diff --git a/lisp/core-act.lisp b/lisp/core-act.lisp index fc7b39e..abca9d5 100644 --- a/lisp/core-act.lisp +++ b/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 - (lambda () (funcall (cognitive-tool-body tool) clean-args))))) + (is-read-only (cognitive-tool-read-only-p tool)) + (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*)))) diff --git a/org/core-act.org b/org/core-act.org index 03a53b5..04051e9 100644 --- a/org/core-act.org +++ b/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 - (lambda () (funcall (cognitive-tool-body tool) clean-args))))) + (is-read-only (cognitive-tool-read-only-p tool)) + (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 \ No newline at end of file