7.4 KiB
7.4 KiB
Stage 3: Act (act.lisp)
Overview
The Act stage is where cognition meets reality. After the Probabilistic engine proposes and the Deterministic engine verifies, Act executes the approved action.
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 human-readable 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
(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
"Verify that act-gate proceeds normally when no skill intercepts."
(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))))