Amr Gharbeia
8fd56dece3
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
379 lines
12 KiB
Org Mode
379 lines
12 KiB
Org Mode
#+TITLE: Core: Package Definition (core-package.org)
|
|
#+AUTHOR: Agent
|
|
#+FILETAGS: :passepartout:core:defpackage:
|
|
#+STARTUP: content
|
|
#+PROPERTY: header-args:lisp :tangle ../lisp/core-package.lisp
|
|
|
|
* Overview: Architectural Intent
|
|
|
|
~package.lisp~ defines two things: the public API of the ~passepartout~ package (the export list), and the implementation of low-level utility functions and global state that don't belong in a specific pipeline stage or skill.
|
|
|
|
The export list is the contract between the harness and all skills. Every function exported here is accessible to every skill via ~use-package~. Adding a symbol here is an API commitment; removing one is a breaking change.
|
|
|
|
The implementation section includes:
|
|
- ~proto-get~ — robust plist accessor used everywhere in the pipeline
|
|
- Logging state (~*log-buffer*~, ~*log-lock*~) — bounded ring buffer for LLM context
|
|
- Skill registry (~*skill-registry*~, ~defskill~) — all loaded skills live here
|
|
- Cognitive tool registry (~*cognitive-tool-registry*~, ~def-cognitive-tool~, ~cognitive-tool-prompt~)
|
|
- Telemetry tracking (~*telemetry-table*~, ~telemetry-track~) — performance metrics per skill
|
|
- Debugger hook — replaces raw SBCL debugger with a friendly error message
|
|
|
|
* Implementation
|
|
|
|
** Package Definition and Export List
|
|
The export list is organized by source module so a contributor can find
|
|
where to add new exports:
|
|
|
|
#+begin_src lisp
|
|
(defpackage :passepartout
|
|
(:use :cl)
|
|
(:export
|
|
;; ── Core: Transport & Protocol ──
|
|
#:frame-message
|
|
#:read-framed-message
|
|
#:PROTO-GET
|
|
#:proto-get
|
|
#:make-hello-message
|
|
#:validate-communication-protocol-schema
|
|
#:start-daemon
|
|
#:register-actuator
|
|
#:actuator-initialize
|
|
#:action-dispatch
|
|
|
|
;; ── Core: Pipeline ──
|
|
#:main
|
|
#:log-message
|
|
#:process-signal
|
|
#:loop-process
|
|
#:perceive-gate
|
|
#:loop-gate-perceive
|
|
#:act-gate
|
|
#:loop-gate-act
|
|
#:reason-gate
|
|
#:loop-gate-reason
|
|
#:cognitive-verify
|
|
#:backend-cascade-call
|
|
#:json-alist-to-plist
|
|
#:stimulus-inject
|
|
#:register-probabilistic-backend
|
|
#:*probabilistic-backends*
|
|
#:*provider-cascade*
|
|
|
|
;; ── Core: Memory ──
|
|
#:ingest-ast
|
|
#:memory-object-get
|
|
#:*memory-store*
|
|
#:memory-object
|
|
#:make-memory-object
|
|
#:memory-object-id
|
|
#:memory-object-type
|
|
#:memory-object-attributes
|
|
#:memory-object-parent-id
|
|
#:memory-object-children
|
|
#:memory-object-version
|
|
#:memory-object-last-sync
|
|
#:memory-object-vector
|
|
#:memory-object-content
|
|
#:memory-object-hash
|
|
#:memory-object-scope
|
|
#:memory-objects-by-attribute
|
|
#:snapshot-memory
|
|
#:rollback-memory
|
|
#:undo-snapshot
|
|
#:undo
|
|
#:redo
|
|
#:*undo-stack*
|
|
#:*redo-stack*
|
|
|
|
;; ── Core: Context & Awareness ──
|
|
#:context-get-system-logs
|
|
#:context-assemble-global-awareness
|
|
#:context-awareness-assemble
|
|
#:context-query
|
|
#:push-context
|
|
#:pop-context
|
|
#:current-context
|
|
#:current-scope
|
|
#:context-stack-depth
|
|
#:context-save
|
|
#:context-load
|
|
#:focus-project
|
|
#:focus-session
|
|
#:focus-memex
|
|
#:unfocus
|
|
#:*scope-resolver*
|
|
|
|
;; ── Core: Skills Engine ──
|
|
#:skill
|
|
#:skill-name
|
|
#:skill-priority
|
|
#:skill-dependencies
|
|
#:skill-trigger-fn
|
|
#:skill-probabilistic-prompt
|
|
#:skill-deterministic-fn
|
|
#:defskill
|
|
#:*skill-registry*
|
|
#:skill-initialize-all
|
|
#:load-skill-from-org
|
|
#:lisp-syntax-validate
|
|
|
|
;; ── Core: Cognitive Tools ──
|
|
#:def-cognitive-tool
|
|
#:*cognitive-tool-registry*
|
|
#:cognitive-tool
|
|
#:cognitive-tool-name
|
|
#:cognitive-tool-description
|
|
#:cognitive-tool-parameters
|
|
#:cognitive-tool-guard
|
|
#:cognitive-tool-body
|
|
#:tool-read-only-p
|
|
|
|
;; ── Security: Dispatcher ──
|
|
#:dispatcher-check-secret-path
|
|
#:dispatcher-check-shell-safety
|
|
#:dispatcher-check-privacy-tags
|
|
#:dispatcher-check-network-exfil
|
|
#:dispatcher-check
|
|
#:dispatcher-gate
|
|
#:wildcard-match
|
|
|
|
;; ── Security: HITL ──
|
|
#:hitl-create
|
|
#:hitl-approve
|
|
#:hitl-deny
|
|
#:hitl-handle-message
|
|
|
|
;; ── Security: Vault & Permissions ──
|
|
#:*VAULT-MEMORY*
|
|
#:vault-get
|
|
#:vault-set
|
|
#:vault-get-secret
|
|
#:vault-set-secret
|
|
#:get-tool-permission
|
|
#:set-tool-permission
|
|
#:check-tool-permission-gate
|
|
#:permission-get
|
|
#:permission-set
|
|
#:policy-compliance-check
|
|
#:validator-protocol-check
|
|
|
|
;; ── Embedding ──
|
|
#:*embedding-backend*
|
|
#:*embedding-queue*
|
|
#:*embedding-provider*
|
|
#:embed-queue-object
|
|
#:embed-object
|
|
#:embed-all-pending
|
|
#:embedding-backend-hashing
|
|
#:embedding-backend-native
|
|
#:embedding-native-load-model
|
|
#:embedding-native-unload
|
|
#:embedding-native-ensure-loaded
|
|
#:embedding-native-get-dim
|
|
#:embeddings-compute
|
|
#:mark-vector-stale
|
|
|
|
;; ── Channels ──
|
|
#:channel-cli-input
|
|
#:gateway-start
|
|
#:gateway-registry-initialize
|
|
#:messaging-link
|
|
#:messaging-unlink
|
|
#:gateway-configured-p
|
|
|
|
;; ── Programming: Lisp ──
|
|
#:lisp-validate
|
|
#:lisp-structural-check
|
|
#:lisp-syntactic-check
|
|
#:lisp-semantic-check
|
|
#:lisp-eval
|
|
#:lisp-format
|
|
#:lisp-list-definitions
|
|
#:lisp-extract
|
|
#:lisp-inject
|
|
#:lisp-slurp
|
|
|
|
;; ── Programming: Org ──
|
|
#:org-read-file
|
|
#:org-write-file
|
|
#:org-headline-add
|
|
#:org-headline-find-by-id
|
|
#:org-property-set
|
|
#:org-todo-set
|
|
#:org-id-generate
|
|
#:org-id-format
|
|
#:org-modify
|
|
|
|
;; ── Programming: Literate & REPL ──
|
|
#:literate-tangle-sync-check
|
|
#:literate-extract-lisp-blocks
|
|
#:literate-block-balance-check
|
|
#:repl-eval
|
|
#:repl-inspect
|
|
#:repl-list-vars
|
|
|
|
;; ── Symbolic ──
|
|
#:archivist-create-note
|
|
#:archivist-extract-headlines
|
|
#:archivist-headline-to-filename
|
|
|
|
;; ── Diagnostics & Config ──
|
|
#:diagnostics-run-all
|
|
#:diagnostics-main
|
|
#:diagnostics-dependencies-check
|
|
#:diagnostics-env-check
|
|
#:get-oc-config-dir
|
|
#:run-setup-wizard
|
|
|
|
;; ── Providers ──
|
|
#:register-provider
|
|
#:provider-openai-request
|
|
#:provider-config
|
|
|
|
;; ── Token Economics ──
|
|
#:count-tokens
|
|
#:model-token-ratio
|
|
#:token-cost
|
|
#:provider-token-cost
|
|
#:cost-track-call
|
|
#:cost-session-total
|
|
#:cost-session-calls
|
|
#:cost-by-provider
|
|
#:cost-session-reset
|
|
#:cost-format-budget-status
|
|
#:cost-track-backend-call
|
|
#:prompt-prefix-cached
|
|
#:context-assemble-cached
|
|
#:enforce-token-budget
|
|
#:token-economics-initialize))
|
|
#+end_src
|
|
|
|
** Package Implementation
|
|
The package implementation section defines the low-level utilities and global state that are shared across all harness components and skills.
|
|
|
|
#+begin_src lisp
|
|
(in-package :passepartout)
|
|
#+end_src
|
|
|
|
*** Logging state
|
|
The harness maintains a bounded ring buffer of log messages for inclusion in LLM context. Access is thread-safe via a lock.
|
|
#+begin_src lisp
|
|
(defvar *log-buffer* nil)
|
|
(defvar *log-lock* (bordeaux-threads:make-lock "log-messages-lock"))
|
|
(defvar *log-limit* 100)
|
|
#+end_src
|
|
|
|
*** Skill registry
|
|
The global registry of all loaded skills. This is the authoritative list that the deterministic engine iterates.
|
|
#+begin_src lisp
|
|
(defvar *skill-registry* (make-hash-table :test 'equal)
|
|
"Global registry of all loaded skills.")
|
|
#+end_src
|
|
|
|
*** Skill telemetry
|
|
Tracks execution metrics per skill (count, duration, failures) for diagnostics and performance analysis.
|
|
#+begin_src lisp
|
|
(defvar *telemetry-table* (make-hash-table :test 'equal))
|
|
(defvar *telemetry-lock* (bordeaux-threads:make-lock "harness-telemetry-lock"))
|
|
|
|
(defun telemetry-track (skill-name duration status)
|
|
"Updates performance metrics for a skill. STATUS is :success or :rejected."
|
|
(when skill-name
|
|
(bordeaux-threads:with-lock-held (*telemetry-lock*)
|
|
(let ((entry (or (gethash skill-name *telemetry-table*) (list :executions 0 :total-time 0 :failures 0))))
|
|
(incf (getf entry :executions))
|
|
(incf (getf entry :total-time) duration)
|
|
(when (eq status :rejected) (incf (getf entry :failures)))
|
|
(setf (gethash skill-name *telemetry-table*) entry)))))
|
|
#+end_src
|
|
|
|
*** Cognitive tool registry
|
|
Tools that the LLM can invoke are registered here. Each tool has a name, description, parameters, optional guard, and implementation body. The ~def-cognitive-tool~ macro handles registration. ~cognitive-tool-prompt~ serialises the registry into the LLM's system prompt.
|
|
#+begin_src lisp
|
|
(defvar *cognitive-tool-registry* (make-hash-table :test 'equal))
|
|
#+end_src
|
|
|
|
#+begin_src lisp
|
|
(defstruct cognitive-tool
|
|
name
|
|
description
|
|
parameters
|
|
guard
|
|
body
|
|
read-only-p)
|
|
#+end_src
|
|
|
|
#+begin_src lisp
|
|
(defmacro def-cognitive-tool (name description parameters &key guard body read-only-p)
|
|
"Registers a cognitive tool. PARAMETERS is a list of plists, one per parameter."
|
|
`(setf (gethash (string-downcase (string ',name)) *cognitive-tool-registry*)
|
|
(make-cognitive-tool :name (string-downcase (string ',name))
|
|
:description ,description
|
|
:parameters ',parameters
|
|
:guard ,guard
|
|
:body ,body
|
|
:read-only-p ,read-only-p)))
|
|
#+end_src
|
|
|
|
#+begin_src lisp
|
|
(defun cognitive-tool-prompt ()
|
|
"Serialises all registered tools into a prompt string for the LLM."
|
|
(let ((descriptions nil))
|
|
(maphash (lambda (k tool)
|
|
(declare (ignore k))
|
|
(push (format nil "- ~a: ~a~% Parameters: ~a~%"
|
|
(cognitive-tool-name tool)
|
|
(cognitive-tool-description tool)
|
|
(cognitive-tool-parameters tool))
|
|
descriptions))
|
|
*cognitive-tool-registry*)
|
|
(if descriptions
|
|
(format nil "Available tools:~%~a" (apply #'concatenate 'string (sort descriptions #'string<)))
|
|
"No tools registered.")))
|
|
|
|
;; Alias: generate-tool-belt-prompt → cognitive-tool-prompt
|
|
(defun generate-tool-belt-prompt ()
|
|
(cognitive-tool-prompt))
|
|
|
|
(defun tool-read-only-p (name)
|
|
"Returns T if the named cognitive tool is read-only, NIL otherwise."
|
|
(let ((tool (gethash (string-downcase (string name)) *cognitive-tool-registry*)))
|
|
(when tool
|
|
(cognitive-tool-read-only-p tool))))
|
|
#+end_src
|
|
|
|
*** Centralized logging (log-message)
|
|
Thread-safe logging function that writes to both the ring buffer (for LLM context) and stdout (for the user). Bounded by ~*log-limit*~.
|
|
#+begin_src lisp
|
|
(defun log-message (msg &rest args)
|
|
"Centralized, thread-safe logging for the harness."
|
|
(let ((formatted-msg (apply #'format nil msg args)))
|
|
(bordeaux-threads:with-lock-held (*log-lock*)
|
|
(push formatted-msg *log-buffer*)
|
|
(when (> (length *log-buffer*) *log-limit*)
|
|
(setq *log-buffer* (subseq *log-buffer* 0 *log-limit*))))
|
|
(format t "~a~%" formatted-msg)
|
|
(finish-output)))
|
|
#+end_src
|
|
|
|
*** Debugger hook
|
|
Friendly error handler that replaces the raw SBCL debugger with a diagnostic message. This prevents the agent from entering the debugger on unhandled conditions.
|
|
#+begin_src lisp
|
|
(setf *debugger-hook* (lambda (condition hook)
|
|
"Friendly error handler - shows diagnostic message instead of raw debugger."
|
|
(declare (ignore hook))
|
|
(format t "~%")
|
|
(format t "┌─────────────────────────────────────────────┐~%")
|
|
(format t "│ ERROR: ~A~%" (type-of condition))
|
|
(format t "│~%")
|
|
(format t "│ Run: passepartout diagnostics~%")
|
|
(format t "│ For system diagnostics~%")
|
|
(format t "└─────────────────────────────────────────────┘~%")
|
|
(format t "~%")
|
|
(format t "Details: ~A~%" condition)
|
|
(format t "Backtrace:~%")
|
|
(sb-debug:print-backtrace :count 20 :stream *standard-output*)
|
|
(finish-output)
|
|
(uiop:quit 1)))
|
|
#+end_src
|