REFAC: Configurable mandatory skills via environment

2026-04-13 17:28:32 -04:00
parent 222a231d40
commit 22e6d3c242
11 changed files with 257 additions and 103 deletions
--- a/src/act.lisp
+++ b/src/act.lisp
@@ -1,65 +1,98 @@
 (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))

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

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

+(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")))))
+
 (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))
--- a/src/loop.lisp
+++ b/src/loop.lisp
@@ -49,6 +49,7 @@
         (env-file (uiop:merge-pathnames* ".local/share/org-agent/.env" (uiop:ensure-directory-pathname home))))
    (when (uiop:file-exists-p env-file) (cl-dotenv:load-env env-file)))
  
+  (initialize-actuators)
  (initialize-all-skills)
  (start-heartbeat)
  
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -54,6 +54,7 @@
   #:decide-gate
   #:dispatch-gate
   #:inject-stimulus
+   #:initialize-actuators
   #:dispatch-action
   #:register-actuator
   
--- a/src/reason.lisp
+++ b/src/reason.lisp
@@ -1,17 +1,16 @@
 (in-package :org-agent)

-;; --- 1. Probabilistic Mechanisms ---
-
 (defvar *probabilistic-backends* (make-hash-table :test 'equal))
 (defvar *provider-cascade* nil)
 (defvar *model-selector-fn* nil)
 (defvar *consensus-enabled-p* nil)

 (defun register-probabilistic-backend (name fn)
+  "Registers a neural provider (e.g., :gemini, :anthropic) with its calling function."
  (setf (gethash name *probabilistic-backends*) fn))

 (defun probabilistic-call (prompt &key (system-prompt "You are the Probabilistic engine.") (cascade nil) (context nil))
-  "Dispatches a neural request through the provider cascade."
+  "Dispatches a neural request through the provider cascade. Returns a Lisp plist or a failure log."
  (let ((backends (or cascade *provider-cascade*)))
    (or (dolist (backend backends)
          (let ((backend-fn (gethash backend *probabilistic-backends*)))
@@ -21,48 +20,58 @@
                     (result (if model 
                                 (funcall backend-fn prompt system-prompt :model model)
                                 (funcall backend-fn prompt system-prompt))))
-                (unless (or (null result) (search ":LOG" result))
+                ;; If the result is valid and doesn't contain a failure log, return it.
+                (unless (or (null result) 
+                            (and (stringp result) (search ":LOG" result)))
                  (return result))))))
-        "(:type :LOG :payload (:text \"Neural Cascade Failure\"))")))
+        ;; Final fallback if all backends in the cascade fail.
+        (list :type :LOG :payload (list :text "Neural Cascade Failure: All providers exhausted.")))))

 (defun think (context)
  "Generates a Lisp action proposal based on current context."
-  (let ((active-skill (find-triggered-skill context))
-        (tool-belt (generate-tool-belt-prompt))
-        (global-context (context-assemble-global-awareness)))
+  (let* ((active-skill (find-triggered-skill context))
+         (tool-belt (generate-tool-belt-prompt))
+         (global-context (context-assemble-global-awareness))
+         (assistant-name (or (uiop:getenv "MEMEX_ASSISTANT") "Agent")))
    (if active-skill
        (let* ((prompt-generator (skill-probabilistic-prompt active-skill))
               (raw-prompt (when prompt-generator (funcall prompt-generator context)))
-               (system-prompt (concatenate 'string "IDENTITY: Actuator for org-agent. MANDATE: ONE Lisp plist. " global-context " " tool-belt)))
+               (system-prompt (format nil "IDENTITY: Actuator for ~a. MANDATE: ONE Lisp plist. ~a ~a" 
+                                      assistant-name global-context tool-belt)))
          (if (and raw-prompt (> (length raw-prompt) 1))
              (let* ((thought (probabilistic-call raw-prompt :system-prompt system-prompt :context context))
-                     (cleaned (string-trim '(#\Space #\Newline #\Tab) thought)))
-                (handler-case (read-from-string cleaned)
-                  (error (c) (list :type :EVENT :payload (list :sensor :syntax-error :code cleaned :error (format nil "~a" c))))))
-              '(:type :LOG :payload (:text "Skill triggered (Deterministic only)"))))
+                     ;; Ensure we are working with a string for read-from-string
+                     (cleaned (if (stringp thought) (string-trim '(#\Space #\Newline #\Tab) thought) thought)))
+                (if (stringp cleaned)
+                    (handler-case (read-from-string cleaned)
+                      (error (c) (list :type :EVENT :payload (list :sensor :syntax-error :code cleaned :error (format nil "~a" c)))))
+                    cleaned))
+              (list :type :LOG :payload (list :text (format nil "Skill '~a' triggered (Deterministic only)" (skill-name active-skill))))))
        nil)))

-;; --- 2. Deterministic Mechanisms ---
-
 (defun deterministic-verify (proposed-action context)
  "Iterates through all skill deterministic-gates sorted by priority."
  (let ((current-action proposed-action)
        (skills nil))
+    ;; 1. Collect and sort active gates
    (maphash (lambda (name skill) (declare (ignore name)) (when (skill-deterministic-fn skill) (push skill skills))) *skills-registry*)
    (setf skills (sort skills #'> :key #'skill-priority))
+    
+    ;; 2. Execute gates sequentially
    (dolist (skill skills)
      (let ((gate (skill-deterministic-fn skill)))
        (setf current-action (funcall gate current-action context))
+        ;; If any gate returns a LOG or EVENT, it has intercepted the action.
        (when (and (listp current-action) (member (getf current-action :type) '(:LOG :EVENT)))
          (harness-log "DETERMINISTIC: Intercepted by skill '~a'" (skill-name skill))
          (return-from deterministic-verify current-action))))
    current-action))

-;; --- 3. The Unified Entrypoint ---
-
 (defun reason-gate (signal)
  "Unified Stage: Combines Probabilistic proposals and Deterministic verification."
+  ;; Only process events that haven't been reasoned yet.
  (unless (eq (getf signal :type) :EVENT) (return-from reason-gate signal))
+  
  (let ((candidate (think signal)))
    (if candidate
        (setf (getf signal :approved-action) (deterministic-verify candidate signal))
--- a/src/skills.lisp
+++ b/src/skills.lisp
@@ -197,9 +197,15 @@
      (return-from initialize-all-skills nil))

    (let ((sorted-files (topological-sort-skills skills-dir)))
-      ;; MANDATE: The System Policy must be present for a safe boot
-      (unless (member "org-skill-policy" sorted-files :key #'pathname-name :test #'string-equal)
-        (error "BOOT FAILURE: org-skill-policy.org not found in skills directory."))
+      ;; MANDATE: Configurable mandatory skills must be present for a safe boot
+      (let* ((mandatory-env (uiop:getenv "MANDATORY_SKILLS"))
+             (mandatory-skills (if mandatory-env 
+                                   (mapcar (lambda (s) (string-trim '(#\Space) s)) 
+                                           (uiop:split-string mandatory-env :separator '(#\,)))
+                                   '("org-skill-policy" "org-skill-bouncer"))))
+        (dolist (req mandatory-skills)
+          (unless (member req sorted-files :key #'pathname-name :test #'string-equal)
+            (error "BOOT FAILURE: Mandatory skill '~a' not found in skills directory." req))))
      
      (harness-log "==================================================")
      (harness-log " LOADER: Initializing ~a skills..." (length sorted-files))