REFAC: Configurable mandatory skills via environment

This commit is contained in:
2026-04-13 17:28:32 -04:00
parent 222a231d40
commit 22e6d3c242
11 changed files with 257 additions and 103 deletions

View File

@@ -25,6 +25,14 @@ DAEMON_HOST="0.0.0.0"
HEARTBEAT_INTERVAL=60 HEARTBEAT_INTERVAL=60
DAEMON_SLEEP_INTERVAL=3600 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 # Memex Integration
# Inside Docker, /app/ is the root for consolidated notes # Inside Docker, /app/ is the root for consolidated notes
MEMEX_DIR="/memex" MEMEX_DIR="/memex"

View File

@@ -5,72 +5,128 @@
* Stage 3: Act (act.lisp) * Stage 3: Act (act.lisp)
** Architectural Intent: Actuation ** 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 #+begin_src lisp :tangle ../src/act.lisp
(in-package :org-agent) (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) (defun initialize-actuators ()
"Registers an actuator function. Actuators receive: (ACTION CONTEXT)." "Loads actuator routing defaults from environment variables and registers core harness actuators."
(setf (gethash name *actuator-registry*) fn)) (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) (defun dispatch-action (action context)
"Routes an approved action to its registered physical actuator." "Routes an approved action to its registered physical actuator."
(when (and action (listp action)) (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*))) (actuator-fn (gethash target *actuator-registry*)))
(if actuator-fn (if actuator-fn
(funcall actuator-fn action context) (funcall actuator-fn action context)
(harness-log "ACT ERROR: No actuator for ~a" target))))) (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) (defun execute-system-action (action context)
"Processes internal harness commands like skill creation." "Processes internal harness commands. (ACTUATOR)"
(declare (ignore context)) (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 (case cmd
(:eval (let ((code (getf payload :code))) (:eval (let ((code (getf payload :code)))
(eval (read-from-string code)))) (eval (read-from-string code))))
(:create-skill (let* ((filename (getf payload :filename)) (content (getf payload :content)) (: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)) (with-open-file (out full-path :direction :output :if-exists :supersede) (write-string content out))
(load-skill-from-org full-path))) (load-skill-from-org full-path)))
(:message (harness-log "ACT [System]: ~a" (getf payload :text))) (:message (harness-log "ACT [System]: ~a" (getf payload :text)))
(t (harness-log "ACT ERROR [System]: Unknown command ~s" cmd))))) (t (harness-log "ACT ERROR [System]: Unknown command ~s" cmd)))))
#+end_src
(defun act-gate (signal) ** Cognitive Tool Actuation
"Final Stage: Actuation and feedback generation." The `:tool` actuator handles the execution of registered cognitive tools.
(let* ((approved (getf signal :approved-action))
(type (getf signal :type)) #+begin_src lisp :tangle ../src/act.lisp
(depth (getf signal :depth 0)) (defun execute-tool-action (action context)
(feedback nil)) "Executes a registered cognitive tool. (ACTUATOR)"
(case type (let* ((payload (getf action :payload))
(:REQUEST (dispatch-action signal signal)) (tool-name (getf payload :tool))
(:EVENT (tool-args (getf payload :args))
(when approved (depth (getf context :depth 0))
(let* ((payload (getf approved :payload)) (tool (gethash (string-downcase (string tool-name)) *cognitive-tools*)))
(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 (if tool
(handler-case (handler-case
(let* ((clean-args (if (and (listp tool-args) (listp (car tool-args))) (car tool-args) tool-args)) (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))) (result (funcall (cognitive-tool-body tool) clean-args)))
(setf feedback (list :type :EVENT :depth (1+ depth) :reply-stream (getf signal :reply-stream) (list :type :EVENT :depth (1+ depth) :reply-stream (getf context :reply-stream)
:payload (list :sensor :tool-output :result result :tool tool-name)))) :payload (list :sensor :tool-output :result result :tool tool-name)))
(error (c) (error (c)
(setf feedback (list :type :EVENT :depth (1+ depth) :reply-stream (getf signal :reply-stream) (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)))))) :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) (list :type :EVENT :depth (1+ depth) :reply-stream (getf context :reply-stream)
:payload (list :sensor :tool-error :message "Tool not found"))))) :payload (list :sensor :tool-error :message "Tool not found")))))
(let ((result (dispatch-action approved signal))) #+end_src
(when (and result (not (member target '(:emacs :system-message))))
(setf feedback (list :type :EVENT :depth (1+ depth) :reply-stream (getf signal :reply-stream) ** The Act Gate
:payload (list :sensor :tool-output :result result :tool approved)))))))))) 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))
(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* ((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) (setf (getf signal :status) :acted)
feedback)) feedback))
#+end_src #+end_src

