#+TITLE: org-agent: The Neurosymbolic Kernel
#+AUTHOR: Amr
#+CREATED: [2026-03-17 Tue]
#+UPDATED: [2026-04-08 Wed]
#+FILETAGS: :platform:kernel:lisp:psf:
#+STARTUP: content

* 1. What: The Neurosymbolic Environment

`org-agent` is a hyper-minimalist, self-editing, proactive AI agent framework. It acts as the "executive soul" of a personal OS, transforming a static collection of notes into a live, programmable environment. It is not a chatbot; it is a **Sovereign Intelligence Environment** where humans and agents collaborate within a shared address space.

** Key Aspects:
- **Knowledge-Native:** The agent doesn't just "read files"; it natively understands the recursive graph of your intelligence (The Memex).
- **Dual-Process Brain:** It combines the intuitive creativity of Large Language Models (System 1) with the deterministic rigor of Common Lisp (System 2).
- **Self-Editing Kernel:** The agent is designed to perceive its own errors and rewrite its own source code, achieving Order 2 Autonomy.
- **Microkernel Design:** A sealed, unbreakable core that delegates all business logic to hot-reloadable, user-space Skills.

* 2. Why: The Philosophy & Vision

The design of `org-agent` represents a radical departure from mainstream, fragmented AI architectures.

** Homoiconic Memory (The Org Mandate)
Most frameworks break the human-machine interface by forcing humans to read Markdown while machines read JSON. `org-agent` mandates that **Org-mode is the native Abstract Syntax Tree (AST) for both.** The code is the data, and the data is the interface. This ensures the agent's memory is perfectly aligned with the user's, preventing "black box" logic.

** The Neurosymbolic Split (System 1 vs. System 2)
Relying entirely on LLMs is fragile. `org-agent` assigns the LLM strictly to **System 1** (intuition). Common Lisp acts as **System 2** (logic and safety gating). The system is imaginative but bound by mathematical rigor. It is safe by design.

** The Sovereign Boundary
To guarantee a high MTBF (Mean Time Between Failures), the core microkernel manages only the cognitive loop, the Object-Store, and the protocol. Everything else—LLM routing, embeddings, and business logic—is pushed across the **Sovereign Boundary** into user-space Skills.

** Literate Programming as Institutional Memory
Every line of system logic is written as a **Literate Org file**. This weaves the "Why" (Architectural Intent) with the "How" (Lisp Implementation), ensuring the system documents itself simply by existing.

** The Long-Term Vision: A True Lisp Machine
The kernel is fundamentally **actuator-agnostic**. While it currently uses Emacs, the ultimate trajectory is to write external editors and browsers out of existence. In this vision, the interface itself—the editor, browser, and system prompt—will be built entirely in Common Lisp, running within the exact same address space as the agent. This eliminates IPC entirely, creating a unified, zero-latency cognitive environment.

* 3. How: The 6 Core Components

The microkernel is divided into six primary subsystems, each solving a fundamental problem of agentic autonomy.

** System Interface (package.lisp)
The `package.lisp` file defines the public API of the `org-agent` kernel. It exports all necessary symbols for skills and actuators to interact with the core.

#+begin_src lisp :tangle src/package.lisp
(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-parent-id
   #:org-object-children
   #:org-object-version
   #:org-object-last-sync
   #:org-object-vector
   #:org-object-content
   #:org-object-hash
   #: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
   #:context-assemble-global-awareness
   
   ;; --- Cognitive Loop & Event Bus ---
   #:perceive
   #:think
   #:decide
   #:act
   #:cognitive-loop
   #:inject-stimulus
   #:dispatch-action
   #:register-actuator
   #:spawn-task
   
   ;; --- Skill Engine ---
   #:load-skill-from-org
   #:load-skill-with-timeout
   #:topological-sort-skills
   #: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*
   #:token-accountant-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))
#+end_src

** The Cognitive Loop (core.lisp)
*** Deep Reasoning: Why Asynchronous Recursion?
Most AI agents are linear "chatbots" that block the interface while waiting for an LLM response. In a Sovereign OS, this is unacceptable.
- **Responsiveness:** By spawning non-blocking threads, the user can continue typing in Emacs while the agent "thinks."
- **Self-Reflection:** The recursive nature allows the agent to observe its own errors. If a tool fails, the error is injected as a new stimulus. The agent realizes its mistake and proposes a fix without human prompting.
- **The Depth Break:** We implement a hardcoded depth limit (Order 2 Autonomy) to prevent "hallucination ruts" where the agent enters an infinite loop of apologies.

*** The Cognitive Loop (OODA)
#+begin_src mermaid
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)
    end
