Files
passepartout/org/core-loop-act.org
Amr Gharbeia 639bc348d9
Some checks failed
Deploy (Gitea) / deploy (push) Failing after 2s
passepartout: v0.4.1 Design Cleanup
- Remove system-prompt-augment mechanism, introduce *standing-mandates*
- Fix false token-overhead claims in DESIGN_DECISIONS + ROADMAP
- Update security vector count 9-10 across all docs and dispatcher docstring
- Rewrite README with agent section, soften aspirational claims
- Register 10 cognitive tools in programming-tools.org with test suite
- Enforce NO-HARDCODED-CONSTANTS in .env.example
- ROADMAP: mark v0.3.x patches DONE, add LOGBOOKs, mark releases
- AGENTS.md: rewrite compact (180 to 50 lines), move refs to CONTRIBUTING
- Normalize org tangle directives to file-level PROPERTY inheritance
2026-05-07 16:44:59 -04:00

361 lines
17 KiB
Org Mode

#+TITLE: Stage 3: Act (act.lisp)
#+AUTHOR: Agent
#+FILETAGS: :harness:act:
#+STARTUP: content
#+PROPERTY: header-args:lisp :tangle ../lisp/core-loop-act.lisp
* Overview: Architectural Intent
The Act stage is where cognition meets reality. After the Probabilistic engine proposes an action and the Deterministic engine verifies it, Act executes it through the appropriate actuator.
An actuator is a function that takes (action context) and performs a physical operation: send a message to the TUI, execute a shell command, call a Telegram API, write to a file. Actuators are registered in a global hash table (~*actuator-registry*~) and dispatched by name.
The key architectural choice: **actuators are not privileged**. The same dispatch mechanism that routes to :shell or :file also routes to :telegram or :signal. There is no special handling for dangerous actuators — safety is enforced at the Reason stage by the deterministic engine, not by Act. This means:
1. Adding a new actuator requires no changes to the core — just register it
2. Safety is centralized in the deterministic gates, not scattered across actuator implementations
3. Every actuator benefits from the same security checks (the Dispatcher, the Policy)
** Why Dispatch-Action Verifies Again?
The Reason stage already ran every proposed action through the deterministic engine. So why does ~loop-gate-act~ call ~cognitive-verify~ again?
Because a skill's deterministic gate runs during Reason, but between Reason and Act, the action might have been transformed by the pipeline (metadata added, format normalized). The last-mile verification catches any transformation that might have introduced an unsafe property. It's the same philosophy as "trust but verify" — the second check is cheap and catches a class of bugs that would otherwise be silent data corruption.
** Contract
1. (loop-gate-act signal): the final pipeline stage. Handles HITL
~:approval-required~ (suspends action), runs last-mile
~cognitive-verify~ on approved actions, dispatches via
~action-dispatch~, sets ~:status :acted~, returns feedback.
2. (act-gate signal): thin alias for ~loop-gate-act~.
3. (action-dispatch approved signal): routes approved actions to
registered actuators by ~:target~ keyword.
* Implementation
** Package Context
#+begin_src lisp
(in-package :passepartout)
#+end_src
** Actuator Configuration
~*actuator-default*~ determines where actions go when no explicit target is specified. Defaults to ~:cli~.
~*actuator-silent*~ lists actuator targets that don't generate tool-output feedback. For example, sending a message to the CLI or Emacs doesn't need to produce a tool-output event — the user can see the message directly. This prevents redundant feedback loops.
;; REPL-VERIFIED: 2026-05-03T13:00:00
#+begin_src lisp
(defvar *actuator-default* :cli
"The actuator used when no explicit target is specified.")
#+end_src
** *actuator-silent*
;; REPL-VERIFIED: 2026-05-03T13:00:00
#+begin_src lisp
(defvar *actuator-silent* '(:cli :system-message :emacs)
"List of actuators that don't generate tool-output feedback.")
#+end_src
** actuator-initialize
;; REPL-VERIFIED: 2026-05-03T13:00:00
#+begin_src lisp
(defun actuator-initialize ()
"Register core actuators and load configuration."
(let ((def (uiop:getenv "DEFAULT_ACTUATOR"))
(silent (uiop:getenv "SILENT_ACTUATORS")))
(when def
(setf *actuator-default* (intern (string-upcase def) :keyword)))
(when silent
(setf *actuator-silent*
(mapcar (lambda (s) (intern (string-upcase (string-trim '(#\Space) s)) :keyword))
(uiop:split-string silent :separator '(#\,))))))
(register-actuator :system #'action-system-execute)
(register-actuator :tool #'action-tool-execute)
(register-actuator :tui (lambda (action context)
(declare (ignore context))
(let* ((meta (getf action :meta))
(stream (getf meta :reply-stream)))
(when (and stream (open-stream-p stream))
;; Enrich response with differentiator visualization data
(setf (getf (getf action :payload) :rule-count)
(if (boundp '*hitl-pending*)
(hash-table-count *hitl-pending*)
0))
(setf (getf (getf action :payload) :foveal-id)
(getf context :foveal-id))
(format stream "~a" (frame-message action))
(finish-output stream))))))
#+end_src
** TUI Differentiator Enrichment (v0.4.0)
The TUI actuator is the last point in the pipeline before the response leaves the daemon. It enriches the action plist with fields that power the TUI's differentiator visualizations:
- ~:rule-count~ = ~(hash-table-count *hitl-pending*)~ — the number of pending HITL actions. The user watches this counter tick as they teach the agent their preferences.
- ~:foveal-id~ = the current foveal focus from the signal context — enables the TUI's focus map status line.
- ~:gate-trace~ — already attached by ~cognitive-verify~, flows through the action plist unchanged.
#+end_src
** Action Dispatch (action-dispatch)
Routes an approved action to its registered actuator. The target is resolved in priority order:
1. The explicit ~:target~ field on the action
2. The source of the original signal (reply to the sender)
3. The default actuator (~:cli~)
Heartbeats are silently dropped here — they should never generate an actuation.
;; REPL-VERIFIED: 2026-05-03T13:00:00
#+begin_src lisp
(defun action-dispatch (action context)
"Route an approved action to its registered actuator."
(let ((payload (proto-get action :payload)))
(when (eq (proto-get payload :sensor) :heartbeat)
(return-from action-dispatch nil))
(when (and action (listp action))
(let* ((meta (proto-get context :meta))
(source (proto-get meta :source))
(raw-target (or (proto-get action :target) source *actuator-default*))
(target (intern (string-upcase (string raw-target)) :keyword))
;; If target is :SYSTEM and we have a live reply-stream, route to :TUI instead
(actual-target (if (and (eq target :system)
(getf meta :reply-stream)
(ignore-errors (open-stream-p (getf meta :reply-stream))))
:tui
target))
(actuator-fn (gethash actual-target *actuator-registry*)))
(when (and meta (null (getf action :meta)))
(setf (getf action :meta) meta))
(if actuator-fn
(funcall actuator-fn action context)
(log-message "ACT ERROR: No actuator registered for '~s'" actual-target))))))
#+end_src
** System Actuator (action-system-execute)
Handles internal harness commands: ~:eval~ (execute arbitrary Lisp) and ~:message~ (log to the harness log). This is how the deterministic engine communicates results back to the user.
;; REPL-VERIFIED: 2026-05-03T13:00:00
#+begin_src lisp
(defun action-system-execute (action context)
"Execute internal harness commands."
(declare (ignore context))
(let* ((payload (getf action :payload))
(cmd (getf payload :action)))
(case cmd
(:eval
(eval (let ((*read-eval* nil)) (read-from-string (getf payload :code)))))
(:message
(log-message "ACT [System]: ~a" (getf payload :text)))
(t
(log-message "ACT ERROR [System]: Unknown command '~s'" cmd)))))
#+end_src
** Tool Actuator (action-tool-execute)
Executes a registered cognitive tool. Cognitive tools are registered via ~def-cognitive-tool~ in the package.lisp and are the primary way the LLM interacts with the outside world.
The function handles:
- Tool dispatch by name (case-insensitive lookup)
- Argument normalization (if the arguments are nested in a list, they're flattened)
- Result formatting (structured results are sent back to the source)
- Error handling (tool errors produce ~:tool-error~ events, not crashes)
The tool's return value is packed into a ~:tool-output~ event and fed back into the pipeline, where it becomes the next perception. This is how the agent "sees" the result of its actions.
;; REPL-VERIFIED: 2026-05-03T13:00:00
#+begin_src lisp
(defun action-tool-execute (action context)
"Execute a registered cognitive tool."
(let* ((payload (getf action :payload))
(tool-name (getf payload :tool))
(tool-args (getf payload :args))
(depth (getf context :depth 0))
(meta (getf context :meta))
(source (getf meta :source))
(tool (gethash (string-downcase (string tool-name)) *cognitive-tool-registry*)))
(if tool
(handler-case
(let* ((clean-args (if (and (listp tool-args) (listp (car tool-args))) (car tool-args) tool-args))
(result (funcall (cognitive-tool-body tool) clean-args)))
(when source
(action-dispatch (list :TYPE :REQUEST :TARGET source
:PAYLOAD (list :ACTION :MESSAGE :TEXT (tool-result-format tool-name result)))
context))
(list :TYPE :EVENT :DEPTH (1+ depth) :META meta
:PAYLOAD (list :SENSOR :tool-output :RESULT result :TOOL tool-name)))
(error (c)
(list :TYPE :EVENT :DEPTH (1+ depth) :META meta
:PAYLOAD (list :SENSOR :tool-error :TOOL tool-name :MESSAGE (format nil "~a" c)))))
(list :TYPE :EVENT :DEPTH (1+ depth) :META meta
:PAYLOAD (list :SENSOR :tool-error :MESSAGE (format nil "Tool '~a' not found" tool-name))))))
#+end_src
** Tool Result Formatting (tool-result-format)
Converts a tool's return value into a human-readable string for display to the user. Handles structured results (plists with ~:status~, ~:content~, ~:message~) and plain values.
;; REPL-VERIFIED: 2026-05-03T13:00:00
#+begin_src lisp
(defun tool-result-format (tool-name result)
"Format a tool result for display."
(if (listp result)
(let ((status (getf result :status))
(content (getf result :content))
(msg (getf result :message)))
(cond
((and (eq status :success) content) (format nil "~a" content))
((and (eq status :error) msg) (format nil "ERROR [~a]: ~a" tool-name msg))
(t (format nil "TOOL [~a] RESULT: ~s" tool-name result))))
(format nil "TOOL [~a] RESULT: ~a" tool-name result)))
#+end_src
** Act Gate (Stage 3)
The final stage of the metabolic pipeline. It receives a signal that has been reasoned (has an ~:approved-action~) and dispatches it.
The gate runs a last-mile deterministic check on the approved action before execution. This catches any issues introduced during pipeline processing (e.g., metadata added by Perceive that changes the action's format).
After dispatch, the gate captures any feedback produced by the actuation (tool output, error events) and returns it to the loop for the next cognitive cycle.
*** loop-gate-act
The main act pipeline stage.
;; REPL-VERIFIED: 2026-05-03T13:00:00
#+begin_src lisp
(defun loop-gate-act (signal)
"Final stage of the metabolic pipeline: Actuation.
For approval-required actions, creates a Flight Plan instead of executing."
(let* ((approved (getf signal :approved-action))
(signal-status (getf signal :status))
(type (getf signal :type))
(meta (getf signal :meta))
(source (getf meta :source))
(feedback nil))
;; HITL: if the approved action requires human approval,
;; create a Flight Plan (Emacs) and HITL entry (all gateways).
(when (and approved
(eq (getf approved :level) :approval-required))
(let* ((payload (getf approved :payload))
(blocked-action (getf payload :action))
(hitl (hitl-create blocked-action)))
(log-message "ACT: Action requires approval — creating Flight Plan + HITL (~a)" (getf hitl :token))
(dispatcher-flight-plan-create blocked-action)
(setf (getf signal :status) :suspended)
(action-dispatch (list :target source
:payload (list :text (getf hitl :message)))
signal)
(setf approved nil)
(setf feedback nil)))
(when approved
(let* ((original-type (getf approved :type))
(verified (cognitive-verify approved signal)))
(if (and (listp verified) (member (getf verified :type) '(:LOG :EVENT))
(not (eq (getf verified :level) :approval-required))
(not (member original-type '(:LOG :EVENT))))
(progn
(log-message "ACT BLOCKED: Action failed last-mile deterministic check.")
(setf (getf signal :approved-action) nil)
(setf feedback verified))
(progn
(setf (getf signal :approved-action) verified)
(setf approved verified)))))
(case type
(:REQUEST (action-dispatch signal signal))
(:LOG (action-dispatch signal signal))
(:EVENT
(if approved
(let* ((target (getf approved :target))
(result (action-dispatch approved signal)))
(cond
((and (listp result) (member (getf result :type) '(:EVENT :LOG)))
(setf feedback result))
((and result (not (member target *actuator-silent*)))
(setf feedback (list :type :EVENT :depth (1+ (getf signal :depth 0)) :meta meta
:payload (list :sensor :tool-output :result result :tool approved))))))
(when source (action-dispatch signal signal)))))
(setf (getf signal :status) :acted)
feedback))
#+end_src
*** act-gate (backward-compatibility alias)
The pipeline gate was originally named ~act-gate~. Code that still
uses the old name can call this alias. New code should call
~loop-gate-act~.
;; REPL-VERIFIED: 2026-05-03T13:00:00
#+begin_src lisp
(defun act-gate (signal)
(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")))
#+end_src