v0.8.2: cleanup + prose + structure + decomposition + budget + errors

Phase 1 — dedup + hardening (~9 items):
- Remove duplicate *skill-registry* defvar from core-skills
- Merge *backend-registry* into *probabilistic-backends*, delete backend-register
- Remove inject-stimulus alias, standardize on stimulus-inject
- Add pre-eval sandbox (skill-source-scan) blocks restricted symbols before eval
- Remove dead plist-get function; remove duplicate json-alist-to-plist export
- Fix read-framed-message whitespace DoS (4096-iteration max)
- Add *read-eval* nil to dispatcher-approvals-process read-from-string (RCE)
- Add test-op to ASDF; update .asd version 0.4.3→0.7.2

Phase 2 — prose + contracts + reorder:
- Split ROADMAP: 2623→1089 lines (TODO only), CHANGELOG: 260→1528 lines (full DONE history, 14 versions reverse chron)
- Add Contracts + Overview to 6 channel files + embedding-native + programming-standards + symbolic-scope
- Reorder 28 .org files: Contract → Test Suite → Implementation (TDD order)
- Add 7-phase inline prose to think() in core-reason
- Expand USER_MANUAL: 183→461 lines (10 new sections)

Phase 3 — decomposition + export organization:
- Decompose think() into think-assemble-prompt, think-call-llm, think-parse-response orchestrator
- Organize 188 exports into 16 grouped sections by module

Phase 4 — budget enforcement + error protocol:
- Per-session budget enforcement (SESSION_BUDGET_USD env var, budget-exhausted-p, guard in think-call-llm)
- Error condition hierarchy (6 conditions: pipeline-error, llm-error, gate-error, budget-error, protocol-error)
- Restarts in loop-process: skip-signal, use-fallback, abort-pipeline
This commit is contained in:
2026-05-10 09:07:44 -04:00
parent 27d203ad67
commit 8fd56dece3
68 changed files with 7014 additions and 6521 deletions

View File

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