#+end_src

**Problem:** Linear AI scripts are blocking and cannot perceive new information while thinking.
**Solution:** A multi-threaded, asynchronous OODA loop. It uses recursion to allow the agent to observe its own results and chain thoughts together.

#+begin_src lisp :tangle src/core.lisp
(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 (depth 0))
  (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 depth)) (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 depth))
          (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)
                            (handler-case
                                (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)))
                              (error (c)
                                (kernel-log "SYSTEM ERROR: Tool '~a' failed: ~a" tool-name c)
                                (let ((err-stimulus `(:type :EVENT :payload (:sensor :tool-error :tool ,tool-name :message ,(format nil "~a" c)))))
                                  (when (getf raw-message :reply-stream) (setf (getf err-stimulus :reply-stream) (getf raw-message :reply-stream)))
                                  (cognitive-loop err-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)
      ;; IMMUNE SYSTEM: Inject loop failure as a new stimulus if not too deep
      ;; And ensure we are not already handling an error to prevent infinite recursion
      (let ((sensor (ignore-errors (getf (getf raw-message :payload) :sensor))))
        (unless (or (> depth 2) (member sensor '(:loop-error :tool-error)))
          (inject-stimulus `(:type :EVENT :payload (:sensor :loop-error :message ,(format nil "~a" c) :depth ,depth))
                           :stream (getf raw-message :reply-stream)
                           :depth (1+ depth))))
      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 using topological order."
  (let* ((env-path (uiop:getenv "SKILLS_DIR"))
         (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 ((sorted-files (topological-sort-skills skills-dir)))
          ;; GATEWAY ENFORCEMENT: Kernel cannot function without the Executive Soul
          (unless (member "org-skill-agent" sorted-files :key #'pathname-name :test #'string-equal)
            (error "GATEWAY FAILURE: org-skill-agent.org not found in skills directory."))
          (dolist (file sorted-files)
            (kernel-log "KERNEL: Loading skill ~a..." (pathname-name file))
            (load-skill-with-timeout file 5)))
        (kernel-log "KERNEL ERROR: Skills directory not found: ~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)))
#+end_src

** The Communication Protocol (protocol.lisp)
*** Deep Reasoning: Why Hex-Length Framing?
Streaming raw JSON over a socket is fragile. If a 5MB Org AST is fragmented by the OS network stack, a standard parser will crash or desynchronize. 
- **Physical Boundary:** By prefixing every message with a 6-character hex length, we create a deterministic physical boundary. 
- **Actuator-Agnosticism:** This protocol makes the kernel a "Dumb Terminal" host. Any program (Bash, Python, WebSockets) that can calculate a length and send bytes can now become an agentic interface.

**Problem:** Massive Org ASTs can fragment and desynchronize raw JSON streams over a socket.
**Solution:** **OACP (Org-Agent Communication Protocol)**. It uses 6-character hex-length framing to guarantee the daemon never crashes regardless of payload size.

#+begin_src lisp :tangle src/protocol.lisp
(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))))
#+end_src

** The Object Store (object-store.lisp)
*** Deep Reasoning: The Single Address Space Advantage
Industry-standard "Vector Databases" or "SQLite Backends" add external complexity and I/O latency.
- **Pointer-Based Reasoning:** By loading the entire Memex into a live Lisp hash table, we achieve microsecond recollection. The agent doesn't "search a file"; it traverses a memory pointer.
- **Memory Imaging:** The `memory-image.lisp` snapshot allows the agent to wake up with its entire context already parsed. This solves the "Cold Start" problem of massive Org files.
- **Merkle-Tree Integrity:** Every node in the Object Store is cryptographically hashed. By hashing the content and the hashes of its children, the root hash provides a single, immutable fingerprint of the entire Memex state.

*** The Single Address Space
#+begin_src mermaid
graph TD
    subgraph LispMachine[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 IPCSlow[IPC Slow]
        E[Emacs / Actuators] -. OACP .-> K
    end
#+end_src

**Problem:** Reading text files for every "memory" is slow; external databases add bloat.
**Solution:** **CLOSOS Single Address Space**. A persistent in-memory hash table that stores native Lisp `org-objects`. Includes memory-imaging to skip boot-time parsing and Merkle-Tree hashing for state verification.

#+begin_src lisp :tangle src/object-store.lisp
(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 hash)

(defun compute-merkle-hash (id type attributes content child-hashes)
  "Computes a SHA-256 Merkle hash for a node based on its core properties and children's hashes."
  (let* ((alist (loop for (k v) on attributes by #'cddr collect (cons k v)))
         (sorted-alist (sort alist #'string< :key (lambda (x) (format nil "~a" (car x)))))
         (attr-string (format nil "~s" sorted-alist))
         (children-string (format nil "~{~a~}" child-hashes))
         (data-string (format nil "ID:~a|TYPE:~s|ATTRS:~a|CONTENT:~a|CHILDREN:~a"
                              id type attr-string (or content "") children-string))
         (digester (ironclad:make-digest :sha256)))
    (ironclad:update-digest digester (ironclad:ascii-string-to-byte-array data-string))
    (ironclad:byte-array-to-hex-string (ironclad:produce-digest digester))))

(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)
         (child-hashes nil))
    (dolist (child contents)
      (when (listp child)
        (let ((child-id (ingest-ast child id)))
          (push child-id child-ids)
          (let ((child-obj (lookup-object child-id)))
            (when child-obj (push (org-object-hash child-obj) child-hashes))))))
    (setf child-ids (nreverse child-ids))
    (setf child-hashes (nreverse child-hashes))
    (let* ((hash (compute-merkle-hash id type props raw-content child-hashes))
           (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 child-ids
                 :version (get-universal-time) :last-sync (get-universal-time)
                 :hash hash)))
      (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)
   :hash (org-object-hash 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)))
#+end_src

** Peripheral Vision (context.lisp & embedding.lisp)
*** Deep Reasoning: Solving the "Lost in the Middle" Problem
LLMs lose precision when context windows are bloated with irrelevant data.
- **Sparse Trees:** We use Lisp's deterministic tree-walking to surgically prune the Org AST. We pass the skeletal "peripheral" outline to the LLM, giving it global awareness while keeping its "foveal" focus on the task at hand. This minimizes token burn and maximizes reasoning accuracy.

**Problem:** Context window bloat confuses LLMs and wastes tokens.
**Solution:** **Sparse Tree Perception**. Surgically prunes the Org AST to pass only the skeletal outline and high-signal context to System 1.

#+begin_src lisp :tangle src/context.lisp
(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))

(defun context-assemble-global-awareness ()
  "Produces a high-level skeletal outline of the current Object Store for the LLM."
  (let ((projects (context-get-active-projects))
        (output "GLOBAL MEMEX AWARENESS (Peripheral Vision):
"))
    (if projects
        (dolist (project projects)
          (setf output (concatenate 'string output
                                    (format nil "- PROJECT: ~a (ID: ~a)~%" 
                                            (getf (org-object-attributes project) :TITLE)
                                            (org-object-id project)))))
        (setf output (concatenate 'string output "No active projects found.~%")))
    output))
#+end_src

#+begin_src lisp :tangle src/embedding.lisp
(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))))))
#+end_src

** The Skill Engine (skills.lisp)
*** Deep Reasoning: Late-Binding Intelligence
Hardcoding logic into a compiled binary creates a "Brittle Kernel."
- **Institutional Memory:** By using Literate Org files as skills, the "Why" (PRD) and the "How" (Lisp) are unified. 
- **Hot-Reloading:** The agent can "learn" a new trick (recompile a package) while running. This allows for a continuous evolutionary loop where the agent can eventually rewrite its own skills to fix bugs it perceives.

**Problem:** Hardcoding logic makes the daemon brittle; teaching new skills usually requires a restart.
**Solution:** **Hot-Reloadable Late-Binding**. Compiles Lisp code blocks from Org files into isolated packages at runtime. Brain updates without dropping heartbeats.

#+begin_src lisp :tangle src/skills.lisp
(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))))

