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

refactor: deduplicate harness-log and revamp system interface documentation

Browse Source
This commit is contained in:
Amr Gharbeia
2026-04-12 19:11:24 -04:00
parent 32ea9a72a5
commit 8018d59fe3
4 changed files with 99 additions and 200 deletions
Download Patch File Download Diff File Expand all files Collapse all files

48
src/loop.lisp
View File

@@ -2,14 +2,8 @@
(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))
@@ -26,12 +20,6 @@
(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))
@@ -82,10 +70,10 @@
signal))
(defun neuro-gate (signal)
"Associative: Intuition and proposed actions."
"Associative: Neural intuition and proposed actions."
(unless (eq (getf signal :type) :EVENT)
(return-from neuro-gate signal))
(harness-log "GATE [Associative]: Consulting System 1...")
(harness-log "GATE [Associative]: Consulting LLM...")
(let ((thoughts (think signal)))
(setf (getf signal :proposals) (if (and (listp thoughts) (listp (car thoughts)))
thoughts
@@ -94,21 +82,13 @@
signal))
(defun resolve-consensus (proposals signal)
"Resolves diverging proposals by voting or selecting the safest one."
"Resolves diverging proposals by selecting the most consistent 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)
(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)))
@@ -123,7 +103,7 @@
signal))
(defun decide-gate (signal)
"Deliberate: Safety and validation."
"Deliberate: 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))))
@@ -173,14 +153,11 @@
(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 "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))
@@ -206,9 +183,10 @@
:recipient recipient
:context context))))
(defvar *default-heartbeat-interval* 60 "Default interval for the system heartbeat pulse in seconds.")
(defvar *heartbeat-thread* nil)
(defun start-heartbeat (&optional (interval 60))
(defun start-heartbeat (&optional (interval *default-heartbeat-interval*))
"Spawns a thread that periodically injects a heartbeat stimulus."
(setf *heartbeat-thread*
(bt:make-thread
@@ -225,10 +203,6 @@
(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"))
@@ -238,7 +212,7 @@
(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)))
(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))
(loop (sleep 3600)))

30
src/package.lisp
View File

@@ -1,10 +1,11 @@
(defpackage :org-agent
(:use :cl)
(:export
;; --- Harness Protocol Protocol ---
;; --- Harness Protocol ---
#:frame-message
#:parse-message
#:make-hello-message
#:validate-harness-protocol-schema
;; --- Daemon Lifecycle ---
#:start-daemon
@@ -17,7 +18,7 @@
#:lookup-object
#:list-objects-by-type
#:*object-store*
#: *history-store*
#:*history-store*
#:org-object
#:org-object-id
#:org-object-type
@@ -31,7 +32,6 @@
#:org-object-hash
#:snapshot-object-store
#:rollback-object-store
#:send-swarm-packet
;; --- Context API (Peripheral Vision) ---
#:context-query-store
@@ -40,7 +40,6 @@
#:context-list-all-skills
#:context-get-skill-source
#:context-get-system-logs
#:context-filter-sparse-tree
#:context-resolve-path
#:context-get-skill-telemetry
#:context-assemble-global-awareness
@@ -55,7 +54,6 @@
#:inject-stimulus
#:dispatch-action
#:register-actuator
#:spawn-task
;; --- Skill Engine ---
#:load-skill-from-org
@@ -64,7 +62,6 @@
#:topological-sort-skills
#:validate-lisp-syntax
#:safety-harness-validate
#:find-triggered-skill
#:defskill
#:*skills-registry*
#:skill
@@ -91,30 +88,18 @@
#:register-emacs-client
#:unregister-emacs-client
;; --- Neuro (System 1) ---
;; --- Associative Engine ---
#:ask-neuro
#:register-neuro-backend
#:register-auth-provider
#:get-provider-auth
#:distill-prompt
#:get-embedding
#:cosine-similarity
#:find-most-similar
#:openrouter-get-available-models
#:*provider-cascade*
#:token-accountant-route-task
;; --- Symbolic Logic ---
#:list-objects-with-attribute
#:org-id-new
#:decide
;; --- AST Helpers ---
#:find-headline-missing-id
;; --- Environment Config ---
#:set-llm-model
#:get-llm-model))
#:find-headline-missing-id))
(in-package :org-agent)
@@ -126,7 +111,7 @@
"Global registry of all loaded skills.")
(defvar *skill-telemetry* (make-hash-table :test 'equal))
(defvar *telemetry-lock* (bt:make-lock "kernel-telemetry-lock"))
(defvar *telemetry-lock* (bt:make-lock "harness-telemetry-lock"))
(defvar *cognitive-tools* (make-hash-table :test 'equal))
@@ -138,6 +123,7 @@
body)
(defmacro def-cognitive-tool (name description parameters &key guard body)
"Registers a new cognitive tool into the global registry. Parameters must be a list of property lists."
`(setf (gethash (string-downcase (string ',name)) *cognitive-tools*)
(make-cognitive-tool :name (string-downcase (string ',name))
:description ,description