REORG: Apply semantic directory structure and documentation cleanup
Some checks failed
Deploy-Agent-V15-Stdin / JOB-V15-STDIN (push) Failing after 2s

This commit is contained in:
2026-04-21 19:07:32 -04:00
parent 2889c65d28
commit 60f2c152e0
33 changed files with 1 additions and 513 deletions

182
harness/act.org Normal file
View File

@@ -0,0 +1,182 @@
#+TITLE: Stage 3: Act (act.lisp)
#+AUTHOR: Amr
#+FILETAGS: :harness:act:
#+STARTUP: content
* Stage 3: Act (act.lisp)
** 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.
** Actuator Configuration
The core harness can be configured via environment variables to operate silently or target different default outputs.
#+begin_src lisp :tangle ../src/act.lisp
(in-package :opencortex)
(defvar *default-actuator* :cli)
(defvar *silent-actuators* '(:cli :system-message :emacs))
(defun initialize-actuators ()
"Loads actuator routing defaults from environment variables and registers core harness actuators."
(let ((def (uiop:getenv "DEFAULT_ACTUATOR"))
(silent (uiop:getenv "SILENT_ACTUATORS")))
(when def
(setf *default-actuator* (intern (string-upcase def) "KEYWORD")))
(when silent
(setf *silent-actuators*
(mapcar (lambda (s) (intern (string-upcase (string-trim '(#\Space) s)) "KEYWORD"))
(str:split "," silent)))))
;; Register core harness actuators
(register-actuator :system #'execute-system-action)
(register-actuator :tool #'execute-tool-action)
(register-actuator :tui (lambda (action context)
(let* ((meta (getf context :meta))
(stream (getf meta :reply-stream)))
(when (and stream (open-stream-p stream))
(format stream "~a" (frame-message action))
(finish-output stream))))))
#+end_src
** Dispatching Actions
The `dispatch-action` function is the primary router. It identifies the target actuator and executes the requested side-effects.
#+begin_src lisp :tangle ../src/act.lisp
(defun dispatch-action (action context)
(let ((payload (proto-get action :payload)))
(when (eq (proto-get payload :sensor) :heartbeat)
(return-from dispatch-action nil)))
"Routes an approved action to its registered physical actuator."
(when (and action (listp action))
(let* ((meta (proto-get context :meta))
(source (proto-get meta :source))
(raw-target (or (ignore-errors (getf action :TARGET))
(ignore-errors (getf action :target))
source
*default-actuator*))
(target (intern (string-upcase (string raw-target)) :keyword))
(actuator-fn (gethash target *actuator-registry*)))
;; Ensure outbound action has meta if context had it
(when (and meta (null (getf action :meta)))
(setf (getf action :meta) meta))
(if actuator-fn
(funcall actuator-fn action context)
(harness-log "ACT ERROR: No actuator for ~s (from ~s)" target raw-target)))))
#+end_src
** Internal System Actions
The `:system` actuator handles internal harness commands like code evaluation and dynamic skill loading.
#+begin_src lisp :tangle ../src/act.lisp
(defun execute-system-action (action context)
"Processes internal harness commands. (ACTUATOR)"
(declare (ignore context))
(let* ((payload (ignore-errors (getf action :payload)))
(cmd (ignore-errors (getf payload :action))))
(case cmd
(:eval (let ((code (getf payload :code)))
(eval (read-from-string code))))
(:create-skill (let* ((filename (getf payload :filename)) (content (getf payload :content))
(skills-dir (merge-pathnames "skills/" (asdf:system-source-directory :opencortex)))
(full-path (merge-pathnames filename skills-dir)))
(with-open-file (out full-path :direction :output :if-exists :supersede) (write-string content out))
(load-skill-from-org full-path)))
(:message (harness-log "ACT [System]: ~a" (getf payload :text)))
(t (harness-log "ACT ERROR [System]: Unknown command ~s" cmd)))))
#+end_src
** Cognitive Tool Actuation
The `:tool` actuator handles the execution of registered cognitive tools.
#+begin_src lisp :tangle ../src/act.lisp
(defun format-tool-result (tool-name result)
"Intelligently formats a tool result for user display."
(if (listp result)
(let ((status (getf result :status))
(content (getf result :content))
(msg (getf result :message)))
(cond ((and (eq status :success) content) (format nil "~a" content))
((and (eq status :error) msg) (format nil "ERROR [~a]: ~a" tool-name msg))
(t (format nil "TOOL [~a] RESULT: ~s" tool-name result))))
(format nil "TOOL [~a] RESULT: ~a" tool-name result)))
(defun execute-tool-action (action context)
"Executes a registered cognitive tool. (ACTUATOR)"
(let* ((payload (getf action :payload))
(tool-name (getf payload :tool))
(tool-args (getf payload :args))
(depth (getf context :depth 0))
(meta (getf context :meta))
(source (getf meta :source))
(tool (gethash (string-downcase (string tool-name)) *cognitive-tools*)))
(if tool
(handler-case
(let* ((clean-args (if (and (listp tool-args) (listp (car tool-args))) (car tool-args) tool-args))
(result (funcall (cognitive-tool-body tool) clean-args)))
(let ((feedback (list :TYPE :EVENT :DEPTH (1+ depth) :META meta
: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
(when source
(dispatch-action (list :TYPE :REQUEST :TARGET source
:PAYLOAD (list :ACTION :MESSAGE :TEXT (format-tool-result tool-name result)))
context))
feedback))
(error (c)
(list :TYPE :EVENT :DEPTH (1+ depth) :META meta
:PAYLOAD (list :SENSOR :tool-error :tool tool-name :message (format nil "~a" c)))))
(list :TYPE :EVENT :DEPTH (1+ depth) :META meta
:PAYLOAD (list :SENSOR :tool-error :message "Tool not found")))))
#+end_src
** The Act Gate
The final stage of the metabolic loop. It performs a "last-mile" safety check before dispatching the action to the registered actuator.
#+begin_src lisp :tangle ../src/act.lisp
(defun act-gate (signal)
"Final Stage: Actuation and feedback generation."
(let* ((approved (getf signal :approved-action))
(type (getf signal :type))
(meta (getf signal :meta))
(source (getf meta :source))
(feedback nil)
;; context must keep internal objects for actuators to function
(context signal))
;; 1. Last-Mile Safety Check (The Bouncer & Deterministic Gates)
(when approved
(let* ((original-type (getf approved :type))
(verified (deterministic-verify approved signal)))
(if (and (listp verified)
(member (getf verified :type) '(:LOG :EVENT :log :event))
(not (member original-type '(:LOG :EVENT :log :event))))
(progn
(harness-log "ACT BLOCKED: Action failed last-mile deterministic check.")
(setf (getf signal :approved-action) nil)
(setf approved nil)
(setf feedback verified))
(progn
(setf (getf signal :approved-action) verified)
(setf approved verified)))))
;; 2. Actuation Logic
(case type
(:REQUEST (dispatch-action signal context))
(:LOG (dispatch-action signal context))
(:EVENT
(if approved
(let* ((target (getf approved :target))
(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)))
(setf feedback result))
((and result (not (member target *silent-actuators*)))
(setf feedback (list :type :EVENT :depth (1+ (getf signal :depth 0)) :meta meta
: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.
(when source
(dispatch-action signal context)))))
(setf (getf signal :status) :acted)
feedback))
#+end_src

150
harness/communication.org Normal file
View File

@@ -0,0 +1,150 @@
#+TITLE: Communication Protocol (communication.lisp)
#+AUTHOR: Amr
#+FILETAGS: :harness:protocol:
#+STARTUP: content
* 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.
* Implementation (communication.lisp)
#+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
#+begin_src lisp :tangle ../src/communication.lisp
(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
** Structural Validation (communication-validator.lisp)
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
(in-package :opencortex)
(defun validate-communication-protocol-schema (msg)
"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
(defun sanitize-protocol-message (msg)
"Recursively strips non-serializable objects from a protocol plist."
(if (and msg (listp msg))
(let ((clean nil))
(loop for (k v) on msg by #'cddr
do (unless (member k '(:reply-stream :socket :stream))
(push k clean)
(push (if (listp v) (sanitize-protocol-message v) v) clean)))
(nreverse clean))
msg))
(defun frame-message (msg)
"Serializes a message plist and prefixes it with a 6-character hex length."
(let* ((sanitized (sanitize-protocol-message msg))
(payload (let ((*print-pretty* nil) (*read-eval* nil)) (format nil "~s" sanitized)))
(len (length payload)))
(format nil "~6,'0x~a" len payload)))
#+end_src

262
harness/context.org Normal file
View File

@@ -0,0 +1,262 @@
#+TITLE: Peripheral Vision (context.lisp)
#+AUTHOR: Amr
#+FILETAGS: :harness:context:
#+STARTUP: content
* 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.
The ~opencortex~ harness implements a deterministic, tree-aware solution: the **Foveal-Peripheral Hybrid Model**.
*** 1. The Foveal Focus (High Resolution)
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.
#+begin_src lisp :tangle ../src/context.lisp
(in-package :opencortex)
#+end_src
** Querying the Store (context-query-store)
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
(defun context-query-store (&key tag todo-state type)
"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
(defun context-get-active-projects ()
"Returns headlines tagged as 'project' that are not yet marked DONE."
(remove-if (lambda (obj) (equal (getf (org-object-attributes obj) :TODO-STATE) "DONE"))
(context-query-store :tag "project" :type :HEADLINE)))
#+end_src
** Completed Tasks (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.
#+begin_src lisp :tangle ../src/context.lisp
(defun context-get-recent-completed-tasks ()
"Retrieves recently finished tasks from the store."
(context-query-store :todo-state "DONE" :type :HEADLINE))
#+end_src
** Capability Discovery (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.
#+begin_src lisp :tangle ../src/context.lisp
(defun context-list-all-skills ()
"Provides a sorted overview of currently loaded system capabilities."
(let ((results nil))
(maphash (lambda (name skill)
(declare (ignore name))
(push (list :name (skill-name skill) :priority (skill-priority skill) :dependencies (skill-dependencies skill)) results))
*skills-registry*)
(sort results #'> :key (lambda (x) (getf x :priority)))))
#+end_src
** Skill Inspection (context-get-skill-source)
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.
#+begin_src lisp :tangle ../src/context.lisp
(defun context-get-skill-source (skill-name)
"Reads the raw literate source of a specific skill for inspection."
(let* ((filename (format nil "~a.org" skill-name))
(skills-dir-str (or (uiop:getenv "SKILLS_DIR") (namestring (merge-pathnames "notes/" (user-homedir-pathname)))))
(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
** Harness Logs (context-get-system-logs)
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`.
#+begin_src lisp :tangle ../src/context.lisp
(defun context-get-system-logs (&optional limit)
"Retrieves the most recent lines from the harness's internal log."
(let ((log-limit (or limit (ignore-errors (parse-integer (uiop:getenv "CONTEXT_LOG_LIMIT"))) 20)))
(bt:with-lock-held (*logs-lock*)
(let ((count (min log-limit (length *system-logs*))))
(subseq *system-logs* 0 count)))))
#+end_src
** AST to Org Rendering (context-render-to-org)
This is the core engine of the Foveal-Peripheral model. It recursively transforms the internal ~org-object~ graph back into an Org-mode string.
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
(defun context-render-to-org (obj &key (depth 1) (foveal-id nil) semantic-threshold (foveal-vector nil))
"Recursively renders an org-object and its children to an Org string using a Foveal-Peripheral Hybrid model."
(let* ((id (org-object-id obj))
(is-foveal (equal id foveal-id))
(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

108
harness/loop.org Normal file
View File

@@ -0,0 +1,108 @@
#+TITLE: The Metabolic Loop (loop.lisp)
#+AUTHOR: Amr
#+FILETAGS: :harness:loop:
#+STARTUP: content
* The Metabolic Loop (loop.lisp)
** 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:
1. **Perceive:** Sensory intake.
2. **Reason:** Cognitive processing.
3. **Act:** Physical side-effects.
** Package and Variables
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.
#+begin_src lisp :tangle ../src/loop.lisp
(in-package :opencortex)
(defvar *interrupt-flag* nil)
(defvar *interrupt-lock* (bt:make-lock "harness-interrupt-lock"))
(defvar *heartbeat-thread* nil)
#+end_src
** The Metabolic Pipeline
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.
#+begin_src lisp :tangle ../src/loop.lisp
(defun process-signal (signal)
"The entry point to the Metabolic Pipeline: Perceive -> Reason -> Act."
(let ((current-signal signal))
(loop while current-signal do
(let ((depth (getf current-signal :depth 0))
(meta (getf current-signal :meta)))
(when (> depth 10) (harness-log "METABOLISM ERROR: Max depth reached.") (return nil))
(when (bt:with-lock-held (*interrupt-lock*) *interrupt-flag*)
(harness-log "METABOLISM: Interrupted.")
(bt:with-lock-held (*interrupt-lock*) (setf *interrupt-flag* nil))
(return nil))
(handler-case
(progn
(setf current-signal (perceive-gate current-signal))
(setf current-signal (reason-gate current-signal))
(let ((feedback (act-gate current-signal)))
;; feedback generation
(if feedback
(progn
;; Inherit meta from trigger signal
(unless (getf feedback :meta) (setf (getf feedback :meta) meta))
(setf current-signal feedback))
(setf current-signal nil))))
(error (c)
(let ((sensor (ignore-errors (getf (getf current-signal :payload) :sensor))))
(harness-log "METABOLISM CRASH [~a]: ~a" (or sensor :unknown) c)
;; Only rollback on critical errors, not standard tool or loop errors
(unless (member sensor '(:loop-error :tool-error :syntax-error))
(harness-log "CRITICAL ERROR: Initiating Micro-Rollback.")
(rollback-memory 0))
(if (or (> depth 2) (member sensor '(:loop-error :tool-error)))
(setf current-signal nil)
(setf current-signal (list :type :EVENT :depth (1+ depth) :meta meta
:payload (list :sensor :loop-error :message (format nil "~a" c) :depth depth)))))))))))
#+end_src
** Heartbeat Mechanism
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.
#+begin_src lisp :tangle ../src/loop.lisp
(defun start-heartbeat ()
"Starts the background heartbeat thread. Interval is loaded from HEARTBEAT_INTERVAL."
(let ((interval (or (ignore-errors (parse-integer (uiop:getenv "HEARTBEAT_INTERVAL"))) 60)))
(setf *heartbeat-thread*
(bt:make-thread
(lambda ()
(loop
(sleep interval)
;; inject-stimulus is synchronous for heartbeats, preventing accumulation.
(inject-stimulus (list :type :EVENT :payload (list :sensor :heartbeat :unix-time (get-universal-time))))))
:name "opencortex-heartbeat"))))
#+end_src
** Main Entry Point
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.
#+begin_src lisp :tangle ../src/loop.lisp
(defun main ()
"Entry point for the Skeleton MVP. Handles initialization and graceful shutdown."
(let* ((home (uiop:getenv "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)))
(initialize-actuators)
(initialize-all-skills)
(start-heartbeat)
;; Graceful shutdown handler for SBCL
#+sbcl
(sb-sys:enable-interrupt sb-unix:sigint
(lambda (sig code scp)
(declare (ignore sig code scp))
(harness-log "SHUTDOWN: SIGINT received. Exiting...")
(uiop:quit 0)))
(let ((sleep-interval (or (ignore-errors (parse-integer (uiop:getenv "DAEMON_SLEEP_INTERVAL"))) 3600)))
(loop
(when (bt:with-lock-held (*interrupt-lock*) *interrupt-flag*) (return))
(sleep sleep-interval))))
#+end_src

86
harness/manifest.org Normal file
View File

@@ -0,0 +1,86 @@
#+TITLE: Manifest (opencortex.asd)
#+AUTHOR: Amr
#+FILETAGS: :harness:system:
#+STARTUP: content
* Manifest (opencortex.asd)
** 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 and loading of all harness modules.
Traditional Lisp systems often use complex, non-linear dependency graphs. However, the ~opencortex~ harness mandates a strict, linear bootstrap sequence.
*** 1. 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. 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.
*** 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
flowchart TD
Org[Literate Org Files] -- Tangle --> Lisp[Source .lisp Files]
Lisp --> ASDF[ASDF Manifest: .asd]
ASDF --> Loader[SBCL Compiler / Loader]
Loader --> Image[Live Harness Image]
Image -- Build --> Binary[Standalone Binary]
#+end_src
** Harness System Definition
This system defines the core "Thin Harness." It includes the protocol, the object store, and the functional loop.
#+begin_src lisp :tangle ../opencortex.asd
(defsystem :opencortex
:name "opencortex"
:author "Amr"
:version "0.1.0"
:license "AGPLv3"
:description "The Probabilistic-Deterministic Lisp Machine Harness"
:depends-on (:usocket :bordeaux-threads :dexador :uiop :cl-dotenv :cl-ppcre :hunchentoot :ironclad :str :cl-json :uuid)
:serial t
:components ((:file "src/package")
(:file "src/skills")
(:file "src/policy")
(:file "src/communication-validator")
(:file "src/communication")
(:file "src/memory")
(:file "src/context")
(:file "src/probabilistic")
(:file "src/perceive")
(:file "src/reason")
(:file "src/act")
(:file "src/loop"))
:build-operation "program-op"
:build-pathname "opencortex-server"
:entry-point "opencortex:main")
#+end_src
** Verification Suite Definition
This system contains the empirical tests required by the Engineering Standards. It depends on ~:opencortex~ and the ~FiveAM~ testing framework.
#+begin_src lisp :tangle ../opencortex.asd
(defsystem :opencortex/tests
:depends-on (:opencortex :fiveam)
:components ((:file "tests/communication-tests")
(:file "tests/pipeline-tests")
(:file "tests/act-tests")
(:file "tests/boot-sequence-tests")
(:file "tests/memory-tests")
(:file "tests/immune-system-tests"))
:perform (test-op (o s)
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :communication-protocol-suite :opencortex-tests))
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :pipeline-suite :opencortex-pipeline-tests))
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :safety-suite :opencortex-safety-tests))
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :boot-suite :opencortex-boot-tests))
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :memory-suite :opencortex-memory-tests))
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :immune-suite :opencortex-immune-system-tests))))
#+end_src
** TUI Client Definition
This system defines the native Croatoan TUI client.
#+begin_src lisp :tangle ../opencortex.asd
(defsystem :opencortex/tui
:depends-on (:opencortex :croatoan :usocket :bordeaux-threads)
:components ((:file "src/tui-client")))
#+end_src

287
harness/memory.org Normal file
View File

@@ -0,0 +1,287 @@
#+TITLE: The System Memory (memory.lisp)
#+AUTHOR: Amr
#+FILETAGS: :harness:memory:
#+STARTUP: content
* The System 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.
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.
- **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.
- **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
(in-package :opencortex)
#+end_src
** The Object Repository
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.
#+begin_src lisp :tangle ../src/memory.lisp
(defvar *memory* (make-hash-table :test 'equal))
(defvar *history-store* (make-hash-table :test 'equal)
"Immutable Merkle-Tree versioning store mapping hashes to objects.")
#+end_src
** The Data Structure (org-object)
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).
#+begin_src lisp :tangle ../src/memory.lisp
(defstruct org-object
id type attributes content vector parent-id children version last-sync hash)
#+end_src
** Merkle Tree Integrity (compute-merkle-hash)
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.
#+begin_src lisp :tangle ../src/memory.lisp
(defun compute-merkle-hash (id type attributes content child-hashes)
"Computes a SHA-256 Merkle hash for a node based on its core properties and children's hashes."
(let* ((alist (loop for (k v) on attributes by #'cddr collect (cons k v)))
(sorted-alist (sort alist #'string< :key (lambda (x) (format nil "~a" (car x)))))
(attr-string (format nil "~s" sorted-alist))
(children-string (format nil "~{~a~}" child-hashes))
(data-string (format nil "ID:~a|TYPE:~s|ATTRS:~a|CONTENT:~a|CHILDREN:~a"
id type attr-string (or content "") children-string))
(digester (ironclad:make-digest :sha256)))
(ironclad:update-digest digester (ironclad:ascii-string-to-byte-array data-string))
(ironclad:byte-array-to-hex-string (ironclad:produce-digest digester))))
#+end_src
** Ingesting the AST (ingest-ast)
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.
#+begin_src lisp :tangle ../src/memory.lisp
(defun ingest-ast (ast &optional parent-id)
"Parses an Org AST into the recursive Lisp Memory with Merkle hashing."
(let* ((type (getf ast :type))
(props (getf ast :properties))
(id (or (getf props :ID) (format nil "temp-~a" (get-universal-time))))
(contents (getf ast :contents))
(raw-content (when (eq type :HEADLINE)
(format nil "~a~%~a" (getf props :TITLE) (or (cl:getf ast :raw-content) ""))))
(should-embed (and raw-content (equal (getf props :EMBED) "t")))
(child-ids nil)
(child-hashes nil))
(dolist (child contents)
(when (listp child)
(let ((child-id (ingest-ast child id)))
(push child-id child-ids)
(let ((child-id-val child-id))
(let ((child-obj (lookup-object child-id-val)))
(when child-obj (push (org-object-hash child-obj) child-hashes)))))))
(setf child-ids (nreverse child-ids))
(setf child-hashes (nreverse child-hashes))
(let* ((hash (compute-merkle-hash id type props raw-content child-hashes))
(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)
id)))
#+end_src
** Memory Snapshots (snapshot-memory)
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.
#+begin_src lisp :tangle ../src/memory.lisp
(defvar *object-store-snapshots* nil)
(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*))
(defun list-objects-by-type (type)
"Returns a list of all objects matching a specific Org element type."
(let ((results nil))
(maphash (lambda (id obj) (declare (ignore id)) (when (eq (org-object-type obj) type) (push obj results))) *memory*)
results))
(defun list-objects-with-attribute (attr-name value)
"Returns a list of all objects where ATTR-NAME matches VALUE."
(let ((results nil))
(maphash (lambda (id obj)
(declare (ignore id))
(let ((attrs (org-object-attributes obj)))
(when (equal (getf attrs attr-name) value)
(push obj results))))
*memory*)
results))
#+end_src
** Structural Helpers
Utility functions for AST traversal and path resolution.
#+begin_src lisp :tangle ../src/memory.lisp
(defun find-headline-missing-id (ast)
"Traverses an AST to find headlines that lack an :ID: property."
(when (listp ast)
(if (and (eq (getf ast :type) :HEADLINE) (not (getf (getf ast :properties) :ID)))
ast
(cl:some #'find-headline-missing-id (getf ast :contents)))))
(defun file-name-nondirectory (path)
"Extracts the filename from a full path string."
(let ((pos (position #\/ path :from-end t))) (if pos (subseq path (1+ pos)) path)))
#+end_src
* Phase E: Chaos (Verification)
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.
#+begin_src lisp :tangle ../tests/memory-tests.lisp
(defpackage :opencortex-memory-tests
(:use :cl :fiveam :opencortex)
(:export #:memory-suite))
(in-package :opencortex-memory-tests)
(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

246
harness/package.org Normal file
View File

@@ -0,0 +1,246 @@
#+TITLE: System Interface (package.lisp)
#+AUTHOR: Amr
#+FILETAGS: :harness:interface:
#+STARTUP: content
* System Interface (package.lisp)
The ~package.lisp~ file defines the public API of the ~opencortex~ harness. It serves as the primary membrane between the deterministic core modules and the dynamic world of skills and actuators.
** Architectural Intent: The Package Membrane
By strictly defining the public interface, we ensure that skills remain decoupled from the harness implementation details. This allows for autonomous replacement of any component (e.g., swapping the Memory or the Probabilistic Engine) without breaking existing skills.
#+begin_src mermaid
flowchart TD
External[Actuators / Clients] -- communication protocol --> Package[Package Membrane: API]
Skills[Dynamic Skills] -- API Calls --> Package
Package --> Internal[Harness Internal Modules]
style Package fill:#f9f,stroke:#333,stroke-width:4px
#+end_src
** Public API Export
#+begin_src lisp :tangle ../src/package.lisp
(defpackage :opencortex
(:use :cl)
(:export
;; --- communication protocol ---
#:frame-message
#:read-framed-message
#:PROTO-GET
#:LIST-OBJECTS-WITH-ATTRIBUTE
#:COSINE-SIMILARITY
#:VAULT-MASK-STRING
#:*VAULT-MEMORY*
#:parse-message
#:make-hello-message
#:validate-communication-protocol-schema
;; --- Daemon Lifecycle ---
#:start-daemon
#:stop-daemon
#:harness-log
#:main
;; --- Memory (CLOSOS) ---
#:ingest-ast
#:lookup-object
#:list-objects-by-type
#:org-id-new
#:*memory*
#:*history-store*
#:org-object
#:make-org-object
#:org-object-id
#:org-object-type
#:org-object-attributes
#:org-object-parent-id
#:org-object-children
#:org-object-version
#:org-object-last-sync
#:org-object-vector
#:org-object-content
#:org-object-hash
#:snapshot-memory
#:rollback-memory
;; --- Context API (Peripheral Vision) ---
#:context-query-store
#:context-get-active-projects
#:context-get-recent-completed-tasks
#:context-list-all-skills
#:context-get-skill-source
#:context-get-system-logs
#:context-resolve-path
#:context-get-skill-telemetry
#:harness-track-telemetry
#:context-assemble-global-awareness
;; --- Reactive Signal Pipeline ---
#:process-signal
#:perceive-gate
#:probabilistic-gate
#:consensus-gate
#:act-gate
#:reason-gate
#:perceive-gate
#:dispatch-gate
#:inject-stimulus
#:initialize-actuators
#:dispatch-action
#:register-actuator
;; --- Skill Engine ---
#:load-skill-from-org
#:initialize-all-skills
#:load-skill-with-timeout
#:topological-sort-skills
#:validate-lisp-syntax
#:defskill
#:*skills-registry*
#:skill
#:skill-name
#:skill-priority
#:skill-dependencies
#:skill-trigger-fn
#:skill-probabilistic-prompt
#:skill-deterministic-fn
;; --- Tool Registry ---
#:def-cognitive-tool
#:*cognitive-tools*
#:cognitive-tool
#:cognitive-tool-name
#:cognitive-tool-description
#:cognitive-tool-parameters
#:cognitive-tool-guard
#:cognitive-tool-body
;; --- Emacs Client Registry ---
#:*emacs-clients*
#:*clients-lock*
#:register-emacs-client
#:unregister-emacs-client
;; --- Probabilistic Engine ---
#:ask-probabilistic
#:register-probabilistic-backend
#:distill-prompt
#:*provider-cascade*
;; --- Security Vault ---
#:vault-get-secret
#:vault-set-secret
;; --- Deterministic Logic ---
#:list-objects-with-attribute
#:deterministic-verify
;; --- AST Helpers ---
#:find-headline-missing-id))
#+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
#+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
(in-package :opencortex)
#+end_src
** Harness Logging State
The harness maintains a thread-safe circular log buffer to provide context for debugging and neural reasoning.
#+begin_src lisp :tangle ../src/package.lisp
(defvar *system-logs* nil)
(defvar *logs-lock* (bt:make-lock "harness-logs-lock"))
(defvar *max-log-history* 100)
#+end_src
** Skills Registry
#+begin_src lisp :tangle ../src/package.lisp
(defvar *skills-registry* (make-hash-table :test 'equal)
"Global registry of all loaded skills.")
#+end_src
** Skill Telemetry State
#+begin_src lisp :tangle ../src/package.lisp
(defvar *skill-telemetry* (make-hash-table :test 'equal))
(defvar *telemetry-lock* (bt:make-lock "harness-telemetry-lock"))
#+end_src
** Telemetry Implementation
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.
#+begin_src lisp :tangle ../src/package.lisp
(defun harness-track-telemetry (skill-name duration status)
"Updates performance metrics for a specific skill. Status should be :success or :rejected."
(when skill-name
(bt:with-lock-held (*telemetry-lock*)
(let ((entry (or (gethash skill-name *skill-telemetry*) (list :executions 0 :total-time 0 :failures 0))))
(incf (getf entry :executions))
(incf (getf entry :total-time) duration)
(when (eq status :rejected) (incf (getf entry :failures)))
(setf (gethash skill-name *skill-telemetry*) entry)))))
#+end_src
** Cognitive Tool Registry
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).
#+begin_src lisp :tangle ../src/package.lisp
(defvar *cognitive-tools* (make-hash-table :test 'equal))
(defstruct cognitive-tool
name
description
parameters
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."
`(setf (gethash (string-downcase (string ',name)) *cognitive-tools*)
(make-cognitive-tool :name (string-downcase (string ',name))
:description ,description
:parameters ',parameters
:guard ,guard
:body ,body)))
#+end_src
** Harness Logging Implementation
Centralized logging function. It simultaneously writes to standard output and the in-memory circular buffer.
#+begin_src lisp :tangle ../src/package.lisp
(defun harness-log (msg &rest args)
"Centralized logging for the harness."
(let ((formatted-msg (apply #'format nil msg args)))
(bt:with-lock-held (*logs-lock*)
(push formatted-msg *system-logs*)
(when (> (length *system-logs*) *max-log-history*)
(setq *system-logs* (subseq *system-logs* 0 *max-log-history*))))
(format t "~a~%" formatted-msg)
(finish-output)))
#+end_src

89
harness/perceive.org Normal file
View File

@@ -0,0 +1,89 @@
#+TITLE: Stage 1: Perceive (perceive.lisp)
#+AUTHOR: Amr
#+FILETAGS: :harness:perceive:
#+STARTUP: content
* 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
To prevent blocking the main pipeline, certain sensors (like user commands or chat messages) are processed asynchronously in their own threads.
#+begin_src lisp :tangle ../src/perceive.lisp
(in-package :opencortex)
(defvar *async-sensors* '(:chat-message :delegation :user-command)
"List of sensors that should be processed asynchronously to avoid blocking gateways.")
#+end_src
** Foveal Focus State
The system tracks the user's current point of interaction to provide context to the reasoning engine.
#+begin_src lisp :tangle ../src/perceive.lisp
(defvar *foveal-focus-id* nil
"The Org ID of the node the user is currently interacting with.")
#+end_src
** Stimulus Injection
The entry point for raw messages. It determines if the signal should be processed synchronously or asynchronously.
#+begin_src lisp :tangle ../src/perceive.lisp
(defun inject-stimulus (raw-message &key stream (depth 0))
"Enqueues a raw message into the reactive signal pipeline."
(let* ((payload (getf raw-message :payload))
(sensor (getf payload :sensor))
(meta (getf raw-message :meta))
(async-p (or (getf payload :async-p) (member sensor *async-sensors*))))
;; Ensure META exists and contains the stream if provided
(unless meta (setf meta (list :SOURCE :SYSTEM :SESSION-ID "internal")))
(when stream (setf (getf meta :reply-stream) stream))
(setf (getf raw-message :meta) meta)
(if async-p
(bt:make-thread
(lambda ()
(restart-case (handler-bind ((error (lambda (c) (harness-log "ASYNC ERROR: ~a" c) (invoke-restart 'skip-event))))
(process-signal raw-message))
(skip-event () nil)))
:name "opencortex-async-task")
(restart-case (handler-bind ((error (lambda (c) (harness-log "SYSTEM ERROR: ~a" c) (invoke-restart 'skip-event))))
(process-signal raw-message))
(skip-event () (harness-log "SYSTEM RECOVERY: Stimulus dropped.~%"))))))
#+end_src
** The Perceive Gate
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.
#+begin_src lisp :tangle ../src/perceive.lisp
(defun perceive-gate (signal)
"Initial processing: Normalizes raw stimuli and updates memory."
(let* ((payload (getf signal :payload))
(type (getf signal :type))
(meta (getf signal :meta))
(sensor (getf payload :sensor)))
(harness-log "GATE [Perceive]: ~a (~a) [Source: ~s]" type (or sensor "no-sensor") (getf meta :source))
(cond ((eq type :EVENT)
(case sensor
(:buffer-update
(let ((ast (getf payload :ast)))
(when ast
(snapshot-memory)
(ingest-ast ast))))
(:point-update
(let ((element (getf payload :element)))
(when element
(snapshot-memory)
(setf *foveal-focus-id* (ignore-errors (getf element :id)))
(ingest-ast element))))
(:interrupt
(bt:with-lock-held (*interrupt-lock*) (setf *interrupt-flag* t)))))
((eq type :RESPONSE)
(harness-log "GATE [Perceive]: Act Result -> ~a" (getf payload :status))))
(setf (getf signal :status) :perceived)
(setf (getf signal :foveal-focus) *foveal-focus-id*)
signal))
#+end_src

145
harness/reason.org Normal file
View File

@@ -0,0 +1,145 @@
#+TITLE: Stage 2: Reason (reason.lisp)
#+AUTHOR: Amr
#+FILETAGS: :harness:reason:
#+STARTUP: content
* Stage 2: Reason (reason.lisp)
** 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).
* Cognition Engine (reason.lisp)
** Package Context
#+begin_src lisp :tangle ../src/reason.lisp
(in-package :opencortex)
#+end_src
** Neural Backend Registry
#+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)
(defun register-probabilistic-backend (name fn)
"Registers a neural provider (e.g., :gemini, :anthropic) with its calling function."
(setf (gethash name *probabilistic-backends*) fn))
#+end_src
** Probabilistic Reasoning (probabilistic-call)
#+begin_src lisp :tangle ../src/reason.lisp
(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."
(let ((backends (or cascade *provider-cascade*)))
(or (dolist (backend backends)
(let ((backend-fn (gethash backend *probabilistic-backends*)))
(when backend-fn
(harness-log "PROBABILISTIC: Attempting backend ~a..." backend)
(let* ((model (when *model-selector-fn* (funcall *model-selector-fn* backend context)))
(result (if model
(funcall backend-fn prompt system-prompt :model model)
(funcall backend-fn prompt system-prompt))))
(cond ((and (listp result) (eq (getf result :status) :success))
(return (getf result :content)))
((stringp result) (return result))
(t (harness-log "PROBABILISTIC: Backend ~a failed: ~a" backend (getf result :message))))))))
(list :type :LOG :payload (list :text "Neural Cascade Failure: All providers exhausted.")))))
#+end_src
** Cognitive Proposal (Think)
#+begin_src lisp :tangle ../src/reason.lisp
(defun strip-markdown (text)
"Strips common markdown code block markers from text."
(if (and text (stringp text))
(let ((cleaned text))
(setf cleaned (cl-ppcre:regex-replace-all "^```[a-z]*\\n" cleaned ""))
(setf cleaned (cl-ppcre:regex-replace-all "\\n```$" cleaned ""))
(setf cleaned (cl-ppcre:regex-replace-all "```" cleaned ""))
(string-trim '(#\Space #\Newline #\Tab) cleaned))
text))
(defun think (context)
"Generates a Lisp action proposal based on current context."
(let* ((active-skill (find-triggered-skill context))
(tool-belt (generate-tool-belt-prompt))
(global-context (context-assemble-global-awareness))
(system-logs (context-get-system-logs))
(assistant-name (or (uiop:getenv "MEMEX_ASSISTANT") "Agent")))
(let* ((prompt-generator (when active-skill (skill-probabilistic-prompt active-skill)))
(raw-prompt (if prompt-generator
(funcall prompt-generator context)
(let ((p (proto-get (proto-get context :payload) :text)))
(if (and p (stringp p)) p "Maintain metabolic stasis."))))
(system-prompt (format nil "IDENTITY: ~a. MANDATE: Respond with ONE Lisp plist. ~a ~a RECENT_LOGS: ~a
IMPORTANT: To reply to the user, you MUST use:
(:TYPE :REQUEST :PAYLOAD (:ACTION :MESSAGE :TEXT \"<Response Text>\"))
To call a tool, you MUST use:
(:TYPE :REQUEST :TARGET :TOOL :ACTION :CALL :TOOL \"<name>\" :ARGS (:arg1 \"val\"))
PROVIDER RULE: Always use the default cascade provider unless a specific model or capability is required for the task."
assistant-name global-context tool-belt system-logs)))
(let* ((thought (probabilistic-call raw-prompt :system-prompt system-prompt :context context))
(cleaned (strip-markdown thought))
(meta (proto-get context :meta))
(source (proto-get meta :source)))
(if (and cleaned (stringp cleaned))
(let ((*read-eval* nil))
(if (and (> (length cleaned) 0) (char= (char cleaned 0) #\())
(handler-case
(let ((parsed (read-from-string cleaned)))
(let ((type (proto-get parsed :TYPE))
(target (or (proto-get parsed :TARGET) (proto-get parsed :target))))
(cond ((member type '(:REQUEST :EVENT :STATUS :RESPONSE))
(unless (proto-get parsed :target) (setf (getf parsed :target) (or source :CLI)))
parsed)
;; Handle raw plists or lists of plists that look like tool calls or data
((or (eq target :TOOL) (eq target :tool) (getf parsed :TOOL) (getf parsed :tool)
(and (listp parsed) (listp (car parsed)) (keywordp (caar parsed))))
(list :TYPE :REQUEST :TARGET :TOOL :PAYLOAD parsed))
(t (list :TYPE :REQUEST :TARGET (or source :CLI) :PAYLOAD (list :ACTION :MESSAGE :TEXT cleaned))))))
(error (c) (list :TYPE :REQUEST :TARGET (or source :CLI) :PAYLOAD (list :ACTION :MESSAGE :TEXT cleaned))))
(list :TYPE :REQUEST :TARGET (or source :CLI) :PAYLOAD (list :ACTION :MESSAGE :TEXT cleaned))))
thought)))))
#+end_src
** Deterministic Verification
#+begin_src lisp :tangle ../src/reason.lisp
(defun deterministic-verify (proposed-action context)
"Iterates through all skill deterministic-gates sorted by priority."
(let ((current-action proposed-action)
(skills nil))
(maphash (lambda (name skill) (declare (ignore name)) (when (skill-deterministic-fn skill) (push skill skills))) *skills-registry*)
(setf skills (sort skills #'> :key #'skill-priority))
(dolist (skill skills)
(let ((trigger (skill-trigger-fn skill))
(gate (skill-deterministic-fn skill)))
(when (or (null trigger) (ignore-errors (funcall trigger context)))
(let ((next-action (funcall gate current-action context)))
(let ((original-type (proto-get current-action :type)))
(when (and (listp next-action)
(member (proto-get next-action :type) '(:LOG :EVENT :log :event))
(or (not (member original-type '(:LOG :EVENT :log :event)))
(not (eq next-action current-action))))
(harness-log "DETERMINISTIC: Intercepted by skill '~a'" (skill-name skill))
(return-from deterministic-verify next-action)))
(setf current-action next-action)))))
current-action))
#+end_src
** Reasoning Gate (The Pipeline Stage)
#+begin_src lisp :tangle ../src/reason.lisp
(defun reason-gate (signal)
"Unified Stage: Combines Probabilistic proposals and Deterministic verification."
(let* ((type (proto-get signal :type))
(payload (proto-get signal :payload))
(sensor (proto-get payload :sensor)))
(unless (and (eq type :EVENT) (member sensor '(:user-input :chat-message)))
(return-from reason-gate signal))
(let ((candidate (think signal)))
(if candidate
(setf (getf signal :approved-action) (deterministic-verify candidate signal))
(setf (getf signal :approved-action) nil))
(setf (getf signal :status) :reasoned)
signal)))
#+end_src

260
harness/setup.org Normal file
View File

@@ -0,0 +1,260 @@
#+TITLE: Zero-to-One Setup (setup.org)
#+AUTHOR: Amr
#+FILETAGS: :harness:setup:
#+STARTUP: content
* Zero-to-One Setup (setup.org)
The ~setup.org~ file defines the automated installation and initialization sequence for the OpenCortex.
** The Installer Script (opencortex.sh)
#+begin_src bash :tangle ../opencortex.sh
#!/bin/bash
set -e
PORT=9105
HOST="localhost"
RED='\033[0;31m'; GREEN='\033[0;32m'; BLUE='\033[0;34m'; YELLOW='\033[0;33m'; NC='\033[0m'
command_exists() { command -v "$1" >/dev/null 2>&1; }
# Resolve symlinks to find the actual repository location
SOURCE="${BASH_SOURCE[0]}"
while [ -h "$SOURCE" ]; do
DIR="$( cd -P "$( dirname "$SOURCE" )" && pwd )"
SOURCE="$(readlink "$SOURCE")"
[[ $SOURCE != /* ]] && SOURCE="$DIR/$SOURCE"
done
export SCRIPT_DIR="$( cd -P "$( dirname "$SOURCE" )" && pwd )"
# Load environment variables if they exist
if [ -f "$SCRIPT_DIR/.env" ]; then
while IFS="=" read -r key value || [ -n "$key" ]; do
if [[ $key =~ ^[a-zA-Z_][a-zA-Z0-9_]*$ ]]; then
val=$(echo "$value" | sed "s/^\"//;s/\"$//")
export "$key=$val"
fi
done < "$SCRIPT_DIR/.env"
[ -n "$ORG_AGENT_DAEMON_PORT" ] && PORT=$ORG_AGENT_DAEMON_PORT
[ -n "$DAEMON_HOST" ] && HOST=$DAEMON_HOST
fi
# --- 1. BOOTSTRAP ---
# If the script is run standalone, it clones the full repo and restarts itself.
if [ ! -d "$SCRIPT_DIR/.git" ] && [ ! -d "$HOME/.opencortex" ] && [[ ! "$(pwd)" =~ "opencortex" ]]; then
echo -e "${BLUE}=== OpenCortex: Zero-to-One Bootstrapper ===${NC}"
git clone ssh://git@10.10.10.201:2222/amr/opencortex.git ~/.opencortex
cd ~/.opencortex && git submodule update --init --recursive
exec ./opencortex.sh "$@"
fi
# --- 2. SETUP ---
setup_system() {
NON_INTERACTIVE=false
for arg in "$@"; do
if [ "$arg" == "--non-interactive" ]; then NON_INTERACTIVE=true; fi
done
echo -e "${BLUE}=== OpenCortex: Initializing System ===${NC}"
echo -e "${YELLOW}--- Installing System Dependencies ---${NC}"
if command_exists apt-get; then
sudo apt-get update && sudo apt-get install -y sbcl emacs-nox rlwrap netcat-openbsd curl git socat libssl-dev libncurses5-dev libffi-dev zlib1g-dev libsqlite3-dev
fi
if [ ! -d "$HOME/quicklisp" ]; then
curl -O https://beta.quicklisp.org/quicklisp.lisp
sbcl --non-interactive --load quicklisp.lisp --eval "(quicklisp-quickstart:install)" --eval "(ql-util:without-prompting (ql:add-to-init-file))"
rm quicklisp.lisp
fi
cd "$SCRIPT_DIR"
if [ ! -f .env ]; then
if [ "$NON_INTERACTIVE" = true ]; then
echo "Non-interactive mode: Using environment variables for .env creation."
cp .env.example .env
[ -n "$MEMEX_USER" ] && sed -i "s|MEMEX_USER=.*|MEMEX_USER=\"$MEMEX_USER\"|" .env
[ -n "$MEMEX_ASSISTANT" ] && sed -i "s|MEMEX_ASSISTANT=.*|MEMEX_ASSISTANT=\"$MEMEX_ASSISTANT\"|" .env
[ -n "$OPENROUTER_API_KEY" ] && sed -i "s|OPENROUTER_API_KEY=.*|OPENROUTER_API_KEY=\"$OPENROUTER_API_KEY\"|" .env
[ -n "$MEMEX_DIR" ] && sed -i "s|MEMEX_DIR=.*|MEMEX_DIR=\"$MEMEX_DIR\"|" .env
else
cp .env.example .env
echo -e "\n${YELLOW}--- Identity Configuration ---${NC}"
read -p "Your Name [User]: " user_name < /dev/tty
user_name=${user_name:-User}
sed -i "s|MEMEX_USER=.*|MEMEX_USER=\"$user_name\"|" .env
read -p "Agent Name [OpenCortex]: " agent_name < /dev/tty
agent_name=${agent_name:-OpenCortex}
sed -i "s|MEMEX_ASSISTANT=.*|MEMEX_ASSISTANT=\"$agent_name\"|" .env
echo -e "\n${YELLOW}--- LLM Configuration ---${NC}"
read -p "OpenRouter API Key: " openrouter_key < /dev/tty
[ -n "$openrouter_key" ] && sed -i "s|OPENROUTER_API_KEY=.*|OPENROUTER_API_KEY=\"$openrouter_key\"|" .env
echo -e "\n${YELLOW}--- Memex Folder Structure ---${NC}"
read -p "Memex Root [\$HOME/memex]: " memex_dir < /dev/tty
memex_dir=${memex_dir:-\$HOME/memex}
sed -i "s|MEMEX_DIR=.*|MEMEX_DIR=\"$memex_dir\"|" .env
fi
# Hydrate default paths
M_DIR=$(grep MEMEX_DIR .env | cut -d'"' -f2 | sed "s|\$HOME|$HOME|")
sed -i "s|SKILLS_DIR=.*|SKILLS_DIR=\"$SCRIPT_DIR/skills\"|" .env
sed -i "s|ZETTELKASTEN_DIR=.*|ZETTELKASTEN_DIR=\"$M_DIR/notes\"|" .env
mkdir -p "$M_DIR" "$M_DIR/notes" "$M_DIR/areas" "$M_DIR/resources" "$M_DIR/archives" "$M_DIR/system" "$M_DIR/inbox" "$M_DIR/daily" "$M_DIR/projects"
fi
mkdir -p src
for f in literate/*.org; do
emacs --batch --eval "(require 'org)" --eval "(org-babel-tangle-file \"$f\")" >/dev/null 2>&1 || true
done
mkdir -p "$HOME/.local/bin"
ln -sf "$SCRIPT_DIR/opencortex.sh" "$HOME/.local/bin/opencortex"
for shell_config in "$HOME/.bashrc" "$HOME/.profile"; do
if [ -f "$shell_config" ]; then
if ! grep -q ".local/bin" "$shell_config"; then
echo 'export PATH="$HOME/.local/bin:$PATH"' >> "$shell_config"
fi
fi
done
export PATH="$HOME/.local/bin:$PATH"
echo -e "${YELLOW}--- Compiling and Loading OpenCortex ---${NC}"
sbcl --non-interactive --eval '(load (merge-pathnames "quicklisp/setup.lisp" (user-homedir-pathname)))' --eval '(push (truename (uiop:getenv "SCRIPT_DIR")) asdf:*central-registry*)' --eval "(ql:quickload '(:opencortex :croatoan))"
if [ $? -ne 0 ]; then
echo -e "${RED}✗ Compilation failed.${NC}"
exit 1
fi
if [ "$NON_INTERACTIVE" = true ]; then
echo "Setup complete (Non-interactive)."
exit 0
fi
echo -e "${YELLOW}--- Finalizing: Awakening the Brain ---${NC}"
"$SCRIPT_DIR/opencortex.sh" --boot > "$SCRIPT_DIR/brain.log" 2>&1 &
success=false
for i in {1..30}; do
if nc -z localhost $PORT 2>/dev/null; then success=true; break; fi
sleep 2
echo -n "."
done
if [ "$success" = true ]; then
echo -e "\n${GREEN}✓ Brain is alive on port $PORT.${NC}"
exit 0
else
echo -e "\n${RED}✗ Brain failed to wake up.${NC}"
exit 1
fi
}
# --- 3. COMMAND ROUTER ---
COMMAND=$1
[ -z "$COMMAND" ] && COMMAND="cli"
shift || true
DEFAULT_PORT=9105
DEFAULT_HOST="localhost"
TARGET_PORT=${PORT:-$DEFAULT_PORT}
TARGET_HOST=${HOST:-$DEFAULT_HOST}
# If uninitialized, force setup.
if [ ! -f "$SCRIPT_DIR/src/package.lisp" ] || [ ! -f "$SCRIPT_DIR/.env" ]; then
COMMAND="setup"
fi
case "$COMMAND" in
setup)
setup_system "$@"
;;
--boot|boot)
export SKILLS_DIR="${SCRIPT_DIR}/skills"
[ -z "$MEMEX_DIR" ] && export MEMEX_DIR="$HOME/memex"
if [ -f "$SCRIPT_DIR/.env" ]; then
export OPENROUTER_API_KEY=$(grep OPENROUTER_API_KEY "$SCRIPT_DIR/.env" | cut -d'"' -f2)
fi
exec sbcl --non-interactive --eval '(load (merge-pathnames "quicklisp/setup.lisp" (user-homedir-pathname)))' --eval '(setf *debugger-hook* (lambda (c h) (declare (ignore h)) (format *error-output* "FATAL LISP ERROR: ~a~%" c) (uiop:print-backtrace :stream *error-output*) (uiop:quit 1)))' --eval '(push (truename (uiop:getenv "SCRIPT_DIR")) asdf:*central-registry*)' --eval '(format t "--- Quickloading OpenCortex ---~%")' --eval "(ql:quickload '(:opencortex :croatoan))" --eval '(opencortex:main)'
;;
tui)
if ! nc -z $TARGET_HOST $TARGET_PORT 2>/dev/null; then
echo -e "Brain is offline. Awakening..."
"$SCRIPT_DIR/opencortex.sh" --boot > "$SCRIPT_DIR/brain.log" 2>&1 &
for i in {1..15}; do
sleep 2
if nc -z $TARGET_HOST $TARGET_PORT 2>/dev/null; then break; fi
echo -n "."
done
echo ""
fi
echo -e "Launching Croatoan TUI..."
export SKILLS_DIR="${SCRIPT_DIR}/skills"
[ -z "$MEMEX_DIR" ] && export MEMEX_DIR="$HOME/memex"
exec sbcl --eval '(load (merge-pathnames "quicklisp/setup.lisp" (user-homedir-pathname)))' --eval '(push (truename (uiop:getenv "SCRIPT_DIR")) asdf:*central-registry*)' --eval '(ql:quickload :opencortex/tui)' --eval '(opencortex.tui:main)'
;;
cli)
if ! nc -z $TARGET_HOST $TARGET_PORT 2>/dev/null; then
echo -e "Brain is offline. Awakening..."
"$SCRIPT_DIR/opencortex.sh" --boot > "$SCRIPT_DIR/brain.log" 2>&1 &
for i in {1..15}; do
sleep 2
if nc -z $TARGET_HOST $TARGET_PORT 2>/dev/null; then break; fi
echo -n "."
done
echo ""
fi
if command_exists socat; then
exec socat - TCP:$TARGET_HOST:$TARGET_PORT
else
exec nc $TARGET_HOST $TARGET_PORT
fi
;;
*)
echo -e "Unknown command: $COMMAND"
echo "Available commands: setup, boot, tui, cli"
exit 1
;;
esac
#+end_src
** Metabolic Docker Infrastructure (Dockerfile)
#+begin_src dockerfile :tangle ../Dockerfile
FROM debian:bullseye-slim
ENV DEBIAN_FRONTEND=noninteractive
RUN apt-get update && apt-get install -y \
sbcl \
emacs-nox \
curl \
git \
socat \
netcat-openbsd \
libssl-dev \
libncurses5-dev \
libffi-dev \
zlib1g-dev \
libsqlite3-dev \
&& rm -rf /var/lib/apt/lists/*
# Install Quicklisp
RUN curl -O https://beta.quicklisp.org/quicklisp.lisp \
&& sbcl --non-interactive --load quicklisp.lisp --eval "(quicklisp-quickstart:install)" --eval "(ql-util:without-prompting (ql:add-to-init-file))" \
&& rm quicklisp.lisp
WORKDIR /app
COPY . .
# Initialize system in non-interactive mode
RUN mkdir -p /root/memex && ./opencortex.sh setup --non-interactive
EXPOSE 9105
CMD ["./opencortex.sh", "boot"]
#+end_src

325
harness/skills.org Normal file
View File

@@ -0,0 +1,325 @@
#+TITLE: The Skill Engine (skills.lisp)
#+AUTHOR: Amr
#+FILETAGS: :harness:skills:
#+STARTUP: content
* 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.
** Global Skill Registry
#+begin_src lisp :tangle ../src/skills.lisp
(in-package :opencortex)
(defun COSINE-SIMILARITY (v1 v2) 1.0) ; Stub
(defun VAULT-MASK-STRING (s) "[MASKED]") ; Stub
(defvar *VAULT-MEMORY* (make-hash-table :test 'equal))
(defstruct skill name priority dependencies trigger-fn probabilistic-prompt deterministic-fn)
(defvar *skill-catalog* (make-hash-table :test 'equal)
"A stateful tracking table for all skill files discovered in the environment.")
(defstruct skill-entry
filename
(status :discovered) ;; :discovered, :loading, :ready, :failed
error-log
(load-time 0))
(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)))
(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
** Skill File Analysis (parse-skill-metadata)
#+begin_src lisp :tangle ../src/skills.lisp
(defun parse-skill-metadata (filepath)
"Extracts ID and DEPENDS_ON tags using robust regex scanning."
(let ((dependencies nil)
(id nil)
(content (uiop:read-file-string filepath)))
;; Extract ID
(multiple-value-bind (match regs)
(ppcre:scan-to-strings "(?im:^:ID:\\s*([^\\s\\r\\n]+))" content)
(when match (setf id (aref regs 0))))
;; Extract all DEPENDS_ON lines
(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
** Dependency Resolution (topological-sort-skills)
#+begin_src lisp :tangle ../src/skills.lisp
(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
(defun validate-lisp-syntax (code-string)
"Checks if a string contains valid, readable Common Lisp forms."
(handler-case
(let ((*read-eval* nil))
(with-input-from-string (stream (format nil "(progn ~a)" code-string))
(loop for form = (read stream nil :eof) until (eq form :eof))
(values t nil)))
(error (c) (values nil (format nil "~a" c)))))
(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
(let* ((content (uiop:read-file-string filepath))
(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)
"Loads a skill Org file with a hard execution timeout."
(let* ((finished nil)
(thread (bt:make-thread (lambda ()
(if (load-skill-from-org filepath)
(setf finished t)
(setf finished :error)))
:name (format nil "loader-~a" (pathname-name filepath))))
(start-time (get-internal-real-time))
(timeout-units (truncate (* timeout-seconds internal-time-units-per-second))))
(loop
(when (eq finished t) (return :success))
(when (eq finished :error) (return :error))
(unless (bt:thread-alive-p thread) (return :error))
(when (> (- (get-internal-real-time) start-time) timeout-units)
(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
** Initializing All Skills (initialize-all-skills)
#+begin_src lisp :tangle ../src/skills.lisp
(defun initialize-all-skills ()
"Scans the directory defined by SKILLS_DIR and hot-loads skills using topological order."
(let* ((env-path (uiop:getenv "SKILLS_DIR"))
(skills-dir-str (or env-path (namestring (merge-pathnames "notes/" (user-homedir-pathname)))))
(resolved-path (context-resolve-path skills-dir-str))
(skills-dir (if resolved-path (uiop:ensure-directory-pathname resolved-path) nil)))
(unless (and skills-dir (uiop:directory-exists-p skills-dir))
(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
** Toolbelt Prompt Generation (generate-tool-belt-prompt)
#+begin_src lisp :tangle ../src/skills.lisp
(defun generate-tool-belt-prompt ()
"Aggregates all registered cognitive tools into a descriptive prompt."
(let ((output (format nil "AVAILABLE TOOLS:
You can call tools by returning a Lisp plist: (:target :tool :action :call :tool <name> :args (...))
EXAMPLES:
(:target :tool :action :call :tool \"eval\" :args (:code \"(+ 1 1)\"))
(:target :tool :action :call :tool \"grep-search\" :args (:pattern \"autonomousty\"))
(:target :tool :action :call :tool \"shell\" :args (:cmd \"ls -la\"))
---
" )))
(maphash (lambda (name tool)
(setf output (concatenate 'string output
(format nil "- ~a: ~a~% Parameters: ~s~%~%"
name
(cognitive-tool-description tool)
(cognitive-tool-parameters tool)))))
*cognitive-tools*)
output))
#+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

174
harness/tui-client.org Normal file
View File

@@ -0,0 +1,174 @@
:PROPERTIES:
:ID: tui-client-spec
:CREATED: [2026-04-17 Fri 11:00]
:END:
#+TITLE: OpenCortex TUI Client (Standalone)
#+STARTUP: content
#+FILETAGS: :tui:ux:client:
* Overview
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
#+begin_src lisp :tangle ../src/tui-client.lisp
(in-package :cl-user)
(defpackage :opencortex.tui
(:use :cl :croatoan)
(:export :main))
(in-package :opencortex.tui)
(defvar *daemon-host* "127.0.0.1")
(defvar *daemon-port* 9105)
(defvar *socket* nil)
(defvar *stream* nil)
(defvar *chat-history* (list))
(defvar *status-text* "Connecting...")
(defvar *input-buffer* (make-array 0 :element-type 'char :fill-pointer 0 :adjustable t))
(defvar *is-running* t)
(defvar *queue-lock* (bt:make-lock))
(defvar *incoming-msgs* nil)
(defun enqueue-msg (msg)
(bt:with-lock-held (*queue-lock*)
(push msg *incoming-msgs*)))
(defun dequeue-msgs ()
(bt:with-lock-held (*queue-lock*)
(let ((msgs (nreverse *incoming-msgs*)))
(setf *incoming-msgs* nil)
msgs)))
(defun clean-keywords (msg)
(if (listp msg)
(let ((clean nil))
(loop for (k v) on msg by #'cddr
do (push (intern (string k) :keyword) clean)
(push v clean))
(nreverse clean))
msg))
(defun format-payload (payload)
"Extracts human-readable text from a protocol payload, handling nested tool calls."
(let* ((action (getf payload :ACTION))
(text (getf payload :TEXT))
(msg (getf payload :MESSAGE))
(tool (getf payload :TOOL))
(prompt (getf payload :PROMPT))
(args (getf payload :ARGS))
(result (getf payload :RESULT)))
(cond (text text)
(msg msg)
((eq action :MESSAGE) (getf payload :TEXT))
((and tool prompt) (format nil "THOUGHT [~a]: ~a" tool prompt))
((and tool args)
(let ((inner-prompt (or (getf args :PROMPT) (getf args :TEXT))))
(if inner-prompt
(format nil "THOUGHT [~a]: ~a" tool inner-prompt)
(format nil "CALL [~a] (ARGS: ~s)" tool args))))
(result (format nil "RESULT: ~a" result))
(t (format nil "~s" payload)))))
(defun listen-thread ()
(loop while *is-running* do
(handler-case
(when (and *stream* (open-stream-p *stream*))
(let ((raw-msg (opencortex:read-framed-message *stream*)))
(unless (member raw-msg '(:eof :error))
(let* ((msg (clean-keywords raw-msg))
(type (or (getf msg :TYPE) (getf msg :type)))
(payload (or (getf msg :PAYLOAD) (getf msg :payload))))
(cond ((and (listp msg) (eq type :EVENT))
(let ((action (or (getf payload :ACTION) (getf payload :action)))
(text (or (getf payload :TEXT) (getf payload :text) (getf payload :MESSAGE) (getf payload :message))))
(cond ((eq action :handshake) (setf *status-text* "Ready"))
(text (enqueue-msg (format nil "SYSTEM: ~a" text))))))
((and (listp msg) (eq type :STATUS))
(setf *status-text* (format nil "[Scribe: ~a] [Gardener: ~a]"
(or (getf msg :SCRIBE) (getf msg :scribe))
(or (getf msg :GARDENER) (getf msg :gardener)))))
((and (listp msg) (member type '(:REQUEST :RESPONSE :LOG)))
(let ((formatted (format-payload payload)))
(when formatted (enqueue-msg formatted))))
((and (listp msg) (eq type :EVENT) (eq (getf payload :SENSOR) :TOOL-OUTPUT))
(let ((formatted (format-payload payload)))
(when formatted (enqueue-msg formatted))))
(t (harness-log "TUI: Ignored unknown type ~a" type)))))
(when (eq raw-msg :eof) (setf *is-running* nil))
(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)))
(sleep 0.05)))
(defun main ()
(handler-case
(setf *socket* (usocket:socket-connect *daemon-host* *daemon-port*))
(error (e) (format t "Error connecting: ~a~%" e) (return-from main)))
(setf *stream* (usocket:socket-stream *socket*))
(bt:make-thread #'listen-thread :name "tui-listener")
(unwind-protect
(with-screen (scr :input-echoing nil :input-blocking nil :enable-colors t :cursor-visible t)
(let* ((h (height scr))
(w (width scr))
(chat-win (make-instance 'window :height (- h 2) :width w :position (list 0 0)))
(status-win (make-instance 'window :height 1 :width w :position (list (- h 2) 0)))
(input-win (make-instance 'window :height 1 :width w :position (list (- h 1) 0)))
(last-status nil))
(setf (function-keys-enabled-p input-win) t)
(setf (input-blocking input-win) nil)
(loop while *is-running* do
;; 1. Handle incoming messages
(let ((new-msgs (dequeue-msgs)))
(when new-msgs
(dolist (msg new-msgs)
(push msg *chat-history*)
(setf *chat-history* (subseq *chat-history* 0 (min (length *chat-history*) 500))))
(clear chat-win)
(let ((line-num 0))
(dolist (m (reverse (subseq *chat-history* 0 (min (length *chat-history*) (- h 3)))))
(add-string chat-win m :y line-num :x 0)
(incf line-num)))
(refresh chat-win)))
;; 2. Render Status Bar ONLY if changed
(unless (equal *status-text* last-status)
(clear status-win)
(add-string status-win *status-text* :attributes '(:reverse))
(refresh status-win)
(setf last-status *status-text*))
;; 3. Handle Keyboard Input
(let* ((event (get-wide-event input-win))
(ch (and event (typep event 'event) (event-key event))))
(when ch
(cond
((or (eq ch #\Newline) (eq ch #\Return))
(let ((cmd (coerce *input-buffer* 'string)))
(setf (fill-pointer *input-buffer*) 0)
(when (> (length cmd) 0)
;; Local Echo
(enqueue-msg (concatenate 'string "> " cmd))
;; Send to Brain
(let ((framed (opencortex:frame-message (list :TYPE :EVENT
:META (list :SOURCE :tui :SESSION-ID "default")
:PAYLOAD (list :SENSOR :user-input :TEXT cmd)))))
(format *stream* "~a" framed)
(finish-output *stream*)))
(when (string= cmd "/exit") (setf *is-running* nil))))
((or (eq ch :backspace) (eq ch #\Backspace) (eq ch #\Rubout) (eq ch #\Del))
(when (> (length *input-buffer*) 0)
(decf (fill-pointer *input-buffer*))))
((characterp ch)
(vector-push-extend ch *input-buffer*))))
(clear input-win)
(add-string input-win (concatenate 'string "> " (coerce *input-buffer* 'string)))
(move input-win 0 (+ 2 (length *input-buffer*)))
(refresh input-win))
(sleep 0.02))))
(setf *is-running* nil)
(when *socket* (usocket:socket-close *socket*))))
#+end_src