- start-daemon: handle ADDRESS-IN-USE-ERROR by trying ports 9105-9115 instead of crashing. Logs which port is used. - Add *daemon-port* defvar to track actual listening port - main: wrap start-daemon in handler-case so the daemon doesn't crash if all ports are in use - connect-daemon (TUI): try ports 9105-9115 with 2s timeout each instead of retrying the same port 3 times - Add debug messages for connection success and disconnection timestamp
436 lines
19 KiB
Org Mode
436 lines
19 KiB
Org Mode
#+TITLE: The Metabolic Loop (loop.lisp)
|
|
#+AUTHOR: Agent
|
|
#+FILETAGS: :harness:loop:
|
|
#+STARTUP: content
|
|
#+PROPERTY: header-args:lisp :tangle /home/user/.local/share/passepartout/lisp/core-pipeline.lisp
|
|
|
|
* Overview: Architectural Intent
|
|
|
|
The Metabolic Loop is the cranial nerve reflex of Passepartout. While skills provide specialized intelligence, the loop provides the fundamental rhythm of existence: the continuous processing of signals from perception through cognition to action.
|
|
|
|
Every signal flows through three stages:
|
|
1. **Perceive** — normalize raw input into a standard Signal format
|
|
2. **Reason** — think (LLM) then verify (deterministic gates)
|
|
3. **Act** — dispatch the approved action to the appropriate actuator
|
|
|
|
If a stage produces a new signal (e.g., the Act stage produces a tool-output event), that signal feeds back into Perceive and the loop continues. This is how the agent has multi-step conversations: each LLM response produces an action, which produces a tool output, which feeds back as a new perception, which triggers the next reasoning cycle.
|
|
|
|
** Why Separate Stages?
|
|
|
|
A single function that called the LLM, checked safety, and executed the result would be simpler to write. But it would be impossible to:
|
|
- Test each stage independently (a bug in the LLM call would block safety testing)
|
|
- Insert new stages between P and R or R and A (adding consensus means adding a gate in the middle)
|
|
- Recover from failures mid-pipeline (an LLM timeout shouldn't prevent safety checks on the next cycle)
|
|
|
|
The stage separation is the functional equivalent of the "thin harness" principle: each stage is a pure function that transforms a signal. The loop is the composition of these functions.
|
|
|
|
** Why the Depth Limit?
|
|
|
|
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, 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~.
|
|
|
|
* Implementation
|
|
|
|
** Package Context
|
|
#+begin_src lisp
|
|
(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.
|
|
|
|
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
|
#+begin_src lisp
|
|
(defvar *interrupt-flag* nil
|
|
"Atomic flag set by signal handlers to trigger graceful shutdown.")
|
|
|
|
#+end_src
|
|
** *loop-interrupt-lock*
|
|
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
|
#+begin_src lisp
|
|
(defvar *loop-interrupt-lock* (bt:make-lock "harness-interrupt-lock")
|
|
"Mutex protecting *interrupt-flag* access.")
|
|
|
|
#+end_src
|
|
** *heartbeat-thread*
|
|
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
|
#+begin_src lisp
|
|
(defvar *heartbeat-thread* nil
|
|
"Handle to the heartbeat thread.")
|
|
#+end_src
|
|
#+end_src
|
|
|
|
** Core Engine (loop-process)
|
|
|
|
The entry point to the metabolic pipeline. Each cycle runs Perceive → Reason → Act. If Act produces feedback (a new signal), the loop continues with that signal at the same depth.
|
|
|
|
The function handles four failure modes:
|
|
- **Depth exceeded**: signal dropped, nil returned
|
|
- **Interrupt flag**: graceful shutdown, nil returned
|
|
- **Handler error**: caught by handler-case, logged, and depending on the sensor type and depth:
|
|
- Normal errors at low depth → memory rollback + retry as :loop-error
|
|
- :loop-error and :tool-error at any depth → dropped (avoids infinite retry loops)
|
|
- High-depth errors (depth > 2) → dropped (avoids cascading failures)
|
|
- **Unhandled error**: the handler-case catches everything, preventing any single bad signal from crashing the agent
|
|
|
|
*** loop-process
|
|
|
|
The main pipeline entry point.
|
|
|
|
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
|
#+begin_src lisp
|
|
(defun loop-process (signal)
|
|
"The entry point to the Metabolic Pipeline: Perceive -> Reason -> Act."
|
|
(let ((current-signal signal))
|
|
(loop while current-signal do
|
|
(let ((depth (getf current-signal :depth 0))
|
|
(meta (getf current-signal :meta)))
|
|
(when (> depth 10)
|
|
(log-message "METABOLISM ERROR: Max recursion depth reached.")
|
|
(return nil))
|
|
|
|
(when (bt:with-lock-held (*loop-interrupt-lock*) *interrupt-flag*)
|
|
(log-message "METABOLISM: Interrupted by shutdown signal.")
|
|
(return nil))
|
|
|
|
(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)
|
|
|
|
The pipeline entry point was originally named ~process-signal~. Code
|
|
that still uses the old name can call this alias. New code should call
|
|
~loop-process~.
|
|
|
|
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
|
#+begin_src lisp
|
|
(defun process-signal (signal)
|
|
(loop-process signal))
|
|
#+end_src
|
|
|
|
** Heartbeat Mechanism
|
|
|
|
The heartbeat is a background thread that fires every N seconds (configurable via ~HEARTBEAT_INTERVAL~ env var, default 60). On each tick, it:
|
|
|
|
1. Increments the save counter and saves memory to disk when the counter exceeds the auto-save interval (default 300s)
|
|
2. Injects a ~:heartbeat~ signal into the pipeline
|
|
|
|
The heartbeat signal is how background skills (Gardener, Scribe) get triggered without user input. These skills have triggers that match ~:sensor :heartbeat~ and run maintenance tasks during idle cycles.
|
|
|
|
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
|
#+begin_src lisp
|
|
(defvar *memory-auto-save-interval* 300)
|
|
#+end_src
|
|
** *heartbeat-save-counter*
|
|
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
|
#+begin_src lisp
|
|
(defvar *heartbeat-save-counter* 0)
|
|
|
|
#+end_src
|
|
** heartbeat-start
|
|
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
|
#+begin_src lisp
|
|
(defun heartbeat-start ()
|
|
"Starts the background heartbeat thread."
|
|
(let ((interval (or (ignore-errors (parse-integer (uiop:getenv "HEARTBEAT_INTERVAL"))) 60))
|
|
(auto-save (or (ignore-errors (parse-integer (uiop:getenv "MEMORY_AUTO_SAVE_INTERVAL"))) *memory-auto-save-interval*)))
|
|
(setf *memory-auto-save-interval* auto-save)
|
|
(setf *heartbeat-save-counter* 0)
|
|
|
|
(setf *heartbeat-thread*
|
|
(bt:make-thread
|
|
(lambda ()
|
|
(loop
|
|
(sleep interval)
|
|
(incf *heartbeat-save-counter*)
|
|
(when (>= *heartbeat-save-counter* (/ *memory-auto-save-interval* interval))
|
|
(setf *heartbeat-save-counter* 0)
|
|
(save-memory-to-disk))
|
|
(stimulus-inject
|
|
(list :type :EVENT :payload (list :sensor :heartbeat :unix-time (get-universal-time))))))
|
|
:name "passepartout-heartbeat"))))
|
|
#+end_src
|
|
#+end_src
|
|
|
|
** Shutdown Save Flag
|
|
|
|
Controls whether memory is saved on shutdown. Useful for testing when you want a clean state on next boot.
|
|
|
|
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
|
#+begin_src lisp
|
|
(defvar *shutdown-save-enabled* t)
|
|
#+end_src
|
|
|
|
** System Health Status
|
|
|
|
Used by the health check protocol and the daemon's status endpoint. Set by ~diagnostics-startup-run~ during boot.
|
|
|
|
- ~:healthy~ — all checks passed
|
|
- ~:degraded~ — checks found issues but the daemon can still run
|
|
- ~:unhealthy~ — checks failed, the daemon may not function correctly
|
|
- ~:unknown~ — health check hasn't run yet
|
|
|
|
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
|
#+begin_src lisp
|
|
(defvar *system-health* :unknown
|
|
"Current system health status: :healthy, :degraded, :unhealthy, or :unknown.")
|
|
|
|
#+end_src
|
|
** *health-check-ran*
|
|
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
|
#+begin_src lisp
|
|
(defvar *health-check-ran* nil
|
|
"Flag indicating if initial health check has completed.")
|
|
#+end_src
|
|
#+end_src
|
|
|
|
** Proactive Doctor
|
|
|
|
Runs the doctor diagnostics automatically at startup. If the doctor finds issues (missing dependencies, misconfigured providers), it prints a diagnostic message but does NOT block the daemon from starting. The user can see the issues and run ~passepartout doctor --fix~ to repair.
|
|
|
|
This is the "fail open" principle applied to boot: the system should start even with problems, not refuse to start until everything is perfect.
|
|
|
|
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
|
#+begin_src lisp
|
|
(defun diagnostics-startup-run ()
|
|
"Runs the doctor diagnostics on startup. Returns health status."
|
|
(format t "~%")
|
|
(format t "==================================================~%")
|
|
(format t " DOCTOR: Running Startup Health Check~%")
|
|
(format t "==================================================~%")
|
|
(handler-case
|
|
(progn
|
|
(when (fboundp 'diagnostics-run-all)
|
|
(let ((result (diagnostics-run-all :auto-install nil)))
|
|
(setf *health-check-ran* t)
|
|
(if result
|
|
(progn
|
|
(setf *system-health* :healthy)
|
|
(format t "DAEMON: Health check passed. Starting services.~%"))
|
|
(progn
|
|
(setf *system-health* :degraded)
|
|
(format t "DAEMON: Health check found issues.~%")
|
|
(format t " Run 'passepartout diagnostics' to repair.~%")))))
|
|
(setf *health-check-ran* t))
|
|
(error (c)
|
|
(format t "DIAGNOSTICS ERROR: ~a~%" c)
|
|
(setf *system-health* :unhealthy)
|
|
(setf *health-check-ran* t)))
|
|
(format t "==================================================~%~%"))
|
|
#+end_src
|
|
|
|
** Main Entry Point (main)
|
|
|
|
The top-level entry point. Called by ~passepartout daemon~ and ~passepartout tui~.
|
|
|
|
Boot sequence:
|
|
1. Load environment variables from ~.config/passepartout/.env~
|
|
2. Load persisted memory state from disk
|
|
3. Register core actuators (:system, :tool, :tui)
|
|
4. Initialize all skills (tangging .lisp or loading from XDG)
|
|
5. Run the proactive health check
|
|
6. Start the heartbeat thread (background maintenance)
|
|
7. Start the TCP daemon (listens for CLI/TUI connections)
|
|
8. Install the SIGINT handler (graceful shutdown on Ctrl+C)
|
|
9. Enter the idle sleep loop (wakes on interrupt)
|
|
|
|
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
|
#+begin_src lisp
|
|
(defun main ()
|
|
"Entry point for Passepartout. Initializes the system and enters idle loop."
|
|
(let* ((home (uiop:getenv "HOME"))
|
|
(env-file (uiop:merge-pathnames* ".config/passepartout/.env" (uiop:ensure-directory-pathname home))))
|
|
(when (uiop:file-exists-p env-file)
|
|
(cl-dotenv:load-env env-file)))
|
|
|
|
(load-memory-from-disk)
|
|
(actuator-initialize)
|
|
(skill-initialize-all)
|
|
|
|
;; Run proactive diagnostics before starting services
|
|
(diagnostics-startup-run)
|
|
|
|
(when (fboundp 'events-start-heartbeat)
|
|
(events-start-heartbeat))
|
|
(handler-case (start-daemon)
|
|
(error (c)
|
|
(log-message "DAEMON: Failed to start — ~a" c)
|
|
(format *error-output* "~&DAEMON: Failed to start — ~a~%" c)))
|
|
|
|
#+sbcl
|
|
(sb-sys:enable-interrupt sb-unix:sigint
|
|
(lambda (sig code scp)
|
|
(declare (ignore sig code scp))
|
|
(log-message "SHUTDOWN: SIGINT received. Saving memory...")
|
|
(when *shutdown-save-enabled* (save-memory-to-disk))
|
|
(uiop:quit 0)))
|
|
|
|
(let ((sleep-interval (or (ignore-errors (parse-integer (uiop:getenv "DAEMON_SLEEP_INTERVAL"))) 3600)))
|
|
(loop
|
|
(when (bt:with-lock-held (*loop-interrupt-lock*) *interrupt-flag*)
|
|
(log-message "SHUTDOWN: Interrupt flag set. Saving memory...")
|
|
(when *shutdown-save-enabled* (save-memory-to-disk))
|
|
(return))
|
|
(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 |