View File

@@ -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)))) (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))) (when (uiop:file-exists-p env-file) (cl-dotenv:load-env env-file)))
(initialize-actuators)
(initialize-all-skills) (initialize-all-skills)
(start-heartbeat) (start-heartbeat)

View File

@@ -75,6 +75,7 @@ flowchart TD
#:decide-gate #:decide-gate
#:dispatch-gate #:dispatch-gate
#:inject-stimulus #:inject-stimulus
#:initialize-actuators
#:dispatch-action #:dispatch-action
#:register-actuator #:register-actuator

View File

@@ -6,24 +6,31 @@
* Stage 2: Reason (reason.lisp) * Stage 2: Reason (reason.lisp)
** Architectural Intent: Unified Cognition ** Architectural Intent: Unified Cognition
The Reason stage is the cognitive engine of the Org-Agent. It unifies two distinct reasoning modes: 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. 1. **Probabilistic Reasoning:** Consulting neural models (LLMs) to generate action proposals based on current context.
2. **Deterministic Reasoning:** Running those proposals through deterministic safety gates (Policy and Validation) to ensure alignment. 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 #+begin_src lisp :tangle ../src/reason.lisp
(in-package :org-agent) (in-package :org-agent)
;; --- 1. Probabilistic Mechanisms ---
(defvar *probabilistic-backends* (make-hash-table :test 'equal)) (defvar *probabilistic-backends* (make-hash-table :test 'equal))
(defvar *provider-cascade* nil) (defvar *provider-cascade* nil)
(defvar *model-selector-fn* nil) (defvar *model-selector-fn* nil)
(defvar *consensus-enabled-p* nil) (defvar *consensus-enabled-p* nil)
(defun register-probabilistic-backend (name fn) (defun register-probabilistic-backend (name fn)
"Registers a neural provider (e.g., :gemini, :anthropic) with its calling function."
(setf (gethash name *probabilistic-backends*) fn)) (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)) (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*))) (let ((backends (or cascade *provider-cascade*)))
(or (dolist (backend backends) (or (dolist (backend backends)
(let ((backend-fn (gethash backend *probabilistic-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 (result (if model
(funcall backend-fn prompt system-prompt :model model) (funcall backend-fn prompt system-prompt :model model)
(funcall backend-fn prompt system-prompt)))) (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)))))) (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) (defun think (context)
"Generates a Lisp action proposal based on current context." "Generates a Lisp action proposal based on current context."
(let ((active-skill (find-triggered-skill context)) (let* ((active-skill (find-triggered-skill context))
(tool-belt (generate-tool-belt-prompt)) (tool-belt (generate-tool-belt-prompt))
(global-context (context-assemble-global-awareness))) (global-context (context-assemble-global-awareness))
(assistant-name (or (uiop:getenv "MEMEX_ASSISTANT") "Agent")))
(if active-skill (if active-skill
(let* ((prompt-generator (skill-probabilistic-prompt active-skill)) (let* ((prompt-generator (skill-probabilistic-prompt active-skill))
(raw-prompt (when prompt-generator (funcall prompt-generator context))) (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)) (if (and raw-prompt (> (length raw-prompt) 1))
(let* ((thought (probabilistic-call raw-prompt :system-prompt system-prompt :context context)) (let* ((thought (probabilistic-call raw-prompt :system-prompt system-prompt :context context))
(cleaned (string-trim '(#\Space #\Newline #\Tab) thought))) ;; 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) (handler-case (read-from-string cleaned)
(error (c) (list :type :EVENT :payload (list :sensor :syntax-error :code cleaned :error (format nil "~a" c)))))) (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)")))) cleaned))
(list :type :LOG :payload (list :text (format nil "Skill '~a' triggered (Deterministic only)" (skill-name active-skill))))))
nil))) 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) (defun deterministic-verify (proposed-action context)
"Iterates through all skill deterministic-gates sorted by priority." "Iterates through all skill deterministic-gates sorted by priority."
(let ((current-action proposed-action) (let ((current-action proposed-action)
(skills nil)) (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*) (maphash (lambda (name skill) (declare (ignore name)) (when (skill-deterministic-fn skill) (push skill skills))) *skills-registry*)
(setf skills (sort skills #'> :key #'skill-priority)) (setf skills (sort skills #'> :key #'skill-priority))
;; 2. Execute gates sequentially
(dolist (skill skills) (dolist (skill skills)
(let ((gate (skill-deterministic-fn skill))) (let ((gate (skill-deterministic-fn skill)))
(setf current-action (funcall gate current-action context)) (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))) (when (and (listp current-action) (member (getf current-action :type) '(:LOG :EVENT)))
(harness-log "DETERMINISTIC: Intercepted by skill '~a'" (skill-name skill)) (harness-log "DETERMINISTIC: Intercepted by skill '~a'" (skill-name skill))
(return-from deterministic-verify current-action)))) (return-from deterministic-verify current-action))))
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) (defun reason-gate (signal)
"Unified Stage: Combines Probabilistic proposals and Deterministic verification." "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)) (unless (eq (getf signal :type) :EVENT) (return-from reason-gate signal))
(let ((candidate (think signal))) (let ((candidate (think signal)))
(if candidate (if candidate
(setf (getf signal :approved-action) (deterministic-verify candidate signal)) (setf (getf signal :approved-action) (deterministic-verify candidate signal))

View File

@@ -310,9 +310,15 @@ The unified orchestrator for the system boot sequence.
(return-from initialize-all-skills nil)) (return-from initialize-all-skills nil))
(let ((sorted-files (topological-sort-skills skills-dir))) (let ((sorted-files (topological-sort-skills skills-dir)))
;; MANDATE: The System Policy must be present for a safe boot ;; MANDATE: Configurable mandatory skills must be present for a safe boot
(unless (member "org-skill-policy" sorted-files :key #'pathname-name :test #'string-equal) (let* ((mandatory-env (uiop:getenv "MANDATORY_SKILLS"))
(error "BOOT FAILURE: org-skill-policy.org not found in skills directory.")) (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 "==================================================")
(harness-log " LOADER: Initializing ~a skills..." (length sorted-files)) (harness-log " LOADER: Initializing ~a skills..." (length sorted-files))

View File

@@ -1,65 +1,98 @@
(in-package :org-agent) (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) (defun initialize-actuators ()
"Registers an actuator function. Actuators receive: (ACTION CONTEXT)." "Loads actuator routing defaults from environment variables and registers core harness actuators."
(setf (gethash name *actuator-registry*) fn)) (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) (defun dispatch-action (action context)
"Routes an approved action to its registered physical actuator." "Routes an approved action to its registered physical actuator."
(when (and action (listp action)) (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*))) (actuator-fn (gethash target *actuator-registry*)))
(if actuator-fn (if actuator-fn
(funcall actuator-fn action context) (funcall actuator-fn action context)
(harness-log "ACT ERROR: No actuator for ~a" target))))) (harness-log "ACT ERROR: No actuator for ~a" target)))))
(defun execute-system-action (action context) (defun execute-system-action (action context)
"Processes internal harness commands like skill creation." "Processes internal harness commands. (ACTUATOR)"
(declare (ignore context)) (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 (case cmd
(:eval (let ((code (getf payload :code))) (:eval (let ((code (getf payload :code)))
(eval (read-from-string code)))) (eval (read-from-string code))))
(:create-skill (let* ((filename (getf payload :filename)) (content (getf payload :content)) (: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)) (with-open-file (out full-path :direction :output :if-exists :supersede) (write-string content out))
(load-skill-from-org full-path))) (load-skill-from-org full-path)))
(:message (harness-log "ACT [System]: ~a" (getf payload :text))) (:message (harness-log "ACT [System]: ~a" (getf payload :text)))
(t (harness-log "ACT ERROR [System]: Unknown command ~s" cmd))))) (t (harness-log "ACT ERROR [System]: Unknown command ~s" cmd)))))
(defun act-gate (signal) (defun execute-tool-action (action context)
"Final Stage: Actuation and feedback generation." "Executes a registered cognitive tool. (ACTUATOR)"
(let* ((approved (getf signal :approved-action)) (let* ((payload (getf action :payload))
(type (getf signal :type)) (tool-name (getf payload :tool))
(depth (getf signal :depth 0)) (tool-args (getf payload :args))
(feedback nil)) (depth (getf context :depth 0))
(case type (tool (gethash (string-downcase (string tool-name)) *cognitive-tools*)))
(: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 (if tool
(handler-case (handler-case
(let* ((clean-args (if (and (listp tool-args) (listp (car tool-args))) (car tool-args) tool-args)) (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))) (result (funcall (cognitive-tool-body tool) clean-args)))
(setf feedback (list :type :EVENT :depth (1+ depth) :reply-stream (getf signal :reply-stream) (list :type :EVENT :depth (1+ depth) :reply-stream (getf context :reply-stream)
:payload (list :sensor :tool-output :result result :tool tool-name)))) :payload (list :sensor :tool-output :result result :tool tool-name)))
(error (c) (error (c)
(setf feedback (list :type :EVENT :depth (1+ depth) :reply-stream (getf signal :reply-stream) (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)))))) :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) (list :type :EVENT :depth (1+ depth) :reply-stream (getf context :reply-stream)
:payload (list :sensor :tool-error :message "Tool not found"))))) :payload (list :sensor :tool-error :message "Tool not found")))))
(let ((result (dispatch-action approved signal)))
(when (and result (not (member target '(:emacs :system-message)))) (defun act-gate (signal)
(setf feedback (list :type :EVENT :depth (1+ depth) :reply-stream (getf signal :reply-stream) "Final Stage: Actuation and feedback generation."
:payload (list :sensor :tool-output :result result :tool approved)))))))))) (let* ((approved (getf signal :approved-action))
(type (getf signal :type))
(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* ((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) (setf (getf signal :status) :acted)
feedback)) feedback))

View File

@@ -49,6 +49,7 @@
(env-file (uiop:merge-pathnames* ".local/share/org-agent/.env" (uiop:ensure-directory-pathname home)))) (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))) (when (uiop:file-exists-p env-file) (cl-dotenv:load-env env-file)))
(initialize-actuators)
(initialize-all-skills) (initialize-all-skills)
(start-heartbeat) (start-heartbeat)

