Files
passepartout/org/core-loop-reason.org
Amr Gharbeia e0a47575e9
Some checks failed
Deploy (Gitea) / deploy (push) Failing after 3s
feat: REPL development tool + naming drift fixes + HITL gateways
REPL tool:
- ~/.opencode/bin/repl — connects to running daemon, evaluates Lisp forms,
  returns results. Usage: repl '(+ 1 2)' or via stdin.
- Server-side handler in programming-repl skill registers for :repl-eval
  sensor, bypasses LLM pipeline, writes result back through reply-stream.
- Core provides pre-reason-handler registry (register-pre-reason-handler)
  for skills to register custom sensors without modifying core code.

HITL gateway integration:
- hitl-handle-message: TUI, Telegram, and Signal gateways intercept
  approval/deny commands before they reach the LLM.
- hitl-create/hitl-approve/hitl-deny: in-memory HITL store with correlation
  tokens for gateway-agnostic approval.
- loop-gate-perceive detects HITL commands and blocks LLM processing.

Naming drift fixes (the complete batch):
- register-actuator vs actuator-register — fixed to register-actuator
- process-signal vs loop-process — alias added
- perceive-gate/reason-gate/act-gate vs loop-gate-* — aliases added
- initialize-actuators vs actuator-initialize — fixed to actuator-initialize
- initialize-all-skills vs skill-initialize-all — fixed to skill-initialize-all
- inject-stimulus alias added for backward compatibility
- All original gateway-manager inject-stimulus → stimulus-inject + HITL check
2026-05-03 13:46:32 -04:00

356 lines
19 KiB
Org Mode

