fix(v0.2.0): finalize structural integrity and clean boot
Some checks failed
Deploy-Agent-V15-Stdin / JOB-V15-STDIN (push) Failing after 2s

- Fixed memory.org source blocks to ensure persistence functions are tangled.
- Improved extract-tangle-target to handle complex Elisp expressions.
- Corrected opencortex.sh initialization paths to prevent setup loops.
- Reordered variable definitions in policy and standards skills to eliminate forward-reference warnings.
This commit is contained in:
2026-04-27 18:54:18 -04:00
parent 75b7d5e710
commit 2e8e79a193
31 changed files with 390 additions and 459 deletions

View File

@@ -1,3 +1,4 @@
#+PROPERTY: header-args:lisp :tangle (expand-file-name "act.lisp" (concat (or (getenv "INSTALL_DIR") ".") "/harness"))
#+TITLE: Stage 3: Act (act.lisp)
#+AUTHOR: Amr
#+FILETAGS: :harness:act:
@@ -35,7 +36,7 @@ Example feedback chain:
* Package Context
#+begin_src lisp :tangle (expand-file-name "act.lisp" (concat (or (getenv "INSTALL_DIR") ".") "/harness"))
#+begin_src lisp
(in-package :opencortex)
#+end_src
@@ -43,7 +44,7 @@ Example feedback chain:
** Actuator Registry Variables
#+begin_src lisp :tangle (expand-file-name "act.lisp" (concat (or (getenv "INSTALL_DIR") ".") "/harness"))
#+begin_src lisp
(defvar *default-actuator* :cli
"The actuator used when no explicit target is specified.
Override with DEFAULT_ACTUATOR environment variable.")
@@ -55,7 +56,7 @@ Example feedback chain:
** initialize-actuators: System Bootstrap
#+begin_src lisp :tangle (expand-file-name "act.lisp" (concat (or (getenv "INSTALL_DIR") ".") "/harness"))
#+begin_src lisp
(defun initialize-actuators ()
"Load actuator configuration from environment and register core actuators.
@@ -102,7 +103,7 @@ Example feedback chain:
** dispatch-action: The Router
#+begin_src lisp :tangle (expand-file-name "act.lisp" (concat (or (getenv "INSTALL_DIR") ".") "/harness"))
#+begin_src lisp
(defun dispatch-action (action context)
"Route an approved action to its registered actuator.
@@ -149,7 +150,7 @@ Example feedback chain:
** execute-system-action: Internal Commands
#+begin_src lisp :tangle (expand-file-name "act.lisp" (concat (or (getenv "INSTALL_DIR") ".") "/harness"))
#+begin_src lisp
(defun execute-system-action (action context)
"Execute internal harness commands.
@@ -198,7 +199,7 @@ Example feedback chain:
** execute-tool-action: Cognitive Tool Execution
#+begin_src lisp :tangle (expand-file-name "act.lisp" (concat (or (getenv "INSTALL_DIR") ".") "/harness"))
#+begin_src lisp
(defun execute-tool-action (action context)
"Execute a registered cognitive tool.
@@ -267,7 +268,7 @@ Example feedback chain:
** format-tool-result: Human-Readable Output
#+begin_src lisp :tangle (expand-file-name "act.lisp" (concat (or (getenv "INSTALL_DIR") ".") "/harness"))
#+begin_src lisp
(defun format-tool-result (tool-name result)
"Format a tool result for human-readable display.
@@ -295,7 +296,7 @@ Example feedback chain:
** act-gate: Final Pipeline Stage
#+begin_src lisp :tangle (expand-file-name "act.lisp" (concat (or (getenv "INSTALL_DIR") ".") "/harness"))
#+begin_src lisp
(defun act-gate (signal)
"Final stage of the metabolic pipeline: Actuation.

View File

@@ -1,3 +1,4 @@
#+PROPERTY: header-args:lisp :tangle (expand-file-name "communication.lisp" (concat (or (getenv "INSTALL_DIR") ".") "/harness"))
#+TITLE: Communication Protocol (communication.lisp)
#+AUTHOR: Amr
#+FILETAGS: :harness:protocol:
@@ -10,7 +11,7 @@ The ~communication.lisp~ module defines the low-level transport and framing logi
* Implementation (communication.lisp)
#+begin_src lisp :tangle (expand-file-name "communication.lisp" (concat (or (getenv "INSTALL_DIR") ".") "/harness"))
#+begin_src lisp
(in-package :opencortex)
(defun proto-get (plist key)
@@ -21,7 +22,7 @@ The ~communication.lisp~ module defines the low-level transport and framing logi
(or (getf plist up) (getf plist dn))))
#+end_src
#+begin_src lisp :tangle (expand-file-name "communication.lisp" (concat (or (getenv "INSTALL_DIR") ".") "/harness"))
#+begin_src lisp
(in-package :opencortex)
(defvar *actuator-registry* (make-hash-table :test 'equalp)
@@ -128,7 +129,7 @@ The validator ensures that incoming messages adhere to the strict property list
** Message Framing (communication.lisp)
Frames a message with a hex length prefix and ensures all data is serializable.
#+begin_src lisp :tangle (expand-file-name "communication.lisp" (concat (or (getenv "INSTALL_DIR") ".") "/harness"))
#+begin_src lisp
(defun sanitize-protocol-message (msg)
"Recursively strips non-serializable objects from a protocol plist."
(if (and msg (listp msg))

View File

@@ -1,3 +1,4 @@
#+PROPERTY: header-args:lisp :tangle (expand-file-name "context.lisp" (concat (or (getenv "INSTALL_DIR") ".") "/harness"))
#+TITLE: Peripheral Vision (context.lisp)
#+AUTHOR: Amr
#+FILETAGS: :harness:context:
@@ -37,14 +38,14 @@ The ~context.lisp~ module provides the deterministic functional layer for queryi
** Package Context
We begin by ensuring we are executing within the correct isolated package namespace.
#+begin_src lisp :tangle (expand-file-name "context.lisp" (concat (or (getenv "INSTALL_DIR") ".") "/harness"))
#+begin_src 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 (expand-file-name "context.lisp" (concat (or (getenv "INSTALL_DIR") ".") "/harness"))
#+begin_src lisp
(defun context-query-store (&key tag todo-state type)
"Filters the Memory based on tags, todo states, or types."
(let ((results nil))
@@ -62,7 +63,7 @@ A generalized filter for the Memory. This function allows skills to perform high
** 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 (expand-file-name "context.lisp" (concat (or (getenv "INSTALL_DIR") ".") "/harness"))
#+begin_src 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"))
@@ -72,7 +73,7 @@ Identifies headlines tagged with ~project~ that have not yet reached a terminal
** 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 (expand-file-name "context.lisp" (concat (or (getenv "INSTALL_DIR") ".") "/harness"))
#+begin_src lisp
(defun context-get-recent-completed-tasks ()
"Retrieves recently finished tasks from the store."
(context-query-store :todo-state "DONE" :type :HEADLINE))
@@ -81,7 +82,7 @@ Retrieves a list of tasks that have reached the terminal ~DONE~ state. This is u
** 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 (expand-file-name "context.lisp" (concat (or (getenv "INSTALL_DIR") ".") "/harness"))
#+begin_src lisp
(defun context-list-all-skills ()
"Provides a sorted overview of currently loaded system capabilities."
(let ((results nil))
@@ -95,7 +96,7 @@ Provides a sorted list of all currently loaded skills. In a "Self-Writing" envir
** 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 (expand-file-name "context.lisp" (concat (or (getenv "INSTALL_DIR") ".") "/harness"))
#+begin_src 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))
@@ -108,7 +109,7 @@ Reads the raw literate Org source of a specific skill. This is a foundational ca
** 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 (expand-file-name "context.lisp" (concat (or (getenv "INSTALL_DIR") ".") "/harness"))
#+begin_src 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)))
@@ -128,7 +129,7 @@ It implements the following deterministic logic:
The semantic threshold is externalized to `CONTEXT_SEMANTIC_THRESHOLD`.
#+begin_src lisp :tangle (expand-file-name "context.lisp" (concat (or (getenv "INSTALL_DIR") ".") "/harness"))
#+begin_src 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))
@@ -177,7 +178,7 @@ The semantic threshold is externalized to `CONTEXT_SEMANTIC_THRESHOLD`.
** 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 (expand-file-name "context.lisp" (concat (or (getenv "INSTALL_DIR") ".") "/harness"))
#+begin_src lisp
(defun context-resolve-path (path-string)
"Expands environment variables and strips literal quotes from a path string."
(let ((path (if (stringp path-string)
@@ -196,7 +197,7 @@ A utility function that expands environment variables (like ~$HOME~ or ~$MEMEX_R
** 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 (expand-file-name "context.lisp" (concat (or (getenv "INSTALL_DIR") ".") "/harness"))
#+begin_src 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)

View File

@@ -1,3 +1,4 @@
#+PROPERTY: header-args:lisp :tangle (expand-file-name "loop.lisp" (concat (or (getenv "INSTALL_DIR") ".") "/harness"))
#+TITLE: The Metabolic Loop (loop.lisp)
#+AUTHOR: Amr
#+FILETAGS: :harness:loop:
@@ -67,7 +68,7 @@ The loop operates in a multi-threaded environment:
* Package and Thread-Safe Variables
#+begin_src lisp :tangle (expand-file-name "loop.lisp" (concat (or (getenv "INSTALL_DIR") ".") "/harness"))
#+begin_src lisp
(in-package :opencortex)
(defvar *interrupt-flag* nil
@@ -90,7 +91,7 @@ This function implements the Perceive-Reason-Act pipeline. It processes a signal
The depth counter prevents infinite recursion—a signal that generates another signal that generates another, etc. By limiting to depth 10, we ensure the system eventually converges or gracefully terminates.
#+begin_src lisp :tangle (expand-file-name "loop.lisp" (concat (or (getenv "INSTALL_DIR") ".") "/harness"))
#+begin_src lisp
(defun process-signal (signal)
"The entry point to the Metabolic Pipeline: Perceive -> Reason -> Act.
@@ -184,7 +185,7 @@ The heartbeat thread ensures the agent remains alive even without external input
** Heartbeat Configuration Variables
#+begin_src lisp :tangle (expand-file-name "loop.lisp" (concat (or (getenv "INSTALL_DIR") ".") "/harness"))
#+begin_src lisp
(defvar *auto-save-interval* 300
"Interval in seconds between automatic memory saves.
Defaults to 300 seconds (5 minutes). Set via MEMORY_AUTO_SAVE_INTERVAL env var.")
@@ -195,7 +196,7 @@ The heartbeat thread ensures the agent remains alive even without external input
** start-heartbeat: The Pulsing Heart
#+begin_src lisp :tangle (expand-file-name "loop.lisp" (concat (or (getenv "INSTALL_DIR") ".") "/harness"))
#+begin_src lisp
(defun start-heartbeat ()
"Starts the background heartbeat thread.
@@ -241,7 +242,7 @@ The heartbeat thread ensures the agent remains alive even without external input
** Shutdown Configuration
#+begin_src lisp :tangle (expand-file-name "loop.lisp" (concat (or (getenv "INSTALL_DIR") ".") "/harness"))
#+begin_src lisp
(defvar *shutdown-save-enabled* t
"When T, save memory to disk on graceful shutdown.
Disable for testing or when memory persistence is handled externally.")
@@ -258,7 +259,7 @@ The main function orchestrates system startup:
5. Register SIGINT handler for graceful Ctrl+C shutdown
6. Enter idle loop (sleeping in 1-hour increments)
#+begin_src lisp :tangle (expand-file-name "loop.lisp" (concat (or (getenv "INSTALL_DIR") ".") "/harness"))
#+begin_src lisp
(defun main ()
"Entry point for OpenCortex. Initializes the system and enters idle loop.

View File

@@ -1,3 +1,4 @@
#+PROPERTY: header-args:lisp :tangle (expand-file-name "opencortex.asd" (concat (or (getenv "INSTALL_DIR") ".") "/harness"))
#+TITLE: Manifest (opencortex.asd)
#+AUTHOR: Amr
#+FILETAGS: :harness:system:
@@ -79,7 +80,7 @@ The testing system (~:opencortex/tests~) is separate from the production system
** Main Harness System
#+begin_src lisp :tangle (expand-file-name "opencortex.asd" (concat (or (getenv "INSTALL_DIR") ".") "/harness"))
#+begin_src lisp
(defsystem :opencortex
:name "opencortex"
:author "Amr"
@@ -119,7 +120,7 @@ The testing system (~:opencortex/tests~) is separate from the production system
** Test System
#+begin_src lisp :tangle (expand-file-name "opencortex.asd" (concat (or (getenv "INSTALL_DIR") ".") "/harness"))
#+begin_src lisp
(defsystem :opencortex/tests
:depends-on (:opencortex ; The harness we're testing
:fiveam) ; Testing framework
@@ -154,7 +155,7 @@ The testing system (~:opencortex/tests~) is separate from the production system
** TUI Client System
#+begin_src lisp :tangle (expand-file-name "opencortex.asd" (concat (or (getenv "INSTALL_DIR") ".") "/harness"))
#+begin_src lisp
(defsystem :opencortex/tui
:depends-on (:opencortex ; The daemon we're connecting to
:croatoan ; Terminal UI library

View File

@@ -148,63 +148,8 @@ Restores the state of the Memex from one of the previous snapshots.
(harness-log "MEMORY ERROR - Snapshot ~a not found." index))))
#+end_src
* Test Suite
These tests verify the Memory system. Run with:
~(fiveam:run! 'memory-suite)~
#+begin_src lisp :tangle (expand-file-name "memory-tests.lisp" (concat (or (getenv "INSTALL_DIR") ".") "/tests"))
(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
"Verify identical ASTs produce identical Merkle hashes."
(let* ((ast1 '(: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 ast1)))
(let ((hash2 (org-object-hash (lookup-object id2))))
(is (equal hash1 hash2))))))))
(test history-store-immutability
"Verify that *history-store* retains old versions."
(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))
(hash-v2 (org-object-hash (lookup-object id-v2))))
(is (equal (org-object-hash (lookup-object "test-node")) hash-v2))
(is (not (null (gethash hash-v1 *history-store*)))
(is (not (null (gethash hash-v2 *history-store*))))))
(test cow-snapshot-and-rollback
"Verify that lightweight snapshots restore previous pointer states."
(clrhash *memory*)
(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))))
(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))))
** Disk Persistence (save-memory / load-memory)
Essential for surviving crashes. Saves the in-memory hash tables to disk and loads them back on restart. The path is controlled by the `MEMORY_SNAPSHOT_PATH` environment variable.
Essential for surviving crashes. Saves the in-memory hash tables to disk and loads them back on restart.
#+begin_src lisp :tangle (expand-file-name "memory.lisp" (concat (or (getenv "INSTALL_DIR") ".") "/harness"))
(defvar *memory-snapshot-path* nil
@@ -259,8 +204,6 @@ Reconstitutes alists into hash tables."
** Semantic Search (get-embedding, semantic-search)
Support for vector embeddings via Ollama and semantic search with cosine similarity.
The vector slot on org-objects enables semantic recall - searching memory by meaning rather than just keywords. Embeddings are generated on ingest when the :EMBED property is set to "t", and cached locally to avoid redundant API calls.
#+begin_src lisp :tangle (expand-file-name "memory.lisp" (concat (or (getenv "INSTALL_DIR") ".") "/harness"))
(defvar *embedding-cache* (make-hash-table :test 'equal)
"Cache for embeddings to avoid redundant API calls.")
@@ -307,7 +250,10 @@ Returns up to LIMIT objects with similarity >= MIN-SIMILARITY, sorted by similar
*memory*)
(setf results (sort results #'> :key (lambda (r) (getf r :similarity))))
(subseq results 0 (min limit (length results)))))
#+end_src
** Cognitive Tool: Semantic Search
#+begin_src lisp :tangle (expand-file-name "memory.lisp" (concat (or (getenv "INSTALL_DIR") ".") "/harness"))
(def-cognitive-tool :semantic-search
"Searches memory for objects semantically similar to a query."
((:query :type :string :description "The search query.")
@@ -317,29 +263,27 @@ Returns up to LIMIT objects with similarity >= MIN-SIMILARITY, sorted by similar
(semantic-search (getf args :query)
:limit (or (getf args :limit) 10)
:min-similarity (or (getf args :min-similarity) 0.5))))
#+end_src
** Cognitive Tool: Generate Embeddings
Provided for the Probabilistic Engine to invoke embedding generation on demand.
#+begin_src lisp :tangle (expand-file-name "memory.lisp" (concat (or (getenv "INSTALL_DIR") ".") "/harness"))
(def-cognitive-tool :generate-embeddings
"Generates vector embeddings for given text via the configured embedding backend (Ollama)."
((:texts :type :list :description "List of text strings to embed."))
:body (lambda (args)
(let ((texts (getf args :texts)))
(unless (and texts (listp texts))
(return-from generate-embeddings
(list :status :error :message ":texts must be a list of strings.")))
(let ((results nil) (errors nil))
(dolist (text texts)
(let ((vec (get-embedding text)))
(if vec
(push (list :text text :vector vec) results)
(push text errors))))
(list :status (if errors :partial :success)
:embeddings (nreverse results)
:failed (when errors (nreverse errors))
:count (length results))))))
(if (not (and texts (listp texts)))
(list :status :error :message ":texts must be a list of strings.")
(let ((results nil) (errors nil))
(dolist (text texts)
(let ((vec (get-embedding text)))
(if vec
(push (list :text text :vector vec) results)
(push text errors))))
(list :status (if errors :partial :success)
:embeddings (nreverse results)
:failed (when errors (nreverse errors))
:count (length results)))))))
#+end_src
** Lookup Utilities
@@ -359,6 +303,7 @@ Basic functions for retrieving objects by ID or 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))
@@ -387,8 +332,7 @@ Utility functions for AST traversal and path resolution.
(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.
* Test Suite
#+begin_src lisp :tangle (expand-file-name "memory-tests.lisp" (concat (or (getenv "INSTALL_DIR") ".") "/tests"))
(defpackage :opencortex-memory-tests
@@ -398,93 +342,12 @@ Following the Engineering Standards, the Memory must be empirically verified thr
(in-package :opencortex-memory-tests)
(def-suite memory-suite
:description "Tests for the Merkle-Tree Memory.")
: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*)))))))
(test merkle-hash-consistency
"Verify that identical ASTs produce identical Merkle hashes."
"Verify identical ASTs produce identical Merkle hashes."
(let* ((ast1 '(:type :HEADLINE :properties (:ID "test-1" :TITLE "Node 1") :contents nil)))
(clrhash *memory*)
(let ((id1 (ingest-ast ast1)))
@@ -494,16 +357,33 @@ Following the Engineering Standards, the Memory must be empirically verified thr
(let ((hash2 (org-object-hash (lookup-object id2))))
(is (equal hash1 hash2))))))))
(test merkle-hash-cascading
"Verify that child changes propagate to parent hashes."
(let* ((ast-root '(: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)))
(root-hash (org-object-hash (lookup-object id-root))))
;; Now ingest a modified child - parent hash should change
(let* ((ast-mod '(:type :HEADLINE :properties (:ID "root" :TITLE "Root")
:contents ((:type :HEADLINE :properties (:ID "leaf" :TITLE "Changed") :contents nil))))
(id-mod (progn (clrhash *memory*) (ingest-ast ast-mod)))
(mod-hash (org-object-hash (lookup-object id-mod))))
(is (not (equal root-hash mod-hash))))))
(test history-store-immutability
"Verify that *history-store* retains old versions."
(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))
(hash-v2 (org-object-hash (lookup-object id-v2))))
(is (equal (org-object-hash (lookup-object "test-node")) hash-v2))
(is (not (null (gethash hash-v1 *history-store*))))
(is (not (null (gethash hash-v2 *history-store*)))))))
(test cow-snapshot-and-rollback
"Verify that lightweight snapshots restore previous pointer states."
(clrhash *memory*)
(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))))
(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))))
(is (equal (org-object-hash (lookup-object "cow-node")) hash-v2))
(rollback-memory 0)
(is (equal (org-object-hash (lookup-object "cow-node")) hash-v1)))))
#+end_src

