v0.8.2: cleanup + prose + structure + decomposition + budget + errors
Phase 1 — dedup + hardening (~9 items): - Remove duplicate *skill-registry* defvar from core-skills - Merge *backend-registry* into *probabilistic-backends*, delete backend-register - Remove inject-stimulus alias, standardize on stimulus-inject - Add pre-eval sandbox (skill-source-scan) blocks restricted symbols before eval - Remove dead plist-get function; remove duplicate json-alist-to-plist export - Fix read-framed-message whitespace DoS (4096-iteration max) - Add *read-eval* nil to dispatcher-approvals-process read-from-string (RCE) - Add test-op to ASDF; update .asd version 0.4.3→0.7.2 Phase 2 — prose + contracts + reorder: - Split ROADMAP: 2623→1089 lines (TODO only), CHANGELOG: 260→1528 lines (full DONE history, 14 versions reverse chron) - Add Contracts + Overview to 6 channel files + embedding-native + programming-standards + symbolic-scope - Reorder 28 .org files: Contract → Test Suite → Implementation (TDD order) - Add 7-phase inline prose to think() in core-reason - Expand USER_MANUAL: 183→461 lines (10 new sections) Phase 3 — decomposition + export organization: - Decompose think() into think-assemble-prompt, think-call-llm, think-parse-response orchestrator - Organize 188 exports into 16 grouped sections by module Phase 4 — budget enforcement + error protocol: - Per-session budget enforcement (SESSION_BUDGET_USD env var, budget-exhausted-p, guard in think-call-llm) - Error condition hierarchy (6 conditions: pipeline-error, llm-error, gate-error, budget-error, protocol-error) - Restarts in loop-process: skip-signal, use-fallback, abort-pipeline
This commit is contained in:
@@ -1,3 +1,102 @@
|
||||
(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||
(ql:quickload :fiveam :silent t))
|
||||
|
||||
(defpackage :passepartout-token-economics-tests
|
||||
(:use :cl :fiveam :passepartout)
|
||||
(:export #:token-economics-suite))
|
||||
|
||||
(in-package :passepartout-token-economics-tests)
|
||||
|
||||
(def-suite token-economics-suite
|
||||
:description "Prompt prefix caching, incremental context, token budget")
|
||||
(in-suite token-economics-suite)
|
||||
|
||||
(test test-prompt-prefix-cached-identity
|
||||
"Contract 1: prompt-prefix-cached includes identity-content when provided."
|
||||
(setf (car passepartout::*prompt-prefix-cache*) nil
|
||||
(cdr passepartout::*prompt-prefix-cache*) "")
|
||||
(let ((prefix (passepartout::prompt-prefix-cached
|
||||
"Agent" "### Mode: concise" "" nil "No tools")))
|
||||
(is (stringp prefix))
|
||||
(is (search "IDENTITY" prefix))
|
||||
(is (search "Mode: concise" prefix))
|
||||
(is (search "TOOLS" prefix))))
|
||||
|
||||
(test test-prompt-prefix-cached-builds
|
||||
"Contract 1: prompt-prefix-cached returns a string containing IDENTITY."
|
||||
(setf (car passepartout::*prompt-prefix-cache*) nil
|
||||
(cdr passepartout::*prompt-prefix-cache*) "")
|
||||
(let ((prefix (passepartout::prompt-prefix-cached "Agent" "" "" nil "No tools")))
|
||||
(is (stringp prefix))
|
||||
(is (search "IDENTITY" prefix))
|
||||
(is (search "TOOLS" prefix))))
|
||||
|
||||
(test test-prompt-prefix-cached-hits
|
||||
"Contract 1: second call with same inputs returns cached result."
|
||||
(setf (car passepartout::*prompt-prefix-cache*) nil
|
||||
(cdr passepartout::*prompt-prefix-cache*) "")
|
||||
(let ((p1 (passepartout::prompt-prefix-cached "Agent" "" "" nil "No tools"))
|
||||
(p2 (passepartout::prompt-prefix-cached "Agent" "" "" nil "No tools")))
|
||||
(is (string= p1 p2))))
|
||||
|
||||
(test test-prompt-prefix-cached-miss
|
||||
"Contract 1: different inputs rebuild the cache."
|
||||
(setf (car passepartout::*prompt-prefix-cache*) nil
|
||||
(cdr passepartout::*prompt-prefix-cache*) "")
|
||||
(let ((p1 (passepartout::prompt-prefix-cached "Agent" "" "" nil "No tools"))
|
||||
(p2 (passepartout::prompt-prefix-cached "Bot" "" "" nil "No tools")))
|
||||
(is (not (string= p1 p2)))
|
||||
(is (search "Bot" p2))))
|
||||
|
||||
(test test-context-assemble-cached-skips-heartbeat
|
||||
"Contract 2: heartbeat sensors skip context assembly, return nil."
|
||||
(let ((result (passepartout::context-assemble-cached
|
||||
'(:foveal-focus "id1") :heartbeat)))
|
||||
(is (null result))))
|
||||
|
||||
(test test-context-assemble-cached-skips-delegation
|
||||
"Contract 2: delegation sensors also skip assembly."
|
||||
(let ((result (passepartout::context-assemble-cached
|
||||
'(:foveal-focus "id1") :delegation)))
|
||||
(is (null result))))
|
||||
|
||||
(test test-context-assemble-cached-non-skip
|
||||
"Contract 2: user-input sensors attempt assembly (fails gracefully without awareness)."
|
||||
(let ((result (passepartout::context-assemble-cached
|
||||
'(:foveal-focus "id1") :user-input)))
|
||||
(is (stringp result))
|
||||
(is (> (length result) 0))))
|
||||
|
||||
(test test-enforce-token-budget-passthrough
|
||||
"Contract 3: under-budget prompts pass through unchanged."
|
||||
(multiple-value-bind (p c l u m)
|
||||
(passepartout::enforce-token-budget "hi" "ctxt" "log" "user" nil 100000)
|
||||
(is (string= "hi" p))
|
||||
(is (string= "ctxt" c))
|
||||
(is (string= "log" l))
|
||||
(is (string= "user" u))
|
||||
(is (null m))))
|
||||
|
||||
(test test-enforce-token-budget-trims
|
||||
"Contract 3: over-budget prompts get trimmed."
|
||||
(let ((big-prefix (make-string 20000 :initial-element #\x)))
|
||||
(multiple-value-bind (p c l u m)
|
||||
(passepartout::enforce-token-budget big-prefix "ctxt" "logs\nlogs\nlogs\nlogs\nlogs\nlogs\nlogs" "user" nil 10)
|
||||
(declare (ignore p l u m))
|
||||
;; The prefix itself exceeds the tiny 10-token budget, so everything gets trimmed
|
||||
(is (or (stringp c) (null c)))
|
||||
(is (search "[Context trimmed" (or c ""))))))
|
||||
|
||||
(test test-token-economics-initialize
|
||||
"Contract 4: initialize zeroes all cache state."
|
||||
(setf (car passepartout::*prompt-prefix-cache*) 12345
|
||||
(cdr passepartout::*prompt-prefix-cache*) "stale")
|
||||
(setf (getf passepartout::*context-cache* :rendered) "stale context")
|
||||
(passepartout::token-economics-initialize)
|
||||
(is (null (car passepartout::*prompt-prefix-cache*)))
|
||||
(is (string= "" (cdr passepartout::*prompt-prefix-cache*)))
|
||||
(is (string= "" (getf passepartout::*context-cache* :rendered))))
|
||||
|
||||
(in-package :passepartout)
|
||||
|
||||
(defvar *prompt-prefix-cache* (cons nil "")
|
||||
@@ -122,105 +221,6 @@ Returns nil when no context cache data is available."
|
||||
(min 100 (floor (* 100 tokens) limit))
|
||||
nil)))
|
||||
|
||||
(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||
(ql:quickload :fiveam :silent t))
|
||||
|
||||
(defpackage :passepartout-token-economics-tests
|
||||
(:use :cl :fiveam :passepartout)
|
||||
(:export #:token-economics-suite))
|
||||
|
||||
(in-package :passepartout-token-economics-tests)
|
||||
|
||||
(def-suite token-economics-suite
|
||||
:description "Prompt prefix caching, incremental context, token budget")
|
||||
(in-suite token-economics-suite)
|
||||
|
||||
(test test-prompt-prefix-cached-identity
|
||||
"Contract 1: prompt-prefix-cached includes identity-content when provided."
|
||||
(setf (car passepartout::*prompt-prefix-cache*) nil
|
||||
(cdr passepartout::*prompt-prefix-cache*) "")
|
||||
(let ((prefix (passepartout::prompt-prefix-cached
|
||||
"Agent" "### Mode: concise" "" nil "No tools")))
|
||||
(is (stringp prefix))
|
||||
(is (search "IDENTITY" prefix))
|
||||
(is (search "Mode: concise" prefix))
|
||||
(is (search "TOOLS" prefix))))
|
||||
|
||||
(test test-prompt-prefix-cached-builds
|
||||
"Contract 1: prompt-prefix-cached returns a string containing IDENTITY."
|
||||
(setf (car passepartout::*prompt-prefix-cache*) nil
|
||||
(cdr passepartout::*prompt-prefix-cache*) "")
|
||||
(let ((prefix (passepartout::prompt-prefix-cached "Agent" "" "" nil "No tools")))
|
||||
(is (stringp prefix))
|
||||
(is (search "IDENTITY" prefix))
|
||||
(is (search "TOOLS" prefix))))
|
||||
|
||||
(test test-prompt-prefix-cached-hits
|
||||
"Contract 1: second call with same inputs returns cached result."
|
||||
(setf (car passepartout::*prompt-prefix-cache*) nil
|
||||
(cdr passepartout::*prompt-prefix-cache*) "")
|
||||
(let ((p1 (passepartout::prompt-prefix-cached "Agent" "" "" nil "No tools"))
|
||||
(p2 (passepartout::prompt-prefix-cached "Agent" "" "" nil "No tools")))
|
||||
(is (string= p1 p2))))
|
||||
|
||||
(test test-prompt-prefix-cached-miss
|
||||
"Contract 1: different inputs rebuild the cache."
|
||||
(setf (car passepartout::*prompt-prefix-cache*) nil
|
||||
(cdr passepartout::*prompt-prefix-cache*) "")
|
||||
(let ((p1 (passepartout::prompt-prefix-cached "Agent" "" "" nil "No tools"))
|
||||
(p2 (passepartout::prompt-prefix-cached "Bot" "" "" nil "No tools")))
|
||||
(is (not (string= p1 p2)))
|
||||
(is (search "Bot" p2))))
|
||||
|
||||
(test test-context-assemble-cached-skips-heartbeat
|
||||
"Contract 2: heartbeat sensors skip context assembly, return nil."
|
||||
(let ((result (passepartout::context-assemble-cached
|
||||
'(:foveal-focus "id1") :heartbeat)))
|
||||
(is (null result))))
|
||||
|
||||
(test test-context-assemble-cached-skips-delegation
|
||||
"Contract 2: delegation sensors also skip assembly."
|
||||
(let ((result (passepartout::context-assemble-cached
|
||||
'(:foveal-focus "id1") :delegation)))
|
||||
(is (null result))))
|
||||
|
||||
(test test-context-assemble-cached-non-skip
|
||||
"Contract 2: user-input sensors attempt assembly (fails gracefully without awareness)."
|
||||
(let ((result (passepartout::context-assemble-cached
|
||||
'(:foveal-focus "id1") :user-input)))
|
||||
(is (stringp result))
|
||||
(is (> (length result) 0))))
|
||||
|
||||
(test test-enforce-token-budget-passthrough
|
||||
"Contract 3: under-budget prompts pass through unchanged."
|
||||
(multiple-value-bind (p c l u m)
|
||||
(passepartout::enforce-token-budget "hi" "ctxt" "log" "user" nil 100000)
|
||||
(is (string= "hi" p))
|
||||
(is (string= "ctxt" c))
|
||||
(is (string= "log" l))
|
||||
(is (string= "user" u))
|
||||
(is (null m))))
|
||||
|
||||
(test test-enforce-token-budget-trims
|
||||
"Contract 3: over-budget prompts get trimmed."
|
||||
(let ((big-prefix (make-string 20000 :initial-element #\x)))
|
||||
(multiple-value-bind (p c l u m)
|
||||
(passepartout::enforce-token-budget big-prefix "ctxt" "logs\nlogs\nlogs\nlogs\nlogs\nlogs\nlogs" "user" nil 10)
|
||||
(declare (ignore p l u m))
|
||||
;; The prefix itself exceeds the tiny 10-token budget, so everything gets trimmed
|
||||
(is (or (stringp c) (null c)))
|
||||
(is (search "[Context trimmed" (or c ""))))))
|
||||
|
||||
(test test-token-economics-initialize
|
||||
"Contract 4: initialize zeroes all cache state."
|
||||
(setf (car passepartout::*prompt-prefix-cache*) 12345
|
||||
(cdr passepartout::*prompt-prefix-cache*) "stale")
|
||||
(setf (getf passepartout::*context-cache* :rendered) "stale context")
|
||||
(passepartout::token-economics-initialize)
|
||||
(is (null (car passepartout::*prompt-prefix-cache*)))
|
||||
(is (string= "" (cdr passepartout::*prompt-prefix-cache*)))
|
||||
(is (string= "" (getf passepartout::*context-cache* :rendered))))
|
||||
|
||||
(in-package :passepartout-token-economics-tests)
|
||||
|
||||
(test test-context-usage-percentage
|
||||
|
||||
Reference in New Issue
Block a user