REFAC: Configurable mandatory skills via environment
This commit is contained in:
@@ -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"
|
||||||
|
|||||||
120
literate/act.org
120
literate/act.org
@@ -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
|
||||||
|
|
||||||
|
** 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)
|
(defun act-gate (signal)
|
||||||
"Final Stage: Actuation and feedback generation."
|
"Final Stage: Actuation and feedback generation."
|
||||||
(let* ((approved (getf signal :approved-action))
|
(let* ((approved (getf signal :approved-action))
|
||||||
(type (getf signal :type))
|
(type (getf signal :type))
|
||||||
(depth (getf signal :depth 0))
|
|
||||||
(feedback nil))
|
(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
|
(case type
|
||||||
(:REQUEST (dispatch-action signal signal))
|
(:REQUEST (dispatch-action signal signal))
|
||||||
(:EVENT
|
(:EVENT
|
||||||
(when approved
|
(when approved
|
||||||
(let* ((payload (getf approved :payload))
|
(let* ((target (getf approved :target))
|
||||||
(target (getf approved :target))
|
(result (dispatch-action approved signal)))
|
||||||
(action (or (getf payload :action) (getf approved :action)))
|
;; If the actuator returns a signal (like :tool-output), it becomes the feedback.
|
||||||
(tool-name (or (getf payload :tool) (getf approved :tool)))
|
;; Otherwise, generate tool-output feedback for non-silent actuators.
|
||||||
(tool-args (or (getf payload :args) (getf approved :args))))
|
(cond ((and (listp result) (member (getf result :type) '(:EVENT :LOG)))
|
||||||
(if (and (eq target :tool) (eq action :call))
|
(setf feedback result))
|
||||||
(let ((tool (gethash (string-downcase (string tool-name)) *cognitive-tools*)))
|
((and result (not (member target *silent-actuators*)))
|
||||||
(if tool
|
(setf feedback (list :type :EVENT :depth (1+ (getf signal :depth 0))
|
||||||
(handler-case
|
:reply-stream (getf signal :reply-stream)
|
||||||
(let* ((clean-args (if (and (listp tool-args) (listp (car tool-args))) (car tool-args) tool-args))
|
:payload (list :sensor :tool-output :result result :tool approved)))))))))
|
||||||
(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))))))))))
|
|
||||||
(setf (getf signal :status) :acted)
|
(setf (getf signal :status) :acted)
|
||||||
feedback))
|
feedback))
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|||||||
@@ -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)
|
||||||
|
|
||||||
|
|||||||
@@ -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
|
||||||
|
|
||||||
|
|||||||
@@ -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
|
||||||
(handler-case (read-from-string cleaned)
|
(cleaned (if (stringp thought) (string-trim '(#\Space #\Newline #\Tab) thought) thought)))
|
||||||
(error (c) (list :type :EVENT :payload (list :sensor :syntax-error :code cleaned :error (format nil "~a" c))))))
|
(if (stringp cleaned)
|
||||||
'(:type :LOG :payload (:text "Skill triggered (Deterministic only)"))))
|
(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)))
|
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))
|
||||||
|
|||||||
@@ -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))
|
||||||
|
|||||||
95
src/act.lisp
95
src/act.lisp
@@ -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 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)
|
(defun act-gate (signal)
|
||||||
"Final Stage: Actuation and feedback generation."
|
"Final Stage: Actuation and feedback generation."
|
||||||
(let* ((approved (getf signal :approved-action))
|
(let* ((approved (getf signal :approved-action))
|
||||||
(type (getf signal :type))
|
(type (getf signal :type))
|
||||||
(depth (getf signal :depth 0))
|
|
||||||
(feedback nil))
|
(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
|
(case type
|
||||||
(:REQUEST (dispatch-action signal signal))
|
(:REQUEST (dispatch-action signal signal))
|
||||||
(:EVENT
|
(:EVENT
|
||||||
(when approved
|
(when approved
|
||||||
(let* ((payload (getf approved :payload))
|
(let* ((target (getf approved :target))
|
||||||
(target (getf approved :target))
|
(result (dispatch-action approved signal)))
|
||||||
(action (or (getf payload :action) (getf approved :action)))
|
;; If the actuator returns a signal (like :tool-output), it becomes the feedback.
|
||||||
(tool-name (or (getf payload :tool) (getf approved :tool)))
|
;; Otherwise, generate tool-output feedback for non-silent actuators.
|
||||||
(tool-args (or (getf payload :args) (getf approved :args))))
|
(cond ((and (listp result) (member (getf result :type) '(:EVENT :LOG)))
|
||||||
(if (and (eq target :tool) (eq action :call))
|
(setf feedback result))
|
||||||
(let ((tool (gethash (string-downcase (string tool-name)) *cognitive-tools*)))
|
((and result (not (member target *silent-actuators*)))
|
||||||
(if tool
|
(setf feedback (list :type :EVENT :depth (1+ (getf signal :depth 0))
|
||||||
(handler-case
|
:reply-stream (getf signal :reply-stream)
|
||||||
(let* ((clean-args (if (and (listp tool-args) (listp (car tool-args))) (car tool-args) tool-args))
|
:payload (list :sensor :tool-output :result result :tool approved)))))))))
|
||||||
(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))))))))))
|
|
||||||
(setf (getf signal :status) :acted)
|
(setf (getf signal :status) :acted)
|
||||||
feedback))
|
feedback))
|
||||||
|
|||||||
@@ -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)
|
||||||
|
|
||||||
|
|||||||
@@ -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
|
||||||
|
|
||||||
|
|||||||
@@ -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
|
||||||
(handler-case (read-from-string cleaned)
|
(cleaned (if (stringp thought) (string-trim '(#\Space #\Newline #\Tab) thought) thought)))
|
||||||
(error (c) (list :type :EVENT :payload (list :sensor :syntax-error :code cleaned :error (format nil "~a" c))))))
|
(if (stringp cleaned)
|
||||||
'(:type :LOG :payload (:text "Skill triggered (Deterministic only)"))))
|
(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)))
|
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))
|
||||||
|
|||||||
@@ -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))
|
||||||
|
|||||||
Reference in New Issue
Block a user