v0.7.2: tool hardening — read-only response caching — TDD

*tool-cache* hash table caches read-only tool results keyed by
tool-name-args. Cache check before execution in
action-tool-execute; cache miss → execute + store. Cache hit
skips tool execution entirely.

tool-cache-key and tool-cache-clear helpers. cache-test tool
verifies re-execution is skipped on second call.

- core-act: *tool-cache*, tool-cache-key, tool-cache-clear,
  cache check wired into action-tool-execute, 1 test
- Core: 92/92  TUI Main: 102/102

v0.7.2 complete. All 14 items + 10 refinements. 92 core, 102 TUI.

lisp/core-act.lisp

@@ -87,8 +87,16 @@
     (if tool
         (handler-case
             (let* ((clean-args (if (and (listp tool-args) (listp (car tool-args))) (car tool-args) tool-args))
-                   (raw-result (call-with-tool-timeout tool-name
+                   (is-read-only (cognitive-tool-read-only-p tool))
-                                 (lambda () (funcall (cognitive-tool-body tool) clean-args)))))
+                   (cache-key (when is-read-only (tool-cache-key tool-name clean-args)))
+                   (cached (when cache-key (gethash cache-key *tool-cache*)))
+                   (raw-result (if cached
+                                   (progn (log-message "TOOL-CACHE: hit for ~a" tool-name) cached)
+                                   (let* ((res (call-with-tool-timeout tool-name
+                                                (lambda () (funcall (cognitive-tool-body tool) clean-args)))))
+                                     (when (and is-read-only cache-key)
+                                       (setf (gethash cache-key *tool-cache*) res))
+                                     res))))
               ;; Timeout: propagate error
               (when (and (listp raw-result) (eq (getf raw-result :status) :error))
                 (return-from action-tool-execute
@@ -145,6 +153,18 @@ Returns T on match, logs and returns NIL on mismatch or read error."
       (log-message "WRITE-VERIFY: Cannot read ~a: ~a" filepath c)
       nil)))
 
+;; v0.7.2: read-only tool response cache
+(defvar *tool-cache* (make-hash-table :test 'equal)
+  "Cache for read-only tool results. Key: tool-name$sxhash-args. Cleared per session.")
+
+(defun tool-cache-key (tool-name args)
+  "Build a cache key from TOOL-NAME and ARGS."
+  (format nil "~a$~a" (string-downcase (string tool-name)) (sxhash args)))
+
+(defun tool-cache-clear ()
+  "Clear the read-only tool response cache."
+  (clrhash *tool-cache*))
+
 (defun tool-result-format (tool-name result)
   "Format a tool result for display."
   (if (listp result)
@@ -311,3 +331,28 @@ For approval-required actions, creates a Flight Plan instead of executing."
            (is (search "timed out" (string-downcase (getf payload :MESSAGE))))))
     (remhash "sleep-forever" passepartout::*cognitive-tool-registry*)
     (remhash "sleep-forever" passepartout::*tool-timeouts*)))
