passepartout: v0.5.0 — File Reorganization & Token Economics
Some checks failed
Deploy (Gitea) / deploy (push) Failing after 2s
Some checks failed
Deploy (Gitea) / deploy (push) Failing after 2s
File Reorganization: - Extracted core-context → symbolic-awareness (skill) - Extracted heartbeat → symbolic-events (skill) - Relocated 6 utility fragments, renamed 23 files, deleted system-model.lisp - Renamed gateway-* → channel-*, split gateway-messaging → 4 channel-* files - Renamed defskill/defpackage names to match new file prefixes - Deleted gateway-messaging.org/.lisp, removed core-context filter - Documented self-repair criterion, added AGENTS.md core boundary rule Token Economics (v0.5.0, skills not core): - tokenizer.lisp: count-tokens, model-token-ratio, token-cost, provider-token-cost (11 tests) - cost-tracker.lisp: cost-track-call, cost-session-total, cost-by-provider (6 tests) - token-economics.lisp: prompt-prefix-cached, context-assemble-cached, enforce-token-budget with CONTEXT_MAX_TOKENS env var (9 tests) Bug Fixes: - Fixed DeepSeek 400 (removed malformed tools from cascade) - Fixed UNDEFINED-FUNCTION crash (fboundp guards in think()) - Fixed gate-trace duplication (setf replaces list* in cognitive-verify) - Tightened dexador connect-timeout 10s→5s Test suite: 116/116 (100%)
This commit is contained in:
@@ -218,13 +218,27 @@ The function handles several cases:
|
||||
|
||||
The system prompt assembly order — identity (including mandates), tools, context, logs — is intentional: standing mandates appear early in IDENTITY so they set the behavioral frame before the model processes tools, context, and logs.
|
||||
|
||||
Token economics (v0.5.0): when ~token-economics~ is loaded, ~think()~ uses
|
||||
~context-assemble-cached~ (skips context assembly on heartbeat/delegation),
|
||||
~prompt-prefix-cached~ (avoids retransmitting IDENTITY+TOOLS), and
|
||||
~enforce-token-budget~ (trims over-budget prompts). Cost is tracked after
|
||||
each cascade call via ~cost-track-backend-call~. All four calls are
|
||||
~fboundp~-guarded — when the module is not loaded, behavior is unchanged.
|
||||
|
||||
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
||||
#+begin_src lisp
|
||||
(defun think (context)
|
||||
(let* ((active-skill (find-triggered-skill context))
|
||||
(let* ((sensor (proto-get (proto-get context :payload) :sensor))
|
||||
(active-skill (find-triggered-skill context))
|
||||
(tool-belt (generate-tool-belt-prompt))
|
||||
(global-context (context-assemble-global-awareness))
|
||||
(system-logs (context-get-system-logs))
|
||||
(global-context (if (fboundp 'context-assemble-cached)
|
||||
(context-assemble-cached context sensor)
|
||||
(if (fboundp 'context-assemble-global-awareness)
|
||||
(context-assemble-global-awareness)
|
||||
"[Awareness skill not loaded]")))
|
||||
(system-logs (if (fboundp 'context-get-system-logs)
|
||||
(context-get-system-logs)
|
||||
"[No system logs available]"))
|
||||
(assistant-name (or (uiop:getenv "MEMEX_ASSISTANT") "Agent"))
|
||||
(rejection-trace (proto-get (proto-get context :payload) :rejection-trace))
|
||||
(prompt-generator (when active-skill (skill-probabilistic-prompt active-skill)))
|
||||
@@ -241,26 +255,39 @@ The system prompt assembly order — identity (including mandates), tools, conte
|
||||
(when (and text (stringp text) (> (length text) 0))
|
||||
(setf out (concatenate 'string out text (string #\Newline))))))
|
||||
(when (> (length out) 0) out)))
|
||||
(system-prompt (format nil "IDENTITY: ~a~a~a~%~%TOOLS:~%~a~%~%CONTEXT:~%~a~%~%LOGS:~%~a"
|
||||
assistant-name reflection-feedback
|
||||
(if standing-mandates-text
|
||||
(concatenate 'string (string #\Newline) standing-mandates-text)
|
||||
"")
|
||||
tool-belt global-context system-logs))
|
||||
(api-tools (let ((tools nil))
|
||||
(maphash (lambda (k tool)
|
||||
(declare (ignore k))
|
||||
(push (list :name (cognitive-tool-name tool)
|
||||
:description (cognitive-tool-description tool)
|
||||
:parameters (cognitive-tool-parameters tool))
|
||||
tools))
|
||||
*cognitive-tool-registry*)
|
||||
(when tools tools))))
|
||||
(system-prompt (if (fboundp 'prompt-prefix-cached)
|
||||
;; v0.5.0: cached prefix with optional budget enforcement
|
||||
(let* ((prefix (prompt-prefix-cached assistant-name reflection-feedback
|
||||
standing-mandates-text tool-belt)))
|
||||
(if (fboundp 'enforce-token-budget)
|
||||
(multiple-value-bind (pfx ctxt logs _ mandates)
|
||||
(enforce-token-budget prefix global-context system-logs
|
||||
raw-prompt standing-mandates-text)
|
||||
(declare (ignore _))
|
||||
(setf standing-mandates-text mandates)
|
||||
(format nil "~a~%~%CONTEXT:~%~a~%~%LOGS:~%~a"
|
||||
pfx (or ctxt "") logs))
|
||||
(format nil "~a~%~%CONTEXT:~%~a~%~%LOGS:~%~a"
|
||||
prefix (or global-context "") system-logs)))
|
||||
;; Fallback when token-economics not loaded
|
||||
(format nil "IDENTITY: ~a~a~a~%~%TOOLS:~%~a~%~%CONTEXT:~%~a~%~%LOGS:~%~a"
|
||||
assistant-name reflection-feedback
|
||||
(if standing-mandates-text
|
||||
(concatenate 'string (string #\Newline) standing-mandates-text)
|
||||
"")
|
||||
tool-belt (or global-context "") system-logs))))
|
||||
(let* ((thought (backend-cascade-call raw-prompt
|
||||
:system-prompt system-prompt
|
||||
:context context
|
||||
:tools api-tools))
|
||||
:context context))
|
||||
(tool-calls (and (listp thought) (getf thought :tool-calls))))
|
||||
;; v0.5.0: cost tracking after successful cascade
|
||||
(when (and (fboundp 'cost-track-backend-call)
|
||||
(stringp thought)
|
||||
(or (null tool-calls)))
|
||||
(ignore-errors
|
||||
(cost-track-backend-call (first *provider-cascade*)
|
||||
(format nil "~a~%~a" system-prompt raw-prompt)
|
||||
thought)))
|
||||
(if tool-calls
|
||||
(let* ((first-call (car tool-calls))
|
||||
(tool-name (getf first-call :name))
|
||||
@@ -355,10 +382,11 @@ sorted by priority (highest first). Returns a rejection plist or the action."
|
||||
(push (list :gate (or gate-name (car gate-entry)) :result :approval) gate-trace)
|
||||
(setf approval-needed t
|
||||
approval-action (getf (getf result :payload) :action)))
|
||||
((member (getf result :type) '(:LOG :EVENT))
|
||||
(push (list :gate (or gate-name (car gate-entry)) :result :blocked) gate-trace)
|
||||
(return-from cognitive-verify
|
||||
(list* :gate-trace (nreverse gate-trace) result)))
|
||||
((member (getf result :type) '(:LOG :EVENT))
|
||||
(push (list :gate (or gate-name (car gate-entry)) :result :blocked) gate-trace)
|
||||
(let ((blocked-result (copy-list result)))
|
||||
(setf (getf blocked-result :gate-trace) (nreverse gate-trace))
|
||||
(return-from cognitive-verify blocked-result)))
|
||||
((and (listp result) result)
|
||||
(push (list :gate (or gate-name (car gate-entry)) :result :passed) gate-trace)
|
||||
(setf current-action result)))))
|
||||
@@ -367,7 +395,9 @@ sorted by priority (highest first). Returns a rejection plist or the action."
|
||||
:gate-trace (nreverse gate-trace)
|
||||
:payload (list :sensor :approval-required
|
||||
:action approval-action))
|
||||
(list* :gate-trace (nreverse gate-trace) current-action))))
|
||||
(let ((passed-result (copy-tree current-action)))
|
||||
(setf (getf passed-result :gate-trace) (nreverse gate-trace))
|
||||
passed-result))))
|
||||
#+end_src
|
||||
|
||||
** Reason Gate (Stage 2)
|
||||
|
||||
Reference in New Issue
Block a user