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

refactor: rename core.org to loop.org, rewrite literate text, and extract constants

Browse Source
This commit is contained in:
Amr Gharbeia
2026-04-12 18:08:36 -04:00
parent b0b94793a5
commit 475f79e79d
3 changed files with 302 additions and 58 deletions
Download Patch File Download Diff File Expand all files Collapse all files

114
literate/core.org → literate/loop.org
View File

@@ -6,7 +6,7 @@
* The Cognitive Loop (core.lisp) * The Cognitive Loop (core.lisp)
** Deep Reasoning: Beyond Asynchronous Recursion ** Deep Reasoning: Beyond Asynchronous Recursion
The original `cognitive-loop` used asynchronous recursion to handle stimuli. While responsive, it led to deep Lisp stacks and made multi-backend consensus difficult to implement. The original `cognitive-loop` used asynchronous recursion to handle stimuli. While responsive, it led to deep Lisp stacks and made multi-backend consensus difficult to implement.
- **The Circuit Board Model:** We have evolved the kernel into a functional transformation pipeline. Every event—be it a keystroke, a timer pulse, or a neural proposal—is a **Signal**. - **The Circuit Board Model:** We have evolved the harness into a functional transformation pipeline. Every event—be it a keystroke, a timer pulse, or a neural proposal—is a **Signal**.
- **Consensus Gates:** By treating reasoning as a signal moving through a pipe, we can "split" the pipe to ask multiple LLMs simultaneously. A **Consensus Gate** later in the pipe compares the proposals and selects the most mathematically consistent one. - **Consensus Gates:** By treating reasoning as a signal moving through a pipe, we can "split" the pipe to ask multiple LLMs simultaneously. A **Consensus Gate** later in the pipe compares the proposals and selects the most mathematically consistent one.
- **Multi-Modal Fusion:** The pipeline can blend disparate signals (e.g. *User Prompt* + *Low Battery Alert* or *Heartbeat*) into a single coherent cognitive event. - **Multi-Modal Fusion:** The pipeline can blend disparate signals (e.g. *User Prompt* + *Low Battery Alert* or *Heartbeat*) into a single coherent cognitive event.
- **Flat Execution:** By using a feedback-loop orchestrator (`process-signal`), we flatten the execution stack. Tool outputs and errors are re-injected as new signals rather than creating nested function calls. - **Flat Execution:** By using a feedback-loop orchestrator (`process-signal`), we flatten the execution stack. Tool outputs and errors are re-injected as new signals rather than creating nested function calls.
@@ -24,7 +24,7 @@ graph TD
#+end_src #+end_src
** Package Context ** Package Context
#+begin_src lisp :tangle ../src/core.lisp #+begin_src lisp :tangle ../src/loop.lisp
(in-package :org-agent) (in-package :org-agent)
(defvar *interrupt-flag* nil) (defvar *interrupt-flag* nil)
@@ -33,35 +33,35 @@ graph TD
** Logs Lock ** Logs Lock
Thread-safety for logging operations. Thread-safety for logging operations.
#+begin_src lisp :tangle ../src/core.lisp #+begin_src lisp :tangle ../src/loop.lisp
;; MOVED TO package.lisp ;; MOVED TO package.lisp
#+end_src #+end_src
** Interrupt Lock ** Interrupt Lock
Thread-safety for loop interruption. Thread-safety for loop interruption.
#+begin_src lisp :tangle ../src/core.lisp #+begin_src lisp :tangle ../src/loop.lisp
(defvar *interrupt-lock* (bt:make-lock "kernel-interrupt-lock")) (defvar *interrupt-lock* (bt:make-lock "harness-interrupt-lock"))
#+end_src #+end_src
** Skill Telemetry ** Skill Telemetry
Hash table tracking execution metrics per skill. Hash table tracking execution metrics per skill.
#+begin_src lisp :tangle ../src/core.lisp #+begin_src lisp :tangle ../src/loop.lisp
;; MOVED TO package.lisp ;; MOVED TO package.lisp
#+end_src #+end_src
** Telemetry Lock ** Telemetry Lock
Thread-safety for metric updates. Thread-safety for metric updates.
#+begin_src lisp :tangle ../src/core.lisp #+begin_src lisp :tangle ../src/loop.lisp
;; MOVED TO package.lisp ;; MOVED TO package.lisp
#+end_src #+end_src
** Physical Dispatch (dispatch-action) ** Physical Dispatch (dispatch-action)
Routes an approved action to its registered physical actuator. Routes an approved action to its registered physical actuator.
#+begin_src lisp :tangle ../src/core.lisp #+begin_src lisp :tangle ../src/loop.lisp
(defun dispatch-action (action context) (defun dispatch-action (action context)
"Routes an approved action to its registered physical actuator." "Routes an approved action to its registered physical actuator."
(when (and action (listp action)) (when (and action (listp action))
@@ -69,14 +69,14 @@ Routes an approved action to its registered physical actuator.
(actuator-fn (gethash target *actuator-registry*))) (actuator-fn (gethash target *actuator-registry*)))
(if actuator-fn (if actuator-fn
(funcall actuator-fn action context) (funcall actuator-fn action context)
(kernel-log "DISPATCH ERROR: No actuator for ~a" target))))) (harness-log "DISPATCH ERROR: No actuator for ~a" target)))))
#+end_src #+end_src
** Performance Tracking (kernel-track-telemetry) ** Performance Tracking (harness-track-telemetry)
Updates performance metrics for a specific skill, tracking execution counts, total duration, and failure rates. Updates performance metrics for a specific skill, tracking execution counts, total duration, and failure rates.
#+begin_src lisp :tangle ../src/core.lisp #+begin_src lisp :tangle ../src/loop.lisp
(defun kernel-track-telemetry (skill-name duration status) (defun harness-track-telemetry (skill-name duration status)
"Updates performance metrics for a specific skill." "Updates performance metrics for a specific skill."
(when skill-name (bt:with-lock-held (*telemetry-lock*) (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)))) (let ((entry (or (gethash skill-name *skill-telemetry*) (list :executions 0 :total-time 0 :failures 0))))
@@ -84,11 +84,11 @@ Updates performance metrics for a specific skill, tracking execution counts, tot
(when (eq status :rejected) (incf (getf entry :failures))) (setf (gethash skill-name *skill-telemetry*) entry))))) (when (eq status :rejected) (incf (getf entry :failures))) (setf (gethash skill-name *skill-telemetry*) entry)))))
#+end_src #+end_src
** System Logging (kernel-log) ** System Logging (harness-log)
A centralized logging function that outputs to standard output and maintains a rolling in-memory buffer for context-aware reasoning. A centralized logging function that outputs to standard output and maintains a rolling in-memory buffer for context-aware reasoning.
#+begin_src lisp :tangle ../src/core.lisp #+begin_src lisp :tangle ../src/loop.lisp
(defun kernel-log (fmt &rest args) (defun harness-log (fmt &rest args)
"Records a formatted message to the system log and standard output." "Records a formatted message to the system log and standard output."
(let ((msg (apply #'format nil fmt args))) (let ((msg (apply #'format nil fmt args)))
(bt:with-lock-held (*logs-lock*) (push msg *system-logs*) (when (> (length *system-logs*) *max-log-history*) (setf *system-logs* (subseq *system-logs* 0 *max-log-history*)))) (bt:with-lock-held (*logs-lock*) (push msg *system-logs*) (when (> (length *system-logs*) *max-log-history*) (setf *system-logs* (subseq *system-logs* 0 *max-log-history*))))
@@ -96,9 +96,9 @@ A centralized logging function that outputs to standard output and maintains a r
#+end_src #+end_src
** Stimulus Injection (inject-stimulus) ** Stimulus Injection (inject-stimulus)
This is the entry point for all events into the kernel. It initializes a signal and passes it to the `process-signal` pipeline. This is the entry point for all events into the harness. It initializes a signal and passes it to the `process-signal` pipeline.
#+begin_src lisp :tangle ../src/core.lisp #+begin_src lisp :tangle ../src/loop.lisp
(defun inject-stimulus (raw-message &key stream (depth 0)) (defun inject-stimulus (raw-message &key stream (depth 0))
"Enqueues a raw message into the reactive signal pipeline, handling async/sync execution and recovery." "Enqueues a raw message into the reactive signal pipeline, handling async/sync execution and recovery."
(let* ((payload (getf raw-message :payload)) (let* ((payload (getf raw-message :payload))
@@ -106,50 +106,50 @@ This is the entry point for all events into the kernel. It initializes a signal
;; Force Chat and Delegation to be async ;; Force Chat and Delegation to be async
(async-p (or (getf payload :async-p) (member sensor '(:chat-message :delegation :user-command))))) (async-p (or (getf payload :async-p) (member sensor '(:chat-message :delegation :user-command)))))
(when stream (setf (getf raw-message :reply-stream) stream)) (when stream (setf (getf raw-message :reply-stream) stream))
(if async-p (bt:make-thread (lambda () (restart-case (handler-bind ((error (lambda (c) (kernel-log "ASYNC ERROR: ~a" c) (invoke-restart 'skip-event)))) (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") (process-signal raw-message)) (skip-event () nil))) :name "org-agent-async-task")
(restart-case (handler-bind ((error (lambda (c) (kernel-log "SYSTEM ERROR: ~a" c) (invoke-restart 'skip-event)))) (process-signal raw-message)) (restart-case (handler-bind ((error (lambda (c) (harness-log "SYSTEM ERROR: ~a" c) (invoke-restart 'skip-event)))) (process-signal raw-message))
(skip-event () (kernel-log "SYSTEM RECOVERY: Stimulus dropped.~%")))))) (skip-event () (harness-log "SYSTEM RECOVERY: Stimulus dropped.~%"))))))
#+end_src #+end_src
** Internal Tool Execution ** Internal Tool Execution
The `execute-system-action` function handles kernel-level operations such as hot-loading skills, evaluating raw Lisp, or setting environment variables. The `execute-system-action` function handles harness-level operations such as hot-loading skills, evaluating raw Lisp, or setting environment variables.
#+begin_src lisp :tangle ../src/core.lisp #+begin_src lisp :tangle ../src/loop.lisp
(defun execute-system-action (action context) (defun execute-system-action (action context)
"Processes internal kernel commands like skill creation or environment updates." "Processes internal harness commands like skill creation or environment updates."
(declare (ignore context)) (declare (ignore context))
(let* ((payload (ignore-errors (getf action :payload))) (cmd (ignore-errors (getf payload :action)))) (let* ((payload (ignore-errors (getf action :payload))) (cmd (ignore-errors (getf payload :action))))
(case cmd (case cmd
(:eval (let ((code (getf payload :code))) (:eval (let ((code (getf payload :code)))
(kernel-log "ACTUATOR [System] - Evaluating: ~a" code) (harness-log "ACTUATOR [System] - Evaluating: ~a" code)
(handler-case (let ((result (eval (read-from-string code)))) (handler-case (let ((result (eval (read-from-string code))))
(kernel-log "ACTUATOR [System] - Result: ~s" result) (harness-log "ACTUATOR [System] - Result: ~s" result)
result) result)
(error (c) (kernel-log "ACTUATOR ERROR [System] - Eval failed: ~a" c))))) (error (c) (harness-log "ACTUATOR ERROR [System] - Eval failed: ~a" c)))))
(:create-skill (let* ((filename (getf payload :filename)) (content (getf payload :content)) (:create-skill (let* ((filename (getf payload :filename)) (content (getf payload :content))
(skills-dir (merge-pathnames "skills/" (asdf:system-source-directory :org-agent))) (full-path (merge-pathnames filename skills-dir))) (skills-dir (merge-pathnames "skills/" (asdf:system-source-directory :org-agent))) (full-path (merge-pathnames filename skills-dir)))
(kernel-log "ACTUATOR [System] - Creating skill ~a..." filename) (harness-log "ACTUATOR [System] - Creating skill ~a..." filename)
(with-open-file (out full-path :direction :output :if-exists :supersede) (write-string content out)) (with-open-file (out full-path :direction :output :if-exists :supersede) (write-string content out))
(load-skill-from-org full-path))) (load-skill-from-org full-path)))
(:set-cascade (setf *provider-cascade* (getf payload :cascade))) (:set-cascade (setf *provider-cascade* (getf payload :cascade)))
(:message (kernel-log "ACTUATOR [System] - ~a" (getf payload :text))) (:message (harness-log "ACTUATOR [System] - ~a" (getf payload :text)))
(t (kernel-log "ACTUATOR [System] - Unknown command ~s" cmd))))) (t (harness-log "ACTUATOR [System] - Unknown command ~s" cmd)))))
#+end_src #+end_src
** The Reactive Signal Pipeline (process-signal) ** The Reactive Signal Pipeline (process-signal)
The kernel has evolved into a functional transformation pipeline. Every event—be it a keystroke, a timer pulse, or a neural proposal—is a **Signal**. Signals flow through a series of "Gates" that progressively enrich and validate the event until it is dispatched to an actuator. the harness has evolved into a functional transformation pipeline. Every event—be it a keystroke, a timer pulse, or a neural proposal—is a **Signal**. Signals flow through a series of "Gates" that progressively enrich and validate the event until it is dispatched to an actuator.
*** Perceive Gate *** Perceive Gate
Normalizes raw stimuli and updates the Object Store knowledge graph. Normalizes raw stimuli and updates the Object Store knowledge graph.
#+begin_src lisp :tangle ../src/core.lisp #+begin_src lisp :tangle ../src/loop.lisp
(defun perceive-gate (signal) (defun perceive-gate (signal)
"Initial processing: Normalizes raw stimuli and updates memory." "Initial processing: Normalizes raw stimuli and updates memory."
(let* ((payload (getf signal :payload)) (let* ((payload (getf signal :payload))
(type (getf signal :type)) (type (getf signal :type))
(sensor (getf payload :sensor))) (sensor (getf payload :sensor)))
(kernel-log "GATE [Perceive]: ~a (~a)" type (or sensor "no-sensor")) (harness-log "GATE [Perceive]: ~a (~a)" type (or sensor "no-sensor"))
(snapshot-object-store) (snapshot-object-store)
(cond ((eq type :EVENT) (cond ((eq type :EVENT)
(case sensor (case sensor
@@ -157,7 +157,7 @@ Normalizes raw stimuli and updates the Object Store knowledge graph.
(:point-update (let ((element (getf payload :element))) (when element (ingest-ast element)))) (:point-update (let ((element (getf payload :element))) (when element (ingest-ast element))))
(:interrupt (bt:with-lock-held (*interrupt-lock*) (setf *interrupt-flag* t))))) (:interrupt (bt:with-lock-held (*interrupt-lock*) (setf *interrupt-flag* t)))))
((eq type :RESPONSE) ((eq type :RESPONSE)
(kernel-log "GATE [Perceive]: Act Result -> ~a" (getf payload :status)))) (harness-log "GATE [Perceive]: Act Result -> ~a" (getf payload :status))))
(setf (getf signal :status) :perceived) (setf (getf signal :status) :perceived)
signal)) signal))
#+end_src #+end_src
@@ -165,12 +165,12 @@ Normalizes raw stimuli and updates the Object Store knowledge graph.
*** Associative Gate *** Associative Gate
Invokes the Associative engine to generate intuition-based proposals. If parallel consensus is enabled, this gate returns a list of proposals. Invokes the Associative engine to generate intuition-based proposals. If parallel consensus is enabled, this gate returns a list of proposals.
#+begin_src lisp :tangle ../src/core.lisp #+begin_src lisp :tangle ../src/loop.lisp
(defun neuro-gate (signal) (defun neuro-gate (signal)
"Associative: Intuition and proposed actions." "Associative: Intuition and proposed actions."
(unless (eq (getf signal :type) :EVENT) (unless (eq (getf signal :type) :EVENT)
(return-from neuro-gate signal)) (return-from neuro-gate signal))
(kernel-log "GATE [Associative]: Consulting System 1...") (harness-log "GATE [Associative]: Consulting System 1...")
(let ((thoughts (think signal))) (let ((thoughts (think signal)))
(setf (getf signal :proposals) (if (and (listp thoughts) (listp (car thoughts))) (setf (getf signal :proposals) (if (and (listp thoughts) (listp (car thoughts)))
thoughts thoughts
@@ -182,11 +182,11 @@ Invokes the Associative engine to generate intuition-based proposals. If paralle
*** Consensus Gate *** Consensus Gate
Compares multiple proposals (from parallel backends) and selects the most consistent one. Compares multiple proposals (from parallel backends) and selects the most consistent one.
#+begin_src lisp :tangle ../src/core.lisp #+begin_src lisp :tangle ../src/loop.lisp
(defun resolve-consensus (proposals signal) (defun resolve-consensus (proposals signal)
"Resolves diverging proposals by voting or selecting the safest one." "Resolves diverging proposals by voting or selecting the safest one."
(declare (ignore signal)) (declare (ignore signal))
(kernel-log "CONSENSUS: ~a proposals found. Resolving..." (length proposals)) (harness-log "CONSENSUS: ~a proposals found. Resolving..." (length proposals))
;; Simplified consensus: Majority vote or first safe one ;; Simplified consensus: Majority vote or first safe one
;; For now, we'll select the proposal that appears most frequently. ;; For now, we'll select the proposal that appears most frequently.
(let ((counts (make-hash-table :test 'equal))) (let ((counts (make-hash-table :test 'equal)))
@@ -199,7 +199,7 @@ Compares multiple proposals (from parallel backends) and selects the most consis
(setq max-count count (setq max-count count
winner p))) winner p)))
counts) counts)
(kernel-log "CONSENSUS: Winner selected with ~a votes." max-count) (harness-log "CONSENSUS: Winner selected with ~a votes." max-count)
winner))) winner)))
(defun consensus-gate (signal) (defun consensus-gate (signal)
@@ -224,7 +224,7 @@ The Deliberate safety gate. Validates the candidate action against formal rules
Before passing the candidate to `decide`, the gate checks its type. If it's a string, it wraps it in `(:type :RESPONSE :payload (list :text <string>))`. Before passing the candidate to `decide`, the gate checks its type. If it's a string, it wraps it in `(:type :RESPONSE :payload (list :text <string>))`.
**** Phase D: Build **** Phase D: Build
#+begin_src lisp :tangle ../src/core.lisp #+begin_src lisp :tangle ../src/loop.lisp
(defun decide-gate (signal) (defun decide-gate (signal)
"Deliberate: Safety and validation." "Deliberate: Safety and validation."
(let ((candidate (getf signal :candidate))) (let ((candidate (getf signal :candidate)))
@@ -240,7 +240,7 @@ Before passing the candidate to `decide`, the gate checks its type. If it's a st
*** Dispatch Gate *** Dispatch Gate
Routes approved actions to actuators. If an action results in new information (like tool output), it returns a FEEDBACK signal to be re-injected. Routes approved actions to actuators. If an action results in new information (like tool output), it returns a FEEDBACK signal to be re-injected.
#+begin_src lisp :tangle ../src/core.lisp #+begin_src lisp :tangle ../src/loop.lisp
(defun dispatch-gate (signal) (defun dispatch-gate (signal)
"Final Stage: Actuation and feedback generation." "Final Stage: Actuation and feedback generation."
(let* ((approved (getf signal :approved-action)) (let* ((approved (getf signal :approved-action))
@@ -280,17 +280,17 @@ Routes approved actions to actuators. If an action results in new information (l
*** Pipeline Orchestrator (process-signal) *** Pipeline Orchestrator (process-signal)
Moves a signal through the gates in a flat loop, handling feedback signals without increasing the Lisp stack depth. Moves a signal through the gates in a flat loop, handling feedback signals without increasing the Lisp stack depth.
#+begin_src lisp :tangle ../src/core.lisp #+begin_src lisp :tangle ../src/loop.lisp
(defun process-signal (signal) (defun process-signal (signal)
"The entry point to the Reactive Signal Pipeline." "The entry point to the Reactive Signal Pipeline."
(let ((current-signal signal)) (let ((current-signal signal))
(loop while current-signal do (loop while current-signal do
(let ((depth (getf current-signal :depth 0))) (let ((depth (getf current-signal :depth 0)))
(when (> depth 10) (when (> depth 10)
(kernel-log "PIPELINE ERROR: Max depth reached.") (harness-log "PIPELINE ERROR: Max depth reached.")
(return nil)) (return nil))
(when (bt:with-lock-held (*interrupt-lock*) *interrupt-flag*) (when (bt:with-lock-held (*interrupt-lock*) *interrupt-flag*)
(kernel-log "PIPELINE: Interrupted.") (harness-log "PIPELINE: Interrupted.")
(bt:with-lock-held (*interrupt-lock*) (setf *interrupt-flag* nil)) (bt:with-lock-held (*interrupt-lock*) (setf *interrupt-flag* nil))
(return nil)) (return nil))
@@ -302,7 +302,7 @@ Moves a signal through the gates in a flat loop, handling feedback signals witho
(setf current-signal (decide-gate current-signal)) (setf current-signal (decide-gate current-signal))
(setf current-signal (dispatch-gate current-signal))) (setf current-signal (dispatch-gate current-signal)))
(error (c) (error (c)
(kernel-log "PIPELINE CRASH: ~a - Initiating Micro-Rollback." c) (harness-log "PIPELINE CRASH: ~a - Initiating Micro-Rollback." c)
(rollback-object-store 0) (rollback-object-store 0)
(let ((sensor (ignore-errors (getf (getf current-signal :payload) :sensor)))) (let ((sensor (ignore-errors (getf (getf current-signal :payload) :sensor))))
(if (or (> depth 2) (member sensor '(:loop-error :tool-error))) (if (or (> depth 2) (member sensor '(:loop-error :tool-error)))
@@ -314,10 +314,10 @@ Moves a signal through the gates in a flat loop, handling feedback signals witho
** Delegation Mechanisms ** Delegation Mechanisms
Allows the core to hand off tasks to specialized background agents or processes. Allows the core to hand off tasks to specialized background agents or processes.
#+begin_src lisp :tangle ../src/core.lisp #+begin_src lisp :tangle ../src/loop.lisp
(defun delegate-task (task-id recipient &key context) (defun delegate-task (task-id recipient &key context)
"Enqueues a task for another agent or background process." "Enqueues a task for another agent or background process."
(kernel-log "ORCHESTRATOR: Delegating task ~a to ~a" task-id recipient) (harness-log "ORCHESTRATOR: Delegating task ~a to ~a" task-id recipient)
(inject-stimulus (list :type :EVENT (inject-stimulus (list :type :EVENT
:payload (list :sensor :delegation :payload (list :sensor :delegation
:task-id task-id :task-id task-id
@@ -328,7 +328,7 @@ Allows the core to hand off tasks to specialized background agents or processes.
** Heartbeat Mechanism ** Heartbeat Mechanism
Periodically injects a "pulse" into the system to trigger temporal skills (like cron jobs or reminders). Periodically injects a "pulse" into the system to trigger temporal skills (like cron jobs or reminders).
#+begin_src lisp :tangle ../src/core.lisp #+begin_src lisp :tangle ../src/loop.lisp
(defvar *heartbeat-thread* nil) (defvar *heartbeat-thread* nil)
(defun start-heartbeat (&optional (interval 60)) (defun start-heartbeat (&optional (interval 60))
@@ -338,7 +338,7 @@ Periodically injects a "pulse" into the system to trigger temporal skills (like
(lambda () (lambda ()
(loop (loop
(sleep interval) (sleep interval)
(kernel-log "KERNEL: Heartbeat pulse...") (harness-log "HARNESS: Heartbeat pulse...")
(inject-stimulus (list :type :EVENT :payload (list :sensor :heartbeat :unix-time (get-universal-time)))))) (inject-stimulus (list :type :EVENT :payload (list :sensor :heartbeat :unix-time (get-universal-time))))))
:name "org-agent-heartbeat"))) :name "org-agent-heartbeat")))
@@ -350,29 +350,29 @@ Periodically injects a "pulse" into the system to trigger temporal skills (like
#+end_src #+end_src
** Boot Sequence (initialize-all-skills) ** Boot Sequence (initialize-all-skills)
The kernel initialization sequence has been moved to the Micro-Loader in the skills module. It remains exported for consistency. The harness initialization sequence has been moved to the Micro-Loader in the skills module. It remains exported for consistency.
#+begin_src lisp :tangle ../src/core.lisp #+begin_src lisp :tangle ../src/loop.lisp
(defun load-all-skills () (defun load-all-skills ()
"Deprecated: use initialize-all-skills. Centralized boot orchestrator." "Deprecated: use initialize-all-skills. Centralized boot orchestrator."
(initialize-all-skills)) (initialize-all-skills))
#+end_src #+end_src
** Main Entry Point ** Main Entry Point
The execution entry point for the kernel binary. The execution entry point for the harness binary.
#+begin_src lisp :tangle ../src/core.lisp #+begin_src lisp :tangle ../src/loop.lisp
(defun main () (defun main ()
"The entry point for the compiled standalone binary." "The entry point for the compiled standalone binary."
(let* ((home (uiop:getenv "HOME")) (let* ((home (uiop:getenv "HOME"))
(env-file (uiop:merge-pathnames* ".local/share/org-agent/.env" (uiop:ensure-directory-pathname home)))) (env-file (uiop:merge-pathnames* ".local/share/org-agent/.env" (uiop:ensure-directory-pathname home))))
(if (uiop:file-exists-p env-file) (if (uiop:file-exists-p env-file)
(progn (progn
(format t "KERNEL: Loading environment from ~a~%" env-file) (format t "HARNESS: Loading environment from ~a~%" env-file)
(cl-dotenv:load-env env-file)) (cl-dotenv:load-env env-file))
(format t "KERNEL ERROR: .env not found at ~a~%" 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)) 60))) (let ((interval (or (ignore-errors (parse-integer (uiop:getenv "HEARTBEAT_INTERVAL") :junk-allowed t)) 60)))
(format t "KERNEL: Heartbeat interval set to ~a seconds.~%" interval) (format t "HARNESS: Heartbeat interval set to ~a seconds.~%" interval)
(start-daemon :interval interval)) (start-daemon :interval interval))
(loop (sleep 3600))) (loop (sleep 3600)))
#+end_src #+end_src
@@ -468,8 +468,8 @@ Following the PSF mandates, the Reactive Signal Pipeline must be empirically ver
(is (member "mock-dependent" deps :test #'string-equal)))) (is (member "mock-dependent" deps :test #'string-equal))))
(test test-log-buffering (test test-log-buffering
"Verify that kernel-log correctly populates the system logs." "Verify that harness-log correctly populates the system logs."
(kernel-log "PSF TEST LOG") (harness-log "PSF TEST LOG")
(let ((logs (context-get-system-logs 5))) (let ((logs (context-get-system-logs 5)))
(is (cl:some (lambda (line) (search "PSF TEST LOG" line)) logs)))) (is (cl:some (lambda (line) (search "PSF TEST LOG" line)) logs))))

2
org-agent.asd
View File

@@ -24,7 +24,7 @@
(:file "src/lisp-repair") (:file "src/lisp-repair")
(:file "src/bouncer") (:file "src/bouncer")
(:file "src/verification-logic") (:file "src/verification-logic")
(:file "src/core") (:file "src/loop")
(:file "src/gateway-telegram") (:file "src/gateway-telegram")
(:file "src/gateway-signal") (:file "src/gateway-signal")
(:file "src/gateway-matrix") (:file "src/gateway-matrix")

244
src/loop.lisp Normal file
View File

@@ -0,0 +1,244 @@
(in-package :org-agent)
(defvar *interrupt-flag* nil)
;; MOVED TO package.lisp
(defvar *interrupt-lock* (bt:make-lock "harness-interrupt-lock"))
;; MOVED TO package.lisp
;; MOVED TO package.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)))))
(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 harness-log (fmt &rest args)
"Records a formatted message to the system log and standard output."
(let ((msg (apply #'format nil fmt args)))
(bt:with-lock-held (*logs-lock*) (push msg *system-logs*) (when (> (length *system-logs*) *max-log-history*) (setf *system-logs* (subseq *system-logs* 0 *max-log-history*))))
(format t "~a~%" msg) (finish-output)))
(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)
"Associative: Intuition and proposed actions."
(unless (eq (getf signal :type) :EVENT)
(return-from neuro-gate signal))
(harness-log "GATE [Associative]: Consulting System 1...")
(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 voting or selecting the safest one."
(declare (ignore signal))
(harness-log "CONSENSUS: ~a proposals found. Resolving..." (length proposals))
;; Simplified consensus: Majority vote or first safe one
;; For now, we'll select the proposal that appears most frequently.
(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)
"Deliberate: 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."
(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 (bt:with-lock-held (*interrupt-lock*) *interrupt-flag*)
(harness-log "PIPELINE: 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)))
(error (c)
(harness-log "PIPELINE 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)))))))))))
(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 *heartbeat-thread* nil)
(defun start-heartbeat (&optional (interval 60))
"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 load-all-skills ()
"Deprecated: use initialize-all-skills. Centralized boot orchestrator."
(initialize-all-skills))
(defun main ()
"The entry point for the compiled standalone binary."
(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)) 60)))
(format t "HARNESS: Heartbeat interval set to ~a seconds.~%" interval)
(start-daemon :interval interval))
(loop (sleep 3600)))