+
+(test test-tool-cache-read-only
+  "Contract v0.7.2: read-only tool results are cached and reused."
+  (let ((call-count 0))
+    (setf (gethash "cache-test" passepartout::*cognitive-tool-registry*)
+          (passepartout::make-cognitive-tool :name "cache-test"
+                                            :read-only-p t
+                                            :body (lambda (args)
+                                                    (declare (ignore args))
+                                                    (incf call-count)
+                                                    (list :status :success :content (format nil "call ~d" call-count)))))
+    (unwind-protect
+         (progn
+           (clrhash passepartout::*tool-cache*)
+           (let* ((action '(:type :REQUEST :payload (:tool "cache-test" :args nil)))
+                  (ctx '(:depth 0))
+                  (r1 (passepartout::action-tool-execute action ctx))
+                  (r2 (passepartout::action-tool-execute action ctx)))
+             (is (= 1 call-count) "Second call should hit cache, not re-execute")
+             (let ((p1 (getf r1 :PAYLOAD))
+                   (p2 (getf r2 :PAYLOAD)))
+               (is (string= (getf (getf p1 :RESULT) :CONTENT)
+                            (getf (getf p2 :RESULT) :CONTENT))))))
+      (remhash "cache-test" passepartout::*cognitive-tool-registry*)
+      (clrhash passepartout::*tool-cache*))))

org/core-act.org

@@ -186,8 +186,16 @@ The tool's return value is packed into a ~:tool-output~ event and fed back into
     (if tool
         (handler-case
             (let* ((clean-args (if (and (listp tool-args) (listp (car tool-args))) (car tool-args) tool-args))
-                   (raw-result (call-with-tool-timeout tool-name
+                   (is-read-only (cognitive-tool-read-only-p tool))
-                                 (lambda () (funcall (cognitive-tool-body tool) clean-args)))))
+                   (cache-key (when is-read-only (tool-cache-key tool-name clean-args)))
+                   (cached (when cache-key (gethash cache-key *tool-cache*)))
+                   (raw-result (if cached
+                                   (progn (log-message "TOOL-CACHE: hit for ~a" tool-name) cached)
+                                   (let* ((res (call-with-tool-timeout tool-name
+                                                (lambda () (funcall (cognitive-tool-body tool) clean-args)))))
+                                     (when (and is-read-only cache-key)
+                                       (setf (gethash cache-key *tool-cache*) res))
+                                     res))))
               ;; Timeout: propagate error
               (when (and (listp raw-result) (eq (getf raw-result :status) :error))
                 (return-from action-tool-execute
@@ -246,6 +254,18 @@ Returns T on match, logs and returns NIL on mismatch or read error."
     (error (c)
       (log-message "WRITE-VERIFY: Cannot read ~a: ~a" filepath c)
       nil)))
+
+;; v0.7.2: read-only tool response cache
+(defvar *tool-cache* (make-hash-table :test 'equal)
+  "Cache for read-only tool results. Key: tool-name$sxhash-args. Cleared per session.")
+
+(defun tool-cache-key (tool-name args)
+  "Build a cache key from TOOL-NAME and ARGS."
+  (format nil "~a$~a" (string-downcase (string tool-name)) (sxhash args)))
+
+(defun tool-cache-clear ()
+  "Clear the read-only tool response cache."
+  (clrhash *tool-cache*))
 #+end_src
 
 ** Tool Result Formatting (tool-result-format)
@@ -448,4 +468,29 @@ Verifies that the act gate correctly processes an approved action and sets the s
            (is (search "timed out" (string-downcase (getf payload :MESSAGE))))))
     (remhash "sleep-forever" passepartout::*cognitive-tool-registry*)
     (remhash "sleep-forever" passepartout::*tool-timeouts*)))
+
+(test test-tool-cache-read-only
+  "Contract v0.7.2: read-only tool results are cached and reused."
+  (let ((call-count 0))
+    (setf (gethash "cache-test" passepartout::*cognitive-tool-registry*)
+          (passepartout::make-cognitive-tool :name "cache-test"
+                                            :read-only-p t
+                                            :body (lambda (args)
+                                                    (declare (ignore args))
+                                                    (incf call-count)
+                                                    (list :status :success :content (format nil "call ~d" call-count)))))
+    (unwind-protect
+         (progn
+           (clrhash passepartout::*tool-cache*)
+           (let* ((action '(:type :REQUEST :payload (:tool "cache-test" :args nil)))
+                  (ctx '(:depth 0))
+                  (r1 (passepartout::action-tool-execute action ctx))
+                  (r2 (passepartout::action-tool-execute action ctx)))
+             (is (= 1 call-count) "Second call should hit cache, not re-execute")
+             (let ((p1 (getf r1 :PAYLOAD))
+                   (p2 (getf r2 :PAYLOAD)))
+               (is (string= (getf (getf p1 :RESULT) :CONTENT)
+                            (getf (getf p2 :RESULT) :CONTENT))))))
+      (remhash "cache-test" passepartout::*cognitive-tool-registry*)
+      (clrhash passepartout::*tool-cache*))))
 #+end_src