#+TITLE: Stage 2: Reason (reason.lisp)
#+AUTHOR: Agent
#+FILETAGS: :harness:reason:
#+STARTUP: content
#+PROPERTY: header-args:lisp :tangle ../lisp/core-loop-reason.lisp
* Overview: Architectural Intent
The Reason stage is the cognitive heart of Passepartout. It takes a normalized signal from Perceive and produces an approved action for Act. This is where the two engines — probabilistic (LLM) and deterministic (Lisp logic) — collaborate.
The design is shaped by one non-negotiable constraint: **the LLM must never touch the actuators directly.** Every action the LLM proposes must pass through a deterministic verification gate that has the final say. This is what separates Passepartout from every other AI agent: the creative brain suggests, but the logical brain decides.
** The Probabilistic-Deterministic Split
An LLM is a statistical engine. Given enough context, it is remarkably good at translation, generation, and pattern matching. But it cannot be trusted with authority because hallucination is a *fundamental property* of probabilistic inference — the model generates the most likely continuation, not the correct one.
The deterministic engine addresses this by being what the probabilistic engine is not: mathematically rigorous, formally verifiable, and incapable of hallucination by design. It operates on explicit symbolic representations — lists, property lists, knowledge graphs — not on floating-point activations. When it evaluates a path confinement check, it returns true or false, not a probability distribution.
The division of labor is architectural:
- The LLM handles the fuzzy interface between human language and structured representation
- The deterministic engine receives those structured representations and evaluates them against formal invariants
- The LLM never reads a file, never executes a command, never modifies memory — it generates proposals
This separation is the source of Passepartout's safety guarantee. Other agents add "guardrails" as an afterthought — a layer of filtering around a dangerous core. Passepartout makes the division explicit.
** Why Plists for Communication?
Every message in the Reason pipeline is a property list (plist):
(TYPE :REQUEST TARGET :CLI PAYLOAD (ACTION :MESSAGE TEXT "Hello"))
A plist is simultaneously:
- Human-readable text
- Machine-parseable data structure
- Executable Lisp code
This is not a cosmetic choice. It means the reasoning pipeline can generate, modify, and execute its own communication protocol without external parsing libraries. There is no JSON encoder, no schema validator, no serialization layer between the two engines. They speak the same language because they *are* the same language.
* Implementation
** Package Context
#+begin_src lisp
(in-package :passepartout)
#+end_src
** Probabilistic Engine State
The probabilistic engine maintains four 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.
These variables are configurable at runtime. 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
;; REPL-VERIFIED: 2026-05-03T13:00:00
#+begin_src lisp
(defvar *provider-cascade* nil)
#+end_src
** Model Selector
;; REPL-VERIFIED: 2026-05-03T13:00:00
#+begin_src lisp
(defvar *model-selector* nil)
#+end_src
** Consensus Toggle
;; REPL-VERIFIED: 2026-05-03T13:00:00
#+begin_src lisp
(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).
The function has a fallback for every failure mode:
- If a backend returns ~:status :error~, the cascade moves to the next provider
- If a backend throws an exception, it is caught and logged, and the cascade moves on
- If ALL backends are exhausted, a structured LOG message is returned saying "Neural Cascade Failure"
This is deliberately resilient. The system should never crash because an LLM provider is down. It should log the failure, try the next provider, and if all fail, return a diagnostic message that the deterministic engine can present to the user.
;; REPL-VERIFIED: 2026-05-03T13:00:00
#+begin_src lisp
(defun backend-cascade-call (prompt &key
(system-prompt "You are the Probabilistic engine.")
(cascade nil)
(context nil))
(let ((backends (or cascade *provider-cascade*)))
(or (dolist (backend backends)
(let ((backend-fn (gethash backend *backend-registry*)))
(when backend-fn
(log-message "PROBABILISTIC: Attempting backend ~a..." backend)
(let* ((model (when *model-selector*
(funcall *model-selector* backend context)))
(result (if model
(funcall backend-fn prompt system-prompt :model model)
(funcall backend-fn prompt system-prompt))))
(cond ((and (listp result) (eq (getf result :status) :success))
(return (getf result :content)))
((stringp result)
(return result))
(t
(log-message "PROBABILISTIC: Backend ~a failed: ~a"
backend (getf result :message))))))))
(list :type :LOG
:payload (list :text "Neural Cascade Failure: All providers exhausted.")))))
#+end_src
** Cognitive Proposal Generation (think)
The ~think~ function is where the creative brain does its work. It assembles the full context for the LLM: the system identity, the available tools, the current global context from memory, the recent system logs, and any rejection trace from a previous failed proposal. It also collects augment strings from any skill that has registered a ~system-prompt-augment~ function.
A note on the augment system: skills can contribute context-specific mandates to the LLM prompt. For example, the REPL skill injects the "prototype in the REPL first" mandate when the context suggests the agent is editing Lisp code. This keeps domain-specific instructions out of the harness while still ensuring they appear in the prompt when relevant.
The LLM's response is expected to be a plist. If it is, it gets parsed and normalized. If it's a string that starts with ~(~ or ~[~, it's read as Lisp data. If it's neither, it falls back to a REQUEST with a MESSAGE action — the raw text.
** Pre-processing: strip markdown from LLM output
LLMs often wrap structured output in markdown code fences:
```lisp
(:TYPE :REQUEST ...)
```
This function strips the fences so the reader can parse the plist.
;; REPL-VERIFIED: 2026-05-03T13:00:00
#+begin_src lisp
(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))
#+end_src
** Normalize plist keywords
Lisp keywords are case-sensitive. The LLM might produce ~:payload~ or ~:PAYLOAD~ or ~:Payload~ depending on the model. This function normalizes all keyword keys to uppercase to ensure the deterministic engine receives consistent input.
;; REPL-VERIFIED: 2026-05-03T13:00:00
#+begin_src lisp
(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)))
#+end_src
** Think: assemble context and call the LLM
This is the main entry point for the probabilistic engine. Every cognitive cycle goes through here.
The function handles several cases:
- If a triggered skill provides a probabilistic prompt generator, that replaces the raw user input
- If the previous proposal was rejected, the rejection trace is injected into the LLM's context so it can self-correct
- Skills can augment the system prompt with domain-specific mandates via the ~system-prompt-augment~ mechanism
The system prompt assembly order — identity, tools, context, logs, mandates — is intentional: the most dynamic content (mandates from skills) comes last so it has the most influence on the LLM's output.
;; REPL-VERIFIED: 2026-05-03T13:00:00
#+begin_src lisp
(defun think (context)
(let* ((active-skill (find-triggered-skill context))
(tool-belt (generate-tool-belt-prompt))
(global-context (context-assemble-global-awareness))
(system-logs (context-get-system-logs))
(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)
""))
(skill-augments (let ((augments ""))
(maphash (lambda (name skill)
(declare (ignore name))
(let ((aug-fn (skill-system-prompt-augment skill)))
(when aug-fn
(let ((aug-text (ignore-errors (funcall aug-fn context))))
(when (and aug-text (stringp aug-text) (> (length aug-text) 0))
(setf augments (concatenate 'string augments aug-text (string #\Newline))))))))
*skill-registry*)
(when (> (length augments) 0) augments)))
(system-prompt (format nil "IDENTITY: ~a~a~%~%TOOLS:~%~a~%~%CONTEXT:~%~a~%~%LOGS:~%~a~%~a"
assistant-name reflection-feedback tool-belt global-context system-logs
(or skill-augments ""))))
(let* ((thought (backend-cascade-call raw-prompt :system-prompt system-prompt :context context))
(cleaned (markdown-strip thought)))
(if (and cleaned (stringp cleaned) (> (length cleaned) 0) (or (char= (char cleaned 0) #\() (char= (char cleaned 0) #\[)))
(handler-case
(let ((parsed (read-from-string cleaned)))
(if (listp parsed)
(plist-keywords-normalize parsed)
(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."))))))
#+end_src
** Deterministic Engine (cognitive-verify)
The deterministic engine is the strict guard. It receives a proposed action from the probabilistic engine and runs it through every registered deterministic gate, sorted by priority.
Skills register deterministic gates via ~defskill~ with the ~:deterministic~ keyword. Each gate is a function that receives (action context) and returns either:
- A modified action (the gate approves or adjusts the proposal)
- A LOG or EVENT plist (the gate rejects the proposal with a reason)
Gates run in priority order, highest first. If any gate returns a LOG or EVENT, the proposal is rejected immediately and the rejection reason flows back to the probabilistic engine via the rejection trace. If all gates pass, the proposal is approved.
This architecture makes safety compositional: each skill adds one constraint. The bouncer checks secrets. The policy checks explanations. The shell actuator checks destructive commands. No single skill needs to understand the full security model.
;; REPL-VERIFIED: 2026-05-03T13:00:00
#+begin_src lisp
(defun cognitive-verify (proposed-action context)
"Runs all registered deterministic gates against the proposed action.
Returns either a rejection plist (for :LOG or :EVENT errors) or the
modified action (for approval-required or pass)."
(let ((current-action (copy-tree proposed-action))
(approval-needed nil)
(approval-action nil))
(maphash (lambda (name skill)
(declare (ignore name))
(when (skill-deterministic-fn skill)
(let ((gate (skill-deterministic-fn skill)))
(when gate
(let ((result (funcall gate current-action context)))
(cond
;; Approval-required: remember it and continue checking
((eq (getf result :level) :approval-required)
(setf approval-needed t
approval-action (getf (getf result :payload) :action)))
;; Hard rejection: return immediately
((member (getf result :type) '(:LOG :EVENT))
(return-from cognitive-verify result))
;; Normal: update action
(t (setf current-action result))))))))
*skill-registry*)
(if approval-needed
(list :type :EVENT :level :approval-required
:payload (list :sensor :approval-required
:action approval-action))
current-action)))
#+end_src
** Reason Gate (Stage 2)
The reason gate is the pipeline stage that orchestrates Think + Determine. It receives a signal, checks if it requires reasoning (only ~:user-input~ and ~:chat-message~ events do), and runs through the cognitive + verification loop.
The loop has retry logic: up to 3 attempts. If the deterministic engine rejects a proposal, the rejection reason is fed back into the next think call so the LLM can self-correct. This loop — propose, reject, correct, re-propose — is the core mechanism by which the agent improves its own output without human intervention.
The retry limit prevents infinite loops. If the LLM cannot produce a passable proposal within 3 attempts, the last rejection reason is attached to the signal and the acted pipeline sees a failed reasoning cycle.
;; REPL-VERIFIED: 2026-05-03T13:00:00
#+begin_src lisp
;; Alias: reason-gate → loop-gate-reason
(defun reason-gate (signal)
(loop-gate-reason signal))
(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))))))))
#+end_src
* Test Suite
Verifies that the deterministic engine correctly rejects unsafe actions (like ~rm -rf /~) while allowing safe ones.
#+begin_src lisp :tangle ../lisp/core-loop-reason.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
(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)))))
#+end_src