passepartout/harness/act.org

Stage 3: Act (act.lisp)

• Overview
• Implementation
  • Package Context
  • Actuator Configuration
  • Action Dispatch (dispatch-action)
  • System Actuator (execute-system-action)
  • Tool Actuator (execute-tool-action)
  • Tool Result Formatting (format-tool-result)
  • Act Gate (Stage 3)
• Test Suite

Overview

The Act stage dispatches approved actions to registered actuators. After the Probabilistic engine proposes and the Deterministic engine verifies, Act executes the approved action via the appropriate actuator (:cli, :tool, :system, :telegram, :signal, etc.). The actuator registry is extensible — skills can register new actuators at runtime.

Implementation

Package Context

(in-package :opencortex)

Actuator Configuration

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

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

(defun initialize-actuators ()
  "Register core actuators and load configuration."
  (let ((def (uiop:getenv "DEFAULT_ACTUATOR"))
        (silent (uiop:getenv "SILENT_ACTUATORS")))
    (when def
      (setf *default-actuator* (intern (string-upcase def) :keyword)))
    (when silent
      (setf *silent-actuators*
            (mapcar (lambda (s) (intern (string-upcase (string-trim '(#\Space) s)) :keyword))
                    (uiop:split-string silent :separator '(#\,))))))

  (register-actuator :system #'execute-system-action)
  (register-actuator :tool #'execute-tool-action)

  (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))
                                (format stream "~a" (frame-message action))
                                (finish-output stream))))))

Action Dispatch (dispatch-action)

(defun dispatch-action (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 dispatch-action 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 *default-actuator*))
             (target (intern (string-upcase (string raw-target)) :keyword))
             (actuator-fn (gethash target *actuator-registry*)))
        (when (and meta (null (getf action :meta)))
          (setf (getf action :meta) meta))
        (if actuator-fn
            (funcall actuator-fn action context)
            (harness-log "ACT ERROR: No actuator registered for '~s'" target))))))

System Actuator (execute-system-action)

(defun execute-system-action (action context)
  "Execute internal harness commands."
  (declare (ignore context))
  (let* ((payload (getf action :payload))
         (cmd (getf payload :action)))
    (case cmd
      (:eval
       (eval (read-from-string (getf payload :code))))
      (:message
       (harness-log "ACT [System]: ~a" (getf payload :text)))
      (t
       (harness-log "ACT ERROR [System]: Unknown command '~s'" cmd)))))

Tool Actuator (execute-tool-action)

(defun execute-tool-action (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-tools*)))
    (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
                (dispatch-action (list :TYPE :REQUEST :TARGET source 
                                       :PAYLOAD (list :ACTION :MESSAGE :TEXT (format-tool-result 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))))))

Tool Result Formatting (format-tool-result)

(defun format-tool-result (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)

(defun act-gate (signal)
  "Final stage of the metabolic pipeline: Actuation."
  (let* ((approved (getf signal :approved-action))
         (type (getf signal :type))
         (meta (getf signal :meta))
         (source (getf meta :source))
         (feedback nil))
    (when approved
      (let* ((original-type (getf approved :type))
             (verified (deterministic-verify approved signal)))
        (if (and (listp verified) (member (getf verified :type) '(:LOG :EVENT)) (not (member original-type '(:LOG :EVENT))))
            (progn
              (harness-log "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 (dispatch-action signal signal))
      (:LOG (dispatch-action signal signal))
      (:EVENT
       (if approved
           (let* ((target (getf approved :target))
                  (result (dispatch-action approved signal)))
             (cond
               ((and (listp result) (member (getf result :type) '(:EVENT :LOG)))
                (setf feedback result))
               ((and result (not (member target *silent-actuators*)))
                (setf feedback (list :type :EVENT :depth (1+ (getf signal :depth 0)) :meta meta
                                    :payload (list :sensor :tool-output :result result :tool approved))))))
           (when source (dispatch-action signal signal)))))
    (setf (getf signal :status) :acted)
    feedback))

Test Suite

(eval-when (:compile-toplevel :load-toplevel :execute)
  (ql:quickload :fiveam :silent t))

(defpackage :opencortex-pipeline-act-tests
  (:use :cl :fiveam :opencortex)
  (:export #:pipeline-act-suite))

(in-package :opencortex-pipeline-act-tests)

(def-suite pipeline-act-suite :description "Test suite for Act pipeline")
(in-suite pipeline-act-suite)

(test test-act-gate-basic
  (clrhash opencortex::*skills-registry*)
  (let* ((signal (list :type :EVENT :status nil :depth 0 :approved-action '(:target :cli :payload (:text "Hello"))))
         (result (act-gate signal)))
    (is (eq :acted (getf signal :status)))
    (is (null result))))