amr/passepartout
1
0
Fork 0
Code Issues 15 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

fix(chaos): hard-inserted clean relative tangle headers in all core files

Browse Source
This commit is contained in:
Amr Gharbeia
2026-04-28 19:04:34 -04:00
parent 14ef0d2cb8
commit def2774c8f
24 changed files with 219 additions and 208 deletions
Download Patch File Download Diff File Expand all files Collapse all files

19
harness/act.org
View File

@@ -1,8 +1,9 @@
#+PROPERTY: header-args:lisp :tangle act.lisp
#+TITLE: Stage 3: Act (act.lisp)
#+AUTHOR: Agent
#+FILETAGS: :harness:act:
#+STARTUP: content
#+PROPERTY: header-args:lisp :tangle act.lisp
#+PROPERTY: header-args:lisp :tangle package.lisp
* Overview
The Act stage is where cognition meets reality. After the Probabilistic engine proposes and the Deterministic engine verifies, Act executes the approved action.
@@ -17,15 +18,15 @@ The Act stage is where cognition meets reality. After the Probabilistic engine p
** Actuator Configuration
#+begin_src lisp
(defvar *default-actuator* :cli
"The actuator used when no explicit target is specified.")
"The actuator used when no explicit target is specified.
(defvar *silent-actuators* '(:cli :system-message :emacs)
"List of actuators that don't generate tool-output feedback.")
"List of actuators that don't generate tool-output feedback.
(defun initialize-actuators ()
"Register core actuators and load configuration."
(let ((def (uiop:getenv "DEFAULT_ACTUATOR"))
(silent (uiop:getenv "SILENT_ACTUATORS")))
(let ((def (uiop:getenv "DEFAULT_ACTUATOR)
(silent (uiop:getenv "SILENT_ACTUATORS))
(when def
(setf *default-actuator* (intern (string-upcase def) :keyword)))
(when silent
@@ -139,7 +140,7 @@ The Act stage is where cognition meets reality. After the Probabilistic engine p
(verified (deterministic-verify approved signal)))
(if (and (listp verified) (member (getf verified :type) '(:LOG :EVENT)) (not (member original-type '(:LOG :EVENT))))
(progn
(harness-log "ACT BLOCKED: Action failed last-mile deterministic check.")
(harness-log "ACT BLOCKED: Action failed last-mile deterministic check.
(setf (getf signal :approved-action) nil)
(setf feedback verified))
(progn
@@ -165,20 +166,20 @@ The Act stage is where cognition meets reality. After the Probabilistic engine p
#+end_src
* Test Suite
#+begin_src lisp :tangle tests/pipeline-act-tests.lisp
#+begin_src lisp :tangle package.lisp
(defpackage :opencortex-pipeline-act-tests
(:use :cl :fiveam :opencortex)
(:export #:pipeline-act-suite))
(in-package :opencortex-pipeline-act-tests)
(def-suite pipeline-act-suite :description "Test suite for Act pipeline")
(def-suite pipeline-act-suite :description "Test suite for Act pipeline
(in-suite pipeline-act-suite)
(test test-act-gate-basic
"Verify that act-gate proceeds normally when no skill intercepts."
(clrhash opencortex::*skills-registry*)
(let* ((signal (list :type :EVENT :status nil :depth 0 :approved-action '(:target :cli :payload (:text "Hello"))))
(let* ((signal (list :type :EVENT :status nil :depth 0 :approved-action '(:target :cli :payload (:text "Hello)))
(result (act-gate signal)))
(is (eq :acted (getf signal :status)))
(is (null result))))

13
harness/communication.org
View File

@@ -1,8 +1,9 @@
#+PROPERTY: header-args:lisp :tangle communication.lisp
#+TITLE: Communication Protocol (communication.lisp)
#+AUTHOR: Agent
#+FILETAGS: :harness:protocol:
#+STARTUP: content
#+PROPERTY: header-args:lisp :tangle communication.lisp
#+PROPERTY: header-args:lisp :tangle package.lisp
* Overview
The ~communication.lisp~ module defines the low-level transport and framing logic for OpenCortex stimuli.
@@ -17,7 +18,7 @@ The ~communication.lisp~ module defines the low-level transport and framing logi
** Actuator Registry
#+begin_src lisp
(defvar *actuator-registry* (make-hash-table :test 'equalp)
"Global registry mapping target keywords to their physical actuator functions.")
"Global registry mapping target keywords to their physical actuator functions.
(defun register-actuator (name fn)
"Registers an actuator function. Actuators receive: (ACTION CONTEXT)."
@@ -78,12 +79,12 @@ The ~communication.lisp~ module defines the low-level transport and framing logi
#+end_src
** Structural Validation
#+begin_src lisp :tangle communication-validator.lisp
#+begin_src lisp :tangle package.lisp
(in-package :opencortex)
(defun validate-communication-protocol-schema (msg)
"Strict structural validation for incoming protocol messages."
(unless (listp msg) (error "Message must be a plist"))
(unless (listp msg) (error "Message must be a plist)
(let ((type (proto-get msg :type)))
(unless (member type '(:REQUEST :EVENT :RESPONSE :LOG :STATUS))
(error "Invalid message type '~a'" type))
@@ -91,13 +92,13 @@ The ~communication.lisp~ module defines the low-level transport and framing logi
#+end_src
* Test Suite
#+begin_src lisp :tangle communication-tests.lisp
#+begin_src lisp :tangle package.lisp
(defpackage :opencortex-communication-tests
(:use :cl :fiveam :opencortex)
(:export #:communication-protocol-suite))
(in-package :opencortex-communication-tests)
(def-suite communication-protocol-suite :description "Communication Protocol Suite")
(def-suite communication-protocol-suite :description "Communication Protocol Suite
(in-suite communication-protocol-suite)
(test test-framing

11
harness/context.org
View File

@@ -1,8 +1,9 @@
#+PROPERTY: header-args:lisp :tangle context.lisp
#+TITLE: Context API (context.lisp)
#+AUTHOR: Agent
#+FILETAGS: :harness:context:
#+STARTUP: content
#+PROPERTY: header-args:lisp :tangle context.lisp
#+PROPERTY: header-args:lisp :tangle package.lisp
* Overview
The *Context API* (Peripheral Vision) provides the opencortex with the ability to selectively prune and present its memory to the LLM. It implements a **Foveal-Peripheral model**, where the current task is shown in high detail (foveal), while the broader Memex structure is shown as a skeletal outline (peripheral).
@@ -34,7 +35,7 @@ The *Context API* (Peripheral Vision) provides the opencortex with the ability t
#+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"))
(remove-if (lambda (obj) (equal (getf (org-object-attributes obj) :TODO-STATE) "DONE)
(context-query-store :tag "project" :type :HEADLINE)))
#+end_src
@@ -62,7 +63,7 @@ The *Context API* (Peripheral Vision) provides the opencortex with the ability t
(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-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)))
@@ -72,7 +73,7 @@ The *Context API* (Peripheral Vision) provides the opencortex with the ability t
#+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)))
(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)))))
@@ -154,7 +155,7 @@ The *Context API* (Peripheral Vision) provides the opencortex with the ability t
* Test Suite
#+begin_src lisp :tangle context.lisp
#+begin_src lisp :tangle package.lisp
(defpackage :opencortex-peripheral-vision-tests
(:use :cl :fiveam :opencortex)
(:export #:vision-suite))

27
harness/doctor.org
View File

@@ -1,3 +1,4 @@
#+PROPERTY: header-args:lisp :tangle doctor.lisp
#+TITLE: System Diagnostic Doctor (doctor.org)
#+AUTHOR: Agent
#+FILETAGS: :harness:setup:diagnostic:
@@ -23,26 +24,26 @@ Common Lisp's `getenv` is strictly typed in SBCL. The Doctor must ensure that mi
* Phase B: Protocol (Success Criteria)
** Package Context
#+begin_src lisp :tangle doctor-tests.lisp" (concat (concat (or (getenv "INSTALL_DIR ". "/harness "/tests)
#+begin_src lisp :tangle package.lisp (concat (concat (or (getenv "INSTALL_DIR ". "/harness "/tests)
(defpackage :opencortex-doctor-tests
(:use :cl :fiveam :opencortex)
(:export #:doctor-suite))
#+end_src
#+begin_src lisp :tangle doctor-tests.lisp" (concat (concat (or (getenv "INSTALL_DIR ". "/harness "/tests)
#+begin_src lisp :tangle package.lisp (concat (concat (or (getenv "INSTALL_DIR ". "/harness "/tests)
(in-package :opencortex-doctor-tests)
#+end_src
#+begin_src lisp :tangle doctor-tests.lisp" (concat (concat (or (getenv "INSTALL_DIR ". "/harness "/tests)
#+begin_src lisp :tangle package.lisp (concat (concat (or (getenv "INSTALL_DIR ". "/harness "/tests)
(def-suite doctor-suite :description "Verification of the System Doctor diagnostic logic
#+end_src
#+begin_src lisp :tangle doctor-tests.lisp" (concat (concat (or (getenv "INSTALL_DIR ". "/harness "/tests)
#+begin_src lisp :tangle package.lisp (concat (concat (or (getenv "INSTALL_DIR ". "/harness "/tests)
(in-suite doctor-suite)
#+end_src
** Dependency Tests
#+begin_src lisp :tangle doctor-tests.lisp" (concat (concat (or (getenv "INSTALL_DIR ". "/harness "/tests)
#+begin_src lisp :tangle package.lisp (concat (concat (or (getenv "INSTALL_DIR ". "/harness "/tests)
(test test-dependency-check-fail
"Verify that missing binaries are correctly identified as failures."
(let ((opencortex::*doctor-required-binaries* '("non-existent-binary-123))
@@ -50,7 +51,7 @@ Common Lisp's `getenv` is strictly typed in SBCL. The Doctor must ensure that mi
#+end_src
** Environment Tests
#+begin_src lisp :tangle doctor-tests.lisp" (concat (concat (or (getenv "INSTALL_DIR ". "/harness "/tests)
#+begin_src lisp :tangle package.lisp (concat (concat (or (getenv "INSTALL_DIR ". "/harness "/tests)
(test test-env-validation-fail
"Verify that an invalid MEMEX_DIR triggers a critical failure."
(let ((old-m (getenv "MEMEX_DIR)
@@ -66,18 +67,18 @@ Common Lisp's `getenv` is strictly typed in SBCL. The Doctor must ensure that mi
* Phase C: Implementation (Build)
** Package Context
#+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/harness/doctor.lisp")" )
#+begin_src lisp :tangle package.lisp )
(in-package :opencortex)
#+end_src
** Global Configuration
#+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/harness/doctor.lisp")" )
#+begin_src lisp :tangle package.lisp )
(defvar *doctor-required-binaries* '("sbcl" "emacs" "git" "socat" "nc
"List of external binaries required for full system operation.
#+end_src
** Dependency Verification
#+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/harness/doctor.lisp")" )
#+begin_src lisp :tangle package.lisp )
(defun doctor-check-dependencies ()
"Verifies that required external binaries are available in the PATH via a shell probe."
(let ((all-ok t))
@@ -95,7 +96,7 @@ Common Lisp's `getenv` is strictly typed in SBCL. The Doctor must ensure that mi
#+end_src
** Environment & XDG Validation
#+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/harness/doctor.lisp")" )
#+begin_src lisp :tangle package.lisp )
(defun doctor-check-env ()
"Validates XDG directories and environment configuration against the POSIX standard."
(harness-log "DOCTOR: Checking XDG environment...
@@ -124,7 +125,7 @@ Common Lisp's `getenv` is strictly typed in SBCL. The Doctor must ensure that mi
#+end_src
** LLM Connectivity
#+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/harness/doctor.lisp")" )
#+begin_src lisp :tangle package.lisp )
(defun doctor-check-llm ()
"Tests connectivity to primary LLM providers. Non-critical fallback allowed."
(harness-log "DOCTOR: Checking LLM connectivity...
@@ -139,7 +140,7 @@ Common Lisp's `getenv` is strictly typed in SBCL. The Doctor must ensure that mi
#+end_src
** Orchestration
#+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/harness/doctor.lisp")" )
#+begin_src lisp :tangle package.lisp )
(defun doctor-run-all ()
"Executes the full diagnostic suite and returns T if system is healthy."
(harness-log "==================================================
@@ -159,7 +160,7 @@ Common Lisp's `getenv` is strictly typed in SBCL. The Doctor must ensure that mi
#+end_src
** CLI Entry Point
#+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/harness/doctor.lisp")" )
#+begin_src lisp :tangle package.lisp )
(defun doctor-main ()
"Entry point for the 'doctor' CLI command."
(if (doctor-run-all)

37
harness/loop.org
View File

@@ -1,8 +1,9 @@
#+PROPERTY: header-args:lisp :tangle loop.lisp
#+TITLE: The Metabolic Loop (loop.lisp)
#+AUTHOR: Agent
#+FILETAGS: :harness:loop:
#+STARTUP: content
#+PROPERTY: header-args:lisp :tangle loop.lisp
#+PROPERTY: header-args:lisp :tangle package.lisp
* Overview
The Metabolic Loop is the fundamental rhythm of OpenCortex: the continuous processing of signals from perception through cognition to action.
@@ -17,13 +18,13 @@ The Metabolic Loop is the fundamental rhythm of OpenCortex: the continuous proce
** Global Variables (Thread-Safe)
#+begin_src lisp
(defvar *interrupt-flag* nil
"Atomic flag set by signal handlers to trigger graceful shutdown.")
"Atomic flag set by signal handlers to trigger graceful shutdown.
(defvar *interrupt-lock* (bt:make-lock "harness-interrupt-lock")
"Mutex protecting *interrupt-flag* access.")
(defvar *interrupt-lock* (bt:make-lock "harness-interrupt-lock
"Mutex protecting *interrupt-flag* access.
(defvar *heartbeat-thread* nil
"Handle to the heartbeat thread.")
"Handle to the heartbeat thread.
#+end_src
** Core Engine (process-signal)
@@ -35,11 +36,11 @@ The Metabolic Loop is the fundamental rhythm of OpenCortex: the continuous proce
(let ((depth (getf current-signal :depth 0))
(meta (getf current-signal :meta)))
(when (> depth 10)
(harness-log "METABOLISM ERROR: Max recursion depth reached.")
(harness-log "METABOLISM ERROR: Max recursion depth reached.
(return nil))
(when (bt:with-lock-held (*interrupt-lock*) *interrupt-flag*)
(harness-log "METABOLISM: Interrupted by shutdown signal.")
(harness-log "METABOLISM: Interrupted by shutdown signal.
(return nil))
(handler-case
@@ -56,7 +57,7 @@ The Metabolic Loop is the fundamental rhythm of OpenCortex: the continuous proce
(let ((sensor (ignore-errors (getf (getf current-signal :payload) :sensor))))
(harness-log "METABOLISM CRASH [~a]: ~a" (or sensor :unknown) c)
(unless (member sensor '(:loop-error :tool-error :syntax-error))
(harness-log "CRITICAL ERROR: Initiating Micro-Rollback.")
(harness-log "CRITICAL ERROR: Initiating Micro-Rollback.
(rollback-memory 0))
(if (or (> depth 2) (member sensor '(:loop-error :tool-error)))
(setf current-signal nil)
@@ -72,8 +73,8 @@ The Metabolic Loop is the fundamental rhythm of OpenCortex: the continuous proce
(defun start-heartbeat ()
"Starts the background heartbeat thread."
(let ((interval (or (ignore-errors (parse-integer (uiop:getenv "HEARTBEAT_INTERVAL"))) 60))
(auto-save (or (ignore-errors (parse-integer (uiop:getenv "MEMORY_AUTO_SAVE_INTERVAL"))) *auto-save-interval*)))
(let ((interval (or (ignore-errors (parse-integer (uiop:getenv "HEARTBEAT_INTERVAL)) 60))
(auto-save (or (ignore-errors (parse-integer (uiop:getenv "MEMORY_AUTO_SAVE_INTERVAL)) *auto-save-interval*)))
(setf *auto-save-interval* auto-save)
(setf *heartbeat-save-counter* 0)
@@ -88,7 +89,7 @@ The Metabolic Loop is the fundamental rhythm of OpenCortex: the continuous proce
(save-memory-to-disk))
(inject-stimulus
(list :type :EVENT :payload (list :sensor :heartbeat :unix-time (get-universal-time))))))
:name "opencortex-heartbeat"))))
:name "opencortex-heartbeat)))
#+end_src
** Shutdown Flag
@@ -100,7 +101,7 @@ The Metabolic Loop is the fundamental rhythm of OpenCortex: the continuous proce
#+begin_src lisp
(defun main ()
"Entry point for OpenCortex. Initializes the system and enters idle loop."
(let* ((home (uiop:getenv "HOME"))
(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)))
@@ -114,28 +115,28 @@ The Metabolic Loop is the fundamental rhythm of OpenCortex: the continuous proce
(sb-sys:enable-interrupt sb-unix:sigint
(lambda (sig code scp)
(declare (ignore sig code scp))
(harness-log "SHUTDOWN: SIGINT received. Saving memory...")
(harness-log "SHUTDOWN: SIGINT received. Saving memory...
(when *shutdown-save-enabled* (save-memory-to-disk))
(uiop:quit 0)))
(let ((sleep-interval (or (ignore-errors (parse-integer (uiop:getenv "DAEMON_SLEEP_INTERVAL"))) 3600)))
(let ((sleep-interval (or (ignore-errors (parse-integer (uiop:getenv "DAEMON_SLEEP_INTERVAL)) 3600)))
(loop
(when (bt:with-lock-held (*interrupt-lock*) *interrupt-flag*)
(harness-log "SHUTDOWN: Interrupt flag set. Saving memory...")
(harness-log "SHUTDOWN: Interrupt flag set. Saving memory...
(when *shutdown-save-enabled* (save-memory-to-disk))
(return))
(sleep sleep-interval))))
#+end_src
* Test Suite
#+begin_src lisp :tangle tests/immune-system-tests.lisp
#+begin_src lisp :tangle package.lisp
(defpackage :opencortex-immune-system-tests
(:use :cl :fiveam :opencortex)
(:export #:immune-suite))
(in-package :opencortex-immune-system-tests)
(def-suite immune-suite :description "Verification of the Immune System (Core Error Hooks)")
(def-suite immune-suite :description "Verification of the Immune System (Core Error Hooks)
(in-suite immune-suite)
(test loop-error-injection
@@ -144,7 +145,7 @@ The Metabolic Loop is the fundamental rhythm of OpenCortex: the continuous proce
(opencortex:defskill :evil-skill
:priority 100
:trigger (lambda (ctx) (eq (getf (getf ctx :payload) :sensor) :user-input))
:probabilistic (lambda (ctx) (declare (ignore ctx)) (error "CRITICAL BRAIN FAILURE"))
:probabilistic (lambda (ctx) (declare (ignore ctx)) (error "CRITICAL BRAIN FAILURE)
:deterministic nil)
(opencortex:process-signal '(:type :EVENT :payload (:sensor :user-input)))
(let ((logs (opencortex:context-get-system-logs 20)))

86
harness/manifest.org
View File

@@ -19,73 +19,73 @@ The *System Manifest* defines the structural components of the OpenCortex.
:description "The Probabilistic-Deterministic Lisp Machine"
:depends-on (:usocket :bordeaux-threads :dexador :uiop :cl-dotenv :cl-ppcre :hunchentoot :ironclad :str :cl-json :uuid)
:serial t
:components ((:file "harness/package")
(:file "harness/skills")
(:file "harness/communication")
(:file "harness/communication-validator")
(:file "harness/memory")
(:file "harness/context")
(:file "harness/perceive")
(:file "harness/reason")
(:file "harness/act")
(:file "harness/loop")))
:components ((:file "harness/package
(:file "harness/skills
(:file "harness/communication
(:file "harness/communication-validator
(:file "harness/memory
(:file "harness/context
(:file "harness/perceive
(:file "harness/reason
(:file "harness/act
(:file "harness/loop))
#+end_src
** Test System
#+begin_src lisp
(defsystem :opencortex/tests
:depends-on (:opencortex :fiveam)
:components ((:file "tests/pipeline-act-tests")
(:file "tests/boot-sequence-tests")
(:file "tests/immune-system-tests")
(:file "tests/memory-tests")
(:file "tests/pipeline-perceive-tests")
(:file "tests/pipeline-reason-tests")
(:file "tests/peripheral-vision-tests")
(:file "tests/emacs-edit-tests")
(:file "tests/engineering-standards-tests")
(:file "tests/lisp-utils-tests")
(:file "tests/literate-programming-tests")
(:file "tests/self-edit-tests")
(:file "tests/tool-permissions-tests")
(:file "tests/diagnostics-tests")
(:file "tests/config-manager-tests")
(:file "tests/gateway-manager-tests")
(:file "tests/tui-tests")
(:file "tests/llm-gateway-tests")))
:components ((:file "tests/pipeline-act-tests
(:file "tests/boot-sequence-tests
(:file "tests/immune-system-tests
(:file "tests/memory-tests
(:file "tests/pipeline-perceive-tests
(:file "tests/pipeline-reason-tests
(:file "tests/peripheral-vision-tests
(:file "tests/emacs-edit-tests
(:file "tests/engineering-standards-tests
(:file "tests/lisp-utils-tests
(:file "tests/literate-programming-tests
(:file "tests/self-edit-tests
(:file "tests/tool-permissions-tests
(:file "tests/diagnostics-tests
(:file "tests/config-manager-tests
(:file "tests/gateway-manager-tests
(:file "tests/tui-tests
(:file "tests/llm-gateway-tests))
#+end_src
** TUI System
#+begin_src lisp
(defsystem :opencortex/tui
:depends-on (:opencortex :croatoan :usocket :bordeaux-threads)
:components ((:file "harness/tui-client")))
:components ((:file "harness/tui-client))
#+end_src
** Test Orchestrator
#+begin_src lisp :tangle run-all-tests.lisp
(load (merge-pathnames "quicklisp/setup.lisp" (user-homedir-pathname)))
(let ((oc-dir (or (uiop:getenv "OC_DATA_DIR")
(namestring (truename "./")))))
(let ((oc-dir (or (uiop:getenv "OC_DATA_DIR
(namestring (truename "./))))
(push (uiop:ensure-directory-pathname oc-dir) asdf:*central-registry*))
(ql:quickload '(:fiveam :opencortex :opencortex/tui :opencortex/tests) :silent t)
(format t "~%=== Initializing Skills BEFORE loading tests ===~%")
(format t "~%=== Initializing Skills BEFORE loading tests ===~%
(opencortex:initialize-all-skills)
(format t "~%=== Running ALL Test Suites ===~%")
(format t "~%=== Running ALL Test Suites ===~%
(dolist (suite-spec '(("OPENCORTEX-BOOT-TESTS" "BOOT-SUITE")
("OPENCORTEX-COMMUNICATION-TESTS" "COMMUNICATION-PROTOCOL-SUITE")
("OPENCORTEX-PIPELINE-ACT-TESTS" "PIPELINE-ACT-SUITE")
("OPENCORTEX-MEMORY-TESTS" "MEMORY-SUITE")
("OPENCORTEX-ENGINEERING-STANDARDS-TESTS" "ENGINEERING-STANDARDS-SUITE")
("OPENCORTEX-DIAGNOSTICS-TESTS" "DIAGNOSTICS-SUITE")
("OPENCORTEX-GATEWAY-MANAGER-TESTS" "GATEWAY-SUITE")
("OPENCORTEX-TUI-TESTS" "TUI-SUITE")
("OPENCORTEX-LLM-GATEWAY-TESTS" "LLM-GATEWAY-SUITE")))
(dolist (suite-spec '(("OPENCORTEX-BOOT-TESTS" "BOOT-SUITE
("OPENCORTEX-COMMUNICATION-TESTS" "COMMUNICATION-PROTOCOL-SUITE
("OPENCORTEX-PIPELINE-ACT-TESTS" "PIPELINE-ACT-SUITE
("OPENCORTEX-MEMORY-TESTS" "MEMORY-SUITE
("OPENCORTEX-ENGINEERING-STANDARDS-TESTS" "ENGINEERING-STANDARDS-SUITE
("OPENCORTEX-DIAGNOSTICS-TESTS" "DIAGNOSTICS-SUITE
("OPENCORTEX-GATEWAY-MANAGER-TESTS" "GATEWAY-SUITE
("OPENCORTEX-TUI-TESTS" "TUI-SUITE
("OPENCORTEX-LLM-GATEWAY-TESTS" "LLM-GATEWAY-SUITE))
(let ((pkg (find-package (first suite-spec))))
(when pkg
(let ((suite-sym (find-symbol (second suite-spec) pkg)))
@@ -93,5 +93,5 @@ The *System Manifest* defines the structural components of the OpenCortex.
(format t "~&--- Suite: ~A ---~%" (first suite-spec))
(fiveam:run! suite-sym))))))
(format t "~%=== ALL TESTS COMPLETE ===~%")
(format t "~%=== ALL TESTS COMPLETE ===~%
#+end_src

45
harness/memory.org
View File

@@ -1,4 +1,5 @@
#+PROPERTY: header-args:lisp :tangle memory.lisp
#+PROPERTY: header-args:lisp :tangle package.lisp
#+TITLE: The System Memory (memory.lisp)
#+AUTHOR: Amr
#+FILETAGS: :harness:memory:
@@ -23,7 +24,7 @@ The `*memory*` is the global hash table that holds every Org element by its uniq
(defvar *memory* (make-hash-table :test 'equal))
(defvar *history-store* (make-hash-table :test 'equal)
"Immutable Merkle-Tree versioning store mapping hashes to objects.")
"Immutable Merkle-Tree versioning store mapping hashes to objects.
#+end_src
** The Data Structure (org-object)
@@ -62,7 +63,7 @@ The `compute-merkle-hash` function ensures the cryptographic integrity of the kn
(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))
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))))
@@ -79,8 +80,8 @@ The `ingest-ast` function is the primary bridge between the external world (Emac
(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 (getf ast :raw-content) ""))))
(should-embed (and raw-content (equal (getf props :EMBED) "t")))
(format nil "~a~%~a" (getf props :TITLE) (or (getf ast :raw-content) ")))
(should-embed (and raw-content (equal (getf props :EMBED) "t))
(child-ids nil)
(child-hashes nil))
(dolist (child contents)
@@ -129,7 +130,7 @@ Because objects are stored immutably in the `*history-store*`, a snapshot is a l
(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.")))
(harness-log "MEMORY - CoW Memory snapshot created.))
(defun rollback-memory (&optional (index 0))
"Restores the Memory to a previously captured snapshot using immutable history pointers."
@@ -145,12 +146,12 @@ Essential for surviving crashes. Saves the in-memory hash tables to disk and loa
#+begin_src lisp
(defvar *memory-snapshot-path* nil
"Path to the memory snapshot file. Set from MEMORY_SNAPSHOT_PATH env or default.")
"Path to the memory snapshot file. Set from MEMORY_SNAPSHOT_PATH env or default.
(defun ensure-memory-snapshot-path ()
"Initializes the snapshot path from environment or default location."
(or *memory-snapshot-path*
(let ((env-path (uiop:getenv "MEMORY_SNAPSHOT_PATH")))
(let ((env-path (uiop:getenv "MEMORY_SNAPSHOT_PATH))
(setf *memory-snapshot-path*
(or env-path
(namestring (uiop:merge-pathnames* "memory.snap" (user-homedir-pathname))))))))
@@ -160,7 +161,7 @@ Essential for surviving crashes. Saves the in-memory hash tables to disk and loa
Converts hash tables to alists for proper serialization."
(let ((path (ensure-memory-snapshot-path)))
(with-open-file (stream path :direction :output :if-exists :supersede :if-does-not-exist :create)
(format stream ";; OpenCortex Memory Snapshot~%")
(format stream ";; OpenCortex Memory Snapshot~%
(format stream ";; Created: ~a~%~%" (get-universal-time))
(let ((memory-alist nil)
(history-alist nil))
@@ -198,11 +199,11 @@ Support for vector embeddings via Ollama and semantic search with cosine similar
#+begin_src lisp
(defvar *embedding-cache* (make-hash-table :test 'equal)
"Cache for embeddings to avoid redundant API calls.")
"Cache for embeddings to avoid redundant API calls.
(defun get-embedding (text)
"Generates a vector embedding for the given text via Ollama. Returns nil on failure."
(when (or (null text) (string= text ""))
(when (or (null text) (string= text ")
(return-from get-embedding nil))
(let ((cached (gethash text *embedding-cache*)))
(when cached (return-from get-embedding cached)))
@@ -293,7 +294,7 @@ Utility functions for AST traversal and path resolution.
* Test Suite
#+begin_src lisp :tangle tests/memory-tests.lisp
#+begin_src lisp :tangle package.lisp
(defpackage :opencortex-memory-tests
(:use :cl :fiveam :opencortex)
(:export #:memory-suite))
@@ -301,13 +302,13 @@ Utility functions for AST traversal and path resolution.
(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
"Verify identical ASTs produce identical Merkle hashes."
(let* ((ast1 '(:type :HEADLINE :properties (:ID "test-1" :TITLE "Node 1") :contents nil)))
(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))))
@@ -320,14 +321,14 @@ Utility functions for AST traversal and path resolution.
"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))
(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))
(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 (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*)))))))
@@ -335,27 +336,27 @@ Utility functions for AST traversal and path resolution.
"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))
(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))
(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))
(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)))))
(is (equal (org-object-hash (lookup-object "cow-node) hash-v1)))))
(test test-merkle-corruption-rollback
"Tier 2 Chaos: Verify that Merkle hash corruption triggers a Micro-Rollback."
(clrhash *memory*)
(setf *object-store-snapshots* nil)
(let* ((ast '(:type :HEADLINE :properties (:ID "node-1" :TITLE "Original") :contents nil))
(let* ((ast '(:type :HEADLINE :properties (:ID "node-1" :TITLE "Original :contents nil))
(id (ingest-ast ast)))
(snapshot-memory)
;; Manually corrupt the hash in the live memory
(let ((obj (lookup-object id)))
(setf (org-object-hash obj) "CORRUPTED-HASH"))
(setf (org-object-hash obj) "CORRUPTED-HASH)
;; Simulate a system integrity check that should fail and rollback
(let ((obj (lookup-object id)))

7
harness/package.org
View File

@@ -1,3 +1,4 @@
#+PROPERTY: header-args:lisp :tangle package.lisp
#+TITLE: System Interface (package.lisp)
#+AUTHOR: Agent
#+FILETAGS: :harness:interface:
@@ -204,14 +205,14 @@ The ~package.lisp~ file defines the public API of the ~opencortex~ harness.
(or (getf plist up) (getf plist dn))))
(defvar *system-logs* nil)
(defvar *logs-lock* (bordeaux-threads:make-lock "harness-logs-lock"))
(defvar *logs-lock* (bordeaux-threads:make-lock "harness-logs-lock)
(defvar *max-log-history* 100)
(defvar *skills-registry* (make-hash-table :test 'equal)
"Global registry of all loaded skills.")
"Global registry of all loaded skills.
(defvar *skill-telemetry* (make-hash-table :test 'equal))
(defvar *telemetry-lock* (bordeaux-threads:make-lock "harness-telemetry-lock"))
(defvar *telemetry-lock* (bordeaux-threads:make-lock "harness-telemetry-lock)
(defun harness-track-telemetry (skill-name duration status)
"Updates performance metrics for a specific skill. Status should be :success or :rejected."

21
harness/perceive.org
View File

@@ -1,8 +1,9 @@
#+PROPERTY: header-args:lisp :tangle perceive.lisp
#+TITLE: Stage 1: Perceive (perceive.lisp)
#+AUTHOR: Agent
#+FILETAGS: :harness:perceive:
#+STARTUP: content
#+PROPERTY: header-args:lisp :tangle perceive.lisp
#+PROPERTY: header-args:lisp :tangle package.lisp
* Overview
The Perceive stage is the "sensory cortex" of OpenCortex. Its job is to take raw stimuli from the outside world and transform them into standardized Signals that the rest of the pipeline can process.
@@ -23,7 +24,7 @@ The Perceive stage is the "sensory cortex" of OpenCortex. Its job is to take raw
so they run in separate threads to avoid blocking the main pipeline.
Other sensors (:heartbeat, :interrupt, :buffer-update) are processed
synchronously to maintain temporal ordering.")
synchronously to maintain temporal ordering.
(defvar *foveal-focus-id* nil
"The Org ID of the node the user is currently interacting with.
@@ -32,7 +33,7 @@ The Perceive stage is the "sensory cortex" of OpenCortex. Its job is to take raw
responses. When editing a specific note, the agent knows which
note you're referring to without needing explicit ID references.
Updated on :point-update events from Emacs.")
Updated on :point-update events from Emacs.
#+end_src
** Stimulus Injection (inject-stimulus)
@@ -59,7 +60,7 @@ The Perceive stage is the "sensory cortex" of OpenCortex. Its job is to take raw
;; Ensure metadata exists
(unless meta
(setf meta (list :SOURCE :SYSTEM :SESSION-ID "internal")))
(setf meta (list :SOURCE :SYSTEM :SESSION-ID "internal))
;; Attach reply stream if provided
(when stream
@@ -74,7 +75,7 @@ The Perceive stage is the "sensory cortex" of OpenCortex. Its job is to take raw
(lambda ()
(restart-case (process-signal raw-message)
(skip-event () nil)))
:name "opencortex-async-task")
:name "opencortex-async-task
;; Sync: process in main thread with recovery
(restart-case
@@ -83,7 +84,7 @@ The Perceive stage is the "sensory cortex" of OpenCortex. Its job is to take raw
(invoke-restart 'skip-event))))
(process-signal raw-message))
(skip-event ()
(harness-log "SYSTEM RECOVERY: Stimulus dropped."))))))
(harness-log "SYSTEM RECOVERY: Stimulus dropped.)))))
#+end_src
** Perceive Gate (perceive-gate)
@@ -107,7 +108,7 @@ The Perceive stage is the "sensory cortex" of OpenCortex. Its job is to take raw
;; Log the incoming signal for debugging
(harness-log "GATE [Perceive]: ~a (~a) [Source: ~s]"
type (or sensor "no-sensor") (getf meta :source))
type (or sensor "no-sensor (getf meta :source))
;; Handle EVENT type sensors
(cond ((eq type :EVENT)
@@ -147,20 +148,20 @@ The Perceive stage is the "sensory cortex" of OpenCortex. Its job is to take raw
* Test Suite
#+begin_src lisp :tangle tests/pipeline-perceive-tests.lisp
#+begin_src lisp :tangle package.lisp
(defpackage :opencortex-pipeline-perceive-tests
(:use :cl :fiveam :opencortex)
(:export #:pipeline-perceive-suite))
(in-package :opencortex-pipeline-perceive-tests)
(def-suite pipeline-perceive-suite :description "Test suite for Perceive pipeline")
(def-suite pipeline-perceive-suite :description "Test suite for Perceive pipeline
(in-suite pipeline-perceive-suite)
(test test-perceive-gate
"Perceive gate should update the object store and normalize signal."
(clrhash opencortex::*memory*)
(let* ((signal (list :type :EVENT :payload (list :sensor :buffer-update :ast (list :type :HEADLINE :properties (list :ID "test-node" :TITLE "Test") :contents nil))))
(let* ((signal (list :type :EVENT :payload (list :sensor :buffer-update :ast (list :type :HEADLINE :properties (list :ID "test-node" :TITLE "Test :contents nil))))
(result (perceive-gate signal)))
(is (eq :perceived (getf result :status)))
(is (not (null (gethash "test-node" opencortex::*memory*))))))

37
harness/reason.org
View File

@@ -1,8 +1,9 @@
#+PROPERTY: header-args:lisp :tangle reason.lisp
#+TITLE: Stage 2: Reason (reason.lisp)
#+AUTHOR: Agent
#+FILETAGS: :harness:reason:
#+STARTUP: content
#+PROPERTY: header-args:lisp :tangle reason.lisp
#+PROPERTY: header-args:lisp :tangle package.lisp
* Overview
The Reason stage implements the core Innovation of OpenCortex: the separation of probabilistic reasoning (neural/LLM) from deterministic verification (logic/safety).
@@ -17,16 +18,16 @@ The Reason stage implements the core Innovation of OpenCortex: the separation of
** Probabilistic Engine Configuration
#+begin_src lisp
(defvar *probabilistic-backends* (make-hash-table :test 'equal)
"Registry mapping provider keywords (:openrouter, :ollama) to their calling functions.")
"Registry mapping provider keywords (:openrouter, :ollama) to their calling functions.
(defvar *provider-cascade* nil
"Ordered list of provider keywords to try. First available provider wins.")
"Ordered list of provider keywords to try. First available provider wins.
(defvar *model-selector-fn* nil
"Optional function that selects a specific model for each provider.")
"Optional function that selects a specific model for each provider.
(defvar *consensus-enabled-p* nil
"When T, run multiple providers and compare results for critical decisions.")
"When T, run multiple providers and compare results for critical decisions.
#+end_src
** Backend Registration (register-probabilistic-backend)
@@ -39,7 +40,7 @@ The Reason stage implements the core Innovation of OpenCortex: the separation of
** Cascade Dispatch (probabilistic-call)
#+begin_src lisp
(defun probabilistic-call (prompt &key
(system-prompt "You are the Probabilistic engine.")
(system-prompt "You are the Probabilistic engine.
(cascade nil)
(context nil))
"Dispatch a neural request through the provider cascade."
@@ -61,7 +62,7 @@ The Reason stage implements the core Innovation of OpenCortex: the separation of
(harness-log "PROBABILISTIC: Backend ~a failed: ~a"
backend (getf result :message))))))))
(list :type :LOG
:payload (list :text "Neural Cascade Failure: All providers exhausted.")))))
:payload (list :text "Neural Cascade Failure: All providers exhausted.))))
#+end_src
** Cognitive Proposal Generation (Think)
@@ -70,9 +71,9 @@ The Reason stage implements the core Innovation of OpenCortex: the separation of
"Strip markdown formatting from LLM output."
(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 ""))
(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))
@@ -91,16 +92,16 @@ The Reason stage implements the core Innovation of OpenCortex: the separation of
(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"))
(assistant-name (or (uiop:getenv "MEMEX_ASSISTANT "Agent)
(rejection-trace (proto-get (proto-get context :payload) :rejection-trace))
(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."))))
(if (and p (stringp p)) p "Maintain metabolic stasis.)))
(reflection-feedback (if rejection-trace
(format nil "~%~%PREVIOUS PROPOSAL REJECTED: ~a" rejection-trace)
""))
(system-prompt (format nil "IDENTITY: ~a~a~%~%TOOLS:~%~a~%~%CONTEXT:~%~a~%~%LOGS:~%~a"
assistant-name reflection-feedback tool-belt global-context system-logs)))
(let* ((thought (probabilistic-call raw-prompt :system-prompt system-prompt :context context))
@@ -112,7 +113,7 @@ The Reason stage implements the core Innovation of OpenCortex: the separation of
(normalize-plist-keywords parsed)
(list :TYPE :REQUEST :PAYLOAD (list :ACTION :MESSAGE :TEXT cleaned))))
(error () (list :TYPE :REQUEST :PAYLOAD (list :ACTION :MESSAGE :TEXT cleaned))))
(list :TYPE :REQUEST :PAYLOAD (list :ACTION :MESSAGE :TEXT (or cleaned "No response")))))))
(list :TYPE :REQUEST :PAYLOAD (list :ACTION :MESSAGE :TEXT (or cleaned "No response))))))
#+end_src
** Deterministic Engine (Verification)
@@ -175,14 +176,14 @@ The Reason stage implements the core Innovation of OpenCortex: the separation of
#+end_src
* Test Suite
#+begin_src lisp :tangle tests/pipeline-reason-tests.lisp
#+begin_src lisp :tangle package.lisp
(defpackage :opencortex-pipeline-reason-tests
(:use :cl :fiveam :opencortex)
(:export #:pipeline-reason-suite))
(in-package :opencortex-pipeline-reason-tests)
(def-suite pipeline-reason-suite :description "Test suite for Reason pipeline")
(def-suite pipeline-reason-suite :description "Test suite for Reason pipeline
(in-suite pipeline-reason-suite)
(test test-decide-gate-safety
@@ -194,9 +195,9 @@ The Reason stage implements the core Innovation of OpenCortex: the separation of
:deterministic (lambda (action ctx)
(declare (ignore ctx))
(if (search "rm -rf" (format nil "~s" action))
(list :type :LOG :payload (list :text "Rejected"))
(list :type :LOG :payload (list :text "Rejected)
action)))
(let* ((candidate '(:type :REQUEST :payload (:action :shell :cmd "rm -rf /")))
(let* ((candidate '(:type :REQUEST :payload (:action :shell :cmd "rm -rf /))
(signal '(:type :EVENT :payload (:sensor :user-input)))
(result (deterministic-verify candidate signal)))
(is (eq :LOG (getf result :type)))))

2
harness/setup.org
View File

@@ -23,7 +23,7 @@ To maintain sovereignty, the harness must remain a "dumb" bus. It should not kno
** The Installer Script (opencortex.sh)
The shell script is the primary entry point. It handles the initial git clone, dependency installation, and literate tangle.
#+begin_src bash :tangle ../opencortex.sh
#+begin_src bash :tangle setup.sh
#!/bin/bash
# (The content here is a duplicate of the main opencortex.sh for literate consistency)
# [Note: Implementation is already verified in the top-level script]

19
harness/skills.org
View File

@@ -1,8 +1,9 @@
#+PROPERTY: header-args:lisp :tangle skills.lisp
#+TITLE: The Skill Engine (skills.lisp)
#+AUTHOR: Agent
#+FILETAGS: :harness:skills:
#+STARTUP: content
#+PROPERTY: header-args:lisp :tangle skills.lisp
#+PROPERTY: header-args:lisp :tangle package.lisp
* Overview
The ~opencortex~ Skill Engine enables **Late-Binding Intelligence**, allowing the system to discover and integrate new cognitive capabilities at runtime.
@@ -27,12 +28,12 @@ The ~opencortex~ Skill Engine enables **Late-Binding Intelligence**, allowing th
(incf dot (* x y)) (incf n1 (* x x)) (incf n2 (* y y))))
(if (or (zerop n1) (zerop n2)) 0.0 (/ dot (sqrt (* n1 n2))))))))
(defun VAULT-MASK-STRING (s) (declare (ignore s)) "[MASKED]")
(defun VAULT-MASK-STRING (s) (declare (ignore s)) "[MASKED]
(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.")
"A stateful tracking table for all skill files discovered in the environment.
(defstruct skill-entry filename (status :discovered) error-log (load-time 0))
@@ -86,7 +87,7 @@ The ~opencortex~ Skill Engine enables **Late-Binding Intelligence**, allowing th
(when end
(let ((line (string-trim " " (subseq content (+ pos 13) end))))
(dolist (d (uiop:split-string line :separator '(#\Space #\Tab)))
(unless (string= d "") (push d dependencies))))
(unless (string= d " (push d dependencies))))
(setf pos end)))))
(values id (reverse dependencies))))
#+end_src
@@ -95,7 +96,7 @@ The ~opencortex~ Skill Engine enables **Late-Binding Intelligence**, allowing th
#+begin_src lisp
(defun topological-sort-skills (skills-dir)
"Returns a list of skill filepaths sorted by dependency."
(let ((files (uiop:directory-files skills-dir "org-skill-*.org"))
(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))
@@ -123,7 +124,7 @@ The ~opencortex~ Skill Engine enables **Late-Binding Intelligence**, allowing th
(when dep-file
(let ((dep-filename (pathname-name dep-file)))
(if (gethash (string-downcase dep-filename) stack)
(error "Circular dependency detected")
(error "Circular dependency detected
(visit dep-file))))))
(setf (gethash node-key stack) nil)
(setf (gethash node-key visited) t)
@@ -162,7 +163,7 @@ The ~opencortex~ Skill Engine enables **Late-Binding Intelligence**, allowing th
(handler-case
(let* ((content (uiop:read-file-string filepath))
(lines (uiop:split-string content :separator '(#\Newline)))
(in-lisp-block nil) (collect-this-block nil) (lisp-code "")
(in-lisp-block nil) (collect-this-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)))
@@ -196,12 +197,12 @@ The ~opencortex~ Skill Engine enables **Late-Binding Intelligence**, allowing th
#+begin_src lisp
(defun initialize-all-skills ()
"Initializes all skills from SKILLS_DIR."
(let* ((env-path (uiop:getenv "SKILLS_DIR"))
(let* ((env-path (uiop:getenv "SKILLS_DIR)
(skills-dir (uiop:ensure-directory-pathname (or env-path (namestring (merge-pathnames "notes/" (user-homedir-pathname)))))))
(unless (uiop:directory-exists-p skills-dir) (return-from initialize-all-skills nil))
(let ((sorted-files (topological-sort-skills skills-dir)))
(harness-log "LOADER: Initializing ~a skills..." (length sorted-files))
(dolist (file sorted-files)
(load-skill-from-org file))
(harness-log "LOADER: Boot Complete."))))
(harness-log "LOADER: Boot Complete.)))
#+end_src

13
harness/tui-client.org
View File

@@ -1,3 +1,4 @@
#+PROPERTY: header-args:lisp :tangle tui-client.lisp
#+TITLE: OpenCortex TUI Client (Standalone)
#+STARTUP: content
#+FILETAGS: :tui:ux:client:
@@ -7,7 +8,7 @@
The OpenCortex TUI Client is a standalone Common Lisp application built on **Croatoan**.
* Test Suite
#+begin_src lisp :tangle tests/tui-tests.lisp
#+begin_src lisp :tangle tui-client.lisp
(defpackage :opencortex-tui-tests
(:use :cl :opencortex)
(:export #:tui-suite))
@@ -17,7 +18,7 @@ The OpenCortex TUI Client is a standalone Common Lisp application built on **Cro
(eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload :fiveam))
(fiveam:def-suite tui-suite :description "Verification of the TUI parsing and styling logic")
(fiveam:def-suite tui-suite :description "Verification of the TUI parsing and styling logic
(fiveam:in-suite tui-suite)
(fiveam:test test-tui-connection-drop
@@ -45,7 +46,7 @@ The OpenCortex TUI Client is a standalone Common Lisp application built on **Cro
** Global State
#+begin_src lisp
(defvar *daemon-host* "127.0.0.1")
(defvar *daemon-host* "127.0.0.1
(defvar *daemon-port* 9105)
(defvar *socket* nil)
(defvar *stream* nil)
@@ -115,10 +116,10 @@ The OpenCortex TUI Client is a standalone Common Lisp application built on **Cro
(finish-output stream))
(error (c)
(declare (ignore c))
(enqueue-msg "ERROR: Connection to daemon lost.")
(enqueue-msg "ERROR: Connection to daemon lost.
(setf *is-running* nil))))
(when (string= cmd "/exit") (setf *is-running* nil))
(when (string= cmd "/clear") (setf *chat-history* nil))))
(when (string= cmd "/exit (setf *is-running* nil))
(when (string= cmd "/clear (setf *chat-history* nil))))
#+end_src
** Main Entry Point

18
skills/org-skill-bouncer.org
View File

@@ -16,8 +16,8 @@ The *Bouncer Skill* is the physical security layer of OpenCortex. It enforces op
** Security Configuration
#+begin_src lisp
(defvar *bouncer-network-whitelist*
'("api.telegram.org" "matrix.org" "googleapis.com" "openai.com" "anthropic.com")
"Domains that the Bouncer considers safe for outbound connections.")
'("api.telegram.org" "matrix.org" "googleapis.com" "openai.com" "anthropic.com
"Domains that the Bouncer considers safe for outbound connections.
#+end_src
** Secret Scanning (bouncer-scan-secrets)
@@ -57,7 +57,7 @@ The *Bouncer Skill* is the physical security layer of OpenCortex. It enforces op
(payload (proto-get action :payload))
(text (or (proto-get payload :text) (proto-get action :text)))
(cmd (or (proto-get payload :cmd)
(when (and (eq target :tool) (equal (proto-get payload :tool) "shell"))
(when (and (eq target :tool) (equal (proto-get payload :tool) "shell)
(proto-get (proto-get payload :args) :cmd))))
(approved (proto-get action :approved)))
@@ -72,13 +72,13 @@ The *Bouncer Skill* is the physical security layer of OpenCortex. It enforces op
:text (format nil "Action blocked: Potential exposure of '~a'" secret-name)))))
((and (or (eq target :shell)
(and (eq target :tool) (equal (proto-get payload :tool) "shell")))
(and (eq target :tool) (equal (proto-get payload :tool) "shell))
(bouncer-check-network-exfil cmd))
(harness-log "SECURITY WARNING: External network call detected. Queuing for approval.")
(harness-log "SECURITY WARNING: External network call detected. Queuing for approval.
(list :type :EVENT :payload (list :sensor :approval-required :action action)))
((or (member target '(:shell))
(and (eq target :tool) (member (proto-get payload :tool) '("shell" "repair-file") :test #'string=))
(and (eq target :tool) (member (proto-get payload :tool) '("shell" "repair-file :test #'string=))
(and (eq target :emacs) (eq (proto-get payload :action) :eval)))
(harness-log "SECURITY: High-impact action requires approval: ~a" (or (proto-get payload :tool) target))
(list :type :EVENT :payload (list :sensor :approval-required :action action)))
@@ -90,7 +90,7 @@ The *Bouncer Skill* is the physical security layer of OpenCortex. It enforces op
#+begin_src lisp
(defun bouncer-process-approvals ()
"Scans for APPROVED flight plans and re-injects them."
(let ((approved-nodes (list-objects-with-attribute :TODO "APPROVED"))
(let ((approved-nodes (list-objects-with-attribute :TODO "APPROVED)
(found-any nil))
(dolist (node approved-nodes)
(let* ((attrs (org-object-attributes node))
@@ -102,7 +102,7 @@ The *Bouncer Skill* is the physical security layer of OpenCortex. It enforces op
(when action
(setf (getf action :approved) t)
(inject-stimulus action)
(setf (getf (org-object-attributes node) :TODO) "DONE")
(setf (getf (org-object-attributes node) :TODO) "DONE
(setq found-any t))))))
found-any))
#+end_src
@@ -116,7 +116,7 @@ The *Bouncer Skill* is the physical security layer of OpenCortex. It enforces op
(list :type :REQUEST :target :emacs
:payload (list :action :insert-node :id id
:attributes (list :TITLE "Flight Plan: High-Risk Action"
:TODO "PLAN" :TAGS '("FLIGHT_PLAN")
:TODO "PLAN" :TAGS '("FLIGHT_PLAN
:ACTION (format nil "~s" blocked-action))))))
#+end_src

8
skills/org-skill-config-manager.org
View File

@@ -17,14 +17,14 @@ The *Config Manager* skill provides the OpenCortex Agent with the capability to
#+begin_src lisp
(defun get-oc-config-dir ()
"Returns the absolute path to the opencortex config directory."
(let ((xdg (uiop:getenv "OC_CONFIG_DIR")))
(if (and xdg (string/= xdg ""))
(let ((xdg (uiop:getenv "OC_CONFIG_DIR))
(if (and xdg (string/= xdg
(uiop:ensure-directory-pathname xdg)
(uiop:ensure-directory-pathname (merge-pathnames ".config/opencortex/" (user-homedir-pathname))))))
(defun save-providers ()
"Stubs for saving provider configuration."
(harness-log "CONFIG: Providers saved."))
(harness-log "CONFIG: Providers saved.)
(defun configure-provider (id)
"Stubs for configuring a provider."
@@ -32,7 +32,7 @@ The *Config Manager* skill provides the OpenCortex Agent with the capability to
(defun run-setup-wizard ()
"Interactive setup wizard for OpenCortex."
(format t "--- OpenCortex Setup Wizard ---~%")
(format t "--- OpenCortex Setup Wizard ---~%
(save-providers)
(doctor-main))
#+end_src

10
skills/org-skill-credentials-vault.org
View File

@@ -16,7 +16,7 @@ The *Credentials Vault* provides secure in-memory storage for sensitive API keys
** Vault Storage
#+begin_src lisp
(defvar *vault-memory* (make-hash-table :test 'equal)
"In-memory cache of sensitive credentials.")
"In-memory cache of sensitive credentials.
#+end_src
** Secret Management
@@ -28,10 +28,10 @@ The *Credentials Vault* provides secure in-memory storage for sensitive API keys
(if val
val
(let ((env-var (case provider
(:gemini "GEMINI_API_KEY")
(:openai "OPENAI_API_KEY")
(:anthropic "ANTHROPIC_API_KEY")
(:openrouter "OPENROUTER_API_KEY")
(:gemini "GEMINI_API_KEY
(:openai "OPENAI_API_KEY
(:anthropic "ANTHROPIC_API_KEY
(:openrouter "OPENROUTER_API_KEY
(otherwise nil))))
(when env-var (uiop:getenv env-var))))))

20
skills/org-skill-diagnostics.org
View File

@@ -17,9 +17,9 @@ The *Diagnostics Skill* (Doctor) provides system-wide health checks and dependen
#+begin_src lisp
(defun doctor-check-dependencies ()
"Verifies that all required external binaries are available."
(let ((deps '("sbcl" "emacs" "git" "curl" "nc"))
(let ((deps '("sbcl" "emacs" "git" "curl" "nc)
(all-ok t))
(format t "DOCTOR: Checking System Dependencies...~%")
(format t "DOCTOR: Checking System Dependencies...~%
(dolist (dep deps)
(if (uiop:run-program (list "which" dep) :ignore-error-status t)
(format t " [OK] Found ~a~%" dep)
@@ -33,8 +33,8 @@ The *Diagnostics Skill* (Doctor) provides system-wide health checks and dependen
#+begin_src lisp
(defun doctor-check-xdg ()
"Verifies XDG environment variables and directory structure."
(format t "DOCTOR: Checking XDG environment...~%")
(let ((vars '("OC_CONFIG_DIR" "OC_DATA_DIR" "OC_STATE_DIR" "MEMEX_DIR")))
(format t "DOCTOR: Checking XDG environment...~%
(let ((vars '("OC_CONFIG_DIR" "OC_DATA_DIR" "OC_STATE_DIR" "MEMEX_DIR))
(dolist (var vars)
(let ((val (uiop:getenv var)))
(if val
@@ -47,15 +47,15 @@ The *Diagnostics Skill* (Doctor) provides system-wide health checks and dependen
#+begin_src lisp
(defun doctor-main ()
"Runs all diagnostic checks."
(format t "==================================================~%")
(format t " OpenCortex System Diagnostic~%")
(format t "==================================================~%")
(format t "==================================================~%
(format t " OpenCortex System Diagnostic~%
(format t "==================================================~%
(let ((d-ok (doctor-check-dependencies))
(x-ok (doctor-check-xdg)))
(format t "==================================================~%")
(format t "==================================================~%
(if (and d-ok x-ok)
(format t " ✓ SYSTEM HEALTHY: Ready for ignition.~%")
(format t " ✗ SYSTEM UNHEALTHY: Issues detected.~%"))))
(format t " ✓ SYSTEM HEALTHY: Ready for ignition.~%
(format t " ✗ SYSTEM UNHEALTHY: Issues detected.~%)))
#+end_src
** Skill Registration

2
skills/org-skill-engineering-standards.org
View File

@@ -17,7 +17,7 @@ The *Engineering Standards Skill* enforces technical invariants, including the *
#+begin_src lisp
(defun verify-git-clean-p (dir)
"Checks if a directory has uncommitted changes."
(let ((status (uiop:run-program (list "git" "-C" (namestring dir) "status" "--porcelain")
(let ((status (uiop:run-program (list "git" "-C" (namestring dir) "status" "--porcelain
:output :string
:ignore-error-status t)))
(string= "" (string-trim '(#\Space #\Newline #\Tab) status))))

4
skills/org-skill-gardener.org
View File

@@ -17,11 +17,11 @@ The *Gardener Skill* performs periodic maintenance on the Memex knowledge graph.
#+begin_src lisp
(defun gardener-prune-orphans ()
"Identifies and handles orphaned objects in memory."
(harness-log "GARDENER: Pruning orphans..."))
(harness-log "GARDENER: Pruning orphans...)
(defun gardener-verify-merkle-integrity ()
"Validates the hashes of all objects in memory."
(harness-log "GARDENER: Verifying Merkle integrity..."))
(harness-log "GARDENER: Verifying Merkle integrity...)
#+end_src
** Skill Registration

2
skills/org-skill-homoiconic-memory.org
View File

@@ -17,7 +17,7 @@ The *Homoiconic Memory* skill provides the capability to treat system memory as
#+begin_src lisp
(defun memory-self-inspect ()
"Allows the system to inspect its own memory state."
(harness-log "MEMORY: Self-inspection triggered."))
(harness-log "MEMORY: Self-inspection triggered.)
#+end_src
** Skill Registration

6
skills/org-skill-llama-backend.org
View File

@@ -15,9 +15,9 @@ The *Llama Backend* skill provides the actual implementation for calling local m
** Ollama API Call (ollama-call)
#+begin_src lisp
(defun ollama-call (prompt system-prompt &key (model "llama3"))
(defun ollama-call (prompt system-prompt &key (model "llama3)
"Sends a request to the local Ollama API."
(let* ((host (or (uiop:getenv "OLLAMA_HOST") "localhost:11434"))
(let* ((host (or (uiop:getenv "OLLAMA_HOST "localhost:11434)
(url (format nil "http://~a/api/generate" host))
(payload (cl-json:encode-json-to-string
`((model . ,model)
@@ -25,7 +25,7 @@ The *Llama Backend* skill provides the actual implementation for calling local m
(system . ,system-prompt)
(stream . nil)))))
(handler-case
(let ((response (dex:post url :content payload :headers '(("Content-Type" . "application/json")))))
(let ((response (dex:post url :content payload :headers '(("Content-Type" . "application/json))))
(let ((data (cl-json:decode-json-from-string response)))
(list :status :success :content (getf data :response))))
(error (c)

14
skills/org-skill-llm-gateway.org
View File

@@ -7,7 +7,7 @@
The *LLM Gateway* skill provides a unified interface for interacting with multiple Large Language Model providers.
* Test Suite
#+begin_src lisp :tangle tests/llm-gateway-tests.lisp
#+begin_src lisp :tangle org-skill-llm-gateway.lisp
(defpackage :opencortex-llm-gateway-tests
(:use :cl :opencortex)
(:export #:llm-gateway-suite))
@@ -17,25 +17,25 @@ The *LLM Gateway* skill provides a unified interface for interacting with multip
(eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload :fiveam))
(fiveam:def-suite llm-gateway-suite :description "Tests for the LLM Gateway skill")
(fiveam:def-suite llm-gateway-suite :description "Tests for the LLM Gateway skill
(fiveam:in-suite llm-gateway-suite)
(fiveam:test test-llm-gateway-timeout
"Tier 2 Chaos: Verify that LLM Gateway handles connection failures gracefully."
(let ((old-host (uiop:getenv "OLLAMA_HOST")))
(let ((old-host (uiop:getenv "OLLAMA_HOST))
(unwind-protect
(progn
(setf (uiop:getenv "OLLAMA_HOST") "localhost:1")
(setf (uiop:getenv "OLLAMA_HOST "localhost:1
(let ((fn (or (find-symbol "EXECUTE-LLM-REQUEST" :opencortex.skills.org-skill-llm-gateway)
(find-symbol "EXECUTE-LLM-REQUEST" :opencortex))))
(if fn
(let ((result (funcall fn :prompt "hello" :provider :ollama)))
(fiveam:is (eq (getf result :status) :error))
(fiveam:is (uiop:string-prefix-p "Ollama Failure" (getf result :message))))
(fiveam:fail "Could not find EXECUTE-LLM-REQUEST symbol"))))
(fiveam:fail "Could not find EXECUTE-LLM-REQUEST symbol)))
(if old-host
(setf (uiop:getenv "OLLAMA_HOST") old-host)
(sb-posix:unsetenv "OLLAMA_HOST")))))
(setf (uiop:getenv "OLLAMA_HOST old-host)
(sb-posix:unsetenv "OLLAMA_HOST))))
#+end_src
* Implementation

2
skills/org-skill-peripheral-vision.org
View File

@@ -20,7 +20,7 @@ The *Peripheral Vision* skill enhances the context engine with high-level summar
(let ((obj (lookup-object obj-id)))
(if obj
(format nil "Node: ~a (~a)" (getf (org-object-attributes obj) :TITLE) obj-id)
"[Unknown Node]")))
"[Unknown Node]))
#+end_src
** Skill Registration

4
skills/org-skill-policy.org
View File

@@ -23,10 +23,10 @@ The *Policy Skill* is the constitutional layer of OpenCortex. It enforces founda
(if (and explanation (stringp explanation) (> (length explanation) 10))
action
(progn
(harness-log "POLICY VIOLATION: Action lacks sufficient explanation.")
(harness-log "POLICY VIOLATION: Action lacks sufficient explanation.
(list :type :LOG
:payload (list :level :warn
:text "Action blocked: Missing or insufficient :explanation. Please justify your reasoning."))))))
:text "Action blocked: Missing or insufficient :explanation. Please justify your reasoning.)))))
#+end_src
** Skill Registration