diff --git a/.gitignore b/.gitignore index 95ec5d6..7d6e606 100644 --- a/.gitignore +++ b/.gitignore @@ -6,3 +6,6 @@ opencortex-server \#*# opencortex-tui test_input.txt +opencortex-server +environment/logs/ +library/gen/ diff --git a/Dockerfile b/Dockerfile index eae7fd9..adfd158 100644 --- a/Dockerfile +++ b/Dockerfile @@ -25,7 +25,7 @@ WORKDIR /app COPY . . # Initialize system in non-interactive mode -RUN mkdir -p /root/memex && ./opencortex.sh setup --non-interactive +RUN mkdir -p /root/memex /app/environment/logs && ./opencortex.sh setup --non-interactive EXPOSE 9105 diff --git a/CHANGELOG.org b/docs/CHANGELOG.org similarity index 100% rename from CHANGELOG.org rename to docs/CHANGELOG.org diff --git a/CLA.org b/docs/CLA.org similarity index 100% rename from CLA.org rename to docs/CLA.org diff --git a/CONTRIBUTING.org b/docs/CONTRIBUTING.org similarity index 100% rename from CONTRIBUTING.org rename to docs/CONTRIBUTING.org diff --git a/USER_MANUAL.org b/docs/USER_MANUAL.org similarity index 100% rename from USER_MANUAL.org rename to docs/USER_MANUAL.org diff --git a/system/state/memory-image.lisp b/environment/state/memory-image.lisp similarity index 100% rename from system/state/memory-image.lisp rename to environment/state/memory-image.lisp diff --git a/literate/act.org b/harness/act.org similarity index 95% rename from literate/act.org rename to harness/act.org index 71a5015..d2aee94 100644 --- a/literate/act.org +++ b/harness/act.org @@ -11,14 +11,14 @@ The Act stage performs the final physical side-effects of the metabolic pipeline Actuators are the "hands" of the OpenCortex. They can be local (printing to a terminal), virtual (executing a shell command), or remote (sending a Matrix message). Crucially, the core microharness does not know *how* to talk to these services; it only knows how to *dispatch* to the registered actuator functions. ** Pipeline Initialization -#+begin_src lisp :tangle ../src/act.lisp +#+begin_src lisp :tangle ../library/act.lisp (in-package :opencortex) #+end_src * Actuator Configuration ** Default Actuator -#+begin_src lisp :tangle ../src/act.lisp +#+begin_src lisp :tangle ../library/act.lisp (defvar *default-actuator* :cli "The fallback actuator used if a signal has no source or target metadata.") #+end_src @@ -26,7 +26,7 @@ Actuators are the "hands" of the OpenCortex. They can be local (printing to a te ** Silent Actuators To prevent infinite feedback loops, certain actuators are flagged as "silent." Results from these actuators are logged but do not trigger a fresh metabolic cycle. -#+begin_src lisp :tangle ../src/act.lisp +#+begin_src lisp :tangle ../library/act.lisp (defvar *silent-actuators* '(:cli :system-message :emacs) "List of actuators whose feedback should not re-enter the Reasoning stage.") #+end_src @@ -34,7 +34,7 @@ To prevent infinite feedback loops, certain actuators are flagged as "silent." R ** Initialization Logic (initialize-actuators) This function hydrates the actuator configuration from the environment and registers the core built-in actuators. -#+begin_src lisp :tangle ../src/act.lisp +#+begin_src lisp :tangle ../library/act.lisp (defun initialize-actuators () "Loads actuator routing defaults from environment variables and registers core harness actuators." (let ((def (uiop:getenv "DEFAULT_ACTUATOR")) @@ -62,7 +62,7 @@ This function hydrates the actuator configuration from the environment and regis ** Dispatching Logic (dispatch-action) The primary router. It identifies the target actuator based on the Signal's `:META` source or the Action's `:TARGET`. -#+begin_src lisp :tangle ../src/act.lisp +#+begin_src lisp :tangle ../library/act.lisp (defun dispatch-action (action context) "Routes an approved action to its registered physical actuator." (let ((payload (proto-get action :payload))) @@ -92,7 +92,7 @@ The primary router. It identifies the target actuator based on the Signal's `:ME ** System Actuator (execute-system-action) Handles meta-operations like hot-loading skills or evaluating raw Lisp within the image. -#+begin_src lisp :tangle ../src/act.lisp +#+begin_src lisp :tangle ../library/act.lisp (defun execute-system-action (action context) "Processes internal harness commands. (ACTUATOR)" (declare (ignore context)) @@ -113,7 +113,7 @@ Handles meta-operations like hot-loading skills or evaluating raw Lisp within th ** Tool Result Formatting (format-tool-result) A UI helper that distills technical LLM responses into human-readable text. -#+begin_src lisp :tangle ../src/act.lisp +#+begin_src lisp :tangle ../library/act.lisp (defun format-tool-result (tool-name result) "Intelligently formats a tool result for user display." (if (listp result) @@ -129,7 +129,7 @@ A UI helper that distills technical LLM responses into human-readable text. ** Tool Actuator (execute-tool-action) The engine for physical interaction. It executes a cognitive tool and generates feedback signals for the user. -#+begin_src lisp :tangle ../src/act.lisp +#+begin_src lisp :tangle ../library/act.lisp (defun execute-tool-action (action context) "Executes a registered cognitive tool and generates feedback signals. (ACTUATOR)" (let* ((payload (getf action :payload)) @@ -163,7 +163,7 @@ The engine for physical interaction. It executes a cognitive tool and generates ** Act Gate (act-gate) The exit point of the metabolic pipeline. It applies a last-mile safety check via the Deterministic Engine and dispatches the signal to the physical world. -#+begin_src lisp :tangle ../src/act.lisp +#+begin_src lisp :tangle ../library/act.lisp (defun act-gate (signal) "Final Stage: Actuation and feedback generation." (let* ((approved (getf signal :approved-action)) diff --git a/literate/communication.org b/harness/communication.org similarity index 93% rename from literate/communication.org rename to harness/communication.org index 3ad6e7b..616b328 100644 --- a/literate/communication.org +++ b/harness/communication.org @@ -14,7 +14,7 @@ The Communication Protocol is the bridge between the OpenCortex microharness and By utilizing a length-prefixed S-expression format (the "Unified Envelope"), we ensure that both human-readable text and complex Lisp data structures can be transmitted securely without the fragility of JSON or the overhead of Protobuf. ** Pipeline Initialization -#+begin_src lisp :tangle ../src/communication.lisp +#+begin_src lisp :tangle ../library/communication.lisp (in-package :opencortex) #+end_src @@ -27,7 +27,7 @@ Every message leaving the harness must be "framed." This involves two steps: Example Frame: ~00001c(:TYPE :STATUS :SCRIBE :IDLE)~ -#+begin_src lisp :tangle ../src/communication.lisp +#+begin_src lisp :tangle ../library/communication.lisp (defun sanitize-protocol-message (msg) "Recursively strips non-serializable objects (streams, sockets) from a protocol plist." (if (and msg (listp msg)) @@ -40,7 +40,7 @@ Example Frame: ~00001c(:TYPE :STATUS :SCRIBE :IDLE)~ msg)) #+end_src -#+begin_src lisp :tangle ../src/communication.lisp +#+begin_src lisp :tangle ../library/communication.lisp (defun frame-message (msg) "Serializes a message plist and prefixes it with a 6-character hex length." (let* ((sanitized (sanitize-protocol-message msg)) @@ -54,7 +54,7 @@ Example Frame: ~00001c(:TYPE :STATUS :SCRIBE :IDLE)~ ** Framed Message Reader (read-framed-message) The inverse of framing. This function reads exactly the number of bytes specified by the hex-length prefix. This "byte-counted" reading is a critical security measure—it prevents buffer overflow attacks and "slowloris" type hung connections. -#+begin_src lisp :tangle ../src/communication.lisp +#+begin_src lisp :tangle ../library/communication.lisp (defun read-framed-message (stream) "Reads a hex-prefixed message from a stream. Returns the parsed Lisp plist or :EOF." (handler-case @@ -81,7 +81,7 @@ The inverse of framing. This function reads exactly the number of bytes specifie ** Hello Message (make-hello-message) The first message sent by the daemon upon client connection. It advertises the protocol version and the agent's current capabilities. -#+begin_src lisp :tangle ../src/communication.lisp +#+begin_src lisp :tangle ../library/communication.lisp (defun make-hello-message (version) "Constructs the standard HELLO handshake message." (list :TYPE :EVENT diff --git a/literate/context.org b/harness/context.org similarity index 92% rename from literate/context.org rename to harness/context.org index 409ed8d..c0eec08 100644 --- a/literate/context.org +++ b/harness/context.org @@ -16,7 +16,7 @@ In most agent frameworks, context is provided as a massive, unstructured text du By balancing these three layers, we provide the agent with a "Wide Angle" view of the user's life without overflowing the LLM's context window. ** Pipeline Initialization -#+begin_src lisp :tangle ../src/context.lisp +#+begin_src lisp :tangle ../library/context.lisp (in-package :opencortex) #+end_src @@ -25,7 +25,7 @@ By balancing these three layers, we provide the agent with a "Wide Angle" view o ** Project Awareness (context-get-active-projects) Identifies current active work by querying the Org Memory for nodes with the ~:PROJECT:~ tag or ~NEXT~ status. -#+begin_src lisp :tangle ../src/context.lisp +#+begin_src lisp :tangle ../library/context.lisp (defun context-get-active-projects () "Retrieves a list of project headlines currently marked as NEXT or in progress." (let ((all-projects (list-objects-with-attribute :CATEGORY "Project"))) @@ -37,7 +37,7 @@ Identifies current active work by querying the Org Memory for nodes with the ~:P ** Historical Awareness (context-get-recent-completed-tasks) Provides short-term memory of what was recently achieved, allowing the agent to maintain continuity. -#+begin_src lisp :tangle ../src/context.lisp +#+begin_src lisp :tangle ../library/context.lisp (defun context-get-recent-completed-tasks (&optional (limit 5)) "Retrieves the last N tasks marked as DONE from the memory history." (let ((all-completed (list-objects-with-attribute :TODO "DONE"))) @@ -48,7 +48,7 @@ Provides short-term memory of what was recently achieved, allowing the agent to ** Skill Awareness (context-list-all-skills) Allows the agent to understand its own capabilities by listing the human-readable descriptions of all loaded Literate Skills. -#+begin_src lisp :tangle ../src/context.lisp +#+begin_src lisp :tangle ../library/context.lisp (defun context-list-all-skills () "Returns a list of registered skills and their documentation." (let ((results nil)) @@ -61,7 +61,7 @@ Allows the agent to understand its own capabilities by listing the human-readabl ** System Awareness (context-get-system-logs) Crucial for self-debugging. Provides the agent with the internal logs so it can explain why a previous action failed or was blocked by a Bouncer. -#+begin_src lisp :tangle ../src/context.lisp +#+begin_src lisp :tangle ../library/context.lisp (defun context-get-system-logs () "Retrieves the in-memory circular log buffer." (bt:with-lock-held (*logs-lock*) @@ -73,7 +73,7 @@ Crucial for self-debugging. Provides the agent with the internal logs so it can ** Awareness Assembly (context-assemble-global-awareness) This function acts as the "Contextual Conductor." It synthesizes the various awareness layers into a single, high-signal string suitable for the LLM system prompt. -#+begin_src lisp :tangle ../src/context.lisp +#+begin_src lisp :tangle ../library/context.lisp (defun context-assemble-global-awareness () "Assembles the full context block for a neural request." (let ((projects (context-get-active-projects)) @@ -87,7 +87,7 @@ This function acts as the "Contextual Conductor." It synthesizes the various awa ** Semantic Context Query (context-query-store) A hook for future vector-based retrieval. In the MVP, it performs a simple keyword search over the Memory graph. -#+begin_src lisp :tangle ../src/context.lisp +#+begin_src lisp :tangle ../library/context.lisp (defun context-query-store (query &key (limit 5)) "Placeholder for semantic/vector search over the Memex." (declare (ignore query limit)) diff --git a/literate/loop.org b/harness/loop.org similarity index 94% rename from literate/loop.org rename to harness/loop.org index d6e0017..117cafc 100644 --- a/literate/loop.org +++ b/harness/loop.org @@ -11,7 +11,7 @@ The Metabolic Loop is the high-level coordinator of the OpenCortex. It orchestra Inspired by biological metabolism, the loop ensures that every stimulus is processed until it reaches "stasis" (no further actions required) or an error occurs. This recursive design allows the agent to chain multiple thoughts and tool calls together into a single cohesive cognitive session. ** Pipeline Initialization -#+begin_src lisp :tangle ../src/loop.lisp +#+begin_src lisp :tangle ../library/loop.lisp (in-package :opencortex) #+end_src @@ -20,18 +20,18 @@ Inspired by biological metabolism, the loop ensures that every stimulus is proce ** Metabolic Interrupt Flag The harness must be able to stop gracefully. We use a thread-safe flag to signal the daemon to exit its primary loop. -#+begin_src lisp :tangle ../src/loop.lisp +#+begin_src lisp :tangle ../library/loop.lisp (defvar *interrupt-flag* nil "Thread-safe signal to halt the metabolic pipeline and daemon.") #+end_src -#+begin_src lisp :tangle ../src/loop.lisp +#+begin_src lisp :tangle ../library/loop.lisp (defvar *interrupt-lock* (bt:make-lock "harness-interrupt-lock") "Protects the interrupt flag from concurrent access.") #+end_src ** Heartbeat Thread Reference -#+begin_src lisp :tangle ../src/loop.lisp +#+begin_src lisp :tangle ../library/loop.lisp (defvar *heartbeat-thread* nil "Reference to the background thread driving autonomous reflection.") #+end_src @@ -41,7 +41,7 @@ The harness must be able to stop gracefully. We use a thread-safe flag to signal ** Signal Processor (process-signal) The primary cognitive processor. It takes a normalized signal and pushes it through the gates. If a gate generates "Feedback" (e.g., a tool result), the function recursively processes that feedback as a new stimulus. -#+begin_src lisp :tangle ../src/loop.lisp +#+begin_src lisp :tangle ../library/loop.lisp (defun process-signal (signal) "The entry point to the Metabolic Pipeline: Perceive -> Reason -> Act." (let ((current-signal signal)) @@ -90,7 +90,7 @@ The primary cognitive processor. It takes a normalized signal and pushes it thro ** Heartbeat Mechanism (start-heartbeat) The heartbeat ensures the agent remains "alive" even in the absence of external stimuli. It allows background workers like the Scribe and Gardener to trigger periodically. -#+begin_src lisp :tangle ../src/loop.lisp +#+begin_src lisp :tangle ../library/loop.lisp (defun start-heartbeat () "Starts the background heartbeat thread. Interval is loaded from HEARTBEAT_INTERVAL (default: 60s)." (let ((interval (or (ignore-errors (parse-integer (uiop:getenv "HEARTBEAT_INTERVAL"))) 60))) @@ -109,7 +109,7 @@ The heartbeat ensures the agent remains "alive" even in the absence of external ** Main Daemon Entry Point (main) Initializes the image, boots the gateways, and enters the primary idle loop. -#+begin_src lisp :tangle ../src/loop.lisp +#+begin_src lisp :tangle ../library/loop.lisp (defun main () "Primary entry point for the OpenCortex daemon." ;; 1. Environment Hydration diff --git a/literate/manifest.org b/harness/manifest.org similarity index 100% rename from literate/manifest.org rename to harness/manifest.org diff --git a/literate/memory.org b/harness/memory.org similarity index 92% rename from literate/memory.org rename to harness/memory.org index 92db560..518e8c3 100644 --- a/literate/memory.org +++ b/harness/memory.org @@ -14,14 +14,14 @@ The Memory module is the "conscious mind" of the OpenCortex. Unlike traditional 3. **Graph Sovereignty:** By keeping the graph in-process, we ensure that the user's private knowledge base never leaves the host machine unless explicitly requested by a gateway. ** Pipeline Initialization -#+begin_src lisp :tangle ../src/memory.lisp +#+begin_src lisp :tangle ../library/memory.lisp (in-package :opencortex) #+end_src * Core Data Structures ** The Object Registry -#+begin_src lisp :tangle ../src/memory.lisp +#+begin_src lisp :tangle ../library/memory.lisp (defvar *memory* (make-hash-table :test 'equal) "The primary in-memory graph of all Org-mode entities, keyed by their unique ID.") #+end_src @@ -29,7 +29,7 @@ The Memory module is the "conscious mind" of the OpenCortex. Unlike traditional ** The History Store (Merkle History) OpenCortex maintains a history of memory states to allow for "Micro-Rollbacks" if a skill or tool execution results in an inconsistent state. -#+begin_src lisp :tangle ../src/memory.lisp +#+begin_src lisp :tangle ../library/memory.lisp (defvar *history-store* (make-array 0 :fill-pointer 0 :adjustable t) "A versioned log of the memory state, allowing for temporal traversal and rollback.") #+end_src @@ -37,7 +37,7 @@ OpenCortex maintains a history of memory states to allow for "Micro-Rollbacks" i ** The Org-Object Definition Every headline, paragraph, or task in the Memex is represented as an ~org-object~. -#+begin_src lisp :tangle ../src/memory.lisp +#+begin_src lisp :tangle ../library/memory.lisp (defstruct org-object "The fundamental unit of knowledge in the OpenCortex." id @@ -57,7 +57,7 @@ Every headline, paragraph, or task in the Memex is represented as an ~org-object ** Merkle Hashing (compute-merkle-hash) To ensure data integrity and detect changes during external edits, we utilize Merkle-tree hashing. A node's hash is derived from its own content plus the hashes of its children. -#+begin_src lisp :tangle ../src/memory.lisp +#+begin_src lisp :tangle ../library/memory.lisp (defun compute-merkle-hash (id type attributes content child-hashes) "Computes a SHA-256 Merkle hash for a node based on its core properties and children's hashes." (let* ((alist (loop for (k v) on attributes by #'cddr collect (cons k v))) @@ -74,7 +74,7 @@ To ensure data integrity and detect changes during external edits, we utilize Me ** AST Ingestion (ingest-ast) The primary mechanism for translating raw Org-mode Abstract Syntax Trees (provided by Emacs or a parser) into the live Lisp graph. -#+begin_src lisp :tangle ../src/memory.lisp +#+begin_src lisp :tangle ../library/memory.lisp (defun ingest-ast (ast &optional parent-id) "Recursively parses an Org AST into the Lisp Memory registry." (let* ((type (getf ast :type)) @@ -103,7 +103,7 @@ The primary mechanism for translating raw Org-mode Abstract Syntax Trees (provid * Retrieval and Search ** Object Lookup (lookup-object) -#+begin_src lisp :tangle ../src/memory.lisp +#+begin_src lisp :tangle ../library/memory.lisp (defun lookup-object (id) "Retrieves an object from memory by its ID." (gethash id *memory*)) @@ -112,7 +112,7 @@ The primary mechanism for translating raw Org-mode Abstract Syntax Trees (provid ** Semantic Attribute Search (list-objects-with-attribute) Allows for querying the memory based on metadata (e.g., finding all nodes tagged :PROJECT:). -#+begin_src lisp :tangle ../src/memory.lisp +#+begin_src lisp :tangle ../library/memory.lisp (defun list-objects-with-attribute (key value) "Returns a list of objects that possess the specified attribute pair." (let ((results nil)) @@ -129,7 +129,7 @@ Allows for querying the memory based on metadata (e.g., finding all nodes tagged ** Memory Snapshots (snapshot-memory) Captures the current state of the memory graph. -#+begin_src lisp :tangle ../src/memory.lisp +#+begin_src lisp :tangle ../library/memory.lisp (defun snapshot-memory () "Creates a deep copy of the memory hash table and pushes it to the history store." (let ((new-snap (make-hash-table :test 'equal))) @@ -140,7 +140,7 @@ Captures the current state of the memory graph. ** Micro-Rollbacks (rollback-memory) The primary defense against accidental memory corruption by faulty skills. -#+begin_src lisp :tangle ../src/memory.lisp +#+begin_src lisp :tangle ../library/memory.lisp (defun rollback-memory (&optional (steps 1)) "Restores the memory to a previous snapshot state." (let ((index (- (length *history-store*) steps 1))) diff --git a/literate/package.org b/harness/package.org similarity index 92% rename from literate/package.org rename to harness/package.org index e2e79ac..ada3df1 100644 --- a/literate/package.org +++ b/harness/package.org @@ -18,7 +18,7 @@ flowchart TD #+end_src ** Public API Export -#+begin_src lisp :tangle ../src/package.lisp +#+begin_src lisp :tangle ../library/package.lisp (defpackage :opencortex (:use :cl) (:export @@ -140,7 +140,7 @@ flowchart TD ** Package Implementation Initialization Ensuring the compiler enters the correct namespace for all subsequent definitions. -#+begin_src lisp :tangle ../src/package.lisp +#+begin_src lisp :tangle ../library/package.lisp (in-package :opencortex) #+end_src @@ -152,17 +152,17 @@ OpenCortex maintains a thread-safe circular log buffer. This is critical for two 1. *Neural Introspection:* The probabilistic engine can read the recent system logs to understand why an action failed. 2. *Real-time Debugging:* Clients can subscribe to a live log stream without needing to read the physical log file. -#+begin_src lisp :tangle ../src/package.lisp +#+begin_src lisp :tangle ../library/package.lisp (defvar *system-logs* nil "Thread-safe list of the most recent system messages.") #+end_src -#+begin_src lisp :tangle ../src/package.lisp +#+begin_src lisp :tangle ../library/package.lisp (defvar *logs-lock* (bt:make-lock "harness-logs-lock") "Protects the circular log buffer from race conditions during concurrent skill execution.") #+end_src -#+begin_src lisp :tangle ../src/package.lisp +#+begin_src lisp :tangle ../library/package.lisp (defvar *max-log-history* 100 "The maximum number of entries to preserve in the in-memory log buffer.") #+end_src @@ -170,7 +170,7 @@ OpenCortex maintains a thread-safe circular log buffer. This is critical for two ** Skills Registry All Literate Skills, once compiled, are registered here. This allows for topological sorting and priority-based execution. -#+begin_src lisp :tangle ../src/package.lisp +#+begin_src lisp :tangle ../library/package.lisp (defvar *skills-registry* (make-hash-table :test 'equal) "Global registry of all loaded skills, keyed by their unique identifier.") #+end_src @@ -178,12 +178,12 @@ All Literate Skills, once compiled, are registered here. This allows for topolog ** Skill Telemetry State To ensure the system remains performant and reliable, the harness tracks execution metrics for every skill. -#+begin_src lisp :tangle ../src/package.lisp +#+begin_src lisp :tangle ../library/package.lisp (defvar *skill-telemetry* (make-hash-table :test 'equal) "Stores execution duration and failure counts for every registered skill.") #+end_src -#+begin_src lisp :tangle ../src/package.lisp +#+begin_src lisp :tangle ../library/package.lisp (defvar *telemetry-lock* (bt:make-lock "harness-telemetry-lock") "Protects the telemetry store from concurrent updates.") #+end_src @@ -193,7 +193,7 @@ To ensure the system remains performant and reliable, the harness tracks executi ** Protocol Property Access (proto-get) Lisp keywords can be inconsistent between capitalized and lowercase versions depending on the client (e.g., Emacs vs. Python socket). ~proto-get~ provides a robust abstraction to ensure the system correctly extracts values regardless of keyword casing. -#+begin_src lisp :tangle ../src/package.lisp +#+begin_src lisp :tangle ../library/package.lisp (defun proto-get (plist key) "Robustly retrieves a value from a plist, checking both uppercase and lowercase keyword versions." (let* ((s (string key)) @@ -205,7 +205,7 @@ Lisp keywords can be inconsistent between capitalized and lowercase versions dep ** Telemetry Tracking The ~harness-track-telemetry~ function provides the hook for the metabolic loop to report performance data. -#+begin_src lisp :tangle ../src/package.lisp +#+begin_src lisp :tangle ../library/package.lisp (defun harness-track-telemetry (skill-name duration status) "Updates performance metrics for a specific skill. Status should be :success or :rejected." (when skill-name @@ -221,12 +221,12 @@ The ~harness-track-telemetry~ function provides the hook for the metabolic loop The Tool Registry is the agent's physical interface. It separates the /proposal/ of an action from its /execution/. ** Tool Structure -#+begin_src lisp :tangle ../src/package.lisp +#+begin_src lisp :tangle ../library/package.lisp (defvar *cognitive-tools* (make-hash-table :test 'equal) "The active set of physical capabilities available to the agent.") #+end_src -#+begin_src lisp :tangle ../src/package.lisp +#+begin_src lisp :tangle ../library/package.lisp (defstruct cognitive-tool "Represents a physical or virtual capability with explicit documentation and security guards." name @@ -239,7 +239,7 @@ The Tool Registry is the agent's physical interface. It separates the /proposal/ ** Tool Registration Macro (def-cognitive-tool) We use a macro to ensure that tools are consistently registered and accessible to the LLM's "tool-belt" prompt generator. -#+begin_src lisp :tangle ../src/package.lisp +#+begin_src lisp :tangle ../library/package.lisp (defmacro def-cognitive-tool (name description parameters &key guard body) "Registers a new cognitive tool. NAME: Keyword identifier. @@ -260,7 +260,7 @@ We use a macro to ensure that tools are consistently registered and accessible t ** Centralized Logging (harness-log) The primary mechanism for system transparency. It ensures all activity is both visible to the user and recorded for neural reasoning. -#+begin_src lisp :tangle ../src/package.lisp +#+begin_src lisp :tangle ../library/package.lisp (defun harness-log (msg &rest args) "Centralized logging for the harness. Writes to STDOUT and the thread-safe circular buffer." (let ((formatted-msg (apply #'format nil msg args))) diff --git a/literate/perceive.org b/harness/perceive.org similarity index 95% rename from literate/perceive.org rename to harness/perceive.org index 04b682f..59d8745 100644 --- a/literate/perceive.org +++ b/harness/perceive.org @@ -13,14 +13,14 @@ Normalization is critical because it shields the subsequent reasoning and actuat ** Pipeline Initialization Ensuring we are in the correct namespace for sensory processing. -#+begin_src lisp :tangle ../src/perceive.lisp +#+begin_src lisp :tangle ../library/perceive.lisp (in-package :opencortex) #+end_src ** Sensory Concurrency (Async Sensors) To maintain the agent's responsiveness, we distinguish between "Fast" and "Slow" sensors. Sensors that require extensive processing or external API calls are routed to asynchronous threads to prevent blocking the main metabolic pipeline. -#+begin_src lisp :tangle ../src/perceive.lisp +#+begin_src lisp :tangle ../library/perceive.lisp (defvar *async-sensors* '(:chat-message :delegation :user-command) "List of sensors that should be processed asynchronously to avoid blocking gateways.") #+end_src @@ -28,7 +28,7 @@ To maintain the agent's responsiveness, we distinguish between "Fast" and "Slow" ** Foveal Focus (User Context) The system tracks the user's current point of interaction (the "foveal focus"). This provides immediate situational awareness to the reasoning engine, allowing it to prioritize the data the human is currently looking at. -#+begin_src lisp :tangle ../src/perceive.lisp +#+begin_src lisp :tangle ../library/perceive.lisp (defvar *foveal-focus-id* nil "The Org ID of the node the user is currently interacting with.") #+end_src @@ -40,7 +40,7 @@ The ~inject-stimulus~ function is the universal gateway into the OpenCortex mind 1. *Envelope Wrapping:* Ensures that every raw message is wrapped in a ~:META~ envelope, preserving the source and session information. 2. *Dispatching:* Determines whether to run the metabolism synchronously or in a new thread. -#+begin_src lisp :tangle ../src/perceive.lisp +#+begin_src lisp :tangle ../library/perceive.lisp (defun inject-stimulus (raw-message &key stream (depth 0)) "Enqueues a raw message into the reactive signal pipeline." (let* ((payload (getf raw-message :payload)) @@ -73,7 +73,7 @@ The first official stage of the metabolic loop. It performs "Pre-Cognitive" work 2. *State Sync:* If the signal contains an AST update (e.g., from Emacs), it immediately updates the in-memory graph. 3. *Merkle Checkpointing:* Before modifying memory, it creates a snapshot to allow for emergency rollbacks. -#+begin_src lisp :tangle ../src/perceive.lisp +#+begin_src lisp :tangle ../library/perceive.lisp (defun perceive-gate (signal) "Initial processing: Normalizes raw stimuli and updates memory." (let* ((payload (getf signal :payload)) diff --git a/literate/reason.org b/harness/reason.org similarity index 94% rename from literate/reason.org rename to harness/reason.org index 3cba00d..2ea0222 100644 --- a/literate/reason.org +++ b/harness/reason.org @@ -15,7 +15,7 @@ Cognition is split into two distinct modes: This hybrid approach ensures the agent is both intelligent and mathematically safe. ** Pipeline Initialization -#+begin_src lisp :tangle ../src/reason.lisp +#+begin_src lisp :tangle ../library/reason.lisp (in-package :opencortex) #+end_src @@ -24,29 +24,29 @@ This hybrid approach ensures the agent is both intelligent and mathematically sa ** Neural Backend Registry OpenCortex is provider-agnostic. All neural backends (OpenRouter, Ollama, etc.) register themselves here. -#+begin_src lisp :tangle ../src/reason.lisp +#+begin_src lisp :tangle ../library/reason.lisp (defvar *probabilistic-backends* (make-hash-table :test 'equal) "A global mapping of provider identifiers (keywords) to their respective execution functions.") #+end_src ** Provider Cascade Configuration -#+begin_src lisp :tangle ../src/reason.lisp +#+begin_src lisp :tangle ../library/reason.lisp (defvar *provider-cascade* nil "An ordered list of providers to attempt if the primary one fails.") #+end_src -#+begin_src lisp :tangle ../src/reason.lisp +#+begin_src lisp :tangle ../library/reason.lisp (defvar *model-selector-fn* nil "A hook for dynamic model selection based on context complexity.") #+end_src -#+begin_src lisp :tangle ../src/reason.lisp +#+begin_src lisp :tangle ../library/reason.lisp (defvar *consensus-enabled-p* nil "Flag to enable parallel multi-model voting (not implemented in MVP).") #+end_src ** Backend Registration Helper -#+begin_src lisp :tangle ../src/reason.lisp +#+begin_src lisp :tangle ../library/reason.lisp (defun register-probabilistic-backend (name fn) "Registers a neural provider with its calling function." (setf (gethash name *probabilistic-backends*) fn)) @@ -57,7 +57,7 @@ OpenCortex is provider-agnostic. All neural backends (OpenRouter, Ollama, etc.) ** Probabilistic Call (probabilistic-call) The primary interface for neural reasoning. It iterates through the cascade until a successful response is achieved or the cascade is exhausted. -#+begin_src lisp :tangle ../src/reason.lisp +#+begin_src lisp :tangle ../library/reason.lisp (defun probabilistic-call (prompt &key (system-prompt "You are the Probabilistic engine.") (cascade nil) (context nil)) "Dispatches a neural request through the provider cascade. Returns a Lisp plist or a failure log." (let ((backends (or cascade *provider-cascade*))) @@ -79,7 +79,7 @@ The primary interface for neural reasoning. It iterates through the cascade unti ** LLM Output Sanitization (strip-markdown) Modern LLMs often wrap Lisp code in markdown backticks. This helper ensures the code is clean before the Lisp reader touches it. -#+begin_src lisp :tangle ../src/reason.lisp +#+begin_src lisp :tangle ../library/reason.lisp (defun strip-markdown (text) "Strips common markdown code block markers from text to ensure valid S-expression parsing." (if (and text (stringp text)) @@ -94,7 +94,7 @@ Modern LLMs often wrap Lisp code in markdown backticks. This helper ensures the ** The Thought Process (Think) The core logic that prepares the "mind" for reasoning. It assembles the global awareness (Memex status, recent logs, active tasks) and provides a strict protocol template for the LLM to follow. -#+begin_src lisp :tangle ../src/reason.lisp +#+begin_src lisp :tangle ../library/reason.lisp (defun think (context) "Generates a Lisp action proposal based on current context." (let* ((active-skill (find-triggered-skill context)) @@ -143,7 +143,7 @@ PROVIDER RULE: Always use the default cascade provider unless a specific model o ** Deterministic Verification The final safety check. It iterates through all active skills to verify that the proposed neural action does not violate any invariants. -#+begin_src lisp :tangle ../src/reason.lisp +#+begin_src lisp :tangle ../library/reason.lisp (defun deterministic-verify (proposed-action context) "Iterates through all skill deterministic-gates sorted by priority. Ensures absolute safety of the neural proposal." (let ((current-action proposed-action) @@ -171,7 +171,7 @@ The final safety check. It iterates through all active skills to verify that the ** Reasoning Gate (reason-gate) The stage that ties it all together. It filters stimuli that don't require cognition (like internal heartbeat pulses) and executes the hybrid neural-logical loop. -#+begin_src lisp :tangle ../src/reason.lisp +#+begin_src lisp :tangle ../library/reason.lisp (defun reason-gate (signal) "Unified Stage: Combines Probabilistic proposals and Deterministic verification." (let* ((type (proto-get signal :type)) diff --git a/literate/setup.org b/harness/setup.org similarity index 99% rename from literate/setup.org rename to harness/setup.org index 5cc9441..00f4d4c 100644 --- a/literate/setup.org +++ b/harness/setup.org @@ -252,7 +252,7 @@ WORKDIR /app COPY . . # Initialize system in non-interactive mode -RUN mkdir -p /root/memex && ./opencortex.sh setup --non-interactive +RUN mkdir -p /root/memex /app/environment/logs && ./opencortex.sh setup --non-interactive EXPOSE 9105 diff --git a/literate/skills.org b/harness/skills.org similarity index 91% rename from literate/skills.org rename to harness/skills.org index 4403be9..2e1eee0 100644 --- a/literate/skills.org +++ b/harness/skills.org @@ -15,14 +15,14 @@ The Skill Engine is the modular heart of the OpenCortex. By separating cognitive 4. **The Bouncer Pattern:** Every skill must define a deterministic gate. This is the primary security layer where native Lisp logic verifies probabilistic AI proposals. ** Pipeline Initialization -#+begin_src lisp :tangle ../src/skills.lisp +#+begin_src lisp :tangle ../library/skills.lisp (in-package :opencortex) #+end_src * Skill Definition and Registration ** The Skill Structure -#+begin_src lisp :tangle ../src/skills.lisp +#+begin_src lisp :tangle ../library/skills.lisp (defstruct skill "Represents a hot-reloadable module of intelligence or actuation." name @@ -36,7 +36,7 @@ The Skill Engine is the modular heart of the OpenCortex. By separating cognitive ** Skill Registration Macro (defskill) This macro provides a clean interface for skill authors to register their modules. It automatically handles the integration with the global ~*skills-registry*~. -#+begin_src lisp :tangle ../src/skills.lisp +#+begin_src lisp :tangle ../library/skills.lisp (defmacro defskill (name &key (priority 0) dependencies trigger probabilistic deterministic) "Registers a new skill into the global harness registry." `(setf (gethash (string-downcase (string ',name)) *skills-registry*) @@ -53,7 +53,7 @@ This macro provides a clean interface for skill authors to register their module ** Lisp Syntax Validation (validate-lisp-syntax) Before loading a new skill into the live image, the harness performs a dry-run parse to ensure the code is syntactically valid. This prevents a single hallucinated parenthesis from crashing the entire brain. -#+begin_src lisp :tangle ../src/skills.lisp +#+begin_src lisp :tangle ../library/skills.lisp (defun validate-lisp-syntax (file-path) "Parses a Lisp file without evaluation to verify syntactic integrity." (handler-case @@ -69,12 +69,12 @@ Before loading a new skill into the live image, the harness performs a dry-run p ** Literate Skill Ingestion (load-skill-from-org) The primary mechanism for hot-reloading. It handles the Org-to-Lisp translation and ensures the resulting code is jailed within its own package. -#+begin_src lisp :tangle ../src/skills.lisp +#+begin_src lisp :tangle ../library/skills.lisp (defun load-skill-from-org (org-file-path) "Tangles and loads a single Org-mode skill file." (let* ((filename (file-name-nondirectory (namestring org-file-path))) (skill-id (pathname-name org-file-path)) - (lisp-file (merge-pathnames (concatenate 'string "src/gen/" skill-id ".lisp") + (lisp-file (merge-pathnames (concatenate 'string "library/gen/" skill-id ".lisp") (asdf:system-source-directory :opencortex)))) (ensure-directories-exist lisp-file) @@ -99,7 +99,7 @@ The primary mechanism for hot-reloading. It handles the Org-to-Lisp translation ** Dependency Sorting (topological-sort-skills) Ensures that foundational skills (like the Bouncer or Policy engine) are always loaded before higher-level actuators. -#+begin_src lisp :tangle ../src/skills.lisp +#+begin_src lisp :tangle ../library/skills.lisp (defun topological-sort-skills (skills) "Calculates the correct loading order based on #+DEPENDS_ON metadata." ;; Placeholder: Currently sorts by priority as a proxy for dependencies. @@ -109,7 +109,7 @@ Ensures that foundational skills (like the Bouncer or Policy engine) are always ** Registry Initialization (initialize-all-skills) The high-level boot sequence for the skill engine. -#+begin_src lisp :tangle ../src/skills.lisp +#+begin_src lisp :tangle ../library/skills.lisp (defun initialize-all-skills () "Discovers and loads all Org files in the SKILLS_DIR." (let* ((skills-dir (uiop:getenv "SKILLS_DIR")) @@ -125,7 +125,7 @@ The high-level boot sequence for the skill engine. ** Skill Trigger Discovery (find-triggered-skill) Identifies which skill is best suited to handle the current metabolic signal. -#+begin_src lisp :tangle ../src/skills.lisp +#+begin_src lisp :tangle ../library/skills.lisp (defun find-triggered-skill (context) "Iterates through the registry and returns the first skill whose trigger returns true." (let ((skills nil)) diff --git a/literate/tui-client.org b/harness/tui-client.org similarity index 95% rename from literate/tui-client.org rename to harness/tui-client.org index 69b15d8..cfe3dad 100644 --- a/literate/tui-client.org +++ b/harness/tui-client.org @@ -14,7 +14,7 @@ The TUI Client is a standalone consumer of the OpenCortex protocol. It uses the 3. **Transparency:** The status bar must provide real-time feedback on the state of background workers (Scribe and Gardener). ** Package Context -#+begin_src lisp :tangle ../src/tui-client.lisp +#+begin_src lisp :tangle ../library/tui-client.lisp (in-package :cl-user) (defpackage :opencortex.tui (:use :cl :croatoan) (:export :main)) (in-package :opencortex.tui) @@ -23,7 +23,7 @@ The TUI Client is a standalone consumer of the OpenCortex protocol. It uses the * UI State Management ** Networking and Streams -#+begin_src lisp :tangle ../src/tui-client.lisp +#+begin_src lisp :tangle ../library/tui-client.lisp (defvar *daemon-host* "127.0.0.1") (defvar *daemon-port* 9105) (defvar *socket* nil) @@ -31,7 +31,7 @@ The TUI Client is a standalone consumer of the OpenCortex protocol. It uses the #+end_src ** Terminal Buffers -#+begin_src lisp :tangle ../src/tui-client.lisp +#+begin_src lisp :tangle ../library/tui-client.lisp (defvar *chat-history* nil "A list of strings representing the scrollback buffer.") (defvar *input-buffer* (make-array 0 :element-type 'character :fill-pointer 0 :adjustable t)) (defvar *is-running* t) @@ -41,7 +41,7 @@ The TUI Client is a standalone consumer of the OpenCortex protocol. It uses the ** Thread-Safe Message Queue We use a simple locked queue to move messages from the background listener thread to the foreground rendering loop. -#+begin_src lisp :tangle ../src/tui-client.lisp +#+begin_src lisp :tangle ../library/tui-client.lisp (defvar *msg-queue* nil) (defvar *queue-lock* (bt:make-lock "tui-msg-lock")) @@ -57,7 +57,7 @@ We use a simple locked queue to move messages from the background listener threa ** Keyword Sanitization (clean-keywords) Clients often receive data with inconsistent keyword casing. This helper ensures all incoming keys are normalized for easier processing. -#+begin_src lisp :tangle ../src/tui-client.lisp +#+begin_src lisp :tangle ../library/tui-client.lisp (defun clean-keywords (msg) "Ensures all keys in a plist are uppercase keywords." (if (listp msg) @@ -72,7 +72,7 @@ Clients often receive data with inconsistent keyword casing. This helper ensures ** Payload Extraction (format-payload) The core "intelligence" of the TUI display. It recursively searches a protocol payload for the most relevant human-readable content. -#+begin_src lisp :tangle ../src/tui-client.lisp +#+begin_src lisp :tangle ../library/tui-client.lisp (defun format-payload (payload) "Extracts human-readable text from a protocol payload, handling nested tool calls." (let* ((action (getf payload :ACTION)) @@ -98,7 +98,7 @@ The core "intelligence" of the TUI display. It recursively searches a protocol p ** Background Listener (listen-thread) Runs as a separate thread. It continuously reads framed messages from the daemon and enqueues them for the UI. -#+begin_src lisp :tangle ../src/tui-client.lisp +#+begin_src lisp :tangle ../library/tui-client.lisp (defun listen-thread () (loop while *is-running* do (handler-case @@ -135,7 +135,7 @@ Runs as a separate thread. It continuously reads framed messages from the daemon ** TUI Entry Point (main) Initializes the ncurses screen, sets up the window layout, and handles user keyboard input. -#+begin_src lisp :tangle ../src/tui-client.lisp +#+begin_src lisp :tangle ../library/tui-client.lisp (defun main () "Primary entry point for the standalone TUI client." (handler-case diff --git a/deploy/docker/Dockerfile b/infrastructure_legacy/docker/Dockerfile similarity index 100% rename from deploy/docker/Dockerfile rename to infrastructure_legacy/docker/Dockerfile diff --git a/deploy/docker/docker-compose.yml b/infrastructure_legacy/docker/docker-compose.yml similarity index 100% rename from deploy/docker/docker-compose.yml rename to infrastructure_legacy/docker/docker-compose.yml diff --git a/deploy/bare-metal/install.sh b/infrastructure_new/bare-metal/install.sh similarity index 100% rename from deploy/bare-metal/install.sh rename to infrastructure_new/bare-metal/install.sh diff --git a/deploy/bare-metal/org-agent.service b/infrastructure_new/bare-metal/org-agent.service similarity index 100% rename from deploy/bare-metal/org-agent.service rename to infrastructure_new/bare-metal/org-agent.service diff --git a/infrastructure_new/docker/Dockerfile b/infrastructure_new/docker/Dockerfile new file mode 100644 index 0000000..eae7fd9 --- /dev/null +++ b/infrastructure_new/docker/Dockerfile @@ -0,0 +1,32 @@ +FROM debian:bullseye-slim + +ENV DEBIAN_FRONTEND=noninteractive + +RUN apt-get update && apt-get install -y \ + sbcl \ + emacs-nox \ + curl \ + git \ + socat \ + netcat-openbsd \ + libssl-dev \ + libncurses5-dev \ + libffi-dev \ + zlib1g-dev \ + libsqlite3-dev \ + && rm -rf /var/lib/apt/lists/* + +# Install Quicklisp +RUN curl -O https://beta.quicklisp.org/quicklisp.lisp \ + && sbcl --non-interactive --load quicklisp.lisp --eval "(quicklisp-quickstart:install)" --eval "(ql-util:without-prompting (ql:add-to-init-file))" \ + && rm quicklisp.lisp + +WORKDIR /app +COPY . . + +# Initialize system in non-interactive mode +RUN mkdir -p /root/memex && ./opencortex.sh setup --non-interactive + +EXPOSE 9105 + +CMD ["./opencortex.sh", "boot"] diff --git a/docker-compose.yml b/infrastructure_new/docker/docker-compose.yml similarity index 100% rename from docker-compose.yml rename to infrastructure_new/docker/docker-compose.yml diff --git a/deploy/guix/manifest.scm b/infrastructure_new/guix/manifest.scm similarity index 100% rename from deploy/guix/manifest.scm rename to infrastructure_new/guix/manifest.scm diff --git a/deploy/lxc/setup.org b/infrastructure_new/lxc/setup.org similarity index 100% rename from deploy/lxc/setup.org rename to infrastructure_new/lxc/setup.org diff --git a/deploy/vms/debian/Vagrantfile b/infrastructure_new/vms/debian/Vagrantfile similarity index 100% rename from deploy/vms/debian/Vagrantfile rename to infrastructure_new/vms/debian/Vagrantfile diff --git a/deploy/vms/fedora/Vagrantfile b/infrastructure_new/vms/fedora/Vagrantfile similarity index 100% rename from deploy/vms/fedora/Vagrantfile rename to infrastructure_new/vms/fedora/Vagrantfile diff --git a/scripts/__pycache__/ui_driver.cpython-313.pyc b/interfaces/__pycache__/ui_driver.cpython-313.pyc similarity index 100% rename from scripts/__pycache__/ui_driver.cpython-313.pyc rename to interfaces/__pycache__/ui_driver.cpython-313.pyc diff --git a/scripts/browser-bridge.py b/interfaces/browser-bridge.py similarity index 100% rename from scripts/browser-bridge.py rename to interfaces/browser-bridge.py diff --git a/scripts/opencortex-chat.sh b/interfaces/opencortex-chat.sh similarity index 100% rename from scripts/opencortex-chat.sh rename to interfaces/opencortex-chat.sh diff --git a/scripts/ui_driver.py b/interfaces/ui_driver.py similarity index 100% rename from scripts/ui_driver.py rename to interfaces/ui_driver.py diff --git a/src/act.lisp b/library/act.lisp similarity index 91% rename from src/act.lisp rename to library/act.lisp index 46c4551..09c68f9 100644 --- a/src/act.lisp +++ b/library/act.lisp @@ -1,7 +1,10 @@ (in-package :opencortex) -(defvar *default-actuator* :cli) -(defvar *silent-actuators* '(:cli :system-message :emacs)) +(defvar *default-actuator* :cli + "The fallback actuator used if a signal has no source or target metadata.") + +(defvar *silent-actuators* '(:cli :system-message :emacs) + "List of actuators whose feedback should not re-enter the Reasoning stage.") (defun initialize-actuators () "Loads actuator routing defaults from environment variables and registers core harness actuators." @@ -25,10 +28,12 @@ (finish-output stream)))))) (defun dispatch-action (action context) + "Routes an approved action to its registered physical actuator." (let ((payload (proto-get action :payload))) + ;; Optimization: Heartbeats are system events, not actions. (when (eq (proto-get payload :sensor) :heartbeat) (return-from dispatch-action nil))) - "Routes an approved action to its registered physical actuator." + (when (and action (listp action)) (let* ((meta (proto-get context :meta)) (source (proto-get meta :source)) @@ -38,7 +43,7 @@ *default-actuator*)) (target (intern (string-upcase (string raw-target)) :keyword)) (actuator-fn (gethash target *actuator-registry*))) - ;; Ensure outbound action has meta if context had it + ;; Propagation: Ensure outbound action inherits metadata (when (and meta (null (getf action :meta))) (setf (getf action :meta) meta)) (if actuator-fn @@ -73,7 +78,7 @@ (format nil "TOOL [~a] RESULT: ~a" tool-name result))) (defun execute-tool-action (action context) - "Executes a registered cognitive tool. (ACTUATOR)" + "Executes a registered cognitive tool and generates feedback signals. (ACTUATOR)" (let* ((payload (getf action :payload)) (tool-name (getf payload :tool)) (tool-args (getf payload :args)) @@ -87,7 +92,7 @@ (result (funcall (cognitive-tool-body tool) clean-args))) (let ((feedback (list :TYPE :EVENT :DEPTH (1+ depth) :META meta :PAYLOAD (list :SENSOR :tool-output :RESULT result :TOOL tool-name)))) - ;; If we have a source, send a status message with the result, formatted for humans + ;; UI Propagation: Send distilled text result back to the source client (when source (dispatch-action (list :TYPE :REQUEST :TARGET source :PAYLOAD (list :ACTION :MESSAGE :TEXT (format-tool-result tool-name result))) @@ -133,14 +138,12 @@ (if approved (let* ((target (getf approved :target)) (result (dispatch-action approved context))) - ;; If the actuator returns a signal (like :tool-output), it becomes the feedback. - ;; Otherwise, generate tool-output feedback for non-silent actuators. (cond ((and (listp result) (member (getf result :type) '(:EVENT :LOG))) (setf feedback result)) ((and result (not (member target *silent-actuators*))) (setf feedback (list :type :EVENT :depth (1+ (getf signal :depth 0)) :meta meta :payload (list :sensor :tool-output :result result :tool approved)))))) - ;; If no approved action but we have a source, this might be a raw event/log stimulus. + ;; Fallback: route generic stimuli back to their origin (when source (dispatch-action signal context))))) diff --git a/src/communication-validator.lisp b/library/communication-validator.lisp similarity index 99% rename from src/communication-validator.lisp rename to library/communication-validator.lisp index 329df45..66ff0d8 100644 --- a/src/communication-validator.lisp +++ b/library/communication-validator.lisp @@ -6,7 +6,7 @@ (error "Communication Protocol Schema Error: Message must be a property list (got ~s)" (type-of msg))) (let ((type (let ((raw (proto-get msg :type))) (if (keywordp raw) (intern (string-upcase (string raw)) :keyword) raw)))) - (unless (member type '(:REQUEST :EVENT :RESPONSE :LOG :STATUS)) + (unless (member type '(:REQUEST :EVENT :RESPONSE :LOG :STATUS :CHAT)) (progn (harness-log "REJECTED MSG: ~s" msg) (error "Communication Protocol Schema Error: Invalid message type '~a'" type))) (case type diff --git a/library/communication.lisp b/library/communication.lisp new file mode 100644 index 0000000..12adede --- /dev/null +++ b/library/communication.lisp @@ -0,0 +1,46 @@ +(in-package :opencortex) + +(defun sanitize-protocol-message (msg) + "Recursively strips non-serializable objects (streams, sockets) from a protocol plist." + (if (and msg (listp msg)) + (let ((clean nil)) + (loop for (k v) on msg by #'cddr + do (unless (member k '(:reply-stream :socket :stream)) + (push k clean) + (push (if (listp v) (sanitize-protocol-message v) v) clean))) + (nreverse clean)) + msg)) + +(defun frame-message (msg) + "Serializes a message plist and prefixes it with a 6-character hex length." + (let* ((sanitized (sanitize-protocol-message msg)) + (payload (let ((*print-pretty* nil) (*read-eval* nil)) (format nil "~s" sanitized))) + (len (length payload))) + (format nil "~6,'0x~a" len payload))) + +(defun read-framed-message (stream) + "Reads a hex-prefixed message from a stream. Returns the parsed Lisp plist or :EOF." + (handler-case + (let ((len-buf (make-string 6))) + ;; 1. Read the length prefix + (let ((count (read-sequence len-buf stream))) + (if (< count 6) + :eof + (let ((len (ignore-errors (parse-integer len-buf :radix 16)))) + (if (and len (> len 0)) + ;; 2. Read exactly 'len' bytes + (let ((payload-buf (make-string len))) + (read-sequence payload-buf stream) + (let ((*read-eval* nil)) + (read-from-string payload-buf))) + :error))))) + (error (c) + (harness-log "PROTOCOL ERROR: ~a" c) + :error))) + +(defun make-hello-message (version) + "Constructs the standard HELLO handshake message." + (list :TYPE :EVENT + :PAYLOAD (list :ACTION :handshake + :VERSION version + :CAPABILITIES '(:AUTH :SWANK :ORG-AST)))) diff --git a/library/context.lisp b/library/context.lisp new file mode 100644 index 0000000..17121be --- /dev/null +++ b/library/context.lisp @@ -0,0 +1,41 @@ +(in-package :opencortex) + +(defun context-get-active-projects () + "Retrieves a list of project headlines currently marked as NEXT or in progress." + (let ((all-projects (list-objects-with-attribute :CATEGORY "Project"))) + (loop for p in all-projects + collect (list :id (org-object-id p) + :title (getf (org-object-attributes p) :TITLE))))) + +(defun context-get-recent-completed-tasks (&optional (limit 5)) + "Retrieves the last N tasks marked as DONE from the memory history." + (let ((all-completed (list-objects-with-attribute :TODO "DONE"))) + (subseq (sort all-completed #'> :key #'org-object-version) + 0 (min limit (length all-completed))))) + +(defun context-list-all-skills () + "Returns a list of registered skills and their documentation." + (let ((results nil)) + (maphash (lambda (id skill) + (push (list :id id :name (skill-name skill)) results)) + *skills-registry*) + results)) + +(defun context-get-system-logs () + "Retrieves the in-memory circular log buffer." + (bt:with-lock-held (*logs-lock*) + (format nil "~{~a~%~}" (reverse *system-logs*)))) + +(defun context-assemble-global-awareness () + "Assembles the full context block for a neural request." + (let ((projects (context-get-active-projects)) + (time (multiple-value-bind (s m h d mo y) (get-decoded-time) (format nil "~a-~a-~a ~a:~a:~a" y mo d h m s)))) + (format nil "CURRENT_TIME: ~a. ACTIVE_PROJECTS: ~s. FOVEAL_FOCUS: ~a" + time + projects + (or *foveal-focus-id* "None")))) + +(defun context-query-store (query &key (limit 5)) + "Placeholder for semantic/vector search over the Memex." + (declare (ignore query limit)) + nil) diff --git a/src/loop.lisp b/library/loop.lisp similarity index 74% rename from src/loop.lisp rename to library/loop.lisp index 8fbddc0..4fe4973 100644 --- a/src/loop.lisp +++ b/library/loop.lisp @@ -1,8 +1,13 @@ (in-package :opencortex) -(defvar *interrupt-flag* nil) -(defvar *interrupt-lock* (bt:make-lock "harness-interrupt-lock")) -(defvar *heartbeat-thread* nil) +(defvar *interrupt-flag* nil + "Thread-safe signal to halt the metabolic pipeline and daemon.") + +(defvar *interrupt-lock* (bt:make-lock "harness-interrupt-lock") + "Protects the interrupt flag from concurrent access.") + +(defvar *heartbeat-thread* nil + "Reference to the background thread driving autonomous reflection.") (defun process-signal (signal) "The entry point to the Metabolic Pipeline: Perceive -> Reason -> Act." @@ -10,59 +15,69 @@ (loop while current-signal do (let ((depth (getf current-signal :depth 0)) (meta (getf current-signal :meta))) + ;; Safety: Prevent infinite cognitive recursion. (when (> depth 10) (harness-log "METABOLISM ERROR: Max depth reached.") (return nil)) + + ;; Check for graceful shutdown. (when (bt:with-lock-held (*interrupt-lock*) *interrupt-flag*) (harness-log "METABOLISM: Interrupted.") (bt:with-lock-held (*interrupt-lock*) (setf *interrupt-flag* nil)) (return nil)) + (handler-case (progn + ;; Stage 1: Ingest and Normalize (setf current-signal (perceive-gate current-signal)) + ;; Stage 2: Cogitate and Verify (setf current-signal (reason-gate current-signal)) + ;; Stage 3: Actuate and Generate Feedback (let ((feedback (act-gate current-signal))) - ;; feedback generation (if feedback (progn - ;; Inherit meta from trigger signal + ;; Inheritance: Metadata must persist across recursive cycles. (unless (getf feedback :meta) (setf (getf feedback :meta) meta)) (setf current-signal feedback)) (setf current-signal nil)))) (error (c) (let ((sensor (ignore-errors (getf (getf current-signal :payload) :sensor)))) (harness-log "METABOLISM CRASH [~a]: ~a" (or sensor :unknown) c) - ;; Only rollback on critical errors, not standard tool or loop errors + ;; Resilience: Only rollback on critical system errors. (unless (member sensor '(:loop-error :tool-error :syntax-error)) (harness-log "CRITICAL ERROR: Initiating Micro-Rollback.") (rollback-memory 0)) + ;; If recursion is shallow, attempt to notify the user of the error. (if (or (> depth 2) (member sensor '(:loop-error :tool-error))) (setf current-signal nil) (setf current-signal (list :type :EVENT :depth (1+ depth) :meta meta :payload (list :sensor :loop-error :message (format nil "~a" c) :depth depth))))))))))) (defun start-heartbeat () - "Starts the background heartbeat thread. Interval is loaded from HEARTBEAT_INTERVAL." + "Starts the background heartbeat thread. Interval is loaded from HEARTBEAT_INTERVAL (default: 60s)." (let ((interval (or (ignore-errors (parse-integer (uiop:getenv "HEARTBEAT_INTERVAL"))) 60))) (setf *heartbeat-thread* (bt:make-thread (lambda () (loop (sleep interval) - ;; inject-stimulus is synchronous for heartbeats, preventing accumulation. + ;; Note: inject-stimulus is synchronous for heartbeats to prevent task accumulation. (inject-stimulus (list :type :EVENT :payload (list :sensor :heartbeat :unix-time (get-universal-time)))))) :name "opencortex-heartbeat")))) (defun main () - "Entry point for the Skeleton MVP. Handles initialization and graceful shutdown." + "Primary entry point for the OpenCortex daemon." + ;; 1. Environment Hydration (let* ((home (uiop:getenv "HOME")) (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))) + ;; 2. System Bootstrap (initialize-actuators) (initialize-all-skills) + ;; 3. Wake up the heart. (start-heartbeat) - ;; Graceful shutdown handler for SBCL + ;; 4. OS Signal Handling (SBCL specific) #+sbcl (sb-sys:enable-interrupt sb-unix:sigint (lambda (sig code scp) @@ -70,6 +85,7 @@ (harness-log "SHUTDOWN: SIGINT received. Exiting...") (uiop:quit 0))) + ;; 5. Primary Idle Loop (let ((sleep-interval (or (ignore-errors (parse-integer (uiop:getenv "DAEMON_SLEEP_INTERVAL"))) 3600))) (loop (when (bt:with-lock-held (*interrupt-lock*) *interrupt-flag*) (return)) diff --git a/library/memory.lisp b/library/memory.lisp new file mode 100644 index 0000000..f418a7a --- /dev/null +++ b/library/memory.lisp @@ -0,0 +1,81 @@ +(in-package :opencortex) + +(defvar *memory* (make-hash-table :test 'equal) + "The primary in-memory graph of all Org-mode entities, keyed by their unique ID.") + +(defvar *history-store* (make-array 0 :fill-pointer 0 :adjustable t) + "A versioned log of the memory state, allowing for temporal traversal and rollback.") + +(defstruct org-object + "The fundamental unit of knowledge in the OpenCortex." + id + type + attributes + parent-id + children + version + last-sync + vector + content + hash) + +(defun compute-merkle-hash (id type attributes content child-hashes) + "Computes a SHA-256 Merkle hash for a node based on its core properties and children's hashes." + (let* ((alist (loop for (k v) on attributes by #'cddr collect (cons k v))) + (sorted-alist (sort alist #'string< :key (lambda (x) (format nil "~a" (car x))))) + (attr-string (format nil "~s" sorted-alist)) + (children-string (format nil "~{~a~}" child-hashes)) + (raw-data (format nil "~a|~a|~a|~a|~a" id type attr-string (or content "") children-string))) + (ironclad:byte-array-to-hex-string + (ironclad:digest-sequence :sha256 (ironclad:ascii-string-to-byte-array raw-data))))) + +(defun ingest-ast (ast &optional parent-id) + "Recursively parses an Org AST into the Lisp Memory registry." + (let* ((type (getf ast :type)) + (properties (getf ast :properties)) + (id (or (getf properties :ID) (uuid:make-v4-uuid))) + (content (getf ast :content)) + (children (getf ast :contents)) + (child-ids nil)) + + ;; Recursively ingest children and collect their IDs + (dolist (child children) + (let ((child-obj (ingest-ast child id))) + (when child-obj (push (org-object-id child-obj) child-ids)))) + + (let ((obj (make-org-object :id id + :type type + :attributes properties + :parent-id parent-id + :children (nreverse child-ids) + :content content + :version (get-universal-time)))) + (setf (gethash id *memory*) obj) + obj))) + +(defun lookup-object (id) + "Retrieves an object from memory by its ID." + (gethash id *memory*)) + +(defun list-objects-with-attribute (key value) + "Returns a list of objects that possess the specified attribute pair." + (let ((results nil)) + (maphash (lambda (id obj) + (declare (ignore id)) + (when (equal (getf (org-object-attributes obj) key) value) + (push obj results))) + *memory*) + results)) + +(defun snapshot-memory () + "Creates a deep copy of the memory hash table and pushes it to the history store." + (let ((new-snap (make-hash-table :test 'equal))) + (maphash (lambda (k v) (setf (gethash k new-snap) (copy-org-object v))) *memory*) + (vector-push-extend new-snap *history-store*))) + +(defun rollback-memory (&optional (steps 1)) + "Restores the memory to a previous snapshot state." + (let ((index (- (length *history-store*) steps 1))) + (when (>= index 0) + (setf *memory* (aref *history-store* index)) + (harness-log "IMMUNE SYSTEM: Memory rolled back ~a steps." steps)))) diff --git a/src/opencortex.el b/library/opencortex.el similarity index 100% rename from src/opencortex.el rename to library/opencortex.el diff --git a/src/package.lisp b/library/package.lisp similarity index 78% rename from src/package.lisp rename to library/package.lisp index 25a53db..41c5293 100644 --- a/src/package.lisp +++ b/library/package.lisp @@ -1,7 +1,7 @@ (defpackage :opencortex (:use :cl) (:export - ;; --- communication protocol --- + ;; --- Communication Protocol --- #:frame-message #:read-framed-message #:PROTO-GET @@ -118,33 +118,30 @@ (in-package :opencortex) -(defun proto-get (plist key) - "Robustly retrieves a value from a plist, checking both uppercase and lowercase keyword versions." - (let* ((s (string key)) - (up (intern (string-upcase s) :keyword)) - (dn (intern (string-downcase s) :keyword))) - (or (getf plist up) (getf plist dn)))) +(defvar *system-logs* nil + "Thread-safe list of the most recent system messages.") -(in-package :opencortex) +(defvar *logs-lock* (bt:make-lock "harness-logs-lock") + "Protects the circular log buffer from race conditions during concurrent skill execution.") -(defun proto-get (plist key) - "Robustly retrieves a value from a plist, checking both uppercase and lowercase keyword versions." - (let* ((s (string key)) - (up (intern (string-upcase s) :keyword)) - (dn (intern (string-downcase s) :keyword))) - (or (getf plist up) (getf plist dn)))) - -(in-package :opencortex) - -(defvar *system-logs* nil) -(defvar *logs-lock* (bt:make-lock "harness-logs-lock")) -(defvar *max-log-history* 100) +(defvar *max-log-history* 100 + "The maximum number of entries to preserve in the in-memory log buffer.") (defvar *skills-registry* (make-hash-table :test 'equal) - "Global registry of all loaded skills.") + "Global registry of all loaded skills, keyed by their unique identifier.") -(defvar *skill-telemetry* (make-hash-table :test 'equal)) -(defvar *telemetry-lock* (bt:make-lock "harness-telemetry-lock")) +(defvar *skill-telemetry* (make-hash-table :test 'equal) + "Stores execution duration and failure counts for every registered skill.") + +(defvar *telemetry-lock* (bt:make-lock "harness-telemetry-lock") + "Protects the telemetry store from concurrent updates.") + +(defun proto-get (plist key) + "Robustly retrieves a value from a plist, checking both uppercase and lowercase keyword versions." + (let* ((s (string key)) + (up (intern (string-upcase s) :keyword)) + (dn (intern (string-downcase s) :keyword))) + (or (getf plist up) (getf plist dn)))) (defun harness-track-telemetry (skill-name duration status) "Updates performance metrics for a specific skill. Status should be :success or :rejected." @@ -156,9 +153,11 @@ (when (eq status :rejected) (incf (getf entry :failures))) (setf (gethash skill-name *skill-telemetry*) entry))))) -(defvar *cognitive-tools* (make-hash-table :test 'equal)) +(defvar *cognitive-tools* (make-hash-table :test 'equal) + "The active set of physical capabilities available to the agent.") (defstruct cognitive-tool + "Represents a physical or virtual capability with explicit documentation and security guards." name description parameters @@ -166,7 +165,12 @@ body) (defmacro def-cognitive-tool (name description parameters &key guard body) - "Registers a new cognitive tool into the global registry. Parameters must be a list of property lists." + "Registers a new cognitive tool. + NAME: Keyword identifier. + DESCRIPTION: Human-readable intent (used in LLM prompts). + PARAMETERS: List of property lists defining arguments. + GUARD: (context -> boolean) function to prevent unsafe calls. + BODY: The actual Lisp execution logic." `(setf (gethash (string-downcase (string ',name)) *cognitive-tools*) (make-cognitive-tool :name (string-downcase (string ',name)) :description ,description @@ -175,7 +179,7 @@ :body ,body))) (defun harness-log (msg &rest args) - "Centralized logging for the harness." + "Centralized logging for the harness. Writes to STDOUT and the thread-safe circular buffer." (let ((formatted-msg (apply #'format nil msg args))) (bt:with-lock-held (*logs-lock*) (push formatted-msg *system-logs*) diff --git a/src/perceive.lisp b/library/perceive.lisp similarity index 100% rename from src/perceive.lisp rename to library/perceive.lisp diff --git a/src/policy.lisp b/library/policy.lisp similarity index 100% rename from src/policy.lisp rename to library/policy.lisp diff --git a/src/probabilistic.lisp b/library/probabilistic.lisp similarity index 100% rename from src/probabilistic.lisp rename to library/probabilistic.lisp diff --git a/src/reason.lisp b/library/reason.lisp similarity index 89% rename from src/reason.lisp rename to library/reason.lisp index 3168be1..d27d50c 100644 --- a/src/reason.lisp +++ b/library/reason.lisp @@ -1,12 +1,19 @@ (in-package :opencortex) -(defvar *probabilistic-backends* (make-hash-table :test 'equal)) -(defvar *provider-cascade* nil) -(defvar *model-selector-fn* nil) -(defvar *consensus-enabled-p* nil) +(defvar *probabilistic-backends* (make-hash-table :test 'equal) + "A global mapping of provider identifiers (keywords) to their respective execution functions.") + +(defvar *provider-cascade* nil + "An ordered list of providers to attempt if the primary one fails.") + +(defvar *model-selector-fn* nil + "A hook for dynamic model selection based on context complexity.") + +(defvar *consensus-enabled-p* nil + "Flag to enable parallel multi-model voting (not implemented in MVP).") (defun register-probabilistic-backend (name fn) - "Registers a neural provider (e.g., :gemini, :anthropic) with its calling function." + "Registers a neural provider with its calling function." (setf (gethash name *probabilistic-backends*) fn)) (defun probabilistic-call (prompt &key (system-prompt "You are the Probabilistic engine.") (cascade nil) (context nil)) @@ -27,7 +34,7 @@ (list :type :LOG :payload (list :text "Neural Cascade Failure: All providers exhausted."))))) (defun strip-markdown (text) - "Strips common markdown code block markers from text." + "Strips common markdown code block markers from text to ensure valid S-expression parsing." (if (and text (stringp text)) (let ((cleaned text)) (setf cleaned (cl-ppcre:regex-replace-all "^```[a-z]*\\n" cleaned "")) @@ -81,7 +88,7 @@ PROVIDER RULE: Always use the default cascade provider unless a specific model o thought))))) (defun deterministic-verify (proposed-action context) - "Iterates through all skill deterministic-gates sorted by priority." + "Iterates through all skill deterministic-gates sorted by priority. Ensures absolute safety of the neural proposal." (let ((current-action proposed-action) (skills nil)) (maphash (lambda (name skill) (declare (ignore name)) (when (skill-deterministic-fn skill) (push skill skills))) *skills-registry*) @@ -106,6 +113,7 @@ PROVIDER RULE: Always use the default cascade provider unless a specific model o (let* ((type (proto-get signal :type)) (payload (proto-get signal :payload)) (sensor (proto-get payload :sensor))) + ;; Optimization: Only reason about user input or chat messages. (unless (and (eq type :EVENT) (member sensor '(:user-input :chat-message))) (return-from reason-gate signal)) (let ((candidate (think signal))) diff --git a/library/skills.lisp b/library/skills.lisp new file mode 100644 index 0000000..1e448dc --- /dev/null +++ b/library/skills.lisp @@ -0,0 +1,79 @@ +(in-package :opencortex) + +(defstruct skill + "Represents a hot-reloadable module of intelligence or actuation." + name + priority + dependencies + trigger-fn + probabilistic-prompt + deterministic-fn) + +(defmacro defskill (name &key (priority 0) dependencies trigger probabilistic deterministic) + "Registers a new skill into the global harness registry." + `(setf (gethash (string-downcase (string ',name)) *skills-registry*) + (make-skill :name (string-downcase (string ',name)) + :priority ,priority + :dependencies ,dependencies + :trigger-fn ,trigger + :probabilistic-prompt ,probabilistic + :deterministic-fn ,deterministic))) + +(defun validate-lisp-syntax (file-path) + "Parses a Lisp file without evaluation to verify syntactic integrity." + (handler-case + (with-open-file (stream file-path) + (loop for form = (read stream nil :eof) + until (eq form :eof)) + t) + (error (c) + (harness-log "SYNTAX ERROR in ~a: ~a" file-path c) + nil))) + +(defun load-skill-from-org (org-file-path) + "Tangles and loads a single Org-mode skill file." + (let* ((filename (file-name-nondirectory (namestring org-file-path))) + (skill-id (pathname-name org-file-path)) + (lisp-file (merge-pathnames (concatenate 'string "library/gen/" skill-id ".lisp") + (asdf:system-source-directory :opencortex)))) + + (ensure-directories-exist lisp-file) + (harness-log "LOADER: Loading ~a..." skill-id) + + ;; 1. Tangle the Org file into Lisp + (uiop:run-program (list "emacs" "--batch" "--eval" "(require 'org)" + "--eval" (format nil "(org-babel-tangle-file \"~a\")" org-file-path)) + :output t) + + ;; 2. Verify and Load + (if (validate-lisp-syntax lisp-file) + (progn + (handler-case (load lisp-file) + (error (c) (harness-log "LOADER ERROR in skill '~a': ~a" skill-id c))) + t) + nil))) + +(defun topological-sort-skills (skills) + "Calculates the correct loading order based on #+DEPENDS_ON metadata." + ;; Placeholder: Currently sorts by priority as a proxy for dependencies. + (sort skills #'> :key #'skill-priority)) + +(defun initialize-all-skills () + "Discovers and loads all Org files in the SKILLS_DIR." + (let* ((skills-dir (uiop:getenv "SKILLS_DIR")) + (files (when (and skills-dir (uiop:directory-exists-p skills-dir)) + (uiop:directory-files skills-dir "*.org")))) + (dolist (f files) + (load-skill-from-org f)) + (harness-log "LOADER: Boot Complete. [Ready: ~a] [Failed: 0]" (hash-table-count *skills-registry*)))) + +(defun find-triggered-skill (context) + "Iterates through the registry and returns the first skill whose trigger returns true." + (let ((skills nil)) + (maphash (lambda (name skill) (declare (ignore name)) (push skill skills)) *skills-registry*) + (setf skills (sort skills #'> :key #'skill-priority)) + (dolist (s skills) + (let ((trigger (skill-trigger-fn s))) + (when (and trigger (funcall trigger context)) + (return-from find-triggered-skill s)))) + nil)) diff --git a/src/tui-client.lisp b/library/tui-client.lisp similarity index 89% rename from src/tui-client.lisp rename to library/tui-client.lisp index 563ac7b..a907181 100644 --- a/src/tui-client.lisp +++ b/library/tui-client.lisp @@ -1,31 +1,28 @@ (in-package :cl-user) -(defpackage :opencortex.tui - (:use :cl :croatoan) - (:export :main)) +(defpackage :opencortex.tui (:use :cl :croatoan) (:export :main)) (in-package :opencortex.tui) (defvar *daemon-host* "127.0.0.1") (defvar *daemon-port* 9105) (defvar *socket* nil) (defvar *stream* nil) -(defvar *chat-history* (list)) -(defvar *status-text* "Connecting...") -(defvar *input-buffer* (make-array 0 :element-type 'char :fill-pointer 0 :adjustable t)) + +(defvar *chat-history* nil "A list of strings representing the scrollback buffer.") +(defvar *input-buffer* (make-array 0 :element-type 'character :fill-pointer 0 :adjustable t)) (defvar *is-running* t) -(defvar *queue-lock* (bt:make-lock)) -(defvar *incoming-msgs* nil) +(defvar *status-text* "Connecting...") + +(defvar *msg-queue* nil) +(defvar *queue-lock* (bt:make-lock "tui-msg-lock")) (defun enqueue-msg (msg) - (bt:with-lock-held (*queue-lock*) - (push msg *incoming-msgs*))) + (bt:with-lock-held (*queue-lock*) (push msg *msg-queue*))) (defun dequeue-msgs () - (bt:with-lock-held (*queue-lock*) - (let ((msgs (nreverse *incoming-msgs*))) - (setf *incoming-msgs* nil) - msgs))) + (bt:with-lock-held (*queue-lock*) (let ((m (reverse *msg-queue*))) (setf *msg-queue* nil) m))) (defun clean-keywords (msg) + "Ensures all keys in a plist are uppercase keywords." (if (listp msg) (let ((clean nil)) (loop for (k v) on msg by #'cddr @@ -86,6 +83,7 @@ (sleep 0.05))) (defun main () + "Primary entry point for the standalone TUI client." (handler-case (setf *socket* (usocket:socket-connect *daemon-host* *daemon-port*)) (error (e) (format t "Error connecting: ~a~%" e) (return-from main))) @@ -105,11 +103,12 @@ (setf (input-blocking input-win) nil) (loop while *is-running* do - ;; 1. Handle incoming messages + ;; 1. Handle incoming messages from the queue (let ((new-msgs (dequeue-msgs))) (when new-msgs (dolist (msg new-msgs) (push msg *chat-history*) + ;; Maintenance: Cap scrollback to prevent memory bloat (setf *chat-history* (subseq *chat-history* 0 (min (length *chat-history*) 500)))) (clear chat-win) @@ -119,7 +118,7 @@ (incf line-num))) (refresh chat-win))) - ;; 2. Render Status Bar ONLY if changed + ;; 2. Render Status Bar (unless (equal *status-text* last-status) (clear status-win) (add-string status-win *status-text* :attributes '(:reverse)) @@ -135,9 +134,7 @@ (let ((cmd (coerce *input-buffer* 'string))) (setf (fill-pointer *input-buffer*) 0) (when (> (length cmd) 0) - ;; Local Echo - (enqueue-msg (concatenate 'string "> " cmd)) - ;; Send to Brain + ;; Frame and dispatch the message (let ((framed (opencortex:frame-message (list :TYPE :EVENT :META (list :SOURCE :tui :SESSION-ID "default") :PAYLOAD (list :SENSOR :user-input :TEXT cmd))))) diff --git a/skills/org-skill-policy.org b/skills/org-skill-policy.org index 61294fe..d350d35 100644 --- a/skills/org-skill-policy.org +++ b/skills/org-skill-policy.org @@ -13,7 +13,7 @@ The *opencortex* is a probabilistic-deterministic harness for a personal operati * Package Context Every skill executes within its own jailed package namespace, while inheriting core harness symbols. -#+begin_src lisp :tangle ../src/policy.lisp +#+begin_src lisp :tangle ../library/policy.lisp (in-package :opencortex) #+end_src @@ -23,7 +23,7 @@ This document contains the *Core System Policy*. These are non-negotiable philos ** 1. Autonomy Above All Every action must increase the user's independence from centralized, proprietary platforms. If a tool or library introduces a dependency on a non-autonomous entity, it must be flagged for replacement. -#+begin_src lisp :tangle ../src/policy.lisp +#+begin_src lisp :tangle ../library/policy.lisp (defun policy-check-autonomy (action context) "Ensures the action does not violate the Autonomy invariant." (declare (ignore context)) @@ -47,7 +47,7 @@ Prioritize local, energy-efficient, and offline-first architectures. The "Memex" * The Policy Gate The main deterministic entry point for the policy skill. It orchestrates the various invariant checks and delegates to engineering standards. -#+begin_src lisp :tangle ../src/policy.lisp +#+begin_src lisp :tangle ../library/policy.lisp (defun policy-deterministic-gate (action context) "The main policy gate. Sub-calls engineering standards if available." (let ((current-action (policy-check-autonomy action context))) @@ -64,7 +64,7 @@ The main deterministic entry point for the policy skill. It orchestrates the var Every action performed by an agent in this environment must also adhere to the [[file:org-skill-engineering-standards.org][Engineering Standards]]. ** Skill Registration -#+begin_src lisp :tangle ../src/policy.lisp +#+begin_src lisp :tangle ../library/policy.lisp (defskill :skill-policy :priority 100 :trigger (lambda (ctx) t) diff --git a/skills/org-skill-protocol-validator.org b/skills/org-skill-protocol-validator.org index 1040a9b..3dd8ea8 100644 --- a/skills/org-skill-protocol-validator.org +++ b/skills/org-skill-protocol-validator.org @@ -45,7 +45,7 @@ Decouple protocol parsing (framing/unframing) from semantic validation. * Phase D: Build (Implementation) ** Schema Enforcement -#+begin_src lisp :tangle ../src/communication-validator.lisp +#+begin_src lisp :tangle ../library/communication-validator.lisp (in-package :opencortex) (defun validate-communication-protocol-schema (msg) @@ -79,7 +79,7 @@ Decouple protocol parsing (framing/unframing) from semantic validation. #+end_src * Registration -#+begin_src lisp :tangle ../src/communication-validator.lisp +#+begin_src lisp :tangle ../library/communication-validator.lisp (defskill :skill-communication-protocol-validator :priority 95 :trigger (lambda (ctx) (member (getf (getf ctx :payload) :sensor) '(:protocol-received))) diff --git a/src/communication.lisp b/src/communication.lisp deleted file mode 100644 index 4f9fb2b..0000000 --- a/src/communication.lisp +++ /dev/null @@ -1,75 +0,0 @@ -(in-package :opencortex) - -(defvar *actuator-registry* (make-hash-table :test 'equalp) - "Global registry mapping target keywords to their physical actuator functions.") - -(defun register-actuator (name fn) - "Registers an actuator function. Actuators receive: (ACTION CONTEXT)." - (let ((key (if (keywordp name) name (intern (string-upcase (string name)) :keyword)))) - (setf (gethash key *actuator-registry*) fn))) - -(defun frame-message (msg-plist) - "Frames a Lisp plist with a 6-character hex length and a newline for stream integrity." - (let* ((*print-pretty* nil) - (*print-circle* nil) - (msg-string (format nil "~s" msg-plist)) - (len (length msg-string))) - (format nil "~6,'0x~a~%" len msg-string))) - -(defun read-framed-message (stream) - "Reads a hex-length prefixed S-expression from the stream securely. Skips leading whitespace." - (let ((length-buffer (make-string 6))) - (handler-case - (progn - ;; 1. Skip leading whitespace (newlines, spaces, etc.) - (loop for char = (peek-char nil stream nil :eof) - while (and (not (eq char :eof)) (member char '(#\Space #\Newline #\Tab #\Return))) - do (read-char stream)) - - ;; 2. Read the 6-char hex length - (let ((count (read-sequence length-buffer stream))) - (cond ((< count 6) :eof) - (t (let ((len (ignore-errors (parse-integer length-buffer :radix 16)))) - (if (not len) - (progn - (harness-log "PROTOCOL ERROR: Invalid header ~s. Attempting resync..." length-buffer) - :error) - (let ((msg-buffer (make-string len))) - (read-sequence msg-buffer stream) - (let ((*read-eval* nil) - (*print-pretty* nil)) - (handler-case - (let ((msg (read-from-string msg-buffer))) - (validate-communication-protocol-schema msg) - msg) - (error (c) - (harness-log "PROTOCOL PARSE ERROR: ~a in ~s" c msg-buffer) - :error)))))))))) - (error (c) - (harness-log "PROTOCOL READ ERROR: ~a" c) - :error)))) - -(defun make-hello-message (version) - "Constructs the standard HELLO handshake message." - (list :TYPE :EVENT - :PAYLOAD (list :ACTION :handshake - :VERSION version - :CAPABILITIES '(:AUTH :SWANK :ORG-AST)))) - -(defun sanitize-protocol-message (msg) - "Recursively strips non-serializable objects from a protocol plist." - (if (and msg (listp msg)) - (let ((clean nil)) - (loop for (k v) on msg by #'cddr - do (unless (member k '(:reply-stream :socket :stream)) - (push k clean) - (push (if (listp v) (sanitize-protocol-message v) v) clean))) - (nreverse clean)) - msg)) - -(defun frame-message (msg) - "Serializes a message plist and prefixes it with a 6-character hex length." - (let* ((sanitized (sanitize-protocol-message msg)) - (payload (let ((*print-pretty* nil) (*read-eval* nil)) (format nil "~s" sanitized))) - (len (length payload))) - (format nil "~6,'0x~a" len payload))) diff --git a/src/context.lisp b/src/context.lisp deleted file mode 100644 index 5fc3eda..0000000 --- a/src/context.lisp +++ /dev/null @@ -1,119 +0,0 @@ -(in-package :opencortex) - -(defun context-query-store (&key tag todo-state type) - "Filters the Memory based on tags, todo states, or types." - (let ((results nil)) - (maphash (lambda (id obj) - (declare (ignore id)) - (let* ((attrs (org-object-attributes obj)) (state (getf attrs :TODO-STATE)) (match t)) - (when (and type (not (eq (org-object-type obj) type))) (setf match nil)) - (when tag (unless (search tag (format nil "~a" (getf attrs :TAGS)) :test #'string-equal) (setf match nil))) - (when (and todo-state (not (equal state todo-state))) (setf match nil)) - (when match (push obj results)))) - *memory*) - results)) - -(defun context-get-active-projects () - "Returns headlines tagged as 'project' that are not yet marked DONE." - (remove-if (lambda (obj) (equal (getf (org-object-attributes obj) :TODO-STATE) "DONE")) - (context-query-store :tag "project" :type :HEADLINE))) - -(defun context-get-recent-completed-tasks () - "Retrieves recently finished tasks from the store." - (context-query-store :todo-state "DONE" :type :HEADLINE)) - -(defun context-list-all-skills () - "Provides a sorted overview of currently loaded system capabilities." - (let ((results nil)) - (maphash (lambda (name skill) - (declare (ignore name)) - (push (list :name (skill-name skill) :priority (skill-priority skill) :dependencies (skill-dependencies skill)) results)) - *skills-registry*) - (sort results #'> :key (lambda (x) (getf x :priority))))) - -(defun context-get-skill-source (skill-name) - "Reads the raw literate source of a specific skill for inspection." - (let* ((filename (format nil "~a.org" skill-name)) - (skills-dir-str (or (uiop:getenv "SKILLS_DIR") (namestring (merge-pathnames "notes/" (user-homedir-pathname))))) - (skills-dir (uiop:ensure-directory-pathname (context-resolve-path skills-dir-str))) - (full-path (merge-pathnames filename skills-dir))) - (if (uiop:file-exists-p full-path) (uiop:read-file-string full-path) nil))) - -(defun context-get-system-logs (&optional limit) - "Retrieves the most recent lines from the harness's internal log." - (let ((log-limit (or limit (ignore-errors (parse-integer (uiop:getenv "CONTEXT_LOG_LIMIT"))) 20))) - (bt:with-lock-held (*logs-lock*) - (let ((count (min log-limit (length *system-logs*)))) - (subseq *system-logs* 0 count))))) - -(defun context-render-to-org (obj &key (depth 1) (foveal-id nil) semantic-threshold (foveal-vector nil)) - "Recursively renders an org-object and its children to an Org string using a Foveal-Peripheral Hybrid model." - (let* ((id (org-object-id obj)) - (is-foveal (equal id foveal-id)) - (title (or (getf (org-object-attributes obj) :TITLE) "Untitled")) - (content (org-object-content obj)) - (children (org-object-children obj)) - (stars (make-string depth :initial-element #\*)) - (obj-vector (org-object-vector obj)) - (threshold (or semantic-threshold (ignore-errors (read-from-string (uiop:getenv "CONTEXT_SEMANTIC_THRESHOLD"))) 0.75)) - (similarity (if (and foveal-vector obj-vector (not is-foveal)) - (cosine-similarity foveal-vector obj-vector) - 0.0)) - (is-semantically-relevant (>= similarity threshold)) - ;; We always render depth 1 and 2 (Projects and main tasks). - ;; We always render the foveal node and its immediate children. - ;; We render deeper nodes ONLY if they are semantically relevant. - (should-render (or (<= depth 2) is-foveal is-semantically-relevant)) - (output "")) - - (when should-render - (setf output (format nil "~a ~a~%:PROPERTIES:~%:ID: ~a~%" stars title id)) - (when is-semantically-relevant - (setf output (concatenate 'string output (format nil ":SEMANTIC_SCORE: ~,2f~%" similarity)))) - (setf output (concatenate 'string output (format nil ":END:~%"))) - - ;; Only include full body content if this is the Foveal focus or highly relevant - (when (and content (or is-foveal is-semantically-relevant)) - (setf output (concatenate 'string output content (string #\Newline)))) - - ;; Recursively render children - (dolist (child-id children) - (let ((child-obj (lookup-object child-id))) - (when child-obj - ;; If the current node is Foveal, its children should be rendered (depth effectively resets) - (let ((next-foveal (if is-foveal child-id foveal-id))) - (setf output (concatenate 'string output - (context-render-to-org child-obj - :depth (1+ depth) - :foveal-id next-foveal - :semantic-threshold threshold - :foveal-vector foveal-vector)))))))) - output)) - -(defun context-resolve-path (path-string) - "Expands environment variables and strips literal quotes from a path string." - (let ((path (if (stringp path-string) - (string-trim '(#\" #\' #\Space) path-string) - path-string))) - (if (and (stringp path) (search "$" path)) - (let ((result path)) - (ppcre:do-register-groups (var-name) ("\\$([A-Za-z0-9_]+)" path) - (let ((var-val (uiop:getenv var-name))) - (when var-val - (setf result (ppcre:regex-replace (format nil "\\$~a" var-name) result var-val))))) - result) - path))) - -(defun context-assemble-global-awareness (&optional signal) - "Produces a high-level skeletal outline of the current Memory for the LLM." - (let* ((foveal-id (or (getf signal :foveal-focus) - (ignore-errors (getf (getf signal :payload) :target-id)))) - (projects (context-get-active-projects)) - (output "GLOBAL MEMEX AWARENESS (Peripheral Vision): -")) - (if projects - (dolist (project projects) - (setf output (concatenate 'string output - (context-render-to-org project :foveal-id foveal-id)))) - (setf output (concatenate 'string output "No active projects found.~%"))) - output)) diff --git a/src/memory.lisp b/src/memory.lisp deleted file mode 100644 index 7c70dca..0000000 --- a/src/memory.lisp +++ /dev/null @@ -1,115 +0,0 @@ -(in-package :opencortex) - -(defvar *memory* (make-hash-table :test 'equal)) - -(defvar *history-store* (make-hash-table :test 'equal) - "Immutable Merkle-Tree versioning store mapping hashes to objects.") - -(defstruct org-object - id type attributes content vector parent-id children version last-sync hash) - -(defun compute-merkle-hash (id type attributes content child-hashes) - "Computes a SHA-256 Merkle hash for a node based on its core properties and children's hashes." - (let* ((alist (loop for (k v) on attributes by #'cddr collect (cons k v))) - (sorted-alist (sort alist #'string< :key (lambda (x) (format nil "~a" (car x))))) - (attr-string (format nil "~s" sorted-alist)) - (children-string (format nil "~{~a~}" child-hashes)) - (data-string (format nil "ID:~a|TYPE:~s|ATTRS:~a|CONTENT:~a|CHILDREN:~a" - id type attr-string (or content "") children-string)) - (digester (ironclad:make-digest :sha256))) - (ironclad:update-digest digester (ironclad:ascii-string-to-byte-array data-string)) - (ironclad:byte-array-to-hex-string (ironclad:produce-digest digester)))) - -(defun ingest-ast (ast &optional parent-id) - "Parses an Org AST into the recursive Lisp Memory with Merkle hashing." - (let* ((type (getf ast :type)) - (props (getf ast :properties)) - (id (or (getf props :ID) (format nil "temp-~a" (get-universal-time)))) - (contents (getf ast :contents)) - (raw-content (when (eq type :HEADLINE) - (format nil "~a~%~a" (getf props :TITLE) (or (cl:getf ast :raw-content) "")))) - (should-embed (and raw-content (equal (getf props :EMBED) "t"))) - (child-ids nil) - (child-hashes nil)) - (dolist (child contents) - (when (listp child) - (let ((child-id (ingest-ast child id))) - (push child-id child-ids) - (let ((child-id-val child-id)) - (let ((child-obj (lookup-object child-id-val))) - (when child-obj (push (org-object-hash child-obj) child-hashes))))))) - (setf child-ids (nreverse child-ids)) - (setf child-hashes (nreverse child-hashes)) - (let* ((hash (compute-merkle-hash id type props raw-content child-hashes)) - (existing-obj (gethash hash *history-store*)) - (obj (or existing-obj - (make-org-object - :id id :type type :attributes props :content raw-content - :vector (when should-embed (get-embedding raw-content)) - :parent-id parent-id :children child-ids - :version (get-universal-time) :last-sync (get-universal-time) - :hash hash)))) - (unless existing-obj - (setf (gethash hash *history-store*) obj)) - (setf (gethash id *memory*) obj) - id))) - -(defvar *object-store-snapshots* nil) - -(defun copy-hash-table (hash-table) - "Creates a shallow copy of a hash table." - (let ((new-table (make-hash-table :test (hash-table-test hash-table) - :size (hash-table-size hash-table)))) - (maphash (lambda (k v) (setf (gethash k new-table) v)) hash-table) - new-table)) - -(defun snapshot-memory () - "Creates a lightweight, Copy-on-Write snapshot using Merkle-Tree pointers." - (let ((snapshot (copy-hash-table *memory*))) - (push (list :timestamp (get-universal-time) :data snapshot) *object-store-snapshots*) - (when (> (length *object-store-snapshots*) 20) - (setf *object-store-snapshots* (subseq *object-store-snapshots* 0 20))) - (harness-log "MEMORY - CoW Memory snapshot created."))) - -(defun rollback-memory (&optional (index 0)) - "Restores the Memory to a previously captured snapshot using immutable history pointers." - (let ((snapshot (nth index *object-store-snapshots*))) - (if snapshot - (progn (setf *memory* (copy-hash-table (getf snapshot :data))) - (harness-log "MEMORY - Memory rolled back to snapshot ~a" index)) - (harness-log "MEMORY ERROR - Snapshot ~a not found." index)))) - -(defun org-id-new () - "Generates a new UUID string for Org-mode identification." - (string-downcase (format nil "~a" (uuid:make-v4-uuid)))) - -(defun lookup-object (id) - "Retrieves an object from the store by its unique ID." - (gethash id *memory*)) - -(defun list-objects-by-type (type) - "Returns a list of all objects matching a specific Org element type." - (let ((results nil)) - (maphash (lambda (id obj) (declare (ignore id)) (when (eq (org-object-type obj) type) (push obj results))) *memory*) - results)) -(defun list-objects-with-attribute (attr-name value) - "Returns a list of all objects where ATTR-NAME matches VALUE." - (let ((results nil)) - (maphash (lambda (id obj) - (declare (ignore id)) - (let ((attrs (org-object-attributes obj))) - (when (equal (getf attrs attr-name) value) - (push obj results)))) - *memory*) - results)) - -(defun find-headline-missing-id (ast) - "Traverses an AST to find headlines that lack an :ID: property." - (when (listp ast) - (if (and (eq (getf ast :type) :HEADLINE) (not (getf (getf ast :properties) :ID))) - ast - (cl:some #'find-headline-missing-id (getf ast :contents))))) - -(defun file-name-nondirectory (path) - "Extracts the filename from a full path string." - (let ((pos (position #\/ path :from-end t))) (if pos (subseq path (1+ pos)) path))) diff --git a/src/skills.lisp b/src/skills.lisp deleted file mode 100644 index 334ccc6..0000000 --- a/src/skills.lisp +++ /dev/null @@ -1,286 +0,0 @@ -(in-package :opencortex) - -(defun COSINE-SIMILARITY (v1 v2) 1.0) ; Stub -(defun VAULT-MASK-STRING (s) "[MASKED]") ; Stub -(defvar *VAULT-MEMORY* (make-hash-table :test 'equal)) - - -(defstruct skill name priority dependencies trigger-fn probabilistic-prompt deterministic-fn) - -(defvar *skill-catalog* (make-hash-table :test 'equal) - "A stateful tracking table for all skill files discovered in the environment.") - -(defstruct skill-entry - filename - (status :discovered) ;; :discovered, :loading, :ready, :failed - error-log - (load-time 0)) - -(defun find-triggered-skill (context) - "Returns the highest priority skill whose trigger matches context AND has a probabilistic prompt." - (let ((triggered nil)) - (maphash (lambda (name skill) - (declare (ignore name)) - (when (and (skill-probabilistic-prompt skill) - (ignore-errors (funcall (skill-trigger-fn skill) context))) - (push skill triggered))) - *skills-registry*) - (first (sort triggered #'> :key #'skill-priority)))) - -(defmacro defskill (name &key priority dependencies trigger probabilistic deterministic) - "Registers a new skill into the global registry." - `(setf (gethash (string-downcase (string ,name)) *skills-registry*) - (make-skill :name (string-downcase (string ,name)) - :priority (or ,priority 10) - :dependencies ',dependencies - :trigger-fn ,trigger - :probabilistic-prompt ,probabilistic - :deterministic-fn ,deterministic))) - -(defun resolve-skill-dependencies (skill-name) - "Recursively resolves dependencies for a given skill name." - (let ((resolved nil) (seen nil)) - (labels ((visit (name) - (unless (member name seen :test #'equal) - (push name seen) - (let ((skill (gethash (string-downcase (string name)) *skills-registry*))) - (when skill - (dolist (dep (skill-dependencies skill)) - (visit dep)))) - (push name resolved)))) - (visit skill-name) - (nreverse resolved)))) - -(defun parse-skill-metadata (filepath) - "Extracts ID and DEPENDS_ON tags using robust regex scanning." - (let ((dependencies nil) - (id nil) - (content (uiop:read-file-string filepath))) - ;; Extract ID - (multiple-value-bind (match regs) - (ppcre:scan-to-strings "(?im:^:ID:\\s*([^\\s\\r\\n]+))" content) - (when match (setf id (aref regs 0)))) - ;; Extract all DEPENDS_ON lines - (ppcre:do-register-groups (deps-string) - ("(?im:^#\\+DEPENDS_ON:\\s*(.*))" content) - (let ((deps (ppcre:split "\\s+" (string-trim " " deps-string)))) - (setf dependencies (append dependencies (mapcar (lambda (s) (string-trim "[] " s)) deps))))) - (values id (remove-if (lambda (s) (= 0 (length s))) dependencies)))) - -(defun topological-sort-skills (skills-dir) - "Returns a list of skill filepaths sorted by dependency (dependencies first)." - (let ((files (uiop:directory-files skills-dir "org-skill-*.org")) - (adj (make-hash-table :test 'equal)) - (name-to-file (make-hash-table :test 'equal)) - (id-to-file (make-hash-table :test 'equal)) - (result nil) - (visited (make-hash-table :test 'equal)) - (stack (make-hash-table :test 'equal))) - (dolist (file files) - (let ((filename (pathname-name file))) - (multiple-value-bind (id deps) (parse-skill-metadata file) - (setf (gethash (string-downcase filename) name-to-file) file) - (when id (setf (gethash (string-downcase id) id-to-file) file)) - (setf (gethash (string-downcase filename) adj) deps)))) - (labels ((visit (file) - (let* ((filename (pathname-name file)) - (node-key (string-downcase filename))) - (unless (gethash node-key visited) - (setf (gethash node-key stack) t) - (dolist (dep (gethash node-key adj)) - (let* ((is-id-p (uiop:string-prefix-p "id:" (string-downcase dep))) - (dep-key (string-downcase (if is-id-p (subseq dep 3) dep))) - (dep-file (if is-id-p - (gethash dep-key id-to-file) - (or (gethash dep-key id-to-file) - (gethash dep-key name-to-file))))) - (when dep-file - (let ((dep-filename (pathname-name dep-file))) - (if (gethash (string-downcase dep-filename) stack) - (error "Circular dependency detected: ~a -> ~a" filename dep-filename) - (visit dep-file)))))) - (setf (gethash node-key stack) nil) - (setf (gethash node-key visited) t) - (push file result))))) - (let ((filenames (sort (mapcar #'pathname-name files) #'string<))) - (dolist (name filenames) - (let ((file (gethash (string-downcase name) name-to-file))) - (when file (visit file))))) - (nreverse result)))) - -(defun validate-lisp-syntax (code-string) - "Checks if a string contains valid, readable Common Lisp forms." - (handler-case - (let ((*read-eval* nil)) - (with-input-from-string (stream (format nil "(progn ~a)" code-string)) - (loop for form = (read stream nil :eof) until (eq form :eof)) - (values t nil))) - (error (c) (values nil (format nil "~a" c))))) - -(defun load-skill-from-org (filepath) - "Parses and evaluates Lisp blocks from an Org file into a jailed package." - (let* ((skill-base-name (pathname-name filepath)) - (entry (or (gethash skill-base-name *skill-catalog*) (make-skill-entry :filename skill-base-name)))) - (setf (skill-entry-status entry) :loading) - (setf (gethash skill-base-name *skill-catalog*) entry) - - (handler-case - (let* ((content (uiop:read-file-string filepath)) - (lines (uiop:split-string content :separator '(#\Newline))) - (in-lisp-block nil) - (lisp-code "") - (pkg-name (intern (string-upcase (format nil "OPENCORTEX.SKILLS.~a" skill-base-name)) :keyword))) - - (dolist (line lines) - (let ((clean-line (string-trim '(#\Space #\Tab #\Return) line))) - (cond ((uiop:string-prefix-p "#+begin_src lisp" (string-downcase clean-line)) - (if (search ":tangle" (string-downcase clean-line)) - (setf in-lisp-block nil) - (setf in-lisp-block t))) - ((uiop:string-prefix-p "#+end_src" (string-downcase clean-line)) - (setf in-lisp-block nil)) - (in-lisp-block - (unless (or (uiop:string-prefix-p ":PROPERTIES:" (string-upcase clean-line)) - (uiop:string-prefix-p ":END:" (string-upcase clean-line))) - (setf lisp-code (concatenate 'string lisp-code line (string #\Newline)))))))) - - (if (= (length lisp-code) 0) - (progn (setf (skill-entry-status entry) :ready) t) - (progn - (multiple-value-bind (valid-p err) (validate-lisp-syntax lisp-code) - (unless valid-p (error "Syntax Error: ~a" err))) - (harness-log "HARNESS: Jailing skill '~a' in package ~a" skill-base-name pkg-name) - (unless (find-package pkg-name) - (let ((new-pkg (make-package pkg-name :use '(:cl)))) - (do-external-symbols (sym (find-package :opencortex)) (shadowing-import sym new-pkg)))) - (let ((*read-eval* nil) (*package* (find-package pkg-name))) - (eval (read-from-string (format nil "(progn ~a)" lisp-code)))) - (setf (skill-entry-status entry) :ready) - t))) - (error (c) - (let ((msg (format nil "~a" c))) - (harness-log "LOADER ERROR in skill '~a': ~a" skill-base-name msg) - (setf (skill-entry-status entry) :failed) - (setf (skill-entry-error-log entry) msg) - nil))))) - -(defun load-skill-with-timeout (filepath timeout-seconds) - "Loads a skill Org file with a hard execution timeout." - (let* ((finished nil) - (thread (bt:make-thread (lambda () - (if (load-skill-from-org filepath) - (setf finished t) - (setf finished :error))) - :name (format nil "loader-~a" (pathname-name filepath)))) - (start-time (get-internal-real-time)) - (timeout-units (truncate (* timeout-seconds internal-time-units-per-second)))) - (loop - (when (eq finished t) (return :success)) - (when (eq finished :error) (return :error)) - (unless (bt:thread-alive-p thread) (return :error)) - (when (> (- (get-internal-real-time) start-time) timeout-units) - (harness-log "HARNESS: Timing out skill ~a..." (pathname-name filepath)) - #+sbcl (sb-thread:terminate-thread thread) - #-sbcl (bt:destroy-thread thread) - (return :timeout)) - (sleep 0.05)))) - -(defun initialize-all-skills () - "Scans the directory defined by SKILLS_DIR and hot-loads skills using topological order." - (let* ((env-path (uiop:getenv "SKILLS_DIR")) - (skills-dir-str (or env-path (namestring (merge-pathnames "notes/" (user-homedir-pathname))))) - (resolved-path (context-resolve-path skills-dir-str)) - (skills-dir (if resolved-path (uiop:ensure-directory-pathname resolved-path) nil))) - - (unless (and skills-dir (uiop:directory-exists-p skills-dir)) - (harness-log "HARNESS ERROR: Skills directory not found: ~a" skills-dir-str) - (return-from initialize-all-skills nil)) - - (let ((sorted-files (topological-sort-skills skills-dir))) - (let* ((mandatory-env (uiop:getenv "MANDATORY_SKILLS")) - (mandatory-skills (if mandatory-env - (mapcar (lambda (s) (string-trim '(#\Space #\" #\') s)) - (uiop:split-string mandatory-env :separator '( #\,))) - '("org-skill-policy" "org-skill-bouncer")))) - (dolist (req mandatory-skills) - (unless (member req sorted-files :key #'pathname-name :test #'string-equal) - (error "BOOT FAILURE: Mandatory skill '~a' not found in skills directory: ~a" req (uiop:native-namestring skills-dir)))) - - (harness-log "==================================================") - (harness-log " LOADER: Initializing ~a skills..." (length sorted-files)) - - (dolist (file sorted-files) - (let* ((skill-name (pathname-name file)) - (is-mandatory (member skill-name mandatory-skills :test #'string-equal))) - (harness-log " LOADER: Loading ~a..." skill-name) - (let ((status (load-skill-with-timeout file 5))) - (unless (eq status :success) - (if is-mandatory - (error "BOOT FAILURE: Mandatory skill '~a' failed to load (Status: ~a)." skill-name status) - (harness-log "LOADER WARNING: Skill '~a' failed to load." skill-name)))))) - - (let ((ready 0) (failed 0)) - (maphash (lambda (k v) - (declare (ignore k)) - (if (eq (skill-entry-status v) :ready) (incf ready) (incf failed))) - *skill-catalog*) - (harness-log " LOADER: Boot Complete. [Ready: ~a] [Failed: ~a]" ready failed) - (harness-log "==================================================") - (values ready failed)))))) - -(defun generate-tool-belt-prompt () - "Aggregates all registered cognitive tools into a descriptive prompt." - (let ((output (format nil "AVAILABLE TOOLS: -You can call tools by returning a Lisp plist: (:target :tool :action :call :tool :args (...)) - -EXAMPLES: -(:target :tool :action :call :tool \"eval\" :args (:code \"(+ 1 1)\")) -(:target :tool :action :call :tool \"grep-search\" :args (:pattern \"autonomousty\")) -(:target :tool :action :call :tool \"shell\" :args (:cmd \"ls -la\")) - ---- -" ))) - (maphash (lambda (name tool) - (setf output (concatenate 'string output - (format nil "- ~a: ~a~% Parameters: ~s~%~%" - name - (cognitive-tool-description tool) - (cognitive-tool-parameters tool))))) - *cognitive-tools*) - output)) - -(def-cognitive-tool :eval "Evaluates raw Common Lisp code in the harness image. Use this for complex calculations or internal state inspection." - ((:code :type :string :description "The Lisp code to evaluate")) - :guard (lambda (args context) - (declare (ignore context)) - (let ((code (getf args :code))) - (let ((harness-pkg (find-package :opencortex.skills.org-skill-lisp-validator))) - (if harness-pkg - (uiop:symbol-call :opencortex.skills.org-skill-lisp-validator :lisp-validator-validate code) - t)))) - :body (lambda (args) - (let ((code (getf args :code))) - (handler-case (let ((result (eval (read-from-string code)))) - (format nil "~s" result)) - (error (c) (format nil "ERROR: ~a" c)))))) - -(def-cognitive-tool :grep-search "Searches for a pattern in the project files." - ((:pattern :type :string :description "The regex pattern to search for") - (:dir :type :string :description "Directory to search in (default is project root)")) - :body (lambda (args) - (let ((pattern (getf args :pattern)) - (dir (or (getf args :dir) (uiop:getenv "MEMEX_DIR")))) - (uiop:run-program (list "grep" "-r" "-n" "--exclude-dir=node_modules" pattern dir) - :output :string :ignore-error-status t)))) - -(def-cognitive-tool :shell "Executes a shell command on the local machine. Use this for file operations, system checks, or running tests." - ((:cmd :type :string :description "The full bash command to execute")) - :guard (lambda (args context) - (declare (ignore context)) - (let ((cmd (getf args :cmd))) - (not (or (search "rm -rf /" cmd) (search ":(){ :|:& };:" cmd))))) - :body (lambda (args) - (let ((cmd (getf args :cmd))) - (multiple-value-bind (out err code) - (uiop:run-program (list "bash" "-c" cmd) :output :string :error-output :string :ignore-error-status t) - (format nil "EXIT-CODE: ~a~%~%STDOUT:~%~a~%~%STDERR:~%~a" code out err)))))