From 22e6d3c2426223c83d8ba74b8e41f241506570a5 Mon Sep 17 00:00:00 2001 From: Amr Gharbeia Date: Mon, 13 Apr 2026 17:28:32 -0400 Subject: [PATCH] REFAC: Configurable mandatory skills via environment --- .env.example | 8 +++ literate/act.org | 120 +++++++++++++++++++++++++++++++------------ literate/loop.org | 1 + literate/package.org | 1 + literate/reason.org | 66 ++++++++++++++++++------ literate/skills.org | 12 +++-- src/act.lisp | 95 +++++++++++++++++++++++----------- src/loop.lisp | 1 + src/package.lisp | 1 + src/reason.lisp | 43 ++++++++++------ src/skills.lisp | 12 +++-- 11 files changed, 257 insertions(+), 103 deletions(-) diff --git a/.env.example b/.env.example index 9423c23..4385b8b 100644 --- a/.env.example +++ b/.env.example @@ -25,6 +25,14 @@ DAEMON_HOST="0.0.0.0" HEARTBEAT_INTERVAL=60 DAEMON_SLEEP_INTERVAL=3600 +# Outbound Communication Defaults +DEFAULT_ACTUATOR="cli" +SILENT_ACTUATORS="cli,system-message,emacs" + +# Core Skill Requirements +# A comma-separated list of skill Org files (without extension) required for boot. +MANDATORY_SKILLS="org-skill-policy,org-skill-bouncer" + # Memex Integration # Inside Docker, /app/ is the root for consolidated notes MEMEX_DIR="/memex" diff --git a/literate/act.org b/literate/act.org index b48cf1e..c814b44 100644 --- a/literate/act.org +++ b/literate/act.org @@ -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 diff --git a/literate/loop.org b/literate/loop.org index 0269236..37aaa2b 100644 --- a/literate/loop.org +++ b/literate/loop.org @@ -80,6 +80,7 @@ The `main` function initializes the environment, loads skills, and starts the he (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) diff --git a/literate/package.org b/literate/package.org index d16639c..f6b90a4 100644 --- a/literate/package.org +++ b/literate/package.org @@ -75,6 +75,7 @@ flowchart TD #:decide-gate #:dispatch-gate #:inject-stimulus + #:initialize-actuators #:dispatch-action #:register-actuator diff --git a/literate/reason.org b/literate/reason.org index 9c67cfb..12217de 100644 --- a/literate/reason.org +++ b/literate/reason.org @@ -6,24 +6,31 @@ * Stage 2: Reason (reason.lisp) ** Architectural Intent: Unified Cognition The Reason stage is the cognitive engine of the Org-Agent. It unifies two distinct reasoning modes: -1. **Probabilistic Reasoning:** Consulting neural models to generate action proposals based on context. -2. **Deterministic Reasoning:** Running those proposals through deterministic safety gates (Policy and Validation) to ensure alignment. +1. **Probabilistic Reasoning:** Consulting neural models (LLMs) to generate action proposals based on current context. +2. **Deterministic Reasoning:** Running those proposals through a series of deterministic safety gates (Policy, Invariants, and Skill-specific validation) to ensure alignment and security. + +** Package and Registry +We initialize the probabilistic backends and the provider cascade which determines the order in which models are consulted. #+begin_src lisp :tangle ../src/reason.lisp (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)) +#+end_src +** Neural Dispatch (Probabilistic) +The `probabilistic-call` function manages the cascade of neural providers. If the primary provider fails, it automatically falls back to the next one in the list. + +#+begin_src lisp :tangle ../src/reason.lisp (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*))) @@ -33,48 +40,73 @@ The Reason stage is the cognitive engine of the Org-Agent. It unifies two distin (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."))))) +#+end_src +** Cognitive Proposal (Think) +The `think` function represents the "intuitive" side of the agent. It identifies the active skill, assembles the global context, and asks the probabilistic engine for a structured action proposal. + +#+begin_src lisp :tangle ../src/reason.lisp (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))) +#+end_src -;; --- 2. Deterministic Mechanisms --- +** Deterministic Verification +Once a proposal is generated, it MUST pass through the deterministic gates. Every skill can register a gate that inspects and potentially modifies or blocks the proposed action. +#+begin_src lisp :tangle ../src/reason.lisp (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)) +#+end_src -;; --- 3. The Unified Entrypoint --- +** The Reason Gate +The entry point for the Reason stage. It orchestrates the transition from probabilistic "thought" to deterministic "verification." +#+begin_src lisp :tangle ../src/reason.lisp (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)) diff --git a/literate/skills.org b/literate/skills.org index 15716c1..0ce6419 100644 --- a/literate/skills.org +++ b/literate/skills.org @@ -310,9 +310,15 @@ The unified orchestrator for the system boot sequence. (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)) diff --git a/src/act.lisp b/src/act.lisp index 6f38e80..2d0477f 100644 --- 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)) diff --git a/src/loop.lisp b/src/loop.lisp index 4eeb826..6626d9c 100644 --- 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) diff --git a/src/package.lisp b/src/package.lisp index 91129b9..fbde7f5 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -54,6 +54,7 @@ #:decide-gate #:dispatch-gate #:inject-stimulus + #:initialize-actuators #:dispatch-action #:register-actuator diff --git a/src/reason.lisp b/src/reason.lisp index 901eaf5..7f3de9c 100644 --- 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)) diff --git a/src/skills.lisp b/src/skills.lisp index 002c5fb..bba745f 100644 --- 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))