RELEASE: Finalize Semantic Restructuring v0.1.0
Some checks failed
Deploy-Agent-V15-Stdin / JOB-V15-STDIN (push) Failing after 3s
Some checks failed
Deploy-Agent-V15-Stdin / JOB-V15-STDIN (push) Failing after 3s
- Folders: literate->harness, src->library, system->environment, scripts->interfaces. - Synchronized all :tangle paths and system definitions. - Hardened .gitignore for binary and log artifacts. - Consolidated all documentation into docs/.
This commit is contained in:
3
.gitignore
vendored
3
.gitignore
vendored
@@ -6,3 +6,6 @@ opencortex-server
|
|||||||
\#*#
|
\#*#
|
||||||
opencortex-tui
|
opencortex-tui
|
||||||
test_input.txt
|
test_input.txt
|
||||||
|
opencortex-server
|
||||||
|
environment/logs/
|
||||||
|
library/gen/
|
||||||
|
|||||||
@@ -25,7 +25,7 @@ WORKDIR /app
|
|||||||
COPY . .
|
COPY . .
|
||||||
|
|
||||||
# Initialize system in non-interactive mode
|
# 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
|
EXPOSE 9105
|
||||||
|
|
||||||
|
|||||||
@@ -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.
|
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
|
** Pipeline Initialization
|
||||||
#+begin_src lisp :tangle ../src/act.lisp
|
#+begin_src lisp :tangle ../library/act.lisp
|
||||||
(in-package :opencortex)
|
(in-package :opencortex)
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
* Actuator Configuration
|
* Actuator Configuration
|
||||||
|
|
||||||
** Default Actuator
|
** Default Actuator
|
||||||
#+begin_src lisp :tangle ../src/act.lisp
|
#+begin_src lisp :tangle ../library/act.lisp
|
||||||
(defvar *default-actuator* :cli
|
(defvar *default-actuator* :cli
|
||||||
"The fallback actuator used if a signal has no source or target metadata.")
|
"The fallback actuator used if a signal has no source or target metadata.")
|
||||||
#+end_src
|
#+end_src
|
||||||
@@ -26,7 +26,7 @@ Actuators are the "hands" of the OpenCortex. They can be local (printing to a te
|
|||||||
** Silent Actuators
|
** 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.
|
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)
|
(defvar *silent-actuators* '(:cli :system-message :emacs)
|
||||||
"List of actuators whose feedback should not re-enter the Reasoning stage.")
|
"List of actuators whose feedback should not re-enter the Reasoning stage.")
|
||||||
#+end_src
|
#+end_src
|
||||||
@@ -34,7 +34,7 @@ To prevent infinite feedback loops, certain actuators are flagged as "silent." R
|
|||||||
** Initialization Logic (initialize-actuators)
|
** Initialization Logic (initialize-actuators)
|
||||||
This function hydrates the actuator configuration from the environment and registers the core built-in 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 ()
|
(defun initialize-actuators ()
|
||||||
"Loads actuator routing defaults from environment variables and registers core harness actuators."
|
"Loads actuator routing defaults from environment variables and registers core harness actuators."
|
||||||
(let ((def (uiop:getenv "DEFAULT_ACTUATOR"))
|
(let ((def (uiop:getenv "DEFAULT_ACTUATOR"))
|
||||||
@@ -62,7 +62,7 @@ This function hydrates the actuator configuration from the environment and regis
|
|||||||
** Dispatching Logic (dispatch-action)
|
** Dispatching Logic (dispatch-action)
|
||||||
The primary router. It identifies the target actuator based on the Signal's `:META` source or the Action's `:TARGET`.
|
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)
|
(defun dispatch-action (action context)
|
||||||
"Routes an approved action to its registered physical actuator."
|
"Routes an approved action to its registered physical actuator."
|
||||||
(let ((payload (proto-get action :payload)))
|
(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)
|
** System Actuator (execute-system-action)
|
||||||
Handles meta-operations like hot-loading skills or evaluating raw Lisp within the image.
|
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)
|
(defun execute-system-action (action context)
|
||||||
"Processes internal harness commands. (ACTUATOR)"
|
"Processes internal harness commands. (ACTUATOR)"
|
||||||
(declare (ignore context))
|
(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)
|
** Tool Result Formatting (format-tool-result)
|
||||||
A UI helper that distills technical LLM responses into human-readable text.
|
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)
|
(defun format-tool-result (tool-name result)
|
||||||
"Intelligently formats a tool result for user display."
|
"Intelligently formats a tool result for user display."
|
||||||
(if (listp result)
|
(if (listp result)
|
||||||
@@ -129,7 +129,7 @@ A UI helper that distills technical LLM responses into human-readable text.
|
|||||||
** Tool Actuator (execute-tool-action)
|
** Tool Actuator (execute-tool-action)
|
||||||
The engine for physical interaction. It executes a cognitive tool and generates feedback signals for the user.
|
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)
|
(defun execute-tool-action (action context)
|
||||||
"Executes a registered cognitive tool and generates feedback signals. (ACTUATOR)"
|
"Executes a registered cognitive tool and generates feedback signals. (ACTUATOR)"
|
||||||
(let* ((payload (getf action :payload))
|
(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)
|
** 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.
|
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)
|
(defun act-gate (signal)
|
||||||
"Final Stage: Actuation and feedback generation."
|
"Final Stage: Actuation and feedback generation."
|
||||||
(let* ((approved (getf signal :approved-action))
|
(let* ((approved (getf signal :approved-action))
|
||||||
@@ -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.
|
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
|
** Pipeline Initialization
|
||||||
#+begin_src lisp :tangle ../src/communication.lisp
|
#+begin_src lisp :tangle ../library/communication.lisp
|
||||||
(in-package :opencortex)
|
(in-package :opencortex)
|
||||||
#+end_src
|
#+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)~
|
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)
|
(defun sanitize-protocol-message (msg)
|
||||||
"Recursively strips non-serializable objects (streams, sockets) from a protocol plist."
|
"Recursively strips non-serializable objects (streams, sockets) from a protocol plist."
|
||||||
(if (and msg (listp msg))
|
(if (and msg (listp msg))
|
||||||
@@ -40,7 +40,7 @@ Example Frame: ~00001c(:TYPE :STATUS :SCRIBE :IDLE)~
|
|||||||
msg))
|
msg))
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
#+begin_src lisp :tangle ../src/communication.lisp
|
#+begin_src lisp :tangle ../library/communication.lisp
|
||||||
(defun frame-message (msg)
|
(defun frame-message (msg)
|
||||||
"Serializes a message plist and prefixes it with a 6-character hex length."
|
"Serializes a message plist and prefixes it with a 6-character hex length."
|
||||||
(let* ((sanitized (sanitize-protocol-message msg))
|
(let* ((sanitized (sanitize-protocol-message msg))
|
||||||
@@ -54,7 +54,7 @@ Example Frame: ~00001c(:TYPE :STATUS :SCRIBE :IDLE)~
|
|||||||
** Framed Message Reader (read-framed-message)
|
** 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.
|
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)
|
(defun read-framed-message (stream)
|
||||||
"Reads a hex-prefixed message from a stream. Returns the parsed Lisp plist or :EOF."
|
"Reads a hex-prefixed message from a stream. Returns the parsed Lisp plist or :EOF."
|
||||||
(handler-case
|
(handler-case
|
||||||
@@ -81,7 +81,7 @@ The inverse of framing. This function reads exactly the number of bytes specifie
|
|||||||
** Hello Message (make-hello-message)
|
** 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.
|
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)
|
(defun make-hello-message (version)
|
||||||
"Constructs the standard HELLO handshake message."
|
"Constructs the standard HELLO handshake message."
|
||||||
(list :TYPE :EVENT
|
(list :TYPE :EVENT
|
||||||
@@ -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.
|
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
|
** Pipeline Initialization
|
||||||
#+begin_src lisp :tangle ../src/context.lisp
|
#+begin_src lisp :tangle ../library/context.lisp
|
||||||
(in-package :opencortex)
|
(in-package :opencortex)
|
||||||
#+end_src
|
#+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)
|
** Project Awareness (context-get-active-projects)
|
||||||
Identifies current active work by querying the Org Memory for nodes with the ~:PROJECT:~ tag or ~NEXT~ status.
|
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 ()
|
(defun context-get-active-projects ()
|
||||||
"Retrieves a list of project headlines currently marked as NEXT or in progress."
|
"Retrieves a list of project headlines currently marked as NEXT or in progress."
|
||||||
(let ((all-projects (list-objects-with-attribute :CATEGORY "Project")))
|
(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)
|
** Historical Awareness (context-get-recent-completed-tasks)
|
||||||
Provides short-term memory of what was recently achieved, allowing the agent to maintain continuity.
|
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))
|
(defun context-get-recent-completed-tasks (&optional (limit 5))
|
||||||
"Retrieves the last N tasks marked as DONE from the memory history."
|
"Retrieves the last N tasks marked as DONE from the memory history."
|
||||||
(let ((all-completed (list-objects-with-attribute :TODO "DONE")))
|
(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)
|
** 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.
|
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 ()
|
(defun context-list-all-skills ()
|
||||||
"Returns a list of registered skills and their documentation."
|
"Returns a list of registered skills and their documentation."
|
||||||
(let ((results nil))
|
(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)
|
** 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.
|
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 ()
|
(defun context-get-system-logs ()
|
||||||
"Retrieves the in-memory circular log buffer."
|
"Retrieves the in-memory circular log buffer."
|
||||||
(bt:with-lock-held (*logs-lock*)
|
(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)
|
** 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.
|
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 ()
|
(defun context-assemble-global-awareness ()
|
||||||
"Assembles the full context block for a neural request."
|
"Assembles the full context block for a neural request."
|
||||||
(let ((projects (context-get-active-projects))
|
(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)
|
** 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.
|
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))
|
(defun context-query-store (query &key (limit 5))
|
||||||
"Placeholder for semantic/vector search over the Memex."
|
"Placeholder for semantic/vector search over the Memex."
|
||||||
(declare (ignore query limit))
|
(declare (ignore query limit))
|
||||||
@@ -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.
|
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
|
** Pipeline Initialization
|
||||||
#+begin_src lisp :tangle ../src/loop.lisp
|
#+begin_src lisp :tangle ../library/loop.lisp
|
||||||
(in-package :opencortex)
|
(in-package :opencortex)
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
@@ -20,18 +20,18 @@ Inspired by biological metabolism, the loop ensures that every stimulus is proce
|
|||||||
** Metabolic Interrupt Flag
|
** 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.
|
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
|
(defvar *interrupt-flag* nil
|
||||||
"Thread-safe signal to halt the metabolic pipeline and daemon.")
|
"Thread-safe signal to halt the metabolic pipeline and daemon.")
|
||||||
#+end_src
|
#+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")
|
(defvar *interrupt-lock* (bt:make-lock "harness-interrupt-lock")
|
||||||
"Protects the interrupt flag from concurrent access.")
|
"Protects the interrupt flag from concurrent access.")
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
** Heartbeat Thread Reference
|
** Heartbeat Thread Reference
|
||||||
#+begin_src lisp :tangle ../src/loop.lisp
|
#+begin_src lisp :tangle ../library/loop.lisp
|
||||||
(defvar *heartbeat-thread* nil
|
(defvar *heartbeat-thread* nil
|
||||||
"Reference to the background thread driving autonomous reflection.")
|
"Reference to the background thread driving autonomous reflection.")
|
||||||
#+end_src
|
#+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)
|
** 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.
|
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)
|
(defun process-signal (signal)
|
||||||
"The entry point to the Metabolic Pipeline: Perceive -> Reason -> Act."
|
"The entry point to the Metabolic Pipeline: Perceive -> Reason -> Act."
|
||||||
(let ((current-signal signal))
|
(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)
|
** 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.
|
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 ()
|
(defun start-heartbeat ()
|
||||||
"Starts the background heartbeat thread. Interval is loaded from HEARTBEAT_INTERVAL (default: 60s)."
|
"Starts the background heartbeat thread. Interval is loaded from HEARTBEAT_INTERVAL (default: 60s)."
|
||||||
(let ((interval (or (ignore-errors (parse-integer (uiop:getenv "HEARTBEAT_INTERVAL"))) 60)))
|
(let ((interval (or (ignore-errors (parse-integer (uiop:getenv "HEARTBEAT_INTERVAL"))) 60)))
|
||||||
@@ -109,7 +109,7 @@ The heartbeat ensures the agent remains "alive" even in the absence of external
|
|||||||
** Main Daemon Entry Point (main)
|
** Main Daemon Entry Point (main)
|
||||||
Initializes the image, boots the gateways, and enters the primary idle loop.
|
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 ()
|
(defun main ()
|
||||||
"Primary entry point for the OpenCortex daemon."
|
"Primary entry point for the OpenCortex daemon."
|
||||||
;; 1. Environment Hydration
|
;; 1. Environment Hydration
|
||||||
@@ -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.
|
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
|
** Pipeline Initialization
|
||||||
#+begin_src lisp :tangle ../src/memory.lisp
|
#+begin_src lisp :tangle ../library/memory.lisp
|
||||||
(in-package :opencortex)
|
(in-package :opencortex)
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
* Core Data Structures
|
* Core Data Structures
|
||||||
|
|
||||||
** The Object Registry
|
** The Object Registry
|
||||||
#+begin_src lisp :tangle ../src/memory.lisp
|
#+begin_src lisp :tangle ../library/memory.lisp
|
||||||
(defvar *memory* (make-hash-table :test 'equal)
|
(defvar *memory* (make-hash-table :test 'equal)
|
||||||
"The primary in-memory graph of all Org-mode entities, keyed by their unique ID.")
|
"The primary in-memory graph of all Org-mode entities, keyed by their unique ID.")
|
||||||
#+end_src
|
#+end_src
|
||||||
@@ -29,7 +29,7 @@ The Memory module is the "conscious mind" of the OpenCortex. Unlike traditional
|
|||||||
** The History Store (Merkle History)
|
** 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.
|
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)
|
(defvar *history-store* (make-array 0 :fill-pointer 0 :adjustable t)
|
||||||
"A versioned log of the memory state, allowing for temporal traversal and rollback.")
|
"A versioned log of the memory state, allowing for temporal traversal and rollback.")
|
||||||
#+end_src
|
#+end_src
|
||||||
@@ -37,7 +37,7 @@ OpenCortex maintains a history of memory states to allow for "Micro-Rollbacks" i
|
|||||||
** The Org-Object Definition
|
** The Org-Object Definition
|
||||||
Every headline, paragraph, or task in the Memex is represented as an ~org-object~.
|
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
|
(defstruct org-object
|
||||||
"The fundamental unit of knowledge in the OpenCortex."
|
"The fundamental unit of knowledge in the OpenCortex."
|
||||||
id
|
id
|
||||||
@@ -57,7 +57,7 @@ Every headline, paragraph, or task in the Memex is represented as an ~org-object
|
|||||||
** Merkle Hashing (compute-merkle-hash)
|
** Merkle Hashing (compute-merkle-hash)
|
||||||
To ensure data integrity and detect changes during external edits, we utilize Merkle-tree hashing. A node's hash is derived from its own content plus the hashes of its children.
|
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)
|
(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."
|
"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)))
|
(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)
|
** 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.
|
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)
|
(defun ingest-ast (ast &optional parent-id)
|
||||||
"Recursively parses an Org AST into the Lisp Memory registry."
|
"Recursively parses an Org AST into the Lisp Memory registry."
|
||||||
(let* ((type (getf ast :type))
|
(let* ((type (getf ast :type))
|
||||||
@@ -103,7 +103,7 @@ The primary mechanism for translating raw Org-mode Abstract Syntax Trees (provid
|
|||||||
* Retrieval and Search
|
* Retrieval and Search
|
||||||
|
|
||||||
** Object Lookup (lookup-object)
|
** Object Lookup (lookup-object)
|
||||||
#+begin_src lisp :tangle ../src/memory.lisp
|
#+begin_src lisp :tangle ../library/memory.lisp
|
||||||
(defun lookup-object (id)
|
(defun lookup-object (id)
|
||||||
"Retrieves an object from memory by its ID."
|
"Retrieves an object from memory by its ID."
|
||||||
(gethash id *memory*))
|
(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)
|
** Semantic Attribute Search (list-objects-with-attribute)
|
||||||
Allows for querying the memory based on metadata (e.g., finding all nodes tagged :PROJECT:).
|
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)
|
(defun list-objects-with-attribute (key value)
|
||||||
"Returns a list of objects that possess the specified attribute pair."
|
"Returns a list of objects that possess the specified attribute pair."
|
||||||
(let ((results nil))
|
(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)
|
** Memory Snapshots (snapshot-memory)
|
||||||
Captures the current state of the memory graph.
|
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 ()
|
(defun snapshot-memory ()
|
||||||
"Creates a deep copy of the memory hash table and pushes it to the history store."
|
"Creates a deep copy of the memory hash table and pushes it to the history store."
|
||||||
(let ((new-snap (make-hash-table :test 'equal)))
|
(let ((new-snap (make-hash-table :test 'equal)))
|
||||||
@@ -140,7 +140,7 @@ Captures the current state of the memory graph.
|
|||||||
** Micro-Rollbacks (rollback-memory)
|
** Micro-Rollbacks (rollback-memory)
|
||||||
The primary defense against accidental memory corruption by faulty skills.
|
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))
|
(defun rollback-memory (&optional (steps 1))
|
||||||
"Restores the memory to a previous snapshot state."
|
"Restores the memory to a previous snapshot state."
|
||||||
(let ((index (- (length *history-store*) steps 1)))
|
(let ((index (- (length *history-store*) steps 1)))
|
||||||
@@ -18,7 +18,7 @@ flowchart TD
|
|||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
** Public API Export
|
** Public API Export
|
||||||
#+begin_src lisp :tangle ../src/package.lisp
|
#+begin_src lisp :tangle ../library/package.lisp
|
||||||
(defpackage :opencortex
|
(defpackage :opencortex
|
||||||
(:use :cl)
|
(:use :cl)
|
||||||
(:export
|
(:export
|
||||||
@@ -140,7 +140,7 @@ flowchart TD
|
|||||||
|
|
||||||
** Package Implementation Initialization
|
** Package Implementation Initialization
|
||||||
Ensuring the compiler enters the correct namespace for all subsequent definitions.
|
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)
|
(in-package :opencortex)
|
||||||
#+end_src
|
#+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.
|
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.
|
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
|
(defvar *system-logs* nil
|
||||||
"Thread-safe list of the most recent system messages.")
|
"Thread-safe list of the most recent system messages.")
|
||||||
#+end_src
|
#+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")
|
(defvar *logs-lock* (bt:make-lock "harness-logs-lock")
|
||||||
"Protects the circular log buffer from race conditions during concurrent skill execution.")
|
"Protects the circular log buffer from race conditions during concurrent skill execution.")
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
#+begin_src lisp :tangle ../src/package.lisp
|
#+begin_src lisp :tangle ../library/package.lisp
|
||||||
(defvar *max-log-history* 100
|
(defvar *max-log-history* 100
|
||||||
"The maximum number of entries to preserve in the in-memory log buffer.")
|
"The maximum number of entries to preserve in the in-memory log buffer.")
|
||||||
#+end_src
|
#+end_src
|
||||||
@@ -170,7 +170,7 @@ OpenCortex maintains a thread-safe circular log buffer. This is critical for two
|
|||||||
** Skills Registry
|
** Skills Registry
|
||||||
All Literate Skills, once compiled, are registered here. This allows for topological sorting and priority-based execution.
|
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)
|
(defvar *skills-registry* (make-hash-table :test 'equal)
|
||||||
"Global registry of all loaded skills, keyed by their unique identifier.")
|
"Global registry of all loaded skills, keyed by their unique identifier.")
|
||||||
#+end_src
|
#+end_src
|
||||||
@@ -178,12 +178,12 @@ All Literate Skills, once compiled, are registered here. This allows for topolog
|
|||||||
** Skill Telemetry State
|
** Skill Telemetry State
|
||||||
To ensure the system remains performant and reliable, the harness tracks execution metrics for every skill.
|
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)
|
(defvar *skill-telemetry* (make-hash-table :test 'equal)
|
||||||
"Stores execution duration and failure counts for every registered skill.")
|
"Stores execution duration and failure counts for every registered skill.")
|
||||||
#+end_src
|
#+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")
|
(defvar *telemetry-lock* (bt:make-lock "harness-telemetry-lock")
|
||||||
"Protects the telemetry store from concurrent updates.")
|
"Protects the telemetry store from concurrent updates.")
|
||||||
#+end_src
|
#+end_src
|
||||||
@@ -193,7 +193,7 @@ To ensure the system remains performant and reliable, the harness tracks executi
|
|||||||
** Protocol Property Access (proto-get)
|
** 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.
|
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)
|
(defun proto-get (plist key)
|
||||||
"Robustly retrieves a value from a plist, checking both uppercase and lowercase keyword versions."
|
"Robustly retrieves a value from a plist, checking both uppercase and lowercase keyword versions."
|
||||||
(let* ((s (string key))
|
(let* ((s (string key))
|
||||||
@@ -205,7 +205,7 @@ Lisp keywords can be inconsistent between capitalized and lowercase versions dep
|
|||||||
** Telemetry Tracking
|
** Telemetry Tracking
|
||||||
The ~harness-track-telemetry~ function provides the hook for the metabolic loop to report performance data.
|
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)
|
(defun harness-track-telemetry (skill-name duration status)
|
||||||
"Updates performance metrics for a specific skill. Status should be :success or :rejected."
|
"Updates performance metrics for a specific skill. Status should be :success or :rejected."
|
||||||
(when skill-name
|
(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/.
|
The Tool Registry is the agent's physical interface. It separates the /proposal/ of an action from its /execution/.
|
||||||
|
|
||||||
** Tool Structure
|
** Tool Structure
|
||||||
#+begin_src lisp :tangle ../src/package.lisp
|
#+begin_src lisp :tangle ../library/package.lisp
|
||||||
(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.")
|
"The active set of physical capabilities available to the agent.")
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
#+begin_src lisp :tangle ../src/package.lisp
|
#+begin_src lisp :tangle ../library/package.lisp
|
||||||
(defstruct cognitive-tool
|
(defstruct cognitive-tool
|
||||||
"Represents a physical or virtual capability with explicit documentation and security guards."
|
"Represents a physical or virtual capability with explicit documentation and security guards."
|
||||||
name
|
name
|
||||||
@@ -239,7 +239,7 @@ The Tool Registry is the agent's physical interface. It separates the /proposal/
|
|||||||
** Tool Registration Macro (def-cognitive-tool)
|
** 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.
|
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)
|
(defmacro def-cognitive-tool (name description parameters &key guard body)
|
||||||
"Registers a new cognitive tool.
|
"Registers a new cognitive tool.
|
||||||
NAME: Keyword identifier.
|
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)
|
** 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.
|
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)
|
(defun harness-log (msg &rest args)
|
||||||
"Centralized logging for the harness. Writes to STDOUT and the thread-safe circular buffer."
|
"Centralized logging for the harness. Writes to STDOUT and the thread-safe circular buffer."
|
||||||
(let ((formatted-msg (apply #'format nil msg args)))
|
(let ((formatted-msg (apply #'format nil msg args)))
|
||||||
@@ -13,14 +13,14 @@ Normalization is critical because it shields the subsequent reasoning and actuat
|
|||||||
** Pipeline Initialization
|
** Pipeline Initialization
|
||||||
Ensuring we are in the correct namespace for sensory processing.
|
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)
|
(in-package :opencortex)
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
** Sensory Concurrency (Async Sensors)
|
** 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.
|
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)
|
(defvar *async-sensors* '(:chat-message :delegation :user-command)
|
||||||
"List of sensors that should be processed asynchronously to avoid blocking gateways.")
|
"List of sensors that should be processed asynchronously to avoid blocking gateways.")
|
||||||
#+end_src
|
#+end_src
|
||||||
@@ -28,7 +28,7 @@ To maintain the agent's responsiveness, we distinguish between "Fast" and "Slow"
|
|||||||
** Foveal Focus (User Context)
|
** 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.
|
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
|
(defvar *foveal-focus-id* nil
|
||||||
"The Org ID of the node the user is currently interacting with.")
|
"The Org ID of the node the user is currently interacting with.")
|
||||||
#+end_src
|
#+end_src
|
||||||
@@ -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.
|
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.
|
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))
|
(defun inject-stimulus (raw-message &key stream (depth 0))
|
||||||
"Enqueues a raw message into the reactive signal pipeline."
|
"Enqueues a raw message into the reactive signal pipeline."
|
||||||
(let* ((payload (getf raw-message :payload))
|
(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.
|
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.
|
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)
|
(defun perceive-gate (signal)
|
||||||
"Initial processing: Normalizes raw stimuli and updates memory."
|
"Initial processing: Normalizes raw stimuli and updates memory."
|
||||||
(let* ((payload (getf signal :payload))
|
(let* ((payload (getf signal :payload))
|
||||||
@@ -15,7 +15,7 @@ Cognition is split into two distinct modes:
|
|||||||
This hybrid approach ensures the agent is both intelligent and mathematically safe.
|
This hybrid approach ensures the agent is both intelligent and mathematically safe.
|
||||||
|
|
||||||
** Pipeline Initialization
|
** Pipeline Initialization
|
||||||
#+begin_src lisp :tangle ../src/reason.lisp
|
#+begin_src lisp :tangle ../library/reason.lisp
|
||||||
(in-package :opencortex)
|
(in-package :opencortex)
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
@@ -24,29 +24,29 @@ This hybrid approach ensures the agent is both intelligent and mathematically sa
|
|||||||
** Neural Backend Registry
|
** Neural Backend Registry
|
||||||
OpenCortex is provider-agnostic. All neural backends (OpenRouter, Ollama, etc.) register themselves here.
|
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)
|
(defvar *probabilistic-backends* (make-hash-table :test 'equal)
|
||||||
"A global mapping of provider identifiers (keywords) to their respective execution functions.")
|
"A global mapping of provider identifiers (keywords) to their respective execution functions.")
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
** Provider Cascade Configuration
|
** Provider Cascade Configuration
|
||||||
#+begin_src lisp :tangle ../src/reason.lisp
|
#+begin_src lisp :tangle ../library/reason.lisp
|
||||||
(defvar *provider-cascade* nil
|
(defvar *provider-cascade* nil
|
||||||
"An ordered list of providers to attempt if the primary one fails.")
|
"An ordered list of providers to attempt if the primary one fails.")
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
#+begin_src lisp :tangle ../src/reason.lisp
|
#+begin_src lisp :tangle ../library/reason.lisp
|
||||||
(defvar *model-selector-fn* nil
|
(defvar *model-selector-fn* nil
|
||||||
"A hook for dynamic model selection based on context complexity.")
|
"A hook for dynamic model selection based on context complexity.")
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
#+begin_src lisp :tangle ../src/reason.lisp
|
#+begin_src lisp :tangle ../library/reason.lisp
|
||||||
(defvar *consensus-enabled-p* nil
|
(defvar *consensus-enabled-p* nil
|
||||||
"Flag to enable parallel multi-model voting (not implemented in MVP).")
|
"Flag to enable parallel multi-model voting (not implemented in MVP).")
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
** Backend Registration Helper
|
** Backend Registration Helper
|
||||||
#+begin_src lisp :tangle ../src/reason.lisp
|
#+begin_src lisp :tangle ../library/reason.lisp
|
||||||
(defun register-probabilistic-backend (name fn)
|
(defun register-probabilistic-backend (name fn)
|
||||||
"Registers a neural provider with its calling function."
|
"Registers a neural provider with its calling function."
|
||||||
(setf (gethash name *probabilistic-backends*) fn))
|
(setf (gethash name *probabilistic-backends*) fn))
|
||||||
@@ -57,7 +57,7 @@ OpenCortex is provider-agnostic. All neural backends (OpenRouter, Ollama, etc.)
|
|||||||
** Probabilistic Call (probabilistic-call)
|
** 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.
|
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))
|
(defun probabilistic-call (prompt &key (system-prompt "You are the Probabilistic engine.") (cascade nil) (context nil))
|
||||||
"Dispatches a neural request through the provider cascade. Returns a Lisp plist or a failure log."
|
"Dispatches a neural request through the provider cascade. Returns a Lisp plist or a failure log."
|
||||||
(let ((backends (or cascade *provider-cascade*)))
|
(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)
|
** 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.
|
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)
|
(defun strip-markdown (text)
|
||||||
"Strips common markdown code block markers from text to ensure valid S-expression parsing."
|
"Strips common markdown code block markers from text to ensure valid S-expression parsing."
|
||||||
(if (and text (stringp text))
|
(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 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.
|
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)
|
(defun think (context)
|
||||||
"Generates a Lisp action proposal based on current context."
|
"Generates a Lisp action proposal based on current context."
|
||||||
(let* ((active-skill (find-triggered-skill context))
|
(let* ((active-skill (find-triggered-skill context))
|
||||||
@@ -143,7 +143,7 @@ PROVIDER RULE: Always use the default cascade provider unless a specific model o
|
|||||||
** Deterministic Verification
|
** Deterministic Verification
|
||||||
The final safety check. It iterates through all active skills to verify that the proposed neural action does not violate any invariants.
|
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)
|
(defun deterministic-verify (proposed-action context)
|
||||||
"Iterates through all skill deterministic-gates sorted by priority. Ensures absolute safety of the neural proposal."
|
"Iterates through all skill deterministic-gates sorted by priority. Ensures absolute safety of the neural proposal."
|
||||||
(let ((current-action proposed-action)
|
(let ((current-action proposed-action)
|
||||||
@@ -171,7 +171,7 @@ The final safety check. It iterates through all active skills to verify that the
|
|||||||
** Reasoning Gate (reason-gate)
|
** 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.
|
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)
|
(defun reason-gate (signal)
|
||||||
"Unified Stage: Combines Probabilistic proposals and Deterministic verification."
|
"Unified Stage: Combines Probabilistic proposals and Deterministic verification."
|
||||||
(let* ((type (proto-get signal :type))
|
(let* ((type (proto-get signal :type))
|
||||||
@@ -252,7 +252,7 @@ WORKDIR /app
|
|||||||
COPY . .
|
COPY . .
|
||||||
|
|
||||||
# Initialize system in non-interactive mode
|
# 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
|
EXPOSE 9105
|
||||||
|
|
||||||
@@ -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.
|
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
|
** Pipeline Initialization
|
||||||
#+begin_src lisp :tangle ../src/skills.lisp
|
#+begin_src lisp :tangle ../library/skills.lisp
|
||||||
(in-package :opencortex)
|
(in-package :opencortex)
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
* Skill Definition and Registration
|
* Skill Definition and Registration
|
||||||
|
|
||||||
** The Skill Structure
|
** The Skill Structure
|
||||||
#+begin_src lisp :tangle ../src/skills.lisp
|
#+begin_src lisp :tangle ../library/skills.lisp
|
||||||
(defstruct skill
|
(defstruct skill
|
||||||
"Represents a hot-reloadable module of intelligence or actuation."
|
"Represents a hot-reloadable module of intelligence or actuation."
|
||||||
name
|
name
|
||||||
@@ -36,7 +36,7 @@ The Skill Engine is the modular heart of the OpenCortex. By separating cognitive
|
|||||||
** Skill Registration Macro (defskill)
|
** 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*~.
|
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)
|
(defmacro defskill (name &key (priority 0) dependencies trigger probabilistic deterministic)
|
||||||
"Registers a new skill into the global harness registry."
|
"Registers a new skill into the global harness registry."
|
||||||
`(setf (gethash (string-downcase (string ',name)) *skills-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)
|
** 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.
|
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)
|
(defun validate-lisp-syntax (file-path)
|
||||||
"Parses a Lisp file without evaluation to verify syntactic integrity."
|
"Parses a Lisp file without evaluation to verify syntactic integrity."
|
||||||
(handler-case
|
(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)
|
** 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.
|
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)
|
(defun load-skill-from-org (org-file-path)
|
||||||
"Tangles and loads a single Org-mode skill file."
|
"Tangles and loads a single Org-mode skill file."
|
||||||
(let* ((filename (file-name-nondirectory (namestring org-file-path)))
|
(let* ((filename (file-name-nondirectory (namestring org-file-path)))
|
||||||
(skill-id (pathname-name 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))))
|
(asdf:system-source-directory :opencortex))))
|
||||||
|
|
||||||
(ensure-directories-exist lisp-file)
|
(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)
|
** Dependency Sorting (topological-sort-skills)
|
||||||
Ensures that foundational skills (like the Bouncer or Policy engine) are always loaded before higher-level actuators.
|
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)
|
(defun topological-sort-skills (skills)
|
||||||
"Calculates the correct loading order based on #+DEPENDS_ON metadata."
|
"Calculates the correct loading order based on #+DEPENDS_ON metadata."
|
||||||
;; Placeholder: Currently sorts by priority as a proxy for dependencies.
|
;; 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)
|
** Registry Initialization (initialize-all-skills)
|
||||||
The high-level boot sequence for the skill engine.
|
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 ()
|
(defun initialize-all-skills ()
|
||||||
"Discovers and loads all Org files in the SKILLS_DIR."
|
"Discovers and loads all Org files in the SKILLS_DIR."
|
||||||
(let* ((skills-dir (uiop:getenv "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)
|
** Skill Trigger Discovery (find-triggered-skill)
|
||||||
Identifies which skill is best suited to handle the current metabolic signal.
|
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)
|
(defun find-triggered-skill (context)
|
||||||
"Iterates through the registry and returns the first skill whose trigger returns true."
|
"Iterates through the registry and returns the first skill whose trigger returns true."
|
||||||
(let ((skills nil))
|
(let ((skills nil))
|
||||||
@@ -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).
|
3. **Transparency:** The status bar must provide real-time feedback on the state of background workers (Scribe and Gardener).
|
||||||
|
|
||||||
** Package Context
|
** Package Context
|
||||||
#+begin_src lisp :tangle ../src/tui-client.lisp
|
#+begin_src lisp :tangle ../library/tui-client.lisp
|
||||||
(in-package :cl-user)
|
(in-package :cl-user)
|
||||||
(defpackage :opencortex.tui (:use :cl :croatoan) (:export :main))
|
(defpackage :opencortex.tui (:use :cl :croatoan) (:export :main))
|
||||||
(in-package :opencortex.tui)
|
(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
|
* UI State Management
|
||||||
|
|
||||||
** Networking and Streams
|
** 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-host* "127.0.0.1")
|
||||||
(defvar *daemon-port* 9105)
|
(defvar *daemon-port* 9105)
|
||||||
(defvar *socket* nil)
|
(defvar *socket* nil)
|
||||||
@@ -31,7 +31,7 @@ The TUI Client is a standalone consumer of the OpenCortex protocol. It uses the
|
|||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
** Terminal Buffers
|
** 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 *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 *input-buffer* (make-array 0 :element-type 'character :fill-pointer 0 :adjustable t))
|
||||||
(defvar *is-running* 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
|
** Thread-Safe Message Queue
|
||||||
We use a simple locked queue to move messages from the background listener thread to the foreground rendering loop.
|
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 *msg-queue* nil)
|
||||||
(defvar *queue-lock* (bt:make-lock "tui-msg-lock"))
|
(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)
|
** Keyword Sanitization (clean-keywords)
|
||||||
Clients often receive data with inconsistent keyword casing. This helper ensures all incoming keys are normalized for easier processing.
|
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)
|
(defun clean-keywords (msg)
|
||||||
"Ensures all keys in a plist are uppercase keywords."
|
"Ensures all keys in a plist are uppercase keywords."
|
||||||
(if (listp msg)
|
(if (listp msg)
|
||||||
@@ -72,7 +72,7 @@ Clients often receive data with inconsistent keyword casing. This helper ensures
|
|||||||
** Payload Extraction (format-payload)
|
** Payload Extraction (format-payload)
|
||||||
The core "intelligence" of the TUI display. It recursively searches a protocol payload for the most relevant human-readable content.
|
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)
|
(defun format-payload (payload)
|
||||||
"Extracts human-readable text from a protocol payload, handling nested tool calls."
|
"Extracts human-readable text from a protocol payload, handling nested tool calls."
|
||||||
(let* ((action (getf payload :ACTION))
|
(let* ((action (getf payload :ACTION))
|
||||||
@@ -98,7 +98,7 @@ The core "intelligence" of the TUI display. It recursively searches a protocol p
|
|||||||
** Background Listener (listen-thread)
|
** Background Listener (listen-thread)
|
||||||
Runs as a separate thread. It continuously reads framed messages from the daemon and enqueues them for the UI.
|
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 ()
|
(defun listen-thread ()
|
||||||
(loop while *is-running* do
|
(loop while *is-running* do
|
||||||
(handler-case
|
(handler-case
|
||||||
@@ -135,7 +135,7 @@ Runs as a separate thread. It continuously reads framed messages from the daemon
|
|||||||
** TUI Entry Point (main)
|
** TUI Entry Point (main)
|
||||||
Initializes the ncurses screen, sets up the window layout, and handles user keyboard input.
|
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 ()
|
(defun main ()
|
||||||
"Primary entry point for the standalone TUI client."
|
"Primary entry point for the standalone TUI client."
|
||||||
(handler-case
|
(handler-case
|
||||||
32
infrastructure_new/docker/Dockerfile
Normal file
32
infrastructure_new/docker/Dockerfile
Normal file
@@ -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"]
|
||||||
@@ -1,7 +1,10 @@
|
|||||||
(in-package :opencortex)
|
(in-package :opencortex)
|
||||||
|
|
||||||
(defvar *default-actuator* :cli)
|
(defvar *default-actuator* :cli
|
||||||
(defvar *silent-actuators* '(:cli :system-message :emacs))
|
"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 ()
|
(defun initialize-actuators ()
|
||||||
"Loads actuator routing defaults from environment variables and registers core harness actuators."
|
"Loads actuator routing defaults from environment variables and registers core harness actuators."
|
||||||
@@ -25,10 +28,12 @@
|
|||||||
(finish-output stream))))))
|
(finish-output stream))))))
|
||||||
|
|
||||||
(defun dispatch-action (action context)
|
(defun dispatch-action (action context)
|
||||||
|
"Routes an approved action to its registered physical actuator."
|
||||||
(let ((payload (proto-get action :payload)))
|
(let ((payload (proto-get action :payload)))
|
||||||
|
;; Optimization: Heartbeats are system events, not actions.
|
||||||
(when (eq (proto-get payload :sensor) :heartbeat)
|
(when (eq (proto-get payload :sensor) :heartbeat)
|
||||||
(return-from dispatch-action nil)))
|
(return-from dispatch-action nil)))
|
||||||
"Routes an approved action to its registered physical actuator."
|
|
||||||
(when (and action (listp action))
|
(when (and action (listp action))
|
||||||
(let* ((meta (proto-get context :meta))
|
(let* ((meta (proto-get context :meta))
|
||||||
(source (proto-get meta :source))
|
(source (proto-get meta :source))
|
||||||
@@ -38,7 +43,7 @@
|
|||||||
*default-actuator*))
|
*default-actuator*))
|
||||||
(target (intern (string-upcase (string raw-target)) :keyword))
|
(target (intern (string-upcase (string raw-target)) :keyword))
|
||||||
(actuator-fn (gethash target *actuator-registry*)))
|
(actuator-fn (gethash target *actuator-registry*)))
|
||||||
;; Ensure outbound action has meta if context had it
|
;; Propagation: Ensure outbound action inherits metadata
|
||||||
(when (and meta (null (getf action :meta)))
|
(when (and meta (null (getf action :meta)))
|
||||||
(setf (getf action :meta) meta))
|
(setf (getf action :meta) meta))
|
||||||
(if actuator-fn
|
(if actuator-fn
|
||||||
@@ -73,7 +78,7 @@
|
|||||||
(format nil "TOOL [~a] RESULT: ~a" tool-name result)))
|
(format nil "TOOL [~a] RESULT: ~a" tool-name result)))
|
||||||
|
|
||||||
(defun execute-tool-action (action context)
|
(defun execute-tool-action (action context)
|
||||||
"Executes a registered cognitive tool. (ACTUATOR)"
|
"Executes a registered cognitive tool and generates feedback signals. (ACTUATOR)"
|
||||||
(let* ((payload (getf action :payload))
|
(let* ((payload (getf action :payload))
|
||||||
(tool-name (getf payload :tool))
|
(tool-name (getf payload :tool))
|
||||||
(tool-args (getf payload :args))
|
(tool-args (getf payload :args))
|
||||||
@@ -87,7 +92,7 @@
|
|||||||
(result (funcall (cognitive-tool-body tool) clean-args)))
|
(result (funcall (cognitive-tool-body tool) clean-args)))
|
||||||
(let ((feedback (list :TYPE :EVENT :DEPTH (1+ depth) :META meta
|
(let ((feedback (list :TYPE :EVENT :DEPTH (1+ depth) :META meta
|
||||||
:PAYLOAD (list :SENSOR :tool-output :RESULT result :TOOL tool-name))))
|
:PAYLOAD (list :SENSOR :tool-output :RESULT result :TOOL tool-name))))
|
||||||
;; If we have a source, send a status message with the result, formatted for humans
|
;; UI Propagation: Send distilled text result back to the source client
|
||||||
(when source
|
(when source
|
||||||
(dispatch-action (list :TYPE :REQUEST :TARGET source
|
(dispatch-action (list :TYPE :REQUEST :TARGET source
|
||||||
:PAYLOAD (list :ACTION :MESSAGE :TEXT (format-tool-result tool-name result)))
|
:PAYLOAD (list :ACTION :MESSAGE :TEXT (format-tool-result tool-name result)))
|
||||||
@@ -133,14 +138,12 @@
|
|||||||
(if approved
|
(if approved
|
||||||
(let* ((target (getf approved :target))
|
(let* ((target (getf approved :target))
|
||||||
(result (dispatch-action approved context)))
|
(result (dispatch-action approved context)))
|
||||||
;; If the actuator returns a signal (like :tool-output), it becomes the feedback.
|
|
||||||
;; Otherwise, generate tool-output feedback for non-silent actuators.
|
|
||||||
(cond ((and (listp result) (member (getf result :type) '(:EVENT :LOG)))
|
(cond ((and (listp result) (member (getf result :type) '(:EVENT :LOG)))
|
||||||
(setf feedback result))
|
(setf feedback result))
|
||||||
((and result (not (member target *silent-actuators*)))
|
((and result (not (member target *silent-actuators*)))
|
||||||
(setf feedback (list :type :EVENT :depth (1+ (getf signal :depth 0)) :meta meta
|
(setf feedback (list :type :EVENT :depth (1+ (getf signal :depth 0)) :meta meta
|
||||||
:payload (list :sensor :tool-output :result result :tool approved))))))
|
:payload (list :sensor :tool-output :result result :tool approved))))))
|
||||||
;; If no approved action but we have a source, this might be a raw event/log stimulus.
|
;; Fallback: route generic stimuli back to their origin
|
||||||
(when source
|
(when source
|
||||||
(dispatch-action signal context)))))
|
(dispatch-action signal context)))))
|
||||||
|
|
||||||
@@ -6,7 +6,7 @@
|
|||||||
(error "Communication Protocol Schema Error: Message must be a property list (got ~s)" (type-of msg)))
|
(error "Communication Protocol Schema Error: Message must be a property list (got ~s)" (type-of msg)))
|
||||||
|
|
||||||
(let ((type (let ((raw (proto-get msg :type))) (if (keywordp raw) (intern (string-upcase (string raw)) :keyword) raw))))
|
(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)))
|
(progn (harness-log "REJECTED MSG: ~s" msg) (error "Communication Protocol Schema Error: Invalid message type '~a'" type)))
|
||||||
|
|
||||||
(case type
|
(case type
|
||||||
46
library/communication.lisp
Normal file
46
library/communication.lisp
Normal file
@@ -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))))
|
||||||
41
library/context.lisp
Normal file
41
library/context.lisp
Normal file
@@ -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)
|
||||||
@@ -1,8 +1,13 @@
|
|||||||
(in-package :opencortex)
|
(in-package :opencortex)
|
||||||
|
|
||||||
(defvar *interrupt-flag* nil)
|
(defvar *interrupt-flag* nil
|
||||||
(defvar *interrupt-lock* (bt:make-lock "harness-interrupt-lock"))
|
"Thread-safe signal to halt the metabolic pipeline and daemon.")
|
||||||
(defvar *heartbeat-thread* nil)
|
|
||||||
|
(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)
|
(defun process-signal (signal)
|
||||||
"The entry point to the Metabolic Pipeline: Perceive -> Reason -> Act."
|
"The entry point to the Metabolic Pipeline: Perceive -> Reason -> Act."
|
||||||
@@ -10,59 +15,69 @@
|
|||||||
(loop while current-signal do
|
(loop while current-signal do
|
||||||
(let ((depth (getf current-signal :depth 0))
|
(let ((depth (getf current-signal :depth 0))
|
||||||
(meta (getf current-signal :meta)))
|
(meta (getf current-signal :meta)))
|
||||||
|
;; Safety: Prevent infinite cognitive recursion.
|
||||||
(when (> depth 10) (harness-log "METABOLISM ERROR: Max depth reached.") (return nil))
|
(when (> depth 10) (harness-log "METABOLISM ERROR: Max depth reached.") (return nil))
|
||||||
|
|
||||||
|
;; Check for graceful shutdown.
|
||||||
(when (bt:with-lock-held (*interrupt-lock*) *interrupt-flag*)
|
(when (bt:with-lock-held (*interrupt-lock*) *interrupt-flag*)
|
||||||
(harness-log "METABOLISM: Interrupted.")
|
(harness-log "METABOLISM: Interrupted.")
|
||||||
(bt:with-lock-held (*interrupt-lock*) (setf *interrupt-flag* nil))
|
(bt:with-lock-held (*interrupt-lock*) (setf *interrupt-flag* nil))
|
||||||
(return nil))
|
(return nil))
|
||||||
|
|
||||||
(handler-case
|
(handler-case
|
||||||
(progn
|
(progn
|
||||||
|
;; Stage 1: Ingest and Normalize
|
||||||
(setf current-signal (perceive-gate current-signal))
|
(setf current-signal (perceive-gate current-signal))
|
||||||
|
;; Stage 2: Cogitate and Verify
|
||||||
(setf current-signal (reason-gate current-signal))
|
(setf current-signal (reason-gate current-signal))
|
||||||
|
;; Stage 3: Actuate and Generate Feedback
|
||||||
(let ((feedback (act-gate current-signal)))
|
(let ((feedback (act-gate current-signal)))
|
||||||
;; feedback generation
|
|
||||||
(if feedback
|
(if feedback
|
||||||
(progn
|
(progn
|
||||||
;; Inherit meta from trigger signal
|
;; Inheritance: Metadata must persist across recursive cycles.
|
||||||
(unless (getf feedback :meta) (setf (getf feedback :meta) meta))
|
(unless (getf feedback :meta) (setf (getf feedback :meta) meta))
|
||||||
(setf current-signal feedback))
|
(setf current-signal feedback))
|
||||||
(setf current-signal nil))))
|
(setf current-signal nil))))
|
||||||
(error (c)
|
(error (c)
|
||||||
(let ((sensor (ignore-errors (getf (getf current-signal :payload) :sensor))))
|
(let ((sensor (ignore-errors (getf (getf current-signal :payload) :sensor))))
|
||||||
(harness-log "METABOLISM CRASH [~a]: ~a" (or sensor :unknown) c)
|
(harness-log "METABOLISM CRASH [~a]: ~a" (or sensor :unknown) c)
|
||||||
;; Only rollback on critical errors, not standard tool or loop errors
|
;; Resilience: Only rollback on critical system errors.
|
||||||
(unless (member sensor '(:loop-error :tool-error :syntax-error))
|
(unless (member sensor '(:loop-error :tool-error :syntax-error))
|
||||||
(harness-log "CRITICAL ERROR: Initiating Micro-Rollback.")
|
(harness-log "CRITICAL ERROR: Initiating Micro-Rollback.")
|
||||||
(rollback-memory 0))
|
(rollback-memory 0))
|
||||||
|
;; If recursion is shallow, attempt to notify the user of the error.
|
||||||
(if (or (> depth 2) (member sensor '(:loop-error :tool-error)))
|
(if (or (> depth 2) (member sensor '(:loop-error :tool-error)))
|
||||||
(setf current-signal nil)
|
(setf current-signal nil)
|
||||||
(setf current-signal (list :type :EVENT :depth (1+ depth) :meta meta
|
(setf current-signal (list :type :EVENT :depth (1+ depth) :meta meta
|
||||||
:payload (list :sensor :loop-error :message (format nil "~a" c) :depth depth)))))))))))
|
:payload (list :sensor :loop-error :message (format nil "~a" c) :depth depth)))))))))))
|
||||||
|
|
||||||
(defun start-heartbeat ()
|
(defun start-heartbeat ()
|
||||||
"Starts the background heartbeat thread. Interval is loaded from HEARTBEAT_INTERVAL."
|
"Starts the background heartbeat thread. Interval is loaded from HEARTBEAT_INTERVAL (default: 60s)."
|
||||||
(let ((interval (or (ignore-errors (parse-integer (uiop:getenv "HEARTBEAT_INTERVAL"))) 60)))
|
(let ((interval (or (ignore-errors (parse-integer (uiop:getenv "HEARTBEAT_INTERVAL"))) 60)))
|
||||||
(setf *heartbeat-thread*
|
(setf *heartbeat-thread*
|
||||||
(bt:make-thread
|
(bt:make-thread
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(loop
|
(loop
|
||||||
(sleep interval)
|
(sleep interval)
|
||||||
;; inject-stimulus is synchronous for heartbeats, preventing accumulation.
|
;; Note: inject-stimulus is synchronous for heartbeats to prevent task accumulation.
|
||||||
(inject-stimulus (list :type :EVENT :payload (list :sensor :heartbeat :unix-time (get-universal-time))))))
|
(inject-stimulus (list :type :EVENT :payload (list :sensor :heartbeat :unix-time (get-universal-time))))))
|
||||||
:name "opencortex-heartbeat"))))
|
:name "opencortex-heartbeat"))))
|
||||||
|
|
||||||
(defun main ()
|
(defun main ()
|
||||||
"Entry point for the Skeleton MVP. Handles initialization and graceful shutdown."
|
"Primary entry point for the OpenCortex daemon."
|
||||||
|
;; 1. Environment Hydration
|
||||||
(let* ((home (uiop:getenv "HOME"))
|
(let* ((home (uiop:getenv "HOME"))
|
||||||
(env-file (uiop:merge-pathnames* ".local/share/opencortex/.env" (uiop:ensure-directory-pathname home))))
|
(env-file (uiop:merge-pathnames* ".local/share/opencortex/.env" (uiop:ensure-directory-pathname home))))
|
||||||
(when (uiop:file-exists-p env-file) (cl-dotenv:load-env env-file)))
|
(when (uiop:file-exists-p env-file) (cl-dotenv:load-env env-file)))
|
||||||
|
|
||||||
|
;; 2. System Bootstrap
|
||||||
(initialize-actuators)
|
(initialize-actuators)
|
||||||
(initialize-all-skills)
|
(initialize-all-skills)
|
||||||
|
|
||||||
|
;; 3. Wake up the heart.
|
||||||
(start-heartbeat)
|
(start-heartbeat)
|
||||||
|
|
||||||
;; Graceful shutdown handler for SBCL
|
;; 4. OS Signal Handling (SBCL specific)
|
||||||
#+sbcl
|
#+sbcl
|
||||||
(sb-sys:enable-interrupt sb-unix:sigint
|
(sb-sys:enable-interrupt sb-unix:sigint
|
||||||
(lambda (sig code scp)
|
(lambda (sig code scp)
|
||||||
@@ -70,6 +85,7 @@
|
|||||||
(harness-log "SHUTDOWN: SIGINT received. Exiting...")
|
(harness-log "SHUTDOWN: SIGINT received. Exiting...")
|
||||||
(uiop:quit 0)))
|
(uiop:quit 0)))
|
||||||
|
|
||||||
|
;; 5. Primary Idle Loop
|
||||||
(let ((sleep-interval (or (ignore-errors (parse-integer (uiop:getenv "DAEMON_SLEEP_INTERVAL"))) 3600)))
|
(let ((sleep-interval (or (ignore-errors (parse-integer (uiop:getenv "DAEMON_SLEEP_INTERVAL"))) 3600)))
|
||||||
(loop
|
(loop
|
||||||
(when (bt:with-lock-held (*interrupt-lock*) *interrupt-flag*) (return))
|
(when (bt:with-lock-held (*interrupt-lock*) *interrupt-flag*) (return))
|
||||||
81
library/memory.lisp
Normal file
81
library/memory.lisp
Normal file
@@ -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))))
|
||||||
@@ -1,7 +1,7 @@
|
|||||||
(defpackage :opencortex
|
(defpackage :opencortex
|
||||||
(:use :cl)
|
(:use :cl)
|
||||||
(:export
|
(:export
|
||||||
;; --- communication protocol ---
|
;; --- Communication Protocol ---
|
||||||
#:frame-message
|
#:frame-message
|
||||||
#:read-framed-message
|
#:read-framed-message
|
||||||
#:PROTO-GET
|
#:PROTO-GET
|
||||||
@@ -118,33 +118,30 @@
|
|||||||
|
|
||||||
(in-package :opencortex)
|
(in-package :opencortex)
|
||||||
|
|
||||||
(defun proto-get (plist key)
|
(defvar *system-logs* nil
|
||||||
"Robustly retrieves a value from a plist, checking both uppercase and lowercase keyword versions."
|
"Thread-safe list of the most recent system messages.")
|
||||||
(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 *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)
|
(defvar *max-log-history* 100
|
||||||
"Robustly retrieves a value from a plist, checking both uppercase and lowercase keyword versions."
|
"The maximum number of entries to preserve in the in-memory log buffer.")
|
||||||
(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 *skills-registry* (make-hash-table :test 'equal)
|
(defvar *skills-registry* (make-hash-table :test 'equal)
|
||||||
"Global registry of all loaded skills.")
|
"Global registry of all loaded skills, keyed by their unique identifier.")
|
||||||
|
|
||||||
(defvar *skill-telemetry* (make-hash-table :test 'equal))
|
(defvar *skill-telemetry* (make-hash-table :test 'equal)
|
||||||
(defvar *telemetry-lock* (bt:make-lock "harness-telemetry-lock"))
|
"Stores execution duration and failure counts for every registered skill.")
|
||||||
|
|
||||||
|
(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)
|
(defun harness-track-telemetry (skill-name duration status)
|
||||||
"Updates performance metrics for a specific skill. Status should be :success or :rejected."
|
"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)))
|
(when (eq status :rejected) (incf (getf entry :failures)))
|
||||||
(setf (gethash skill-name *skill-telemetry*) entry)))))
|
(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
|
(defstruct cognitive-tool
|
||||||
|
"Represents a physical or virtual capability with explicit documentation and security guards."
|
||||||
name
|
name
|
||||||
description
|
description
|
||||||
parameters
|
parameters
|
||||||
@@ -166,7 +165,12 @@
|
|||||||
body)
|
body)
|
||||||
|
|
||||||
(defmacro def-cognitive-tool (name description parameters &key guard body)
|
(defmacro def-cognitive-tool (name description parameters &key guard body)
|
||||||
"Registers a new cognitive tool into the global registry. Parameters must be a list of property lists."
|
"Registers a new cognitive tool.
|
||||||
|
NAME: Keyword identifier.
|
||||||
|
DESCRIPTION: Human-readable intent (used in LLM prompts).
|
||||||
|
PARAMETERS: List of property lists defining arguments.
|
||||||
|
GUARD: (context -> boolean) function to prevent unsafe calls.
|
||||||
|
BODY: The actual Lisp execution logic."
|
||||||
`(setf (gethash (string-downcase (string ',name)) *cognitive-tools*)
|
`(setf (gethash (string-downcase (string ',name)) *cognitive-tools*)
|
||||||
(make-cognitive-tool :name (string-downcase (string ',name))
|
(make-cognitive-tool :name (string-downcase (string ',name))
|
||||||
:description ,description
|
:description ,description
|
||||||
@@ -175,7 +179,7 @@
|
|||||||
:body ,body)))
|
:body ,body)))
|
||||||
|
|
||||||
(defun harness-log (msg &rest args)
|
(defun harness-log (msg &rest args)
|
||||||
"Centralized logging for the harness."
|
"Centralized logging for the harness. Writes to STDOUT and the thread-safe circular buffer."
|
||||||
(let ((formatted-msg (apply #'format nil msg args)))
|
(let ((formatted-msg (apply #'format nil msg args)))
|
||||||
(bt:with-lock-held (*logs-lock*)
|
(bt:with-lock-held (*logs-lock*)
|
||||||
(push formatted-msg *system-logs*)
|
(push formatted-msg *system-logs*)
|
||||||
@@ -1,12 +1,19 @@
|
|||||||
(in-package :opencortex)
|
(in-package :opencortex)
|
||||||
|
|
||||||
(defvar *probabilistic-backends* (make-hash-table :test 'equal))
|
(defvar *probabilistic-backends* (make-hash-table :test 'equal)
|
||||||
(defvar *provider-cascade* nil)
|
"A global mapping of provider identifiers (keywords) to their respective execution functions.")
|
||||||
(defvar *model-selector-fn* nil)
|
|
||||||
(defvar *consensus-enabled-p* nil)
|
(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)
|
(defun register-probabilistic-backend (name fn)
|
||||||
"Registers a neural provider (e.g., :gemini, :anthropic) with its calling function."
|
"Registers a neural provider with its calling function."
|
||||||
(setf (gethash name *probabilistic-backends*) fn))
|
(setf (gethash name *probabilistic-backends*) fn))
|
||||||
|
|
||||||
(defun probabilistic-call (prompt &key (system-prompt "You are the Probabilistic engine.") (cascade nil) (context nil))
|
(defun probabilistic-call (prompt &key (system-prompt "You are the Probabilistic engine.") (cascade nil) (context nil))
|
||||||
@@ -27,7 +34,7 @@
|
|||||||
(list :type :LOG :payload (list :text "Neural Cascade Failure: All providers exhausted.")))))
|
(list :type :LOG :payload (list :text "Neural Cascade Failure: All providers exhausted.")))))
|
||||||
|
|
||||||
(defun strip-markdown (text)
|
(defun strip-markdown (text)
|
||||||
"Strips common markdown code block markers from text."
|
"Strips common markdown code block markers from text to ensure valid S-expression parsing."
|
||||||
(if (and text (stringp text))
|
(if (and text (stringp text))
|
||||||
(let ((cleaned text))
|
(let ((cleaned text))
|
||||||
(setf cleaned (cl-ppcre:regex-replace-all "^```[a-z]*\\n" cleaned ""))
|
(setf cleaned (cl-ppcre:regex-replace-all "^```[a-z]*\\n" cleaned ""))
|
||||||
@@ -81,7 +88,7 @@ PROVIDER RULE: Always use the default cascade provider unless a specific model o
|
|||||||
thought)))))
|
thought)))))
|
||||||
|
|
||||||
(defun deterministic-verify (proposed-action context)
|
(defun deterministic-verify (proposed-action context)
|
||||||
"Iterates through all skill deterministic-gates sorted by priority."
|
"Iterates through all skill deterministic-gates sorted by priority. Ensures absolute safety of the neural proposal."
|
||||||
(let ((current-action proposed-action)
|
(let ((current-action proposed-action)
|
||||||
(skills nil))
|
(skills nil))
|
||||||
(maphash (lambda (name skill) (declare (ignore name)) (when (skill-deterministic-fn skill) (push skill skills))) *skills-registry*)
|
(maphash (lambda (name skill) (declare (ignore name)) (when (skill-deterministic-fn skill) (push skill skills))) *skills-registry*)
|
||||||
@@ -106,6 +113,7 @@ PROVIDER RULE: Always use the default cascade provider unless a specific model o
|
|||||||
(let* ((type (proto-get signal :type))
|
(let* ((type (proto-get signal :type))
|
||||||
(payload (proto-get signal :payload))
|
(payload (proto-get signal :payload))
|
||||||
(sensor (proto-get payload :sensor)))
|
(sensor (proto-get payload :sensor)))
|
||||||
|
;; Optimization: Only reason about user input or chat messages.
|
||||||
(unless (and (eq type :EVENT) (member sensor '(:user-input :chat-message)))
|
(unless (and (eq type :EVENT) (member sensor '(:user-input :chat-message)))
|
||||||
(return-from reason-gate signal))
|
(return-from reason-gate signal))
|
||||||
(let ((candidate (think signal)))
|
(let ((candidate (think signal)))
|
||||||
79
library/skills.lisp
Normal file
79
library/skills.lisp
Normal file
@@ -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))
|
||||||
@@ -1,31 +1,28 @@
|
|||||||
(in-package :cl-user)
|
(in-package :cl-user)
|
||||||
(defpackage :opencortex.tui
|
(defpackage :opencortex.tui (:use :cl :croatoan) (:export :main))
|
||||||
(:use :cl :croatoan)
|
|
||||||
(:export :main))
|
|
||||||
(in-package :opencortex.tui)
|
(in-package :opencortex.tui)
|
||||||
|
|
||||||
(defvar *daemon-host* "127.0.0.1")
|
(defvar *daemon-host* "127.0.0.1")
|
||||||
(defvar *daemon-port* 9105)
|
(defvar *daemon-port* 9105)
|
||||||
(defvar *socket* nil)
|
(defvar *socket* nil)
|
||||||
(defvar *stream* nil)
|
(defvar *stream* nil)
|
||||||
(defvar *chat-history* (list))
|
|
||||||
(defvar *status-text* "Connecting...")
|
(defvar *chat-history* nil "A list of strings representing the scrollback buffer.")
|
||||||
(defvar *input-buffer* (make-array 0 :element-type 'char :fill-pointer 0 :adjustable t))
|
(defvar *input-buffer* (make-array 0 :element-type 'character :fill-pointer 0 :adjustable t))
|
||||||
(defvar *is-running* t)
|
(defvar *is-running* t)
|
||||||
(defvar *queue-lock* (bt:make-lock))
|
(defvar *status-text* "Connecting...")
|
||||||
(defvar *incoming-msgs* nil)
|
|
||||||
|
(defvar *msg-queue* nil)
|
||||||
|
(defvar *queue-lock* (bt:make-lock "tui-msg-lock"))
|
||||||
|
|
||||||
(defun enqueue-msg (msg)
|
(defun enqueue-msg (msg)
|
||||||
(bt:with-lock-held (*queue-lock*)
|
(bt:with-lock-held (*queue-lock*) (push msg *msg-queue*)))
|
||||||
(push msg *incoming-msgs*)))
|
|
||||||
|
|
||||||
(defun dequeue-msgs ()
|
(defun dequeue-msgs ()
|
||||||
(bt:with-lock-held (*queue-lock*)
|
(bt:with-lock-held (*queue-lock*) (let ((m (reverse *msg-queue*))) (setf *msg-queue* nil) m)))
|
||||||
(let ((msgs (nreverse *incoming-msgs*)))
|
|
||||||
(setf *incoming-msgs* nil)
|
|
||||||
msgs)))
|
|
||||||
|
|
||||||
(defun clean-keywords (msg)
|
(defun clean-keywords (msg)
|
||||||
|
"Ensures all keys in a plist are uppercase keywords."
|
||||||
(if (listp msg)
|
(if (listp msg)
|
||||||
(let ((clean nil))
|
(let ((clean nil))
|
||||||
(loop for (k v) on msg by #'cddr
|
(loop for (k v) on msg by #'cddr
|
||||||
@@ -86,6 +83,7 @@
|
|||||||
(sleep 0.05)))
|
(sleep 0.05)))
|
||||||
|
|
||||||
(defun main ()
|
(defun main ()
|
||||||
|
"Primary entry point for the standalone TUI client."
|
||||||
(handler-case
|
(handler-case
|
||||||
(setf *socket* (usocket:socket-connect *daemon-host* *daemon-port*))
|
(setf *socket* (usocket:socket-connect *daemon-host* *daemon-port*))
|
||||||
(error (e) (format t "Error connecting: ~a~%" e) (return-from main)))
|
(error (e) (format t "Error connecting: ~a~%" e) (return-from main)))
|
||||||
@@ -105,11 +103,12 @@
|
|||||||
(setf (input-blocking input-win) nil)
|
(setf (input-blocking input-win) nil)
|
||||||
|
|
||||||
(loop while *is-running* do
|
(loop while *is-running* do
|
||||||
;; 1. Handle incoming messages
|
;; 1. Handle incoming messages from the queue
|
||||||
(let ((new-msgs (dequeue-msgs)))
|
(let ((new-msgs (dequeue-msgs)))
|
||||||
(when new-msgs
|
(when new-msgs
|
||||||
(dolist (msg new-msgs)
|
(dolist (msg new-msgs)
|
||||||
(push msg *chat-history*)
|
(push msg *chat-history*)
|
||||||
|
;; Maintenance: Cap scrollback to prevent memory bloat
|
||||||
(setf *chat-history* (subseq *chat-history* 0 (min (length *chat-history*) 500))))
|
(setf *chat-history* (subseq *chat-history* 0 (min (length *chat-history*) 500))))
|
||||||
|
|
||||||
(clear chat-win)
|
(clear chat-win)
|
||||||
@@ -119,7 +118,7 @@
|
|||||||
(incf line-num)))
|
(incf line-num)))
|
||||||
(refresh chat-win)))
|
(refresh chat-win)))
|
||||||
|
|
||||||
;; 2. Render Status Bar ONLY if changed
|
;; 2. Render Status Bar
|
||||||
(unless (equal *status-text* last-status)
|
(unless (equal *status-text* last-status)
|
||||||
(clear status-win)
|
(clear status-win)
|
||||||
(add-string status-win *status-text* :attributes '(:reverse))
|
(add-string status-win *status-text* :attributes '(:reverse))
|
||||||
@@ -135,9 +134,7 @@
|
|||||||
(let ((cmd (coerce *input-buffer* 'string)))
|
(let ((cmd (coerce *input-buffer* 'string)))
|
||||||
(setf (fill-pointer *input-buffer*) 0)
|
(setf (fill-pointer *input-buffer*) 0)
|
||||||
(when (> (length cmd) 0)
|
(when (> (length cmd) 0)
|
||||||
;; Local Echo
|
;; Frame and dispatch the message
|
||||||
(enqueue-msg (concatenate 'string "> " cmd))
|
|
||||||
;; Send to Brain
|
|
||||||
(let ((framed (opencortex:frame-message (list :TYPE :EVENT
|
(let ((framed (opencortex:frame-message (list :TYPE :EVENT
|
||||||
:META (list :SOURCE :tui :SESSION-ID "default")
|
:META (list :SOURCE :tui :SESSION-ID "default")
|
||||||
:PAYLOAD (list :SENSOR :user-input :TEXT cmd)))))
|
:PAYLOAD (list :SENSOR :user-input :TEXT cmd)))))
|
||||||
@@ -13,7 +13,7 @@ The *opencortex* is a probabilistic-deterministic harness for a personal operati
|
|||||||
* Package Context
|
* Package Context
|
||||||
Every skill executes within its own jailed package namespace, while inheriting core harness symbols.
|
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)
|
(in-package :opencortex)
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
@@ -23,7 +23,7 @@ This document contains the *Core System Policy*. These are non-negotiable philos
|
|||||||
** 1. Autonomy Above All
|
** 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.
|
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)
|
(defun policy-check-autonomy (action context)
|
||||||
"Ensures the action does not violate the Autonomy invariant."
|
"Ensures the action does not violate the Autonomy invariant."
|
||||||
(declare (ignore context))
|
(declare (ignore context))
|
||||||
@@ -47,7 +47,7 @@ Prioritize local, energy-efficient, and offline-first architectures. The "Memex"
|
|||||||
* The Policy Gate
|
* The Policy Gate
|
||||||
The main deterministic entry point for the policy skill. It orchestrates the various invariant checks and delegates to engineering standards.
|
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)
|
(defun policy-deterministic-gate (action context)
|
||||||
"The main policy gate. Sub-calls engineering standards if available."
|
"The main policy gate. Sub-calls engineering standards if available."
|
||||||
(let ((current-action (policy-check-autonomy action context)))
|
(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]].
|
Every action performed by an agent in this environment must also adhere to the [[file:org-skill-engineering-standards.org][Engineering Standards]].
|
||||||
|
|
||||||
** Skill Registration
|
** Skill Registration
|
||||||
#+begin_src lisp :tangle ../src/policy.lisp
|
#+begin_src lisp :tangle ../library/policy.lisp
|
||||||
(defskill :skill-policy
|
(defskill :skill-policy
|
||||||
:priority 100
|
:priority 100
|
||||||
:trigger (lambda (ctx) t)
|
:trigger (lambda (ctx) t)
|
||||||
|
|||||||
@@ -45,7 +45,7 @@ Decouple protocol parsing (framing/unframing) from semantic validation.
|
|||||||
* Phase D: Build (Implementation)
|
* Phase D: Build (Implementation)
|
||||||
|
|
||||||
** Schema Enforcement
|
** Schema Enforcement
|
||||||
#+begin_src lisp :tangle ../src/communication-validator.lisp
|
#+begin_src lisp :tangle ../library/communication-validator.lisp
|
||||||
(in-package :opencortex)
|
(in-package :opencortex)
|
||||||
|
|
||||||
(defun validate-communication-protocol-schema (msg)
|
(defun validate-communication-protocol-schema (msg)
|
||||||
@@ -79,7 +79,7 @@ Decouple protocol parsing (framing/unframing) from semantic validation.
|
|||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
* Registration
|
* Registration
|
||||||
#+begin_src lisp :tangle ../src/communication-validator.lisp
|
#+begin_src lisp :tangle ../library/communication-validator.lisp
|
||||||
(defskill :skill-communication-protocol-validator
|
(defskill :skill-communication-protocol-validator
|
||||||
:priority 95
|
:priority 95
|
||||||
:trigger (lambda (ctx) (member (getf (getf ctx :payload) :sensor) '(:protocol-received)))
|
:trigger (lambda (ctx) (member (getf (getf ctx :payload) :sensor) '(:protocol-received)))
|
||||||
|
|||||||
@@ -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)))
|
|
||||||
119
src/context.lisp
119
src/context.lisp
@@ -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))
|
|
||||||
115
src/memory.lisp
115
src/memory.lisp
@@ -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)))
|
|
||||||
286
src/skills.lisp
286
src/skills.lisp
@@ -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 <name> :args (...))
|
|
||||||
|
|
||||||
EXAMPLES:
|
|
||||||
(:target :tool :action :call :tool \"eval\" :args (:code \"(+ 1 1)\"))
|
|
||||||
(:target :tool :action :call :tool \"grep-search\" :args (:pattern \"autonomousty\"))
|
|
||||||
(:target :tool :action :call :tool \"shell\" :args (:cmd \"ls -la\"))
|
|
||||||
|
|
||||||
---
|
|
||||||
" )))
|
|
||||||
(maphash (lambda (name tool)
|
|
||||||
(setf output (concatenate 'string output
|
|
||||||
(format nil "- ~a: ~a~% Parameters: ~s~%~%"
|
|
||||||
name
|
|
||||||
(cognitive-tool-description tool)
|
|
||||||
(cognitive-tool-parameters tool)))))
|
|
||||||
*cognitive-tools*)
|
|
||||||
output))
|
|
||||||
|
|
||||||
(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)))))
|
|
||||||
Reference in New Issue
Block a user