amr/passepartout
1
0
Fork 0
Code Issues 15 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

REFAC: Configurable mandatory skills via environment

Browse Source
This commit is contained in:
Amr Gharbeia
2026-04-13 17:28:32 -04:00
parent 222a231d40
commit 22e6d3c242
11 changed files with 257 additions and 103 deletions
Download Patch File Download Diff File Expand all files Collapse all files

120
literate/act.org
View File

@@ -5,72 +5,128 @@
* Stage 3: Act (act.lisp)
** Architectural Intent: Actuation
The Act stage performs the final side-effects of the reasoning engine. It routes approved actions to their registered physical actuators (Emacs, Shell, etc.) and handles the execution of internal system tools.
The Act stage performs the final side-effects of the reasoning engine. It routes approved actions to their registered physical actuators (CLI, Shell, Emacs, etc.) and handles the execution of internal system tools.
** Actuator Configuration
The core harness can be configured via environment variables to operate silently or target different default outputs.
#+begin_src lisp :tangle ../src/act.lisp
(in-package :org-agent)
(defvar *actuator-registry* (make-hash-table :test 'equal))
(defvar *default-actuator* :cli)
(defvar *silent-actuators* '(:cli :system-message :emacs))
(defun register-actuator (name fn)
"Registers an actuator function. Actuators receive: (ACTION CONTEXT)."
(setf (gethash name *actuator-registry*) fn))
(defun initialize-actuators ()
"Loads actuator routing defaults from environment variables and registers core harness actuators."
(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"))
(str:split "," silent)))))
;; Register core harness actuators
(register-actuator :system #'execute-system-action)
(register-actuator :tool #'execute-tool-action))
#+end_src
** Dispatching Actions
The `dispatch-action` function is the primary router. It identifies the target actuator and executes the requested side-effects.
#+begin_src lisp :tangle ../src/act.lisp
(defun dispatch-action (action context)
"Routes an approved action to its registered physical actuator."
(when (and action (listp action))
(let* ((target (or (ignore-errors (getf action :target)) :emacs))
(let* ((target (or (ignore-errors (getf action :target)) *default-actuator*))
(actuator-fn (gethash target *actuator-registry*)))
(if actuator-fn
(funcall actuator-fn action context)
(harness-log "ACT ERROR: No actuator for ~a" target)))))
#+end_src
** Internal System Actions
The `:system` actuator handles internal harness commands like code evaluation and dynamic skill loading.
#+begin_src lisp :tangle ../src/act.lisp
(defun execute-system-action (action context)
"Processes internal harness commands like skill creation."
"Processes internal harness commands. (ACTUATOR)"
(declare (ignore context))
(let* ((payload (ignore-errors (getf action :payload))) (cmd (ignore-errors (getf payload :action))))
(let* ((payload (ignore-errors (getf action :payload)))
(cmd (ignore-errors (getf payload :action))))
(case cmd
(:eval (let ((code (getf payload :code)))
(eval (read-from-string code))))
(:create-skill (let* ((filename (getf payload :filename)) (content (getf payload :content))
(skills-dir (merge-pathnames "skills/" (asdf:system-source-directory :org-agent))) (full-path (merge-pathnames filename skills-dir)))
(skills-dir (merge-pathnames "skills/" (asdf:system-source-directory :org-agent)))
(full-path (merge-pathnames filename skills-dir)))
(with-open-file (out full-path :direction :output :if-exists :supersede) (write-string content out))
(load-skill-from-org full-path)))
(:message (harness-log "ACT [System]: ~a" (getf payload :text)))
(t (harness-log "ACT ERROR [System]: Unknown command ~s" cmd)))))
#+end_src
** Cognitive Tool Actuation
The `:tool` actuator handles the execution of registered cognitive tools.
#+begin_src lisp :tangle ../src/act.lisp
(defun execute-tool-action (action context)
"Executes a registered cognitive tool. (ACTUATOR)"
(let* ((payload (getf action :payload))
(tool-name (getf payload :tool))
(tool-args (getf payload :args))
(depth (getf context :depth 0))
(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)))
(list :type :EVENT :depth (1+ depth) :reply-stream (getf context :reply-stream)
:payload (list :sensor :tool-output :result result :tool tool-name)))
(error (c)
(list :type :EVENT :depth (1+ depth) :reply-stream (getf context :reply-stream)
:payload (list :sensor :tool-error :tool tool-name :message (format nil "~a" c)))))
(list :type :EVENT :depth (1+ depth) :reply-stream (getf context :reply-stream)
:payload (list :sensor :tool-error :message "Tool not found")))))
#+end_src
** The Act Gate
The final stage of the metabolic loop. It performs a "last-mile" safety check before dispatching the action to the registered actuator.
#+begin_src lisp :tangle ../src/act.lisp
(defun act-gate (signal)
"Final Stage: Actuation and feedback generation."
(let* ((approved (getf signal :approved-action))
(type (getf signal :type))
(depth (getf signal :depth 0))
(feedback nil))
;; 1. Last-Mile Safety Check (The Bouncer)
(when approved
(let ((verified (decide approved signal)))
(if (and (listp verified) (member (getf verified :type) '(:LOG :EVENT)))
(progn
(harness-log "ACT BLOCKED: Action failed last-mile deterministic check.")
(setf approved nil)
(setf feedback verified))
(setf approved verified))))
;; 2. Actuation Logic
(case type
(:REQUEST (dispatch-action signal signal))
(:EVENT
(when approved
(let* ((payload (getf approved :payload))
(target (getf approved :target))
(action (or (getf payload :action) (getf approved :action)))
(tool-name (or (getf payload :tool) (getf approved :tool)))
(tool-args (or (getf payload :args) (getf approved :args))))
(if (and (eq target :tool) (eq action :call))
(let ((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)))
(setf feedback (list :type :EVENT :depth (1+ depth) :reply-stream (getf signal :reply-stream)
:payload (list :sensor :tool-output :result result :tool tool-name))))
(error (c)
(setf feedback (list :type :EVENT :depth (1+ depth) :reply-stream (getf signal :reply-stream)
:payload (list :sensor :tool-error :tool tool-name :message (format nil "~a" c))))))
(setf feedback (list :type :EVENT :depth (1+ depth) :reply-stream (getf signal :reply-stream)
:payload (list :sensor :tool-error :message "Tool not found")))))
(let ((result (dispatch-action approved signal)))
(when (and result (not (member target '(:emacs :system-message))))
(setf feedback (list :type :EVENT :depth (1+ depth) :reply-stream (getf signal :reply-stream)
:payload (list :sensor :tool-output :result result :tool approved))))))))))
(let* ((target (getf approved :target))
(result (dispatch-action approved signal)))
;; If the actuator returns a signal (like :tool-output), it becomes the feedback.
;; Otherwise, generate tool-output feedback for non-silent actuators.
(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))
:reply-stream (getf signal :reply-stream)
:payload (list :sensor :tool-output :result result :tool approved)))))))))
(setf (getf signal :status) :acted)
feedback))
#+end_src