passepartout/org/core-act.org

Stage 3: Act (act.lisp)

• Overview: Architectural Intent
  • Why Dispatch-Action Verifies Again?
  • Contract
• Implementation
  • Package Context
  • Actuator Configuration
  • actuator-silent
  • actuator-initialize
  • TUI Differentiator Enrichment (v0.4.0)
  • Action Dispatch (action-dispatch)
  • System Actuator (action-system-execute)
  • Tool Actuator (action-tool-execute)
  • v0.7.2 — Tool Execution Hardening
  • Tool Result Formatting (tool-result-format)
  • Act Gate (Stage 3)
    • loop-gate-act
    • act-gate (backward-compatibility alias)
• Test Suite

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

(in-package :passepartout)

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

(defvar *actuator-default* :cli
  "The actuator used when no explicit target is specified.")

actuator-silent

;; REPL-VERIFIED: 2026-05-03T13:00:00

(defvar *actuator-silent* '(:cli :system-message :emacs)
  "List of actuators that don't generate tool-output feedback.")

actuator-initialize

;; REPL-VERIFIED: 2026-05-03T13:00:00

(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))))))

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

(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))))))

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

(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)))))

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

(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*)))
    ;; v0.7.2: snapshot before destructive tool execution
    (when (and tool (not (cognitive-tool-read-only-p tool)))
      (undo-snapshot))
    (if tool
        (handler-case
            (let* ((clean-args (if (and (listp tool-args) (listp (car tool-args))) (car tool-args) tool-args))
                   (raw-result (call-with-tool-timeout tool-name
                                 (lambda () (funcall (cognitive-tool-body tool) clean-args)))))
              ;; Timeout: propagate error
              (when (and (listp raw-result) (eq (getf raw-result :status) :error))
                (return-from action-tool-execute
                  (list :TYPE :EVENT :DEPTH (1+ depth) :META meta
                        :PAYLOAD (list :SENSOR :tool-error :TOOL tool-name
                                      :MESSAGE (getf raw-result :message)))))
              (when source
                (action-dispatch (list :TYPE :REQUEST :TARGET source 
                                       :PAYLOAD (list :ACTION :MESSAGE :TEXT (tool-result-format tool-name raw-result)))
                                context))
              (list :TYPE :EVENT :DEPTH (1+ depth) :META meta
                    :PAYLOAD (list :SENSOR :tool-output :RESULT raw-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))))))

v0.7.2 — Tool Execution Hardening

(defvar *tool-timeouts* (make-hash-table :test 'equal)
  "Per-tool timeout in seconds. Default 120s.")

;; Defaults: shell=300s, search-files=30s, eval-form=10s
(setf (gethash "shell" *tool-timeouts*) 300)
(setf (gethash "search-files" *tool-timeouts*) 30)
(setf (gethash "eval-form" *tool-timeouts*) 10)

(defun tool-timeout (tool-name)
  "Return timeout for tool-name, default 120 seconds."
  (gethash (string-downcase (string tool-name)) *tool-timeouts* 120))

(defun call-with-tool-timeout (tool-name fn)
  "Execute FN within the timeout for TOOL-NAME.
On timeout, returns (:status :error :message ...)."
  (let ((timeout (tool-timeout tool-name)))
    (handler-case
        (sb-ext:with-timeout timeout
          (funcall fn))
      (sb-ext:timeout (c)
        (declare (ignore c))
        (list :status :error :message
              (format nil "Timed out after ~a second~:p" timeout))))))

(defun verify-write (filepath expected-content)
  "Verify that FILEPATH contains EXPECTED-CONTENT after write.
Returns T on match, logs and returns NIL on mismatch or read error."
  (handler-case
      (let ((actual (uiop:read-file-string filepath)))
        (if (string= expected-content actual)
            t
            (progn
              (log-message "WRITE-VERIFY: Mismatch in ~a" filepath)
              nil)))
    (error (c)
      (log-message "WRITE-VERIFY: Cannot read ~a: ~a" filepath c)
      nil)))

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

(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)))

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

(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))

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

(defun act-gate (signal)
  (loop-gate-act signal))

Test Suite

Verifies that the act gate correctly processes an approved action and sets the signal status to :acted.

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

(test test-tool-timeout-shell
  "Contract v0.7.2: shell timeout is 300 seconds."
  (is (= 300 (passepartout::tool-timeout "shell"))))

(test test-tool-timeout-unknown
  "Contract v0.7.2: unknown tool gets default 120s."
  (is (= 120 (passepartout::tool-timeout "nonexistent-tool"))))

(test test-verify-write-match
  "Contract v0.7.2: verify-write returns T on match."
  (let ((path "/tmp/passepartout-verify-test.org")
        (content "test content"))
    (with-open-file (f path :direction :output :if-exists :supersede)
      (write-string content f))
    (unwind-protect
         (is (passepartout::verify-write path content))
      (ignore-errors (delete-file path)))))

(test test-tool-timeout-enforcement
  "Contract v0.7.2: tool exceeding timeout returns :error with timeout message."
  (setf (gethash "sleep-forever" passepartout::*tool-timeouts*) 1)
  (setf (gethash "sleep-forever" passepartout::*cognitive-tool-registry*)
        (passepartout::make-cognitive-tool :name "sleep-forever"
                                          :read-only-p nil
                                          :body (lambda (args)
                                                  (declare (ignore args))
                                                  (sleep 10)
                                                  "done")))
  (unwind-protect
       (let* ((action '(:type :REQUEST :payload (:tool "sleep-forever" :args nil)))
              (ctx '(:depth 0))
              (result (passepartout::action-tool-execute action ctx)))
         (is (eq :EVENT (getf result :TYPE)))
         (let ((payload (getf result :PAYLOAD)))
           (is (eq :tool-error (getf payload :SENSOR)))
           (is (search "timed out" (string-downcase (getf payload :MESSAGE))))))
    (remhash "sleep-forever" passepartout::*cognitive-tool-registry*)
    (remhash "sleep-forever" passepartout::*tool-timeouts*)))