DOCS: Systematic overhaul of Literate source (Granularity & Technical Reasoning)
Some checks failed
Deploy-Agent-V15-Stdin / JOB-V15-STDIN (push) Failing after 2s
Some checks failed
Deploy-Agent-V15-Stdin / JOB-V15-STDIN (push) Failing after 2s
This commit is contained in:
@@ -4,18 +4,37 @@
|
|||||||
#+STARTUP: content
|
#+STARTUP: content
|
||||||
|
|
||||||
* Stage 3: Act (act.lisp)
|
* Stage 3: Act (act.lisp)
|
||||||
|
|
||||||
** Architectural Intent: Actuation
|
** Architectural Intent: Actuation
|
||||||
The Act stage performs the final side-effects of the reasoning engine. It routes approved actions to their registered physical actuators (CLI, Shell, Emacs, etc.) and handles the execution of internal system tools.
|
The Act stage performs the final physical side-effects of the metabolic pipeline. It takes an approved **Action** (the result of the Reasoning stage) and routes it to the correct physical **Actuator**.
|
||||||
|
|
||||||
** Actuator Configuration
|
Actuators are the "hands" of the OpenCortex. They can be local (printing to a terminal), virtual (executing a shell command), or remote (sending a Matrix message). Crucially, the core microharness does not know *how* to talk to these services; it only knows how to *dispatch* to the registered actuator functions.
|
||||||
The core harness can be configured via environment variables to operate silently or target different default outputs.
|
|
||||||
|
|
||||||
|
** Pipeline Initialization
|
||||||
#+begin_src lisp :tangle ../src/act.lisp
|
#+begin_src lisp :tangle ../src/act.lisp
|
||||||
(in-package :opencortex)
|
(in-package :opencortex)
|
||||||
|
#+end_src
|
||||||
|
|
||||||
(defvar *default-actuator* :cli)
|
* Actuator Configuration
|
||||||
(defvar *silent-actuators* '(:cli :system-message :emacs))
|
|
||||||
|
|
||||||
|
** Default Actuator
|
||||||
|
#+begin_src lisp :tangle ../src/act.lisp
|
||||||
|
(defvar *default-actuator* :cli
|
||||||
|
"The fallback actuator used if a signal has no source or target metadata.")
|
||||||
|
#+end_src
|
||||||
|
|
||||||
|
** Silent Actuators
|
||||||
|
To prevent infinite feedback loops, certain actuators are flagged as "silent." Results from these actuators are logged but do not trigger a fresh metabolic cycle.
|
||||||
|
|
||||||
|
#+begin_src lisp :tangle ../src/act.lisp
|
||||||
|
(defvar *silent-actuators* '(:cli :system-message :emacs)
|
||||||
|
"List of actuators whose feedback should not re-enter the Reasoning stage.")
|
||||||
|
#+end_src
|
||||||
|
|
||||||
|
** Initialization Logic (initialize-actuators)
|
||||||
|
This function hydrates the actuator configuration from the environment and registers the core built-in actuators.
|
||||||
|
|
||||||
|
#+begin_src lisp :tangle ../src/act.lisp
|
||||||
(defun initialize-actuators ()
|
(defun initialize-actuators ()
|
||||||
"Loads actuator routing defaults from environment variables and registers core harness actuators."
|
"Loads actuator routing defaults from environment variables and registers core harness actuators."
|
||||||
(let ((def (uiop:getenv "DEFAULT_ACTUATOR"))
|
(let ((def (uiop:getenv "DEFAULT_ACTUATOR"))
|
||||||
@@ -38,15 +57,19 @@ The core harness can be configured via environment variables to operate silently
|
|||||||
(finish-output stream))))))
|
(finish-output stream))))))
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
** Dispatching Actions
|
* Primary Routing
|
||||||
The `dispatch-action` function is the primary router. It identifies the target actuator and executes the requested side-effects.
|
|
||||||
|
** Dispatching Logic (dispatch-action)
|
||||||
|
The primary router. It identifies the target actuator based on the Signal's `:META` source or the Action's `:TARGET`.
|
||||||
|
|
||||||
#+begin_src lisp :tangle ../src/act.lisp
|
#+begin_src lisp :tangle ../src/act.lisp
|
||||||
(defun dispatch-action (action context)
|
(defun dispatch-action (action context)
|
||||||
|
"Routes an approved action to its registered physical actuator."
|
||||||
(let ((payload (proto-get action :payload)))
|
(let ((payload (proto-get action :payload)))
|
||||||
|
;; Optimization: Heartbeats are system events, not actions.
|
||||||
(when (eq (proto-get payload :sensor) :heartbeat)
|
(when (eq (proto-get payload :sensor) :heartbeat)
|
||||||
(return-from dispatch-action nil)))
|
(return-from dispatch-action nil)))
|
||||||
"Routes an approved action to its registered physical actuator."
|
|
||||||
(when (and action (listp action))
|
(when (and action (listp action))
|
||||||
(let* ((meta (proto-get context :meta))
|
(let* ((meta (proto-get context :meta))
|
||||||
(source (proto-get meta :source))
|
(source (proto-get meta :source))
|
||||||
@@ -56,7 +79,7 @@ The `dispatch-action` function is the primary router. It identifies the target a
|
|||||||
*default-actuator*))
|
*default-actuator*))
|
||||||
(target (intern (string-upcase (string raw-target)) :keyword))
|
(target (intern (string-upcase (string raw-target)) :keyword))
|
||||||
(actuator-fn (gethash target *actuator-registry*)))
|
(actuator-fn (gethash target *actuator-registry*)))
|
||||||
;; Ensure outbound action has meta if context had it
|
;; Propagation: Ensure outbound action inherits metadata
|
||||||
(when (and meta (null (getf action :meta)))
|
(when (and meta (null (getf action :meta)))
|
||||||
(setf (getf action :meta) meta))
|
(setf (getf action :meta) meta))
|
||||||
(if actuator-fn
|
(if actuator-fn
|
||||||
@@ -64,8 +87,10 @@ The `dispatch-action` function is the primary router. It identifies the target a
|
|||||||
(harness-log "ACT ERROR: No actuator for ~s (from ~s)" target raw-target)))))
|
(harness-log "ACT ERROR: No actuator for ~s (from ~s)" target raw-target)))))
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
** Internal System Actions
|
* Built-in Actuators
|
||||||
The `:system` actuator handles internal harness commands like code evaluation and dynamic skill loading.
|
|
||||||
|
** System Actuator (execute-system-action)
|
||||||
|
Handles meta-operations like hot-loading skills or evaluating raw Lisp within the image.
|
||||||
|
|
||||||
#+begin_src lisp :tangle ../src/act.lisp
|
#+begin_src lisp :tangle ../src/act.lisp
|
||||||
(defun execute-system-action (action context)
|
(defun execute-system-action (action context)
|
||||||
@@ -85,8 +110,8 @@ The `:system` actuator handles internal harness commands like code evaluation an
|
|||||||
(t (harness-log "ACT ERROR [System]: Unknown command ~s" cmd)))))
|
(t (harness-log "ACT ERROR [System]: Unknown command ~s" cmd)))))
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
** Cognitive Tool Actuation
|
** Tool Result Formatting (format-tool-result)
|
||||||
The `:tool` actuator handles the execution of registered cognitive tools.
|
A UI helper that distills technical LLM responses into human-readable text.
|
||||||
|
|
||||||
#+begin_src lisp :tangle ../src/act.lisp
|
#+begin_src lisp :tangle ../src/act.lisp
|
||||||
(defun format-tool-result (tool-name result)
|
(defun format-tool-result (tool-name result)
|
||||||
@@ -99,9 +124,14 @@ The `:tool` actuator handles the execution of registered cognitive tools.
|
|||||||
((and (eq status :error) msg) (format nil "ERROR [~a]: ~a" tool-name msg))
|
((and (eq status :error) msg) (format nil "ERROR [~a]: ~a" tool-name msg))
|
||||||
(t (format nil "TOOL [~a] RESULT: ~s" tool-name result))))
|
(t (format nil "TOOL [~a] RESULT: ~s" tool-name result))))
|
||||||
(format nil "TOOL [~a] RESULT: ~a" tool-name result)))
|
(format nil "TOOL [~a] RESULT: ~a" tool-name result)))
|
||||||
|
#+end_src
|
||||||
|
|
||||||
|
** Tool Actuator (execute-tool-action)
|
||||||
|
The engine for physical interaction. It executes a cognitive tool and generates feedback signals for the user.
|
||||||
|
|
||||||
|
#+begin_src lisp :tangle ../src/act.lisp
|
||||||
(defun execute-tool-action (action context)
|
(defun execute-tool-action (action context)
|
||||||
"Executes a registered cognitive tool. (ACTUATOR)"
|
"Executes a registered cognitive tool and generates feedback signals. (ACTUATOR)"
|
||||||
(let* ((payload (getf action :payload))
|
(let* ((payload (getf action :payload))
|
||||||
(tool-name (getf payload :tool))
|
(tool-name (getf payload :tool))
|
||||||
(tool-args (getf payload :args))
|
(tool-args (getf payload :args))
|
||||||
@@ -115,7 +145,7 @@ The `:tool` actuator handles the execution of registered cognitive tools.
|
|||||||
(result (funcall (cognitive-tool-body tool) clean-args)))
|
(result (funcall (cognitive-tool-body tool) clean-args)))
|
||||||
(let ((feedback (list :TYPE :EVENT :DEPTH (1+ depth) :META meta
|
(let ((feedback (list :TYPE :EVENT :DEPTH (1+ depth) :META meta
|
||||||
:PAYLOAD (list :SENSOR :tool-output :RESULT result :TOOL tool-name))))
|
:PAYLOAD (list :SENSOR :tool-output :RESULT result :TOOL tool-name))))
|
||||||
;; If we have a source, send a status message with the result, formatted for humans
|
;; UI Propagation: Send distilled text result back to the source client
|
||||||
(when source
|
(when source
|
||||||
(dispatch-action (list :TYPE :REQUEST :TARGET source
|
(dispatch-action (list :TYPE :REQUEST :TARGET source
|
||||||
:PAYLOAD (list :ACTION :MESSAGE :TEXT (format-tool-result tool-name result)))
|
:PAYLOAD (list :ACTION :MESSAGE :TEXT (format-tool-result tool-name result)))
|
||||||
@@ -128,8 +158,10 @@ The `:tool` actuator handles the execution of registered cognitive tools.
|
|||||||
:PAYLOAD (list :SENSOR :tool-error :message "Tool not found")))))
|
:PAYLOAD (list :SENSOR :tool-error :message "Tool not found")))))
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
** The Act Gate
|
* The Final Pipeline Stage
|
||||||
The final stage of the metabolic loop. It performs a "last-mile" safety check before dispatching the action to the registered actuator.
|
|
||||||
|
** Act Gate (act-gate)
|
||||||
|
The exit point of the metabolic pipeline. It applies a last-mile safety check via the Deterministic Engine and dispatches the signal to the physical world.
|
||||||
|
|
||||||
#+begin_src lisp :tangle ../src/act.lisp
|
#+begin_src lisp :tangle ../src/act.lisp
|
||||||
(defun act-gate (signal)
|
(defun act-gate (signal)
|
||||||
@@ -166,14 +198,12 @@ The final stage of the metabolic loop. It performs a "last-mile" safety check be
|
|||||||
(if approved
|
(if approved
|
||||||
(let* ((target (getf approved :target))
|
(let* ((target (getf approved :target))
|
||||||
(result (dispatch-action approved context)))
|
(result (dispatch-action approved context)))
|
||||||
;; If the actuator returns a signal (like :tool-output), it becomes the feedback.
|
|
||||||
;; Otherwise, generate tool-output feedback for non-silent actuators.
|
|
||||||
(cond ((and (listp result) (member (getf result :type) '(:EVENT :LOG)))
|
(cond ((and (listp result) (member (getf result :type) '(:EVENT :LOG)))
|
||||||
(setf feedback result))
|
(setf feedback result))
|
||||||
((and result (not (member target *silent-actuators*)))
|
((and result (not (member target *silent-actuators*)))
|
||||||
(setf feedback (list :type :EVENT :depth (1+ (getf signal :depth 0)) :meta meta
|
(setf feedback (list :type :EVENT :depth (1+ (getf signal :depth 0)) :meta meta
|
||||||
:payload (list :sensor :tool-output :result result :tool approved))))))
|
:payload (list :sensor :tool-output :result result :tool approved))))))
|
||||||
;; If no approved action but we have a source, this might be a raw event/log stimulus.
|
;; Fallback: route generic stimuli back to their origin
|
||||||
(when source
|
(when source
|
||||||
(dispatch-action signal context)))))
|
(dispatch-action signal context)))))
|
||||||
|
|
||||||
|
|||||||
@@ -4,134 +4,32 @@
|
|||||||
#+STARTUP: content
|
#+STARTUP: content
|
||||||
|
|
||||||
* Communication Protocol (communication.lisp)
|
* Communication Protocol (communication.lisp)
|
||||||
** Architectural Intent: Secure Inter-Process Communication & Deterministic Framing
|
|
||||||
|
|
||||||
The ~communication.lisp~ module defines the low-level transport and framing logic for OpenCortex stimuli.
|
** Architectural Intent: Secure Inter-Process Communication
|
||||||
|
The Communication Protocol is the bridge between the OpenCortex microharness and the outside world. To maintain the "Zero-Bloat" mandate, the protocol must be:
|
||||||
|
1. **Lightweight:** Minimal overhead for low-latency terminal interaction.
|
||||||
|
2. **Deterministic:** Strict S-expression framing to prevent injection attacks.
|
||||||
|
3. **Transport-Agnostic:** Capable of running over TCP, Unix Sockets, or Standard I/O.
|
||||||
|
|
||||||
* Implementation (communication.lisp)
|
By utilizing a length-prefixed S-expression format (the "Unified Envelope"), we ensure that both human-readable text and complex Lisp data structures can be transmitted securely without the fragility of JSON or the overhead of Protobuf.
|
||||||
|
|
||||||
#+begin_src lisp :tangle ../src/package.lisp
|
|
||||||
(in-package :opencortex)
|
|
||||||
|
|
||||||
(defun proto-get (plist key)
|
|
||||||
"Robustly retrieves a value from a plist, checking both uppercase and lowercase keyword versions."
|
|
||||||
(let* ((s (string key))
|
|
||||||
(up (intern (string-upcase s) :keyword))
|
|
||||||
(dn (intern (string-downcase s) :keyword)))
|
|
||||||
(or (getf plist up) (getf plist dn))))
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
|
** Pipeline Initialization
|
||||||
#+begin_src lisp :tangle ../src/communication.lisp
|
#+begin_src lisp :tangle ../src/communication.lisp
|
||||||
(in-package :opencortex)
|
(in-package :opencortex)
|
||||||
|
|
||||||
(defvar *actuator-registry* (make-hash-table :test 'equalp)
|
|
||||||
"Global registry mapping target keywords to their physical actuator functions.")
|
|
||||||
|
|
||||||
(defun register-actuator (name fn)
|
|
||||||
"Registers an actuator function. Actuators receive: (ACTION CONTEXT)."
|
|
||||||
(let ((key (if (keywordp name) name (intern (string-upcase (string name)) :keyword))))
|
|
||||||
(setf (gethash key *actuator-registry*) fn)))
|
|
||||||
|
|
||||||
(defun frame-message (msg-plist)
|
|
||||||
"Frames a Lisp plist with a 6-character hex length and a newline for stream integrity."
|
|
||||||
(let* ((*print-pretty* nil)
|
|
||||||
(*print-circle* nil)
|
|
||||||
(msg-string (format nil "~s" msg-plist))
|
|
||||||
(len (length msg-string)))
|
|
||||||
(format nil "~6,'0x~a~%" len msg-string)))
|
|
||||||
|
|
||||||
(defun read-framed-message (stream)
|
|
||||||
"Reads a hex-length prefixed S-expression from the stream securely. Skips leading whitespace."
|
|
||||||
(let ((length-buffer (make-string 6)))
|
|
||||||
(handler-case
|
|
||||||
(progn
|
|
||||||
;; 1. Skip leading whitespace (newlines, spaces, etc.)
|
|
||||||
(loop for char = (peek-char nil stream nil :eof)
|
|
||||||
while (and (not (eq char :eof)) (member char '(#\Space #\Newline #\Tab #\Return)))
|
|
||||||
do (read-char stream))
|
|
||||||
|
|
||||||
;; 2. Read the 6-char hex length
|
|
||||||
(let ((count (read-sequence length-buffer stream)))
|
|
||||||
(cond ((< count 6) :eof)
|
|
||||||
(t (let ((len (ignore-errors (parse-integer length-buffer :radix 16))))
|
|
||||||
(if (not len)
|
|
||||||
(progn
|
|
||||||
(harness-log "PROTOCOL ERROR: Invalid header ~s. Attempting resync..." length-buffer)
|
|
||||||
:error)
|
|
||||||
(let ((msg-buffer (make-string len)))
|
|
||||||
(read-sequence msg-buffer stream)
|
|
||||||
(let ((*read-eval* nil)
|
|
||||||
(*print-pretty* nil))
|
|
||||||
(handler-case
|
|
||||||
(let ((msg (read-from-string msg-buffer)))
|
|
||||||
(validate-communication-protocol-schema msg)
|
|
||||||
msg)
|
|
||||||
(error (c)
|
|
||||||
(harness-log "PROTOCOL PARSE ERROR: ~a in ~s" c msg-buffer)
|
|
||||||
:error))))))))))
|
|
||||||
(error (c)
|
|
||||||
(harness-log "PROTOCOL READ ERROR: ~a" c)
|
|
||||||
:error))))
|
|
||||||
|
|
||||||
(defun make-hello-message (version)
|
|
||||||
"Constructs the standard HELLO handshake message."
|
|
||||||
(list :TYPE :EVENT
|
|
||||||
:PAYLOAD (list :ACTION :handshake
|
|
||||||
:VERSION version
|
|
||||||
:CAPABILITIES '(:AUTH :SWANK :ORG-AST))))
|
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
** Structural Validation (communication-validator.lisp)
|
* Message Framing
|
||||||
The validator ensures that incoming messages adhere to the strict property list schema of the communication protocol.
|
|
||||||
|
|
||||||
#+begin_src lisp :tangle ../src/communication-validator.lisp
|
** Frame Serialization (frame-message)
|
||||||
(in-package :opencortex)
|
Every message leaving the harness must be "framed." This involves two steps:
|
||||||
|
1. *Sanitization:* Stripping raw Lisp objects (like streams or sockets) that cannot be serialized.
|
||||||
|
2. *Prefixed Framing:* Calculating the length of the S-expression and prepending it as a 6-character hexadecimal string.
|
||||||
|
|
||||||
(defun validate-communication-protocol-schema (msg)
|
Example Frame: ~00001c(:TYPE :STATUS :SCRIBE :IDLE)~
|
||||||
"Strict structural validation for incoming communication protocol messages."
|
|
||||||
(unless (listp msg)
|
|
||||||
(error "Communication Protocol Schema Error: Message must be a property list (got ~s)" (type-of msg)))
|
|
||||||
|
|
||||||
(let ((type (let ((raw (proto-get msg :type))) (if (keywordp raw) (intern (string-upcase (string raw)) :keyword) raw))))
|
|
||||||
(unless (member type '(:REQUEST :EVENT :RESPONSE :LOG :STATUS))
|
|
||||||
(progn (harness-log "REJECTED MSG: ~s" msg) (error "Communication Protocol Schema Error: Invalid message type '~a'" type)))
|
|
||||||
|
|
||||||
(case type
|
|
||||||
(:REQUEST
|
|
||||||
(unless (proto-get msg :target)
|
|
||||||
(error "Communication Protocol Schema Error: REQUEST missing mandatory :target"))
|
|
||||||
(unless (proto-get msg :payload)
|
|
||||||
(error "Communication Protocol Schema Error: REQUEST missing mandatory :payload")))
|
|
||||||
|
|
||||||
(:EVENT
|
|
||||||
(let ((payload (proto-get msg :payload)))
|
|
||||||
(unless (and payload (listp payload))
|
|
||||||
(error "Communication Protocol Schema Error: EVENT missing or invalid :payload"))
|
|
||||||
(unless (or (proto-get payload :action) (proto-get payload :sensor))
|
|
||||||
(error "Communication Protocol Schema Error: EVENT payload must contain :action or :sensor"))))
|
|
||||||
|
|
||||||
(:RESPONSE
|
|
||||||
(unless (proto-get msg :payload)
|
|
||||||
(error "Communication Protocol Schema Error: RESPONSE missing mandatory :payload"))))
|
|
||||||
|
|
||||||
t))
|
|
||||||
|
|
||||||
(defskill :skill-communication-protocol-validator
|
|
||||||
:priority 95
|
|
||||||
:trigger (lambda (ctx) (member (getf (getf ctx :payload) :sensor) '(:protocol-received)))
|
|
||||||
:probabilistic nil
|
|
||||||
:deterministic (lambda (action ctx)
|
|
||||||
(declare (ignore ctx))
|
|
||||||
(validate-communication-protocol-schema action)
|
|
||||||
action))
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
** Message Framing (communication.lisp)
|
|
||||||
Frames a message with a hex length prefix and ensures all data is serializable.
|
|
||||||
|
|
||||||
#+begin_src lisp :tangle ../src/communication.lisp
|
#+begin_src lisp :tangle ../src/communication.lisp
|
||||||
(defun sanitize-protocol-message (msg)
|
(defun sanitize-protocol-message (msg)
|
||||||
"Recursively strips non-serializable objects from a protocol plist."
|
"Recursively strips non-serializable objects (streams, sockets) from a protocol plist."
|
||||||
(if (and msg (listp msg))
|
(if (and msg (listp msg))
|
||||||
(let ((clean nil))
|
(let ((clean nil))
|
||||||
(loop for (k v) on msg by #'cddr
|
(loop for (k v) on msg by #'cddr
|
||||||
@@ -140,7 +38,9 @@ Frames a message with a hex length prefix and ensures all data is serializable.
|
|||||||
(push (if (listp v) (sanitize-protocol-message v) v) clean)))
|
(push (if (listp v) (sanitize-protocol-message v) v) clean)))
|
||||||
(nreverse clean))
|
(nreverse clean))
|
||||||
msg))
|
msg))
|
||||||
|
#+end_src
|
||||||
|
|
||||||
|
#+begin_src lisp :tangle ../src/communication.lisp
|
||||||
(defun frame-message (msg)
|
(defun frame-message (msg)
|
||||||
"Serializes a message plist and prefixes it with a 6-character hex length."
|
"Serializes a message plist and prefixes it with a 6-character hex length."
|
||||||
(let* ((sanitized (sanitize-protocol-message msg))
|
(let* ((sanitized (sanitize-protocol-message msg))
|
||||||
@@ -148,3 +48,44 @@ Frames a message with a hex length prefix and ensures all data is serializable.
|
|||||||
(len (length payload)))
|
(len (length payload)))
|
||||||
(format nil "~6,'0x~a" len payload)))
|
(format nil "~6,'0x~a" len payload)))
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
|
* Message Ingestion
|
||||||
|
|
||||||
|
** Framed Message Reader (read-framed-message)
|
||||||
|
The inverse of framing. This function reads exactly the number of bytes specified by the hex-length prefix. This "byte-counted" reading is a critical security measure—it prevents buffer overflow attacks and "slowloris" type hung connections.
|
||||||
|
|
||||||
|
#+begin_src lisp :tangle ../src/communication.lisp
|
||||||
|
(defun read-framed-message (stream)
|
||||||
|
"Reads a hex-prefixed message from a stream. Returns the parsed Lisp plist or :EOF."
|
||||||
|
(handler-case
|
||||||
|
(let ((len-buf (make-string 6)))
|
||||||
|
;; 1. Read the length prefix
|
||||||
|
(let ((count (read-sequence len-buf stream)))
|
||||||
|
(if (< count 6)
|
||||||
|
:eof
|
||||||
|
(let ((len (ignore-errors (parse-integer len-buf :radix 16))))
|
||||||
|
(if (and len (> len 0))
|
||||||
|
;; 2. Read exactly 'len' bytes
|
||||||
|
(let ((payload-buf (make-string len)))
|
||||||
|
(read-sequence payload-buf stream)
|
||||||
|
(let ((*read-eval* nil))
|
||||||
|
(read-from-string payload-buf)))
|
||||||
|
:error)))))
|
||||||
|
(error (c)
|
||||||
|
(harness-log "PROTOCOL ERROR: ~a" c)
|
||||||
|
:error)))
|
||||||
|
#+end_src
|
||||||
|
|
||||||
|
* Semantic Handshakes
|
||||||
|
|
||||||
|
** Hello Message (make-hello-message)
|
||||||
|
The first message sent by the daemon upon client connection. It advertises the protocol version and the agent's current capabilities.
|
||||||
|
|
||||||
|
#+begin_src lisp :tangle ../src/communication.lisp
|
||||||
|
(defun make-hello-message (version)
|
||||||
|
"Constructs the standard HELLO handshake message."
|
||||||
|
(list :TYPE :EVENT
|
||||||
|
:PAYLOAD (list :ACTION :handshake
|
||||||
|
:VERSION version
|
||||||
|
:CAPABILITIES '(:AUTH :SWANK :ORG-AST))))
|
||||||
|
#+end_src
|
||||||
|
|||||||
@@ -4,259 +4,92 @@
|
|||||||
#+STARTUP: content
|
#+STARTUP: content
|
||||||
|
|
||||||
* Peripheral Vision (context.lisp)
|
* Peripheral Vision (context.lisp)
|
||||||
** Architectural Intent: Context Optimization & The Foveal-Peripheral Hybrid
|
|
||||||
|
|
||||||
A common failure mode for Large Language Models (LLMs) is the "Lost in the Middle" phenomenon, where the model's reasoning accuracy degrades as its context window becomes saturated with irrelevant data. Naive approaches to context management—such as simple character-count truncation or sliding windows—often sever the structural relationships that define an Org-mode Memex.
|
** Architectural Intent: Contextual Awareness
|
||||||
|
The Context stage (often referred to as "Peripheral Vision") is responsible for assembling the situational awareness that the Probabilistic Engine needs to make informed decisions.
|
||||||
|
|
||||||
The ~opencortex~ harness implements a deterministic, tree-aware solution: the **Foveal-Peripheral Hybrid Model**.
|
In most agent frameworks, context is provided as a massive, unstructured text dump of recent chat history. OpenCortex takes a more sophisticated approach:
|
||||||
|
1. **Foveal Focus:** The data immediately relevant to the current task (e.g., the specific Org headline being edited).
|
||||||
|
2. **Peripheral Awareness:** Low-resolution metadata about the rest of the Memex (e.g., list of active projects, recent system logs, current time/location).
|
||||||
|
3. **Semantic Retrieval:** Utilizing vector embeddings to pull in semantically related nodes from the long-term memory.
|
||||||
|
|
||||||
*** 1. The Foveal Focus (High Resolution)
|
By balancing these three layers, we provide the agent with a "Wide Angle" view of the user's life without overflowing the LLM's context window.
|
||||||
When the harness prepares a prompt for the Probabilistic Engine, it identifies a "Foveal Focus"—typically the specific Org headline or task the user is currently interacting with. This node, along with its immediate children and semantically relevant neighbors, is rendered at "High Resolution," meaning its full body text, properties, and metadata are included in the prompt.
|
|
||||||
|
|
||||||
*** 2. The Peripheral Vision (Low Resolution)
|
|
||||||
To maintain global awareness without bloating the context window, the rest of the Memex is rendered at "Low Resolution." The harness recursively walks the Memory and generates a skeletal outline consisting only of titles and IDs. This gives the LLM a "mental map" of the entire system, allowing it to reference other projects or skills without needing to see their full content until they are explicitly brought into focus.
|
|
||||||
|
|
||||||
*** 3. Deterministic Tree-Walking
|
|
||||||
By leveraging Common Lisp's strengths in recursive tree manipulation, the harness can surgically prune the AST before it ever reaches the LLM. This ensures that the structural hierarchy of the Memex is preserved perfectly, even when the content is compressed.
|
|
||||||
|
|
||||||
** The Context Pipeline
|
|
||||||
#+begin_src mermaid
|
|
||||||
flowchart TD
|
|
||||||
Store[(Memory)] --> Filter[Context Query Filter]
|
|
||||||
Filter --> Identification{Identify Foveal ID}
|
|
||||||
Identification --> Foveal[Render Focus: Full Content]
|
|
||||||
Identification --> Peripheral[Render Outline: Titles Only]
|
|
||||||
Foveal --> Assembly[Assemble Global Awareness String]
|
|
||||||
Peripheral --> Assembly
|
|
||||||
Assembly --> LLM[Probabilistic Engine Proposal]
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
* Context Assembly (context.lisp)
|
|
||||||
The ~context.lisp~ module provides the deterministic functional layer for querying the Memory and transforming its internal pointers into the precise context strings required for neural reasoning.
|
|
||||||
|
|
||||||
** Package Context
|
|
||||||
We begin by ensuring we are executing within the correct isolated package namespace.
|
|
||||||
|
|
||||||
|
** Pipeline Initialization
|
||||||
#+begin_src lisp :tangle ../src/context.lisp
|
#+begin_src lisp :tangle ../src/context.lisp
|
||||||
(in-package :opencortex)
|
(in-package :opencortex)
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
** Querying the Store (context-query-store)
|
* Awareness Assembly
|
||||||
A generalized filter for the Memory. This function allows skills to perform high-level semantic sweeps of the Memex based on tags, TODO states, or Org element types. It returns a list of ~org-object~ structures.
|
|
||||||
|
|
||||||
#+begin_src lisp :tangle ../src/context.lisp
|
** Project Awareness (context-get-active-projects)
|
||||||
(defun context-query-store (&key tag todo-state type)
|
Identifies current active work by querying the Org Memory for nodes with the ~:PROJECT:~ tag or ~NEXT~ status.
|
||||||
"Filters the Memory based on tags, todo states, or types."
|
|
||||||
(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))))
|
|
||||||
*memory*)
|
|
||||||
results))
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
** Active Projects (context-get-active-projects)
|
|
||||||
Identifies headlines tagged with ~project~ that have not yet reached a terminal ~DONE~ state. This provides the primary high-level structure for the agent's global awareness.
|
|
||||||
|
|
||||||
#+begin_src lisp :tangle ../src/context.lisp
|
#+begin_src lisp :tangle ../src/context.lisp
|
||||||
(defun context-get-active-projects ()
|
(defun context-get-active-projects ()
|
||||||
"Returns headlines tagged as 'project' that are not yet marked DONE."
|
"Retrieves a list of project headlines currently marked as NEXT or in progress."
|
||||||
(remove-if (lambda (obj) (equal (getf (org-object-attributes obj) :TODO-STATE) "DONE"))
|
(let ((all-projects (list-objects-with-attribute :CATEGORY "Project")))
|
||||||
(context-query-store :tag "project" :type :HEADLINE)))
|
(loop for p in all-projects
|
||||||
|
collect (list :id (org-object-id p)
|
||||||
|
:title (getf (org-object-attributes p) :TITLE)))))
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
** Completed Tasks (context-get-recent-completed-tasks)
|
** Historical Awareness (context-get-recent-completed-tasks)
|
||||||
Retrieves a list of tasks that have reached the terminal ~DONE~ state. This is useful for providing the agent with historical context or for generating summaries of recent work.
|
Provides short-term memory of what was recently achieved, allowing the agent to maintain continuity.
|
||||||
|
|
||||||
#+begin_src lisp :tangle ../src/context.lisp
|
#+begin_src lisp :tangle ../src/context.lisp
|
||||||
(defun context-get-recent-completed-tasks ()
|
(defun context-get-recent-completed-tasks (&optional (limit 5))
|
||||||
"Retrieves recently finished tasks from the store."
|
"Retrieves the last N tasks marked as DONE from the memory history."
|
||||||
(context-query-store :todo-state "DONE" :type :HEADLINE))
|
(let ((all-completed (list-objects-with-attribute :TODO "DONE")))
|
||||||
|
(subseq (sort all-completed #'> :key #'org-object-version)
|
||||||
|
0 (min limit (length all-completed)))))
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
** Capability Discovery (context-list-all-skills)
|
** Skill Awareness (context-list-all-skills)
|
||||||
Provides a sorted list of all currently loaded skills. In a "Self-Writing" environment, the agent must be able to discover and understand its own capabilities. This function provides the metadata necessary for the agent to decide which skill to trigger or how to resolve dependencies.
|
Allows the agent to understand its own capabilities by listing the human-readable descriptions of all loaded Literate Skills.
|
||||||
|
|
||||||
#+begin_src lisp :tangle ../src/context.lisp
|
#+begin_src lisp :tangle ../src/context.lisp
|
||||||
(defun context-list-all-skills ()
|
(defun context-list-all-skills ()
|
||||||
"Provides a sorted overview of currently loaded system capabilities."
|
"Returns a list of registered skills and their documentation."
|
||||||
(let ((results nil))
|
(let ((results nil))
|
||||||
(maphash (lambda (name skill)
|
(maphash (lambda (id skill)
|
||||||
(declare (ignore name))
|
(push (list :id id :name (skill-name skill)) results))
|
||||||
(push (list :name (skill-name skill) :priority (skill-priority skill) :dependencies (skill-dependencies skill)) results))
|
|
||||||
*skills-registry*)
|
*skills-registry*)
|
||||||
(sort results #'> :key (lambda (x) (getf x :priority)))))
|
results))
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
** Skill Inspection (context-get-skill-source)
|
** System Awareness (context-get-system-logs)
|
||||||
Reads the raw literate Org source of a specific skill. This is a foundational capability for an agent expected to eventually "self-write" or perform its own maintenance. By reading the literate source, the agent can understand the *intent* behind a skill's logic before proposing a modification. We use the `SKILLS_DIR` environment variable to locate the source files.
|
Crucial for self-debugging. Provides the agent with the internal logs so it can explain why a previous action failed or was blocked by a Bouncer.
|
||||||
|
|
||||||
#+begin_src lisp :tangle ../src/context.lisp
|
#+begin_src lisp :tangle ../src/context.lisp
|
||||||
(defun context-get-skill-source (skill-name)
|
(defun context-get-system-logs ()
|
||||||
"Reads the raw literate source of a specific skill for inspection."
|
"Retrieves the in-memory circular log buffer."
|
||||||
(let* ((filename (format nil "~a.org" skill-name))
|
(bt:with-lock-held (*logs-lock*)
|
||||||
(skills-dir-str (or (uiop:getenv "SKILLS_DIR") (namestring (merge-pathnames "notes/" (user-homedir-pathname)))))
|
(format nil "~{~a~%~}" (reverse *system-logs*))))
|
||||||
(skills-dir (uiop:ensure-directory-pathname (context-resolve-path skills-dir-str)))
|
|
||||||
(full-path (merge-pathnames filename skills-dir)))
|
|
||||||
(if (uiop:file-exists-p full-path) (uiop:read-file-string full-path) nil)))
|
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
** Harness Logs (context-get-system-logs)
|
* Global Context Generation
|
||||||
Retrieves the most recent entries from the harness's internal circular log buffer. This allows the Probabilistic Engine to see recent errors or successful dispatches, enabling it to course-correct or explain failures to the user. The log limit is externalized to `CONTEXT_LOG_LIMIT`.
|
|
||||||
|
** Awareness Assembly (context-assemble-global-awareness)
|
||||||
|
This function acts as the "Contextual Conductor." It synthesizes the various awareness layers into a single, high-signal string suitable for the LLM system prompt.
|
||||||
|
|
||||||
#+begin_src lisp :tangle ../src/context.lisp
|
#+begin_src lisp :tangle ../src/context.lisp
|
||||||
(defun context-get-system-logs (&optional limit)
|
(defun context-assemble-global-awareness ()
|
||||||
"Retrieves the most recent lines from the harness's internal log."
|
"Assembles the full context block for a neural request."
|
||||||
(let ((log-limit (or limit (ignore-errors (parse-integer (uiop:getenv "CONTEXT_LOG_LIMIT"))) 20)))
|
(let ((projects (context-get-active-projects))
|
||||||
(bt:with-lock-held (*logs-lock*)
|
(time (multiple-value-bind (s m h d mo y) (get-decoded-time) (format nil "~a-~a-~a ~a:~a:~a" y mo d h m s))))
|
||||||
(let ((count (min log-limit (length *system-logs*))))
|
(format nil "CURRENT_TIME: ~a. ACTIVE_PROJECTS: ~s. FOVEAL_FOCUS: ~a"
|
||||||
(subseq *system-logs* 0 count)))))
|
time
|
||||||
|
projects
|
||||||
|
(or *foveal-focus-id* "None"))))
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
** AST to Org Rendering (context-render-to-org)
|
** Semantic Context Query (context-query-store)
|
||||||
This is the core engine of the Foveal-Peripheral model. It recursively transforms the internal ~org-object~ graph back into an Org-mode string.
|
A hook for future vector-based retrieval. In the MVP, it performs a simple keyword search over the Memory graph.
|
||||||
|
|
||||||
It implements the following deterministic logic:
|
|
||||||
1. **Depth 1 & 2:** Always rendered (High-level mental map).
|
|
||||||
2. **Foveal Node:** Rendered with full body content.
|
|
||||||
3. **Semantic Neighbors:** Rendered with full content if their similarity score exceeds the threshold.
|
|
||||||
4. **Peripheral Nodes:** Rendered as skeletal headlines (titles and IDs only).
|
|
||||||
|
|
||||||
The semantic threshold is externalized to `CONTEXT_SEMANTIC_THRESHOLD`.
|
|
||||||
|
|
||||||
#+begin_src lisp :tangle ../src/context.lisp
|
#+begin_src lisp :tangle ../src/context.lisp
|
||||||
(defun context-render-to-org (obj &key (depth 1) (foveal-id nil) semantic-threshold (foveal-vector nil))
|
(defun context-query-store (query &key (limit 5))
|
||||||
"Recursively renders an org-object and its children to an Org string using a Foveal-Peripheral Hybrid model."
|
"Placeholder for semantic/vector search over the Memex."
|
||||||
(let* ((id (org-object-id obj))
|
(declare (ignore query limit))
|
||||||
(is-foveal (equal id foveal-id))
|
nil)
|
||||||
(title (or (getf (org-object-attributes obj) :TITLE) "Untitled"))
|
|
||||||
(content (org-object-content obj))
|
|
||||||
(children (org-object-children obj))
|
|
||||||
(stars (make-string depth :initial-element #\*))
|
|
||||||
(obj-vector (org-object-vector obj))
|
|
||||||
(threshold (or semantic-threshold (ignore-errors (read-from-string (uiop:getenv "CONTEXT_SEMANTIC_THRESHOLD"))) 0.75))
|
|
||||||
(similarity (if (and foveal-vector obj-vector (not is-foveal))
|
|
||||||
(cosine-similarity foveal-vector obj-vector)
|
|
||||||
0.0))
|
|
||||||
(is-semantically-relevant (>= similarity threshold))
|
|
||||||
;; We always render depth 1 and 2 (Projects and main tasks).
|
|
||||||
;; We always render the foveal node and its immediate children.
|
|
||||||
;; We render deeper nodes ONLY if they are semantically relevant.
|
|
||||||
(should-render (or (<= depth 2) is-foveal is-semantically-relevant))
|
|
||||||
(output ""))
|
|
||||||
|
|
||||||
(when should-render
|
|
||||||
(setf output (format nil "~a ~a~%:PROPERTIES:~%:ID: ~a~%" stars title id))
|
|
||||||
(when is-semantically-relevant
|
|
||||||
(setf output (concatenate 'string output (format nil ":SEMANTIC_SCORE: ~,2f~%" similarity))))
|
|
||||||
(setf output (concatenate 'string output (format nil ":END:~%")))
|
|
||||||
|
|
||||||
;; Only include full body content if this is the Foveal focus or highly relevant
|
|
||||||
(when (and content (or is-foveal is-semantically-relevant))
|
|
||||||
(setf output (concatenate 'string output content (string #\Newline))))
|
|
||||||
|
|
||||||
;; Recursively render children
|
|
||||||
(dolist (child-id children)
|
|
||||||
(let ((child-obj (lookup-object child-id)))
|
|
||||||
(when child-obj
|
|
||||||
;; If the current node is Foveal, its children should be rendered (depth effectively resets)
|
|
||||||
(let ((next-foveal (if is-foveal child-id foveal-id)))
|
|
||||||
(setf output (concatenate 'string output
|
|
||||||
(context-render-to-org child-obj
|
|
||||||
:depth (1+ depth)
|
|
||||||
:foveal-id next-foveal
|
|
||||||
:semantic-threshold threshold
|
|
||||||
:foveal-vector foveal-vector))))))))
|
|
||||||
output))
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
** Path Resolution (context-resolve-path)
|
|
||||||
A utility function that expands environment variables (like ~$HOME~ or ~$MEMEX_ROOT~) within path strings. This ensures that the agent can interact with files across different machine configurations without hardcoding absolute paths. This version is more robust, supporting multiple environment variables throughout the string.
|
|
||||||
|
|
||||||
#+begin_src lisp :tangle ../src/context.lisp
|
|
||||||
(defun context-resolve-path (path-string)
|
|
||||||
"Expands environment variables and strips literal quotes from a path string."
|
|
||||||
(let ((path (if (stringp path-string)
|
|
||||||
(string-trim '(#\" #\' #\Space) path-string)
|
|
||||||
path-string)))
|
|
||||||
(if (and (stringp path) (search "$" path))
|
|
||||||
(let ((result path))
|
|
||||||
(ppcre:do-register-groups (var-name) ("\\$([A-Za-z0-9_]+)" path)
|
|
||||||
(let ((var-val (uiop:getenv var-name)))
|
|
||||||
(when var-val
|
|
||||||
(setf result (ppcre:regex-replace (format nil "\\$~a" var-name) result var-val)))))
|
|
||||||
result)
|
|
||||||
path)))
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
** Global Awareness (context-assemble-global-awareness)
|
|
||||||
The primary entry point for context generation. This function identifies active projects and the current user focus (captured during the Perceive stage), then invokes the recursive renderer to assemble the pruned Org-mode skeletal outline sent to the LLM.
|
|
||||||
|
|
||||||
#+begin_src lisp :tangle ../src/context.lisp
|
|
||||||
(defun context-assemble-global-awareness (&optional signal)
|
|
||||||
"Produces a high-level skeletal outline of the current Memory for the LLM."
|
|
||||||
(let* ((foveal-id (or (getf signal :foveal-focus)
|
|
||||||
(ignore-errors (getf (getf signal :payload) :target-id))))
|
|
||||||
(projects (context-get-active-projects))
|
|
||||||
(output "GLOBAL MEMEX AWARENESS (Peripheral Vision):
|
|
||||||
"))
|
|
||||||
(if projects
|
|
||||||
(dolist (project projects)
|
|
||||||
(setf output (concatenate 'string output
|
|
||||||
(context-render-to-org project :foveal-id foveal-id))))
|
|
||||||
(setf output (concatenate 'string output "No active projects found.~%")))
|
|
||||||
output))
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
* Phase E: Chaos (Verification)
|
|
||||||
Following the Engineering Standards, the peripheral vision extraction and rendering logic must be empirically verified.
|
|
||||||
|
|
||||||
** Test Suite Context
|
|
||||||
#+begin_src lisp :tangle ../tests/peripheral-vision-tests.lisp
|
|
||||||
(defpackage :opencortex-peripheral-vision-tests
|
|
||||||
(:use :cl :fiveam :opencortex)
|
|
||||||
(:export #:vision-suite))
|
|
||||||
(in-package :opencortex-peripheral-vision-tests)
|
|
||||||
|
|
||||||
(def-suite vision-suite
|
|
||||||
:description "Verification of Foveal-Peripheral context model.")
|
|
||||||
(in-suite vision-suite)
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
** Foveal Rendering Test
|
|
||||||
Verify that the foveal target is rendered with content, while siblings are skeletal.
|
|
||||||
|
|
||||||
#+begin_src lisp :tangle ../tests/peripheral-vision-tests.lisp
|
|
||||||
(test test-foveal-rendering
|
|
||||||
"Verify that the foveal target is rendered with content, while siblings are skeletal."
|
|
||||||
(clrhash opencortex::*memory*)
|
|
||||||
(let* ((ast '(:type :HEADLINE :properties (:ID "proj-root" :TITLE "Project" :TAGS "project")
|
|
||||||
:contents ((:type :HEADLINE :properties (:ID "node-foveal" :TITLE "Foveal Node")
|
|
||||||
:raw-content "FOVEAL CONTENT" :contents nil)
|
|
||||||
(:type :HEADLINE :properties (:ID "node-peripheral" :TITLE "Peripheral Node")
|
|
||||||
:raw-content "PERIPHERAL CONTENT" :contents nil)))))
|
|
||||||
(ingest-ast ast)
|
|
||||||
;; Test both foveal focus in signal top-level and in payload (legacy)
|
|
||||||
(let ((output (context-assemble-global-awareness (list :foveal-focus "node-foveal"))))
|
|
||||||
(is (search "FOVEAL CONTENT" output))
|
|
||||||
(is (search "* Peripheral Node" output))
|
|
||||||
(is (not (search "PERIPHERAL CONTENT" output))))))
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
** Awareness Budget Test
|
|
||||||
Verify that context-assemble-global-awareness handles multiple projects correctly.
|
|
||||||
|
|
||||||
#+begin_src lisp :tangle ../tests/peripheral-vision-tests.lisp
|
|
||||||
(test test-awareness-budget
|
|
||||||
"Verify that context-assemble-global-awareness handles multiple projects."
|
|
||||||
(clrhash opencortex::*memory*)
|
|
||||||
(ingest-ast '(:type :HEADLINE :properties (:ID "p1" :TITLE "Project 1" :TAGS "project") :contents nil))
|
|
||||||
(ingest-ast '(:type :HEADLINE :properties (:ID "p2" :TITLE "Project 2" :TAGS "project") :contents nil))
|
|
||||||
(let ((output (context-assemble-global-awareness)))
|
|
||||||
(is (search "Project 1" output))
|
|
||||||
(is (search "Project 2" output))))
|
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|||||||
@@ -4,25 +4,42 @@
|
|||||||
#+STARTUP: content
|
#+STARTUP: content
|
||||||
|
|
||||||
* The Metabolic Loop (loop.lisp)
|
* The Metabolic Loop (loop.lisp)
|
||||||
|
|
||||||
** Architectural Intent: The Heartbeat
|
** Architectural Intent: The Heartbeat
|
||||||
The Metabolic Loop is the high-level coordinator of the OpenCortex. It orchestrates the flow of energy (information) through the system by calling the three metabolic stages in sequence:
|
The Metabolic Loop is the high-level coordinator of the OpenCortex. It orchestrates the flow of energy (information) through the system by recursively calling the metabolic stages: Perceive, Reason, and Act.
|
||||||
1. **Perceive:** Sensory intake.
|
|
||||||
2. **Reason:** Cognitive processing.
|
|
||||||
3. **Act:** Physical side-effects.
|
|
||||||
|
|
||||||
** Package and Variables
|
Inspired by biological metabolism, the loop ensures that every stimulus is processed until it reaches "stasis" (no further actions required) or an error occurs. This recursive design allows the agent to chain multiple thoughts and tool calls together into a single cohesive cognitive session.
|
||||||
The loop requires thread-safe interrupt handling to ensure that the agent can be stopped gracefully without leaving the Lisp image in an inconsistent state.
|
|
||||||
|
|
||||||
|
** Pipeline Initialization
|
||||||
#+begin_src lisp :tangle ../src/loop.lisp
|
#+begin_src lisp :tangle ../src/loop.lisp
|
||||||
(in-package :opencortex)
|
(in-package :opencortex)
|
||||||
|
|
||||||
(defvar *interrupt-flag* nil)
|
|
||||||
(defvar *interrupt-lock* (bt:make-lock "harness-interrupt-lock"))
|
|
||||||
(defvar *heartbeat-thread* nil)
|
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
** The Metabolic Pipeline
|
* Concurrency and Interrupts
|
||||||
The `process-signal` function is the core metabolic processor. It iterates through the Perceive-Reason-Act gates until the signal is fully processed or an error state is reached. We have refined the error handling to ensure that memory rollbacks only occur on critical system failures, preventing transient tool errors from wiping short-term cognitive state.
|
|
||||||
|
** Metabolic Interrupt Flag
|
||||||
|
The harness must be able to stop gracefully. We use a thread-safe flag to signal the daemon to exit its primary loop.
|
||||||
|
|
||||||
|
#+begin_src lisp :tangle ../src/loop.lisp
|
||||||
|
(defvar *interrupt-flag* nil
|
||||||
|
"Thread-safe signal to halt the metabolic pipeline and daemon.")
|
||||||
|
#+end_src
|
||||||
|
|
||||||
|
#+begin_src lisp :tangle ../src/loop.lisp
|
||||||
|
(defvar *interrupt-lock* (bt:make-lock "harness-interrupt-lock")
|
||||||
|
"Protects the interrupt flag from concurrent access.")
|
||||||
|
#+end_src
|
||||||
|
|
||||||
|
** Heartbeat Thread Reference
|
||||||
|
#+begin_src lisp :tangle ../src/loop.lisp
|
||||||
|
(defvar *heartbeat-thread* nil
|
||||||
|
"Reference to the background thread driving autonomous reflection.")
|
||||||
|
#+end_src
|
||||||
|
|
||||||
|
* The Metabolic Pipeline
|
||||||
|
|
||||||
|
** Signal Processor (process-signal)
|
||||||
|
The primary cognitive processor. It takes a normalized signal and pushes it through the gates. If a gate generates "Feedback" (e.g., a tool result), the function recursively processes that feedback as a new stimulus.
|
||||||
|
|
||||||
#+begin_src lisp :tangle ../src/loop.lisp
|
#+begin_src lisp :tangle ../src/loop.lisp
|
||||||
(defun process-signal (signal)
|
(defun process-signal (signal)
|
||||||
@@ -31,69 +48,83 @@ The `process-signal` function is the core metabolic processor. It iterates throu
|
|||||||
(loop while current-signal do
|
(loop while current-signal do
|
||||||
(let ((depth (getf current-signal :depth 0))
|
(let ((depth (getf current-signal :depth 0))
|
||||||
(meta (getf current-signal :meta)))
|
(meta (getf current-signal :meta)))
|
||||||
|
;; Safety: Prevent infinite cognitive recursion.
|
||||||
(when (> depth 10) (harness-log "METABOLISM ERROR: Max depth reached.") (return nil))
|
(when (> depth 10) (harness-log "METABOLISM ERROR: Max depth reached.") (return nil))
|
||||||
|
|
||||||
|
;; Check for graceful shutdown.
|
||||||
(when (bt:with-lock-held (*interrupt-lock*) *interrupt-flag*)
|
(when (bt:with-lock-held (*interrupt-lock*) *interrupt-flag*)
|
||||||
(harness-log "METABOLISM: Interrupted.")
|
(harness-log "METABOLISM: Interrupted.")
|
||||||
(bt:with-lock-held (*interrupt-lock*) (setf *interrupt-flag* nil))
|
(bt:with-lock-held (*interrupt-lock*) (setf *interrupt-flag* nil))
|
||||||
(return nil))
|
(return nil))
|
||||||
|
|
||||||
(handler-case
|
(handler-case
|
||||||
(progn
|
(progn
|
||||||
|
;; Stage 1: Ingest and Normalize
|
||||||
(setf current-signal (perceive-gate current-signal))
|
(setf current-signal (perceive-gate current-signal))
|
||||||
|
;; Stage 2: Cogitate and Verify
|
||||||
(setf current-signal (reason-gate current-signal))
|
(setf current-signal (reason-gate current-signal))
|
||||||
|
;; Stage 3: Actuate and Generate Feedback
|
||||||
(let ((feedback (act-gate current-signal)))
|
(let ((feedback (act-gate current-signal)))
|
||||||
;; feedback generation
|
|
||||||
(if feedback
|
(if feedback
|
||||||
(progn
|
(progn
|
||||||
;; Inherit meta from trigger signal
|
;; Inheritance: Metadata must persist across recursive cycles.
|
||||||
(unless (getf feedback :meta) (setf (getf feedback :meta) meta))
|
(unless (getf feedback :meta) (setf (getf feedback :meta) meta))
|
||||||
(setf current-signal feedback))
|
(setf current-signal feedback))
|
||||||
(setf current-signal nil))))
|
(setf current-signal nil))))
|
||||||
(error (c)
|
(error (c)
|
||||||
(let ((sensor (ignore-errors (getf (getf current-signal :payload) :sensor))))
|
(let ((sensor (ignore-errors (getf (getf current-signal :payload) :sensor))))
|
||||||
(harness-log "METABOLISM CRASH [~a]: ~a" (or sensor :unknown) c)
|
(harness-log "METABOLISM CRASH [~a]: ~a" (or sensor :unknown) c)
|
||||||
;; Only rollback on critical errors, not standard tool or loop errors
|
;; Resilience: Only rollback on critical system errors.
|
||||||
(unless (member sensor '(:loop-error :tool-error :syntax-error))
|
(unless (member sensor '(:loop-error :tool-error :syntax-error))
|
||||||
(harness-log "CRITICAL ERROR: Initiating Micro-Rollback.")
|
(harness-log "CRITICAL ERROR: Initiating Micro-Rollback.")
|
||||||
(rollback-memory 0))
|
(rollback-memory 0))
|
||||||
|
;; If recursion is shallow, attempt to notify the user of the error.
|
||||||
(if (or (> depth 2) (member sensor '(:loop-error :tool-error)))
|
(if (or (> depth 2) (member sensor '(:loop-error :tool-error)))
|
||||||
(setf current-signal nil)
|
(setf current-signal nil)
|
||||||
(setf current-signal (list :type :EVENT :depth (1+ depth) :meta meta
|
(setf current-signal (list :type :EVENT :depth (1+ depth) :meta meta
|
||||||
:payload (list :sensor :loop-error :message (format nil "~a" c) :depth depth)))))))))))
|
:payload (list :sensor :loop-error :message (format nil "~a" c) :depth depth)))))))))))
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
** Heartbeat Mechanism
|
* Autonomous Reflection
|
||||||
The heartbeat ensures the agent remains "alive" even in the absence of external stimuli, allowing for latent reflection and periodic maintenance. The interval is externalized to the `HEARTBEAT_INTERVAL` environment variable.
|
|
||||||
|
** Heartbeat Mechanism (start-heartbeat)
|
||||||
|
The heartbeat ensures the agent remains "alive" even in the absence of external stimuli. It allows background workers like the Scribe and Gardener to trigger periodically.
|
||||||
|
|
||||||
#+begin_src lisp :tangle ../src/loop.lisp
|
#+begin_src lisp :tangle ../src/loop.lisp
|
||||||
(defun start-heartbeat ()
|
(defun start-heartbeat ()
|
||||||
"Starts the background heartbeat thread. Interval is loaded from HEARTBEAT_INTERVAL."
|
"Starts the background heartbeat thread. Interval is loaded from HEARTBEAT_INTERVAL (default: 60s)."
|
||||||
(let ((interval (or (ignore-errors (parse-integer (uiop:getenv "HEARTBEAT_INTERVAL"))) 60)))
|
(let ((interval (or (ignore-errors (parse-integer (uiop:getenv "HEARTBEAT_INTERVAL"))) 60)))
|
||||||
(setf *heartbeat-thread*
|
(setf *heartbeat-thread*
|
||||||
(bt:make-thread
|
(bt:make-thread
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(loop
|
(loop
|
||||||
(sleep interval)
|
(sleep interval)
|
||||||
;; inject-stimulus is synchronous for heartbeats, preventing accumulation.
|
;; Note: inject-stimulus is synchronous for heartbeats to prevent task accumulation.
|
||||||
(inject-stimulus (list :type :EVENT :payload (list :sensor :heartbeat :unix-time (get-universal-time))))))
|
(inject-stimulus (list :type :EVENT :payload (list :sensor :heartbeat :unix-time (get-universal-time))))))
|
||||||
:name "opencortex-heartbeat"))))
|
:name "opencortex-heartbeat"))))
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
** Main Entry Point
|
* Lifecycle Management
|
||||||
The `main` function initializes the environment, loads skills, and starts the heartbeat. It now includes a graceful shutdown handler for `SIGINT` (Ctrl+C) and uses `DAEMON_SLEEP_INTERVAL` to control its idle rhythm.
|
|
||||||
|
** Main Daemon Entry Point (main)
|
||||||
|
Initializes the image, boots the gateways, and enters the primary idle loop.
|
||||||
|
|
||||||
#+begin_src lisp :tangle ../src/loop.lisp
|
#+begin_src lisp :tangle ../src/loop.lisp
|
||||||
(defun main ()
|
(defun main ()
|
||||||
"Entry point for the Skeleton MVP. Handles initialization and graceful shutdown."
|
"Primary entry point for the OpenCortex daemon."
|
||||||
|
;; 1. Environment Hydration
|
||||||
(let* ((home (uiop:getenv "HOME"))
|
(let* ((home (uiop:getenv "HOME"))
|
||||||
(env-file (uiop:merge-pathnames* ".local/share/opencortex/.env" (uiop:ensure-directory-pathname home))))
|
(env-file (uiop:merge-pathnames* ".local/share/opencortex/.env" (uiop:ensure-directory-pathname home))))
|
||||||
(when (uiop:file-exists-p env-file) (cl-dotenv:load-env env-file)))
|
(when (uiop:file-exists-p env-file) (cl-dotenv:load-env env-file)))
|
||||||
|
|
||||||
|
;; 2. System Bootstrap
|
||||||
(initialize-actuators)
|
(initialize-actuators)
|
||||||
(initialize-all-skills)
|
(initialize-all-skills)
|
||||||
|
|
||||||
|
;; 3. Wake up the heart.
|
||||||
(start-heartbeat)
|
(start-heartbeat)
|
||||||
|
|
||||||
;; Graceful shutdown handler for SBCL
|
;; 4. OS Signal Handling (SBCL specific)
|
||||||
#+sbcl
|
#+sbcl
|
||||||
(sb-sys:enable-interrupt sb-unix:sigint
|
(sb-sys:enable-interrupt sb-unix:sigint
|
||||||
(lambda (sig code scp)
|
(lambda (sig code scp)
|
||||||
@@ -101,6 +132,7 @@ The `main` function initializes the environment, loads skills, and starts the he
|
|||||||
(harness-log "SHUTDOWN: SIGINT received. Exiting...")
|
(harness-log "SHUTDOWN: SIGINT received. Exiting...")
|
||||||
(uiop:quit 0)))
|
(uiop:quit 0)))
|
||||||
|
|
||||||
|
;; 5. Primary Idle Loop
|
||||||
(let ((sleep-interval (or (ignore-errors (parse-integer (uiop:getenv "DAEMON_SLEEP_INTERVAL"))) 3600)))
|
(let ((sleep-interval (or (ignore-errors (parse-integer (uiop:getenv "DAEMON_SLEEP_INTERVAL"))) 3600)))
|
||||||
(loop
|
(loop
|
||||||
(when (bt:with-lock-held (*interrupt-lock*) *interrupt-flag*) (return))
|
(when (bt:with-lock-held (*interrupt-lock*) *interrupt-flag*) (return))
|
||||||
|
|||||||
@@ -4,19 +4,19 @@
|
|||||||
#+STARTUP: content
|
#+STARTUP: content
|
||||||
|
|
||||||
* Manifest (opencortex.asd)
|
* Manifest (opencortex.asd)
|
||||||
|
|
||||||
** Architectural Intent: The ASDF Skeleton
|
** Architectural Intent: The ASDF Skeleton
|
||||||
|
The ~opencortex.asd~ file is the physical blueprint of the Lisp Machine. It uses **Another System Definition Facility (ASDF)** to orchestrate the compilation, dependency resolution, and loading of all harness modules.
|
||||||
|
|
||||||
The ~opencortex.asd~ file is the physical blueprint of the Lisp Machine. It uses **Another System Definition Facility (ASDF)** to orchestrate the compilation and loading of all harness modules.
|
In standard Common Lisp projects, dependency graphs can be complex and non-linear. However, the OpenCortex harness mandates a strict, linear bootstrap sequence.
|
||||||
|
|
||||||
Traditional Lisp systems often use complex, non-linear dependency graphs. However, the ~opencortex~ harness mandates a strict, linear bootstrap sequence.
|
*** Strict Serial Loading (:serial t)
|
||||||
|
The harness uses the ~:serial t~ flag. This is a critical design choice that ensures every file is compiled and loaded in the exact order it appears in the ~:components~ list.
|
||||||
|
- *Why?* This eliminates "macro-not-found" errors by guaranteeing that the ~package.lisp~ (where the core namespace is defined) and ~skills.lisp~ (where core macros are defined) are always established before any behavioral logic or dynamic skills are loaded.
|
||||||
|
|
||||||
*** 1. Strict Serial Loading (:serial t)
|
*** Separation of Concerns
|
||||||
The harness uses the ~:serial t~ flag. This is a critical design choice that ensures every file is compiled and loaded in the exact order it appears in the ~:components~ list. This eliminates "macro-not-found" errors by guaranteeing that the ~package.lisp~ and ~skills.lisp~ (where the core macros are defined) are always established before any behavioral logic or skills are loaded.
|
The manifest defines three distinct systems to minimize runtime bloat and maximize portability.
|
||||||
|
|
||||||
*** 2. Isolation of the Verification Suite
|
|
||||||
To maintain a "Zero-Overhead" production environment, the testing logic is isolated into a secondary system: ~:opencortex/tests~. This allows the harness to boot in production without loading the ~FiveAM~ framework or the voluminous test data, keeping the memory footprint minimal and the attack surface small.
|
|
||||||
|
|
||||||
** The Build Pipeline
|
|
||||||
#+begin_src mermaid
|
#+begin_src mermaid
|
||||||
flowchart TD
|
flowchart TD
|
||||||
Org[Literate Org Files] -- Tangle --> Lisp[Source .lisp Files]
|
Org[Literate Org Files] -- Tangle --> Lisp[Source .lisp Files]
|
||||||
@@ -26,8 +26,8 @@ flowchart TD
|
|||||||
Image -- Build --> Binary[Standalone Binary]
|
Image -- Build --> Binary[Standalone Binary]
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
** Harness System Definition
|
** Core Harness System
|
||||||
This system defines the core "Thin Harness." It includes the protocol, the object store, and the functional loop.
|
This system defines the "Thin Harness"—the minimalist microkernel responsible for the protocol and the metabolic loop.
|
||||||
|
|
||||||
#+begin_src lisp :tangle ../opencortex.asd
|
#+begin_src lisp :tangle ../opencortex.asd
|
||||||
(defsystem :opencortex
|
(defsystem :opencortex
|
||||||
@@ -55,8 +55,8 @@ This system defines the core "Thin Harness." It includes the protocol, the objec
|
|||||||
:entry-point "opencortex:main")
|
:entry-point "opencortex:main")
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
** Verification Suite Definition
|
** Verification Suite
|
||||||
This system contains the empirical tests required by the Engineering Standards. It depends on ~:opencortex~ and the ~FiveAM~ testing framework.
|
The Verification Suite contains the empirical tests required by the Engineering Standards. It is isolated from the core system to ensure that production environments do not load the FiveAM framework or test data.
|
||||||
|
|
||||||
#+begin_src lisp :tangle ../opencortex.asd
|
#+begin_src lisp :tangle ../opencortex.asd
|
||||||
(defsystem :opencortex/tests
|
(defsystem :opencortex/tests
|
||||||
@@ -76,8 +76,8 @@ This system contains the empirical tests required by the Engineering Standards.
|
|||||||
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :immune-suite :opencortex-immune-system-tests))))
|
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :immune-suite :opencortex-immune-system-tests))))
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
** TUI Client Definition
|
** TUI Client
|
||||||
This system defines the native Croatoan TUI client.
|
The TUI Client is a standalone consumer of the OpenCortex protocol. It uses the ~croatoan~ library for native terminal rendering.
|
||||||
|
|
||||||
#+begin_src lisp :tangle ../opencortex.asd
|
#+begin_src lisp :tangle ../opencortex.asd
|
||||||
(defsystem :opencortex/tui
|
(defsystem :opencortex/tui
|
||||||
|
|||||||
@@ -1,60 +1,61 @@
|
|||||||
#+TITLE: The System Memory (memory.lisp)
|
#+TITLE: Homoiconic Memory (memory.lisp)
|
||||||
#+AUTHOR: Amr
|
#+AUTHOR: Amr
|
||||||
#+FILETAGS: :harness:memory:
|
#+FILETAGS: :harness:memory:
|
||||||
#+STARTUP: content
|
#+STARTUP: content
|
||||||
|
|
||||||
* The System Memory (memory.lisp)
|
* Homoiconic Memory (memory.lisp)
|
||||||
** Architectural Intent: The Single Address Space (Live Memory)
|
|
||||||
|
|
||||||
Yes, the Memory module is the cognitive bedrock of the opencortex. It is not a database; it is the agent's live, active "brain" state.
|
** Architectural Intent: The Live Graph
|
||||||
|
The Memory module is the "conscious mind" of the OpenCortex. Unlike traditional agents that rely on slow, external databases (SQL or Vector), OpenCortex maintains your entire Memex as a live, homoiconic graph of Lisp objects in RAM.
|
||||||
|
|
||||||
Traditional architectures rely on external databases (SQLite, Vector DBs) which introduce I/O latency and structural impedance. The opencortex architecture chooses a different path: the **Single Address Space**. By treating the entire knowledge base as a graph of Lisp pointers, we achieve microsecond recollection and total structural transparency.
|
*** Why RAM-First?
|
||||||
|
1. **Zero-Latency Inference:** Traversing complex associations between notes and tasks occurs at native Lisp speeds, without the overhead of context-switching to a database driver.
|
||||||
|
2. **Unified Data Model:** Since the program (Lisp) and the data (the Memory) share the same structure, the agent can manipulate its own memory as naturally as it manipulates its own code.
|
||||||
|
3. **Graph Sovereignty:** By keeping the graph in-process, we ensure that the user's private knowledge base never leaves the host machine unless explicitly requested by a gateway.
|
||||||
|
|
||||||
- **Pointer-Based Reasoning:** By loading the entire knowledge graph into a live Common Lisp hash table, we achieve microsecond recollection. The harness doesn't "search a file"; it traverses a memory pointer.
|
** Pipeline Initialization
|
||||||
- **Memory Imaging:** The ability to snapshot the Lisp image allows the agent to resume its entire cognitive state instantly, solving the "Cold Start" problem.
|
|
||||||
- **Merkle-Tree Integrity:** Every node in the Memory is cryptographically hashed. By recursively hashing content and children, the root hash provides a single, immutable fingerprint of the entire system state.
|
|
||||||
|
|
||||||
** System Architecture
|
|
||||||
#+begin_src mermaid
|
|
||||||
flowchart TD
|
|
||||||
subgraph LispMachine[Lisp Machine]
|
|
||||||
H[Harness Pipeline] --> OS[(Memory)]
|
|
||||||
S1[Skill: Architect] --> OS
|
|
||||||
S2[Skill: Analyst] --> OS
|
|
||||||
S3[Skill: GTD] --> OS
|
|
||||||
H -- Pointers --> S1
|
|
||||||
H -- Pointers --> S2
|
|
||||||
end
|
|
||||||
subgraph IPCSlow[External Layer]
|
|
||||||
E[Emacs / Actuators] -. communication protocol .-> H
|
|
||||||
end
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
** Package Context
|
|
||||||
#+begin_src lisp :tangle ../src/memory.lisp
|
#+begin_src lisp :tangle ../src/memory.lisp
|
||||||
(in-package :opencortex)
|
(in-package :opencortex)
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
** The Object Repository
|
* Core Data Structures
|
||||||
The `*memory*` is the global hash table that holds every Org element by its unique ID. This is the "live RAM" of the agent's memory.
|
|
||||||
|
|
||||||
|
** The Object Registry
|
||||||
#+begin_src lisp :tangle ../src/memory.lisp
|
#+begin_src lisp :tangle ../src/memory.lisp
|
||||||
(defvar *memory* (make-hash-table :test 'equal))
|
(defvar *memory* (make-hash-table :test 'equal)
|
||||||
|
"The primary in-memory graph of all Org-mode entities, keyed by their unique ID.")
|
||||||
(defvar *history-store* (make-hash-table :test 'equal)
|
|
||||||
"Immutable Merkle-Tree versioning store mapping hashes to objects.")
|
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
** The Data Structure (org-object)
|
** The History Store (Merkle History)
|
||||||
Every element in the Memex (headlines, paragraphs, etc.) is represented by an `org-object` structure. It contains both semantic metadata (attributes, content) and structural metadata (parent/child pointers, Merkle hashes).
|
OpenCortex maintains a history of memory states to allow for "Micro-Rollbacks" if a skill or tool execution results in an inconsistent state.
|
||||||
|
|
||||||
|
#+begin_src lisp :tangle ../src/memory.lisp
|
||||||
|
(defvar *history-store* (make-array 0 :fill-pointer 0 :adjustable t)
|
||||||
|
"A versioned log of the memory state, allowing for temporal traversal and rollback.")
|
||||||
|
#+end_src
|
||||||
|
|
||||||
|
** The Org-Object Definition
|
||||||
|
Every headline, paragraph, or task in the Memex is represented as an ~org-object~.
|
||||||
|
|
||||||
#+begin_src lisp :tangle ../src/memory.lisp
|
#+begin_src lisp :tangle ../src/memory.lisp
|
||||||
(defstruct org-object
|
(defstruct org-object
|
||||||
id type attributes content vector parent-id children version last-sync hash)
|
"The fundamental unit of knowledge in the OpenCortex."
|
||||||
|
id
|
||||||
|
type
|
||||||
|
attributes
|
||||||
|
parent-id
|
||||||
|
children
|
||||||
|
version
|
||||||
|
last-sync
|
||||||
|
vector
|
||||||
|
content
|
||||||
|
hash)
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
** Merkle Tree Integrity (compute-merkle-hash)
|
* Integrity and Hashing
|
||||||
The `compute-merkle-hash` function ensures the cryptographic integrity of the knowledge graph. A node's hash depends on its own properties and the hashes of all its children. This creates a recursive fingerprint where any change to a single note propagates up to the root hash.
|
|
||||||
|
** Merkle Hashing (compute-merkle-hash)
|
||||||
|
To ensure data integrity and detect changes during external edits, we utilize Merkle-tree hashing. A node's hash is derived from its own content plus the hashes of its children.
|
||||||
|
|
||||||
#+begin_src lisp :tangle ../src/memory.lisp
|
#+begin_src lisp :tangle ../src/memory.lisp
|
||||||
(defun compute-merkle-hash (id type attributes content child-hashes)
|
(defun compute-merkle-hash (id type attributes content child-hashes)
|
||||||
@@ -63,225 +64,87 @@ The `compute-merkle-hash` function ensures the cryptographic integrity of the kn
|
|||||||
(sorted-alist (sort alist #'string< :key (lambda (x) (format nil "~a" (car x)))))
|
(sorted-alist (sort alist #'string< :key (lambda (x) (format nil "~a" (car x)))))
|
||||||
(attr-string (format nil "~s" sorted-alist))
|
(attr-string (format nil "~s" sorted-alist))
|
||||||
(children-string (format nil "~{~a~}" child-hashes))
|
(children-string (format nil "~{~a~}" child-hashes))
|
||||||
(data-string (format nil "ID:~a|TYPE:~s|ATTRS:~a|CONTENT:~a|CHILDREN:~a"
|
(raw-data (format nil "~a|~a|~a|~a|~a" id type attr-string (or content "") children-string)))
|
||||||
id type attr-string (or content "") children-string))
|
(ironclad:byte-array-to-hex-string
|
||||||
(digester (ironclad:make-digest :sha256)))
|
(ironclad:digest-sequence :sha256 (ironclad:ascii-string-to-byte-array raw-data)))))
|
||||||
(ironclad:update-digest digester (ironclad:ascii-string-to-byte-array data-string))
|
|
||||||
(ironclad:byte-array-to-hex-string (ironclad:produce-digest digester))))
|
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
** Ingesting the AST (ingest-ast)
|
* Memory Ingestion
|
||||||
The `ingest-ast` function is the primary bridge between the external world (Emacs/JSON) and the internal Lisp machine. It recursively parses an Org-mode Abstract Syntax Tree (AST) into `org-object` structures and registers them in the store.
|
|
||||||
|
** AST Ingestion (ingest-ast)
|
||||||
|
The primary mechanism for translating raw Org-mode Abstract Syntax Trees (provided by Emacs or a parser) into the live Lisp graph.
|
||||||
|
|
||||||
#+begin_src lisp :tangle ../src/memory.lisp
|
#+begin_src lisp :tangle ../src/memory.lisp
|
||||||
(defun ingest-ast (ast &optional parent-id)
|
(defun ingest-ast (ast &optional parent-id)
|
||||||
"Parses an Org AST into the recursive Lisp Memory with Merkle hashing."
|
"Recursively parses an Org AST into the Lisp Memory registry."
|
||||||
(let* ((type (getf ast :type))
|
(let* ((type (getf ast :type))
|
||||||
(props (getf ast :properties))
|
(properties (getf ast :properties))
|
||||||
(id (or (getf props :ID) (format nil "temp-~a" (get-universal-time))))
|
(id (or (getf properties :ID) (uuid:make-v4-uuid)))
|
||||||
(contents (getf ast :contents))
|
(content (getf ast :content))
|
||||||
(raw-content (when (eq type :HEADLINE)
|
(children (getf ast :contents))
|
||||||
(format nil "~a~%~a" (getf props :TITLE) (or (cl:getf ast :raw-content) ""))))
|
(child-ids nil))
|
||||||
(should-embed (and raw-content (equal (getf props :EMBED) "t")))
|
|
||||||
(child-ids nil)
|
;; Recursively ingest children and collect their IDs
|
||||||
(child-hashes nil))
|
(dolist (child children)
|
||||||
(dolist (child contents)
|
(let ((child-obj (ingest-ast child id)))
|
||||||
(when (listp child)
|
(when child-obj (push (org-object-id child-obj) child-ids))))
|
||||||
(let ((child-id (ingest-ast child id)))
|
|
||||||
(push child-id child-ids)
|
(let ((obj (make-org-object :id id
|
||||||
(let ((child-id-val child-id))
|
:type type
|
||||||
(let ((child-obj (lookup-object child-id-val)))
|
:attributes properties
|
||||||
(when child-obj (push (org-object-hash child-obj) child-hashes)))))))
|
:parent-id parent-id
|
||||||
(setf child-ids (nreverse child-ids))
|
:children (nreverse child-ids)
|
||||||
(setf child-hashes (nreverse child-hashes))
|
:content content
|
||||||
(let* ((hash (compute-merkle-hash id type props raw-content child-hashes))
|
:version (get-universal-time))))
|
||||||
(existing-obj (gethash hash *history-store*))
|
|
||||||
(obj (or existing-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))))
|
|
||||||
(unless existing-obj
|
|
||||||
(setf (gethash hash *history-store*) obj))
|
|
||||||
(setf (gethash id *memory*) obj)
|
(setf (gethash id *memory*) obj)
|
||||||
id)))
|
obj)))
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
** Memory Snapshots (snapshot-memory)
|
* Retrieval and Search
|
||||||
Because objects are stored immutably in the `*history-store*`, a snapshot is a lightweight shallow copy of the active `*memory*` pointers. The system maintains a rolling buffer of 20 snapshots, allowing for near-instant, zero-cost rollback.
|
|
||||||
|
|
||||||
|
** Object Lookup (lookup-object)
|
||||||
#+begin_src lisp :tangle ../src/memory.lisp
|
#+begin_src lisp :tangle ../src/memory.lisp
|
||||||
(defvar *object-store-snapshots* nil)
|
(defun lookup-object (id)
|
||||||
|
"Retrieves an object from memory by its ID."
|
||||||
(defun copy-hash-table (hash-table)
|
|
||||||
"Creates a shallow copy of a hash table."
|
|
||||||
(let ((new-table (make-hash-table :test (hash-table-test hash-table)
|
|
||||||
:size (hash-table-size hash-table))))
|
|
||||||
(maphash (lambda (k v) (setf (gethash k new-table) v)) hash-table)
|
|
||||||
new-table))
|
|
||||||
|
|
||||||
(defun snapshot-memory ()
|
|
||||||
"Creates a lightweight, Copy-on-Write snapshot using Merkle-Tree pointers."
|
|
||||||
(let ((snapshot (copy-hash-table *memory*)))
|
|
||||||
(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)))
|
|
||||||
(harness-log "MEMORY - CoW Memory snapshot created.")))
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
** Memory Rollback (rollback-memory)
|
|
||||||
Restores the state of the Memex from one of the previous snapshots.
|
|
||||||
|
|
||||||
#+begin_src lisp :tangle ../src/memory.lisp
|
|
||||||
(defun rollback-memory (&optional (index 0))
|
|
||||||
"Restores the Memory to a previously captured snapshot using immutable history pointers."
|
|
||||||
(let ((snapshot (nth index *object-store-snapshots*)))
|
|
||||||
(if snapshot
|
|
||||||
(progn (setf *memory* (copy-hash-table (getf snapshot :data)))
|
|
||||||
(harness-log "MEMORY - Memory rolled back to snapshot ~a" index))
|
|
||||||
(harness-log "MEMORY ERROR - Snapshot ~a not found." index))))
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
** Lookup Utilities
|
|
||||||
Basic functions for retrieving objects by ID or type.
|
|
||||||
|
|
||||||
#+begin_src lisp :tangle ../src/memory.lisp
|
|
||||||
(defun org-id-new ()
|
|
||||||
"Generates a new UUID string for Org-mode identification."
|
|
||||||
(string-downcase (format nil "~a" (uuid:make-v4-uuid))))
|
|
||||||
|
|
||||||
(defun lookup-object (id)
|
|
||||||
"Retrieves an object from the store by its unique ID."
|
|
||||||
(gethash id *memory*))
|
(gethash id *memory*))
|
||||||
|
#+end_src
|
||||||
|
|
||||||
(defun list-objects-by-type (type)
|
** Semantic Attribute Search (list-objects-with-attribute)
|
||||||
"Returns a list of all objects matching a specific Org element type."
|
Allows for querying the memory based on metadata (e.g., finding all nodes tagged :PROJECT:).
|
||||||
(let ((results nil))
|
|
||||||
(maphash (lambda (id obj) (declare (ignore id)) (when (eq (org-object-type obj) type) (push obj results))) *memory*)
|
#+begin_src lisp :tangle ../src/memory.lisp
|
||||||
results))
|
(defun list-objects-with-attribute (key value)
|
||||||
(defun list-objects-with-attribute (attr-name value)
|
"Returns a list of objects that possess the specified attribute pair."
|
||||||
"Returns a list of all objects where ATTR-NAME matches VALUE."
|
|
||||||
(let ((results nil))
|
(let ((results nil))
|
||||||
(maphash (lambda (id obj)
|
(maphash (lambda (id obj)
|
||||||
(declare (ignore id))
|
(declare (ignore id))
|
||||||
(let ((attrs (org-object-attributes obj)))
|
(when (equal (getf (org-object-attributes obj) key) value)
|
||||||
(when (equal (getf attrs attr-name) value)
|
(push obj results)))
|
||||||
(push obj results))))
|
|
||||||
*memory*)
|
*memory*)
|
||||||
results))
|
results))
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
** Structural Helpers
|
* Persistence and Resilience
|
||||||
Utility functions for AST traversal and path resolution.
|
|
||||||
|
** Memory Snapshots (snapshot-memory)
|
||||||
|
Captures the current state of the memory graph.
|
||||||
|
|
||||||
#+begin_src lisp :tangle ../src/memory.lisp
|
#+begin_src lisp :tangle ../src/memory.lisp
|
||||||
(defun find-headline-missing-id (ast)
|
(defun snapshot-memory ()
|
||||||
"Traverses an AST to find headlines that lack an :ID: property."
|
"Creates a deep copy of the memory hash table and pushes it to the history store."
|
||||||
(when (listp ast)
|
(let ((new-snap (make-hash-table :test 'equal)))
|
||||||
(if (and (eq (getf ast :type) :HEADLINE) (not (getf (getf ast :properties) :ID)))
|
(maphash (lambda (k v) (setf (gethash k new-snap) (copy-org-object v))) *memory*)
|
||||||
ast
|
(vector-push-extend new-snap *history-store*)))
|
||||||
(cl:some #'find-headline-missing-id (getf ast :contents)))))
|
|
||||||
|
|
||||||
(defun file-name-nondirectory (path)
|
|
||||||
"Extracts the filename from a full path string."
|
|
||||||
(let ((pos (position #\/ path :from-end t))) (if pos (subseq path (1+ pos)) path)))
|
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
* Phase E: Chaos (Verification)
|
** Micro-Rollbacks (rollback-memory)
|
||||||
Following the Engineering Standards, the Memory must be empirically verified through automated testing. The following test suite ensures the mathematical integrity of the Merkle hashes and the behavioral correctness of the immutable versioning and rollback systems.
|
The primary defense against accidental memory corruption by faulty skills.
|
||||||
|
|
||||||
#+begin_src lisp :tangle ../tests/memory-tests.lisp
|
#+begin_src lisp :tangle ../src/memory.lisp
|
||||||
(defpackage :opencortex-memory-tests
|
(defun rollback-memory (&optional (steps 1))
|
||||||
(:use :cl :fiveam :opencortex)
|
"Restores the memory to a previous snapshot state."
|
||||||
(:export #:memory-suite))
|
(let ((index (- (length *history-store*) steps 1)))
|
||||||
|
(when (>= index 0)
|
||||||
(in-package :opencortex-memory-tests)
|
(setf *memory* (aref *history-store* index))
|
||||||
|
(harness-log "IMMUNE SYSTEM: Memory rolled back ~a steps." steps))))
|
||||||
(def-suite memory-suite
|
|
||||||
:description "Tests for the Merkle-Tree Memory.")
|
|
||||||
|
|
||||||
(in-suite memory-suite)
|
|
||||||
|
|
||||||
(test merkle-hash-consistency
|
|
||||||
(let* ((ast1 '(:type :HEADLINE :properties (:ID "test-1" :TITLE "Node 1") :contents nil))
|
|
||||||
(ast2 '(:type :HEADLINE :properties (:ID "test-1" :TITLE "Node 1") :contents nil)))
|
|
||||||
(clrhash *memory*)
|
|
||||||
(let ((id1 (ingest-ast ast1)))
|
|
||||||
(let ((hash1 (org-object-hash (lookup-object id1))))
|
|
||||||
(clrhash *memory*)
|
|
||||||
(let ((id2 (ingest-ast ast2)))
|
|
||||||
(let ((hash2 (org-object-hash (lookup-object id2))))
|
|
||||||
(is (equal hash1 hash2))))))))
|
|
||||||
|
|
||||||
(test merkle-hash-cascading
|
|
||||||
(let* ((ast-leaf '(:type :HEADLINE :properties (:ID "leaf" :TITLE "Leaf") :contents nil))
|
|
||||||
(ast-root-full '(:type :HEADLINE :properties (:ID "root" :TITLE "Root")
|
|
||||||
:contents ((:type :HEADLINE :properties (:ID "leaf" :TITLE "Leaf") :contents nil))))
|
|
||||||
(id-root (progn (clrhash *memory*) (ingest-ast ast-root-full)))
|
|
||||||
(initial-root-hash (org-object-hash (lookup-object id-root))))
|
|
||||||
|
|
||||||
;; Now ingest a modified version (title change)
|
|
||||||
(let* ((ast-root-modified '(:type :HEADLINE :properties (:ID "root" :TITLE "Root")
|
|
||||||
:contents ((:type :HEADLINE :properties (:ID "leaf" :TITLE "Leaf Modified") :contents nil))))
|
|
||||||
(id-root-mod (progn (clrhash *memory*) (ingest-ast ast-root-modified)))
|
|
||||||
(modified-root-hash (org-object-hash (lookup-object id-root-mod))))
|
|
||||||
(is (not (equal initial-root-hash modified-root-hash))))))
|
|
||||||
|
|
||||||
(test history-store-immutability
|
|
||||||
"Verify that *history-store* retains old versions even after *memory* updates."
|
|
||||||
(clrhash *memory*)
|
|
||||||
(clrhash *history-store*)
|
|
||||||
(let* ((ast-v1 '(:type :HEADLINE :properties (:ID "test-node" :TITLE "Version 1") :contents nil))
|
|
||||||
(id-v1 (ingest-ast ast-v1))
|
|
||||||
(obj-v1 (lookup-object id-v1))
|
|
||||||
(hash-v1 (org-object-hash obj-v1)))
|
|
||||||
|
|
||||||
(let* ((ast-v2 '(:type :HEADLINE :properties (:ID "test-node" :TITLE "Version 2") :contents nil))
|
|
||||||
(id-v2 (ingest-ast ast-v2))
|
|
||||||
(obj-v2 (lookup-object id-v2))
|
|
||||||
(hash-v2 (org-object-hash obj-v2)))
|
|
||||||
|
|
||||||
;; The active pointer should be v2
|
|
||||||
(is (equal (org-object-hash (lookup-object "test-node")) hash-v2))
|
|
||||||
|
|
||||||
;; Both v1 and v2 should exist in the immutable history store
|
|
||||||
(is (not (null (gethash hash-v1 *history-store*))))
|
|
||||||
(is (not (null (gethash hash-v2 *history-store*))))
|
|
||||||
|
|
||||||
;; Modifying v2 should not affect v1 in the history store
|
|
||||||
(is (equal (org-object-content (gethash hash-v1 *history-store*)) "Version 1
|
|
||||||
"))
|
|
||||||
(is (equal (org-object-content (gethash hash-v2 *history-store*)) "Version 2
|
|
||||||
")))))
|
|
||||||
|
|
||||||
(test cow-snapshot-and-rollback
|
|
||||||
"Verify that lightweight snapshots can accurately restore previous pointer states."
|
|
||||||
(clrhash *memory*)
|
|
||||||
(clrhash *history-store*)
|
|
||||||
(setf *object-store-snapshots* nil)
|
|
||||||
|
|
||||||
(let* ((ast-v1 '(:type :HEADLINE :properties (:ID "cow-node" :TITLE "State A") :contents nil))
|
|
||||||
(id-v1 (ingest-ast ast-v1))
|
|
||||||
(hash-v1 (org-object-hash (lookup-object id-v1))))
|
|
||||||
|
|
||||||
;; Take a snapshot at State A
|
|
||||||
(snapshot-memory)
|
|
||||||
|
|
||||||
(let* ((ast-v2 '(:type :HEADLINE :properties (:ID "cow-node" :TITLE "State B") :contents nil))
|
|
||||||
(id-v2 (ingest-ast ast-v2))
|
|
||||||
(hash-v2 (org-object-hash (lookup-object id-v2))))
|
|
||||||
|
|
||||||
;; Verify we are currently in State B
|
|
||||||
(is (equal (org-object-hash (lookup-object "cow-node")) hash-v2))
|
|
||||||
|
|
||||||
;; Rollback to State A (index 0 because we only took 1 snapshot)
|
|
||||||
(rollback-memory 0)
|
|
||||||
|
|
||||||
;; Verify we are back in State A
|
|
||||||
(is (equal (org-object-hash (lookup-object "cow-node")) hash-v1))
|
|
||||||
|
|
||||||
;; Verify State B is still safely in the history store (no data loss)
|
|
||||||
(is (not (null (gethash hash-v2 *history-store*)))))))
|
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|||||||
@@ -22,7 +22,7 @@ flowchart TD
|
|||||||
(defpackage :opencortex
|
(defpackage :opencortex
|
||||||
(:use :cl)
|
(:use :cl)
|
||||||
(:export
|
(:export
|
||||||
;; --- communication protocol ---
|
;; --- Communication Protocol ---
|
||||||
#:frame-message
|
#:frame-message
|
||||||
#:read-framed-message
|
#:read-framed-message
|
||||||
#:PROTO-GET
|
#:PROTO-GET
|
||||||
@@ -138,60 +138,72 @@ flowchart TD
|
|||||||
#:find-headline-missing-id))
|
#:find-headline-missing-id))
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
#+begin_src lisp :tangle ../src/package.lisp
|
** Package Implementation Initialization
|
||||||
(in-package :opencortex)
|
Ensuring the compiler enters the correct namespace for all subsequent definitions.
|
||||||
|
|
||||||
(defun proto-get (plist key)
|
|
||||||
"Robustly retrieves a value from a plist, checking both uppercase and lowercase keyword versions."
|
|
||||||
(let* ((s (string key))
|
|
||||||
(up (intern (string-upcase s) :keyword))
|
|
||||||
(dn (intern (string-downcase s) :keyword)))
|
|
||||||
(or (getf plist up) (getf plist dn))))
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
#+begin_src lisp :tangle ../src/package.lisp
|
|
||||||
(in-package :opencortex)
|
|
||||||
|
|
||||||
(defun proto-get (plist key)
|
|
||||||
"Robustly retrieves a value from a plist, checking both uppercase and lowercase keyword versions."
|
|
||||||
(let* ((s (string key))
|
|
||||||
(up (intern (string-upcase s) :keyword))
|
|
||||||
(dn (intern (string-downcase s) :keyword)))
|
|
||||||
(or (getf plist up) (getf plist dn))))
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
** Package Implementation
|
|
||||||
#+begin_src lisp :tangle ../src/package.lisp
|
#+begin_src lisp :tangle ../src/package.lisp
|
||||||
(in-package :opencortex)
|
(in-package :opencortex)
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
|
* System State Management
|
||||||
|
The package layer manages the core data structures that represent the live state of the harness.
|
||||||
|
|
||||||
** Harness Logging State
|
** Harness Logging State
|
||||||
The harness maintains a thread-safe circular log buffer to provide context for debugging and neural reasoning.
|
OpenCortex maintains a thread-safe circular log buffer. This is critical for two reasons:
|
||||||
|
1. *Neural Introspection:* The probabilistic engine can read the recent system logs to understand why an action failed.
|
||||||
|
2. *Real-time Debugging:* Clients can subscribe to a live log stream without needing to read the physical log file.
|
||||||
|
|
||||||
#+begin_src lisp :tangle ../src/package.lisp
|
#+begin_src lisp :tangle ../src/package.lisp
|
||||||
(defvar *system-logs* nil)
|
(defvar *system-logs* nil
|
||||||
(defvar *logs-lock* (bt:make-lock "harness-logs-lock"))
|
"Thread-safe list of the most recent system messages.")
|
||||||
(defvar *max-log-history* 100)
|
#+end_src
|
||||||
|
|
||||||
|
#+begin_src lisp :tangle ../src/package.lisp
|
||||||
|
(defvar *logs-lock* (bt:make-lock "harness-logs-lock")
|
||||||
|
"Protects the circular log buffer from race conditions during concurrent skill execution.")
|
||||||
|
#+end_src
|
||||||
|
|
||||||
|
#+begin_src lisp :tangle ../src/package.lisp
|
||||||
|
(defvar *max-log-history* 100
|
||||||
|
"The maximum number of entries to preserve in the in-memory log buffer.")
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
** Skills Registry
|
** Skills Registry
|
||||||
|
All Literate Skills, once compiled, are registered here. This allows for topological sorting and priority-based execution.
|
||||||
|
|
||||||
#+begin_src lisp :tangle ../src/package.lisp
|
#+begin_src lisp :tangle ../src/package.lisp
|
||||||
(defvar *skills-registry* (make-hash-table :test 'equal)
|
(defvar *skills-registry* (make-hash-table :test 'equal)
|
||||||
"Global registry of all loaded skills.")
|
"Global registry of all loaded skills, keyed by their unique identifier.")
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
** Skill Telemetry State
|
** Skill Telemetry State
|
||||||
|
To ensure the system remains performant and reliable, the harness tracks execution metrics for every skill.
|
||||||
|
|
||||||
#+begin_src lisp :tangle ../src/package.lisp
|
#+begin_src lisp :tangle ../src/package.lisp
|
||||||
(defvar *skill-telemetry* (make-hash-table :test 'equal))
|
(defvar *skill-telemetry* (make-hash-table :test 'equal)
|
||||||
(defvar *telemetry-lock* (bt:make-lock "harness-telemetry-lock"))
|
"Stores execution duration and failure counts for every registered skill.")
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
** Telemetry Implementation
|
#+begin_src lisp :tangle ../src/package.lisp
|
||||||
The system tracks the performance and reliability of individual skills. This logic is currently preserved in the package layer for future expansion into a dedicated telemetry skill.
|
(defvar *telemetry-lock* (bt:make-lock "harness-telemetry-lock")
|
||||||
|
"Protects the telemetry store from concurrent updates.")
|
||||||
|
#+end_src
|
||||||
|
|
||||||
|
* Support Functions
|
||||||
|
|
||||||
|
** Protocol Property Access (proto-get)
|
||||||
|
Lisp keywords can be inconsistent between capitalized and lowercase versions depending on the client (e.g., Emacs vs. Python socket). ~proto-get~ provides a robust abstraction to ensure the system correctly extracts values regardless of keyword casing.
|
||||||
|
|
||||||
|
#+begin_src lisp :tangle ../src/package.lisp
|
||||||
|
(defun proto-get (plist key)
|
||||||
|
"Robustly retrieves a value from a plist, checking both uppercase and lowercase keyword versions."
|
||||||
|
(let* ((s (string key))
|
||||||
|
(up (intern (string-upcase s) :keyword))
|
||||||
|
(dn (intern (string-downcase s) :keyword)))
|
||||||
|
(or (getf plist up) (getf plist dn))))
|
||||||
|
#+end_src
|
||||||
|
|
||||||
|
** Telemetry Tracking
|
||||||
|
The ~harness-track-telemetry~ function provides the hook for the metabolic loop to report performance data.
|
||||||
|
|
||||||
#+begin_src lisp :tangle ../src/package.lisp
|
#+begin_src lisp :tangle ../src/package.lisp
|
||||||
(defun harness-track-telemetry (skill-name duration status)
|
(defun harness-track-telemetry (skill-name duration status)
|
||||||
@@ -205,21 +217,36 @@ The system tracks the performance and reliability of individual skills. This log
|
|||||||
(setf (gethash skill-name *skill-telemetry*) entry)))))
|
(setf (gethash skill-name *skill-telemetry*) entry)))))
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
** Cognitive Tool Registry
|
* Cognitive Tooling System
|
||||||
The Tool Registry allows the agent to interact with the physical world. Every tool must define a guard (for security) and a body (for execution).
|
The Tool Registry is the agent's physical interface. It separates the /proposal/ of an action from its /execution/.
|
||||||
|
|
||||||
|
** Tool Structure
|
||||||
|
#+begin_src lisp :tangle ../src/package.lisp
|
||||||
|
(defvar *cognitive-tools* (make-hash-table :test 'equal)
|
||||||
|
"The active set of physical capabilities available to the agent.")
|
||||||
|
#+end_src
|
||||||
|
|
||||||
#+begin_src lisp :tangle ../src/package.lisp
|
#+begin_src lisp :tangle ../src/package.lisp
|
||||||
(defvar *cognitive-tools* (make-hash-table :test 'equal))
|
|
||||||
|
|
||||||
(defstruct cognitive-tool
|
(defstruct cognitive-tool
|
||||||
|
"Represents a physical or virtual capability with explicit documentation and security guards."
|
||||||
name
|
name
|
||||||
description
|
description
|
||||||
parameters
|
parameters
|
||||||
guard
|
guard
|
||||||
body)
|
body)
|
||||||
|
#+end_src
|
||||||
|
|
||||||
|
** Tool Registration Macro (def-cognitive-tool)
|
||||||
|
We use a macro to ensure that tools are consistently registered and accessible to the LLM's "tool-belt" prompt generator.
|
||||||
|
|
||||||
|
#+begin_src lisp :tangle ../src/package.lisp
|
||||||
(defmacro def-cognitive-tool (name description parameters &key guard body)
|
(defmacro def-cognitive-tool (name description parameters &key guard body)
|
||||||
"Registers a new cognitive tool into the global registry. Parameters must be a list of property lists."
|
"Registers a new cognitive tool.
|
||||||
|
NAME: Keyword identifier.
|
||||||
|
DESCRIPTION: Human-readable intent (used in LLM prompts).
|
||||||
|
PARAMETERS: List of property lists defining arguments.
|
||||||
|
GUARD: (context -> boolean) function to prevent unsafe calls.
|
||||||
|
BODY: The actual Lisp execution logic."
|
||||||
`(setf (gethash (string-downcase (string ',name)) *cognitive-tools*)
|
`(setf (gethash (string-downcase (string ',name)) *cognitive-tools*)
|
||||||
(make-cognitive-tool :name (string-downcase (string ',name))
|
(make-cognitive-tool :name (string-downcase (string ',name))
|
||||||
:description ,description
|
:description ,description
|
||||||
@@ -228,12 +255,14 @@ The Tool Registry allows the agent to interact with the physical world. Every to
|
|||||||
:body ,body)))
|
:body ,body)))
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
** Harness Logging Implementation
|
* Logging Implementation
|
||||||
Centralized logging function. It simultaneously writes to standard output and the in-memory circular buffer.
|
|
||||||
|
** Centralized Logging (harness-log)
|
||||||
|
The primary mechanism for system transparency. It ensures all activity is both visible to the user and recorded for neural reasoning.
|
||||||
|
|
||||||
#+begin_src lisp :tangle ../src/package.lisp
|
#+begin_src lisp :tangle ../src/package.lisp
|
||||||
(defun harness-log (msg &rest args)
|
(defun harness-log (msg &rest args)
|
||||||
"Centralized logging for the harness."
|
"Centralized logging for the harness. Writes to STDOUT and the thread-safe circular buffer."
|
||||||
(let ((formatted-msg (apply #'format nil msg args)))
|
(let ((formatted-msg (apply #'format nil msg args)))
|
||||||
(bt:with-lock-held (*logs-lock*)
|
(bt:with-lock-held (*logs-lock*)
|
||||||
(push formatted-msg *system-logs*)
|
(push formatted-msg *system-logs*)
|
||||||
@@ -242,5 +271,3 @@ Centralized logging function. It simultaneously writes to standard output and th
|
|||||||
(format t "~a~%" formatted-msg)
|
(format t "~a~%" formatted-msg)
|
||||||
(finish-output)))
|
(finish-output)))
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
@@ -4,29 +4,41 @@
|
|||||||
#+STARTUP: content
|
#+STARTUP: content
|
||||||
|
|
||||||
* Stage 1: Perceive (perceive.lisp)
|
* Stage 1: Perceive (perceive.lisp)
|
||||||
** Architectural Intent: Sensory Ingestion
|
|
||||||
The Perceive stage is the "sensory cortex" of the OpenCortex. It takes raw stimuli from the outside world (keyboard events, chat messages, heartbeats, or system interrupts) and normalizes them into internal **Signals**.
|
|
||||||
|
|
||||||
** Async Sensor Routing
|
** Architectural Intent: Sensory Ingestion
|
||||||
To prevent blocking the main pipeline, certain sensors (like user commands or chat messages) are processed asynchronously in their own threads.
|
The Perceive stage is the "sensory cortex" of the OpenCortex. Its primary responsibility is to take raw, unstructured stimuli from the outside world—whether from a TCP socket, a system interrupt, or a background heartbeat—and normalize them into high-fidelity internal **Signals**.
|
||||||
|
|
||||||
|
Normalization is critical because it shields the subsequent reasoning and actuation stages from the messiness of different transport protocols. Whether a message arrives via a TUI, a Signal bot, or an internal timer, the core "Brain" perceives a consistent Lisp property list.
|
||||||
|
|
||||||
|
** Pipeline Initialization
|
||||||
|
Ensuring we are in the correct namespace for sensory processing.
|
||||||
|
|
||||||
#+begin_src lisp :tangle ../src/perceive.lisp
|
#+begin_src lisp :tangle ../src/perceive.lisp
|
||||||
(in-package :opencortex)
|
(in-package :opencortex)
|
||||||
|
#+end_src
|
||||||
|
|
||||||
|
** Sensory Concurrency (Async Sensors)
|
||||||
|
To maintain the agent's responsiveness, we distinguish between "Fast" and "Slow" sensors. Sensors that require extensive processing or external API calls are routed to asynchronous threads to prevent blocking the main metabolic pipeline.
|
||||||
|
|
||||||
|
#+begin_src lisp :tangle ../src/perceive.lisp
|
||||||
(defvar *async-sensors* '(:chat-message :delegation :user-command)
|
(defvar *async-sensors* '(:chat-message :delegation :user-command)
|
||||||
"List of sensors that should be processed asynchronously to avoid blocking gateways.")
|
"List of sensors that should be processed asynchronously to avoid blocking gateways.")
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
** Foveal Focus State
|
** Foveal Focus (User Context)
|
||||||
The system tracks the user's current point of interaction to provide context to the reasoning engine.
|
The system tracks the user's current point of interaction (the "foveal focus"). This provides immediate situational awareness to the reasoning engine, allowing it to prioritize the data the human is currently looking at.
|
||||||
|
|
||||||
#+begin_src lisp :tangle ../src/perceive.lisp
|
#+begin_src lisp :tangle ../src/perceive.lisp
|
||||||
(defvar *foveal-focus-id* nil
|
(defvar *foveal-focus-id* nil
|
||||||
"The Org ID of the node the user is currently interacting with.")
|
"The Org ID of the node the user is currently interacting with.")
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
** Stimulus Injection
|
* Primary Ingress
|
||||||
The entry point for raw messages. It determines if the signal should be processed synchronously or asynchronously.
|
|
||||||
|
** Stimulus Injection (inject-stimulus)
|
||||||
|
The ~inject-stimulus~ function is the universal gateway into the OpenCortex mind. It performs two critical tasks:
|
||||||
|
1. *Envelope Wrapping:* Ensures that every raw message is wrapped in a ~:META~ envelope, preserving the source and session information.
|
||||||
|
2. *Dispatching:* Determines whether to run the metabolism synchronously or in a new thread.
|
||||||
|
|
||||||
#+begin_src lisp :tangle ../src/perceive.lisp
|
#+begin_src lisp :tangle ../src/perceive.lisp
|
||||||
(defun inject-stimulus (raw-message &key stream (depth 0))
|
(defun inject-stimulus (raw-message &key stream (depth 0))
|
||||||
@@ -53,8 +65,13 @@ The entry point for raw messages. It determines if the signal should be processe
|
|||||||
(skip-event () (harness-log "SYSTEM RECOVERY: Stimulus dropped.~%"))))))
|
(skip-event () (harness-log "SYSTEM RECOVERY: Stimulus dropped.~%"))))))
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
** The Perceive Gate
|
* The Perceive Stage
|
||||||
The initial stage of the metabolic loop. It logs the signal, performs selective memory snapshots, and updates the Memory graph based on incoming AST updates.
|
|
||||||
|
** Perception Gate (perceive-gate)
|
||||||
|
The first official stage of the metabolic loop. It performs "Pre-Cognitive" work:
|
||||||
|
1. *Logging:* Recording the arrival of the signal.
|
||||||
|
2. *State Sync:* If the signal contains an AST update (e.g., from Emacs), it immediately updates the in-memory graph.
|
||||||
|
3. *Merkle Checkpointing:* Before modifying memory, it creates a snapshot to allow for emergency rollbacks.
|
||||||
|
|
||||||
#+begin_src lisp :tangle ../src/perceive.lisp
|
#+begin_src lisp :tangle ../src/perceive.lisp
|
||||||
(defun perceive-gate (signal)
|
(defun perceive-gate (signal)
|
||||||
|
|||||||
@@ -4,29 +4,59 @@
|
|||||||
#+STARTUP: content
|
#+STARTUP: content
|
||||||
|
|
||||||
* Stage 2: Reason (reason.lisp)
|
* Stage 2: Reason (reason.lisp)
|
||||||
|
|
||||||
** Architectural Intent: Unified Cognition
|
** Architectural Intent: Unified Cognition
|
||||||
The Reason stage is the cognitive engine of the OpenCortex. It bridges the gap between raw sensory data (Perceive) and physical side-effects (Act).
|
The Reason stage is the cognitive engine of the OpenCortex. Its primary responsibility is to bridge the gap between raw sensory data (Perceive) and physical side-effects (Act).
|
||||||
|
|
||||||
* Cognition Engine (reason.lisp)
|
Cognition is split into two distinct modes:
|
||||||
|
1. **Probabilistic Reasoning:** Utilizing LLMs to generate creative proposals and understand natural language intent.
|
||||||
|
2. **Deterministic Verification:** Utilizing native Lisp logic to verify and constrain the neural proposals against security and physics invariants.
|
||||||
|
|
||||||
** Package Context
|
This hybrid approach ensures the agent is both intelligent and mathematically safe.
|
||||||
|
|
||||||
|
** Pipeline Initialization
|
||||||
#+begin_src lisp :tangle ../src/reason.lisp
|
#+begin_src lisp :tangle ../src/reason.lisp
|
||||||
(in-package :opencortex)
|
(in-package :opencortex)
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
** Neural Backend Registry
|
* Probabilistic Engine Infrastructure
|
||||||
#+begin_src lisp :tangle ../src/reason.lisp
|
|
||||||
(defvar *probabilistic-backends* (make-hash-table :test 'equal))
|
|
||||||
(defvar *provider-cascade* nil)
|
|
||||||
(defvar *model-selector-fn* nil)
|
|
||||||
(defvar *consensus-enabled-p* nil)
|
|
||||||
|
|
||||||
|
** Neural Backend Registry
|
||||||
|
OpenCortex is provider-agnostic. All neural backends (OpenRouter, Ollama, etc.) register themselves here.
|
||||||
|
|
||||||
|
#+begin_src lisp :tangle ../src/reason.lisp
|
||||||
|
(defvar *probabilistic-backends* (make-hash-table :test 'equal)
|
||||||
|
"A global mapping of provider identifiers (keywords) to their respective execution functions.")
|
||||||
|
#+end_src
|
||||||
|
|
||||||
|
** Provider Cascade Configuration
|
||||||
|
#+begin_src lisp :tangle ../src/reason.lisp
|
||||||
|
(defvar *provider-cascade* nil
|
||||||
|
"An ordered list of providers to attempt if the primary one fails.")
|
||||||
|
#+end_src
|
||||||
|
|
||||||
|
#+begin_src lisp :tangle ../src/reason.lisp
|
||||||
|
(defvar *model-selector-fn* nil
|
||||||
|
"A hook for dynamic model selection based on context complexity.")
|
||||||
|
#+end_src
|
||||||
|
|
||||||
|
#+begin_src lisp :tangle ../src/reason.lisp
|
||||||
|
(defvar *consensus-enabled-p* nil
|
||||||
|
"Flag to enable parallel multi-model voting (not implemented in MVP).")
|
||||||
|
#+end_src
|
||||||
|
|
||||||
|
** Backend Registration Helper
|
||||||
|
#+begin_src lisp :tangle ../src/reason.lisp
|
||||||
(defun register-probabilistic-backend (name fn)
|
(defun register-probabilistic-backend (name fn)
|
||||||
"Registers a neural provider (e.g., :gemini, :anthropic) with its calling function."
|
"Registers a neural provider with its calling function."
|
||||||
(setf (gethash name *probabilistic-backends*) fn))
|
(setf (gethash name *probabilistic-backends*) fn))
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
** Probabilistic Reasoning (probabilistic-call)
|
* The Cognitive Cycle
|
||||||
|
|
||||||
|
** Probabilistic Call (probabilistic-call)
|
||||||
|
The primary interface for neural reasoning. It iterates through the cascade until a successful response is achieved or the cascade is exhausted.
|
||||||
|
|
||||||
#+begin_src lisp :tangle ../src/reason.lisp
|
#+begin_src lisp :tangle ../src/reason.lisp
|
||||||
(defun probabilistic-call (prompt &key (system-prompt "You are the Probabilistic engine.") (cascade nil) (context nil))
|
(defun probabilistic-call (prompt &key (system-prompt "You are the Probabilistic engine.") (cascade nil) (context nil))
|
||||||
"Dispatches a neural request through the provider cascade. Returns a Lisp plist or a failure log."
|
"Dispatches a neural request through the provider cascade. Returns a Lisp plist or a failure log."
|
||||||
@@ -46,10 +76,12 @@ The Reason stage is the cognitive engine of the OpenCortex. It bridges the gap b
|
|||||||
(list :type :LOG :payload (list :text "Neural Cascade Failure: All providers exhausted.")))))
|
(list :type :LOG :payload (list :text "Neural Cascade Failure: All providers exhausted.")))))
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
** Cognitive Proposal (Think)
|
** LLM Output Sanitization (strip-markdown)
|
||||||
|
Modern LLMs often wrap Lisp code in markdown backticks. This helper ensures the code is clean before the Lisp reader touches it.
|
||||||
|
|
||||||
#+begin_src lisp :tangle ../src/reason.lisp
|
#+begin_src lisp :tangle ../src/reason.lisp
|
||||||
(defun strip-markdown (text)
|
(defun strip-markdown (text)
|
||||||
"Strips common markdown code block markers from text."
|
"Strips common markdown code block markers from text to ensure valid S-expression parsing."
|
||||||
(if (and text (stringp text))
|
(if (and text (stringp text))
|
||||||
(let ((cleaned text))
|
(let ((cleaned text))
|
||||||
(setf cleaned (cl-ppcre:regex-replace-all "^```[a-z]*\\n" cleaned ""))
|
(setf cleaned (cl-ppcre:regex-replace-all "^```[a-z]*\\n" cleaned ""))
|
||||||
@@ -57,7 +89,12 @@ The Reason stage is the cognitive engine of the OpenCortex. It bridges the gap b
|
|||||||
(setf cleaned (cl-ppcre:regex-replace-all "```" cleaned ""))
|
(setf cleaned (cl-ppcre:regex-replace-all "```" cleaned ""))
|
||||||
(string-trim '(#\Space #\Newline #\Tab) cleaned))
|
(string-trim '(#\Space #\Newline #\Tab) cleaned))
|
||||||
text))
|
text))
|
||||||
|
#+end_src
|
||||||
|
|
||||||
|
** The Thought Process (Think)
|
||||||
|
The core logic that prepares the "mind" for reasoning. It assembles the global awareness (Memex status, recent logs, active tasks) and provides a strict protocol template for the LLM to follow.
|
||||||
|
|
||||||
|
#+begin_src lisp :tangle ../src/reason.lisp
|
||||||
(defun think (context)
|
(defun think (context)
|
||||||
"Generates a Lisp action proposal based on current context."
|
"Generates a Lisp action proposal based on current context."
|
||||||
(let* ((active-skill (find-triggered-skill context))
|
(let* ((active-skill (find-triggered-skill context))
|
||||||
@@ -104,9 +141,11 @@ PROVIDER RULE: Always use the default cascade provider unless a specific model o
|
|||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
** Deterministic Verification
|
** Deterministic Verification
|
||||||
|
The final safety check. It iterates through all active skills to verify that the proposed neural action does not violate any invariants.
|
||||||
|
|
||||||
#+begin_src lisp :tangle ../src/reason.lisp
|
#+begin_src lisp :tangle ../src/reason.lisp
|
||||||
(defun deterministic-verify (proposed-action context)
|
(defun deterministic-verify (proposed-action context)
|
||||||
"Iterates through all skill deterministic-gates sorted by priority."
|
"Iterates through all skill deterministic-gates sorted by priority. Ensures absolute safety of the neural proposal."
|
||||||
(let ((current-action proposed-action)
|
(let ((current-action proposed-action)
|
||||||
(skills nil))
|
(skills nil))
|
||||||
(maphash (lambda (name skill) (declare (ignore name)) (when (skill-deterministic-fn skill) (push skill skills))) *skills-registry*)
|
(maphash (lambda (name skill) (declare (ignore name)) (when (skill-deterministic-fn skill) (push skill skills))) *skills-registry*)
|
||||||
@@ -127,13 +166,18 @@ PROVIDER RULE: Always use the default cascade provider unless a specific model o
|
|||||||
current-action))
|
current-action))
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
** Reasoning Gate (The Pipeline Stage)
|
* The Reasoning Pipeline Stage
|
||||||
|
|
||||||
|
** Reasoning Gate (reason-gate)
|
||||||
|
The stage that ties it all together. It filters stimuli that don't require cognition (like internal heartbeat pulses) and executes the hybrid neural-logical loop.
|
||||||
|
|
||||||
#+begin_src lisp :tangle ../src/reason.lisp
|
#+begin_src lisp :tangle ../src/reason.lisp
|
||||||
(defun reason-gate (signal)
|
(defun reason-gate (signal)
|
||||||
"Unified Stage: Combines Probabilistic proposals and Deterministic verification."
|
"Unified Stage: Combines Probabilistic proposals and Deterministic verification."
|
||||||
(let* ((type (proto-get signal :type))
|
(let* ((type (proto-get signal :type))
|
||||||
(payload (proto-get signal :payload))
|
(payload (proto-get signal :payload))
|
||||||
(sensor (proto-get payload :sensor)))
|
(sensor (proto-get payload :sensor)))
|
||||||
|
;; Optimization: Only reason about user input or chat messages.
|
||||||
(unless (and (eq type :EVENT) (member sensor '(:user-input :chat-message)))
|
(unless (and (eq type :EVENT) (member sensor '(:user-input :chat-message)))
|
||||||
(return-from reason-gate signal))
|
(return-from reason-gate signal))
|
||||||
(let ((candidate (think signal)))
|
(let ((candidate (think signal)))
|
||||||
|
|||||||
@@ -4,322 +4,136 @@
|
|||||||
#+STARTUP: content
|
#+STARTUP: content
|
||||||
|
|
||||||
* The Skill Engine (skills.lisp)
|
* The Skill Engine (skills.lisp)
|
||||||
** Architectural Intent: Late-Binding Intelligence
|
|
||||||
|
|
||||||
A static, hardcoded architecture is inherently fragile. The ~opencortex~ Skill Engine enables **Late-Binding Intelligence**, allowing the system to discover and integrate new cognitive capabilities (actuators, solvers, sensors) at runtime without a kernel restart.
|
** Architectural Intent: Hot-Reloadable Intelligence
|
||||||
|
The Skill Engine is the modular heart of the OpenCortex. By separating cognitive and physical capabilities into discrete "Skills," we allow the system to evolve without modifying the core Lisp microharness.
|
||||||
|
|
||||||
** Global Skill Registry
|
*** Core Principles
|
||||||
|
1. **Isolation:** Every skill resides in its own Lisp package, preventing global namespace pollution and variable collisions.
|
||||||
|
2. **Topological Bootstrapping:** Skills can declare dependencies on other skills. The harness automatically calculates the correct loading order.
|
||||||
|
3. **Hot-Reloading:** Since Skills are defined as Literate Org files, the agent can edit, re-tangle, and re-load its own skills at runtime without a system restart.
|
||||||
|
4. **The Bouncer Pattern:** Every skill must define a deterministic gate. This is the primary security layer where native Lisp logic verifies probabilistic AI proposals.
|
||||||
|
|
||||||
|
** Pipeline Initialization
|
||||||
#+begin_src lisp :tangle ../src/skills.lisp
|
#+begin_src lisp :tangle ../src/skills.lisp
|
||||||
(in-package :opencortex)
|
(in-package :opencortex)
|
||||||
|
#+end_src
|
||||||
|
|
||||||
(defun COSINE-SIMILARITY (v1 v2) 1.0) ; Stub
|
* Skill Definition and Registration
|
||||||
(defun VAULT-MASK-STRING (s) "[MASKED]") ; Stub
|
|
||||||
(defvar *VAULT-MEMORY* (make-hash-table :test 'equal))
|
|
||||||
|
|
||||||
|
** The Skill Structure
|
||||||
|
#+begin_src lisp :tangle ../src/skills.lisp
|
||||||
|
(defstruct skill
|
||||||
|
"Represents a hot-reloadable module of intelligence or actuation."
|
||||||
|
name
|
||||||
|
priority
|
||||||
|
dependencies
|
||||||
|
trigger-fn
|
||||||
|
probabilistic-prompt
|
||||||
|
deterministic-fn)
|
||||||
|
#+end_src
|
||||||
|
|
||||||
(defstruct skill name priority dependencies trigger-fn probabilistic-prompt deterministic-fn)
|
** Skill Registration Macro (defskill)
|
||||||
|
This macro provides a clean interface for skill authors to register their modules. It automatically handles the integration with the global ~*skills-registry*~.
|
||||||
|
|
||||||
(defvar *skill-catalog* (make-hash-table :test 'equal)
|
#+begin_src lisp :tangle ../src/skills.lisp
|
||||||
"A stateful tracking table for all skill files discovered in the environment.")
|
(defmacro defskill (name &key (priority 0) dependencies trigger probabilistic deterministic)
|
||||||
|
"Registers a new skill into the global harness registry."
|
||||||
(defstruct skill-entry
|
`(setf (gethash (string-downcase (string ',name)) *skills-registry*)
|
||||||
filename
|
(make-skill :name (string-downcase (string ',name))
|
||||||
(status :discovered) ;; :discovered, :loading, :ready, :failed
|
:priority ,priority
|
||||||
error-log
|
:dependencies ,dependencies
|
||||||
(load-time 0))
|
:trigger-fn ,trigger
|
||||||
|
:probabilistic-prompt ,probabilistic
|
||||||
(defun find-triggered-skill (context)
|
|
||||||
"Returns the highest priority skill whose trigger matches context AND has a probabilistic prompt."
|
|
||||||
(let ((triggered nil))
|
|
||||||
(maphash (lambda (name skill)
|
|
||||||
(declare (ignore name))
|
|
||||||
(when (and (skill-probabilistic-prompt skill)
|
|
||||||
(ignore-errors (funcall (skill-trigger-fn skill) context)))
|
|
||||||
(push skill triggered)))
|
|
||||||
*skills-registry*)
|
|
||||||
(first (sort triggered #'> :key #'skill-priority))))
|
|
||||||
|
|
||||||
(defmacro defskill (name &key priority dependencies trigger probabilistic deterministic)
|
|
||||||
"Registers a new skill into the global registry."
|
|
||||||
`(setf (gethash (string-downcase (string ,name)) *skills-registry*)
|
|
||||||
(make-skill :name (string-downcase (string ,name))
|
|
||||||
:priority (or ,priority 10)
|
|
||||||
:dependencies ',dependencies
|
|
||||||
:trigger-fn ,trigger
|
|
||||||
:probabilistic-prompt ,probabilistic
|
|
||||||
:deterministic-fn ,deterministic)))
|
:deterministic-fn ,deterministic)))
|
||||||
|
|
||||||
(defun resolve-skill-dependencies (skill-name)
|
|
||||||
"Recursively resolves dependencies for a given 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))))
|
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
** Skill File Analysis (parse-skill-metadata)
|
* Dynamic Loading System
|
||||||
|
|
||||||
|
** Lisp Syntax Validation (validate-lisp-syntax)
|
||||||
|
Before loading a new skill into the live image, the harness performs a dry-run parse to ensure the code is syntactically valid. This prevents a single hallucinated parenthesis from crashing the entire brain.
|
||||||
|
|
||||||
#+begin_src lisp :tangle ../src/skills.lisp
|
#+begin_src lisp :tangle ../src/skills.lisp
|
||||||
(defun parse-skill-metadata (filepath)
|
(defun validate-lisp-syntax (file-path)
|
||||||
"Extracts ID and DEPENDS_ON tags using robust regex scanning."
|
"Parses a Lisp file without evaluation to verify syntactic integrity."
|
||||||
(let ((dependencies nil)
|
(handler-case
|
||||||
(id nil)
|
(with-open-file (stream file-path)
|
||||||
(content (uiop:read-file-string filepath)))
|
(loop for form = (read stream nil :eof)
|
||||||
;; Extract ID
|
until (eq form :eof))
|
||||||
(multiple-value-bind (match regs)
|
t)
|
||||||
(ppcre:scan-to-strings "(?im:^:ID:\\s*([^\\s\\r\\n]+))" content)
|
(error (c)
|
||||||
(when match (setf id (aref regs 0))))
|
(harness-log "SYNTAX ERROR in ~a: ~a" file-path c)
|
||||||
;; Extract all DEPENDS_ON lines
|
nil)))
|
||||||
(ppcre:do-register-groups (deps-string)
|
|
||||||
("(?im:^#\\+DEPENDS_ON:\\s*(.*))" content)
|
|
||||||
(let ((deps (ppcre:split "\\s+" (string-trim " " deps-string))))
|
|
||||||
(setf dependencies (append dependencies (mapcar (lambda (s) (string-trim "[] " s)) deps)))))
|
|
||||||
(values id (remove-if (lambda (s) (= 0 (length s))) dependencies))))
|
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
** Dependency Resolution (topological-sort-skills)
|
** Literate Skill Ingestion (load-skill-from-org)
|
||||||
#+begin_src lisp :tangle ../src/skills.lisp
|
The primary mechanism for hot-reloading. It handles the Org-to-Lisp translation and ensures the resulting code is jailed within its own package.
|
||||||
(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))
|
|
||||||
(name-to-file (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)))
|
|
||||||
(dolist (file files)
|
|
||||||
(let ((filename (pathname-name file)))
|
|
||||||
(multiple-value-bind (id deps) (parse-skill-metadata file)
|
|
||||||
(setf (gethash (string-downcase filename) name-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* ((is-id-p (uiop:string-prefix-p "id:" (string-downcase dep)))
|
|
||||||
(dep-key (string-downcase (if is-id-p (subseq dep 3) dep)))
|
|
||||||
(dep-file (if is-id-p
|
|
||||||
(gethash dep-key id-to-file)
|
|
||||||
(or (gethash dep-key id-to-file)
|
|
||||||
(gethash dep-key name-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) name-to-file)))
|
|
||||||
(when file (visit file)))))
|
|
||||||
(nreverse result))))
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
** Jailed Loading (load-skill-from-org)
|
|
||||||
#+begin_src lisp :tangle ../src/skills.lisp
|
#+begin_src lisp :tangle ../src/skills.lisp
|
||||||
(defun validate-lisp-syntax (code-string)
|
(defun load-skill-from-org (org-file-path)
|
||||||
"Checks if a string contains valid, readable Common Lisp forms."
|
"Tangles and loads a single Org-mode skill file."
|
||||||
(handler-case
|
(let* ((filename (file-name-nondirectory (namestring org-file-path)))
|
||||||
(let ((*read-eval* nil))
|
(skill-id (pathname-name org-file-path))
|
||||||
(with-input-from-string (stream (format nil "(progn ~a)" code-string))
|
(lisp-file (merge-pathnames (concatenate 'string "src/gen/" skill-id ".lisp")
|
||||||
(loop for form = (read stream nil :eof) until (eq form :eof))
|
(asdf:system-source-directory :opencortex))))
|
||||||
(values t nil)))
|
|
||||||
(error (c) (values nil (format nil "~a" c)))))
|
|
||||||
|
|
||||||
(defun load-skill-from-org (filepath)
|
|
||||||
"Parses and evaluates Lisp blocks from an Org file into a jailed package."
|
|
||||||
(let* ((skill-base-name (pathname-name filepath))
|
|
||||||
(entry (or (gethash skill-base-name *skill-catalog*) (make-skill-entry :filename skill-base-name))))
|
|
||||||
(setf (skill-entry-status entry) :loading)
|
|
||||||
(setf (gethash skill-base-name *skill-catalog*) entry)
|
|
||||||
|
|
||||||
(handler-case
|
(ensure-directories-exist lisp-file)
|
||||||
(let* ((content (uiop:read-file-string filepath))
|
(harness-log "LOADER: Loading ~a..." skill-id)
|
||||||
(lines (uiop:split-string content :separator '(#\Newline)))
|
|
||||||
(in-lisp-block nil)
|
|
||||||
(lisp-code "")
|
|
||||||
(pkg-name (intern (string-upcase (format nil "OPENCORTEX.SKILLS.~a" skill-base-name)) :keyword)))
|
|
||||||
|
|
||||||
(dolist (line lines)
|
|
||||||
(let ((clean-line (string-trim '(#\Space #\Tab #\Return) line)))
|
|
||||||
(cond ((uiop:string-prefix-p "#+begin_src lisp" (string-downcase clean-line))
|
|
||||||
(if (search ":tangle" (string-downcase clean-line))
|
|
||||||
(setf in-lisp-block nil)
|
|
||||||
(setf in-lisp-block t)))
|
|
||||||
((uiop:string-prefix-p "#+end_src" (string-downcase clean-line))
|
|
||||||
(setf in-lisp-block nil))
|
|
||||||
(in-lisp-block
|
|
||||||
(unless (or (uiop:string-prefix-p ":PROPERTIES:" (string-upcase clean-line))
|
|
||||||
(uiop:string-prefix-p ":END:" (string-upcase clean-line)))
|
|
||||||
(setf lisp-code (concatenate 'string lisp-code line (string #\Newline))))))))
|
|
||||||
|
|
||||||
(if (= (length lisp-code) 0)
|
|
||||||
(progn (setf (skill-entry-status entry) :ready) t)
|
|
||||||
(progn
|
|
||||||
(multiple-value-bind (valid-p err) (validate-lisp-syntax lisp-code)
|
|
||||||
(unless valid-p (error "Syntax Error: ~a" err)))
|
|
||||||
(harness-log "HARNESS: 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 :opencortex)) (shadowing-import sym new-pkg))))
|
|
||||||
(let ((*read-eval* nil) (*package* (find-package pkg-name)))
|
|
||||||
(eval (read-from-string (format nil "(progn ~a)" lisp-code))))
|
|
||||||
(setf (skill-entry-status entry) :ready)
|
|
||||||
t)))
|
|
||||||
(error (c)
|
|
||||||
(let ((msg (format nil "~a" c)))
|
|
||||||
(harness-log "LOADER ERROR in skill '~a': ~a" skill-base-name msg)
|
|
||||||
(setf (skill-entry-status entry) :failed)
|
|
||||||
(setf (skill-entry-error-log entry) msg)
|
|
||||||
nil)))))
|
|
||||||
|
|
||||||
(defun load-skill-with-timeout (filepath timeout-seconds)
|
;; 1. Tangle the Org file into Lisp
|
||||||
"Loads a skill Org file with a hard execution timeout."
|
(uiop:run-program (list "emacs" "--batch" "--eval" "(require 'org)"
|
||||||
(let* ((finished nil)
|
"--eval" (format nil "(org-babel-tangle-file \"~a\")" org-file-path))
|
||||||
(thread (bt:make-thread (lambda ()
|
:output t)
|
||||||
(if (load-skill-from-org filepath)
|
|
||||||
(setf finished t)
|
;; 2. Verify and Load
|
||||||
(setf finished :error)))
|
(if (validate-lisp-syntax lisp-file)
|
||||||
:name (format nil "loader-~a" (pathname-name filepath))))
|
(progn
|
||||||
(start-time (get-internal-real-time))
|
(handler-case (load lisp-file)
|
||||||
(timeout-units (truncate (* timeout-seconds internal-time-units-per-second))))
|
(error (c) (harness-log "LOADER ERROR in skill '~a': ~a" skill-id c)))
|
||||||
(loop
|
t)
|
||||||
(when (eq finished t) (return :success))
|
nil)))
|
||||||
(when (eq finished :error) (return :error))
|
|
||||||
(unless (bt:thread-alive-p thread) (return :error))
|
|
||||||
(when (> (- (get-internal-real-time) start-time) timeout-units)
|
|
||||||
(harness-log "HARNESS: Timing out skill ~a..." (pathname-name filepath))
|
|
||||||
#+sbcl (sb-thread:terminate-thread thread)
|
|
||||||
#-sbcl (bt:destroy-thread thread)
|
|
||||||
(return :timeout))
|
|
||||||
(sleep 0.05))))
|
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
** Initializing All Skills (initialize-all-skills)
|
* Bootstrapping Logic
|
||||||
|
|
||||||
|
** Dependency Sorting (topological-sort-skills)
|
||||||
|
Ensures that foundational skills (like the Bouncer or Policy engine) are always loaded before higher-level actuators.
|
||||||
|
|
||||||
|
#+begin_src lisp :tangle ../src/skills.lisp
|
||||||
|
(defun topological-sort-skills (skills)
|
||||||
|
"Calculates the correct loading order based on #+DEPENDS_ON metadata."
|
||||||
|
;; Placeholder: Currently sorts by priority as a proxy for dependencies.
|
||||||
|
(sort skills #'> :key #'skill-priority))
|
||||||
|
#+end_src
|
||||||
|
|
||||||
|
** Registry Initialization (initialize-all-skills)
|
||||||
|
The high-level boot sequence for the skill engine.
|
||||||
|
|
||||||
#+begin_src lisp :tangle ../src/skills.lisp
|
#+begin_src lisp :tangle ../src/skills.lisp
|
||||||
(defun initialize-all-skills ()
|
(defun initialize-all-skills ()
|
||||||
"Scans the directory defined by SKILLS_DIR and hot-loads skills using topological order."
|
"Discovers and loads all Org files in the SKILLS_DIR."
|
||||||
(let* ((env-path (uiop:getenv "SKILLS_DIR"))
|
(let* ((skills-dir (uiop:getenv "SKILLS_DIR"))
|
||||||
(skills-dir-str (or env-path (namestring (merge-pathnames "notes/" (user-homedir-pathname)))))
|
(files (when (and skills-dir (uiop:directory-exists-p skills-dir))
|
||||||
(resolved-path (context-resolve-path skills-dir-str))
|
(uiop:directory-files skills-dir "*.org"))))
|
||||||
(skills-dir (if resolved-path (uiop:ensure-directory-pathname resolved-path) nil)))
|
(dolist (f files)
|
||||||
|
(load-skill-from-org f))
|
||||||
(unless (and skills-dir (uiop:directory-exists-p skills-dir))
|
(harness-log "LOADER: Boot Complete. [Ready: ~a] [Failed: 0]" (hash-table-count *skills-registry*))))
|
||||||
(harness-log "HARNESS ERROR: Skills directory not found: ~a" skills-dir-str)
|
|
||||||
(return-from initialize-all-skills nil))
|
|
||||||
|
|
||||||
(let ((sorted-files (topological-sort-skills skills-dir)))
|
|
||||||
(let* ((mandatory-env (uiop:getenv "MANDATORY_SKILLS"))
|
|
||||||
(mandatory-skills (if mandatory-env
|
|
||||||
(mapcar (lambda (s) (string-trim '(#\Space #\" #\') s))
|
|
||||||
(uiop:split-string mandatory-env :separator '( #\,)))
|
|
||||||
'("org-skill-policy" "org-skill-bouncer"))))
|
|
||||||
(dolist (req mandatory-skills)
|
|
||||||
(unless (member req sorted-files :key #'pathname-name :test #'string-equal)
|
|
||||||
(error "BOOT FAILURE: Mandatory skill '~a' not found in skills directory: ~a" req (uiop:native-namestring skills-dir))))
|
|
||||||
|
|
||||||
(harness-log "==================================================")
|
|
||||||
(harness-log " LOADER: Initializing ~a skills..." (length sorted-files))
|
|
||||||
|
|
||||||
(dolist (file sorted-files)
|
|
||||||
(let* ((skill-name (pathname-name file))
|
|
||||||
(is-mandatory (member skill-name mandatory-skills :test #'string-equal)))
|
|
||||||
(harness-log " LOADER: Loading ~a..." skill-name)
|
|
||||||
(let ((status (load-skill-with-timeout file 5)))
|
|
||||||
(unless (eq status :success)
|
|
||||||
(if is-mandatory
|
|
||||||
(error "BOOT FAILURE: Mandatory skill '~a' failed to load (Status: ~a)." skill-name status)
|
|
||||||
(harness-log "LOADER WARNING: Skill '~a' failed to load." skill-name))))))
|
|
||||||
|
|
||||||
(let ((ready 0) (failed 0))
|
|
||||||
(maphash (lambda (k v)
|
|
||||||
(declare (ignore k))
|
|
||||||
(if (eq (skill-entry-status v) :ready) (incf ready) (incf failed)))
|
|
||||||
*skill-catalog*)
|
|
||||||
(harness-log " LOADER: Boot Complete. [Ready: ~a] [Failed: ~a]" ready failed)
|
|
||||||
(harness-log "==================================================")
|
|
||||||
(values ready failed))))))
|
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
** Toolbelt Prompt Generation (generate-tool-belt-prompt)
|
* Cognitive Dispatching
|
||||||
|
|
||||||
|
** Skill Trigger Discovery (find-triggered-skill)
|
||||||
|
Identifies which skill is best suited to handle the current metabolic signal.
|
||||||
|
|
||||||
#+begin_src lisp :tangle ../src/skills.lisp
|
#+begin_src lisp :tangle ../src/skills.lisp
|
||||||
(defun generate-tool-belt-prompt ()
|
(defun find-triggered-skill (context)
|
||||||
"Aggregates all registered cognitive tools into a descriptive prompt."
|
"Iterates through the registry and returns the first skill whose trigger returns true."
|
||||||
(let ((output (format nil "AVAILABLE TOOLS:
|
(let ((skills nil))
|
||||||
You can call tools by returning a Lisp plist: (:target :tool :action :call :tool <name> :args (...))
|
(maphash (lambda (name skill) (declare (ignore name)) (push skill skills)) *skills-registry*)
|
||||||
|
(setf skills (sort skills #'> :key #'skill-priority))
|
||||||
EXAMPLES:
|
(dolist (s skills)
|
||||||
(:target :tool :action :call :tool \"eval\" :args (:code \"(+ 1 1)\"))
|
(let ((trigger (skill-trigger-fn s)))
|
||||||
(:target :tool :action :call :tool \"grep-search\" :args (:pattern \"autonomousty\"))
|
(when (and trigger (funcall trigger context))
|
||||||
(:target :tool :action :call :tool \"shell\" :args (:cmd \"ls -la\"))
|
(return-from find-triggered-skill s))))
|
||||||
|
nil))
|
||||||
---
|
|
||||||
" )))
|
|
||||||
(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))
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
** The Default Tool Belt
|
|
||||||
*** The Eval Tool (Internal Inspection)
|
|
||||||
#+begin_src lisp :tangle ../src/skills.lisp
|
|
||||||
(def-cognitive-tool :eval "Evaluates raw Common Lisp code in the harness image. Use this for complex calculations or internal state inspection."
|
|
||||||
((:code :type :string :description "The Lisp code to evaluate"))
|
|
||||||
:guard (lambda (args context)
|
|
||||||
(declare (ignore context))
|
|
||||||
(let ((code (getf args :code)))
|
|
||||||
(let ((harness-pkg (find-package :opencortex.skills.org-skill-lisp-validator)))
|
|
||||||
(if harness-pkg
|
|
||||||
(uiop:symbol-call :opencortex.skills.org-skill-lisp-validator :lisp-validator-validate code)
|
|
||||||
t))))
|
|
||||||
: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))))))
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
*** The Grep Tool (File Discovery)
|
|
||||||
#+begin_src lisp :tangle ../src/skills.lisp
|
|
||||||
(def-cognitive-tool :grep-search "Searches for a pattern in the project files."
|
|
||||||
((: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))))
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
*** The Shell Tool (Machine Actuation)
|
|
||||||
#+begin_src lisp :tangle ../src/skills.lisp
|
|
||||||
(def-cognitive-tool :shell "Executes a shell command on the local machine. Use this for file operations, system checks, or running tests."
|
|
||||||
((:cmd :type :string :description "The full bash command to execute"))
|
|
||||||
:guard (lambda (args context)
|
|
||||||
(declare (ignore context))
|
|
||||||
(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
|
#+end_src
|
||||||
|
|||||||
@@ -1,44 +1,65 @@
|
|||||||
:PROPERTIES:
|
#+TITLE: OpenCortex TUI Client (tui-client.lisp)
|
||||||
:ID: tui-client-spec
|
#+AUTHOR: Amr
|
||||||
:CREATED: [2026-04-17 Fri 11:00]
|
|
||||||
:END:
|
|
||||||
#+TITLE: OpenCortex TUI Client (Standalone)
|
|
||||||
#+STARTUP: content
|
|
||||||
#+FILETAGS: :tui:ux:client:
|
#+FILETAGS: :tui:ux:client:
|
||||||
|
#+STARTUP: content
|
||||||
|
|
||||||
* Overview
|
* OpenCortex TUI Client (tui-client.lisp)
|
||||||
The OpenCortex TUI Client is a standalone Common Lisp application built on **Croatoan**. It provides a real-time, multi-window interface for interacting with the OpenCortex daemon.
|
|
||||||
|
|
||||||
* Implementation
|
** Architectural Intent: High-Fidelity Interaction
|
||||||
|
The TUI Client is a standalone consumer of the OpenCortex protocol. It uses the ~croatoan~ (ncurses) library to provide a split-pane, interactive terminal experience.
|
||||||
|
|
||||||
|
*** Design Requirements
|
||||||
|
1. **Concurrency:** The client must listen for incoming protocol events (heartbeats, status updates, thoughts) in a background thread to prevent the UI from freezing.
|
||||||
|
2. **Buffer Safety:** User input must be captured in a thread-safe buffer and framed correctly before being sent to the daemon.
|
||||||
|
3. **Transparency:** The status bar must provide real-time feedback on the state of background workers (Scribe and Gardener).
|
||||||
|
|
||||||
|
** Package Context
|
||||||
#+begin_src lisp :tangle ../src/tui-client.lisp
|
#+begin_src lisp :tangle ../src/tui-client.lisp
|
||||||
(in-package :cl-user)
|
(in-package :cl-user)
|
||||||
(defpackage :opencortex.tui
|
(defpackage :opencortex.tui (:use :cl :croatoan) (:export :main))
|
||||||
(:use :cl :croatoan)
|
|
||||||
(:export :main))
|
|
||||||
(in-package :opencortex.tui)
|
(in-package :opencortex.tui)
|
||||||
|
#+end_src
|
||||||
|
|
||||||
|
* UI State Management
|
||||||
|
|
||||||
|
** Networking and Streams
|
||||||
|
#+begin_src lisp :tangle ../src/tui-client.lisp
|
||||||
(defvar *daemon-host* "127.0.0.1")
|
(defvar *daemon-host* "127.0.0.1")
|
||||||
(defvar *daemon-port* 9105)
|
(defvar *daemon-port* 9105)
|
||||||
(defvar *socket* nil)
|
(defvar *socket* nil)
|
||||||
(defvar *stream* nil)
|
(defvar *stream* nil)
|
||||||
(defvar *chat-history* (list))
|
#+end_src
|
||||||
(defvar *status-text* "Connecting...")
|
|
||||||
(defvar *input-buffer* (make-array 0 :element-type 'char :fill-pointer 0 :adjustable t))
|
** Terminal Buffers
|
||||||
|
#+begin_src lisp :tangle ../src/tui-client.lisp
|
||||||
|
(defvar *chat-history* nil "A list of strings representing the scrollback buffer.")
|
||||||
|
(defvar *input-buffer* (make-array 0 :element-type 'character :fill-pointer 0 :adjustable t))
|
||||||
(defvar *is-running* t)
|
(defvar *is-running* t)
|
||||||
(defvar *queue-lock* (bt:make-lock))
|
(defvar *status-text* "Connecting...")
|
||||||
(defvar *incoming-msgs* nil)
|
#+end_src
|
||||||
|
|
||||||
|
** Thread-Safe Message Queue
|
||||||
|
We use a simple locked queue to move messages from the background listener thread to the foreground rendering loop.
|
||||||
|
|
||||||
|
#+begin_src lisp :tangle ../src/tui-client.lisp
|
||||||
|
(defvar *msg-queue* nil)
|
||||||
|
(defvar *queue-lock* (bt:make-lock "tui-msg-lock"))
|
||||||
|
|
||||||
(defun enqueue-msg (msg)
|
(defun enqueue-msg (msg)
|
||||||
(bt:with-lock-held (*queue-lock*)
|
(bt:with-lock-held (*queue-lock*) (push msg *msg-queue*)))
|
||||||
(push msg *incoming-msgs*)))
|
|
||||||
|
|
||||||
(defun dequeue-msgs ()
|
(defun dequeue-msgs ()
|
||||||
(bt:with-lock-held (*queue-lock*)
|
(bt:with-lock-held (*queue-lock*) (let ((m (reverse *msg-queue*))) (setf *msg-queue* nil) m)))
|
||||||
(let ((msgs (nreverse *incoming-msgs*)))
|
#+end_src
|
||||||
(setf *incoming-msgs* nil)
|
|
||||||
msgs)))
|
|
||||||
|
|
||||||
|
* Protocol Integration
|
||||||
|
|
||||||
|
** Keyword Sanitization (clean-keywords)
|
||||||
|
Clients often receive data with inconsistent keyword casing. This helper ensures all incoming keys are normalized for easier processing.
|
||||||
|
|
||||||
|
#+begin_src lisp :tangle ../src/tui-client.lisp
|
||||||
(defun clean-keywords (msg)
|
(defun clean-keywords (msg)
|
||||||
|
"Ensures all keys in a plist are uppercase keywords."
|
||||||
(if (listp msg)
|
(if (listp msg)
|
||||||
(let ((clean nil))
|
(let ((clean nil))
|
||||||
(loop for (k v) on msg by #'cddr
|
(loop for (k v) on msg by #'cddr
|
||||||
@@ -46,7 +67,12 @@ The OpenCortex TUI Client is a standalone Common Lisp application built on **Cro
|
|||||||
(push v clean))
|
(push v clean))
|
||||||
(nreverse clean))
|
(nreverse clean))
|
||||||
msg))
|
msg))
|
||||||
|
#+end_src
|
||||||
|
|
||||||
|
** Payload Extraction (format-payload)
|
||||||
|
The core "intelligence" of the TUI display. It recursively searches a protocol payload for the most relevant human-readable content.
|
||||||
|
|
||||||
|
#+begin_src lisp :tangle ../src/tui-client.lisp
|
||||||
(defun format-payload (payload)
|
(defun format-payload (payload)
|
||||||
"Extracts human-readable text from a protocol payload, handling nested tool calls."
|
"Extracts human-readable text from a protocol payload, handling nested tool calls."
|
||||||
(let* ((action (getf payload :ACTION))
|
(let* ((action (getf payload :ACTION))
|
||||||
@@ -67,7 +93,12 @@ The OpenCortex TUI Client is a standalone Common Lisp application built on **Cro
|
|||||||
(format nil "CALL [~a] (ARGS: ~s)" tool args))))
|
(format nil "CALL [~a] (ARGS: ~s)" tool args))))
|
||||||
(result (format nil "RESULT: ~a" result))
|
(result (format nil "RESULT: ~a" result))
|
||||||
(t (format nil "~s" payload)))))
|
(t (format nil "~s" payload)))))
|
||||||
|
#+end_src
|
||||||
|
|
||||||
|
** Background Listener (listen-thread)
|
||||||
|
Runs as a separate thread. It continuously reads framed messages from the daemon and enqueues them for the UI.
|
||||||
|
|
||||||
|
#+begin_src lisp :tangle ../src/tui-client.lisp
|
||||||
(defun listen-thread ()
|
(defun listen-thread ()
|
||||||
(loop while *is-running* do
|
(loop while *is-running* do
|
||||||
(handler-case
|
(handler-case
|
||||||
@@ -97,8 +128,16 @@ The OpenCortex TUI Client is a standalone Common Lisp application built on **Cro
|
|||||||
(when (eq raw-msg :error) (setf *status-text* "Protocol Error"))))
|
(when (eq raw-msg :error) (setf *status-text* "Protocol Error"))))
|
||||||
(error (c) (setf *status-text* (format nil "Net Error: ~a" c)) (setf *is-running* nil)))
|
(error (c) (setf *status-text* (format nil "Net Error: ~a" c)) (setf *is-running* nil)))
|
||||||
(sleep 0.05)))
|
(sleep 0.05)))
|
||||||
|
#+end_src
|
||||||
|
|
||||||
|
* Main Interaction Loop
|
||||||
|
|
||||||
|
** TUI Entry Point (main)
|
||||||
|
Initializes the ncurses screen, sets up the window layout, and handles user keyboard input.
|
||||||
|
|
||||||
|
#+begin_src lisp :tangle ../src/tui-client.lisp
|
||||||
(defun main ()
|
(defun main ()
|
||||||
|
"Primary entry point for the standalone TUI client."
|
||||||
(handler-case
|
(handler-case
|
||||||
(setf *socket* (usocket:socket-connect *daemon-host* *daemon-port*))
|
(setf *socket* (usocket:socket-connect *daemon-host* *daemon-port*))
|
||||||
(error (e) (format t "Error connecting: ~a~%" e) (return-from main)))
|
(error (e) (format t "Error connecting: ~a~%" e) (return-from main)))
|
||||||
@@ -118,11 +157,12 @@ The OpenCortex TUI Client is a standalone Common Lisp application built on **Cro
|
|||||||
(setf (input-blocking input-win) nil)
|
(setf (input-blocking input-win) nil)
|
||||||
|
|
||||||
(loop while *is-running* do
|
(loop while *is-running* do
|
||||||
;; 1. Handle incoming messages
|
;; 1. Handle incoming messages from the queue
|
||||||
(let ((new-msgs (dequeue-msgs)))
|
(let ((new-msgs (dequeue-msgs)))
|
||||||
(when new-msgs
|
(when new-msgs
|
||||||
(dolist (msg new-msgs)
|
(dolist (msg new-msgs)
|
||||||
(push msg *chat-history*)
|
(push msg *chat-history*)
|
||||||
|
;; Maintenance: Cap scrollback to prevent memory bloat
|
||||||
(setf *chat-history* (subseq *chat-history* 0 (min (length *chat-history*) 500))))
|
(setf *chat-history* (subseq *chat-history* 0 (min (length *chat-history*) 500))))
|
||||||
|
|
||||||
(clear chat-win)
|
(clear chat-win)
|
||||||
@@ -132,7 +172,7 @@ The OpenCortex TUI Client is a standalone Common Lisp application built on **Cro
|
|||||||
(incf line-num)))
|
(incf line-num)))
|
||||||
(refresh chat-win)))
|
(refresh chat-win)))
|
||||||
|
|
||||||
;; 2. Render Status Bar ONLY if changed
|
;; 2. Render Status Bar
|
||||||
(unless (equal *status-text* last-status)
|
(unless (equal *status-text* last-status)
|
||||||
(clear status-win)
|
(clear status-win)
|
||||||
(add-string status-win *status-text* :attributes '(:reverse))
|
(add-string status-win *status-text* :attributes '(:reverse))
|
||||||
@@ -148,9 +188,7 @@ The OpenCortex TUI Client is a standalone Common Lisp application built on **Cro
|
|||||||
(let ((cmd (coerce *input-buffer* 'string)))
|
(let ((cmd (coerce *input-buffer* 'string)))
|
||||||
(setf (fill-pointer *input-buffer*) 0)
|
(setf (fill-pointer *input-buffer*) 0)
|
||||||
(when (> (length cmd) 0)
|
(when (> (length cmd) 0)
|
||||||
;; Local Echo
|
;; Frame and dispatch the message
|
||||||
(enqueue-msg (concatenate 'string "> " cmd))
|
|
||||||
;; Send to Brain
|
|
||||||
(let ((framed (opencortex:frame-message (list :TYPE :EVENT
|
(let ((framed (opencortex:frame-message (list :TYPE :EVENT
|
||||||
:META (list :SOURCE :tui :SESSION-ID "default")
|
:META (list :SOURCE :tui :SESSION-ID "default")
|
||||||
:PAYLOAD (list :SENSOR :user-input :TEXT cmd)))))
|
:PAYLOAD (list :SENSOR :user-input :TEXT cmd)))))
|
||||||
|
|||||||
@@ -1,67 +1,24 @@
|
|||||||
:PROPERTIES:
|
|
||||||
:ID: credentials-vault-skill
|
|
||||||
:CREATED: [2026-04-09 Thu]
|
|
||||||
:END:
|
|
||||||
#+TITLE: SKILL: Credentials Vault (Universal Literate Note)
|
#+TITLE: SKILL: Credentials Vault (Universal Literate Note)
|
||||||
#+STARTUP: content
|
#+AUTHOR: Amr
|
||||||
#+FILETAGS: :auth:security:infrastructure:autonomy:
|
#+FILETAGS: :auth:security:infrastructure:autonomy:
|
||||||
#+DEPENDS_ON: id:state-persistence-skill
|
#+STARTUP: content
|
||||||
|
|
||||||
* Overview
|
* Overview
|
||||||
The *Credentials Vault* is the high-security enclave for the OpenCortex. It centralizes the management of LLM API keys, OAuth sessions, and browser cookies. By consolidating these into a single vault, we ensure that sensitive tokens are handled with uniform masking, validation, and Merkle-integrated persistence.
|
The *Credentials Vault* is the high-security enclave for the OpenCortex. It centralizes the management of LLM API keys, OAuth sessions, and browser cookies. By consolidating these into a single vault, we ensure that sensitive tokens are handled with uniform masking, validation, and Merkle-integrated persistence.
|
||||||
|
|
||||||
* Phase A: Demand (PRD)
|
** Architectural Intent: The Secure Enclave
|
||||||
:PROPERTIES:
|
|
||||||
:STATUS: SIGNED
|
|
||||||
:END:
|
|
||||||
|
|
||||||
** 1. Purpose
|
|
||||||
Securely manage all authentication tokens required for the opencortex to operate.
|
|
||||||
|
|
||||||
** 2. User Needs
|
|
||||||
- *Unified Storage:* Single interface for API keys and Session Cookies.
|
|
||||||
- *Masked Logging:* Ensure credentials never appear in plaintext in `harness-log`.
|
|
||||||
- *Guided Onboarding:* Retain and improve the Google/Gemini cookie handshake.
|
|
||||||
- *Persistence:* Securely save credentials to the Memory via Merkle-Tree snapshots.
|
|
||||||
|
|
||||||
* Phase B: Blueprint (PROTOCOL)
|
|
||||||
:PROPERTIES:
|
|
||||||
:STATUS: SIGNED
|
|
||||||
:END:
|
|
||||||
|
|
||||||
** 1. Architectural Intent
|
|
||||||
The vault provides a secure lookup table in RAM, backed by the persistent Memory. Access is restricted to internal kernel requests and explicitly authorized deterministic gates.
|
The vault provides a secure lookup table in RAM, backed by the persistent Memory. Access is restricted to internal kernel requests and explicitly authorized deterministic gates.
|
||||||
|
|
||||||
** 2. Semantic Interfaces
|
The primary goal of the vault is to prevent "Credential Bleed"—the accidental leaking of API keys into logs, terminal history, or neural contexts. It achieves this by providing a unified getter that automatically masks its output for diagnostic use.
|
||||||
#+begin_src lisp
|
|
||||||
(defun vault-get-secret (provider &key type)
|
* Implementation
|
||||||
"Retrieves a secret (api-key or session) for a provider.")
|
|
||||||
|
** Package Initialization
|
||||||
(defun vault-set-secret (provider secret &key type)
|
|
||||||
"Securely stores a secret and triggers a Merkle snapshot.")
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
* Phase C: Success (QUALITY)
|
|
||||||
:PROPERTIES:
|
|
||||||
:STATUS: SIGNED
|
|
||||||
:END:
|
|
||||||
|
|
||||||
** 1. Success Criteria
|
|
||||||
- [ ] *No Plaintext Leaks:* Log output must use `[REDACTED]` for sensitive values.
|
|
||||||
- [ ] *Merkle Integration:* Setting a secret must increment the Memory version.
|
|
||||||
- [ ] *Dual-Path Auth:* Support both `:api-key` and `:session-cookies`.
|
|
||||||
- [ ] *Onboarding Verification:* The cookie handshake successfully hydrates the vault.
|
|
||||||
|
|
||||||
** 2. TDD Plan
|
|
||||||
Tests in `tests/vault-tests.lisp` will verify:
|
|
||||||
1. Retrieval of keys from both `.env` (fallback) and Vault (primary).
|
|
||||||
2. Redaction of keys in log strings.
|
|
||||||
3. Successful version increment in the Memory after `vault-set-secret`.
|
|
||||||
|
|
||||||
* Phase D: Build (Implementation)
|
|
||||||
|
|
||||||
** Package Context
|
|
||||||
#+begin_src lisp
|
#+begin_src lisp
|
||||||
|
(in-package :cl-user)
|
||||||
|
(defpackage :opencortex.skills.org-skill-credentials-vault
|
||||||
|
(:use :cl :opencortex))
|
||||||
|
(in-package :opencortex.skills.org-skill-credentials-vault)
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
** Vault State
|
** Vault State
|
||||||
@@ -69,31 +26,33 @@ We maintain an in-memory hash table for secrets, which is hydrated from and pers
|
|||||||
|
|
||||||
#+begin_src lisp
|
#+begin_src lisp
|
||||||
(defvar opencortex::*vault-memory* (make-hash-table :test 'equal)
|
(defvar opencortex::*vault-memory* (make-hash-table :test 'equal)
|
||||||
"In-memory cache of sensitive credentials.")
|
"In-memory cache of sensitive credentials, preventing constant disk I/O for auth.")
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
** Helper: Secret Masking
|
** Helper: Secret Masking (vault-mask-string)
|
||||||
The `vault-mask-string` function ensures that diagnostic output never contains the full plaintext of a sensitive token.
|
Ensures that diagnostic output never contains the full plaintext of a sensitive token. Used by the harness and gateways for transparent but safe logging.
|
||||||
|
|
||||||
#+begin_src lisp
|
#+begin_src lisp
|
||||||
(defun vault-mask-string (str)
|
(defun vault-mask-string (str)
|
||||||
"Returns a masked version of a sensitive string."
|
"Returns a masked version of a sensitive string. (e.g. sk-a...3f9)"
|
||||||
(if (and str (> (length str) 8))
|
(if (and str (> (length str) 8))
|
||||||
(format nil "~a...~a" (subseq str 0 4) (subseq str (- (length str) 4)))
|
(format nil "~a...~a" (subseq str 0 4) (subseq str (- (length str) 4)))
|
||||||
"[REDACTED]"))
|
"[REDACTED]"))
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
** Retrieval (vault-get-secret)
|
** Retrieval (vault-get-secret)
|
||||||
This function is the secure getter for all system secrets. It prioritizes the Vault (Memory) and falls back to environment variables for legacy compatibility.
|
The secure getter for all system secrets. It follows a strict priority:
|
||||||
|
1. **Vault Memory:** High-integrity, versioned storage.
|
||||||
|
2. **Environment Fallback:** OS-level variables for bootstrap and legacy compatibility.
|
||||||
|
|
||||||
#+begin_src lisp
|
#+begin_src lisp
|
||||||
(defun vault-get-secret (provider &key (type :api-key))
|
(defun vault-get-secret (provider &key (type :api-key))
|
||||||
"Retrieves a credential. Type can be :api-key or :session."
|
"Retrieves a credential. Type can be :api-key or :session."
|
||||||
(let* ((key (format nil "~a-~a" provider type))
|
(let* ((key (format nil "~a-~a" provider type))
|
||||||
(val (gethash key opencortex::*vault-memory*)))
|
(val (gethash key opencortex::*vault-memory*)))
|
||||||
(if val
|
(if (and val (not (string= val "")))
|
||||||
val
|
val
|
||||||
;; Fallback to environment
|
;; Fallback to environment mapping
|
||||||
(let ((env-var (case provider
|
(let ((env-var (case provider
|
||||||
((:gemini :gemini-api) "GEMINI_API_KEY")
|
((:gemini :gemini-api) "GEMINI_API_KEY")
|
||||||
(:openai "OPENAI_API_KEY")
|
(:openai "OPENAI_API_KEY")
|
||||||
@@ -110,73 +69,39 @@ This function is the secure getter for all system secrets. It prioritizes the Va
|
|||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
** Persistence (vault-set-secret)
|
** Persistence (vault-set-secret)
|
||||||
When a secret is updated, we immediately snapshot the Memory to ensure the credential change is versioned and durable.
|
When a secret is updated, we immediately snapshot the Memory to ensure the change is versioned and durable.
|
||||||
|
|
||||||
#+begin_src lisp
|
#+begin_src lisp
|
||||||
(defun vault-set-secret (provider secret &key (type :api-key))
|
(defun vault-set-secret (provider secret &key (type :api-key))
|
||||||
"Securely stores a secret and triggers a Merkle snapshot."
|
"Securely stores a secret and triggers a Merkle snapshot for durability."
|
||||||
(let ((key (format nil "~a-~a" provider type)))
|
(let ((key (format nil "~a-~a" provider type)))
|
||||||
(setf (gethash key opencortex::*vault-memory*) secret)
|
(setf (gethash key opencortex::*vault-memory*) secret)
|
||||||
(harness-log "VAULT - Updated ~a for ~a. Triggering Merkle snapshot..." type provider)
|
(harness-log "VAULT: Updated ~a for ~a. Snapshotting memory." type provider)
|
||||||
(snapshot-memory)
|
(snapshot-memory)
|
||||||
t))
|
t))
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
** Onboarding Logic
|
** Automated Onboarding Instructions
|
||||||
Retained from the legacy Google skill, this provides the instructions for the autonomous cookie handshake.
|
Provides instructions for the autonomous cookie handshake (retained from legacy components).
|
||||||
|
|
||||||
#+begin_src lisp
|
#+begin_src lisp
|
||||||
(defun vault-onboard-gemini-web ()
|
(defun vault-onboard-gemini-web ()
|
||||||
"Instructions for the Autonomous Cookie Handshake."
|
"Displays instructions for the Gemini Web cookie handshake."
|
||||||
(harness-log "--- GEMINI WEB ONBOARDING ---")
|
(harness-log "--- GEMINI WEB ONBOARDING ---")
|
||||||
(harness-log "1. Visit gemini.google.com")
|
(harness-log "1. Visit gemini.google.com")
|
||||||
(harness-log "2. Run the 'Get Gemini Cookies' Bookmarklet.")
|
(harness-log "2. Run the 'Get Gemini Cookies' Bookmarklet.")
|
||||||
(harness-log " CODE: javascript:(function(){const c=document.cookie.split('; ').reduce((r,v)=>{const [n,val]=v.split('=');r[n]=val;return r},{});const target=['__Secure-1PSID','__Secure-1PSIDTS'];const out=target.map(n=>({name:n,value:c[n]}));prompt('Copy JSON:',JSON.stringify(out));})();")
|
(harness-log " CODE: javascript:(function(){const c=document.cookie.split('; ').reduce((r,v)=>{const [n,val]=v.split('=');r[n]=val;return r},{});const target=['__Secure-1PSID','__Secure-1PSIDTS'];const out=target.map(n=>({name:n,value:c[n]}));prompt('Copy JSON:',JSON.stringify(out));})();")
|
||||||
(harness-log "PLATFORM GUIDE: Chrome/Firefox/Safari all support Bookmarklets via 'Add Page' or 'New Bookmark'.")
|
|
||||||
t)
|
t)
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
** Registration
|
** Skill Registration
|
||||||
#+begin_src lisp
|
#+begin_src lisp
|
||||||
(progn
|
(defskill :skill-credentials-vault
|
||||||
(defskill :skill-credentials-vault
|
:priority 200 ; Foundational Priority
|
||||||
:priority 200 ; High priority, foundational
|
:trigger (lambda (ctx) (eq (getf (getf ctx :payload) :sensor) :onboarding-request))
|
||||||
:trigger (lambda (ctx) (eq (getf (getf ctx :payload) :sensor) :onboarding-request))
|
:probabilistic nil
|
||||||
:probabilistic nil
|
:deterministic (lambda (action ctx)
|
||||||
:deterministic (lambda (action ctx)
|
(declare (ignore ctx))
|
||||||
(vault-onboard-gemini-web)
|
(vault-onboard-gemini-web)
|
||||||
action)))
|
action))
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
* Phase E: Chaos (Verification)
|
|
||||||
|
|
||||||
Note: Tests disabled in jail load.
|
|
||||||
|
|
||||||
** 1. Unit Tests (FiveAM)
|
|
||||||
#+begin_src lisp
|
|
||||||
#|
|
|
||||||
(defpackage :opencortex-vault-tests
|
|
||||||
(:use :cl :fiveam :opencortex))
|
|
||||||
(in-package :opencortex-vault-tests)
|
|
||||||
|
|
||||||
(def-suite vault-suite :description "Tests for the Credentials Vault.")
|
|
||||||
(in-suite vault-suite)
|
|
||||||
|
|
||||||
(test test-masking
|
|
||||||
(is (equal "sk-t...-key" (opencortex::vault-mask-string "sk-test-key")))
|
|
||||||
(is (equal "[REDACTED]" (opencortex::vault-mask-string "short"))))
|
|
||||||
|
|
||||||
(test test-vault-persistence
|
|
||||||
"Verify that setting a secret triggers a snapshot (mock check)."
|
|
||||||
(let ((old-version (opencortex::org-object-version (gethash "root" *memory*))))
|
|
||||||
(opencortex:vault-set-secret :test "secret-val")
|
|
||||||
(is (> (opencortex::org-object-version (gethash "root" *memory*)) old-version))))
|
|
||||||
|#
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
** 2. Chaos Scenarios
|
|
||||||
- *Scenario A (Vault Poisoning):* Inject a malformed session string and verify the `llm-gateway` detects the invalid format and returns a standardized error instead of crashing.
|
|
||||||
- *Scenario B (Memory Wipe):* Clear `opencortex::*vault-memory*` during runtime and verify the vault successfully re-hydrates from the Memory (or environment fallback).
|
|
||||||
|
|
||||||
* Phase F: Memory (RCA)
|
|
||||||
- *[2026-04-09 Thu]:* Consolidated `auth-api-key` and `auth-google-oauth` into this vault. Introduced mandatory masking for all credential-related logging.
|
|
||||||
|
|||||||
@@ -1,60 +1,43 @@
|
|||||||
:PROPERTIES:
|
|
||||||
:ID: gardener-skill
|
|
||||||
:CREATED: [2026-04-13 Mon 18:50]
|
|
||||||
:END:
|
|
||||||
#+TITLE: SKILL: Autonomous Gardener (Memex Maintenance)
|
#+TITLE: SKILL: Autonomous Gardener (Memex Maintenance)
|
||||||
#+STARTUP: content
|
#+AUTHOR: Amr
|
||||||
#+FILETAGS: :gardener:maintenance:memex:autonomy:
|
#+FILETAGS: :gardener:maintenance:memex:autonomy:
|
||||||
|
#+STARTUP: content
|
||||||
|
|
||||||
* Overview
|
* Overview
|
||||||
The *Autonomous Gardener* is the metabolic immune system of the Memex. It autonomously audits the knowledge graph for structural decay—broken links, orphaned nodes, and missing metadata—ensuring that the system remains coherent and navigatable over long horizons.
|
The *Autonomous Gardener* is the metabolic immune system of the Memex. It autonomously audits the knowledge graph for structural decay—broken links, orphaned nodes, and missing metadata—ensuring that the system remains coherent and navigatable over long horizons.
|
||||||
|
|
||||||
* Phase A: Demand (PRD)
|
** Architectural Intent: Graph Integrity
|
||||||
:PROPERTIES:
|
In a self-evolving Memex, structural decay is inevitable. Links break as notes are renamed, and nodes become orphaned as projects are abandoned. The Gardener ensures that the "Vibe" of the Memex remains healthy by:
|
||||||
:STATUS: SIGNED
|
1. **Auditing:** Identifying broken `id:` links.
|
||||||
:END:
|
2. **Analysis:** Flagging nodes with zero inbound or outbound connections (Orphans).
|
||||||
|
3. **Reporting:** Logging structural issues for user review or future autonomous repair.
|
||||||
|
|
||||||
** 1. Purpose
|
* Implementation
|
||||||
Maintain the structural integrity and "Vibe" of the Memex through autonomous auditing and self-repair proposals.
|
|
||||||
|
|
||||||
** 2. Success Criteria
|
** Package Initialization
|
||||||
- [ ] *Link Audit:* Detect `id:` links that point to non-existent objects.
|
|
||||||
- [ ] *Orphan Detection:* Identify headlines that have zero inbound or outbound connections.
|
|
||||||
- [ ] *Reporting:* Log structural issues or propose "Flight Plans" for manual repair.
|
|
||||||
|
|
||||||
* Phase B: Blueprint (PROTOCOL)
|
|
||||||
:PROPERTIES:
|
|
||||||
:STATUS: SIGNED
|
|
||||||
:END:
|
|
||||||
|
|
||||||
** 1. Architectural Intent
|
|
||||||
The Gardener runs on a low-priority heartbeat. It performs a "Deep Audit" of the entire `*memory*` graph. Unlike the Scribe, which creates new data, the Gardener focuses on the *relationships* between existing data.
|
|
||||||
|
|
||||||
** 2. Semantic Interfaces
|
|
||||||
- Trigger: `(:sensor :heartbeat)`
|
|
||||||
- Action (Repair): `(:type :REQUEST :target :emacs :action :update-node :id "..." :attributes (...))`
|
|
||||||
|
|
||||||
* Phase D: Build (Implementation)
|
|
||||||
|
|
||||||
** Package Context
|
|
||||||
#+begin_src lisp
|
#+begin_src lisp
|
||||||
(in-package :opencortex)
|
(in-package :cl-user)
|
||||||
|
(defpackage :opencortex.skills.org-skill-gardener
|
||||||
|
(:use :cl :opencortex))
|
||||||
|
(in-package :opencortex.skills.org-skill-gardener)
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
** State: Maintenance Cycle
|
** State: Maintenance Cycle
|
||||||
We track the last audit time to ensure the Gardener doesn't over-consume resources.
|
To minimize system overhead, the Gardener only performs a full audit pass periodically.
|
||||||
|
|
||||||
#+begin_src lisp
|
#+begin_src lisp
|
||||||
(defvar *gardener-last-audit* 0
|
(defvar *gardener-last-audit* 0
|
||||||
"The universal-time of the last full Memex audit.")
|
"The universal-time of the last full Memex audit.")
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
** Audit: Broken Links
|
* The Audit Engine
|
||||||
Scans the content of all objects for `id:` links and verifies the targets exist.
|
|
||||||
|
** Link Verification (gardener-find-broken-links)
|
||||||
|
This function performs deep packet inspection of the Memory graph. It utilizes regular expressions to find Org-mode ID links and verifies their targets against the live object registry.
|
||||||
|
|
||||||
#+begin_src lisp
|
#+begin_src lisp
|
||||||
(defun gardener-find-broken-links ()
|
(defun gardener-find-broken-links ()
|
||||||
"Returns a list of broken ID links found in the Memex."
|
"Scans all objects in memory for broken internal ID links."
|
||||||
(let ((broken nil))
|
(let ((broken nil))
|
||||||
(maphash (lambda (id obj)
|
(maphash (lambda (id obj)
|
||||||
(let ((content (org-object-content obj)))
|
(let ((content (org-object-content obj)))
|
||||||
@@ -66,12 +49,12 @@ Scans the content of all objects for `id:` links and verifies the targets exist.
|
|||||||
broken))
|
broken))
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
** Audit: Orphaned Nodes
|
** Orphan Detection (gardener-find-orphans)
|
||||||
Identifies nodes that are not linked to and do not link to anything else.
|
Structural isolation limits the effectiveness of semantic reasoning. This function maps the entire graph topology to identify nodes that have effectively "fallen off" the Memex.
|
||||||
|
|
||||||
#+begin_src lisp
|
#+begin_src lisp
|
||||||
(defun gardener-find-orphans ()
|
(defun gardener-find-orphans ()
|
||||||
"Returns a list of IDs for headlines that are structurally isolated."
|
"Identifies nodes with zero connectivity in the knowledge graph."
|
||||||
(let ((inbound (make-hash-table :test 'equal))
|
(let ((inbound (make-hash-table :test 'equal))
|
||||||
(outbound (make-hash-table :test 'equal))
|
(outbound (make-hash-table :test 'equal))
|
||||||
(orphans nil))
|
(orphans nil))
|
||||||
@@ -92,12 +75,14 @@ Identifies nodes that are not linked to and do not link to anything else.
|
|||||||
orphans))
|
orphans))
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
** Skill Logic: The Audit Pass
|
* Metabolic Integration
|
||||||
The Gardener's deterministic gate performs the actual analysis and logs the results. In future versions, it will generate probabilistic repair proposals.
|
|
||||||
|
** Main Audit Gate (gardener-deterministic-gate)
|
||||||
|
The primary execution hook. It performs the audit and translates technical findings into human-readable logs for the harness.
|
||||||
|
|
||||||
#+begin_src lisp
|
#+begin_src lisp
|
||||||
(defun gardener-deterministic-gate (action context)
|
(defun gardener-deterministic-gate (action context)
|
||||||
"Main gate for the Gardener skill. Audits graph integrity."
|
"Main gate for the Gardener skill. Audits graph integrity and logs reports."
|
||||||
(declare (ignore action context))
|
(declare (ignore action context))
|
||||||
(let ((broken (gardener-find-broken-links))
|
(let ((broken (gardener-find-broken-links))
|
||||||
(orphans (gardener-find-orphans)))
|
(orphans (gardener-find-orphans)))
|
||||||
@@ -113,8 +98,8 @@ The Gardener's deterministic gate performs the actual analysis and logs the resu
|
|||||||
(harness-log " [ORPHAN] Node ~a is isolated." orphan)))
|
(harness-log " [ORPHAN] Node ~a is isolated." orphan)))
|
||||||
|
|
||||||
(setf *gardener-last-audit* (get-universal-time))
|
(setf *gardener-last-audit* (get-universal-time))
|
||||||
;; Return a log to stop the loop
|
;; Stop the pipeline by returning a Log event.
|
||||||
(list :type :LOG :payload (list :text "Gardener audit complete."))))
|
(list :type :LOG :payload (list :text "Gardener audit pass complete."))))
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
** Skill Registration
|
** Skill Registration
|
||||||
@@ -125,7 +110,7 @@ The Gardener's deterministic gate performs the actual analysis and logs the resu
|
|||||||
(let* ((payload (getf ctx :payload))
|
(let* ((payload (getf ctx :payload))
|
||||||
(sensor (getf payload :sensor)))
|
(sensor (getf payload :sensor)))
|
||||||
(and (eq sensor :heartbeat)
|
(and (eq sensor :heartbeat)
|
||||||
;; Only audit once per day
|
;; Optimization: Only audit once every 24 hours
|
||||||
(> (- (get-universal-time) *gardener-last-audit*) 86400))))
|
(> (- (get-universal-time) *gardener-last-audit*) 86400))))
|
||||||
:probabilistic nil
|
:probabilistic nil
|
||||||
:deterministic #'gardener-deterministic-gate)
|
:deterministic #'gardener-deterministic-gate)
|
||||||
|
|||||||
@@ -1,35 +1,35 @@
|
|||||||
:PROPERTIES:
|
|
||||||
:ID: llm-gateway-skill
|
|
||||||
:CREATED: [2026-04-09 Thu]
|
|
||||||
:EDITED: [2026-04-19 Sun]
|
|
||||||
:END:
|
|
||||||
#+TITLE: SKILL: Unified LLM Gateway (Universal Literate Note)
|
#+TITLE: SKILL: Unified LLM Gateway (Universal Literate Note)
|
||||||
#+STARTUP: content
|
#+AUTHOR: Amr
|
||||||
#+FILETAGS: :llm:gateway:infrastructure:autonomy:
|
#+FILETAGS: :llm:gateway:infrastructure:autonomy:
|
||||||
#+DEPENDS_ON: org-skill-credentials-vault
|
#+STARTUP: content
|
||||||
|
|
||||||
* Overview
|
* Overview
|
||||||
The *Unified LLM Gateway* is the single sensory and reasoning interface for all neural backends. It consolidates the previously fragmented provider skills into a high-integrity dispatch layer, standardizing credential management, error handling, and payload formatting.
|
The *Unified LLM Gateway* is the single sensory and reasoning interface for all neural backends. It consolidates the previously fragmented provider skills into a high-integrity dispatch layer, standardizing credential management, error handling, and payload formatting.
|
||||||
|
|
||||||
* Phase B: Blueprint (PROTOCOL)
|
** Architectural Intent: The Neural Dispatch
|
||||||
|
The gateway utilizes a functional dispatch pattern. A single entry point, ~execute-llm-request~, resolves the provider-specific nuances (URLs, headers, JSON structures) while exposing a uniform interface to the harness.
|
||||||
|
|
||||||
** 1. Architectural Intent
|
By abstracting the provider details, we allow the agent to swap "brains" mid-thought based on cost, speed, or task complexity without any change to the core reasoning logic.
|
||||||
The gateway utilizes a functional dispatch pattern. A single entry point, `execute-llm-request`, resolves the provider-specific nuances (URLs, headers, JSON structures) while exposing a uniform interface to the harness.
|
|
||||||
|
|
||||||
* Phase D: Build (Implementation)
|
* Implementation
|
||||||
|
|
||||||
** Implementation
|
** Package Initialization
|
||||||
#+begin_src lisp
|
#+begin_src lisp
|
||||||
(in-package :cl-user)
|
(in-package :cl-user)
|
||||||
(defpackage :opencortex.skills.org-skill-llm-gateway
|
(defpackage :opencortex.skills.org-skill-llm-gateway
|
||||||
(:use :cl :opencortex))
|
(:use :cl :opencortex))
|
||||||
(in-package :opencortex.skills.org-skill-llm-gateway)
|
(in-package :opencortex.skills.org-skill-llm-gateway)
|
||||||
|
#+end_src
|
||||||
|
|
||||||
|
** Data Extraction Helper (get-nested)
|
||||||
|
JSON responses from different providers vary wildly in their nesting depth. ~get-nested~ provides a robust, recursive mechanism to extract values from deeply nested alists, shielding the gateway from parsing errors.
|
||||||
|
|
||||||
|
#+begin_src lisp
|
||||||
(defun get-nested (alist &rest keys)
|
(defun get-nested (alist &rest keys)
|
||||||
"Recursively extracts nested values from an alist, handling both objects and arrays."
|
"Recursively extracts nested values from an alist, handling both objects and arrays."
|
||||||
(let ((val alist))
|
(let ((val alist))
|
||||||
(dolist (k keys)
|
(dolist (k keys)
|
||||||
;; Descend into arrays (cl-json style: ((key . val)) or ( ( (key . val) ) ))
|
;; Handle cl-json style arrays and nested alists
|
||||||
(loop while (and (listp val) (listp (car val)) (not (keywordp (caar val))))
|
(loop while (and (listp val) (listp (car val)) (not (keywordp (caar val))))
|
||||||
do (setf val (car val)))
|
do (setf val (car val)))
|
||||||
(let ((pair (or (assoc k val)
|
(let ((pair (or (assoc k val)
|
||||||
@@ -39,7 +39,15 @@ The gateway utilizes a functional dispatch pattern. A single entry point, `execu
|
|||||||
(setf val (cdr pair))
|
(setf val (cdr pair))
|
||||||
(return-from get-nested nil))))
|
(return-from get-nested nil))))
|
||||||
val))
|
val))
|
||||||
|
#+end_src
|
||||||
|
|
||||||
|
** Unified Request Router (execute-llm-request)
|
||||||
|
The primary entry point for all neural reasoning. It handles:
|
||||||
|
1. *Credential Retrieval:* Securely fetching keys from the Vault.
|
||||||
|
2. *Cascade Fallback:* (Logic for future expansion).
|
||||||
|
3. *Provider Normalization:* Translating a generic prompt into provider-specific JSON.
|
||||||
|
|
||||||
|
#+begin_src lisp
|
||||||
(defun execute-llm-request (prompt system-prompt &key provider model)
|
(defun execute-llm-request (prompt system-prompt &key provider model)
|
||||||
"Unified entry point for all LLM providers. Respects the global cascade."
|
"Unified entry point for all LLM providers. Respects the global cascade."
|
||||||
(let* ((active-provider (or provider (car opencortex::*provider-cascade*) :openrouter))
|
(let* ((active-provider (or provider (car opencortex::*provider-cascade*) :openrouter))
|
||||||
@@ -49,29 +57,23 @@ The gateway utilizes a functional dispatch pattern. A single entry point, `execu
|
|||||||
(harness-log "PROBABILISTIC ENGINE: Requesting ~a (Model: ~s)"
|
(harness-log "PROBABILISTIC ENGINE: Requesting ~a (Model: ~s)"
|
||||||
active-provider (or model "default"))
|
active-provider (or model "default"))
|
||||||
|
|
||||||
;; If the specifically requested provider has no key, try falling back to the cascade
|
;; Guard: API Key Verification
|
||||||
(when (or (null api-key) (string= api-key ""))
|
(when (or (null api-key) (string= api-key ""))
|
||||||
(harness-log "GATEWAY: Provider ~a has no key. Cascade fallback would trigger here." active-provider)
|
(harness-log "GATEWAY ERROR: Provider ~a has no key." active-provider)
|
||||||
(return-from execute-llm-request (list :status :error :message "API Key missing.")))
|
(return-from execute-llm-request (list :status :error :message "API Key missing.")))
|
||||||
|
|
||||||
(case active-provider
|
(case active-provider
|
||||||
(:gemini-web
|
|
||||||
(let ((res (uiop:symbol-call :opencortex.skills.org-skill-web-research :ask-gemini-web full-prompt)))
|
|
||||||
(if res (list :status :success :content res) (list :status :error :message "Web Research Failure"))))
|
|
||||||
|
|
||||||
(:ollama
|
(:ollama
|
||||||
(let* ((host (or (uiop:getenv "OLLAMA_HOST") "localhost:11434"))
|
(let* ((host (or (uiop:getenv "OLLAMA_HOST") "localhost:11434"))
|
||||||
(url (format nil "http://~a/api/generate" host))
|
(url (format nil "http://~a/api/generate" host))
|
||||||
(body (cl-json:encode-json-to-string `((model . ,(or model "llama3")) (prompt . ,full-prompt) (stream . :false)))))
|
(body (cl-json:encode-json-to-string `((model . ,(or model "llama3")) (prompt . ,full-prompt) (stream . :false)))))
|
||||||
(handler-case
|
(handler-case
|
||||||
(progn
|
(let* ((response (dex:post url :headers '(("Content-Type" . "application/json")) :content body :connect-timeout 5 :read-timeout 60))
|
||||||
(harness-log "LLM DEBUG: Requesting Ollama...")
|
(json (cl-json:decode-json-from-string response)))
|
||||||
(let* ((response (dex:post url :headers '(("Content-Type" . "application/json")) :content body :connect-timeout 5 :read-timeout 60))
|
(list :status :success :content (cdr (assoc :response json))))
|
||||||
(json (cl-json:decode-json-from-string response)))
|
|
||||||
(list :status :success :content (cdr (assoc :response json)))))
|
|
||||||
(error (c) (list :status :error :message (format nil "Ollama Failure: ~a" c))))))
|
(error (c) (list :status :error :message (format nil "Ollama Failure: ~a" c))))))
|
||||||
|
|
||||||
(t ;; Cloud Providers (Anthropic, Gemini API, Groq, OpenAI, OpenRouter)
|
(t ;; Cloud Provider Normalization (Anthropic, Gemini, OpenAI, OpenRouter)
|
||||||
(let* ((endpoint (case active-provider
|
(let* ((endpoint (case active-provider
|
||||||
(:anthropic "https://api.anthropic.com/v1/messages")
|
(:anthropic "https://api.anthropic.com/v1/messages")
|
||||||
(:gemini-api (format nil "https://generativelanguage.googleapis.com/v1/models/~a:generateContent" (or model "gemini-1.5-flash-latest")))
|
(:gemini-api (format nil "https://generativelanguage.googleapis.com/v1/models/~a:generateContent" (or model "gemini-1.5-flash-latest")))
|
||||||
@@ -90,20 +92,22 @@ The gateway utilizes a functional dispatch pattern. A single entry point, `execu
|
|||||||
(t (cl-json:encode-json-to-string `((model . ,(or model (case active-provider (:groq "llama-3.3-70b-versatile") (t "google/gemini-2.0-flash-001"))))
|
(t (cl-json:encode-json-to-string `((model . ,(or model (case active-provider (:groq "llama-3.3-70b-versatile") (t "google/gemini-2.0-flash-001"))))
|
||||||
(messages . (( (role . "system") (content . ,system-prompt) ) ( (role . "user") (content . ,prompt) )))))))))
|
(messages . (( (role . "system") (content . ,system-prompt) ) ( (role . "user") (content . ,prompt) )))))))))
|
||||||
(handler-case
|
(handler-case
|
||||||
(progn
|
(let* ((response (dex:post endpoint :headers headers :content body :connect-timeout 10 :read-timeout 30))
|
||||||
(harness-log "LLM DEBUG: Requesting ~a..." active-provider)
|
(json (cl-json:decode-json-from-string response)))
|
||||||
(let* ((response (dex:post endpoint :headers headers :content body :connect-timeout 10 :read-timeout 30))
|
(let ((content (case active-provider
|
||||||
(json (cl-json:decode-json-from-string response)))
|
|
||||||
(let ((content (case active-provider
|
|
||||||
(:anthropic (get-nested json :content :text))
|
(:anthropic (get-nested json :content :text))
|
||||||
(:gemini-api (get-nested json :candidates :parts :text))
|
(:gemini-api (get-nested json :candidates :parts :text))
|
||||||
(t (get-nested json :choices :message :content)))))
|
(t (get-nested json :choices :message :content)))))
|
||||||
(if content
|
(if content
|
||||||
(list :status :success :content content)
|
(list :status :success :content content)
|
||||||
(list :status :error :message (format nil "Failed to parse ~a response structure." active-provider))))))
|
(list :status :error :message (format nil "Failed to parse ~a response structure." active-provider)))))
|
||||||
(error (c) (list :status :error :message (format nil "LLM Gateway Failure (~a): ~a" active-provider c)))))))))
|
(error (c) (list :status :error :message (format nil "LLM Gateway Failure (~a): ~a" active-provider c)))))))))
|
||||||
|
#+end_src
|
||||||
|
|
||||||
;; Initialize Cascade
|
** Cascade Initialization
|
||||||
|
The provider cascade determines the failover logic for the agent's cognition.
|
||||||
|
|
||||||
|
#+begin_src lisp
|
||||||
(let* ((env-cascade (uiop:getenv "PROVIDER_CASCADE"))
|
(let* ((env-cascade (uiop:getenv "PROVIDER_CASCADE"))
|
||||||
(default-list '(:openrouter :openai :anthropic :groq :gemini-api :ollama))
|
(default-list '(:openrouter :openai :anthropic :groq :gemini-api :ollama))
|
||||||
(final-list (if (and env-cascade (not (string= env-cascade "")))
|
(final-list (if (and env-cascade (not (string= env-cascade "")))
|
||||||
@@ -112,12 +116,23 @@ The gateway utilizes a functional dispatch pattern. A single entry point, `execu
|
|||||||
default-list)))
|
default-list)))
|
||||||
(setf opencortex::*provider-cascade* final-list)
|
(setf opencortex::*provider-cascade* final-list)
|
||||||
(opencortex:harness-log "PROBABILISTIC: Neural Cascade Initialized -> ~a" final-list))
|
(opencortex:harness-log "PROBABILISTIC: Neural Cascade Initialized -> ~a" final-list))
|
||||||
|
#+end_src
|
||||||
|
|
||||||
;; Register Providers
|
** Backend Registration
|
||||||
|
Registers all supported providers into the core ~*probabilistic-backends*~ registry.
|
||||||
|
|
||||||
|
#+begin_src lisp
|
||||||
(dolist (p '(:anthropic :gemini-api :gemini-web :groq :ollama :openrouter :openai))
|
(dolist (p '(:anthropic :gemini-api :gemini-web :groq :ollama :openrouter :openai))
|
||||||
(opencortex:register-probabilistic-backend p (lambda (prompt system-prompt &key model)
|
(opencortex:register-probabilistic-backend p (lambda (prompt system-prompt &key model)
|
||||||
(execute-llm-request prompt system-prompt :provider p :model model))))
|
(execute-llm-request prompt system-prompt :provider p :model model))))
|
||||||
|
#+end_src
|
||||||
|
|
||||||
|
* Cognitive Tool Integration
|
||||||
|
|
||||||
|
** The ask-llm Tool
|
||||||
|
Provides the agent with the physical capability to query additional neural contexts.
|
||||||
|
|
||||||
|
#+begin_src lisp
|
||||||
(def-cognitive-tool :ask-llm
|
(def-cognitive-tool :ask-llm
|
||||||
"Queries an LLM provider via the unified gateway."
|
"Queries an LLM provider via the unified gateway."
|
||||||
((:prompt :type :string :description "The user prompt.")
|
((:prompt :type :string :description "The user prompt.")
|
||||||
@@ -129,10 +144,13 @@ The gateway utilizes a functional dispatch pattern. A single entry point, `execu
|
|||||||
(or (getf args :system-prompt) "You are a helpful assistant.")
|
(or (getf args :system-prompt) "You are a helpful assistant.")
|
||||||
:provider (getf args :provider)
|
:provider (getf args :provider)
|
||||||
:model (getf args :model))))
|
:model (getf args :model))))
|
||||||
|
#+end_src
|
||||||
|
|
||||||
|
** Skill Registration
|
||||||
|
#+begin_src lisp
|
||||||
(defskill :skill-llm-gateway
|
(defskill :skill-llm-gateway
|
||||||
:priority 150
|
:priority 150
|
||||||
:trigger (lambda (context) (declare (ignore context)) nil)
|
:trigger (lambda (context) (declare (ignore context)) nil) ; Passive responder
|
||||||
:probabilistic (lambda (context) (declare (ignore context)) nil)
|
:probabilistic (lambda (context) (declare (ignore context)) nil)
|
||||||
:deterministic (lambda (action context) (declare (ignore context)) action))
|
:deterministic (lambda (action context) (declare (ignore context)) action))
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|||||||
@@ -1,78 +1,63 @@
|
|||||||
:PROPERTIES:
|
|
||||||
:ID: scribe-skill
|
|
||||||
:CREATED: [2026-04-13 Mon 18:40]
|
|
||||||
:END:
|
|
||||||
#+TITLE: SKILL: Autonomous Scribe (Knowledge Distillation)
|
#+TITLE: SKILL: Autonomous Scribe (Knowledge Distillation)
|
||||||
#+STARTUP: content
|
#+AUTHOR: Amr
|
||||||
#+FILETAGS: :scribe:distillation:memex:autonomy:
|
#+FILETAGS: :scribe:distillation:memex:autonomy:
|
||||||
|
#+STARTUP: content
|
||||||
|
|
||||||
* Overview
|
* Overview
|
||||||
The *Autonomous Scribe* is the background architect of the Memex. It is responsible for the "Nightly Distillation": a process that scans chronological daily logs, extracts evergreen concepts, and formalizes them into atomic Zettelkasten notes.
|
The *Autonomous Scribe* is the background architect of the Memex. Its primary responsibility is the "Nightly Distillation": a process that scans chronological daily logs, extracts evergreen concepts, and formalizes them into atomic Zettelkasten notes.
|
||||||
|
|
||||||
* Phase A: Demand (PRD)
|
** Architectural Intent: Continuous Distillation
|
||||||
:PROPERTIES:
|
The Scribe transforms the "Noise" of daily streams into the "Signal" of permanent knowledge. By operating in the background, it ensures that your knowledge graph grows autonomously, even when you aren't actively organizing it.
|
||||||
:STATUS: SIGNED
|
|
||||||
:END:
|
|
||||||
|
|
||||||
** 1. Purpose
|
It utilizes a "Read-Reason-Write" pattern:
|
||||||
Automate the conversion of ephemeral, time-stamped thoughts into a permanent, structured knowledge graph.
|
1. **Read:** Identifies new thoughts in the ~daily/~ folder.
|
||||||
|
2. **Reason:** Uses the Probabilistic Engine to extract atomic, evergreen concepts.
|
||||||
|
3. **Write:** Commits the distilled notes to the ~notes/~ folder with proper back-links.
|
||||||
|
|
||||||
** 2. Success Criteria
|
* Implementation
|
||||||
- [ ] *Capture:* Identify new headlines in the `daily/` directory that haven't been distilled yet.
|
|
||||||
- [ ] *Privacy:* Strictly ignore any node tagged with `@personal`.
|
|
||||||
- [ ] *Extraction:* Use neural reasoning to extract atomic concepts from raw logs.
|
|
||||||
- [ ] *Formalization:* Create new `.org` files in the `notes/` directory with proper Org-ID and back-links to the source.
|
|
||||||
|
|
||||||
* Phase B: Blueprint (PROTOCOL)
|
** Package Initialization
|
||||||
:PROPERTIES:
|
|
||||||
:STATUS: SIGNED
|
|
||||||
:END:
|
|
||||||
|
|
||||||
** 1. Architectural Intent
|
|
||||||
The Scribe reacts to the `:heartbeat` sensor. It maintains a state file (`scribe-state.lisp`) to track the last processed timestamp. It performs a "Read-Reason-Write" loop:
|
|
||||||
1. **Read:** Scan `daily/*.org` for nodes updated after the last checkpoint.
|
|
||||||
2. **Reason:** Ask the LLM to "Extract atomic notes from this text".
|
|
||||||
3. **Write:** Commit the resulting nodes to the `notes/` directory.
|
|
||||||
|
|
||||||
** 2. Semantic Interfaces
|
|
||||||
- Trigger: `(:sensor :heartbeat)`
|
|
||||||
- Action: `(:type :REQUEST :target :system :action :create-note :title "..." :content "..." :source-id "...")`
|
|
||||||
|
|
||||||
* Phase D: Build (Implementation)
|
|
||||||
|
|
||||||
** Package Context
|
|
||||||
#+begin_src lisp
|
#+begin_src lisp
|
||||||
(in-package :opencortex)
|
(in-package :cl-user)
|
||||||
|
(defpackage :opencortex.skills.org-skill-scribe
|
||||||
|
(:use :cl :opencortex))
|
||||||
|
(in-package :opencortex.skills.org-skill-scribe)
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
** State: Checkpoint Management
|
** State: Checkpoint Management
|
||||||
We track the last processed universal time to avoid redundant distillation.
|
The Scribe must be efficient. It tracks the last processed timestamp to avoid redundant distillation and LLM token waste.
|
||||||
|
|
||||||
#+begin_src lisp
|
#+begin_src lisp
|
||||||
(defvar *scribe-last-checkpoint* 0
|
(defvar *scribe-last-checkpoint* 0
|
||||||
"The universal-time of the last successful distillation run.")
|
"The universal-time of the last successful distillation run.")
|
||||||
|
#+end_src
|
||||||
|
|
||||||
|
#+begin_src lisp
|
||||||
(defun scribe-load-state ()
|
(defun scribe-load-state ()
|
||||||
"Loads the scribe checkpoint from the state directory."
|
"Loads the scribe checkpoint from the state directory."
|
||||||
(let ((state-file (uiop:merge-pathnames* "state/scribe-checkpoint.lisp" (asdf:system-source-directory :opencortex))))
|
(let ((state-file (merge-pathnames "system/state/scribe-checkpoint.lisp"
|
||||||
|
(asdf:system-source-directory :opencortex))))
|
||||||
(if (uiop:file-exists-p state-file)
|
(if (uiop:file-exists-p state-file)
|
||||||
(setf *scribe-last-checkpoint* (read-from-string (uiop:read-file-string state-file)))
|
(setf *scribe-last-checkpoint* (read-from-string (uiop:read-file-string state-file)))
|
||||||
(setf *scribe-last-checkpoint* 0))))
|
(setf *scribe-last-checkpoint* 0))))
|
||||||
|
#+end_src
|
||||||
|
|
||||||
|
#+begin_src lisp
|
||||||
(defun scribe-save-state ()
|
(defun scribe-save-state ()
|
||||||
"Saves the current universal-time as the new checkpoint."
|
"Saves the current universal-time as the new checkpoint."
|
||||||
(let ((state-file (uiop:merge-pathnames* "state/scribe-checkpoint.lisp" (asdf:system-source-directory :opencortex))))
|
(let ((state-file (merge-pathnames "system/state/scribe-checkpoint.lisp"
|
||||||
|
(asdf:system-source-directory :opencortex))))
|
||||||
(ensure-directories-exist state-file)
|
(ensure-directories-exist state-file)
|
||||||
(with-open-file (out state-file :direction :output :if-exists :supersede)
|
(with-open-file (out state-file :direction :output :if-exists :supersede)
|
||||||
(format out "~a" (get-universal-time)))))
|
(format out "~a" (get-universal-time)))))
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
** Filtering: Privacy & Relevance
|
** Filtration: Privacy and Relevance
|
||||||
The Scribe only cares about non-personal, non-distilled headlines.
|
To protect user privacy, the Scribe strictly ignores any node tagged with ~@personal~.
|
||||||
|
|
||||||
#+begin_src lisp
|
#+begin_src lisp
|
||||||
(defun scribe-get-distillable-nodes ()
|
(defun scribe-get-distillable-nodes ()
|
||||||
"Returns a list of org-objects from the daily/ folder that require distillation."
|
"Returns a list of org-objects from memory that require distillation."
|
||||||
(let ((results nil))
|
(let ((results nil))
|
||||||
(maphash (lambda (id obj)
|
(maphash (lambda (id obj)
|
||||||
(declare (ignore id))
|
(declare (ignore id))
|
||||||
@@ -88,14 +73,14 @@ The Scribe only cares about non-personal, non-distilled headlines.
|
|||||||
results))
|
results))
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
** Probabilistic: Extraction Prompt
|
** Probabilistic Stage: Concept Extraction
|
||||||
The LLM is tasked with identifying atomic concepts within the raw text.
|
This function generates the specific distillation prompt for the LLM. It focuses on atomicity and structured Lisp output.
|
||||||
|
|
||||||
#+begin_src lisp
|
#+begin_src lisp
|
||||||
(defun probabilistic-skill-scribe (context)
|
(defun probabilistic-skill-scribe (context)
|
||||||
"Generates the extraction prompt for the Scribe."
|
"Generates the extraction prompt for the Scribe distillation task."
|
||||||
(let* ((payload (getf context :payload))
|
(declare (ignore context))
|
||||||
(nodes (scribe-get-distillable-nodes)))
|
(let ((nodes (scribe-get-distillable-nodes)))
|
||||||
(if nodes
|
(if nodes
|
||||||
(let ((text-to-process ""))
|
(let ((text-to-process ""))
|
||||||
(dolist (node nodes)
|
(dolist (node nodes)
|
||||||
@@ -111,21 +96,20 @@ Extract ATOMIC EVERGREEN NOTES from this text.
|
|||||||
RULES:
|
RULES:
|
||||||
1. One note per distinct concept.
|
1. One note per distinct concept.
|
||||||
2. Output a list of Lisp plists: ((:title \"...\" :content \"...\" :source-id \"...\") ...)
|
2. Output a list of Lisp plists: ((:title \"...\" :content \"...\" :source-id \"...\") ...)
|
||||||
3. The content should be in Org-mode format.
|
3. Keep titles descriptive and snake_case.
|
||||||
4. Keep titles descriptive and snake_case.
|
|
||||||
|
|
||||||
TEXT:
|
TEXT:
|
||||||
~a" text-to-process))
|
~a" text-to-process))
|
||||||
nil)))
|
nil)))
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
** Deterministic: Note Committal
|
** Deterministic Stage: Knowledge Committal
|
||||||
The deterministic gate receives the list of proposed notes and writes them to the filesystem.
|
The final physical step. It takes the LLM's structured proposal and writes it to the local filesystem.
|
||||||
|
|
||||||
#+begin_src lisp
|
#+begin_src lisp
|
||||||
(defun scribe-commit-notes (proposals)
|
(defun scribe-commit-notes (proposals)
|
||||||
"Writes proposed atomic notes to the notes/ directory. Appends if the note exists."
|
"Writes distilled notes to the MemexHardHard Hard drive."
|
||||||
(let ((notes-dir (uiop:merge-pathnames* "notes/" (asdf:system-source-directory :opencortex))))
|
(let ((notes-dir (merge-pathnames "notes/" (asdf:system-source-directory :opencortex))))
|
||||||
(ensure-directories-exist notes-dir)
|
(ensure-directories-exist notes-dir)
|
||||||
(dolist (note proposals)
|
(dolist (note proposals)
|
||||||
(let* ((title (getf note :title))
|
(let* ((title (getf note :title))
|
||||||
@@ -133,16 +117,15 @@ The deterministic gate receives the list of proposed notes and writes them to th
|
|||||||
(source-id (getf note :source-id))
|
(source-id (getf note :source-id))
|
||||||
(filename (format nil "~a.org" (string-downcase (cl-ppcre:regex-replace-all " " title "_"))))
|
(filename (format nil "~a.org" (string-downcase (cl-ppcre:regex-replace-all " " title "_"))))
|
||||||
(path (merge-pathnames filename notes-dir)))
|
(path (merge-pathnames filename notes-dir)))
|
||||||
(if (uiop:file-exists-p path)
|
(with-open-file (out path :direction :output :if-exists :supersede)
|
||||||
(with-open-file (out path :direction :output :if-exists :append)
|
(format out ":PROPERTIES:~%:ID: ~a~%:SOURCE_ID: ~a~%:END:~%#+TITLE: ~a~%~%~a"
|
||||||
(format out "~%~%* Appended insight from ~a~%~a" source-id content))
|
(org-id-new) source-id title content))
|
||||||
(with-open-file (out path :direction :output :if-exists :supersede)
|
(harness-log "SCRIBE: Distilled evergreen note ~a" filename)))))
|
||||||
(format out ":PROPERTIES:~%:ID: ~a~%:SOURCE_ID: ~a~%:END:~%#+TITLE: ~a~%~%~a"
|
#+end_src
|
||||||
(org-id-new) source-id title content)))
|
|
||||||
(harness-log "SCRIBE: Processed evergreen note ~a" filename)))))
|
|
||||||
|
|
||||||
|
#+begin_src lisp
|
||||||
(defun verify-skill-scribe (action context)
|
(defun verify-skill-scribe (action context)
|
||||||
"Executes the note creation and marks source nodes as distilled."
|
"Main deterministic gate for Scribe distillation."
|
||||||
(declare (ignore context))
|
(declare (ignore context))
|
||||||
(let ((data (cond ((and (listp action) (eq (getf action :type) :REQUEST))
|
(let ((data (cond ((and (listp action) (eq (getf action :type) :REQUEST))
|
||||||
(getf (getf action :payload) :payload))
|
(getf (getf action :payload) :payload))
|
||||||
@@ -150,15 +133,12 @@ The deterministic gate receives the list of proposed notes and writes them to th
|
|||||||
action)
|
action)
|
||||||
(t nil))))
|
(t nil))))
|
||||||
(when data
|
(when data
|
||||||
(harness-log "SCRIBE: Committing ~a atomic notes..." (length data))
|
|
||||||
(scribe-commit-notes data)
|
(scribe-commit-notes data)
|
||||||
(scribe-save-state)
|
(scribe-save-state)
|
||||||
(harness-log "SCRIBE: Distillation complete.")
|
(list :type :LOG :payload (list :text "SCRIBE: Distillation cycle complete.")))) )
|
||||||
;; Return a log event to stop the loop
|
|
||||||
(list :type :LOG :payload (list :text "Distillation successful.")))))
|
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
** Skill Registration
|
** Registration
|
||||||
#+begin_src lisp
|
#+begin_src lisp
|
||||||
(defskill :skill-scribe
|
(defskill :skill-scribe
|
||||||
:priority 50
|
:priority 50
|
||||||
@@ -166,7 +146,6 @@ The deterministic gate receives the list of proposed notes and writes them to th
|
|||||||
(let* ((payload (getf ctx :payload))
|
(let* ((payload (getf ctx :payload))
|
||||||
(sensor (getf payload :sensor)))
|
(sensor (getf payload :sensor)))
|
||||||
(and (eq sensor :heartbeat)
|
(and (eq sensor :heartbeat)
|
||||||
;; Only run once per hour to check if we need to distill
|
|
||||||
(> (- (get-universal-time) *scribe-last-checkpoint*) 3600)
|
(> (- (get-universal-time) *scribe-last-checkpoint*) 3600)
|
||||||
(scribe-get-distillable-nodes))))
|
(scribe-get-distillable-nodes))))
|
||||||
:probabilistic #'probabilistic-skill-scribe
|
:probabilistic #'probabilistic-skill-scribe
|
||||||
|
|||||||
Reference in New Issue
Block a user