View File

@@ -1,3 +1,4 @@
#+PROPERTY: header-args:lisp :tangle (expand-file-name "package.lisp" (concat (or (getenv "INSTALL_DIR") ".") "/harness"))
#+TITLE: System Interface (package.lisp)
#+AUTHOR: Amr
#+FILETAGS: :harness:interface:
@@ -9,7 +10,7 @@ The ~package.lisp~ file defines the public API of the ~opencortex~ harness. It s
** Public API Export
#+begin_src lisp :tangle (expand-file-name "package.lisp" (concat (or (getenv "INSTALL_DIR") ".") "/harness"))
#+begin_src lisp
(defpackage :opencortex
(:use :cl)
(:export
@@ -154,13 +155,13 @@ The ~package.lisp~ file defines the public API of the ~opencortex~ harness. It s
* Package Implementation
#+begin_src lisp :tangle (expand-file-name "package.lisp" (concat (or (getenv "INSTALL_DIR") ".") "/harness"))
#+begin_src lisp
(in-package :opencortex)
#+end_src
** Robust Plist Accessor
#+begin_src lisp :tangle (expand-file-name "package.lisp" (concat (or (getenv "INSTALL_DIR") ".") "/harness"))
#+begin_src lisp
(defun proto-get (plist key)
"Robustly retrieves a value from a plist, checking both uppercase and lowercase keyword versions."
(let* ((s (string key))
@@ -173,7 +174,7 @@ The ~package.lisp~ file defines the public API of the ~opencortex~ harness. It s
The harness maintains a thread-safe circular log buffer to provide context for debugging and neural reasoning.
#+begin_src lisp :tangle (expand-file-name "package.lisp" (concat (or (getenv "INSTALL_DIR") ".") "/harness"))
#+begin_src lisp
(defvar *system-logs* nil)
(defvar *logs-lock* (bordeaux-threads:make-lock "harness-logs-lock"))
(defvar *max-log-history* 100)
@@ -181,14 +182,14 @@ The harness maintains a thread-safe circular log buffer to provide context for d
** Skills Registry
#+begin_src lisp :tangle (expand-file-name "package.lisp" (concat (or (getenv "INSTALL_DIR") ".") "/harness"))
#+begin_src lisp
(defvar *skills-registry* (make-hash-table :test 'equal)
"Global registry of all loaded skills.")
#+end_src
** Skill Telemetry State
#+begin_src lisp :tangle (expand-file-name "package.lisp" (concat (or (getenv "INSTALL_DIR") ".") "/harness"))
#+begin_src lisp
(defvar *skill-telemetry* (make-hash-table :test 'equal))
(defvar *telemetry-lock* (bordeaux-threads:make-lock "harness-telemetry-lock"))
#+end_src
@@ -197,7 +198,7 @@ The harness maintains a thread-safe circular log buffer to provide context for d
The system tracks the performance and reliability of individual skills.
#+begin_src lisp :tangle (expand-file-name "package.lisp" (concat (or (getenv "INSTALL_DIR") ".") "/harness"))
#+begin_src 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
@@ -213,7 +214,7 @@ The system tracks the performance and reliability of individual skills.
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 (expand-file-name "package.lisp" (concat (or (getenv "INSTALL_DIR") ".") "/harness"))
#+begin_src lisp
(defvar *cognitive-tools* (make-hash-table :test 'equal))
(defstruct cognitive-tool
@@ -237,7 +238,7 @@ The Tool Registry allows the agent to interact with the physical world. Every to
Centralized logging function. It simultaneously writes to standard output and the in-memory circular buffer.
#+begin_src lisp :tangle (expand-file-name "package.lisp" (concat (or (getenv "INSTALL_DIR") ".") "/harness"))
#+begin_src lisp
(defun harness-log (msg &rest args)
"Centralized logging for the harness."
(let ((formatted-msg (apply #'format nil msg args)))

View File

@@ -1,3 +1,4 @@
#+PROPERTY: header-args:lisp :tangle (expand-file-name "perceive.lisp" (concat (or (getenv "INSTALL_DIR") ".") "/harness"))
#+TITLE: Stage 1: Perceive (perceive.lisp)
#+AUTHOR: Amr
#+FILETAGS: :harness:perceive:
@@ -53,7 +54,7 @@ Other sensors (heartbeats, interrupts) are processed synchronously to maintain o
* Package Context
#+begin_src lisp :tangle (expand-file-name "perceive.lisp" (concat (or (getenv "INSTALL_DIR") ".") "/harness"))
#+begin_src lisp
(in-package :opencortex)
#+end_src
@@ -61,7 +62,7 @@ Other sensors (heartbeats, interrupts) are processed synchronously to maintain o
** Async Sensor Registry
#+begin_src lisp :tangle (expand-file-name "perceive.lisp" (concat (or (getenv "INSTALL_DIR") ".") "/harness"))
#+begin_src lisp
(defvar *async-sensors* '(:chat-message :delegation :user-command)
"Sensors that are processed in dedicated threads.
@@ -74,7 +75,7 @@ Other sensors (heartbeats, interrupts) are processed synchronously to maintain o
** Foveal Focus State
#+begin_src lisp :tangle (expand-file-name "perceive.lisp" (concat (or (getenv "INSTALL_DIR") ".") "/harness"))
#+begin_src lisp
(defvar *foveal-focus-id* nil
"The Org ID of the node the user is currently interacting with.
@@ -89,7 +90,7 @@ Other sensors (heartbeats, interrupts) are processed synchronously to maintain o
** inject-stimulus: Entry Point
#+begin_src lisp :tangle (expand-file-name "perceive.lisp" (concat (or (getenv "INSTALL_DIR") ".") "/harness"))
#+begin_src lisp
(defun inject-stimulus (raw-message &key stream (depth 0))
"Inject a raw message into the signal processing pipeline.
@@ -146,7 +147,7 @@ Other sensors (heartbeats, interrupts) are processed synchronously to maintain o
** perceive-gate: Signal Normalization
#+begin_src lisp :tangle (expand-file-name "perceive.lisp" (concat (or (getenv "INSTALL_DIR") ".") "/harness"))
#+begin_src lisp
(defun perceive-gate (signal)
"Stage 1 of the metabolic pipeline: Normalize sensory input.

View File

@@ -1,3 +1,4 @@
#+PROPERTY: header-args:lisp :tangle (expand-file-name "reason.lisp" (concat (or (getenv "INSTALL_DIR") ".") "/harness"))
#+TITLE: Stage 2: Reason (reason.lisp)
#+AUTHOR: Amr
#+FILETAGS: :harness:reason:
@@ -33,7 +34,7 @@ This means the reasoning pipeline can generate, modify, and execute its own comm
* Package Context
#+begin_src lisp :tangle (expand-file-name "reason.lisp" (concat (or (getenv "INSTALL_DIR") ".") "/harness"))
#+begin_src lisp
(in-package :opencortex)
#+end_src
@@ -43,7 +44,7 @@ The probabilistic engine is responsible for all neural/LLM operations. It mainta
** Backend Registry Variables
#+begin_src lisp :tangle (expand-file-name "reason.lisp" (concat (or (getenv "INSTALL_DIR") ".") "/harness"))
#+begin_src lisp
(defvar *probabilistic-backends* (make-hash-table :test 'equal)
"Registry mapping provider keywords (:openrouter, :ollama) to their calling functions.")
@@ -60,7 +61,7 @@ The probabilistic engine is responsible for all neural/LLM operations. It mainta
** register-probabilistic-backend: Backend Registration
#+begin_src lisp :tangle (expand-file-name "reason.lisp" (concat (or (getenv "INSTALL_DIR") ".") "/harness"))
#+begin_src lisp
(defun register-probabilistic-backend (name fn)
"Register a neural provider backend.
@@ -79,7 +80,7 @@ The probabilistic engine is responsible for all neural/LLM operations. It mainta
** probabilistic-call: Cascade Dispatch
#+begin_src lisp :tangle (expand-file-name "reason.lisp" (concat (or (getenv "INSTALL_DIR") ".") "/harness"))
#+begin_src lisp
(defun probabilistic-call (prompt &key
(system-prompt "You are the Probabilistic engine.")
(cascade nil)
@@ -129,7 +130,7 @@ The `think` function is the heart of the probabilistic engine. It constructs a p
** strip-markdown: Clean LLM Output
#+begin_src lisp :tangle (expand-file-name "reason.lisp" (concat (or (getenv "INSTALL_DIR") ".") "/harness"))
#+begin_src lisp
(defun strip-markdown (text)
"Strip markdown formatting from LLM output.
@@ -152,7 +153,7 @@ The `think` function is the heart of the probabilistic engine. It constructs a p
** normalize-plist-keywords: Fix LLM Keyword Output
#+begin_src lisp :tangle (expand-file-name "reason.lisp" (concat (or (getenv "INSTALL_DIR") ".") "/harness"))
#+begin_src lisp
(defun normalize-plist-keywords (plist)
"Normalize all keys in a plist to keywords.
@@ -176,7 +177,7 @@ The `think` function is the heart of the probabilistic engine. It constructs a p
** think: Generate Action Proposal
#+begin_src lisp :tangle (expand-file-name "reason.lisp" (concat (or (getenv "INSTALL_DIR") ".") "/harness"))
#+begin_src lisp
(defun think (context)
"Generate a Lisp action proposal based on current context.
@@ -328,7 +329,7 @@ The deterministic engine runs all registered skills' verification functions. Thi
** deterministic-verify: Skill Chain Verification
#+begin_src lisp :tangle (expand-file-name "reason.lisp" (concat (or (getenv "INSTALL_DIR") ".") "/harness"))
#+begin_src lisp
(defun deterministic-verify (proposed-action context)
"Run all skill deterministic gates on a proposed action.
@@ -399,7 +400,7 @@ The deterministic engine runs all registered skills' verification functions. Thi
** reason-gate: The Stage Function
#+begin_src lisp :tangle (expand-file-name "reason.lisp" (concat (or (getenv "INSTALL_DIR") ".") "/harness"))
#+begin_src lisp
(defun reason-gate (signal)
"Stage 2 of the metabolic pipeline: Reason.

View File

@@ -1,3 +1,4 @@
#+PROPERTY: header-args:lisp :tangle (expand-file-name "skills.lisp" (concat (or (getenv "INSTALL_DIR") ".") "/harness"))
#+TITLE: The Skill Engine (skills.lisp)
#+AUTHOR: Amr
#+FILETAGS: :harness:skills:
@@ -61,7 +62,7 @@ flowchart LR
** Global Skill Registry
#+begin_src lisp :tangle (expand-file-name "skills.lisp" (concat (or (getenv "INSTALL_DIR") ".") "/harness"))
#+begin_src lisp
(in-package :opencortex)
(defun COSINE-SIMILARITY (v1 v2)
@@ -137,7 +138,7 @@ flowchart LR
#+end_src
** Skill File Analysis (parse-skill-metadata)
#+begin_src lisp :tangle (expand-file-name "skills.lisp" (concat (or (getenv "INSTALL_DIR") ".") "/harness"))
#+begin_src lisp
(defun parse-skill-metadata (filepath)
"Extracts ID and DEPENDS_ON tags from org file."
(let ((dependencies nil)
@@ -163,7 +164,7 @@ flowchart LR
#+end_src
** Dependency Resolution (topological-sort-skills)
#+begin_src lisp :tangle (expand-file-name "skills.lisp" (concat (or (getenv "INSTALL_DIR") ".") "/harness"))
#+begin_src 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"))
@@ -207,7 +208,7 @@ flowchart LR
#+end_src
** Jailed Loading (load-skill-from-org)
#+begin_src lisp :tangle (expand-file-name "skills.lisp" (concat (or (getenv "INSTALL_DIR") ".") "/harness"))
#+begin_src lisp
(defun validate-lisp-syntax (code-string)
"Checks if a string contains valid, readable Common Lisp forms.
Delegates to the Lisp Validator skill when available; falls back to a basic
@@ -227,15 +228,26 @@ reader check during early boot before the validator skill is loaded."
(values nil (or (getf result :reason) "Lisp Validator rejected code.")))))
(defun extract-tangle-target (line)
"Extracts the value of the :tangle header from an org src block line."
"Extracts the value of the :tangle header from an org src block line.
Handles both simple strings and parenthesized elisp expressions."
(let ((pos (search ":tangle" line)))
(when pos
(let* ((rest (subseq line (+ pos 7)))
(trimmed (string-trim '(#\Space #\Tab) rest))
(end (position #\Space trimmed)))
(if end
(subseq trimmed 0 end)
trimmed)))))
(let ((rest (string-trim '(#\Space #\Tab) (subseq line (+ pos 7)))))
(if (char= (char rest 0) #\()
;; It's an elisp expression, find the matching closing paren
(let ((balance 0)
(end nil))
(dotimes (i (length rest))
(let ((ch (char rest i)))
(cond ((char= ch #\() (incf balance))
((char= ch #\)) (decf balance)))
(when (and (> i 0) (= balance 0))
(setf end (1+ i))
(return-from extract-tangle-target (subseq rest 0 end)))))
rest)
;; It's a simple string, stop at next space
(let ((end (position #\Space rest)))
(if end (subseq rest 0 end) rest)))))))
(defun load-skill-from-org (filepath)
"Parses and evaluates Lisp blocks with :tangle directives from an Org file.
@@ -259,9 +271,8 @@ Only loads blocks that specify a .lisp tangle target, ignoring tests and example
((uiop:string-prefix-p "#+begin_src lisp" clean-line)
(setf in-lisp-block t)
(let ((tangle-target (extract-tangle-target clean-line)))
(if (and tangle-target
(not (search "tests/" tangle-target))
(not (search ":tangle no" clean-line)))
(if (or (and tangle-target (not (search "/tests" tangle-target)) (not (search ":tangle no" clean-line)))
(and (not tangle-target) (not (search ":tangle no" clean-line))))
(setf collect-this-block t)
(setf collect-this-block nil))))
@@ -359,7 +370,7 @@ Only loads blocks that specify a .lisp tangle target, ignoring tests and example
#+end_src
** Toolbelt Prompt Generation (generate-tool-belt-prompt)
#+begin_src lisp :tangle (expand-file-name "skills.lisp" (concat (or (getenv "INSTALL_DIR") ".") "/harness"))
#+begin_src lisp
(defun generate-tool-belt-prompt ()
"Aggregates all registered cognitive tools into a descriptive prompt."
(let ((output (format nil "AVAILABLE TOOLS:
@@ -386,7 +397,7 @@ EXAMPLES:
** The Default Tool Belt
*** The Eval Tool (Internal Inspection)
#+begin_src lisp :tangle (expand-file-name "skills.lisp" (concat (or (getenv "INSTALL_DIR") ".") "/harness"))
#+begin_src 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)
@@ -404,7 +415,7 @@ EXAMPLES:
#+end_src
*** The Grep Tool (File Discovery)
#+begin_src lisp :tangle (expand-file-name "skills.lisp" (concat (or (getenv "INSTALL_DIR") ".") "/harness"))
#+begin_src 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)"))
@@ -416,7 +427,7 @@ EXAMPLES:
#+end_src
*** The Shell Tool (Machine Actuation)
#+begin_src lisp :tangle (expand-file-name "skills.lisp" (concat (or (getenv "INSTALL_DIR") ".") "/harness"))
#+begin_src 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)
@@ -431,7 +442,7 @@ EXAMPLES:
#+end_src
*** The Reload-Skill Tool (Hot Reload)
#+begin_src lisp :tangle (expand-file-name "skills.lisp" (concat (or (getenv "INSTALL_DIR") ".") "/harness"))
#+begin_src lisp
(def-cognitive-tool :reload-skill "Reloads a skill from its Org-mode source file, recompiling into the live image without restarting the daemon."
((:skill :type :string :description "The skill name (e.g., \"org-skill-policy\") or full path to the .org file"))
:guard (lambda (args context)
@@ -467,7 +478,7 @@ EXAMPLES:
#+end_src
*** The File Read Tool (V 0.2.0 File I/O)
#+begin_src lisp :tangle (expand-file-name "skills.lisp" (concat (or (getenv "INSTALL_DIR") ".") "/harness"))
#+begin_src lisp
(def-cognitive-tool :read-file "Reads the contents of a file as a string."
((:file :type :string :description "The path to the file to read"))
:guard (lambda (args context)
@@ -486,7 +497,7 @@ EXAMPLES:
#+end_src
*** The File Write Tool (V 0.2.0 File I/O)
#+begin_src lisp :tangle (expand-file-name "skills.lisp" (concat (or (getenv "INSTALL_DIR") ".") "/harness"))
#+begin_src lisp
(def-cognitive-tool :write-file "Writes content to a file, creating it if it doesn't exist."
((:file :type :string :description "The path to the file to write")
(:content :type :string :description "The content to write")
@@ -519,7 +530,7 @@ EXAMPLES:
#+end_src
*** The String Replace Tool (V 0.2.0 File I/O)
#+begin_src lisp :tangle (expand-file-name "skills.lisp" (concat (or (getenv "INSTALL_DIR") ".") "/harness"))
#+begin_src lisp
(def-cognitive-tool :replace-string "Replaces occurrences of old-string with new-string in a file."
((:file :type :string :description "The path to the file")
(:old :type :string :description "The substring to find and replace")

View File

@@ -1,3 +1,4 @@
#+PROPERTY: header-args:lisp :tangle (expand-file-name "tui-client.lisp" (concat (or (getenv "INSTALL_DIR") ".") "/harness"))
:PROPERTIES:
:ID: tui-client-spec
:CREATED: [2026-04-17 Fri 11:00]
@@ -10,7 +11,7 @@
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 (expand-file-name "tui-client.lisp" (concat (or (getenv "INSTALL_DIR") ".") "/harness"))
#+begin_src lisp
(in-package :cl-user)
(defpackage :opencortex.tui
(:use :cl :croatoan)