59 KiB
59 KiB
org-agent: The Neurosymbolic Kernel
- The Philosophy
- Mandate 1: Strictly Org-mode and Common Lisp
- Mandate 2: Minimalist Core, Skill-Based Extension
- Why Org-mode? (Homoiconic Memory)
- Why Common Lisp? (The Kernel vs. The Actuators)
- The Actuator-Agnostic Vision (Towards a True Lisp Machine)
- The Neurosymbolic Split (System 1 vs. System 2)
- Literate Programming as Institutional Memory
- Anti-Fragility and Trade-offs
- The Paradigm: Skills vs. Sub-Agents
- Architecture Diagrams
- System Definition
- The Kernel Core
- System 1 (Neural Engine)
- System 2 (Symbolic Gating)
- Skill Engine
- Daemon Runtime
- Long-Term Vision: Orders of Autonomy
- Current State: Order 2 Achieved
A hyper-minimalist, self-editing, proactive AI agent framework. `org-agent` acts as the "executive soul" of a personal OS, using Org-mode as its native memory and Common Lisp as its deterministic reasoning engine.
The Philosophy
Mandate 1: Strictly Org-mode and Common Lisp
The system is built on a "No Legacy" policy. Markdown (.md) and JSON are strictly prohibited for internal system logic, planning, and memory. Org-mode is the native Abstract Syntax Tree (AST) for both human and machine, and Common Lisp (SBCL) is the deterministic reasoning engine.
Mandate 2: Minimalist Core, Skill-Based Extension
The `org-agent` kernel (the Daemon) MUST remain a minimalist microkernel. It handles only the cognitive loop, the persistent Object-Store, and the communication protocol. All business logic, LLM provider connectors, and task-management rules MUST be implemented as hot-reloadable Skills living in the user's Memex.
Why Org-mode? (Homoiconic Memory)
Most agent frameworks rely on a messy combination of Python scripts, JSON states, and Markdown prompts. This breaks the human-agent interface. JSON is for machines; Markdown is for humans.
Org-mode is for both. It provides a hierarchical Abstract Syntax Tree (AST) that a machine can navigate deterministically, while remaining a perfectly ergonomic, human-readable text document.
Why Common Lisp? (The Kernel vs. The Actuators)
The `org-agent` kernel is built in Common Lisp to provide a persistent, high-performance background process (SBCL) that maintains a live, threaded Object Store in RAM.
This architecture treats all interfaces as external Actuators and Sensors:
- Editor Actuator (Emacs): A sensor array that detects file changes and executes structural refactoring.
- Messaging Actuator (Signal/Telegram/Discord): A delivery channel for proactive alerts and human-in-the-loop decisions.
- Web Actuator (Dashboard): A visual telemetry interface for monitoring the live kernel state.
The Actuator-Agnostic Vision (Towards a True Lisp Machine)
While Emacs currently serves as the primary editor actuator, the `org-agent` core is fundamentally actuator-agnostic. Emacs is not a privileged citizen. The OACP (Org-Agent Communication Protocol) expects a serialized Org AST, but it does not care who generates it.
The long-term design trajectory moves toward a "True Lisp Machine" where external editors and browsers are written out of existence:
- Actuators as Dumb Terminals: In the near term, Emacs, bash scripts, and web clients merely render views and pass stimuli to the kernel. All "truth" and state management live securely within the Lisp image.
- The Sovereign GUI: Eventually, the interface itself (the editor, the browser, the system prompt) must be built in Common Lisp (e.g., using McCLIM or Nyxt technologies), running in the exact same address space as the agent. This will completely eliminate the OACP IPC socket for local interaction, creating a unified, zero-latency cognitive environment.
The Neurosymbolic Split (System 1 vs. System 2)
Relying entirely on LLMs (System 1) for agentic workflows is notoriously fragile due to hallucinations and context limits. By using the LLM only for "intuition" (The `Think` phase) and using Common Lisp for deterministic gating and execution (The `Decide` and `Act` phases), the system is creative but strictly bound by mathematical logic. It's safe by design.
Literate Programming as Institutional Memory
The decision to force all system logic and rules into Literate Org files ensures that the "Why" (the PRD and philosophy) never drifts from the "How" (the Lisp implementation). The system documents itself simply by existing.
Anti-Fragility and Trade-offs
While the architecture is beautiful, it comes with specific engineering trade-offs that we manage:
- The Parsing Bottleneck: Org-mode is a complex, plain-text format. While it is homoiconic, parsing massive Org files into Lisp structs every time the kernel starts could become a bottleneck. The `memory-image.lisp` state-dumping mechanism solves this by allowing the system to bypass text parsing and load directly from memory.
- Web/Mobile Accessibility: Optimizing for Lisp and Emacs (structural integrity via `org-id`) often breaks standard web rendering (like Gitea's parsers). A dedicated "Web Actuator" skill is needed to translate the raw Org AST into a consumable format on those platforms.
- The "Zero-Bloat" Discipline: Maintaining the "Lisp Machine Sovereignty" rule (no external dependencies unless strictly necessary) requires constant vigilance as new skills are added.
The Paradigm: Skills vs. Sub-Agents
Modern AI frameworks heavily rely on "Sub-agents" (e.g., passing text between isolated Python scripts). `org-agent` fundamentally rejects this in favor of Org-Native Skills.
The Performance Advantage (Single Address Space)
Following CLOSOS principles, the Lisp Machine architecture uses a Single Address Space. All applications (Skills) and the kernel share one unified memory space. We completely eliminate standard Inter-Process Communication (IPC) overhead. Objects are shared via direct pointers, meaning zero serialization/deserialization latency when moving from perception to thought.
Specialization (System 1 Prompt Injection)
Instead of spinning up separate sub-agent processes with static prompts, the kernel dynamically injects the `:neuro-prompt` of the active skill into the LLM context. The LLM is temporarily "re-programmed" at runtime per task.
Context Length & Memory (Peripheral Vision)
Multi-agent systems struggle with context bloat. `org-agent` solves this via its Peripheral Vision API. The Lisp Kernel uses `context-filter-sparse-tree` to surgically prune the Org AST, passing only the relevant hierarchical nodes to the LLM and preventing context-window overload.
Responsiveness (Dual-Process Advantage)
The system employs a Dual-Process Architecture:
- System 1 (Neural): Probabilistic, slow, creative (LLM).
- System 2 (Symbolic): Deterministic, instant, rigorous (Lisp).
Because Skills are compiled Lisp code, System 2 intercepts deterministic tasks (like assigning an ID) and executes them in milliseconds, bypassing the LLM entirely.
Architecture Diagrams
The Single Address Space
graph TD
subgraph Lisp Machine
K[Kernel Core] --> OS[(Object Store)]
S1[Skill: Architect] --> OS
S2[Skill: Analyst] --> OS
S3[Skill: GTD] --> OS
K -- Pointers --> S1
K -- Pointers --> S2
end
subgraph IPC Slow
E[Emacs Actuator] -. JSON .-> K
endThe Cognitive Loop (OODA)
sequenceDiagram
participant Sensor
participant Kernel
participant System1 as System 1 (LLM)
participant System2 as System 2 (Lisp)
participant Actuator
Sensor->>Kernel: Perceive (Stimulus)
Kernel->>System1: Think (Inject Prompt)
System1-->>Kernel: Proposed Action
Kernel->>System2: Decide (Safety Gate)
alt Validation Failed
System2-->>Kernel: Reject / Log Error
else Validation Passed
System2->>Actuator: Act (Dispatch)
endSystem Definition
This section defines the ASDF system, its dependencies, and the loading order of the modules.
(defsystem :org-agent
:name "org-agent"
:author "Amr"
:version "0.1.0"
:license "MIT"
:description "The Neurosymbolic Lisp Machine Kernel"
:depends-on (:usocket :cl-json :bordeaux-threads :dexador :uiop :cl-dotenv :cl-ppcre :hunchentoot)
:serial t
:components ((:module "src"
:components ((:file "package")
(:file "protocol")
(:file "object-store")
(:file "context")
(:file "embedding")
(:file "skills")
(:file "neuro")
(:file "symbolic")
(:file "core"))))
:build-operation "program-op"
:build-pathname "org-agent-server"
:entry-point "org-agent:main"
:in-order-to ((test-op (test-op :org-agent/tests))))
(defsystem :org-agent/tests
:depends-on (:org-agent :fiveam)
:components ((:module "tests"
:components ((:file "oacp-tests")
(:file "cognitive-loop-tests"))))
:perform (test-op (o s)
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :oacp-suite :org-agent-tests))
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :cognitive-suite :org-agent-cognitive-tests))))The Kernel Core
The physical implementation of the daemon, tangled from this Org document into src/.
Namespace & API
(defpackage :org-agent
(:use :cl)
(:export
;; --- OACP Protocol ---
#:frame-message
#:parse-message
#:make-hello-message
;; --- Daemon Lifecycle ---
#:start-daemon
#:stop-daemon
#:kernel-log
#:main
;; --- Object Store (CLOSOS) ---
#:ingest-ast
#:lookup-object
#:list-objects-by-type
#:*object-store*
#:org-object
#:org-object-id
#:org-object-type
#:org-object-attributes
#:org-object-children
#:org-object-vector
#:org-object-content
#:snapshot-object-store
#:rollback-object-store
#:send-swarm-packet
;; --- Context API (Peripheral Vision) ---
#:context-query-store
#:context-get-active-projects
#:context-get-recent-completed-tasks
#:context-list-all-skills
#:context-get-skill-source
#:context-get-system-logs
#:context-filter-sparse-tree
#:context-resolve-path
#:context-get-skill-telemetry
;; --- Cognitive Loop & Event Bus ---
#:perceive
#:think
#:decide
#:act
#:cognitive-loop
#:inject-stimulus
#:dispatch-action
#:register-actuator
#:spawn-task
;; --- Skill Engine ---
#:load-skill-from-org
#:validate-lisp-syntax
#:find-triggered-skill
#:defskill
#:*skills-registry*
#:skill
#:skill-name
#:skill-priority
#:skill-trigger-fn
#:skill-neuro-prompt
#:skill-symbolic-fn
;; --- Tool Registry ---
#:def-cognitive-tool
#:*cognitive-tools*
#:cognitive-tool
#:cognitive-tool-name
#:cognitive-tool-description
#:cognitive-tool-parameters
#:cognitive-tool-guard
#:cognitive-tool-body
;; --- Emacs Client Registry ---
#:*emacs-clients*
#:*clients-lock*
#:register-emacs-client
#:unregister-emacs-client
;; --- Neuro (System 1) ---
#: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*
#:economist-route-task
;; --- Symbolic Logic ---
#:list-objects-with-attribute
#:org-id-new
;; --- AST Helpers ---
#:find-headline-missing-id
;; --- Environment Config ---
#:set-llm-model
#:get-llm-model))Communication (OACP)
(in-package :org-agent)
(defun frame-message (msg-string)
"Prefix MSG-STRING with a 6-character hex length (lowercase)."
(let ((len (length msg-string)))
(format nil "~(~6,'0x~)~a" len msg-string)))
(defun parse-message (framed-string)
"Extract and parse the S-expression from a framed string."
(when (< (length framed-string) 6)
(error "Framed string too short"))
(let* ((len-str (subseq framed-string 0 6))
(actual-msg (subseq framed-string 6))
(expected-len (ignore-errors (parse-integer len-str :radix 16))))
(unless expected-len
(error "Invalid hex length prefix: ~a" len-str))
(unless (= expected-len (length actual-msg))
(error "Message length mismatch. Expected ~a, got ~a" expected-len (length actual-msg)))
(read-from-string actual-msg)))
(defun make-hello-message (version)
"Construct the standard HELLO handshake message."
(list :type :EVENT
:payload (list :action :handshake
:version version
:capabilities '(:auth :swank :org-ast))))Perceptual Memory (Object Store)
(in-package :org-agent)
(defvar *object-store* (make-hash-table :test 'equal))
(defstruct org-object
id type attributes content vector parent-id children version last-sync)
(defun ingest-ast (ast &optional parent-id)
(let* ((type (getf ast :type))
(props (getf ast :properties))
(id (or (getf props :ID) (format nil "temp-~a" (get-universal-time))))
(contents (getf ast :contents))
(raw-content (when (eq type :HEADLINE)
(format nil "~a~%~a" (getf props :TITLE) (or (cl:getf ast :raw-content) ""))))
(should-embed (and raw-content (equal (getf props :EMBED) "t")))
(child-ids nil))
(dolist (child contents)
(when (listp child) (push (ingest-ast child id) child-ids)))
(let ((obj (make-org-object
:id id :type type :attributes props :content raw-content
:vector (when should-embed (get-embedding raw-content))
:parent-id parent-id :children (nreverse child-ids)
:version (get-universal-time) :last-sync (get-universal-time))))
(setf (gethash id *object-store*) obj)
id)))
(defvar *object-store-snapshots* nil)
(defun clone-org-object (obj)
(make-org-object
:id (org-object-id obj) :type (org-object-type obj)
:attributes (copy-list (org-object-attributes obj))
:content (org-object-content obj) :vector (org-object-vector obj)
:parent-id (org-object-parent-id obj) :children (copy-list (org-object-children obj))
:version (org-object-version obj) :last-sync (org-object-last-sync obj)))
(defun snapshot-object-store ()
(let ((snapshot (make-hash-table :test 'equal)))
(maphash (lambda (id obj) (setf (gethash id snapshot) (clone-org-object obj))) *object-store*)
(push (list :timestamp (get-universal-time) :data snapshot) *object-store-snapshots*)
(when (> (length *object-store-snapshots*) 20)
(setf *object-store-snapshots* (subseq *object-store-snapshots* 0 20)))
(kernel-log "MEMORY - Object Store snapshot created.")))
(defun rollback-object-store (&optional (index 0))
(let ((snapshot (nth index *object-store-snapshots*)))
(if snapshot
(progn (setf *object-store* (getf snapshot :data))
(kernel-log "MEMORY - Object Store rolled back to snapshot ~a" index))
(kernel-log "MEMORY ERROR - Snapshot ~a not found." index))))
(defun lookup-object (id) (gethash id *object-store*))
(defun list-objects-by-type (type)
(let ((results nil))
(maphash (lambda (id obj) (declare (ignore id)) (when (eq (org-object-type obj) type) (push obj results))) *object-store*)
results))
(defun find-headline-missing-id (ast)
(when (listp ast)
(if (and (eq (getf ast :type) :HEADLINE) (not (getf (getf ast :properties) :ID)))
ast
(cl:some #'find-headline-missing-id (getf ast :contents)))))
(defun file-name-nondirectory (path)
(let ((pos (position #\/ path :from-end t))) (if pos (subseq path (1+ pos)) path)))Peripheral Vision (Context API)
(in-package :org-agent)
(defun context-query-store (&key tag todo-state type)
(let ((results nil))
(maphash (lambda (id obj)
(declare (ignore id))
(let* ((attrs (org-object-attributes obj)) (state (getf attrs :TODO-STATE)) (match t))
(when (and type (not (eq (org-object-type obj) type))) (setf match nil))
(when tag (unless (search tag (format nil "~a" (getf attrs :TAGS)) :test #'string-equal) (setf match nil)))
(when (and todo-state (not (equal state todo-state))) (setf match nil))
(when match (push obj results))))
*object-store*)
results))
(defun context-get-active-projects ()
(remove-if (lambda (obj) (equal (getf (org-object-attributes obj) :TODO-STATE) "DONE"))
(context-query-store :tag "project" :type :HEADLINE)))
(defun context-get-recent-completed-tasks () (context-query-store :todo-state "DONE" :type :HEADLINE))
(defun context-list-all-skills ()
(let ((results nil))
(maphash (lambda (name skill)
(declare (ignore name))
(push (list :name (skill-name skill) :priority (skill-priority skill) :dependencies (skill-dependencies skill)) results))
*skills-registry*)
(sort results #'> :key (lambda (x) (getf x :priority)))))
(defun context-get-skill-source (skill-name)
(let* ((filename (format nil "~a.org" skill-name))
(skills-dir (merge-pathnames "skills/" (asdf:system-source-directory :org-agent)))
(full-path (merge-pathnames filename skills-dir)))
(if (uiop:file-exists-p full-path) (uiop:read-file-string full-path) nil)))
(defun context-get-system-logs (&optional (limit 20))
(bt:with-lock-held (*logs-lock*)
(let ((count (min limit (length *system-logs*)))) (subseq *system-logs* 0 count))))
(defun context-get-skill-telemetry (skill-name)
(bt:with-lock-held (*telemetry-lock*) (gethash (string-downcase skill-name) *skill-telemetry*)))
(defun context-filter-sparse-tree (ast predicate)
(if (listp ast)
(let* ((contents (getf ast :contents))
(filtered-contents (remove-if #'null (mapcar (lambda (c) (context-filter-sparse-tree c predicate)) contents))))
(if (or (funcall predicate ast) (not (null filtered-contents)))
(let ((new-ast (copy-list ast))) (setf (getf new-ast :contents) filtered-contents) new-ast)
nil))
nil))
(defun context-resolve-path (path-string)
(if (and (stringp path-string) (uiop:string-prefix-p "$" path-string))
(let* ((parts (uiop:split-string path-string :separator '(#\/)))
(var-name (subseq (car parts) 1)) (var-val (uiop:getenv var-name))
(remaining (cl:reduce (lambda (a b) (format nil "~a/~a" a b)) (cdr parts))))
(if var-val (let ((clean-val (string-trim '(#\" #\Space) var-val)))
(format nil "~a/~a" (string-right-trim "/" clean-val) remaining))
path-string))
path-string))System 1 (Neural Engine)
Embedding Logic
(in-package :org-agent)
(defun get-embedding (text)
(let* ((auth (get-provider-auth :gemini)) (api-key (getf auth :api-key))
(endpoint "https://generativelanguage.googleapis.com/v1beta/models/text-embedding-004:embedContent"))
(unless api-key (return-from get-embedding nil))
(let* ((url (format nil "~a?key=~a" endpoint api-key)) (headers `(("Content-Type" . "application/json")))
(body (cl-json:encode-json-to-string `((model . "models/text-embedding-004") (content . ((parts . ((text . ,text)))))))))
(handler-case (let* ((response (dex:post url :headers headers :content body))
(json (cl-json:decode-json-from-string response)))
(cdr (assoc :values (cdr (assoc :embedding json)))))
(error (c) (kernel-log "EMBEDDING FAILURE: ~a" c) nil)))))
(defun dot-product (v1 v2) (reduce #'+ (mapcar #'* v1 v2)))
(defun magnitude (v) (sqrt (reduce #'+ (mapcar (lambda (x) (* x x)) v))))
(defun cosine-similarity (v1 v2)
(let ((m1 (magnitude v1)) (m2 (magnitude v2))) (if (or (zerop m1) (zerop m2)) 0 (/ (dot-product v1 v2) (* m1 m2)))))
(defun find-most-similar (query-vector top-k)
(let ((similarities nil))
(maphash (lambda (id obj) (let ((vec (org-object-vector obj))) (when vec (push (cons (cosine-similarity query-vector vec) obj) similarities)))) *object-store*)
(let ((sorted (sort similarities #'> :key #'car))) (subseq sorted 0 (min top-k (length sorted))))))Neural Logic
(in-package :org-agent)
(defun get-env (var &optional default) (or (uiop:getenv var) default))
(defvar *auth-providers* (make-hash-table :test 'equal))
(defun register-auth-provider (name fn) (setf (gethash name *auth-providers*) fn))
(defun get-provider-auth (provider)
"Retrieves authentication credentials for a provider.
Supports direct plists, functions, or specific environment variable fallbacks."
(let ((auth (gethash provider *auth-providers*)))
(cond
((functionp auth) (funcall auth))
((listp auth) auth)
(t
(let ((specific-key (case provider
(:gemini (uiop:getenv "GEMINI_API_KEY"))
(:openrouter (uiop:getenv "OPENROUTER_API_KEY"))
(:anthropic (uiop:getenv "ANTHROPIC_API_KEY"))
(:openai (uiop:getenv "OPENAI_API_KEY"))
(t nil))))
(if (and specific-key (> (length specific-key) 0))
(list :api-key specific-key)
;; Final fallback to the legacy generic key
(let ((legacy (uiop:getenv "LLM_API_KEY")))
(when (and legacy (> (length legacy) 0))
(list :api-key legacy)))))))))
(defvar *neuro-backends* (make-hash-table :test 'equal))
(defvar *provider-cascade* '(:openrouter :gemini))
(defun register-neuro-backend (name fn) (setf (gethash name *neuro-backends*) fn))
(defvar *model-selector-fn* nil "A function called with (provider context) to return a model ID.")
(defun ask-neuro (prompt &key (system-prompt "You are the System 1 engine of a Neurosymbolic Lisp Machine.") (cascade nil) (context nil))
"Dispatches a neural request through the provider cascade.
If CASCADE is a function, it is called with CONTEXT to determine backends."
(let ((backends (cond
((and cascade (listp cascade)) cascade)
((functionp cascade) (funcall cascade context))
((functionp *provider-cascade*) (funcall *provider-cascade* context))
(t *provider-cascade*))))
(dolist (backend backends)
(let ((backend-fn (gethash backend *neuro-backends*)))
(when backend-fn
(kernel-log "SYSTEM 1: 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))))
(if (and (stringp result) (search ":LOG" result) (or (search "Failure" result) (search "missing" result)))
(kernel-log "SYSTEM 1: Backend ~a failed. Falling back..." backend)
(return-from ask-neuro result))))))
"(:type :LOG :payload (:text \"Neural Cascade Failure\"))"))
(defun execute-gemini-request (prompt system-prompt &key model)
(let* ((auth (get-provider-auth :gemini)) (api-key (getf auth :api-key)) (bearer-token (getf auth :bearer-token))
(endpoint-base (if model (format nil "https://generativelanguage.googleapis.com/v1/models/~a:generateContent" model)
(return-from execute-gemini-request "(:type :LOG :payload (:text \"Error: Gemini Model ID missing.\"))"))))
(unless (or api-key bearer-token) (return-from execute-gemini-request "(:type :LOG :payload (:text \"Authentication missing\"))"))
(let* ((url (if api-key (format nil "~a?key=~a" endpoint-base api-key) endpoint-base))
(headers `(("Content-Type" . "application/json") ,@(when bearer-token `(("Authorization" . ,(format nil "Bearer ~a" bearer-token))))))
(body (cl-json:encode-json-to-string `((contents . ((parts . ((text . ,(format nil "~a~%~%Prompt: ~a" system-prompt prompt))))))))))
(handler-case (let* ((response (dex:post url :headers headers :content body :connect-timeout 10 :read-timeout 30)) (json (cl-json:decode-json-from-string response)))
(cdr (assoc :text (cdr (assoc :parts (car (cdr (assoc :parts (car (cdr (assoc :candidates json)))))))))))
(error (c) (format nil "(:type :LOG :payload (:text \"Neural Engine Failure: ~a\"))" c))))))
(defun execute-groq-request (prompt system-prompt &key model)
(let ((api-key (uiop:getenv "GROQ_API_KEY"))
(endpoint "https://api.groq.com/openai/v1/chat/completions"))
(unless model (return-from execute-groq-request "(:type :LOG :payload (:text \"Error: Groq Model ID missing.\"))"))
(unless api-key (return-from execute-groq-request "(:type :LOG :payload (:text \"Groq API Key missing\"))"))
(let* ((headers `(("Content-Type" . "application/json")
("Authorization" . ,(format nil "Bearer ~a" api-key))))
(body (cl-json:encode-json-to-string
`((model . ,model)
(messages . (( (role . "system") (content . ,system-prompt) )
( (role . "user") (content . ,prompt) )))))))
(handler-case (let* ((response (dex:post endpoint :headers headers :content body :connect-timeout 5 :read-timeout 10))
(json (cl-json:decode-json-from-string response)))
(cdr (assoc :content (cdr (assoc :message (car (cdr (assoc :choices json))))))))
(error (c) (format nil "(:type :LOG :payload (:text \"Groq Failure: ~a\"))" c))))))
(defun execute-openrouter-request (prompt system-prompt &key model)
(let ((api-key (uiop:getenv "OPENROUTER_API_KEY"))
(endpoint "https://openrouter.ai/api/v1/chat/completions"))
(unless model (return-from execute-openrouter-request "(:type :LOG :payload (:text \"Error: Model ID missing. Accountant must provide a model.\"))"))
(unless api-key (return-from execute-openrouter-request "(:type :LOG :payload (:text \"OpenRouter API Key missing\"))"))
(let* ((headers `(("Content-Type" . "application/json")
("Authorization" . ,(format nil "Bearer ~a" api-key))
("HTTP-Referer" . "https://github.com/amr/org-agent")))
(body (cl-ppcre:regex-replace-all "\\\\/"
(cl-json:encode-json-to-string
`((model . ,model)
(messages . (( (role . "system") (content . ,system-prompt) )
( (role . "user") (content . ,prompt) )))))
"/")))
(kernel-log "OPENROUTER DEBUG - Body: ~a" body)
(handler-case (let* ((response (dex:post endpoint :headers headers :content body :connect-timeout 10 :read-timeout 30)))
(kernel-log "OPENROUTER DEBUG - Raw Response: ~a" response)
(let ((json (cl-json:decode-json-from-string response)))
(cdr (assoc :content (cdr (assoc :message (car (cdr (assoc :choices json)))))))))
(error (c)
(kernel-log "OPENROUTER ERROR: ~a" c)
(if (typep c 'dex:http-request-failed)
(kernel-log "OPENROUTER ERROR BODY: ~a" (dex:response-body c)))
(format nil "(:type :LOG :payload (:text \"OpenRouter Failure: ~a\"))" c))))))
(defun openrouter-get-available-models ()
"Fetches available models from OpenRouter."
(let ((api-key (uiop:getenv "OPENROUTER_API_KEY")))
(unless api-key (return-from openrouter-get-available-models nil))
(let ((headers `(("Authorization" . ,(format nil "Bearer ~a" api-key)))))
(handler-case
(let* ((response (dex:get "https://openrouter.ai/api/v1/models"
:headers headers
:connect-timeout 60
:read-timeout 60))
(json (cl-json:decode-json-from-string response))
(data (cdr (assoc :data json)))
(results nil))
(dolist (item data)
(let ((id (cdr (assoc :id item)))
(context-len (cdr (assoc :context--length item))))
(when id
(push (list :id id :context (format nil "~a" (or context-len "unknown"))) results))))
(nreverse results))
(error (c)
(kernel-log "Model Discovery Error: ~a" c)
nil)))))
;; --- Sovereign Service Stubs ---
;; These are implemented in specialized skills but registered in the kernel namespace.
(defun economist-route-task (complexity)
"Stub for Neuro-Economic routing. Overridden by skill-economist."
(declare (ignore complexity))
:gemini) ; Default fallback
(defun org-id-new ()
"Stub for Sovereign ID generation. Overridden by skill-ast-normalization."
(format nil "node-~a" (get-universal-time)))
(register-neuro-backend :gemini #'execute-gemini-request)
(register-neuro-backend :openrouter #'execute-openrouter-request)
(register-neuro-backend :groq #'execute-groq-request)
(defvar *provider-cascade* '(:openrouter :gemini)) ; Default fallback only
(defun get-org-timestamp ()
"Returns a current Org-mode active timestamp."
(multiple-value-bind (sec min hour day month year day-of-week) (decode-universal-time (get-universal-time))
(declare (ignore sec))
(let ((day-names '("Mon" "Tue" "Wed" "Thu" "Fri" "Sat" "Sun")))
(format nil "[~4,'0d-~2,'0d-~2,'0d ~a ~2,'0d:~2,'0d]"
year month day (nth day-of-week day-names) hour min))))
(defun update-note-metadata (filepath)
"Ensures a :PROPERTIES: drawer exists and updates the :EDITED: timestamp."
(let ((content (uiop:read-file-string filepath))
(now (get-org-timestamp)))
(if (search ":PROPERTIES:" content)
;; Update existing EDITED or add it
(let ((new-content (if (search ":EDITED:" content)
(cl-ppcre:regex-replace ":EDITED: \\[.*?\\]" content (format nil ":EDITED: ~a" now))
(cl-ppcre:regex-replace ":PROPERTIES:\\n" content (format nil ":PROPERTIES:~%:EDITED: ~a~%" now)))))
(with-open-file (out filepath :direction :output :if-exists :supersede)
(write-string new-content out)))
;; Create new drawer
(let ((new-content (format nil ":PROPERTIES:~%:CREATED: ~a~%:EDITED: ~a~%:END:~%~a" now now content)))
(with-open-file (out filepath :direction :output :if-exists :supersede)
(write-string new-content out))))))
(defun think (context)
(let ((active-skill (find-triggered-skill context))
(tool-belt (generate-tool-belt-prompt)))
(if active-skill
(progn
(kernel-log "SYSTEM 1: 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.
If you need to do multiple things or need information from a tool, you MUST:
1. Call the tool FIRST.
2. Wait for the result in the next recursive turn.
3. Only then reply to the user or call the next tool.
"
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)))
(kernel-log "SYSTEM 1 RAW: ~a~%" thought)
(let* ((cleaned-thought
(let ((match (cl-ppcre:scan-to-strings "(?s)```(?:lisp)?\\n?(.*?)\\n?```" thought)))
(if match
(let ((regs (nth-value 1 (cl-ppcre:scan-to-strings "(?s)```(?:lisp)?\\n?(.*?)\\n?```" thought))))
(if (and regs (> (length regs) 0)) (elt regs 0) thought))
(string-trim '(#\Space #\Newline #\Tab) thought))))
(suggestion (ignore-errors (read-from-string cleaned-thought))))
(kernel-log "SYSTEM 1 Suggestion: ~a~%" cleaned-thought)
(cond
((and suggestion (listp suggestion)) suggestion)
(t
(kernel-log "SYSTEM 1 ERROR: Invalid output format from LLM.~%")
nil))))
'(:type :LOG :payload (:text "Skill triggered (Deterministic only)")))))
nil)))
(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)))
(defun distillation-loop ()
"Autonomous distillation cycle (Skeletal)."
(kernel-log "NEURO [Evolution] - Distillation cycle triggered."))System 2 (Symbolic Gating)
Symbolic Logic
(in-package :org-agent)
(defun decide (proposed-action context)
(let ((active-skill (find-triggered-skill context)))
(if (and proposed-action (listp proposed-action) active-skill)
(let* ((symbolic-gate (skill-symbolic-fn active-skill))
(payload (getf proposed-action :payload))
(action (or (getf payload :action) (getf proposed-action :action)))
(code (or (getf payload :code) (getf proposed-action :code))))
;; Global safety harness for EVAL
(when (and (member (getf proposed-action :type) '(:request :REQUEST))
(member action '(:eval :EVAL)))
(let ((harness-pkg (find-package :org-agent.skills.org-skill-safety-harness)))
(when (and code harness-pkg)
(unless (ignore-errors (uiop:symbol-call :org-agent.skills.org-skill-safety-harness :safety-harness-validate code))
(kernel-log "SYSTEM 2 [GLOBAL]: Security violation blocked.~%")
(return-from decide '(:type :LOG :payload (:text "Blocked by Global Safety Harness")))))))
;; Skill-specific verification
(if symbolic-gate
(let ((decision (funcall symbolic-gate proposed-action context)))
(if decision
(progn (kernel-log "SYSTEM 2: Verified by skill '~a'.~%" (skill-name active-skill)) decision)
(progn (kernel-log "SYSTEM 2: REJECTED by skill '~a'.~%" (skill-name active-skill))
'(:type :LOG :payload (:text "Action rejected by skill heuristics")))))
(progn (kernel-log "SYSTEM 2: Verified (Implicitly safe for skill '~a').~%" (skill-name active-skill)) proposed-action)))
proposed-action)))
(defun list-objects-with-attribute (attr-key attr-val)
(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))Skill Engine
Skill Logic
(in-package :org-agent)
(defvar *skills-registry* (make-hash-table :test 'equal))
(defstruct skill name priority dependencies trigger-fn neuro-prompt symbolic-fn)
(defvar *cognitive-tools* (make-hash-table :test 'equal))
(defstruct cognitive-tool name description parameters guard body)
(defmacro def-cognitive-tool (name description &key parameters guard body)
`(setf (gethash (string-downcase (string ,name)) *cognitive-tools*)
(make-cognitive-tool :name (string-downcase (string ,name))
:description ,description
:parameters ',parameters
:guard ,guard
:body ,body)))
(defun generate-tool-belt-prompt ()
(let ((output (format nil "AVAILABLE TOOLS:
You can call tools by returning a Lisp plist: (:target :tool :action :call :tool <name> :args (...))
EXAMPLES:
(:target :tool :action :call :tool \"eval\" :args (:code \"(+ 1 1)\"))
(:target :tool :action :call :tool \"grep-search\" :args (:pattern \"sovereignty\"))
(:target :tool :action :call :tool \"shell\" :args (:cmd \"ls -la\"))
---
")))
(maphash (lambda (name tool)
(setf output (concatenate 'string output
(format nil "- ~a: ~a~% Parameters: ~s~%~%"
name
(cognitive-tool-description tool)
(cognitive-tool-parameters tool)))))
*cognitive-tools*)
output))
(defmacro defskill (name &key priority dependencies trigger neuro symbolic)
`(setf (gethash ,(string-downcase (string name)) *skills-registry*)
(make-skill :name ,(string-downcase (string name)) :priority (or ,priority 10) :dependencies ,dependencies
:trigger-fn ,trigger :neuro-prompt ,neuro :symbolic-fn ,symbolic)))
(defun find-triggered-skill (context)
(let ((triggered nil))
(maphash (lambda (name skill) (declare (ignore name)) (when (ignore-errors (funcall (skill-trigger-fn skill) context)) (push skill triggered))) *skills-registry*)
(first (sort triggered #'> :key #'skill-priority))))
(defun resolve-skill-dependencies (skill-name)
(let ((resolved nil) (seen nil))
(labels ((visit (name) (unless (member name seen :test #'equal) (push name seen)
(let ((skill (gethash (string-downcase (string name)) *skills-registry*)))
(when skill (dolist (dep (skill-dependencies skill)) (visit dep))))
(push name resolved))))
(visit skill-name) (nreverse resolved))))
(defun load-skill-from-org (filepath)
(when (uiop:file-exists-p filepath)
(let* ((content (uiop:read-file-string filepath)) (lines (uiop:split-string content :separator '(#\Newline)))
(in-lisp-block nil) (lisp-code "") (dependencies nil) (skill-base-name (pathname-name filepath))
(pkg-name (intern (string-upcase (format nil "ORG-AGENT.SKILLS.~a" skill-base-name)) :keyword)))
(dolist (line lines)
(let ((clean-line (string-trim '(#\Space #\Tab #\Return) line)))
(when (uiop:string-prefix-p "#+DEPENDS_ON:" (string-upcase clean-line))
(setf dependencies (mapcar (lambda (s) (string-trim "[] " s)) (uiop:split-string (subseq clean-line 13) :separator '(#\Space)))))))
(dolist (line lines)
(let ((clean-line (string-trim '(#\Space #\Tab #\Return) line)))
(cond ((uiop:string-prefix-p "#+begin_src lisp" (string-downcase clean-line)) (setf in-lisp-block t))
((uiop:string-prefix-p "#+end_src" (string-downcase clean-line)) (setf in-lisp-block nil))
(in-lisp-block (setf lisp-code (concatenate 'string lisp-code line (string #\Newline)))))))
(when (> (length lisp-code) 0)
(kernel-log "KERNEL: Jailing skill '~a' in package ~a" skill-base-name pkg-name)
(unless (find-package pkg-name)
(let ((new-pkg (make-package pkg-name :use '(:cl))))
(do-external-symbols (sym (find-package :org-agent)) (shadowing-import sym new-pkg))))
(let ((*read-eval* nil) (*package* (find-package pkg-name)))
(handler-case (eval (read-from-string (format nil "(progn ~a)" lisp-code)))
(error (c) (kernel-log "READER ERROR in skill '~a': ~a~%" skill-base-name c))))))))
(defun validate-lisp-syntax (code-string)
(handler-case (let ((*read-eval* nil)) (with-input-from-string (stream (format nil "(progn ~a)" code-string))
(loop for form = (read stream nil :eof) until (eq form :eof)) (values t nil)))
(error (c) (values nil (format nil "~a" c)))))
(def-cognitive-tool :eval "Evaluates raw Common Lisp code in the kernel image. Use this for complex calculations or internal state inspection."
:parameters ((:code :type :string :description "The Lisp code to evaluate"))
:guard (lambda (args context)
(declare (ignore context))
(let ((code (getf args :code)))
;; Reuse the global safety harness if it exists
(let ((harness-pkg (find-package :org-agent.skills.org-skill-safety-harness)))
(if harness-pkg
(uiop:symbol-call :org-agent.skills.org-skill-safety-harness :safety-harness-validate code)
t)))) ; Implicitly safe if harness not loaded
:body (lambda (args)
(let ((code (getf args :code)))
(handler-case (let ((result (eval (read-from-string code))))
(format nil "~s" result))
(error (c) (format nil "ERROR: ~a" c))))))
(def-cognitive-tool :grep-search "Searches for a pattern in the project files."
:parameters ((:pattern :type :string :description "The regex pattern to search for")
(:dir :type :string :description "Directory to search in (default is project root)"))
:body (lambda (args)
(let ((pattern (getf args :pattern))
(dir (or (getf args :dir) (uiop:getenv "MEMEX_DIR"))))
(uiop:run-program (list "grep" "-r" "-n" "--exclude-dir=node_modules" pattern dir)
:output :string :ignore-error-status t))))
(def-cognitive-tool :shell "Executes a shell command on the local machine. Use this for file operations, system checks, or running tests."
:parameters ((:cmd :type :string :description "The full bash command to execute"))
:guard (lambda (args context)
(declare (ignore context))
;; Global safety: prohibit destructive commands
(let ((cmd (getf args :cmd)))
(not (or (search "rm -rf /" cmd) (search ":(){ :|:& };:" cmd)))))
:body (lambda (args)
(let ((cmd (getf args :cmd)))
(multiple-value-bind (out err code)
(uiop:run-program (list "bash" "-c" cmd) :output :string :error-output :string :ignore-error-status t)
(format nil "EXIT-CODE: ~a~%~%STDOUT:~%~a~%~%STDERR:~%~a" code out err)))))Daemon Runtime
Lifecycle & Loop
(in-package :org-agent)
(defvar *system-logs* nil)
(defvar *logs-lock* (bt:make-lock "kernel-logs-lock"))
(defvar *max-log-history* 100)
(defvar *interrupt-flag* nil)
(defvar *interrupt-lock* (bt:make-lock "kernel-interrupt-lock"))
(defvar *skill-telemetry* (make-hash-table :test 'equal))
(defvar *telemetry-lock* (bt:make-lock "kernel-telemetry-lock"))
(defun kernel-track-telemetry (skill-name duration status)
(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 kernel-log (fmt &rest 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*))))
(format t "~a~%" msg) (finish-output)))
(defvar *heartbeat-thread* nil)
(defvar *actuator-registry* (make-hash-table :test 'equal))
(defun register-actuator (name fn)
"Registers an actuator function. Actuators receive two arguments: (ACTION CONTEXT)."
(setf (gethash name *actuator-registry*) fn))
(defun inject-stimulus (raw-message &key stream)
(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) (kernel-log "ASYNC ERROR: ~a" c) (invoke-restart 'skip-event))))
(cognitive-loop 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)))) (cognitive-loop raw-message))
(skip-event () (kernel-log "SYSTEM RECOVERY: Stimulus dropped.~%"))))))
(defun spawn-task (task-description &key (async-p t))
(inject-stimulus `(:type :EVENT :payload (:sensor :delegation :query ,task-description :async-p ,async-p))))
(defun send-swarm-packet (target-url payload)
(let* ((json-payload (cl-json:encode-json-to-string payload)) (headers '(("Content-Type" . "application/json"))))
(handler-case (dex:post target-url :headers headers :content json-payload) (error (c) (kernel-log "SWARM ERROR: ~a" c) nil))))
(defun dispatch-action (action context)
(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) (kernel-log "DISPATCH ERROR: No actuator for ~a" target)))))
(defun execute-system-action (action context)
(declare (ignore context))
(let* ((payload (ignore-errors (getf action :payload))) (cmd (ignore-errors (getf payload :action))))
(case cmd
(:eval (let ((code (getf payload :code)))
(kernel-log "ACTUATOR [System] - Evaluating: ~a" code)
(handler-case (let ((result (eval (read-from-string code))))
(kernel-log "ACTUATOR [System] - Result: ~s" result)
result)
(error (c) (kernel-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)))
(kernel-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 (kernel-log "ACTUATOR [System] - ~a" (getf payload :text)))
(t (kernel-log "ACTUATOR [System] - Unknown command ~s" cmd)))))
(defun cognitive-loop (raw-message &optional (depth 0))
(when (> depth 10)
(kernel-log "SYSTEM ERROR: Maximum cognitive depth reached.")
(return-from cognitive-loop nil))
(when (bt:with-lock-held (*interrupt-lock*) *interrupt-flag*)
(kernel-log "SYSTEM: Loop interrupted.")
(bt:with-lock-held (*interrupt-lock*) (setf *interrupt-flag* nil))
(return-from cognitive-loop nil))
(handler-case
(let* ((start-time (get-internal-real-time))
(type (getf raw-message :type))
(perceive-fn (find-symbol "PERCEIVE" :org-agent))
(context (if perceive-fn (funcall perceive-fn raw-message) raw-message)))
(snapshot-object-store)
(if (eq type :REQUEST)
(dispatch-action raw-message context)
(let* ((skill (find-triggered-skill context))
(skill-name (when skill (skill-name skill)))
(proposed-action (think context))
(approved-action (decide proposed-action context))
(status (if (and proposed-action (null approved-action)) :rejected :success))
(duration (- (get-internal-real-time) start-time)))
(when skill-name (kernel-track-telemetry skill-name duration status))
(let* ((payload (getf approved-action :payload))
(target (getf approved-action :target))
(action (or (getf payload :action) (getf approved-action :action)))
(tool-name (or (getf payload :tool) (getf approved-action :tool)))
(tool-args (or (getf payload :args) (getf approved-action :args))))
(if (and approved-action (eq target :tool) (eq action :call))
;; Internal Tool Execution
(let* ((tool (gethash (string-downcase (string tool-name)) *cognitive-tools*)))
(if tool
(progn
(kernel-log "SYSTEM 2: Executing tool '~a'..." tool-name)
(let* ((clean-args (if (and (listp tool-args) (listp (car tool-args))) (car tool-args) tool-args))
(tool-result (funcall (cognitive-tool-body tool) clean-args))
(next-stimulus `(:type :EVENT :payload (:sensor :tool-output :result ,tool-result :tool ,tool-name))))
(when (getf raw-message :reply-stream) (setf (getf next-stimulus :reply-stream) (getf raw-message :reply-stream)))
(cognitive-loop next-stimulus (1+ depth))))
(progn
(kernel-log "SYSTEM ERROR: Tool '~a' not found in registry." tool-name)
(let ((err-stimulus `(:type :EVENT :payload (:sensor :tool-error :message "Tool not found"))))
(when (getf raw-message :reply-stream) (setf (getf err-stimulus :reply-stream) (getf raw-message :reply-stream)))
(cognitive-loop err-stimulus (1+ depth))))))
;; Physical Actuation (Emacs, Shell, etc.)
(let ((result (dispatch-action approved-action context)))
(when (and result (not (member target '(:emacs :system-message))))
(let ((fallback-stimulus `(:type :EVENT :payload (:sensor :tool-output :result ,result :tool ,approved-action))))
(when (getf raw-message :reply-stream) (setf (getf fallback-stimulus :reply-stream) (getf raw-message :reply-stream)))
(cognitive-loop fallback-stimulus (1+ depth))))))))))
(error (c)
(kernel-log "LOOP CRASH - Error in recursive turn: ~a~%" c)
nil)))
(defun perceive (raw-message)
(let ((type (getf raw-message :type)) (payload (getf raw-message :payload)))
(kernel-log "PERCEIVE: ~a (~a)" type (or (getf payload :sensor) "no-sensor"))
(cond ((eq type :EVENT) (let ((sensor (getf payload :sensor)))
(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)
(kernel-log "ACT RESULT: ~a~%PAYLOAD: ~s~%" (getf payload :status) payload)))
raw-message))
(defun start-heartbeat (&optional (interval 60))
(setf *heartbeat-thread* (bt:make-thread (lambda () (loop (sleep interval) (kernel-log "KERNEL: Heartbeat pulse...")
(inject-stimulus `(:type :EVENT :payload (:sensor :heartbeat :unix-time ,(get-universal-time)))))) :name "org-agent-heartbeat")))
(defun stop-heartbeat () (when (and *heartbeat-thread* (bt:thread-alive-p *heartbeat-thread*)) (bt:destroy-thread *heartbeat-thread*) (setf *heartbeat-thread* nil)))
(defun load-all-skills ()
"Scans the directory defined by SKILLS_DIR and hot-loads skills.
Supports selective loading via SKILLS_WHITELIST environment variable."
(let* ((env-path (uiop:getenv "SKILLS_DIR"))
(whitelist-raw (uiop:getenv "SKILLS_WHITELIST"))
(whitelist (when whitelist-raw (uiop:split-string whitelist-raw :separator '(#\,))))
(skills-dir-str (or env-path (namestring (merge-pathnames "notes/" (user-homedir-pathname)))))
(resolved-path (context-resolve-path skills-dir-str))
(skills-dir (if resolved-path (uiop:ensure-directory-pathname resolved-path) nil)))
(if (and skills-dir (uiop:directory-exists-p skills-dir))
(let ((files (uiop:directory-files skills-dir "org-skill-*.org")))
(if files
(dolist (file files)
(let ((skill-name (pathname-name file)))
(if (or (null whitelist) (member skill-name whitelist :test #'string-equal))
(load-skill-from-org file)
(kernel-log "KERNEL: Skipping skill ~a (Not in whitelist)" skill-name))))
(kernel-log "KERNEL: No skills found in ~a" resolved-path)))
(kernel-log "KERNEL ERROR: Skills directory not found or invalid path: ~a" skills-dir-str))))
(defvar *daemon-thread* nil) (defvar *daemon-socket* nil)
(defvar *emacs-clients* nil)
(defvar *clients-lock* (bt:make-lock "emacs-clients-lock"))
(defun register-emacs-client (stream)
(bt:with-lock-held (*clients-lock*)
(pushnew stream *emacs-clients*)))
(defun unregister-emacs-client (stream)
(bt:with-lock-held (*clients-lock*)
(setf *emacs-clients* (remove stream *emacs-clients*))))
(defun handle-client (stream)
"Main loop for a single OACP client connection."
(kernel-log "DAEMON: New client connected.~%")
(register-emacs-client stream)
(unwind-protect
(loop
(handler-case
(progn
;; 1. Skip leading whitespace/newlines
(loop for char = (peek-char nil stream nil :eof)
while (and (not (eq char :eof)) (member char '(#\Space #\Newline #\Return #\Tab)))
do (read-char stream))
(let ((peek (peek-char nil stream nil :eof)))
(if (eq peek :eof) (return))
(let* ((len-prefix (make-string 6)))
;; 2. Read the 6-character length prefix
(unless (read-sequence len-prefix stream)
(return))
(let* ((len (parse-integer len-prefix :radix 16))
(msg-payload (make-string len)))
;; 3. Read the actual message payload
(unless (read-sequence msg-payload stream)
(return))
;; 4. Parse and process
(let ((msg (read-from-string msg-payload)))
(kernel-log "DAEMON: Received stimulus (~a characters)~%" len)
(inject-stimulus msg :stream stream))))))
(error (c)
(kernel-log "DAEMON CLIENT ERROR: ~a~%" c)
(return))))
(kernel-log "DAEMON: Client disconnected.~%")
(unregister-emacs-client stream)
(ignore-errors (close stream))))
(defun start-daemon (&key port interval)
(let* ((env-host (uiop:getenv "DAEMON_HOST")) (env-port (uiop:getenv "ORG_AGENT_DAEMON_PORT"))
(listen-host (if env-host (string-trim " \"'" env-host) "127.0.0.1"))
(listen-port (or (or port (when env-port (ignore-errors (parse-integer (string-trim " \"'" env-port) :junk-allowed t)))) 9105)))
(register-actuator :system #'execute-system-action)
(register-actuator :emacs (lambda (action context)
(declare (ignore context))
(kernel-log "ACTUATOR [Emacs] - Action: ~a~%" action)))
(start-heartbeat (or interval 60))
(kernel-log "DAEMON: Binding to ~a:~a..." listen-host listen-port)
(setf *daemon-socket* (usocket:socket-listen listen-host listen-port :reuse-address t))
(setf *daemon-thread* (bt:make-thread (lambda () (unwind-protect (loop (handler-case (let ((client-socket (usocket:socket-accept *daemon-socket*)))
(bt:make-thread (lambda () (handle-client (usocket:socket-stream client-socket))) :name "org-agent-client-handler"))
(error (c) (kernel-log "DAEMON ERROR: ~a" c) (sleep 0.1))))
(usocket:socket-close *daemon-socket*))) :name "org-agent-tcp-listener"))
(kernel-log "==================================================~% org-agent Kernel Booted Successfully.~% Daemon Listening: ~a:~a~%==================================================" listen-host listen-port)
(load-all-skills)))
(defun stop-daemon () (stop-heartbeat) (when *daemon-socket* (usocket:socket-close *daemon-socket*) (setf *daemon-socket* nil)) (kernel-log "org-agent Kernel stopped.~%"))
(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 "KERNEL: Loading environment from ~a~%" env-file)
(cl-dotenv:load-env env-file))
(format t "KERNEL 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 "KERNEL: Heartbeat interval set to ~a seconds.~%" interval)
(start-daemon :interval interval))
;; Keep the process alive.
(loop (sleep 3600)))Long-Term Vision: Orders of Autonomy
The development of org-agent follows distinct orders of autonomy, progressing from a basic assistant to a fully sovereign entity.
Order 1: The Reactive Kernel (Phase 1 & 2)
The agent acts as a strict "Delegator." It requires human stimulus to trigger the Cognitive Loop. Capabilities (Skills) are expanded, but the agent only speaks when spoken to.
Order 2: The Self-Editing Kernel (Phase 3 - Current)
The agent achieves introspection. It can "perceive pain" (errors) via system logs and trigger a skill-self-fix loop to rewrite its own source code, hot-reloading the changes. It proactively maintains the system.
Order 3: The Sovereign Architect (Phase 4+)
The agent transitions to full autonomy. It maintains the Consensus Loop entirely, identifying structural decay in the Memex, drafting its own PRDs, writing code, executing Chaos testing, and committing the final result without human intervention (unless authorization gates are explicitly set).
Current State: Order 2 Achieved
- DONE Core Lisp microkernel (Cognitive Loop: Perceive -> Think -> Decide -> Act)
- DONE OACP (Swank/Socket communication protocol) implemented
- DONE Org AST-to-Lisp conversion logic & Object Store integration
- DONE System 2 Safety Gating (The Harness) established
- DONE Org-Native Skill parsing and loading
- DONE Secure Docker containerization
- DONE Skill Graph & Recursive Dependencies (Ars Contexta)
- DONE Multi-Provider LLM Failover Cascade
- DONE Context API (Peripheral Vision)
- DONE Heartbeat Loop (Proactive Awareness)
- DONE Immune System (Autonomous Self-Repair)
- DONE Web Dashboard (Visual Telemetry)
- DONE Org-Native Multi-modal Delivery (Signal/Telegram/Discord)
- DONE Project Foundry (Autonomous Scaffolding & Git Stewardship)
- DONE Strictly Org-mode Mandate (.md purge)