View File

@@ -54,6 +54,7 @@
#:decide-gate #:decide-gate
#:dispatch-gate #:dispatch-gate
#:inject-stimulus #:inject-stimulus
#:initialize-actuators
#:dispatch-action #:dispatch-action
#:register-actuator #:register-actuator

View File

@@ -1,17 +1,16 @@
(in-package :org-agent) (in-package :org-agent)
;; --- 1. Probabilistic Mechanisms ---
(defvar *probabilistic-backends* (make-hash-table :test 'equal)) (defvar *probabilistic-backends* (make-hash-table :test 'equal))
(defvar *provider-cascade* nil) (defvar *provider-cascade* nil)
(defvar *model-selector-fn* nil) (defvar *model-selector-fn* nil)
(defvar *consensus-enabled-p* nil) (defvar *consensus-enabled-p* nil)
(defun register-probabilistic-backend (name fn) (defun register-probabilistic-backend (name fn)
"Registers a neural provider (e.g., :gemini, :anthropic) with its calling function."
(setf (gethash name *probabilistic-backends*) fn)) (setf (gethash name *probabilistic-backends*) fn))
(defun probabilistic-call (prompt &key (system-prompt "You are the Probabilistic engine.") (cascade nil) (context nil)) (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*))) (let ((backends (or cascade *provider-cascade*)))
(or (dolist (backend backends) (or (dolist (backend backends)
(let ((backend-fn (gethash backend *probabilistic-backends*))) (let ((backend-fn (gethash backend *probabilistic-backends*)))
@@ -21,48 +20,58 @@
(result (if model (result (if model
(funcall backend-fn prompt system-prompt :model model) (funcall backend-fn prompt system-prompt :model model)
(funcall backend-fn prompt system-prompt)))) (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)))))) (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) (defun think (context)
"Generates a Lisp action proposal based on current context." "Generates a Lisp action proposal based on current context."
(let ((active-skill (find-triggered-skill context)) (let* ((active-skill (find-triggered-skill context))
(tool-belt (generate-tool-belt-prompt)) (tool-belt (generate-tool-belt-prompt))
(global-context (context-assemble-global-awareness))) (global-context (context-assemble-global-awareness))
(assistant-name (or (uiop:getenv "MEMEX_ASSISTANT") "Agent")))
(if active-skill (if active-skill
(let* ((prompt-generator (skill-probabilistic-prompt active-skill)) (let* ((prompt-generator (skill-probabilistic-prompt active-skill))
(raw-prompt (when prompt-generator (funcall prompt-generator context))) (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)) (if (and raw-prompt (> (length raw-prompt) 1))
(let* ((thought (probabilistic-call raw-prompt :system-prompt system-prompt :context context)) (let* ((thought (probabilistic-call raw-prompt :system-prompt system-prompt :context context))
(cleaned (string-trim '(#\Space #\Newline #\Tab) thought))) ;; 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) (handler-case (read-from-string cleaned)
(error (c) (list :type :EVENT :payload (list :sensor :syntax-error :code cleaned :error (format nil "~a" c)))))) (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)")))) cleaned))
(list :type :LOG :payload (list :text (format nil "Skill '~a' triggered (Deterministic only)" (skill-name active-skill))))))
nil))) nil)))
;; --- 2. Deterministic Mechanisms ---
(defun deterministic-verify (proposed-action context) (defun deterministic-verify (proposed-action context)
"Iterates through all skill deterministic-gates sorted by priority." "Iterates through all skill deterministic-gates sorted by priority."
(let ((current-action proposed-action) (let ((current-action proposed-action)
(skills nil)) (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*) (maphash (lambda (name skill) (declare (ignore name)) (when (skill-deterministic-fn skill) (push skill skills))) *skills-registry*)
(setf skills (sort skills #'> :key #'skill-priority)) (setf skills (sort skills #'> :key #'skill-priority))
;; 2. Execute gates sequentially
(dolist (skill skills) (dolist (skill skills)
(let ((gate (skill-deterministic-fn skill))) (let ((gate (skill-deterministic-fn skill)))
(setf current-action (funcall gate current-action context)) (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))) (when (and (listp current-action) (member (getf current-action :type) '(:LOG :EVENT)))
(harness-log "DETERMINISTIC: Intercepted by skill '~a'" (skill-name skill)) (harness-log "DETERMINISTIC: Intercepted by skill '~a'" (skill-name skill))
(return-from deterministic-verify current-action)))) (return-from deterministic-verify current-action))))
current-action)) current-action))
;; --- 3. The Unified Entrypoint ---
(defun reason-gate (signal) (defun reason-gate (signal)
"Unified Stage: Combines Probabilistic proposals and Deterministic verification." "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)) (unless (eq (getf signal :type) :EVENT) (return-from reason-gate signal))
(let ((candidate (think signal))) (let ((candidate (think signal)))
(if candidate (if candidate
(setf (getf signal :approved-action) (deterministic-verify candidate signal)) (setf (getf signal :approved-action) (deterministic-verify candidate signal))

View File

@@ -197,9 +197,15 @@
(return-from initialize-all-skills nil)) (return-from initialize-all-skills nil))
(let ((sorted-files (topological-sort-skills skills-dir))) (let ((sorted-files (topological-sort-skills skills-dir)))
;; MANDATE: The System Policy must be present for a safe boot ;; MANDATE: Configurable mandatory skills must be present for a safe boot
(unless (member "org-skill-policy" sorted-files :key #'pathname-name :test #'string-equal) (let* ((mandatory-env (uiop:getenv "MANDATORY_SKILLS"))
(error "BOOT FAILURE: org-skill-policy.org not found in skills directory.")) (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 "==================================================")
(harness-log " LOADER: Initializing ~a skills..." (length sorted-files)) (harness-log " LOADER: Initializing ~a skills..." (length sorted-files))