From 4ab37ceb24966491bf5f077c2f067989ac15f3c4 Mon Sep 17 00:00:00 2001 From: Amr Gharbeia Date: Mon, 13 Apr 2026 09:57:59 -0400 Subject: [PATCH] ARCH: Implement Metabolic Harness (Perceive > Reason > Act) --- literate/act.org | 76 +++++++ literate/loop.org | 422 ++----------------------------------- literate/neurosymbolic.org | 283 ------------------------- literate/perceive.org | 47 +++++ literate/reason.org | 84 ++++++++ org-agent.asd | 39 ++-- src/act.lisp | 65 ++++++ src/loop.lisp | 191 +---------------- src/perceive.lisp | 36 ++++ src/reason.lisp | 71 +++++++ 10 files changed, 428 insertions(+), 886 deletions(-) create mode 100644 literate/act.org delete mode 100644 literate/neurosymbolic.org create mode 100644 literate/perceive.org create mode 100644 literate/reason.org create mode 100644 src/act.lisp create mode 100644 src/perceive.lisp create mode 100644 src/reason.lisp diff --git a/literate/act.org b/literate/act.org new file mode 100644 index 0000000..b48cf1e --- /dev/null +++ b/literate/act.org @@ -0,0 +1,76 @@ +#+TITLE: Stage 3: Act (act.lisp) +#+AUTHOR: Amr +#+FILETAGS: :harness:act: +#+STARTUP: content + +* 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. + +#+begin_src lisp :tangle ../src/act.lisp +(in-package :org-agent) + +(defvar *actuator-registry* (make-hash-table :test 'equal)) + +(defun register-actuator (name fn) + "Registers an actuator function. Actuators receive: (ACTION CONTEXT)." + (setf (gethash name *actuator-registry*) fn)) + +(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)) + (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." + (declare (ignore context)) + (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))) + (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 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)) + (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)))))))))) + (setf (getf signal :status) :acted) + feedback)) +#+end_src diff --git a/literate/loop.org b/literate/loop.org index 287172f..34a4012 100644 --- a/literate/loop.org +++ b/literate/loop.org @@ -1,449 +1,63 @@ -#+TITLE: The Cognitive Loop (loop.lisp) +#+TITLE: The Metabolic Loop (loop.lisp) #+AUTHOR: Amr #+FILETAGS: :harness:loop: #+STARTUP: content -* The Cognitive Loop (loop.lisp) -** Architectural Intent: The Reactive Signal Pipeline - -The core of the ~org-agent~ harness is a functional transformation pipeline. In traditional agent architectures, events are handled through deep, asynchronous recursion, which leads to fragile Lisp stacks and makes it difficult to implement advanced features like multi-model consensus. - -We have evolved the harness into a **Reactive Signal Pipeline**. Every event—whether it is a user keystroke, a heartbeat timer pulse, or a suggested action from an LLM—is treated as a discrete **Signal**. - -Signals move through a series of formal **Gates**. Each gate transforms or validates the signal until it is either physically dispatched to an actuator or safely rejected by the Deterministic Engine. - -*** Advantages of the Pipeline Model: -- **Consensus Ready:** By treating reasoning as a signal moving through a pipe, we can "split" the pipe to query multiple LLM backends simultaneously. A Consensus Gate later in the pipe compares these proposals. -- **Flat Execution:** Using a central orchestrator (~process-signal~) flattens the execution stack. Feedback from tools or errors is re-injected as a new signal rather than creating a nested function call. -- **Micro-Rollbacks:** Because every signal turn is discrete, the harness can snapshot the Object Store before a turn and instantly roll back if a skill crashes. - -** The Signal Pipeline Architecture -#+begin_src mermaid -flowchart TD - S1[Signal: External Stimulus] --> P[Perceive Gate] - S2[Signal: Heartbeat Pulse] --> P - P --> N[Probabilistic Gate] - N --> C[Consensus Gate] - C --> V[Validation Gate] - V --> D[Dispatch Gate] - D -- Feedback Signal --> S1 -#+end_src - -** Package Context -We ensure we are in the correct isolated namespace. +* The Metabolic Loop (loop.lisp) +** Architectural Intent: The Heartbeat +The Metabolic Loop is the high-level coordinator of the Org-Agent. It orchestrates the flow of energy (information) through the system by calling the three metabolic stages in sequence: +1. **Perceive:** Sensory intake. +2. **Reason:** Cognitive processing. +3. **Act:** Physical side-effects. #+begin_src lisp :tangle ../src/loop.lisp (in-package :org-agent) (defvar *interrupt-flag* nil) -#+end_src - -** Interrupt Lock -A thread-safe lock used to signal the pipeline to halt execution gracefully. - -#+begin_src lisp :tangle ../src/loop.lisp (defvar *interrupt-lock* (bt:make-lock "harness-interrupt-lock")) -#+end_src -** Physical Dispatch (dispatch-action) -The final stage of the pipeline. It routes an approved action to its registered physical actuator (Emacs, Shell, etc.). - -#+begin_src lisp :tangle ../src/loop.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)) - (actuator-fn (gethash target *actuator-registry*))) - (if actuator-fn - (funcall actuator-fn action context) - (harness-log "DISPATCH ERROR: No actuator for ~a" target))))) -#+end_src - -** Performance Tracking (harness-track-telemetry) -Updates execution metrics for skills. This allows the harness to monitor which skills are consuming the most time or failing most frequently. - -#+begin_src lisp :tangle ../src/loop.lisp -(defun harness-track-telemetry (skill-name duration status) - "Updates performance metrics for a specific skill." - (when skill-name (bt:with-lock-held (*telemetry-lock*) - (let ((entry (or (gethash skill-name *skill-telemetry*) (list :executions 0 :total-time 0 :failures 0)))) - (incf (getf entry :executions)) (incf (getf entry :total-time) duration) - (when (eq status :rejected) (incf (getf entry :failures))) (setf (gethash skill-name *skill-telemetry*) entry))))) -#+end_src - -** Stimulus Injection (inject-stimulus) -The entry point for all events into the harness. It enqueues raw messages into the pipeline, handling the transition from asynchronous threads to the synchronous pipeline execution. - -#+begin_src lisp :tangle ../src/loop.lisp -(defun inject-stimulus (raw-message &key stream (depth 0)) - "Enqueues a raw message into the reactive signal pipeline, handling async/sync execution and recovery." - (let* ((payload (getf raw-message :payload)) - (sensor (getf payload :sensor)) - ;; Force Chat and Delegation to be async - (async-p (or (getf payload :async-p) (member sensor '(:chat-message :delegation :user-command))))) - (when stream (setf (getf raw-message :reply-stream) stream)) - (if async-p (bt:make-thread (lambda () (restart-case (handler-bind ((error (lambda (c) (harness-log "ASYNC ERROR: ~a" c) (invoke-restart 'skip-event)))) - (process-signal raw-message)) (skip-event () nil))) :name "org-agent-async-task") - (restart-case (handler-bind ((error (lambda (c) (harness-log "SYSTEM ERROR: ~a" c) (invoke-restart 'skip-event)))) (process-signal raw-message)) - (skip-event () (harness-log "SYSTEM RECOVERY: Stimulus dropped.~%")))))) -#+end_src - -** Internal Tool Execution -Handles harness-level operations that are not delegated to external actuators, such as hot-loading skills or evaluating Lisp code for system maintenance. - -#+begin_src lisp :tangle ../src/loop.lisp -(defun execute-system-action (action context) - "Processes internal harness commands like skill creation or environment updates." - (declare (ignore context)) - (let* ((payload (ignore-errors (getf action :payload))) (cmd (ignore-errors (getf payload :action)))) - (case cmd - (:eval (let ((code (getf payload :code))) - (harness-log "ACTUATOR [System] - Evaluating: ~a" code) - (handler-case (let ((result (eval (read-from-string code)))) - (harness-log "ACTUATOR [System] - Result: ~s" result) - result) - (error (c) (harness-log "ACTUATOR ERROR [System] - Eval failed: ~a" c))))) - (: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))) - (harness-log "ACTUATOR [System] - Creating skill ~a..." filename) - (with-open-file (out full-path :direction :output :if-exists :supersede) (write-string content out)) - (load-skill-from-org full-path))) - (:set-cascade (setf *provider-cascade* (getf payload :cascade))) - (:message (harness-log "ACTUATOR [System] - ~a" (getf payload :text))) - (t (harness-log "ACTUATOR [System] - Unknown command ~s" cmd))))) -#+end_src - -** The Reactive Signal Pipeline (process-signal) -This is the core functional loop. It moves a signal through the gates sequentially. - -*** Perceive Gate -The Perceive Gate is responsible for data normalization and sensory intake. It takes raw stimulus and updates the global Object Store graph. - -#+begin_src lisp :tangle ../src/loop.lisp -(defun perceive-gate (signal) - "Initial processing: Normalizes raw stimuli and updates memory." - (let* ((payload (getf signal :payload)) - (type (getf signal :type)) - (sensor (getf payload :sensor))) - (harness-log "GATE [Perceive]: ~a (~a)" type (or sensor "no-sensor")) - (snapshot-object-store) - (cond ((eq type :EVENT) - (case sensor - (:buffer-update (let ((ast (getf payload :ast))) (when ast (ingest-ast ast)))) - (:point-update (let ((element (getf payload :element))) (when element (ingest-ast element)))) - (:interrupt (bt:with-lock-held (*interrupt-lock*) (setf *interrupt-flag* t))))) - ((eq type :RESPONSE) - (harness-log "GATE [Perceive]: Act Result -> ~a" (getf payload :status)))) - (setf (getf signal :status) :perceived) - signal)) -#+end_src - -*** Probabilistic Gate -The Probabilistic Gate invokes the neural reasoning engine. It takes the current context and generates a list of "intuitions" or proposed actions. - -#+begin_src lisp :tangle ../src/loop.lisp -(defun neuro-gate (signal) - "Probabilistic: Neural intuition and proposed actions." - (unless (eq (getf signal :type) :EVENT) - (return-from neuro-gate signal)) - (harness-log "GATE [Probabilistic]: Consulting LLM...") - (let ((thoughts (think signal))) - (setf (getf signal :proposals) (if (and (listp thoughts) (listp (car thoughts))) - thoughts - (if thoughts (list thoughts) nil))) - (setf (getf signal :status) :thought) - signal)) -#+end_src - -*** Consensus Gate -When multiple LLM backends provide diverging thoughts, the Consensus Gate resolves them into a single candidate action. - -#+begin_src lisp :tangle ../src/loop.lisp -(defun resolve-consensus (proposals signal) - "Resolves diverging proposals by selecting the most consistent one." - (declare (ignore signal)) - (harness-log "CONSENSUS: ~a proposals found. Resolving..." (length proposals)) - (let ((counts (make-hash-table :test 'equal))) - (dolist (p proposals) (incf (gethash p counts 0))) - (let ((winner (first proposals)) (max-count 0)) - (maphash (lambda (p count) (when (> count max-count) (setq max-count count winner p))) counts) - (harness-log "CONSENSUS: Winner selected with ~a votes." max-count) - winner))) - -(defun consensus-gate (signal) - "Resolves multiple proposals into a single candidate action." - (let ((proposals (getf signal :proposals))) - (if (and proposals (cdr proposals)) - (let ((winner (resolve-consensus proposals signal))) - (setf (getf signal :candidate) winner)) - (setf (getf signal :candidate) (first proposals))) - (setf (getf signal :status) :consensus) - signal)) -#+end_src - -*** Decide Gate -The Decide Gate is the final deterministic safety net. It runs the candidate action through all loaded skill safety gates (The Deterministic Engine) before allowing it to proceed. - -#+begin_src lisp :tangle ../src/loop.lisp -(defun decide-gate (signal) - "Deterministic: Deterministic safety and validation." - (let ((candidate (getf signal :candidate))) - (if candidate - (let* ((normalized-candidate (if (listp candidate) candidate (list :type :RESPONSE :payload (list :text candidate)))) - (decision (decide normalized-candidate signal))) - (setf (getf signal :approved-action) decision)) - (setf (getf signal :approved-action) nil)) - (setf (getf signal :status) :decided) - signal)) -#+end_src - -*** Dispatch Gate -The Dispatch Gate performs the final actuation. If the action produces output (like a tool result), it returns a new signal to be re-injected into the pipeline. - -#+begin_src lisp :tangle ../src/loop.lisp -(defun dispatch-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)) - (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)))))))))) - (setf (getf signal :status) :dispatched) - feedback)) -#+end_src - -*** Pipeline Orchestrator (process-signal) -This is the entry point to the functional pipeline. It iterates through the gates and handles micro-rollbacks if a pipeline stage crashes. - -#+begin_src lisp :tangle ../src/loop.lisp (defun process-signal (signal) - "The entry point to the Reactive Signal Pipeline." + "The entry point to the Metabolic Pipeline: Perceive -> Reason -> Act." (let ((current-signal signal)) (loop while current-signal do (let ((depth (getf current-signal :depth 0))) - (when (> depth 10) (harness-log "PIPELINE ERROR: Max depth reached.") (return nil)) + (when (> depth 10) (harness-log "METABOLISM ERROR: Max depth reached.") (return nil)) (when (bt:with-lock-held (*interrupt-lock*) *interrupt-flag*) - (harness-log "PIPELINE: Interrupted.") + (harness-log "METABOLISM: Interrupted.") (bt:with-lock-held (*interrupt-lock*) (setf *interrupt-flag* nil)) (return nil)) (handler-case (progn (setf current-signal (perceive-gate current-signal)) - (setf current-signal (neuro-gate current-signal)) - (setf current-signal (consensus-gate current-signal)) - (setf current-signal (decide-gate current-signal)) - (setf current-signal (dispatch-gate current-signal))) + (setf current-signal (reason-gate current-signal)) + (setf current-signal (act-gate current-signal))) (error (c) - (harness-log "PIPELINE CRASH: ~a - Initiating Micro-Rollback." c) + (harness-log "METABOLISM CRASH: ~a - Initiating Micro-Rollback." c) (rollback-object-store 0) (let ((sensor (ignore-errors (getf (getf current-signal :payload) :sensor)))) (if (or (> depth 2) (member sensor '(:loop-error :tool-error))) (setf current-signal nil) (setf current-signal (list :type :EVENT :depth (1+ depth) :reply-stream (getf current-signal :reply-stream) :payload (list :sensor :loop-error :message (format nil "~a" c) :depth depth))))))))))) -#+end_src -** Delegation Mechanisms -Allows the harness to hand off tasks to specialized background agents or processes. - -#+begin_src lisp :tangle ../src/loop.lisp -(defun delegate-task (task-id recipient &key context) - "Enqueues a task for another agent or background process." - (harness-log "ORCHESTRATOR: Delegating task ~a to ~a" task-id recipient) - (inject-stimulus (list :type :EVENT - :payload (list :sensor :delegation - :task-id task-id - :recipient recipient - :context context)))) -#+end_src - -** Heartbeat Mechanism -Periodically injects a "pulse" into the system to trigger temporal skills. - -#+begin_src lisp :tangle ../src/loop.lisp -(defvar *default-heartbeat-interval* 60 "Default interval for the system heartbeat pulse in seconds.") +(defvar *default-heartbeat-interval* 60) (defvar *heartbeat-thread* nil) (defun start-heartbeat (&optional (interval *default-heartbeat-interval*)) - "Spawns a thread that periodically injects a heartbeat stimulus." (setf *heartbeat-thread* (bt:make-thread (lambda () (loop (sleep interval) - (harness-log "HARNESS: Heartbeat pulse...") (inject-stimulus (list :type :EVENT :payload (list :sensor :heartbeat :unix-time (get-universal-time)))))) :name "org-agent-heartbeat"))) -(defun stop-heartbeat () - "Gracefully terminates the heartbeat pulse thread." - (when (and *heartbeat-thread* (bt:thread-alive-p *heartbeat-thread*)) - (bt:destroy-thread *heartbeat-thread*) - (setf *heartbeat-thread* nil))) -#+end_src - -** Main Entry Point -The execution entry point for the harness binary. - -#+begin_src lisp :tangle ../src/loop.lisp (defun main () - "The entry point for the compiled standalone binary." + "Entry point for the Skeleton MVP." (let* ((home (uiop:getenv "HOME")) (env-file (uiop:merge-pathnames* ".local/share/org-agent/.env" (uiop:ensure-directory-pathname home)))) - (if (uiop:file-exists-p env-file) - (progn - (format t "HARNESS: Loading environment from ~a~%" env-file) - (cl-dotenv:load-env env-file)) - (format t "HARNESS ERROR: .env not found at ~a~%" env-file))) - (let ((interval (or (ignore-errors (parse-integer (uiop:getenv "HEARTBEAT_INTERVAL") :junk-allowed t)) *default-heartbeat-interval*))) - (format t "HARNESS: Heartbeat interval set to ~a seconds.~%" interval) - (start-daemon :interval interval)) + (when (uiop:file-exists-p env-file) (cl-dotenv:load-env env-file))) + (initialize-all-skills) + (start-heartbeat) (loop (sleep 3600))) #+end_src - -* Phase E: Chaos (Verification) -The Reactive Signal Pipeline must be empirically verified through automated testing to ensure architectural integrity. - -#+begin_src lisp :tangle ../tests/pipeline-tests.lisp -(defpackage :org-agent-pipeline-tests - (:use :cl :fiveam :org-agent)) -(in-package :org-agent-pipeline-tests) - -(def-suite pipeline-suite - :description "Verification of the Reactive Signal Pipeline.") -(in-suite pipeline-suite) - -(defun setup-mock-skills () - "Register mock skills for testing." - (clrhash org-agent::*skills-registry*) - (org-agent::defskill :mock-refactor - :priority 100 - :trigger (lambda (ctx) (eq (getf (getf ctx :payload) :command) :organize-subtree)) - :neuro (lambda (ctx) "Mock neuro prompt") - :symbolic (lambda (action ctx) - `(:type :REQUEST :id 123 - :payload (:action :refactor-subtree - :target-id nil - :properties (("ID" . "node-123")))))) - (org-agent::defskill :mock-safety - :priority 50 - :trigger (lambda (ctx) t) ; always triggers - :neuro (lambda (ctx) "Mock neuro") - :symbolic (lambda (action ctx) nil))) ; rejects everything - -(test test-perceive-gate - "Perceive gate should update the object store and normalize signal." - (clrhash org-agent::*object-store*) - (let* ((signal (list :type :EVENT :payload (list :sensor :buffer-update :ast (list :type :HEADLINE :properties (list :ID "test-node" :TITLE "Test") :contents nil)))) - (result (perceive-gate signal))) - (is (eq :perceived (getf result :status))) - (is (not (null (gethash "test-node" org-agent::*object-store*)))))) - -(test test-decide-gate-safety - "Decide gate should block unsafe LLM proposals." - (setup-mock-skills) - (let* ((candidate (list :type :REQUEST :payload (list :action :eval :code "(shell-command \"rm -rf /\")"))) - (signal (list :type :EVENT :candidate candidate)) - (result (decide-gate signal))) - (is (eq :decided (getf result :status))) - (let ((approved (getf result :approved-action))) - (is (eq :LOG (getf approved :type))) - (is (search "Action rejected by skill heuristics" (getf (getf approved :payload) :text)))))) - -(test test-pipeline-flow-flat - "Verify that process-signal correctly executes a signal through gates." - (setup-mock-skills) - (clrhash org-agent::*object-store*) - (let ((signal (list :type :EVENT :payload (list :sensor :buffer-update)))) - (process-signal signal) - (pass "Pipeline completed execution."))) - -(test test-depth-limiting - "Verify that the pipeline terminates runaway feedback loops." - (let ((runaway-signal (list :type :EVENT :depth 11 :payload (list :sensor :heartbeat)))) - (is (null (process-signal runaway-signal))))) - -(test test-env-loading - "Verify that environment variables are accessible." - (setf (uiop:getenv "LLM_ENDPOINT") "http://mock") - (setf (uiop:getenv "MEMEX_USER") "Amr") - (is (not (null (uiop:getenv "LLM_ENDPOINT")))) - (is (stringp (org-agent::get-env "MEMEX_USER")))) - -(test test-path-resolution - "Verify that context-resolve-path expands environment variables." - (setf (uiop:getenv "MEMEX_USER") "Amr") - (let ((path "$MEMEX_USER/test")) - (is (search "Amr/test" (context-resolve-path path))))) - -(test test-skill-dependencies - "Verify that resolve-skill-dependencies correctly flattens the graph." - (setup-mock-skills) - (org-agent::defskill :mock-dependent - :priority 10 - :dependencies (list "mock-safety") - :trigger (lambda (ctx) nil) - :neuro nil - :symbolic nil) - (let ((deps (org-agent::resolve-skill-dependencies "mock-dependent"))) - (is (member "mock-safety" deps :test #'string-equal)) - (is (member "mock-dependent" deps :test #'string-equal)))) - -(test test-log-buffering - "Verify that harness-log correctly populates the system logs." - (harness-log "Engineering TEST LOG") - (let ((logs (context-get-system-logs 5))) - (is (cl:some (lambda (line) (search "Engineering TEST LOG" line)) logs)))) - -(test test-global-awareness-assembly - "Verify that context-assemble-global-awareness reports active projects." - (clrhash org-agent::*object-store*) - (ingest-ast (list :type :HEADLINE :properties (list :ID "proj-1" :TITLE "Project Alpha" :TAGS "project") :contents nil)) - (let ((awareness (context-assemble-global-awareness))) - (is (search "Project Alpha" awareness)) - (is (search "proj-1" awareness)))) - -(test test-micro-rollback - "Verify that a pipeline crash triggers an automatic Object Store rollback." - (clrhash org-agent::*object-store*) - (clrhash org-agent::*history-store*) - (setf org-agent::*object-store-snapshots* nil) - ;; State A - (ingest-ast (list :type :HEADLINE :properties (list :ID "node-1" :TITLE "State A") :contents nil)) - (setup-mock-skills) - (org-agent::defskill :crashing-skill - :priority 200 - :trigger (lambda (ctx) t) - :neuro (lambda (ctx) (list :type :REQUEST :payload (list :action :eval :code "(error \"BOOM\")"))) - :symbolic (lambda (action ctx) (error "CRASH IN DETERMINISTIC ENGINE"))) - (process-signal (list :type :EVENT :payload (list :sensor :test))) - ;; Verify that we are still in State A - (let ((obj (lookup-object "node-1"))) - (is (not (null obj))) - (is (equal (getf (org-object-attributes obj) :TITLE) "State A")))) -#+end_src diff --git a/literate/neurosymbolic.org b/literate/neurosymbolic.org deleted file mode 100644 index fefd0d2..0000000 --- a/literate/neurosymbolic.org +++ /dev/null @@ -1,283 +0,0 @@ -#+TITLE: The Neurosymbolic Bridge (neuro.lisp & symbolic.lisp) -#+AUTHOR: Amr -#+FILETAGS: :kernel:neuro:symbolic: -#+STARTUP: content - -* The Neurosymbolic Bridge (neuro.lisp & symbolic.lisp) -*** The Neurosymbolic Loop - -In our loop, the Probabilistic Engine never speaks to the world directly. It only proposes "thoughts" to the Deterministic Engine. the Deterministic Engine, the Lisp harness, evaluates these thoughts against a chain of symbolic safety gates (Skills) before any action is actually dispatched to an actuator (Emacs, Shell, etc.). - -#+begin_src mermaid -flowchart TD - Stimulus[External Stimulus/Signal] --> Perceive[Perceive: Skill Trigger] - Perceive --> Probabilistic[Probabilistic Engine: LLM] - Probabilistic --> Proposal[Lisp Action Proposal] - Proposal --> Deterministic[Deterministic Engine: Lisp Gates] - Deterministic --> Gate1[Safety Gate: Skill A] - Gate1 --> Gate2[Safety Gate: Skill B] - Gate2 --> Verified[Verified Action] - Verified --> Dispatch[Dispatch: Actuator] - - style Probabilistic fill:#f9f,stroke:#333,stroke-width:2px - style Deterministic fill:#bbf,stroke:#333,stroke-width:2px -#+end_src - -*** Sovereign Decoupling (The Thin Harness) - -The harness files ~neuro.lisp~ and ~symbolic.lisp~ are intentionally "Thin Harnesses." They do not know how to talk to Google Gemini or Anthropic Claude; they do not know what a "Bouncer" or a "Token Accountant" is. Instead, they provide the **protocol** for these behaviors. - -By moving the "Fat" logic (vendor APIs, security rules) into **Skills**, we achieve total sovereign decoupling. You can swap your LLM provider or your security policy without ever touching the harness. - -* Probabilistic Engine (neuro.lisp) -The Probabilistic engine handles the interface with LLM providers, providing a unified probabilistic space regardless of the underlying model. - -** Package Context -#+begin_src lisp :tangle ../src/neuro.lisp -(in-package :org-agent) -#+end_src - -** Probabilistic Backends Registry -The harness maintains a neutral registry of backends. Skills (like the LLM Gateway) register themselves here to provide actual neural reasoning capabilities. - -#+begin_src lisp :tangle ../src/neuro.lisp -(defvar *neuro-backends* (make-hash-table :test 'equal)) -#+end_src - -** Provider Cascade -The ordered list of backends to attempt for neural reasoning. This list is ~nil~ by default and must be populated by skills (e.g., the LLM Gateway or Token Accountant) during the harness boot sequence. - -#+begin_src lisp :tangle ../src/neuro.lisp -(defvar *provider-cascade* nil) -#+end_src - -** Register Probabilistic Backend -A simple mapping from a keyword identifier to a backend implementation function. - -#+begin_src lisp :tangle ../src/neuro.lisp -(defun register-neuro-backend (name fn) (setf (gethash name *neuro-backends*) fn)) -#+end_src - -** Model Selector Function -A hook for dynamic model selection. A skill might look at the current context and decide to use a "cheap" model for summaries and an "expensive" model for coding tasks. - -#+begin_src lisp :tangle ../src/neuro.lisp -(defvar *model-selector-fn* nil "A function called with (provider context) to return a model ID.") -#+end_src - -** Probabilistic Dispatch (ask-neuro) -This is the primary entrance to the Probabilistic engine. It implements two modes of operation: -1. **Sequential Cascade:** Attempt backends one by one until success. -2. **Parallel Consensus:** Query multiple backends simultaneously to resolve hallucinations or select the best "thought." - -#+begin_src mermaid -sequenceDiagram - participant Harness - participant ProviderA as LLM 1 - participant ProviderB as LLM 2 - Harness->>ProviderA: Parallel Query - Harness->>ProviderB: Parallel Query - ProviderA-->>Harness: Suggestion A - ProviderB-->>Harness: Suggestion B - Harness->>Harness: Resolve Consensus -#+end_src - -#+begin_src lisp :tangle ../src/neuro.lisp -(defvar *consensus-enabled-p* nil "If T, ask-neuro queries all backends in parallel.") - -(defun ask-neuro (prompt &key (system-prompt "You are the Probabilistic engine of a Neurosymbolic Lisp Machine.") (cascade nil) (context nil)) - "Dispatches a neural request through the provider cascade or parallel consensus." - (let ((backends (cond - ((and cascade (listp cascade)) cascade) - ((functionp cascade) (funcall cascade context)) - (t *provider-cascade*)))) - (if *consensus-enabled-p* - ;; PARALLEL CONSENSUS MODE - (let ((results nil) - (threads nil) - (lock (bt:make-lock))) - (dolist (backend backends) - (let ((backend-fn (gethash backend *neuro-backends*))) - (when backend-fn - (push (bt:make-thread - (lambda () - (harness-log "PROBABILISTIC [Consensus]: Querying backend ~a..." backend) - (let* ((model (when *model-selector-fn* (funcall *model-selector-fn* backend context))) - (result (ignore-errors - (if model - (funcall backend-fn prompt system-prompt :model model) - (funcall backend-fn prompt system-prompt))))) - (bt:with-lock-held (lock) - (push result results))))) - threads)))) - ;; Wait for all threads with a timeout (e.g., 30s) - (let ((start-time (get-universal-time))) - (loop while (and (< (length results) (length threads)) - (< (- (get-universal-time) start-time) 30)) - do (sleep 0.1))) - ;; Return the list of raw results (filtering out nils or errors) - (let ((valid-results (remove-if-not #'stringp results))) - (if valid-results - (format nil "~{~a~^|CONSENSUS-SEP|~}" valid-results) - "(:type :LOG :payload (:text \"Neural Consensus Failure\"))"))) - - ;; SEQUENTIAL CASCADE MODE - (or (dolist (backend backends) - (let ((backend-fn (gethash backend *neuro-backends*))) - (when backend-fn - (harness-log "PROBABILISTIC: Attempting backend ~a..." backend) - (let* ((model (when *model-selector-fn* (funcall *model-selector-fn* backend context))) - (result (if model - (funcall backend-fn prompt system-prompt :model model) - (funcall backend-fn prompt system-prompt)))) - (unless (or (null result) - (and (stringp result) (search ":LOG" result) (or (search "Failure" result) (search "missing" result)))) - (return result)))))) - "(:type :LOG :payload (:text \"Neural Cascade Failure\"))")))) -#+end_src - -** Probabilistic Reasoning (think) -The ~think~ function is where the "Neuro" meets the "Symbolic." It gathers the global awareness context (Peripheral Vision), the tool definitions (The Tool Belt), and any skill-specific triggers to form the final prompt. - -Crucially, it mandates that the output be a Common Lisp property list, forcing the LLM to "think in Lisp." - -#+begin_src lisp :tangle ../src/neuro.lisp -(defun think (context) - "Invokes the neural Probabilistic engine to propose a Lisp action based on context." - (let ((active-skill (find-triggered-skill context)) - (tool-belt (generate-tool-belt-prompt)) - (global-context (context-assemble-global-awareness))) - (if active-skill - (progn - (harness-log "PROBABILISTIC: Engaging skill '~a'~%" (skill-name active-skill)) - (let* ((prompt-generator (skill-neuro-prompt active-skill)) - (raw-prompt (when prompt-generator (funcall prompt-generator context))) - (full-system-prompt (concatenate 'string - "ACTUATOR IDENTITY: You are the pure Lisp actuator for the org-agent kernel. -MANDATE: Output EXACTLY ONE Common Lisp property list starting with (:type :REQUEST). -ZERO CONVERSATION: Do not explain. Do not say 'Okay'. Do not use markdown blocks. -STRICT RULE: Do not output multiple lists. Do not chain multiple requests. -DO NOT embed tool calls inside text strings. - -" - global-context - " -" - tool-belt - " -IMPORTANT: To reply to the user, you MUST use: -(:type :REQUEST :target :emacs :action :insert-at-end :buffer \"*org-agent-chat*\" :text \"* \") - -To call a tool, you MUST use: -(:type :REQUEST :target :tool :action :call :tool \"\" :args (:arg1 \"val\")) - -"))) - (if (and raw-prompt (> (length raw-prompt) 1)) - (let* ((thought (ask-neuro raw-prompt :system-prompt full-system-prompt :context context)) - (raw-thoughts (cl-ppcre:split (cl-ppcre:quote-meta-chars "|CONSENSUS-SEP|") thought)) - (suggestions nil)) - (dolist (raw-thought raw-thoughts) - (harness-log "PROBABILISTIC RAW: ~a~%" raw-thought) - (let* ((cleaned-thought - (let ((match (cl-ppcre:scan-to-strings "(?s)```(?:lisp)?\\n?(.*?)\\n?```" raw-thought))) - (if match - (let ((regs (nth-value 1 (cl-ppcre:scan-to-strings "(?s)```(?:lisp)?\\n?(.*?)\\n?```" raw-thought)))) - (if (and regs (> (length regs) 0)) (elt regs 0) raw-thought)) - (string-trim '(#\Space #\Newline #\Tab) raw-thought)))) - (suggestion (handler-case (read-from-string cleaned-thought) - (error (c) - ;; EMIT ASYNCHRONOUS REPAIR STIMULUS - (list :type :EVENT :payload - (list :sensor :syntax-error - :code cleaned-thought - :error (format nil "~a" c))))))) - (harness-log "PROBABILISTIC Suggestion: ~a~%" cleaned-thought) - (when (and suggestion (listp suggestion)) - (push suggestion suggestions)))) - (if (and *consensus-enabled-p* suggestions) - (nreverse suggestions) - (first (nreverse suggestions)))) - '(:type :LOG :payload (:text "Skill triggered (Deterministic only)"))))) - nil))) -#+end_src - -** Prompt Meta-Cognition (distill-prompt) -Even the Probabilistic engine can benefit from introspection. This function allows the agent to observe its own prompts and successful results to distill them into reusable templates. - -#+begin_src lisp :tangle ../src/neuro.lisp -(defun distill-prompt (full-prompt successful-output) - (let ((system-instr "You are a Meta-Cognitive Prompt Architect. DISTILL into template.")) - (ask-neuro (format nil "PROMPT: ~a~%RESULT: ~a" full-prompt successful-output) :system-prompt system-instr))) -#+end_src - - -* Deterministic Engine (symbolic.lisp) -The Deterministic engine is the deterministic gatekeeper that ensures all proposed actions—whether from the user or from the neural engine—are safe and logically valid. - -As a "Thin Harness," the Deterministic engine does not contain specific security rules or task integrity checks. Instead, it provides a priority-based dispatcher that iterates through all loaded skills to validate or transform proposed actions. - -** Package Context -#+begin_src lisp :tangle ../src/symbolic.lisp -(in-package :org-agent) -#+end_src - -** Validation Gate (decide) -This is the **Supervisor**. It intercepts every action proposal and runs it through the symbolic gates of all registered skills, sorted by priority. - -This sequential chain allows for multi-layered defense: -1. **Low Priority Gates:** Suggest refinements or logging. -2. **Medium Priority Gates:** Transform actions (e.g., adding project IDs). -3. **High Priority Gates:** Absolute security blocks (e.g., the Bouncer blocking shell access). - -#+begin_src mermaid -flowchart LR - Proposal[Proposal] --> SkillA[Skill A: Priority 10] - SkillA --> SkillB[Skill B: Priority 50] - SkillB --> SkillC[Skill C: Priority 100] - SkillC --> Verified[Verified Action] - - style SkillC fill:#fbb,stroke:#333 -#+end_src - -#+begin_src lisp :tangle ../src/symbolic.lisp -(defun decide (proposed-action context) - "The Deterministic Safety Gate: iterates through all skill symbolic-gates sorted by priority." - (let ((current-action proposed-action) - (skills nil)) - ;; 1. Collect all skills with symbolic gates - (maphash (lambda (name skill) - (declare (ignore name)) - (when (skill-symbolic-fn skill) - (push skill skills))) - *skills-registry*) - - ;; 2. Sort skills by priority (highest first) - (setf skills (sort skills #'> :key #'skill-priority)) - - ;; 3. Execute symbolic gates sequentially - (dolist (skill skills) - (let ((gate (skill-symbolic-fn skill))) - (setf current-action (funcall gate current-action context)) - ;; If any gate returns a LOG or EVENT (blocking/intercepting), stop and return it. - (when (and (listp current-action) - (member (getf current-action :type) '(:LOG :EVENT :log :event))) - (harness-log "DETERMINISTIC: Intercepted by skill '~a'~%" (skill-name skill)) - (return-from decide current-action)))) - - current-action)) -#+end_src - -** Store Filtering (list-objects-with-attribute) -A symbolic helper function to find nodes with specific attributes. This is used by skills to perform complex semantic lookups in the Object Store. - -#+begin_src lisp :tangle ../src/symbolic.lisp -(defun list-objects-with-attribute (attr-key attr-val) - "Filters the Object Store for nodes having a specific attribute value." - (let ((results nil)) - (maphash (lambda (id obj) - (declare (ignore id)) - (when (equal (getf (org-object-attributes obj) attr-key) attr-val) - (push obj results))) - *object-store*) - results)) -#+end_src diff --git a/literate/perceive.org b/literate/perceive.org new file mode 100644 index 0000000..3ed12fd --- /dev/null +++ b/literate/perceive.org @@ -0,0 +1,47 @@ +#+TITLE: Stage 1: Perceive (perceive.lisp) +#+AUTHOR: Amr +#+FILETAGS: :harness:perceive: +#+STARTUP: content + +* Stage 1: Perceive (perceive.lisp) +** Architectural Intent: Sensory Ingestion +The Perceive stage is responsible for data normalization and sensory intake. It takes raw stimuli (from TCP sockets, Signal, or Heartbeats) and updates the global Object Store graph. + +#+begin_src lisp :tangle ../src/perceive.lisp +(in-package :org-agent) + +(defun harness-track-telemetry (skill-name duration status) + "Updates performance metrics for a specific skill." + (when skill-name (bt:with-lock-held (*telemetry-lock*) + (let ((entry (or (gethash skill-name *skill-telemetry*) (list :executions 0 :total-time 0 :failures 0)))) + (incf (getf entry :executions)) (incf (getf entry :total-time) duration) + (when (eq status :rejected) (incf (getf entry :failures))) (setf (gethash skill-name *skill-telemetry*) entry))))) + +(defun inject-stimulus (raw-message &key stream (depth 0)) + "Enqueues a raw message into the reactive signal pipeline." + (let* ((payload (getf raw-message :payload)) + (sensor (getf payload :sensor)) + (async-p (or (getf payload :async-p) (member sensor '(:chat-message :delegation :user-command))))) + (when stream (setf (getf raw-message :reply-stream) stream)) + (if async-p (bt:make-thread (lambda () (restart-case (handler-bind ((error (lambda (c) (harness-log "ASYNC ERROR: ~a" c) (invoke-restart 'skip-event)))) + (process-signal raw-message)) (skip-event () nil))) :name "org-agent-async-task") + (restart-case (handler-bind ((error (lambda (c) (harness-log "SYSTEM ERROR: ~a" c) (invoke-restart 'skip-event)))) (process-signal raw-message)) + (skip-event () (harness-log "SYSTEM RECOVERY: Stimulus dropped.~%")))))) + +(defun perceive-gate (signal) + "Initial processing: Normalizes raw stimuli and updates memory." + (let* ((payload (getf signal :payload)) + (type (getf signal :type)) + (sensor (getf payload :sensor))) + (harness-log "GATE [Perceive]: ~a (~a)" type (or sensor "no-sensor")) + (snapshot-object-store) + (cond ((eq type :EVENT) + (case sensor + (:buffer-update (let ((ast (getf payload :ast))) (when ast (ingest-ast ast)))) + (:point-update (let ((element (getf payload :element))) (when element (ingest-ast element)))) + (:interrupt (bt:with-lock-held (*interrupt-lock*) (setf *interrupt-flag* t))))) + ((eq type :RESPONSE) + (harness-log "GATE [Perceive]: Act Result -> ~a" (getf payload :status)))) + (setf (getf signal :status) :perceived) + signal)) +#+end_src diff --git a/literate/reason.org b/literate/reason.org new file mode 100644 index 0000000..99420cf --- /dev/null +++ b/literate/reason.org @@ -0,0 +1,84 @@ +#+TITLE: Stage 2: Reason (reason.lisp) +#+AUTHOR: Amr +#+FILETAGS: :harness:reason: +#+STARTUP: content + +* 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 symbolic safety gates (Policy and Validation) to ensure alignment. + +#+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) + (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." + (let ((backends (or cascade *provider-cascade*))) + (or (dolist (backend backends) + (let ((backend-fn (gethash backend *probabilistic-backends*))) + (when backend-fn + (harness-log "PROBABILISTIC: Attempting backend ~a..." backend) + (let* ((model (when *model-selector-fn* (funcall *model-selector-fn* backend context))) + (result (if model + (funcall backend-fn prompt system-prompt :model model) + (funcall backend-fn prompt system-prompt)))) + (unless (or (null result) (search ":LOG" result)) + (return result)))))) + "(:type :LOG :payload (:text \"Neural Cascade Failure\"))"))) + +(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))) + (if active-skill + (let* ((prompt-generator (skill-neuro-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))) + (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)")))) + nil))) + +;; --- 2. Deterministic Mechanisms --- + +(defun deterministic-verify (proposed-action context) + "Iterates through all skill symbolic-gates sorted by priority." + (let ((current-action proposed-action) + (skills nil)) + (maphash (lambda (name skill) (declare (ignore name)) (when (skill-symbolic-fn skill) (push skill skills))) *skills-registry*) + (setf skills (sort skills #'> :key #'skill-priority)) + (dolist (skill skills) + (let ((gate (skill-symbolic-fn skill))) + (setf current-action (funcall gate current-action context)) + (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." + (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)) + (setf (getf signal :approved-action) nil)) + (setf (getf signal :status) :reasoned) + signal)) +#+end_src diff --git a/org-agent.asd b/org-agent.asd index 16573e8..aab5d1c 100644 --- a/org-agent.asd +++ b/org-agent.asd @@ -3,34 +3,40 @@ :author "Amr" :version "0.1.0" :license "MIT" - :description "The Neurosymbolic Lisp Machine Harness" + :description "The Metabolic Neurosymbolic Lisp Machine" :depends-on (:usocket :cl-json :bordeaux-threads :dexador :uiop :cl-dotenv :cl-ppcre :hunchentoot :ironclad :str) :serial t :components ((:file "src/package") (:file "src/skills") - (:file "src/system-invariants") (:file "src/engineering-standards") (:file "src/protocol-validator") (:file "src/protocol") + ;; --- Memory Layer --- (:file "src/object-store") + (:file "src/homoiconic-memory") + (:file "src/state-persistence") (:file "src/embedding") (:file "src/embedding-logic") (:file "src/context") (:file "src/context-logic") - (:file "src/neuro") - (:file "src/credentials-vault") - (:file "src/llm-gateway") - (:file "src/symbolic") + ;; --- Metabolic Harness --- + (:file "src/perceive") + (:file "src/reason") + (:file "src/act") + (:file "src/loop") + ;; --- Core Mandatory Skills --- + (:file "src/policy-enforcer") (:file "src/lisp-validator") + (:file "src/harness-monitor") + (:file "src/llm-gateway") + (:file "src/credentials-vault") + (:file "src/chat-logic") (:file "src/self-fix") (:file "src/lisp-repair") - (:file "src/bouncer") - (:file "src/verification-logic") - (:file "src/loop") + ;; --- Gateways --- (:file "src/gateway-telegram") (:file "src/gateway-signal") - (:file "src/gateway-matrix") - (:file "src/playwright")) + (:file "src/gateway-matrix")) :build-operation "program-op" :build-pathname "org-agent-server" :entry-point "org-agent:main") @@ -52,14 +58,12 @@ (:file "tests/llm-gateway-tests") (:file "tests/gateway-telegram-tests") (:file "tests/gateway-signal-tests") - (:file "tests/gateway-matrix-tests") - (:file "tests/playwright-tests") - (:file "tests/chaos-qa")) + (:file "tests/gateway-matrix-tests")) :perform (test-op (o s) (uiop:symbol-call :fiveam :run! (uiop:find-symbol* :harness-protocol-suite :org-agent-tests)) (uiop:symbol-call :fiveam :run! (uiop:find-symbol* :pipeline-suite :org-agent-pipeline-tests)) (uiop:symbol-call :fiveam :run! (uiop:find-symbol* :vision-suite :org-agent-peripheral-vision-tests)) - (uiop:symbol-call :fiveam :run! (uiop:find-symbol* :safety-suite :org-agent-safety-tests)) + (uiop:symbol-call :fiveam :run! (uiop:find-symbol* :lisp-validator-suite :org-agent-lisp-validator-tests)) (uiop:symbol-call :fiveam :run! (uiop:find-symbol* :boot-suite :org-agent-boot-tests)) (uiop:symbol-call :fiveam :run! (uiop:find-symbol* :object-store-suite :org-agent-object-store-tests)) (uiop:symbol-call :fiveam :run! (uiop:find-symbol* :immune-suite :org-agent-immune-system-tests)) @@ -69,9 +73,6 @@ (uiop:symbol-call :fiveam :run! (uiop:find-symbol* :bouncer-suite :org-agent-bouncer-tests)) (uiop:symbol-call :fiveam :run! (uiop:find-symbol* :formal-verification-suite :org-agent-formal-verification-tests)) (uiop:symbol-call :fiveam :run! (uiop:find-symbol* :llm-gateway-suite :org-agent-llm-gateway-tests)) - (uiop:symbol-call :fiveam :run! (uiop:find-symbol* :shell-actuator-suite :org-agent-shell-actuator-tests)) (uiop:symbol-call :fiveam :run! (uiop:find-symbol* :gateway-telegram-suite :org-agent-gateway-telegram-tests)) (uiop:symbol-call :fiveam :run! (uiop:find-symbol* :gateway-signal-suite :org-agent-gateway-signal-tests)) - (uiop:symbol-call :fiveam :run! (uiop:find-symbol* :gateway-matrix-suite :org-agent-gateway-matrix-tests)) - (uiop:symbol-call :fiveam :run! (uiop:find-symbol* :playwright-suite :org-agent-playwright-tests)) - (uiop:symbol-call :fiveam :run! (uiop:find-symbol* :chaos-suite :org-agent-chaos-qa)))) + (uiop:symbol-call :fiveam :run! (uiop:find-symbol* :gateway-matrix-suite :org-agent-gateway-matrix-tests)))) diff --git a/src/act.lisp b/src/act.lisp new file mode 100644 index 0000000..6f38e80 --- /dev/null +++ b/src/act.lisp @@ -0,0 +1,65 @@ +(in-package :org-agent) + +(defvar *actuator-registry* (make-hash-table :test 'equal)) + +(defun register-actuator (name fn) + "Registers an actuator function. Actuators receive: (ACTION CONTEXT)." + (setf (gethash name *actuator-registry*) fn)) + +(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)) + (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." + (declare (ignore context)) + (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))) + (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 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)) + (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)))))))))) + (setf (getf signal :status) :acted) + feedback)) diff --git a/src/loop.lisp b/src/loop.lisp index 985f2bc..4a82433 100644 --- a/src/loop.lisp +++ b/src/loop.lisp @@ -1,172 +1,25 @@ (in-package :org-agent) (defvar *interrupt-flag* nil) - (defvar *interrupt-lock* (bt:make-lock "harness-interrupt-lock")) -(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)) - (actuator-fn (gethash target *actuator-registry*))) - (if actuator-fn - (funcall actuator-fn action context) - (harness-log "DISPATCH ERROR: No actuator for ~a" target))))) - -(defun harness-track-telemetry (skill-name duration status) - "Updates performance metrics for a specific skill." - (when skill-name (bt:with-lock-held (*telemetry-lock*) - (let ((entry (or (gethash skill-name *skill-telemetry*) (list :executions 0 :total-time 0 :failures 0)))) - (incf (getf entry :executions)) (incf (getf entry :total-time) duration) - (when (eq status :rejected) (incf (getf entry :failures))) (setf (gethash skill-name *skill-telemetry*) entry))))) - -(defun inject-stimulus (raw-message &key stream (depth 0)) - "Enqueues a raw message into the reactive signal pipeline, handling async/sync execution and recovery." - (let* ((payload (getf raw-message :payload)) - (sensor (getf payload :sensor)) - ;; Force Chat and Delegation to be async - (async-p (or (getf payload :async-p) (member sensor '(:chat-message :delegation :user-command))))) - (when stream (setf (getf raw-message :reply-stream) stream)) - (if async-p (bt:make-thread (lambda () (restart-case (handler-bind ((error (lambda (c) (harness-log "ASYNC ERROR: ~a" c) (invoke-restart 'skip-event)))) - (process-signal raw-message)) (skip-event () nil))) :name "org-agent-async-task") - (restart-case (handler-bind ((error (lambda (c) (harness-log "SYSTEM ERROR: ~a" c) (invoke-restart 'skip-event)))) (process-signal raw-message)) - (skip-event () (harness-log "SYSTEM RECOVERY: Stimulus dropped.~%")))))) - -(defun execute-system-action (action context) - "Processes internal harness commands like skill creation or environment updates." - (declare (ignore context)) - (let* ((payload (ignore-errors (getf action :payload))) (cmd (ignore-errors (getf payload :action)))) - (case cmd - (:eval (let ((code (getf payload :code))) - (harness-log "ACTUATOR [System] - Evaluating: ~a" code) - (handler-case (let ((result (eval (read-from-string code)))) - (harness-log "ACTUATOR [System] - Result: ~s" result) - result) - (error (c) (harness-log "ACTUATOR ERROR [System] - Eval failed: ~a" c))))) - (: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))) - (harness-log "ACTUATOR [System] - Creating skill ~a..." filename) - (with-open-file (out full-path :direction :output :if-exists :supersede) (write-string content out)) - (load-skill-from-org full-path))) - (:set-cascade (setf *provider-cascade* (getf payload :cascade))) - (:message (harness-log "ACTUATOR [System] - ~a" (getf payload :text))) - (t (harness-log "ACTUATOR [System] - Unknown command ~s" cmd))))) - -(defun perceive-gate (signal) - "Initial processing: Normalizes raw stimuli and updates memory." - (let* ((payload (getf signal :payload)) - (type (getf signal :type)) - (sensor (getf payload :sensor))) - (harness-log "GATE [Perceive]: ~a (~a)" type (or sensor "no-sensor")) - (snapshot-object-store) - (cond ((eq type :EVENT) - (case sensor - (:buffer-update (let ((ast (getf payload :ast))) (when ast (ingest-ast ast)))) - (:point-update (let ((element (getf payload :element))) (when element (ingest-ast element)))) - (:interrupt (bt:with-lock-held (*interrupt-lock*) (setf *interrupt-flag* t))))) - ((eq type :RESPONSE) - (harness-log "GATE [Perceive]: Act Result -> ~a" (getf payload :status)))) - (setf (getf signal :status) :perceived) - signal)) - -(defun neuro-gate (signal) - "Probabilistic: Neural intuition and proposed actions." - (unless (eq (getf signal :type) :EVENT) - (return-from neuro-gate signal)) - (harness-log "GATE [Probabilistic]: Consulting LLM...") - (let ((thoughts (think signal))) - (setf (getf signal :proposals) (if (and (listp thoughts) (listp (car thoughts))) - thoughts - (if thoughts (list thoughts) nil))) - (setf (getf signal :status) :thought) - signal)) - -(defun resolve-consensus (proposals signal) - "Resolves diverging proposals by selecting the most consistent one." - (declare (ignore signal)) - (harness-log "CONSENSUS: ~a proposals found. Resolving..." (length proposals)) - (let ((counts (make-hash-table :test 'equal))) - (dolist (p proposals) (incf (gethash p counts 0))) - (let ((winner (first proposals)) (max-count 0)) - (maphash (lambda (p count) (when (> count max-count) (setq max-count count winner p))) counts) - (harness-log "CONSENSUS: Winner selected with ~a votes." max-count) - winner))) - -(defun consensus-gate (signal) - "Resolves multiple proposals into a single candidate action." - (let ((proposals (getf signal :proposals))) - (if (and proposals (cdr proposals)) - (let ((winner (resolve-consensus proposals signal))) - (setf (getf signal :candidate) winner)) - (setf (getf signal :candidate) (first proposals))) - (setf (getf signal :status) :consensus) - signal)) - -(defun decide-gate (signal) - "Deterministic: Deterministic safety and validation." - (let ((candidate (getf signal :candidate))) - (if candidate - (let* ((normalized-candidate (if (listp candidate) candidate (list :type :RESPONSE :payload (list :text candidate)))) - (decision (decide normalized-candidate signal))) - (setf (getf signal :approved-action) decision)) - (setf (getf signal :approved-action) nil)) - (setf (getf signal :status) :decided) - signal)) - -(defun dispatch-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)) - (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)))))))))) - (setf (getf signal :status) :dispatched) - feedback)) - (defun process-signal (signal) - "The entry point to the Reactive Signal Pipeline." + "The entry point to the Metabolic Pipeline: Perceive -> Reason -> Act." (let ((current-signal signal)) (loop while current-signal do (let ((depth (getf current-signal :depth 0))) - (when (> depth 10) (harness-log "PIPELINE ERROR: Max depth reached.") (return nil)) + (when (> depth 10) (harness-log "METABOLISM ERROR: Max depth reached.") (return nil)) (when (bt:with-lock-held (*interrupt-lock*) *interrupt-flag*) - (harness-log "PIPELINE: Interrupted.") + (harness-log "METABOLISM: Interrupted.") (bt:with-lock-held (*interrupt-lock*) (setf *interrupt-flag* nil)) (return nil)) (handler-case (progn (setf current-signal (perceive-gate current-signal)) - (setf current-signal (neuro-gate current-signal)) - (setf current-signal (consensus-gate current-signal)) - (setf current-signal (decide-gate current-signal)) - (setf current-signal (dispatch-gate current-signal))) + (setf current-signal (reason-gate current-signal)) + (setf current-signal (act-gate current-signal))) (error (c) - (harness-log "PIPELINE CRASH: ~a - Initiating Micro-Rollback." c) + (harness-log "METABOLISM CRASH: ~a - Initiating Micro-Rollback." c) (rollback-object-store 0) (let ((sensor (ignore-errors (getf (getf current-signal :payload) :sensor)))) (if (or (> depth 2) (member sensor '(:loop-error :tool-error))) @@ -174,45 +27,23 @@ (setf current-signal (list :type :EVENT :depth (1+ depth) :reply-stream (getf current-signal :reply-stream) :payload (list :sensor :loop-error :message (format nil "~a" c) :depth depth))))))))))) -(defun delegate-task (task-id recipient &key context) - "Enqueues a task for another agent or background process." - (harness-log "ORCHESTRATOR: Delegating task ~a to ~a" task-id recipient) - (inject-stimulus (list :type :EVENT - :payload (list :sensor :delegation - :task-id task-id - :recipient recipient - :context context)))) - -(defvar *default-heartbeat-interval* 60 "Default interval for the system heartbeat pulse in seconds.") +(defvar *default-heartbeat-interval* 60) (defvar *heartbeat-thread* nil) (defun start-heartbeat (&optional (interval *default-heartbeat-interval*)) - "Spawns a thread that periodically injects a heartbeat stimulus." (setf *heartbeat-thread* (bt:make-thread (lambda () (loop (sleep interval) - (harness-log "HARNESS: Heartbeat pulse...") (inject-stimulus (list :type :EVENT :payload (list :sensor :heartbeat :unix-time (get-universal-time)))))) :name "org-agent-heartbeat"))) -(defun stop-heartbeat () - "Gracefully terminates the heartbeat pulse thread." - (when (and *heartbeat-thread* (bt:thread-alive-p *heartbeat-thread*)) - (bt:destroy-thread *heartbeat-thread*) - (setf *heartbeat-thread* nil))) - (defun main () - "The entry point for the compiled standalone binary." + "Entry point for the Skeleton MVP." (let* ((home (uiop:getenv "HOME")) (env-file (uiop:merge-pathnames* ".local/share/org-agent/.env" (uiop:ensure-directory-pathname home)))) - (if (uiop:file-exists-p env-file) - (progn - (format t "HARNESS: Loading environment from ~a~%" env-file) - (cl-dotenv:load-env env-file)) - (format t "HARNESS ERROR: .env not found at ~a~%" env-file))) - (let ((interval (or (ignore-errors (parse-integer (uiop:getenv "HEARTBEAT_INTERVAL") :junk-allowed t)) *default-heartbeat-interval*))) - (format t "HARNESS: Heartbeat interval set to ~a seconds.~%" interval) - (start-daemon :interval interval)) + (when (uiop:file-exists-p env-file) (cl-dotenv:load-env env-file))) + (initialize-all-skills) + (start-heartbeat) (loop (sleep 3600))) diff --git a/src/perceive.lisp b/src/perceive.lisp new file mode 100644 index 0000000..5c47c70 --- /dev/null +++ b/src/perceive.lisp @@ -0,0 +1,36 @@ +(in-package :org-agent) + +(defun harness-track-telemetry (skill-name duration status) + "Updates performance metrics for a specific skill." + (when skill-name (bt:with-lock-held (*telemetry-lock*) + (let ((entry (or (gethash skill-name *skill-telemetry*) (list :executions 0 :total-time 0 :failures 0)))) + (incf (getf entry :executions)) (incf (getf entry :total-time) duration) + (when (eq status :rejected) (incf (getf entry :failures))) (setf (gethash skill-name *skill-telemetry*) entry))))) + +(defun inject-stimulus (raw-message &key stream (depth 0)) + "Enqueues a raw message into the reactive signal pipeline." + (let* ((payload (getf raw-message :payload)) + (sensor (getf payload :sensor)) + (async-p (or (getf payload :async-p) (member sensor '(:chat-message :delegation :user-command))))) + (when stream (setf (getf raw-message :reply-stream) stream)) + (if async-p (bt:make-thread (lambda () (restart-case (handler-bind ((error (lambda (c) (harness-log "ASYNC ERROR: ~a" c) (invoke-restart 'skip-event)))) + (process-signal raw-message)) (skip-event () nil))) :name "org-agent-async-task") + (restart-case (handler-bind ((error (lambda (c) (harness-log "SYSTEM ERROR: ~a" c) (invoke-restart 'skip-event)))) (process-signal raw-message)) + (skip-event () (harness-log "SYSTEM RECOVERY: Stimulus dropped.~%")))))) + +(defun perceive-gate (signal) + "Initial processing: Normalizes raw stimuli and updates memory." + (let* ((payload (getf signal :payload)) + (type (getf signal :type)) + (sensor (getf payload :sensor))) + (harness-log "GATE [Perceive]: ~a (~a)" type (or sensor "no-sensor")) + (snapshot-object-store) + (cond ((eq type :EVENT) + (case sensor + (:buffer-update (let ((ast (getf payload :ast))) (when ast (ingest-ast ast)))) + (:point-update (let ((element (getf payload :element))) (when element (ingest-ast element)))) + (:interrupt (bt:with-lock-held (*interrupt-lock*) (setf *interrupt-flag* t))))) + ((eq type :RESPONSE) + (harness-log "GATE [Perceive]: Act Result -> ~a" (getf payload :status)))) + (setf (getf signal :status) :perceived) + signal)) diff --git a/src/reason.lisp b/src/reason.lisp new file mode 100644 index 0000000..76dc241 --- /dev/null +++ b/src/reason.lisp @@ -0,0 +1,71 @@ +(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) + (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." + (let ((backends (or cascade *provider-cascade*))) + (or (dolist (backend backends) + (let ((backend-fn (gethash backend *probabilistic-backends*))) + (when backend-fn + (harness-log "PROBABILISTIC: Attempting backend ~a..." backend) + (let* ((model (when *model-selector-fn* (funcall *model-selector-fn* backend context))) + (result (if model + (funcall backend-fn prompt system-prompt :model model) + (funcall backend-fn prompt system-prompt)))) + (unless (or (null result) (search ":LOG" result)) + (return result)))))) + "(:type :LOG :payload (:text \"Neural Cascade Failure\"))"))) + +(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))) + (if active-skill + (let* ((prompt-generator (skill-neuro-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))) + (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)")))) + nil))) + +;; --- 2. Deterministic Mechanisms --- + +(defun deterministic-verify (proposed-action context) + "Iterates through all skill symbolic-gates sorted by priority." + (let ((current-action proposed-action) + (skills nil)) + (maphash (lambda (name skill) (declare (ignore name)) (when (skill-symbolic-fn skill) (push skill skills))) *skills-registry*) + (setf skills (sort skills #'> :key #'skill-priority)) + (dolist (skill skills) + (let ((gate (skill-symbolic-fn skill))) + (setf current-action (funcall gate current-action context)) + (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." + (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)) + (setf (getf signal :approved-action) nil)) + (setf (getf signal :status) :reasoned) + signal))