;; --- Boot Sequence & Micro-Loader ---

(defun parse-skill-metadata (filepath)
  "Extracts ID and DEPENDS_ON tags using robust line-scanning."
  (let ((dependencies nil)
        (id nil))
    (with-open-file (stream filepath)
      (loop for line = (read-line stream nil :eof)
            until (eq line :eof)
            do (let ((clean (string-trim '(#\Space #\Tab #\Return #\Newline) line)))
                 (cond
                   ((uiop:string-prefix-p "#+DEPENDS_ON:" (string-upcase clean))
                    (let* ((deps-part (string-trim " " (subseq clean 13))))
                      (setf dependencies (append dependencies 
                                                 (mapcar (lambda (s) (string-trim "[] " s))
                                                         (uiop:split-string deps-part :separator '(#\Space #\Tab)))))))
                   ((uiop:string-prefix-p ":ID:" (string-upcase clean))
                    (setf id (string-trim '(#\Space #\Tab) (subseq clean 4))))))))
    (values id (remove-if (lambda (s) (= 0 (length s))) dependencies))))

(defun topological-sort-skills (skills-dir)
  "Returns a list of skill filepaths sorted by dependency (dependencies first)."
  (let ((files (uiop:directory-files skills-dir "org-skill-*.org"))
        (adj (make-hash-table :test 'equal))
        (id-to-file (make-hash-table :test 'equal))
        (result nil)
        (visited (make-hash-table :test 'equal))
        (stack (make-hash-table :test 'equal)))
    ;; First pass: Build ID-to-File mapping and store raw dependencies
    (dolist (file files)
      (let ((filename (pathname-name file)))
        (multiple-value-bind (id deps) (parse-skill-metadata file)
          (setf (gethash (string-downcase filename) id-to-file) file)
          (when id (setf (gethash (string-downcase id) id-to-file) file))
          (setf (gethash (string-downcase filename) adj) deps))))
    
    (labels ((visit (file)
               (let* ((filename (pathname-name file))
                      (node-key (string-downcase filename)))
                 (unless (gethash node-key visited)
                   (setf (gethash node-key stack) t)
                   (dolist (dep (gethash node-key adj))
                     (let* ((dep-id (if (and (> (length dep) 3) (uiop:string-prefix-p "id:" (string-downcase dep)))
                                        (subseq dep 3)
                                        dep))
                            (dep-file (gethash (string-downcase dep-id) id-to-file)))
                       (when dep-file
                         (let ((dep-filename (pathname-name dep-file)))
                           (if (gethash (string-downcase dep-filename) stack)
                               (error "Circular dependency detected: ~a -> ~a" filename dep-filename)
                               (visit dep-file))))))
                   (setf (gethash node-key stack) nil)
                   (setf (gethash node-key visited) t)
                   (push file result)))))
      
      (let ((filenames (sort (mapcar #'pathname-name files) #'string<)))
        (dolist (name filenames)
          (let ((file (gethash (string-downcase name) id-to-file)))
            (when file (visit file)))))
      result)))

(defun load-skill-with-timeout (filepath timeout-seconds)
  "Loads a skill Org file with a hard execution timeout."
  (let* ((finished nil)
         (thread (bt:make-thread (lambda () 
                                   (handler-case
                                       (progn
                                         (load-skill-from-org filepath)
                                         (setf finished t))
                                     (error (c) 
                                       (kernel-log "THREAD ERROR: ~a" c)
                                       (setf finished :error))))
                                 :name (format nil "loader-~a" (pathname-name filepath))))
         (start-time (get-internal-real-time))
         (timeout-units (* timeout-seconds internal-time-units-per-second)))
    (loop 
      (when (eq finished t) (return :success))
      (when (eq finished :error) (return :error))
      (unless (bt:thread-alive-p thread) (return :error))
      (when (> (- (get-internal-real-time) start-time) timeout-units)
        #+sbcl (sb-thread:terminate-thread thread)
        #-sbcl (bt:destroy-thread thread)
        (kernel-log "KERNEL ERROR: Timeout loading skill ~a" (pathname-name filepath))
        (return :timeout))
      (sleep 0.1))))

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

#+end_src

** The Neurosymbolic Bridge (neuro.lisp & symbolic.lisp)
*** Deep Reasoning: Imagination Checked by Physics
System 1 (LLM) is creative but hallucination-prone. System 2 (Lisp) is rigid but 100% accurate.
- **The Safety Gate:** We never allow the LLM to talk to the actuators directly. It must propose a Lisp form. System 2 intercepts this form and validates it against mathematical rules and PSF invariants. 
- **Sovereign Decoupling:** By moving the physical API logic into skills, the core remains a neutral "Thinking Engine" that doesn't care if the imagination comes from Google, Anthropic, or a local Llama instance.

**Problem:** LLMs hallucinate; pure code is rigid.
**Solution:** The **Safety Gate**. `neuro.lisp` (System 1) proposes; `symbolic.lisp` (System 2) intercepts and validates. Imagination checked by the laws of physics.

#+begin_src lisp :tangle src/neuro.lisp
(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."
  (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)
             (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."
  (let ((backends (cond
                    ((and cascade (listp cascade)) cascade)
                    ((functionp cascade) (funcall 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\"))"))

;; --- Sovereign Service Fallbacks ---

(defun token-accountant-route-task (context)
  "Generic fallback for routing. Overridden by skill-token-accountant."
  (declare (ignore context))
  '(:openrouter :gemini))

(defun org-id-new ()
  "Generic fallback for ID generation. Overridden by skill-ast-normalization."
  (format nil "node-~a" (get-universal-time)))

(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 think (context)
  (let ((active-skill (find-triggered-skill context))
        (tool-belt (generate-tool-belt-prompt))
        (global-context (context-assemble-global-awareness)))
    (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.

"
                                                 global-context
                                                 "
"
                                                 tool-belt
                                                 "
IMPORTANT: To reply to the user, you MUST use:
(:type :REQUEST :target :emacs :action :insert-at-end :buffer \"*org-agent-chat*\" :text \"* <Response Text>\")

To call a tool, you MUST use:
(:type :REQUEST :target :tool :action :call :tool \"<name>\" :args (:arg1 \"val\"))

")))
            (if (and raw-prompt (> (length raw-prompt) 1))
                (let* ((thought (ask-neuro raw-prompt :system-prompt full-system-prompt :context context)))
                  (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)))
#+end_src

#+begin_src lisp :tangle src/symbolic.lisp
(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))
#+end_src
* System Definition
#+begin_src lisp :tangle org-agent.asd
(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 :ironclad)
  :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")
                             (:file "boot-sequence-tests")
                             (:file "object-store-tests")
                             (:file "immune-system-tests")
                             (:file "chaos-qa"))))
  :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))
             (uiop:symbol-call :fiveam :run! (uiop:find-symbol* :boot-suite :org-agent-boot-tests))
             (uiop:symbol-call :fiveam :run! (uiop:find-symbol* :object-store-suite :org-agent-object-store-tests))
             (uiop:symbol-call :fiveam :run! (uiop:find-symbol* :immune-suite :org-agent-immune-system-tests))
             (uiop:symbol-call :fiveam :run! (uiop:find-symbol* :chaos-suite :org-agent-chaos-qa))))
#+end_src
