amr/passepartout
1
0
Fork 0
Code Issues 15 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

ARCH: Implement Metabolic Harness (Perceive > Reason > Act)

Browse Source
This commit is contained in:
Amr Gharbeia
2026-04-13 09:57:59 -04:00
parent e241276a3d
commit 4ab37ceb24
10 changed files with 428 additions and 886 deletions
Download Patch File Download Diff File Expand all files Collapse all files

76
literate/act.org Normal file
View File

@@ -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

422
literate/loop.org
View File

@@ -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

283
literate/neurosymbolic.org
View File

@@ -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 \"* <Response Text>\")
To call a tool, you MUST use:
(:type :REQUEST :target :tool :action :call :tool \"<name>\" :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

47
literate/perceive.org Normal file
View File

@@ -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

84
literate/reason.org Normal file
View File

@@ -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

39
org-agent.asd
View File

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

65
src/act.lisp Normal file
View File

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

191
src/loop.lisp
View File

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

36
src/perceive.lisp Normal file
View File

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

71
src/reason.lisp Normal file
View File

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