amr/passepartout
1
0
Fork 0
Code Issues 15 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

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

Browse Source 
*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.
This commit is contained in:
Amr Gharbeia
2026-05-08 21:30:09 -04:00
parent f7b3e20a15
commit 1201b916d8
2 changed files with 94 additions and 4 deletions
Download Patch File Download Diff File Expand all files Collapse all files

49
org/core-act.org
View File

@@ -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