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:
@@ -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:
|
||||
1. **Transient errors** (tool failures, network timeouts) — recoverable, generate a :loop-error signal at higher depth for retry
|
||||
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
|
||||
The three-tier error recovery model, now backed by a condition hierarchy
|
||||
that skills can hook into via ~handler-bind~:
|
||||
|
||||
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
|
||||
(progn
|
||||
(setf current-signal (perceive-gate current-signal))
|
||||
(setf current-signal (reason-gate current-signal))
|
||||
(let ((feedback (act-gate current-signal)))
|
||||
(if feedback
|
||||
(progn
|
||||
(unless (getf feedback :meta) (setf (getf feedback :meta) meta))
|
||||
(setf current-signal feedback))
|
||||
(setf current-signal nil))))
|
||||
(error (c)
|
||||
(let ((sensor (ignore-errors (getf (getf current-signal :payload) :sensor))))
|
||||
(log-message "METABOLISM CRASH [~a]: ~a" (or sensor :unknown) c)
|
||||
(unless (member sensor '(:loop-error :tool-error :syntax-error))
|
||||
(log-message "CRITICAL ERROR: Initiating Micro-Rollback.")
|
||||
(rollback-memory 0))
|
||||
(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)))))))))))
|
||||
(restart-case
|
||||
(handler-bind
|
||||
((pipeline-error (lambda (c)
|
||||
(log-message "PIPELINE ERROR: ~a" (error-message c)))))
|
||||
(handler-case
|
||||
(progn
|
||||
(setf current-signal (perceive-gate current-signal))
|
||||
(setf current-signal (reason-gate current-signal))
|
||||
(let ((feedback (act-gate current-signal)))
|
||||
(if feedback
|
||||
(progn
|
||||
(unless (getf feedback :meta) (setf (getf feedback :meta) meta))
|
||||
(setf current-signal feedback))
|
||||
(setf current-signal nil))))
|
||||
(error (c)
|
||||
(let ((sensor (ignore-errors (getf (getf current-signal :payload) :sensor))))
|
||||
(log-message "METABOLISM CRASH [~a]: ~a" (or sensor :unknown) c)
|
||||
(unless (member sensor '(:loop-error :tool-error :syntax-error))
|
||||
(log-message "CRITICAL ERROR: Initiating Micro-Rollback.")
|
||||
(rollback-memory 0))
|
||||
(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
|
||||
|
||||
Reference in New Issue
Block a user