docs: restructure literate source into separate component files and remove legacy docs
This commit is contained in:
1195
README.org
1195
README.org
File diff suppressed because it is too large
Load Diff
@@ -1,39 +0,0 @@
|
||||
#+TITLE: Phase 2: The Delegator (Roadmap)
|
||||
#+AUTHOR: org-agent
|
||||
#+DATE: [2026-03-23 Mon]
|
||||
|
||||
* Overview
|
||||
Phase 2 shifts focus from kernel architecture to capability expansion. Because the kernel (Phase 1) is a generalized Event Bus, **all Phase 2 features are implemented entirely as Org-Native Skills**. No modifications to the Lisp Core (`core.lisp`, `neuro.lisp`, `symbolic.lisp`) are required.
|
||||
|
||||
* The Phase 2 Skill Roster
|
||||
|
||||
** 1. The LLM Router
|
||||
- **Skill File:** `skills/skill-router.org`
|
||||
- **Role:** Meta-cognition. Replaces complex Lisp trigger logic with LLM intent classification.
|
||||
- **Trigger:** Catches general `:user-command` or ambiguous `:buffer-update` events.
|
||||
- **Action:** Instead of editing a file, it emits an internal Lisp event `(:type :EVENT :payload (:sensor :delegation :target-skill <skill-name>))`, forcing the engine to re-loop and trigger the specific skill.
|
||||
|
||||
** 2. Deep Memory (Vector/Semantic Search)
|
||||
- **Skill File:** `skills/skill-atomic-notes.org`
|
||||
- **Role:** Context augmentation beyond the live RAM `*object-store*`.
|
||||
- **System 2 (Lisp):** Wraps a local search tool (like `ripgrep` or a lightweight Lisp vector db).
|
||||
- **System 1 (LLM):** Formats the retrieved text into the Context API so downstream skills can read it before making decisions.
|
||||
|
||||
** 3. The Shell Actuator
|
||||
- **Skill File:** `skills/skill-shell-actuator.org`
|
||||
- **Role:** Gives the agent hands outside of Emacs.
|
||||
- **Registration:** Uses `(org-agent:register-actuator :shell #'execute-shell-safely)`.
|
||||
- **System 2 (Gatekeeper):** A massive, paranoid Lisp function that whitelist-checks commands (e.g., allows `git status`, blocks `rm`).
|
||||
|
||||
** 4. The Cron Scheduler
|
||||
- **Skill File:** `skills/skill-cron.org`
|
||||
- **Role:** Autonomous temporal action.
|
||||
- **Trigger:** `(eq sensor :heartbeat)`
|
||||
- **System 2 (Lisp):** Queries the `*object-store*` for deadlines. If a deadline has passed, it creates an action.
|
||||
- **System 1 (LLM):** Drafts a polite, contextual warning message to send to the user.
|
||||
|
||||
** 5. Web Research
|
||||
- **Skill File:** `skills/skill-web-research.org`
|
||||
- **Role:** Internet connectivity via headless text browsing.
|
||||
- **System 2 (Lisp):** Wraps `lynx` and `curl` to fetch webpage content.
|
||||
- **System 1 (LLM):** Parses the raw HTML/text and synthesizes a summary for the user.
|
||||
@@ -1,16 +0,0 @@
|
||||
#+TITLE: PRD: LLM Failover Cascade & Multi-Provider Support
|
||||
#+AUTHOR: PSF Requirements Definer
|
||||
#+STATUS: FROZEN
|
||||
|
||||
* 1. Purpose
|
||||
Ensure 100% availability of System 1 (Neural) reasoning via an ordered list of providers and automatic fallbacks.
|
||||
|
||||
* 2. Functional Requirements
|
||||
- **Backend Registry:** The core MUST allow Skills to register new AI providers (Gemini, OpenAI, Claude, etc.).
|
||||
- **Automatic Failover:** The `ask-neuro` function MUST iterate through a `*provider-cascade*` list, automatically trying the next provider if the previous one fails.
|
||||
- **Interactive Re-Ordering:** The system MUST allow the user to update the cascade order in real-time from Emacs.
|
||||
|
||||
* 3. Success Criteria
|
||||
- DONE Daemon correctly falls back from a failing API key to a working one.
|
||||
- DONE `M-x org-agent-set-model-cascade` successfully updates the live Lisp hierarchy.
|
||||
- DONE Support for 5+ providers (Gemini, OpenAI, Anthropic, OpenRouter, Ollama).
|
||||
@@ -1,17 +0,0 @@
|
||||
#+TITLE: PRD: Org-Native Multi-Modal Delivery
|
||||
#+AUTHOR: PSF Requirements Definer
|
||||
#+STATUS: FROZEN
|
||||
|
||||
* 1. Purpose
|
||||
Enable the agent to communicate outside of Emacs while maintaining all outbound records in a human-readable, homoiconic format.
|
||||
|
||||
* 2. Functional Requirements
|
||||
- **Org-Native Outbox:** The system MUST use a central Org file (`9_system/delivery.org`) as its outbound message queue.
|
||||
- **Actuator API:** A `:delivery` actuator MUST be registered to handle external messaging intents.
|
||||
- **Channel Support:** The system MUST support Signal, Telegram, and Discord metadata.
|
||||
- **Proactive Alerts:** The Cron skill MUST be able to route alerts to the delivery actuator based on Org properties.
|
||||
|
||||
* 3. Success Criteria
|
||||
- DONE New messages appear as structured headlines in `delivery.org`.
|
||||
- DONE Metadata (channel, target) is stored in native Org property drawers.
|
||||
- DONE No hidden JSON or external database required for queueing.
|
||||
@@ -1,17 +0,0 @@
|
||||
#+TITLE: PRD: Project Foundry (Scaffolding)
|
||||
#+AUTHOR: PSF Requirements Definer
|
||||
#+STATUS: FROZEN
|
||||
|
||||
* 1. Purpose
|
||||
Act as a senior engineer by autonomously scaffolding new project directories, git repos, and documentation templates.
|
||||
|
||||
* 2. Functional Requirements
|
||||
- **Directory Creation:** The system MUST be able to create new folders within the `$PROJECTS_DIR`.
|
||||
- **Git Integration:** The foundry MUST initialize a new git repository for every scaffolded project.
|
||||
- **Boilerplate Generation:** The system MUST write a customized `README.org` for new projects.
|
||||
- **GTD Connection:** The foundry MUST automatically add a `PROJ` headline to `gtd.org` with a dynamic `:PROJECT_PATH:`.
|
||||
|
||||
* 3. Success Criteria
|
||||
- DONE New projects appear in the physical filesystem and the GTD plan simultaneously.
|
||||
- DONE Path resolution handles environment variables (`$PROJECTS_DIR`) correctly.
|
||||
- DONE System 2 prevents overwriting existing project directories.
|
||||
@@ -1,16 +0,0 @@
|
||||
#+TITLE: PRD: The Skill Graph & Self-Awareness
|
||||
#+AUTHOR: PSF Requirements Definer
|
||||
#+STATUS: FROZEN
|
||||
|
||||
* 1. Purpose
|
||||
Enable recursive, networked intelligence by unifying logic (skills) and knowledge (Atomic Notes (Zettelkasten)).
|
||||
|
||||
* 2. Functional Requirements
|
||||
- **Dependency Tracking:** Skills MUST be able to declare dependencies on other skills via `#+DEPENDS_ON:`.
|
||||
- **Introspection:** The kernel MUST provide an API to list all active skills and read their source code.
|
||||
- **Topological Dispatch:** The system MUST resolve dependencies recursively before engaging a skill.
|
||||
|
||||
* 3. Success Criteria
|
||||
- DONE `(context-list-all-skills)` returns accurate priority and dependency metadata.
|
||||
- DONE Skills jailed in isolated packages can still resolve symbols from their declared dependencies.
|
||||
- DONE The Brain Mapper skill can successfully visualize the network.
|
||||
@@ -1,17 +0,0 @@
|
||||
#+TITLE: PRD: Kernel Web Dashboard
|
||||
#+AUTHOR: PSF Requirements Definer
|
||||
#+STATUS: FROZEN
|
||||
|
||||
* 1. Purpose
|
||||
Provide a read-only visual interface for monitoring the Lisp Machine's internal state and execution logs.
|
||||
|
||||
* 2. Functional Requirements
|
||||
- **Web Server:** A lightweight HTTP server (Hunchentoot) MUST run inside the kernel.
|
||||
- **Skill Visualization:** The dashboard MUST display the current Skill Graph, priorities, and jailing status.
|
||||
- **Log Monitoring:** The dashboard MUST display the most recent 20-50 system log entries.
|
||||
- **Remote Access:** The dashboard MUST be accessible from other computers on the local network (binding to 0.0.0.0).
|
||||
|
||||
* 3. Success Criteria
|
||||
- DONE Dashboard loads at `http://<ip>:8081`.
|
||||
- DONE Skill list updates dynamically as new skills are hot-loaded.
|
||||
- DONE Kernel errors are visible in the web UI.
|
||||
@@ -1,23 +0,0 @@
|
||||
#+TITLE: PRD: Skill-Based Dynamic Model Switching
|
||||
#+AUTHOR: PSF Requirements Definer
|
||||
#+DATE: 2026-03-24
|
||||
#+STARTUP: content
|
||||
|
||||
* Overview
|
||||
The `org-agent` currently relies on hardcoded LLM model strings within its pluggable provider skills. To match the flexibility of the legacy Openclaw system while maintaining a **Minimalist Core**, we will implement a "Homoiconic Configuration" model using the **Skill Graph**. Configuration settings will live as standard Org-mode properties in the user's memex, and a dedicated configuration skill will provide lookup services to other skills.
|
||||
|
||||
* Mandates
|
||||
- **The Org Mandate:** Configuration MUST be human-editable and machine-readable within `.org` files.
|
||||
- **Minimalist Core:** No new global variables or state-management registries shall be added to the kernel (`src/*.lisp`).
|
||||
- **Skill Graph Sovereignty:** Capabilities MUST build upon one another via dependencies.
|
||||
|
||||
* Requirements
|
||||
1. **Property-Based Configuration:** The system MUST allow defining LLM models via Org-mode properties (e.g., `:LLM_MODEL_OPENAI: gpt-4o`) anywhere in the loaded memex files.
|
||||
2. **Configuration Skill:** A new skill (`skill-environment-config.org`) MUST be created to handle property lookups within the persistent `*object-store*`.
|
||||
3. **Skill Integration:** Provider skills (OpenAI, Anthropic, OpenRouter) MUST declare a dependency on `skill-environment-config` and query it for their model string at runtime.
|
||||
4. **Late-Binding Updates:** Because the kernel updates the `*object-store*` on every buffer save, changing a model string in an Org file results in an immediate, hot-swapped change to the agent's behavior.
|
||||
|
||||
* Acceptance Criteria
|
||||
- A user can add `:LLM_MODEL_OPENAI: gpt-4o` to a "Settings" headline in their memex.
|
||||
- The OpenAI provider skill successfully fetches this value via the configuration skill.
|
||||
- No modifications are made to the core Lisp daemon files.
|
||||
@@ -1,22 +0,0 @@
|
||||
#+TITLE: PRD: Model Discovery
|
||||
#+AUTHOR: PSF Requirements Definer
|
||||
#+DATE: 2026-03-24
|
||||
#+STARTUP: content
|
||||
|
||||
* Overview
|
||||
Users currently lack visibility into the LLM models available via the registered provider skills (OpenAI, Anthropic, OpenRouter). To match Openclaw's UX while preserving a Minimalist Core, the system needs an intra-skill discovery protocol.
|
||||
|
||||
* Mandates
|
||||
- **The Org Mandate:** Outputs must be rendered natively in Org-mode buffers.
|
||||
- **Minimalist Core:** No state or new capabilities shall be added to the Lisp Daemon. All discovery logic must be localized to the Skill Graph.
|
||||
|
||||
* Requirements
|
||||
1. **Dynamic Provider Introspection:** The system MUST be able to query loaded skills dynamically to find which ones act as LLM providers.
|
||||
2. **Model Listing API:** Every provider skill MUST export a function that returns a list of its available models (e.g., ID, Context Window).
|
||||
3. **The Explorer Skill:** A new skill (`skill-model-explorer.org`) MUST intercept the command `@agent list models` and aggregate the results from all providers.
|
||||
4. **Org-Table Output:** The Explorer Skill MUST output the aggregated list back to the Emacs buffer formatted as an `org-table` for immediate human readability.
|
||||
|
||||
* Acceptance Criteria
|
||||
- Writing `@agent list models` in an Org buffer and saving triggers the Explorer Skill.
|
||||
- An Org-mode table is inserted below the command containing columns for `Provider`, `Model`, and `Context`.
|
||||
- Adding a new provider skill automatically includes its models in future queries without modifying the Explorer Skill.
|
||||
@@ -1,47 +0,0 @@
|
||||
#+TITLE: PROTOCOL: Skill-Based Configuration
|
||||
#+AUTHOR: PSF Architect
|
||||
#+DATE: 2026-03-24
|
||||
#+STARTUP: content
|
||||
|
||||
* Overview
|
||||
This protocol defines the skill-to-skill interface for retrieving environment configuration from the Org-mode Object-Store. It leverages the **Skill Graph** to provide a centralized configuration API for all other skills.
|
||||
|
||||
* The Configuration Skill (`skill-environment-config.org`)
|
||||
|
||||
** 1. Internal Logic
|
||||
The skill iterates over the kernel's `*object-store*` to find headlines containing specific properties.
|
||||
|
||||
#+begin_src lisp
|
||||
(defun get-config-attribute (property-key &optional default)
|
||||
"Searches the global *object-store* for any headline containing PROPERTY-KEY."
|
||||
(let ((store org-agent:*object-store*))
|
||||
(maphash (lambda (id obj)
|
||||
(declare (ignore id))
|
||||
(when (eq (org-agent:org-object-type obj) :HEADLINE)
|
||||
(let ((val (getf (org-agent:org-object-attributes obj) property-key)))
|
||||
(when val
|
||||
(return-from get-config-attribute val)))))
|
||||
store)
|
||||
default))
|
||||
#+end_src
|
||||
|
||||
* Skill Graph Integration
|
||||
|
||||
** 2. Dependency Declaration
|
||||
Other skills requiring configuration MUST declare a dependency on this skill.
|
||||
|
||||
#+begin_src org
|
||||
#+DEPENDS_ON: skill-environment-config
|
||||
#+end_src
|
||||
|
||||
** 3. Provider Integration Example
|
||||
Provider skills will invoke the config skill's API during the System 1 prompt generation.
|
||||
|
||||
#+begin_src lisp
|
||||
(let ((model (org-agent.skills.skill-environment-config:get-config-attribute :LLM_MODEL_OPENAI "gpt-4-turbo-preview")))
|
||||
;; ... use model in API call ...
|
||||
)
|
||||
#+end_src
|
||||
|
||||
* No Core Modifications Required
|
||||
This protocol adheres to the **Minimalist Core** mandate by implementing the entirety of the "Dynamic Model Switching" logic within the Skill Layer.
|
||||
@@ -1,51 +0,0 @@
|
||||
#+TITLE: PROTOCOL: Model Discovery
|
||||
#+AUTHOR: PSF Architect
|
||||
#+DATE: 2026-03-24
|
||||
#+STARTUP: content
|
||||
|
||||
* Overview
|
||||
This protocol defines the interfaces allowing the `org-agent` to dynamically introspect available models from any loaded provider skill, outputting the result to Emacs as an Org table.
|
||||
|
||||
* 1. The Provider Export Interface
|
||||
Every skill acting as a Neural Provider MUST export a function named `GET-AVAILABLE-MODELS`.
|
||||
|
||||
#+begin_src lisp
|
||||
;; Signature
|
||||
(get-available-models) -> list-of-plists
|
||||
|
||||
;; Return Format Example
|
||||
'((:id "gpt-4-turbo" :context "128k")
|
||||
(:id "gpt-4o" :context "128k"))
|
||||
#+end_src
|
||||
|
||||
* 2. The Model Explorer Skill (`skill-model-explorer.org`)
|
||||
|
||||
** Dynamic Introspection
|
||||
The explorer uses the kernel's `(org-agent:context-list-all-skills)` API to find all skills whose name starts with `skill-provider-`.
|
||||
|
||||
For each matching skill, it looks up the package:
|
||||
#+begin_src lisp
|
||||
(let* ((pkg (find-package (intern (string-upcase (format nil "ORG-AGENT.SKILLS.~a" skill-name)) :keyword)))
|
||||
(fn (when pkg (find-symbol "GET-AVAILABLE-MODELS" pkg))))
|
||||
(when (and fn (fboundp fn))
|
||||
(funcall fn)))
|
||||
#+end_src
|
||||
|
||||
** Org-Table Formatting
|
||||
The explorer aggregates the plists and formats them into an Org table string:
|
||||
#+begin_example
|
||||
| Provider | Model ID | Context |
|
||||
|----------+----------+---------|
|
||||
| OpenAI | gpt-4o | 128k |
|
||||
#+end_example
|
||||
|
||||
* 3. Emacs Actuator Command
|
||||
The explorer generates a System 2 `approved-action` that instructs the `:emacs` actuator to insert this text.
|
||||
|
||||
#+begin_src lisp
|
||||
'(:type :REQUEST
|
||||
:target :emacs
|
||||
:payload (:action :insert-text
|
||||
:text "| Provider | Model ID | Context |\n..."
|
||||
:position :after-trigger))
|
||||
#+end_src
|
||||
207
literate/context.org
Normal file
207
literate/context.org
Normal file
@@ -0,0 +1,207 @@
|
||||
#+TITLE: Peripheral Vision (context.lisp & embedding.lisp)
|
||||
#+AUTHOR: Amr
|
||||
#+FILETAGS: :kernel:context:embedding:
|
||||
#+STARTUP: content
|
||||
|
||||
* Peripheral Vision (context.lisp & embedding.lisp)
|
||||
** Deep Reasoning: Solving the "Lost in the Middle" Problem
|
||||
LLMs lose precision when context windows are bloated with irrelevant data.
|
||||
- **Sparse Trees:** We use Lisp's deterministic tree-walking to surgically prune the Org AST. We pass the skeletal "peripheral" outline to the LLM, giving it global awareness while keeping its "foveal" focus on the task at hand. This minimizes token burn and maximizes reasoning accuracy.
|
||||
|
||||
* Context Assembly (context.lisp)
|
||||
The `context.lisp` module provides deterministic functions for querying the `*object-store*` and assembling the precise context string sent to System 1.
|
||||
|
||||
** Package Context
|
||||
#+begin_src lisp :tangle ../src/context.lisp
|
||||
(in-package :org-agent)
|
||||
#+end_src
|
||||
|
||||
** Querying the Store (context-query-store)
|
||||
A generalized filter for the Object Store that supports tags, TODO states, and element types.
|
||||
|
||||
#+begin_src lisp :tangle ../src/context.lisp
|
||||
(defun context-query-store (&key tag todo-state type)
|
||||
"Filters the Object Store 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))))
|
||||
*object-store*)
|
||||
results))
|
||||
#+end_src
|
||||
|
||||
** Active Projects (context-get-active-projects)
|
||||
Identifies headlines tagged with `project` that are not yet marked as `DONE`.
|
||||
|
||||
#+begin_src lisp :tangle ../src/context.lisp
|
||||
(defun context-get-active-projects ()
|
||||
"Returns headlines tagged as 'project' that are not yet marked DONE."
|
||||
(remove-if (lambda (obj) (equal (getf (org-object-attributes obj) :TODO-STATE) "DONE"))
|
||||
(context-query-store :tag "project" :type :HEADLINE)))
|
||||
#+end_src
|
||||
|
||||
** Completed Tasks (context-get-recent-completed-tasks)
|
||||
Retrieves a list of tasks that have reached the terminal `DONE` state.
|
||||
|
||||
#+begin_src lisp :tangle ../src/context.lisp
|
||||
(defun context-get-recent-completed-tasks ()
|
||||
"Retrieves recently finished tasks from the store."
|
||||
(context-query-store :todo-state "DONE" :type :HEADLINE))
|
||||
#+end_src
|
||||
|
||||
** Capability Discovery (context-list-all-skills)
|
||||
Provides a sorted list of all currently loaded skills, including their priority and dependencies.
|
||||
|
||||
#+begin_src lisp :tangle ../src/context.lisp
|
||||
(defun context-list-all-skills ()
|
||||
"Provides a sorted overview of currently loaded system capabilities."
|
||||
(let ((results nil))
|
||||
(maphash (lambda (name skill)
|
||||
(declare (ignore name))
|
||||
(push (list :name (skill-name skill) :priority (skill-priority skill) :dependencies (skill-dependencies skill)) results))
|
||||
*skills-registry*)
|
||||
(sort results #'> :key (lambda (x) (getf x :priority)))))
|
||||
#+end_src
|
||||
|
||||
** Skill Inspection (context-get-skill-source)
|
||||
Reads the raw literate source of a specific skill. This is crucial for "System 2" meta-reasoning, where the agent needs to understand its own implementation.
|
||||
|
||||
#+begin_src lisp :tangle ../src/context.lisp
|
||||
(defun context-get-skill-source (skill-name)
|
||||
"Reads the raw literate source of a specific skill for inspection."
|
||||
(let* ((filename (format nil "~a.org" skill-name))
|
||||
(skills-dir (merge-pathnames "skills/" (asdf:system-source-directory :org-agent)))
|
||||
(full-path (merge-pathnames filename skills-dir)))
|
||||
(if (uiop:file-exists-p full-path) (uiop:read-file-string full-path) nil)))
|
||||
#+end_src
|
||||
|
||||
** Kernel Logs (context-get-system-logs)
|
||||
Retrieves the most recent system logs, providing temporal context to the LLM.
|
||||
|
||||
#+begin_src lisp :tangle ../src/context.lisp
|
||||
(defun context-get-system-logs (&optional (limit 20))
|
||||
"Retrieves the most recent lines from the kernel's internal log."
|
||||
(bt:with-lock-held (*logs-lock*)
|
||||
(let ((count (min limit (length *system-logs*)))) (subseq *system-logs* 0 count))))
|
||||
#+end_src
|
||||
|
||||
** Telemetry (context-get-skill-telemetry)
|
||||
Provides execution stats for a specific skill.
|
||||
|
||||
#+begin_src lisp :tangle ../src/context.lisp
|
||||
(defun context-get-skill-telemetry (skill-name)
|
||||
"Returns performance and execution data for a specific skill."
|
||||
(bt:with-lock-held (*telemetry-lock*) (gethash (string-downcase skill-name) *skill-telemetry*)))
|
||||
#+end_src
|
||||
|
||||
** Sparse Trees (context-filter-sparse-tree)
|
||||
Prunes the Org AST to show only specific nodes and their ancestors, creating a "skeleton" view that fits within LLM context limits.
|
||||
|
||||
#+begin_src lisp :tangle ../src/context.lisp
|
||||
(defun context-filter-sparse-tree (ast predicate)
|
||||
"Prunes an AST to show only nodes matching a predicate and their ancestors."
|
||||
(if (listp ast)
|
||||
(let* ((contents (getf ast :contents))
|
||||
(filtered-contents (remove-if #'null (mapcar (lambda (c) (context-filter-sparse-tree c predicate)) contents))))
|
||||
(if (or (funcall predicate ast) (not (null filtered-contents)))
|
||||
(let ((new-ast (copy-list ast))) (setf (getf new-ast :contents) filtered-contents) new-ast)
|
||||
nil))
|
||||
nil))
|
||||
#+end_src
|
||||
|
||||
** Path Resolution (context-resolve-path)
|
||||
Expands environment variables (like `$HOME`) within path strings.
|
||||
|
||||
#+begin_src lisp :tangle ../src/context.lisp
|
||||
(defun context-resolve-path (path-string)
|
||||
"Expands environment variables within path strings (e.g. $HOME/...)."
|
||||
(if (and (stringp path-string) (uiop:string-prefix-p "$" path-string))
|
||||
(let* ((parts (uiop:split-string path-string :separator '(#\/)))
|
||||
(var-name (subseq (car parts) 1)) (var-val (uiop:getenv var-name))
|
||||
(remaining (cl:reduce (lambda (a b) (format nil "~a/~a" a b)) (cdr parts))))
|
||||
(if var-val (let ((clean-val (string-trim '(#\" #\Space) var-val)))
|
||||
(format nil "~a/~a" (string-right-trim "/" clean-val) remaining))
|
||||
path-string))
|
||||
path-string))
|
||||
#+end_src
|
||||
|
||||
** Global Awareness (context-assemble-global-awareness)
|
||||
The primary "peripheral vision" generator. It produces the skeletal overview of the Memex that is prepended to LLM prompts.
|
||||
|
||||
#+begin_src lisp :tangle ../src/context.lisp
|
||||
(defun context-assemble-global-awareness ()
|
||||
"Produces a high-level skeletal outline of the current Object Store for the LLM."
|
||||
(let ((projects (context-get-active-projects))
|
||||
(output "GLOBAL MEMEX AWARENESS (Peripheral Vision):
|
||||
"))
|
||||
(if projects
|
||||
(dolist (project projects)
|
||||
(setf output (concatenate 'string output
|
||||
(format nil "- PROJECT: ~a (ID: ~a)~%"
|
||||
(getf (org-object-attributes project) :TITLE)
|
||||
(org-object-id project)))))
|
||||
(setf output (concatenate 'string output "No active projects found.~%")))
|
||||
output))
|
||||
#+end_src
|
||||
|
||||
* Semantic Search (embedding.lisp)
|
||||
The `embedding.lisp` module handles vector representations and cosine similarity for semantic discovery.
|
||||
|
||||
** Package Context
|
||||
#+begin_src lisp :tangle ../src/embedding.lisp
|
||||
(in-package :org-agent)
|
||||
#+end_src
|
||||
|
||||
** Embedding Retrieval (get-embedding)
|
||||
Fetches a numerical vector representation of text from the configured provider (defaults to Gemini `text-embedding-004`).
|
||||
|
||||
#+begin_src lisp :tangle ../src/embedding.lisp
|
||||
(defun get-embedding (text)
|
||||
"Retrieves a vector representation of text via the configured neural provider."
|
||||
(let* ((auth (get-provider-auth :gemini)) (api-key (getf auth :api-key))
|
||||
(endpoint "https://generativelanguage.googleapis.com/v1beta/models/text-embedding-004:embedContent"))
|
||||
(unless api-key (return-from get-embedding nil))
|
||||
(let* ((url (format nil "~a?key=~a" endpoint api-key)) (headers `(("Content-Type" . "application/json")))
|
||||
(body (cl-json:encode-json-to-string `((model . "models/text-embedding-004") (content . ((parts . ((text . ,text)))))))))
|
||||
(handler-case (let* ((response (dex:post url :headers headers :content body))
|
||||
(json (cl-json:decode-json-from-string response)))
|
||||
(cdr (assoc :values (cdr (assoc :embedding json)))))
|
||||
(error (c) (kernel-log "EMBEDDING FAILURE: ~a" c) nil)))))
|
||||
#+end_src
|
||||
|
||||
** Vector Math
|
||||
Simple implementations of dot product and magnitude for similarity calculations.
|
||||
|
||||
#+begin_src lisp :tangle ../src/embedding.lisp
|
||||
(defun dot-product (v1 v2)
|
||||
"Calculates the dot product of two numerical vectors."
|
||||
(reduce #'+ (mapcar #'* v1 v2)))
|
||||
|
||||
(defun magnitude (v)
|
||||
"Calculates the Euclidean magnitude of a numerical vector."
|
||||
(sqrt (reduce #'+ (mapcar (lambda (x) (* x x)) v))))
|
||||
#+end_src
|
||||
|
||||
** Cosine Similarity (cosine-similarity)
|
||||
Calculates the semantic distance (normalized dot product) between two vectors.
|
||||
|
||||
#+begin_src lisp :tangle ../src/embedding.lisp
|
||||
(defun cosine-similarity (v1 v2)
|
||||
"Calculates the semantic distance between two vectors."
|
||||
(let ((m1 (magnitude v1)) (m2 (magnitude v2))) (if (or (zerop m1) (zerop m2)) 0 (/ (dot-product v1 v2) (* m1 m2)))))
|
||||
#+end_src
|
||||
|
||||
** Semantic Discovery (find-most-similar)
|
||||
Identifies the top-k most semantically related objects in the entire store by comparing their cached vectors against a query vector.
|
||||
|
||||
#+begin_src lisp :tangle ../src/embedding.lisp
|
||||
(defun find-most-similar (query-vector top-k)
|
||||
"Identifies the top-k most semantically related objects in the store."
|
||||
(let ((similarities nil))
|
||||
(maphash (lambda (id obj) (let ((vec (org-object-vector obj))) (when vec (push (cons (cosine-similarity query-vector vec) obj) similarities)))) *object-store*)
|
||||
(let ((sorted (sort similarities #'> :key #'car))) (subseq sorted 0 (min top-k (length sorted))))))
|
||||
#+end_src
|
||||
350
literate/core.org
Normal file
350
literate/core.org
Normal file
@@ -0,0 +1,350 @@
|
||||
#+TITLE: The Cognitive Loop (core.lisp)
|
||||
#+AUTHOR: Amr
|
||||
#+FILETAGS: :kernel:core:
|
||||
#+STARTUP: content
|
||||
|
||||
* The Cognitive Loop (core.lisp)
|
||||
** Deep Reasoning: Why Asynchronous Recursion?
|
||||
Most AI agents are linear "chatbots" that block the interface while waiting for an LLM response. In a Sovereign OS, this is unacceptable.
|
||||
- **Responsiveness:** By spawning non-blocking threads, the user can continue typing in Emacs while the agent "thinks."
|
||||
- **Self-Reflection:** The recursive nature allows the agent to observe its own errors. If a tool fails, the error is injected as a new stimulus. The agent realizes its mistake and proposes a fix without human prompting.
|
||||
- **The Depth Break:** We implement a hardcoded depth limit (Order 2 Autonomy) to prevent "hallucination ruts" where the agent enters an infinite loop of apologies.
|
||||
|
||||
** The Cognitive Loop (OODA Architecture)
|
||||
#+begin_src mermaid
|
||||
sequenceDiagram
|
||||
participant Sensor
|
||||
participant Kernel
|
||||
participant System1 as System 1 (LLM)
|
||||
participant System2 as System 2 (Lisp)
|
||||
participant Actuator
|
||||
|
||||
Sensor->>Kernel: Perceive (Stimulus)
|
||||
Kernel->>System1: Think (Inject Prompt)
|
||||
System1-->>Kernel: Proposed Action
|
||||
Kernel->>System2: Decide (Safety Gate)
|
||||
alt Validation Failed
|
||||
System2-->>Kernel: Reject / Log Error
|
||||
else Validation Passed
|
||||
System2->>Actuator: Act (Dispatch)
|
||||
end
|
||||
#+end_src
|
||||
|
||||
** Package Context
|
||||
#+begin_src lisp :tangle ../src/core.lisp
|
||||
(in-package :org-agent)
|
||||
#+end_src
|
||||
|
||||
** Global Kernel State
|
||||
The kernel maintains several thread-safe global variables for logging, telemetry, and execution control.
|
||||
|
||||
#+begin_src lisp :tangle ../src/core.lisp
|
||||
(defvar *system-logs* nil)
|
||||
(defvar *logs-lock* (bt:make-lock "kernel-logs-lock"))
|
||||
(defvar *max-log-history* 100)
|
||||
(defvar *interrupt-flag* nil)
|
||||
(defvar *interrupt-lock* (bt:make-lock "kernel-interrupt-lock"))
|
||||
(defvar *skill-telemetry* (make-hash-table :test 'equal))
|
||||
(defvar *telemetry-lock* (bt:make-lock "kernel-telemetry-lock"))
|
||||
#+end_src
|
||||
|
||||
** Performance Tracking (kernel-track-telemetry)
|
||||
Updates performance metrics for a specific skill, tracking execution counts, total duration, and failure rates.
|
||||
|
||||
#+begin_src lisp :tangle ../src/core.lisp
|
||||
(defun kernel-track-telemetry (skill-name duration status)
|
||||
"Updates performance metrics for a specific skill."
|
||||
(when skill-name (bt:with-lock-held (*telemetry-lock*)
|
||||
(let ((entry (or (gethash skill-name *skill-telemetry*) (list :executions 0 :total-time 0 :failures 0))))
|
||||
(incf (getf entry :executions)) (incf (getf entry :total-time) duration)
|
||||
(when (eq status :rejected) (incf (getf entry :failures))) (setf (gethash skill-name *skill-telemetry*) entry)))))
|
||||
#+end_src
|
||||
|
||||
** System Logging (kernel-log)
|
||||
A centralized logging function that outputs to standard output and maintains a rolling in-memory buffer for context-aware reasoning.
|
||||
|
||||
#+begin_src lisp :tangle ../src/core.lisp
|
||||
(defun kernel-log (fmt &rest args)
|
||||
"Records a formatted message to the system log and standard output."
|
||||
(let ((msg (apply #'format nil fmt args)))
|
||||
(bt:with-lock-held (*logs-lock*) (push msg *system-logs*) (when (> (length *system-logs*) *max-log-history*) (setf *system-logs* (subseq *system-logs* 0 *max-log-history*))))
|
||||
(format t "~a~%" msg) (finish-output)))
|
||||
#+end_src
|
||||
|
||||
** Actuator Registration
|
||||
Actuators are the "hands" of the agent. This registry allows external modules (like Emacs or the Shell) to register functions that the kernel can invoke to perform physical actions.
|
||||
|
||||
#+begin_src lisp :tangle ../src/core.lisp
|
||||
(defvar *heartbeat-thread* nil)
|
||||
(defvar *actuator-registry* (make-hash-table :test 'equal))
|
||||
|
||||
(defun register-actuator (name fn)
|
||||
"Registers an actuator function. Actuators receive two arguments: (ACTION CONTEXT)."
|
||||
(setf (gethash name *actuator-registry*) fn))
|
||||
#+end_src
|
||||
|
||||
** Stimulus Injection (inject-stimulus)
|
||||
This is the entry point for all events into the kernel. It decides whether to handle an event synchronously or spawn a new background thread based on the stimulus type (e.g., chat messages and user commands are always asynchronous).
|
||||
|
||||
#+begin_src lisp :tangle ../src/core.lisp
|
||||
(defun inject-stimulus (raw-message &key stream (depth 0))
|
||||
"Enqueues a raw message into the cognitive loop, handling async/sync execution and recovery."
|
||||
(let* ((payload (getf raw-message :payload))
|
||||
(sensor (getf payload :sensor))
|
||||
;; Force Chat and Delegation to be async
|
||||
(async-p (or (getf payload :async-p) (member sensor '(:chat-message :delegation :user-command)))))
|
||||
(when stream (setf (getf raw-message :reply-stream) stream))
|
||||
(if async-p (bt:make-thread (lambda () (restart-case (handler-bind ((error (lambda (c) (kernel-log "ASYNC ERROR: ~a" c) (invoke-restart 'skip-event))))
|
||||
(cognitive-loop raw-message depth)) (skip-event () nil))) :name "org-agent-async-task")
|
||||
(restart-case (handler-bind ((error (lambda (c) (kernel-log "SYSTEM ERROR: ~a" c) (invoke-restart 'skip-event)))) (cognitive-loop raw-message depth))
|
||||
(skip-event () (kernel-log "SYSTEM RECOVERY: Stimulus dropped.~%"))))))
|
||||
#+end_src
|
||||
|
||||
** Internal Tool Execution
|
||||
The `execute-system-action` function handles kernel-level operations such as hot-loading skills, evaluating raw Lisp, or setting environment variables.
|
||||
|
||||
#+begin_src lisp :tangle ../src/core.lisp
|
||||
(defun execute-system-action (action context)
|
||||
"Processes internal kernel commands like skill creation or environment updates."
|
||||
(declare (ignore context))
|
||||
(let* ((payload (ignore-errors (getf action :payload))) (cmd (ignore-errors (getf payload :action))))
|
||||
(case cmd
|
||||
(:eval (let ((code (getf payload :code)))
|
||||
(kernel-log "ACTUATOR [System] - Evaluating: ~a" code)
|
||||
(handler-case (let ((result (eval (read-from-string code))))
|
||||
(kernel-log "ACTUATOR [System] - Result: ~s" result)
|
||||
result)
|
||||
(error (c) (kernel-log "ACTUATOR ERROR [System] - Eval failed: ~a" c)))))
|
||||
(:create-skill (let* ((filename (getf payload :filename)) (content (getf payload :content))
|
||||
(skills-dir (merge-pathnames "skills/" (asdf:system-source-directory :org-agent))) (full-path (merge-pathnames filename skills-dir)))
|
||||
(kernel-log "ACTUATOR [System] - Creating skill ~a..." filename)
|
||||
(with-open-file (out full-path :direction :output :if-exists :supersede) (write-string content out))
|
||||
(load-skill-from-org full-path)))
|
||||
(:set-cascade (setf *provider-cascade* (getf payload :cascade)))
|
||||
(:message (kernel-log "ACTUATOR [System] - ~a" (getf payload :text)))
|
||||
(t (kernel-log "ACTUATOR [System] - Unknown command ~s" cmd)))))
|
||||
#+end_src
|
||||
|
||||
** The OODA Cycle (cognitive-loop)
|
||||
The heart of the system. It recursively executes the OODA cycle:
|
||||
1. **Perceive:** Process incoming sensors and update memory.
|
||||
2. **Think:** Consult System 1 (LLM) for a proposed action.
|
||||
3. **Decide:** System 2 (Lisp) validates the proposal.
|
||||
4. **Act:** Dispatch the validated action to an actuator.
|
||||
|
||||
If a tool fails, the error is fed back into the loop as a new stimulus, allowing for autonomous self-correction.
|
||||
|
||||
#+begin_src lisp :tangle ../src/core.lisp
|
||||
(defun cognitive-loop (raw-message &optional (depth 0))
|
||||
"The main recursive OODA cycle: Perceive, Think, Decide, Act."
|
||||
(when (> depth 10)
|
||||
(kernel-log "SYSTEM ERROR: Maximum cognitive depth reached.")
|
||||
(return-from cognitive-loop nil))
|
||||
(when (bt:with-lock-held (*interrupt-lock*) *interrupt-flag*)
|
||||
(kernel-log "SYSTEM: Loop interrupted.")
|
||||
(bt:with-lock-held (*interrupt-lock*) (setf *interrupt-flag* nil))
|
||||
(return-from cognitive-loop nil))
|
||||
|
||||
(handler-case
|
||||
(let* ((start-time (get-internal-real-time))
|
||||
(type (getf raw-message :type))
|
||||
(perceive-fn (find-symbol "PERCEIVE" :org-agent))
|
||||
(context (if perceive-fn (funcall perceive-fn raw-message) raw-message)))
|
||||
(snapshot-object-store)
|
||||
(if (eq type :REQUEST)
|
||||
(dispatch-action raw-message context)
|
||||
(let* ((skill (find-triggered-skill context))
|
||||
(skill-name (when skill (skill-name skill)))
|
||||
(proposed-action (think context))
|
||||
(approved-action (decide proposed-action context))
|
||||
(status (if (and proposed-action (null approved-action)) :rejected :success))
|
||||
(duration (- (get-internal-real-time) start-time)))
|
||||
(when skill-name (kernel-track-telemetry skill-name duration status))
|
||||
|
||||
(let* ((payload (getf approved-action :payload))
|
||||
(target (getf approved-action :target))
|
||||
(action (or (getf payload :action) (getf approved-action :action)))
|
||||
(tool-name (or (getf payload :tool) (getf approved-action :tool)))
|
||||
(tool-args (or (getf payload :args) (getf approved-action :args))))
|
||||
(if (and approved-action (eq target :tool) (eq action :call))
|
||||
;; Internal Tool Execution
|
||||
(let* ((tool (gethash (string-downcase (string tool-name)) *cognitive-tools*)))
|
||||
(if tool
|
||||
(progn
|
||||
(kernel-log "SYSTEM 2: Executing tool '~a'..." tool-name)
|
||||
(handler-case
|
||||
(let* ((clean-args (if (and (listp tool-args) (listp (car tool-args))) (car tool-args) tool-args))
|
||||
(tool-result (funcall (cognitive-tool-body tool) clean-args))
|
||||
(next-stimulus `(:type :EVENT :payload (:sensor :tool-output :result ,tool-result :tool ,tool-name))))
|
||||
(when (getf raw-message :reply-stream) (setf (getf next-stimulus :reply-stream) (getf raw-message :reply-stream)))
|
||||
(cognitive-loop next-stimulus (1+ depth)))
|
||||
(error (c)
|
||||
(kernel-log "SYSTEM ERROR: Tool '~a' failed: ~a" tool-name c)
|
||||
(let ((err-stimulus `(:type :EVENT :payload (:sensor :tool-error :tool ,tool-name :message ,(format nil "~a" c)))))
|
||||
(when (getf raw-message :reply-stream) (setf (getf err-stimulus :reply-stream) (getf raw-message :reply-stream)))
|
||||
(cognitive-loop err-stimulus (1+ depth))))))
|
||||
(progn
|
||||
(kernel-log "SYSTEM ERROR: Tool '~a' not found in registry." tool-name)
|
||||
(let ((err-stimulus `(:type :EVENT :payload (:sensor :tool-error :message "Tool not found"))))
|
||||
(when (getf raw-message :reply-stream) (setf (getf err-stimulus :reply-stream) (getf raw-message :reply-stream)))
|
||||
(cognitive-loop err-stimulus (1+ depth))))))
|
||||
|
||||
;; Physical Actuation (Emacs, Shell, etc.)
|
||||
(let ((result (dispatch-action approved-action context)))
|
||||
(when (and result (not (member target '(:emacs :system-message))))
|
||||
(let ((fallback-stimulus `(:type :EVENT :payload (:sensor :tool-output :result ,result :tool ,approved-action))))
|
||||
(when (getf raw-message :reply-stream) (setf (getf fallback-stimulus :reply-stream) (getf raw-message :reply-stream)))
|
||||
(cognitive-loop fallback-stimulus (1+ depth))))))))))
|
||||
(error (c)
|
||||
(kernel-log "LOOP CRASH - Error in recursive turn: ~a~%" c)
|
||||
;; IMMUNE SYSTEM: Inject loop failure as a new stimulus if not too deep
|
||||
(let ((sensor (ignore-errors (getf (getf raw-message :payload) :sensor))))
|
||||
(unless (or (> depth 2) (member sensor '(:loop-error :tool-error)))
|
||||
(inject-stimulus `(:type :EVENT :payload (:sensor :loop-error :message ,(format nil "~a" c) :depth ,depth))
|
||||
:stream (getf raw-message :reply-stream)
|
||||
:depth (1+ depth))))
|
||||
nil)))
|
||||
#+end_src
|
||||
|
||||
** Perception (perceive)
|
||||
Handles the low-level processing of stimuli, such as updating the Object Store when a buffer is saved in Emacs.
|
||||
|
||||
#+begin_src lisp :tangle ../src/core.lisp
|
||||
(defun perceive (raw-message)
|
||||
"Initial processing of raw stimuli, updating the Object Store if needed."
|
||||
(handler-case
|
||||
(let ((type (getf raw-message :type)) (payload (getf raw-message :payload)))
|
||||
(kernel-log "PERCEIVE: ~a (~a)" type (or (getf payload :sensor) "no-sensor"))
|
||||
(cond ((eq type :EVENT) (let ((sensor (getf payload :sensor)))
|
||||
(case sensor
|
||||
(:buffer-update (let ((ast (getf payload :ast))) (when ast (ingest-ast ast))))
|
||||
(:point-update (let ((element (getf payload :element))) (when element (ingest-ast element))))
|
||||
(:interrupt (bt:with-lock-held (*interrupt-lock*) (setf *interrupt-flag* t))))))
|
||||
((eq type :RESPONSE)
|
||||
(kernel-log "ACT RESULT: ~a~%PAYLOAD: ~s~%" (getf payload :status) payload)))
|
||||
raw-message)
|
||||
(error (c)
|
||||
(kernel-log "PERCEIVE ERROR: Malformed stimulus received: ~a" c)
|
||||
nil)))
|
||||
#+end_src
|
||||
|
||||
** Heartbeat Mechanism
|
||||
Periodically injects a "pulse" into the system to trigger temporal skills (like cron jobs or reminders).
|
||||
|
||||
#+begin_src lisp :tangle ../src/core.lisp
|
||||
(defun start-heartbeat (&optional (interval 60))
|
||||
"Spawns a thread that periodically injects a heartbeat stimulus."
|
||||
(setf *heartbeat-thread* (bt:make-thread (lambda () (loop (sleep interval) (kernel-log "KERNEL: Heartbeat pulse...")
|
||||
(inject-stimulus `(:type :EVENT :payload (:sensor :heartbeat :unix-time ,(get-universal-time)))))) :name "org-agent-heartbeat")))
|
||||
|
||||
(defun stop-heartbeat ()
|
||||
"Gracefully terminates the heartbeat pulse thread."
|
||||
(when (and *heartbeat-thread* (bt:thread-alive-p *heartbeat-thread*))
|
||||
(bt:destroy-thread *heartbeat-thread*)
|
||||
(setf *heartbeat-thread* nil)))
|
||||
#+end_src
|
||||
|
||||
** Boot Sequence (load-all-skills)
|
||||
Scans the skills directory and loads skills according to their topological dependency order.
|
||||
|
||||
#+begin_src lisp :tangle ../src/core.lisp
|
||||
(defun load-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)))
|
||||
(if (and skills-dir (uiop:directory-exists-p skills-dir))
|
||||
(let ((sorted-files (topological-sort-skills skills-dir)))
|
||||
;; GATEWAY ENFORCEMENT: Kernel cannot function without the Executive Soul
|
||||
(unless (member "org-skill-agent" sorted-files :key #'pathname-name :test #'string-equal)
|
||||
(error "GATEWAY FAILURE: org-skill-agent.org not found in skills directory."))
|
||||
(dolist (file sorted-files)
|
||||
(kernel-log "KERNEL: Loading skill ~a..." (pathname-name file))
|
||||
(load-skill-with-timeout file 5)))
|
||||
(kernel-log "KERNEL ERROR: Skills directory not found: ~a" skills-dir-str))))
|
||||
#+end_src
|
||||
|
||||
** The Daemon Lifecycle
|
||||
Manages the TCP server that listens for OACP connections.
|
||||
|
||||
#+begin_src lisp :tangle ../src/core.lisp
|
||||
(defvar *daemon-thread* nil) (defvar *daemon-socket* nil)
|
||||
(defvar *emacs-clients* nil)
|
||||
(defvar *clients-lock* (bt:make-lock "emacs-clients-lock"))
|
||||
|
||||
(defun register-emacs-client (stream)
|
||||
"Tracks an active Emacs socket connection."
|
||||
(bt:with-lock-held (*clients-lock*)
|
||||
(pushnew stream *emacs-clients*)))
|
||||
|
||||
(defun unregister-emacs-client (stream)
|
||||
"Removes a disconnected Emacs socket from the registry."
|
||||
(bt:with-lock-held (*clients-lock*)
|
||||
(setf *emacs-clients* (remove stream *emacs-clients*))))
|
||||
|
||||
(defun handle-client (stream)
|
||||
"Main loop for a single OACP client connection."
|
||||
(kernel-log "DAEMON: New client connected.~%")
|
||||
(register-emacs-client stream)
|
||||
(unwind-protect
|
||||
(loop
|
||||
(handler-case
|
||||
(progn
|
||||
(loop for char = (peek-char nil stream nil :eof)
|
||||
while (and (not (eq char :eof)) (member char '(#\Space #\Newline #\Return #\Tab)))
|
||||
do (read-char stream))
|
||||
(let ((peek (peek-char nil stream nil :eof)))
|
||||
(if (eq peek :eof) (return))
|
||||
(let* ((len-prefix (make-string 6)))
|
||||
(unless (read-sequence len-prefix stream) (return))
|
||||
(let* ((len (parse-integer len-prefix :radix 16))
|
||||
(msg-payload (make-string len)))
|
||||
(unless (read-sequence msg-payload stream) (return))
|
||||
(let ((msg (read-from-string msg-payload)))
|
||||
(kernel-log "DAEMON: Received stimulus (~a characters)~%" len)
|
||||
(inject-stimulus msg :stream stream))))))
|
||||
(error (c) (kernel-log "DAEMON CLIENT ERROR: ~a~%" c) (return))))
|
||||
(kernel-log "DAEMON: Client disconnected.~%")
|
||||
(unregister-emacs-client stream)
|
||||
(ignore-errors (close stream))))
|
||||
|
||||
(defun start-daemon (&key port interval)
|
||||
(let* ((env-host (uiop:getenv "DAEMON_HOST")) (env-port (uiop:getenv "ORG_AGENT_DAEMON_PORT"))
|
||||
(listen-host (if env-host (string-trim " \"'" env-host) "127.0.0.1"))
|
||||
(listen-port (or (or port (when env-port (ignore-errors (parse-integer (string-trim " \"'" env-port) :junk-allowed t)))) 9105)))
|
||||
(register-actuator :system #'execute-system-action)
|
||||
(register-actuator :emacs (lambda (action context)
|
||||
(declare (ignore context))
|
||||
(kernel-log "ACTUATOR [Emacs] - Action: ~a~%" action)))
|
||||
(start-heartbeat (or interval 60))
|
||||
(kernel-log "DAEMON: Binding to ~a:~a..." listen-host listen-port)
|
||||
(setf *daemon-socket* (usocket:socket-listen listen-host listen-port :reuse-address t))
|
||||
(setf *daemon-thread* (bt:make-thread (lambda () (unwind-protect (loop (handler-case (let ((client-socket (usocket:socket-accept *daemon-socket*)))
|
||||
(bt:make-thread (lambda () (handle-client (usocket:socket-stream client-socket))) :name "org-agent-client-handler"))
|
||||
(error (c) (kernel-log "DAEMON ERROR: ~a" c) (sleep 0.1))))
|
||||
(usocket:socket-close *daemon-socket*))) :name "org-agent-tcp-listener"))
|
||||
(kernel-log "==================================================~% org-agent Kernel Booted Successfully.~% Daemon Listening: ~a:~a~%==================================================" listen-host listen-port)
|
||||
(load-all-skills)))
|
||||
|
||||
(defun stop-daemon () (stop-heartbeat) (when *daemon-socket* (usocket:socket-close *daemon-socket*) (setf *daemon-socket* nil)) (kernel-log "org-agent Kernel stopped.~%"))
|
||||
#+end_src
|
||||
|
||||
** Main Entry Point
|
||||
The execution entry point for the kernel binary.
|
||||
|
||||
#+begin_src lisp :tangle ../src/core.lisp
|
||||
(defun main ()
|
||||
"The entry point for the compiled standalone binary."
|
||||
(let* ((home (uiop:getenv "HOME"))
|
||||
(env-file (uiop:merge-pathnames* ".local/share/org-agent/.env" (uiop:ensure-directory-pathname home))))
|
||||
(if (uiop:file-exists-p env-file)
|
||||
(progn
|
||||
(format t "KERNEL: Loading environment from ~a~%" env-file)
|
||||
(cl-dotenv:load-env env-file))
|
||||
(format t "KERNEL ERROR: .env not found at ~a~%" env-file)))
|
||||
(let ((interval (or (ignore-errors (parse-integer (uiop:getenv "HEARTBEAT_INTERVAL") :junk-allowed t)) 60)))
|
||||
(format t "KERNEL: Heartbeat interval set to ~a seconds.~%" interval)
|
||||
(start-daemon :interval interval))
|
||||
(loop (sleep 3600)))
|
||||
#+end_src
|
||||
22
literate/evolution.org
Normal file
22
literate/evolution.org
Normal file
@@ -0,0 +1,22 @@
|
||||
#+TITLE: [EVOLUTION] Component VII: The Reactive Signal Pipeline
|
||||
#+AUTHOR: Amr
|
||||
#+FILETAGS: :kernel:evolution:
|
||||
#+STARTUP: content
|
||||
|
||||
* [EVOLUTION] Component VII: The Reactive Signal Pipeline
|
||||
** Deep Reasoning: Beyond the recursive loop
|
||||
The current `cognitive-loop` is a recursive process that handles sensors and tools as distinct code paths. While functional, it is difficult to parallelize and observe.
|
||||
- **The Circuit Board Model:** We are evolving the kernel into a functional transformation pipeline. Every event—be it a keystroke, a timer pulse, or a neural proposal—is a **Signal**.
|
||||
- **Consensus Gates:** By treating reasoning as a signal moving through a pipe, we can "split" the pipe to ask multiple LLMs simultaneously. A **Consensus Gate** later in the pipe compares the proposals and selects the most mathematically consistent one.
|
||||
- **Multi-Modal Fusion:** The pipeline can blend disparate signals (e.g. *User Prompt* + *Low Battery Alert*) into a single coherent cognitive event.
|
||||
|
||||
** The Signal Architecture
|
||||
#+begin_src mermaid
|
||||
graph LR
|
||||
S1[Signal: User Message] --> P[Perceive Gate]
|
||||
S2[Signal: Heartbeat] --> P
|
||||
P --> N[Neuro Gate: Multi-Backend]
|
||||
N --> C[Consensus Gate]
|
||||
C --> V[Validation Gate: System 2]
|
||||
V --> D[Dispatch Gate: Actuators]
|
||||
#+end_src
|
||||
222
literate/neurosymbolic.org
Normal file
222
literate/neurosymbolic.org
Normal file
@@ -0,0 +1,222 @@
|
||||
#+TITLE: The Neurosymbolic Bridge (neuro.lisp & symbolic.lisp)
|
||||
#+AUTHOR: Amr
|
||||
#+FILETAGS: :kernel:neuro:symbolic:
|
||||
#+STARTUP: content
|
||||
|
||||
* The Neurosymbolic Bridge (neuro.lisp & symbolic.lisp)
|
||||
** Deep Reasoning: Imagination Checked by Physics
|
||||
System 1 (LLM) is creative but hallucination-prone. System 2 (Lisp) is rigid but 100% accurate.
|
||||
- **The Safety Gate:** We never allow the LLM to talk to the actuators directly. It must propose a Lisp form. System 2 intercepts this form and validates it against mathematical rules and PSF invariants.
|
||||
- **Sovereign Decoupling:** By moving the physical API logic into skills, the core remains a neutral "Thinking Engine" that doesn't care if the imagination comes from Google, Anthropic, or a local Llama instance.
|
||||
|
||||
* Neural Engine (neuro.lisp)
|
||||
This module handles the interaction with Large Language Models, providing a unified interface for multiple backends.
|
||||
|
||||
** Package Context
|
||||
#+begin_src lisp :tangle ../src/neuro.lisp
|
||||
(in-package :org-agent)
|
||||
#+end_src
|
||||
|
||||
** Environment Access
|
||||
#+begin_src lisp :tangle ../src/neuro.lisp
|
||||
(defun get-env (var &optional default) (or (uiop:getenv var) default))
|
||||
#+end_src
|
||||
|
||||
** Authentication Registry
|
||||
Tracks API keys and authentication functions for various providers.
|
||||
|
||||
#+begin_src lisp :tangle ../src/neuro.lisp
|
||||
(defvar *auth-providers* (make-hash-table :test 'equal))
|
||||
|
||||
(defun register-auth-provider (name fn) (setf (gethash name *auth-providers*) fn))
|
||||
|
||||
(defun get-provider-auth (provider)
|
||||
"Retrieves authentication credentials for a provider."
|
||||
(let ((auth (gethash provider *auth-providers*)))
|
||||
(cond
|
||||
((functionp auth) (funcall auth))
|
||||
((listp auth) auth)
|
||||
(t
|
||||
(let ((specific-key (case provider
|
||||
(:gemini (uiop:getenv "GEMINI_API_KEY"))
|
||||
(:openrouter (uiop:getenv "OPENROUTER_API_KEY"))
|
||||
(:anthropic (uiop:getenv "ANTHROPIC_API_KEY"))
|
||||
(:openai (uiop:getenv "OPENAI_API_KEY"))
|
||||
(t nil))))
|
||||
(if (and specific-key (> (length specific-key) 0))
|
||||
(list :api-key specific-key)
|
||||
(let ((legacy (uiop:getenv "LLM_API_KEY")))
|
||||
(when (and legacy (> (length legacy) 0))
|
||||
(list :api-key legacy)))))))))
|
||||
#+end_src
|
||||
|
||||
** Backend Registry and Cascade
|
||||
The kernel supports a "cascade" of providers. If the primary provider (e.g. OpenRouter) fails, it automatically falls back to the secondary (e.g. Gemini).
|
||||
|
||||
#+begin_src lisp :tangle ../src/neuro.lisp
|
||||
(defvar *neuro-backends* (make-hash-table :test 'equal))
|
||||
(defvar *provider-cascade* '(:openrouter :gemini))
|
||||
|
||||
(defun register-neuro-backend (name fn) (setf (gethash name *neuro-backends*) fn))
|
||||
|
||||
(defvar *model-selector-fn* nil "A function called with (provider context) to return a model ID.")
|
||||
#+end_src
|
||||
|
||||
** Neural Dispatch (ask-neuro)
|
||||
The primary entry point for System 1. It handles the retry logic and backend selection.
|
||||
|
||||
#+begin_src lisp :tangle ../src/neuro.lisp
|
||||
(defun ask-neuro (prompt &key (system-prompt "You are the System 1 engine of a Neurosymbolic Lisp Machine.") (cascade nil) (context nil))
|
||||
"Dispatches a neural request through the provider cascade."
|
||||
(let ((backends (cond
|
||||
((and cascade (listp cascade)) cascade)
|
||||
((functionp cascade) (funcall cascade context))
|
||||
(t *provider-cascade*))))
|
||||
(dolist (backend backends)
|
||||
(let ((backend-fn (gethash backend *neuro-backends*)))
|
||||
(when backend-fn
|
||||
(kernel-log "SYSTEM 1: Attempting backend ~a..." backend)
|
||||
(let* ((model (when *model-selector-fn* (funcall *model-selector-fn* backend context)))
|
||||
(result (if model
|
||||
(funcall backend-fn prompt system-prompt :model model)
|
||||
(funcall backend-fn prompt system-prompt))))
|
||||
(if (and (stringp result) (search ":LOG" result) (or (search "Failure" result) (search "missing" result)))
|
||||
(kernel-log "SYSTEM 1: Backend ~a failed. Falling back..." backend)
|
||||
(return-from ask-neuro result))))))
|
||||
"(:type :LOG :payload (:text \"Neural Cascade Failure\"))"))
|
||||
#+end_src
|
||||
|
||||
** Sovereign Service Fallbacks
|
||||
Standard functions that can be overridden by specific skills to provide enhanced functionality.
|
||||
|
||||
#+begin_src lisp :tangle ../src/neuro.lisp
|
||||
(defun token-accountant-route-task (context)
|
||||
"Generic fallback for routing. Overridden by skill-token-accountant."
|
||||
(declare (ignore context))
|
||||
'(:openrouter :gemini))
|
||||
|
||||
(defun org-id-new ()
|
||||
"Generic fallback for ID generation. Overridden by skill-ast-normalization."
|
||||
(format nil "node-~a" (get-universal-time)))
|
||||
|
||||
(defun get-org-timestamp ()
|
||||
"Returns a current Org-mode active timestamp."
|
||||
(multiple-value-bind (sec min hour day month year day-of-week) (decode-universal-time (get-universal-time))
|
||||
(declare (ignore sec))
|
||||
(let ((day-names '("Mon" "Tue" "Wed" "Thu" "Fri" "Sat" "Sun")))
|
||||
(format nil "[~4,'0d-~2,'0d-~2,'0d ~a ~2,'0d:~2,'0d]"
|
||||
year month day (nth day-of-week day-names) hour min))))
|
||||
#+end_src
|
||||
|
||||
** Neural Reasoning (think)
|
||||
Invokes the System 1 engine to generate a proposed Lisp action. It automatically injects the tool documentation and global context into the prompt.
|
||||
|
||||
#+begin_src lisp :tangle ../src/neuro.lisp
|
||||
(defun think (context)
|
||||
"Invokes the neural System 1 engine to propose a Lisp action based on context."
|
||||
(let ((active-skill (find-triggered-skill context))
|
||||
(tool-belt (generate-tool-belt-prompt))
|
||||
(global-context (context-assemble-global-awareness)))
|
||||
(if active-skill
|
||||
(progn
|
||||
(kernel-log "SYSTEM 1: Engaging skill '~a'~%" (skill-name active-skill))
|
||||
(let* ((prompt-generator (skill-neuro-prompt active-skill))
|
||||
(raw-prompt (when prompt-generator (funcall prompt-generator context)))
|
||||
(full-system-prompt (concatenate 'string
|
||||
"ACTUATOR IDENTITY: You are the pure Lisp actuator for the org-agent kernel.
|
||||
MANDATE: Output EXACTLY ONE Common Lisp property list starting with (:type :REQUEST).
|
||||
ZERO CONVERSATION: Do not explain. Do not say 'Okay'. Do not use markdown blocks.
|
||||
STRICT RULE: Do not output multiple lists. Do not chain multiple requests.
|
||||
DO NOT embed tool calls inside text strings.
|
||||
|
||||
"
|
||||
global-context
|
||||
"
|
||||
"
|
||||
tool-belt
|
||||
"
|
||||
IMPORTANT: To reply to the user, you MUST use:
|
||||
(:type :REQUEST :target :emacs :action :insert-at-end :buffer \"*org-agent-chat*\" :text \"* <Response Text>\")
|
||||
|
||||
To call a tool, you MUST use:
|
||||
(:type :REQUEST :target :tool :action :call :tool \"<name>\" :args (:arg1 \"val\"))
|
||||
|
||||
")))
|
||||
(if (and raw-prompt (> (length raw-prompt) 1))
|
||||
(let* ((thought (ask-neuro raw-prompt :system-prompt full-system-prompt :context context)))
|
||||
(kernel-log "SYSTEM 1 RAW: ~a~%" thought)
|
||||
(let* ((cleaned-thought
|
||||
(let ((match (cl-ppcre:scan-to-strings "(?s)```(?:lisp)?\\n?(.*?)\\n?```" thought)))
|
||||
(if match
|
||||
(let ((regs (nth-value 1 (cl-ppcre:scan-to-strings "(?s)```(?:lisp)?\\n?(.*?)\\n?```" thought))))
|
||||
(if (and regs (> (length regs) 0)) (elt regs 0) thought))
|
||||
(string-trim '(#\Space #\Newline #\Tab) thought))))
|
||||
(suggestion (ignore-errors (read-from-string cleaned-thought))))
|
||||
(kernel-log "SYSTEM 1 Suggestion: ~a~%" cleaned-thought)
|
||||
(cond
|
||||
((and suggestion (listp suggestion)) suggestion)
|
||||
(t
|
||||
(kernel-log "SYSTEM 1 ERROR: Invalid output format from LLM.~%")
|
||||
nil))))
|
||||
'(:type :LOG :payload (:text "Skill triggered (Deterministic only)")))))
|
||||
nil)))
|
||||
#+end_src
|
||||
|
||||
** Prompt Meta-Cognition (distill-prompt)
|
||||
Allows the agent to self-optimize its own prompts.
|
||||
|
||||
#+begin_src lisp :tangle ../src/neuro.lisp
|
||||
(defun distill-prompt (full-prompt successful-output)
|
||||
(let ((system-instr "You are a Meta-Cognitive Prompt Architect. DISTILL into template."))
|
||||
(ask-neuro (format nil "PROMPT: ~a~%RESULT: ~a" full-prompt successful-output) :system-prompt system-instr)))
|
||||
#+end_src
|
||||
|
||||
* Symbolic Logic (symbolic.lisp)
|
||||
The deterministic gatekeeper that ensures all proposed actions are safe and logically valid.
|
||||
|
||||
** Package Context
|
||||
#+begin_src lisp :tangle ../src/symbolic.lisp
|
||||
(in-package :org-agent)
|
||||
#+end_src
|
||||
|
||||
** Validation Gate (decide)
|
||||
The "System 2" supervisor. It intercepts every action proposed by System 1 and runs it through the skill's symbolic gate and the global safety harness.
|
||||
|
||||
#+begin_src lisp :tangle ../src/symbolic.lisp
|
||||
(defun decide (proposed-action context)
|
||||
"The System 2 Safety Gate: validates or rejects proposed neural actions."
|
||||
(let ((active-skill (find-triggered-skill context)))
|
||||
(if (and proposed-action (listp proposed-action) active-skill)
|
||||
(let* ((symbolic-gate (skill-symbolic-fn active-skill))
|
||||
(payload (getf proposed-action :payload))
|
||||
(action (or (getf payload :action) (getf proposed-action :action)))
|
||||
(code (or (getf payload :code) (getf proposed-action :code))))
|
||||
;; Global safety harness for EVAL
|
||||
(when (and (member (getf proposed-action :type) '(:request :REQUEST))
|
||||
(member action '(:eval :EVAL)))
|
||||
(let ((harness-pkg (find-package :org-agent.skills.org-skill-safety-harness)))
|
||||
(when (and code harness-pkg)
|
||||
(unless (ignore-errors (uiop:symbol-call :org-agent.skills.org-skill-safety-harness :safety-harness-validate code))
|
||||
(kernel-log "SYSTEM 2 [GLOBAL]: Security violation blocked.~%")
|
||||
(return-from decide '(:type :LOG :payload (:text "Blocked by Global Safety Harness")))))))
|
||||
;; Skill-specific verification
|
||||
(if symbolic-gate
|
||||
(let ((decision (funcall symbolic-gate proposed-action context)))
|
||||
(if decision
|
||||
(progn (kernel-log "SYSTEM 2: Verified by skill '~a'.~%" (skill-name active-skill)) decision)
|
||||
(progn (kernel-log "SYSTEM 2: REJECTED by skill '~a'.~%" (skill-name active-skill))
|
||||
'(:type :LOG :payload (:text "Action rejected by skill heuristics")))))
|
||||
(progn (kernel-log "SYSTEM 2: Verified (Implicitly safe for skill '~a').~%" (skill-name active-skill)) proposed-action)))
|
||||
proposed-action)))
|
||||
#+end_src
|
||||
|
||||
** Store Filtering (list-objects-with-attribute)
|
||||
A symbolic helper function to find nodes with specific attributes.
|
||||
|
||||
#+begin_src lisp :tangle ../src/symbolic.lisp
|
||||
(defun list-objects-with-attribute (attr-key attr-val)
|
||||
"Filters the Object Store for nodes having a specific attribute value."
|
||||
(let ((results nil))
|
||||
(maphash (lambda (id obj) (declare (ignore id)) (when (equal (getf (org-object-attributes obj) attr-key) attr-val) (push obj results))) *object-store*)
|
||||
results))
|
||||
#+end_src
|
||||
171
literate/object-store.org
Normal file
171
literate/object-store.org
Normal file
@@ -0,0 +1,171 @@
|
||||
#+TITLE: The Object Store (object-store.lisp)
|
||||
#+AUTHOR: Amr
|
||||
#+FILETAGS: :kernel:memory:
|
||||
#+STARTUP: content
|
||||
|
||||
* The Object Store (object-store.lisp)
|
||||
** Deep Reasoning: The Single Address Space Advantage
|
||||
Industry-standard "Vector Databases" or "SQLite Backends" add external complexity and I/O latency.
|
||||
- **Pointer-Based Reasoning:** By loading the entire Memex into a live Lisp hash table, we achieve microsecond recollection. The agent doesn't "search a file"; it traverses a memory pointer.
|
||||
- **Memory Imaging:** The `memory-image.lisp` snapshot allows the agent to wake up with its entire context already parsed. This solves the "Cold Start" problem of massive Org files.
|
||||
- **Merkle-Tree Integrity:** Every node in the Object Store is cryptographically hashed. By hashing the content and the hashes of its children, the root hash provides a single, immutable fingerprint of the entire Memex state.
|
||||
|
||||
** The Single Address Space (Architecture)
|
||||
#+begin_src mermaid
|
||||
graph TD
|
||||
subgraph LispMachine[Lisp Machine]
|
||||
K[Kernel Core] --> OS[(Object Store)]
|
||||
S1[Skill: Architect] --> OS
|
||||
S2[Skill: Analyst] --> OS
|
||||
S3[Skill: GTD] --> OS
|
||||
K -- Pointers --> S1
|
||||
K -- Pointers --> S2
|
||||
end
|
||||
subgraph IPCSlow[IPC Slow]
|
||||
E[Emacs / Actuators] -. OACP .-> K
|
||||
end
|
||||
#+end_src
|
||||
|
||||
** Package Context
|
||||
We begin by establishing the `org-agent` package context.
|
||||
|
||||
#+begin_src lisp :tangle ../src/object-store.lisp
|
||||
(in-package :org-agent)
|
||||
#+end_src
|
||||
|
||||
** The Object Repository
|
||||
The `*object-store*` is the global hash table that holds every Org element by its unique ID. This is the "live RAM" of the agent's memory.
|
||||
|
||||
#+begin_src lisp :tangle ../src/object-store.lisp
|
||||
(defvar *object-store* (make-hash-table :test 'equal))
|
||||
#+end_src
|
||||
|
||||
** The Data Structure (org-object)
|
||||
Every element in the Memex (headlines, paragraphs, etc.) is represented by an `org-object` structure. It contains both semantic metadata (attributes, content) and structural metadata (parent/child pointers, Merkle hashes).
|
||||
|
||||
#+begin_src lisp :tangle ../src/object-store.lisp
|
||||
(defstruct org-object
|
||||
id type attributes content vector parent-id children version last-sync hash)
|
||||
#+end_src
|
||||
|
||||
** Merkle Tree Integrity (compute-merkle-hash)
|
||||
The `compute-merkle-hash` function ensures the cryptographic integrity of the knowledge graph. A node's hash depends on its own properties and the hashes of all its children. This creates a recursive fingerprint where any change to a single note propagates up to the root hash.
|
||||
|
||||
#+begin_src lisp :tangle ../src/object-store.lisp
|
||||
(defun compute-merkle-hash (id type attributes content child-hashes)
|
||||
"Computes a SHA-256 Merkle hash for a node based on its core properties and children's hashes."
|
||||
(let* ((alist (loop for (k v) on attributes by #'cddr collect (cons k v)))
|
||||
(sorted-alist (sort alist #'string< :key (lambda (x) (format nil "~a" (car x)))))
|
||||
(attr-string (format nil "~s" sorted-alist))
|
||||
(children-string (format nil "~{~a~}" child-hashes))
|
||||
(data-string (format nil "ID:~a|TYPE:~s|ATTRS:~a|CONTENT:~a|CHILDREN:~a"
|
||||
id type attr-string (or content "") children-string))
|
||||
(digester (ironclad:make-digest :sha256)))
|
||||
(ironclad:update-digest digester (ironclad:ascii-string-to-byte-array data-string))
|
||||
(ironclad:byte-array-to-hex-string (ironclad:produce-digest digester))))
|
||||
#+end_src
|
||||
|
||||
** Ingesting the AST (ingest-ast)
|
||||
The `ingest-ast` function is the primary bridge between the external world (Emacs/JSON) and the internal Lisp machine. It recursively parses an Org-mode Abstract Syntax Tree (AST) into `org-object` structures and registers them in the store.
|
||||
|
||||
#+begin_src lisp :tangle ../src/object-store.lisp
|
||||
(defun ingest-ast (ast &optional parent-id)
|
||||
"Parses an Org AST into the recursive Lisp Object Store 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))
|
||||
(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)))
|
||||
(setf (gethash id *object-store*) obj)
|
||||
id)))
|
||||
#+end_src
|
||||
|
||||
** Memory Snapshots (snapshot-object-store)
|
||||
The system maintains a rolling buffer of 20 snapshots. This allows for near-instant rollback if the agent makes a mistake or if the user wants to revert the Memex state.
|
||||
|
||||
#+begin_src lisp :tangle ../src/object-store.lisp
|
||||
(defvar *object-store-snapshots* nil)
|
||||
|
||||
(defun clone-org-object (obj)
|
||||
"Creates a deep copy of an org-object structure."
|
||||
(make-org-object
|
||||
:id (org-object-id obj) :type (org-object-type obj)
|
||||
:attributes (copy-list (org-object-attributes obj))
|
||||
:content (org-object-content obj) :vector (org-object-vector obj)
|
||||
:parent-id (org-object-parent-id obj) :children (copy-list (org-object-children obj))
|
||||
:version (org-object-version obj) :last-sync (org-object-last-sync obj)
|
||||
:hash (org-object-hash obj)))
|
||||
|
||||
(defun snapshot-object-store ()
|
||||
"Creates an immutable point-in-time image of the current knowledge graph."
|
||||
(let ((snapshot (make-hash-table :test 'equal)))
|
||||
(maphash (lambda (id obj) (setf (gethash id snapshot) (clone-org-object obj))) *object-store*)
|
||||
(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)))
|
||||
(kernel-log "MEMORY - Object Store snapshot created.")))
|
||||
#+end_src
|
||||
|
||||
** Memory Rollback (rollback-object-store)
|
||||
Restores the state of the Memex from one of the previous snapshots.
|
||||
|
||||
#+begin_src lisp :tangle ../src/object-store.lisp
|
||||
(defun rollback-object-store (&optional (index 0))
|
||||
"Restores the Object Store to a previously captured snapshot."
|
||||
(let ((snapshot (nth index *object-store-snapshots*)))
|
||||
(if snapshot
|
||||
(progn (setf *object-store* (getf snapshot :data))
|
||||
(kernel-log "MEMORY - Object Store rolled back to snapshot ~a" index))
|
||||
(kernel-log "MEMORY ERROR - Snapshot ~a not found." index))))
|
||||
#+end_src
|
||||
|
||||
** Lookup Utilities
|
||||
Basic functions for retrieving objects by ID or type.
|
||||
|
||||
#+begin_src lisp :tangle ../src/object-store.lisp
|
||||
(defun lookup-object (id)
|
||||
"Retrieves an object from the store by its unique ID."
|
||||
(gethash id *object-store*))
|
||||
|
||||
(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))) *object-store*)
|
||||
results))
|
||||
#+end_src
|
||||
|
||||
** Structural Helpers
|
||||
Utility functions for AST traversal and path resolution.
|
||||
|
||||
#+begin_src lisp :tangle ../src/object-store.lisp
|
||||
(defun find-headline-missing-id (ast)
|
||||
"Traverses an AST to find headlines that lack an :ID: property."
|
||||
(when (listp ast)
|
||||
(if (and (eq (getf ast :type) :HEADLINE) (not (getf (getf ast :properties) :ID)))
|
||||
ast
|
||||
(cl:some #'find-headline-missing-id (getf ast :contents)))))
|
||||
|
||||
(defun file-name-nondirectory (path)
|
||||
"Extracts the filename from a full path string."
|
||||
(let ((pos (position #\/ path :from-end t))) (if pos (subseq path (1+ pos)) path)))
|
||||
#+end_src
|
||||
122
literate/package.org
Normal file
122
literate/package.org
Normal file
@@ -0,0 +1,122 @@
|
||||
#+TITLE: System Interface (package.lisp)
|
||||
#+AUTHOR: Amr
|
||||
#+FILETAGS: :kernel:interface:
|
||||
#+STARTUP: content
|
||||
|
||||
* System Interface (package.lisp)
|
||||
The `package.lisp` file defines the public API of the `org-agent` kernel. It exports all necessary symbols for skills and actuators to interact with the core.
|
||||
|
||||
#+begin_src lisp :tangle ../src/package.lisp
|
||||
(defpackage :org-agent
|
||||
(:use :cl)
|
||||
(:export
|
||||
;; --- OACP Protocol ---
|
||||
#:frame-message
|
||||
#:parse-message
|
||||
#:make-hello-message
|
||||
|
||||
;; --- Daemon Lifecycle ---
|
||||
#:start-daemon
|
||||
#:stop-daemon
|
||||
#:kernel-log
|
||||
#:main
|
||||
|
||||
;; --- Object Store (CLOSOS) ---
|
||||
#:ingest-ast
|
||||
#:lookup-object
|
||||
#:list-objects-by-type
|
||||
#:*object-store*
|
||||
#:org-object
|
||||
#:org-object-id
|
||||
#:org-object-type
|
||||
#:org-object-attributes
|
||||
#:org-object-parent-id
|
||||
#:org-object-children
|
||||
#:org-object-version
|
||||
#:org-object-last-sync
|
||||
#:org-object-vector
|
||||
#:org-object-content
|
||||
#:org-object-hash
|
||||
#:snapshot-object-store
|
||||
#:rollback-object-store
|
||||
#:send-swarm-packet
|
||||
|
||||
;; --- Context API (Peripheral Vision) ---
|
||||
#:context-query-store
|
||||
#:context-get-active-projects
|
||||
#:context-get-recent-completed-tasks
|
||||
#:context-list-all-skills
|
||||
#:context-get-skill-source
|
||||
#:context-get-system-logs
|
||||
#:context-filter-sparse-tree
|
||||
#:context-resolve-path
|
||||
#:context-get-skill-telemetry
|
||||
#:context-assemble-global-awareness
|
||||
|
||||
;; --- Cognitive Loop & Event Bus ---
|
||||
#:perceive
|
||||
#:think
|
||||
#:decide
|
||||
#:act
|
||||
#:cognitive-loop
|
||||
#:inject-stimulus
|
||||
#:dispatch-action
|
||||
#:register-actuator
|
||||
#:spawn-task
|
||||
|
||||
;; --- Skill Engine ---
|
||||
#:load-skill-from-org
|
||||
#:load-skill-with-timeout
|
||||
#:topological-sort-skills
|
||||
#:validate-lisp-syntax
|
||||
#:find-triggered-skill
|
||||
#:defskill
|
||||
#:*skills-registry*
|
||||
#:skill
|
||||
#:skill-name
|
||||
#:skill-priority
|
||||
#:skill-trigger-fn
|
||||
#:skill-neuro-prompt
|
||||
#:skill-symbolic-fn
|
||||
|
||||
;; --- Tool Registry ---
|
||||
#:def-cognitive-tool
|
||||
#:*cognitive-tools*
|
||||
#:cognitive-tool
|
||||
#:cognitive-tool-name
|
||||
#:cognitive-tool-description
|
||||
#:cognitive-tool-parameters
|
||||
#:cognitive-tool-guard
|
||||
#:cognitive-tool-body
|
||||
|
||||
;; --- Emacs Client Registry ---
|
||||
#:*emacs-clients*
|
||||
#:*clients-lock*
|
||||
#:register-emacs-client
|
||||
#:unregister-emacs-client
|
||||
|
||||
;; --- Neuro (System 1) ---
|
||||
|
||||
#:ask-neuro
|
||||
#:register-neuro-backend
|
||||
#:register-auth-provider
|
||||
#:get-provider-auth
|
||||
#:distill-prompt
|
||||
#:get-embedding
|
||||
#:cosine-similarity
|
||||
#:find-most-similar
|
||||
#:openrouter-get-available-models
|
||||
#:*provider-cascade*
|
||||
#:token-accountant-route-task
|
||||
|
||||
;; --- Symbolic Logic ---
|
||||
#:list-objects-with-attribute
|
||||
#:org-id-new
|
||||
|
||||
;; --- AST Helpers ---
|
||||
#:find-headline-missing-id
|
||||
|
||||
;; --- Environment Config ---
|
||||
#:set-llm-model
|
||||
#:get-llm-model))
|
||||
#+end_src
|
||||
91
literate/protocol.org
Normal file
91
literate/protocol.org
Normal file
@@ -0,0 +1,91 @@
|
||||
#+TITLE: The Communication Protocol (protocol.lisp)
|
||||
#+AUTHOR: Amr
|
||||
#+FILETAGS: :kernel:protocol:
|
||||
#+STARTUP: content
|
||||
|
||||
* The Communication Protocol (protocol.lisp)
|
||||
** Deep Reasoning: Why Hex-Length Framing?
|
||||
Streaming raw JSON over a socket is fragile. If a 5MB Org AST is fragmented by the OS network stack, a standard parser will crash or desynchronize.
|
||||
- **Physical Boundary:** By prefixing every message with a 6-character hex length, we create a deterministic physical boundary.
|
||||
- **Actuator-Agnosticism:** This protocol makes the kernel a "Dumb Terminal" host. Any program (Bash, Python, WebSockets) that can calculate a length and send bytes can now become an agentic interface.
|
||||
|
||||
** Package Context
|
||||
We begin by ensuring we are in the correct package.
|
||||
|
||||
#+begin_src lisp :tangle ../src/protocol.lisp
|
||||
(in-package :org-agent)
|
||||
#+end_src
|
||||
|
||||
** Message Framing (frame-message)
|
||||
The `frame-message` function is responsible for preparing a string for transmission over the wire. It calculates the length and, if security is enabled via environment variables, appends an HMAC-SHA256 signature to guarantee message integrity.
|
||||
|
||||
#+begin_src lisp :tangle ../src/protocol.lisp
|
||||
(defun frame-message (msg-string)
|
||||
"Prefix MSG-STRING with a 6-character hex length (lowercase).
|
||||
FUTURE: Will also prefix a 64-char HMAC signature when OACP_ENFORCE_HMAC=true."
|
||||
(let ((len (length msg-string))
|
||||
(enforce-hmac (uiop:getenv "OACP_ENFORCE_HMAC")))
|
||||
(if (and enforce-hmac (string-equal enforce-hmac "true"))
|
||||
(let* ((secret (or (uiop:getenv "OACP_HMAC_SECRET") "default-insecure-secret"))
|
||||
(key (ironclad:ascii-string-to-byte-array secret))
|
||||
(hmac (ironclad:make-mac :hmac key :sha256))
|
||||
(payload-bytes (ironclad:ascii-string-to-byte-array msg-string)))
|
||||
(ironclad:update-mac hmac payload-bytes)
|
||||
(let ((signature (ironclad:byte-array-to-hex-string (ironclad:produce-mac hmac))))
|
||||
(format nil "~(~6,'0x~)~a~a" len signature msg-string)))
|
||||
(format nil "~(~6,'0x~)~a" len msg-string))))
|
||||
#+end_src
|
||||
|
||||
** Message Parsing (parse-message)
|
||||
Parsing is the inverse of framing. This function performs three critical safety checks:
|
||||
1. It validates the 6-character hex length prefix.
|
||||
2. It verifies the HMAC signature (if enabled) to prevent man-in-the-middle attacks.
|
||||
3. It binds `*read-eval*` to `nil` before calling `read-from-string`, preventing "Reader Macro Injection" which could otherwise execute arbitrary Lisp code during deserialization.
|
||||
|
||||
#+begin_src lisp :tangle ../src/protocol.lisp
|
||||
(defun parse-message (framed-string)
|
||||
"Extract and parse the S-expression from a framed string, securely preventing reader macro injection."
|
||||
(when (< (length framed-string) 6)
|
||||
(error "Framed string too short"))
|
||||
(let* ((enforce-hmac (uiop:getenv "OACP_ENFORCE_HMAC"))
|
||||
(use-hmac (and enforce-hmac (string-equal enforce-hmac "true")))
|
||||
(prefix-len (if use-hmac 70 6)))
|
||||
(when (< (length framed-string) prefix-len)
|
||||
(error "Framed string too short for OACP signature/length"))
|
||||
|
||||
(let* ((len-str (subseq framed-string 0 6))
|
||||
(signature (when use-hmac (subseq framed-string 6 70)))
|
||||
(actual-msg (subseq framed-string prefix-len))
|
||||
(expected-len (ignore-errors (parse-integer len-str :radix 16))))
|
||||
(unless expected-len
|
||||
(error "Invalid hex length prefix: ~a" len-str))
|
||||
(unless (= expected-len (length actual-msg))
|
||||
(error "Message length mismatch. Expected ~a, got ~a" expected-len (length actual-msg)))
|
||||
|
||||
;; HMAC Validation Foundation
|
||||
(when use-hmac
|
||||
(let* ((secret (or (uiop:getenv "OACP_HMAC_SECRET") "default-insecure-secret"))
|
||||
(key (ironclad:ascii-string-to-byte-array secret))
|
||||
(hmac (ironclad:make-mac :hmac key :sha256))
|
||||
(payload-bytes (ironclad:ascii-string-to-byte-array actual-msg)))
|
||||
(ironclad:update-mac hmac payload-bytes)
|
||||
(let ((expected-signature (ironclad:byte-array-to-hex-string (ironclad:produce-mac hmac))))
|
||||
(unless (string-equal signature expected-signature)
|
||||
(error "OACP Integrity Failure: HMAC signature mismatch")))))
|
||||
|
||||
;; SECURITY: Prevent Reader Macro Injection (e.g. #. ) during deserialization
|
||||
(let ((*read-eval* nil))
|
||||
(read-from-string actual-msg)))))
|
||||
#+end_src
|
||||
|
||||
** Handshaking (make-hello-message)
|
||||
Every OACP connection begins with a `HELLO` handshake. This function constructs the standard response that the kernel sends to a client to announce its capabilities and version.
|
||||
|
||||
#+begin_src lisp :tangle ../src/protocol.lisp
|
||||
(defun make-hello-message (version)
|
||||
"Construct the standard HELLO handshake message."
|
||||
(list :type :EVENT
|
||||
:payload (list :action :handshake
|
||||
:version version
|
||||
:capabilities '(:auth :swank :org-ast))))
|
||||
#+end_src
|
||||
281
literate/skills.org
Normal file
281
literate/skills.org
Normal file
@@ -0,0 +1,281 @@
|
||||
#+TITLE: The Skill Engine (skills.lisp)
|
||||
#+AUTHOR: Amr
|
||||
#+FILETAGS: :kernel:skills:
|
||||
#+STARTUP: content
|
||||
|
||||
* The Skill Engine (skills.lisp)
|
||||
** Deep Reasoning: Late-Binding Intelligence
|
||||
Hardcoding logic into a compiled binary creates a "Brittle Kernel."
|
||||
- **Institutional Memory:** By using Literate Org files as skills, the "Why" (PRD) and the "How" (Lisp) are unified.
|
||||
- **Hot-Reloading:** The agent can "learn" a new trick (recompile a package) while running. This allows for a continuous evolutionary loop where the agent can eventually rewrite its own skills to fix bugs it perceives.
|
||||
|
||||
** Package Context
|
||||
#+begin_src lisp :tangle ../src/skills.lisp
|
||||
(in-package :org-agent)
|
||||
#+end_src
|
||||
|
||||
** Skill Registry
|
||||
The central hub for all loaded capabilities.
|
||||
|
||||
#+begin_src lisp :tangle ../src/skills.lisp
|
||||
(defvar *skills-registry* (make-hash-table :test 'equal))
|
||||
|
||||
(defstruct skill name priority dependencies trigger-fn neuro-prompt symbolic-fn)
|
||||
#+end_src
|
||||
|
||||
** Cognitive Tool Registry
|
||||
Tools are discrete actions that System 1 (Neuro) can request. This registry tracks tool definitions, their parameters, and their safety guards.
|
||||
|
||||
#+begin_src lisp :tangle ../src/skills.lisp
|
||||
(defvar *cognitive-tools* (make-hash-table :test 'equal))
|
||||
|
||||
(defstruct cognitive-tool name description parameters guard body)
|
||||
|
||||
(defmacro def-cognitive-tool (name description &key parameters guard body)
|
||||
`(setf (gethash (string-downcase (string ,name)) *cognitive-tools*)
|
||||
(make-cognitive-tool :name (string-downcase (string ,name))
|
||||
:description ,description
|
||||
:parameters ',parameters
|
||||
:guard ,guard
|
||||
:body ,body)))
|
||||
#+end_src
|
||||
|
||||
** Toolbelt Prompt Generation (generate-tool-belt-prompt)
|
||||
Constructs the technical documentation of available tools that is injected into the LLM system prompt.
|
||||
|
||||
#+begin_src lisp :tangle ../src/skills.lisp
|
||||
(defun generate-tool-belt-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 \"sovereignty\"))
|
||||
(:target :tool :action :call :tool \"shell\" :args (:cmd \"ls -la\"))
|
||||
|
||||
---
|
||||
")))
|
||||
(maphash (lambda (name tool)
|
||||
(setf output (concatenate 'string output
|
||||
(format nil "- ~a: ~a~% Parameters: ~s~%~%"
|
||||
name
|
||||
(cognitive-tool-description tool)
|
||||
(cognitive-tool-parameters tool)))))
|
||||
*cognitive-tools*)
|
||||
output))
|
||||
#+end_src
|
||||
|
||||
** Defining Skills (defskill)
|
||||
The primary macro used within Org files to register new agent capabilities.
|
||||
|
||||
#+begin_src lisp :tangle ../src/skills.lisp
|
||||
(defmacro defskill (name &key priority dependencies trigger neuro symbolic)
|
||||
`(setf (gethash ,(string-downcase (string name)) *skills-registry*)
|
||||
(make-skill :name ,(string-downcase (string name)) :priority (or ,priority 10) :dependencies ,dependencies
|
||||
:trigger-fn ,trigger :neuro-prompt ,neuro :symbolic-fn ,symbolic)))
|
||||
#+end_src
|
||||
|
||||
** Skill Selection (find-triggered-skill)
|
||||
Iterates through the registry to find the highest-priority skill whose trigger function matches the current context.
|
||||
|
||||
#+begin_src lisp :tangle ../src/skills.lisp
|
||||
(defun find-triggered-skill (context)
|
||||
(let ((triggered nil))
|
||||
(maphash (lambda (name skill) (declare (ignore name)) (when (ignore-errors (funcall (skill-trigger-fn skill) context)) (push skill triggered))) *skills-registry*)
|
||||
(first (sort triggered #'> :key #'skill-priority))))
|
||||
#+end_src
|
||||
|
||||
** Dependency Resolution
|
||||
Ensures that skills are loaded and unloaded in the correct order.
|
||||
|
||||
#+begin_src lisp :tangle ../src/skills.lisp
|
||||
(defun resolve-skill-dependencies (skill-name)
|
||||
(let ((resolved nil) (seen nil))
|
||||
(labels ((visit (name) (unless (member name seen :test #'equal) (push name seen)
|
||||
(let ((skill (gethash (string-downcase (string name)) *skills-registry*)))
|
||||
(when skill (dolist (dep (skill-dependencies skill)) (visit dep))))
|
||||
(push name resolved))))
|
||||
(visit skill-name) (nreverse resolved))))
|
||||
#+end_src
|
||||
|
||||
** Metadata Parsing (parse-skill-metadata)
|
||||
Robustly extracts `#+DEPENDS_ON:` and `:ID:` tags from an Org file without full AST parsing.
|
||||
|
||||
#+begin_src lisp :tangle ../src/skills.lisp
|
||||
(defun parse-skill-metadata (filepath)
|
||||
"Extracts ID and DEPENDS_ON tags using robust line-scanning."
|
||||
(let ((dependencies nil)
|
||||
(id nil))
|
||||
(with-open-file (stream filepath)
|
||||
(loop for line = (read-line stream nil :eof)
|
||||
until (eq line :eof)
|
||||
do (let ((clean (string-trim '(#\Space #\Tab #\Return #\Newline) line)))
|
||||
(cond
|
||||
((uiop:string-prefix-p "#+DEPENDS_ON:" (string-upcase clean))
|
||||
(let* ((deps-part (string-trim " " (subseq clean 13))))
|
||||
(setf dependencies (append dependencies
|
||||
(mapcar (lambda (s) (string-trim "[] " s))
|
||||
(uiop:split-string deps-part :separator '(#\Space #\Tab)))))))
|
||||
((uiop:string-prefix-p ":ID:" (string-upcase clean))
|
||||
(setf id (string-trim '(#\Space #\Tab) (subseq clean 4))))))))
|
||||
(values id (remove-if (lambda (s) (= 0 (length s))) dependencies))))
|
||||
#+end_src
|
||||
|
||||
** Topological Sorting (topological-sort-skills)
|
||||
Calculates the correct load order for a directory of skill files, detecting circular dependencies.
|
||||
|
||||
#+begin_src lisp :tangle ../src/skills.lisp
|
||||
(defun topological-sort-skills (skills-dir)
|
||||
"Returns a list of skill filepaths sorted by dependency (dependencies first)."
|
||||
(let ((files (uiop:directory-files skills-dir "org-skill-*.org"))
|
||||
(adj (make-hash-table :test 'equal))
|
||||
(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) id-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* ((dep-id (if (and (> (length dep) 3) (uiop:string-prefix-p "id:" (string-downcase dep)))
|
||||
(subseq dep 3)
|
||||
dep))
|
||||
(dep-file (gethash (string-downcase dep-id) id-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) id-to-file)))
|
||||
(when file (visit file)))))
|
||||
result)))
|
||||
#+end_src
|
||||
|
||||
** Jailed Loading (load-skill-from-org)
|
||||
The core "hot-loading" mechanism. It extracts Lisp blocks from an Org file and evaluates them within a dedicated package ("Jail"). This prevents skills from accidentally polluting the global namespace while still allowing them to access the `org-agent` API.
|
||||
|
||||
#+begin_src lisp :tangle ../src/skills.lisp
|
||||
(defun load-skill-from-org (filepath)
|
||||
"Parses and evaluates Lisp blocks from an Org file into a jailed package."
|
||||
(when (uiop:file-exists-p filepath)
|
||||
(let* ((content (uiop:read-file-string filepath)) (lines (uiop:split-string content :separator '(#\Newline)))
|
||||
(in-lisp-block nil) (lisp-code "") (dependencies nil) (skill-base-name (pathname-name filepath))
|
||||
(pkg-name (intern (string-upcase (format nil "ORG-AGENT.SKILLS.~a" skill-base-name)) :keyword)))
|
||||
(dolist (line lines)
|
||||
(let ((clean-line (string-trim '(#\Space #\Tab #\Return) line)))
|
||||
(when (uiop:string-prefix-p "#+DEPENDS_ON:" (string-upcase clean-line))
|
||||
(setf dependencies (mapcar (lambda (s) (string-trim "[] " s)) (uiop:split-string (subseq clean-line 13) :separator '(#\Space)))))))
|
||||
(dolist (line lines)
|
||||
(let ((clean-line (string-trim '(#\Space #\Tab #\Return) line)))
|
||||
(cond ((uiop:string-prefix-p "#+begin_src lisp" (string-downcase clean-line)) (setf in-lisp-block t))
|
||||
((uiop:string-prefix-p "#+end_src" (string-downcase clean-line)) (setf in-lisp-block nil))
|
||||
(in-lisp-block (setf lisp-code (concatenate 'string lisp-code line (string #\Newline)))))))
|
||||
(when (> (length lisp-code) 0)
|
||||
(kernel-log "KERNEL: 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 :org-agent)) (shadowing-import sym new-pkg))))
|
||||
(let ((*read-eval* nil) (*package* (find-package pkg-name)))
|
||||
(handler-case (eval (read-from-string (format nil "(progn ~a)" lisp-code)))
|
||||
(error (c) (kernel-log "READER ERROR in skill '~a': ~a~%" skill-base-name c))))))))
|
||||
#+end_src
|
||||
|
||||
** Safe Loading with Timeout
|
||||
Wraps the skill loader in a thread with a hard timeout to prevent a single malformed skill from hanging the entire kernel boot sequence.
|
||||
|
||||
#+begin_src lisp :tangle ../src/skills.lisp
|
||||
(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 ()
|
||||
(handler-case
|
||||
(progn
|
||||
(load-skill-from-org filepath)
|
||||
(setf finished t))
|
||||
(error (c)
|
||||
(kernel-log "THREAD ERROR: ~a" c)
|
||||
(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)
|
||||
(kernel-log "KERNEL: Timing out skill ~a..." (pathname-name filepath))
|
||||
#+sbcl (sb-thread:terminate-thread thread)
|
||||
#-sbcl (bt:destroy-thread thread)
|
||||
(return :timeout))
|
||||
(sleep 0.05))))
|
||||
#+end_src
|
||||
|
||||
** Syntax Validation
|
||||
#+begin_src lisp :tangle ../src/skills.lisp
|
||||
(defun validate-lisp-syntax (code-string)
|
||||
"Checks if a string contains valid, readable Common Lisp forms."
|
||||
(handler-case (let ((*read-eval* nil)) (with-input-from-string (stream (format nil "(progn ~a)" code-string))
|
||||
(loop for form = (read stream nil :eof) until (eq form :eof)) (values t nil)))
|
||||
(error (c) (values nil (format nil "~a" c)))))
|
||||
#+end_src
|
||||
|
||||
** The Default Tool Belt
|
||||
We register a set of standard cognitive tools that all skills can use.
|
||||
|
||||
*** The Eval Tool
|
||||
#+begin_src lisp :tangle ../src/skills.lisp
|
||||
(def-cognitive-tool :eval "Evaluates raw Common Lisp code in the kernel image. Use this for complex calculations or internal state inspection."
|
||||
:parameters ((: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 :org-agent.skills.org-skill-safety-harness)))
|
||||
(if harness-pkg
|
||||
(uiop:symbol-call :org-agent.skills.org-skill-safety-harness :safety-harness-validate code)
|
||||
t))))
|
||||
:body (lambda (args)
|
||||
(let ((code (getf args :code)))
|
||||
(handler-case (let ((result (eval (read-from-string code))))
|
||||
(format nil "~s" result))
|
||||
(error (c) (format nil "ERROR: ~a" c))))))
|
||||
#+end_src
|
||||
|
||||
*** The Grep Tool
|
||||
#+begin_src lisp :tangle ../src/skills.lisp
|
||||
(def-cognitive-tool :grep-search "Searches for a pattern in the project files."
|
||||
:parameters ((:pattern :type :string :description "The regex pattern to search for")
|
||||
(:dir :type :string :description "Directory to search in (default is project root)"))
|
||||
:body (lambda (args)
|
||||
(let ((pattern (getf args :pattern))
|
||||
(dir (or (getf args :dir) (uiop:getenv "MEMEX_DIR"))))
|
||||
(uiop:run-program (list "grep" "-r" "-n" "--exclude-dir=node_modules" pattern dir)
|
||||
:output :string :ignore-error-status t))))
|
||||
#+end_src
|
||||
|
||||
*** The Shell Tool
|
||||
#+begin_src lisp :tangle ../src/skills.lisp
|
||||
(def-cognitive-tool :shell "Executes a shell command on the local machine. Use this for file operations, system checks, or running tests."
|
||||
:parameters ((:cmd :type :string :description "The full bash command to execute"))
|
||||
:guard (lambda (args context)
|
||||
(declare (ignore context))
|
||||
(let ((cmd (getf args :cmd)))
|
||||
(not (or (search "rm -rf /" cmd) (search ":(){ :|:& };:" cmd)))))
|
||||
:body (lambda (args)
|
||||
(let ((cmd (getf args :cmd)))
|
||||
(multiple-value-bind (out err code)
|
||||
(uiop:run-program (list "bash" "-c" cmd) :output :string :error-output :string :ignore-error-status t)
|
||||
(format nil "EXIT-CODE: ~a~%~%STDOUT:~%~a~%~%STDERR:~%~a" code out err)))))
|
||||
#+end_src
|
||||
47
literate/system-definition.org
Normal file
47
literate/system-definition.org
Normal file
@@ -0,0 +1,47 @@
|
||||
#+TITLE: System Definition (org-agent.asd)
|
||||
#+AUTHOR: Amr
|
||||
#+FILETAGS: :kernel:system:
|
||||
#+STARTUP: content
|
||||
|
||||
* System Definition
|
||||
#+begin_src lisp :tangle ../org-agent.asd
|
||||
(defsystem :org-agent
|
||||
:name "org-agent"
|
||||
:author "Amr"
|
||||
:version "0.1.0"
|
||||
:license "MIT"
|
||||
:description "The Neurosymbolic Lisp Machine Kernel"
|
||||
:depends-on (:usocket :cl-json :bordeaux-threads :dexador :uiop :cl-dotenv :cl-ppcre :hunchentoot :ironclad)
|
||||
:serial t
|
||||
:components ((:module "src"
|
||||
:components ((:file "package")
|
||||
(:file "protocol")
|
||||
(:file "object-store")
|
||||
(:file "context")
|
||||
(:file "embedding")
|
||||
(:file "skills")
|
||||
(:file "neuro")
|
||||
(:file "symbolic")
|
||||
(:file "core"))))
|
||||
:build-operation "program-op"
|
||||
:build-pathname "org-agent-server"
|
||||
:entry-point "org-agent:main"
|
||||
:in-order-to ((test-op (test-op :org-agent/tests))))
|
||||
|
||||
(defsystem :org-agent/tests
|
||||
:depends-on (:org-agent :fiveam)
|
||||
:components ((:module "tests"
|
||||
:components ((:file "oacp-tests")
|
||||
(:file "cognitive-loop-tests")
|
||||
(:file "boot-sequence-tests")
|
||||
(:file "object-store-tests")
|
||||
(:file "immune-system-tests")
|
||||
(:file "chaos-qa"))))
|
||||
:perform (test-op (o s)
|
||||
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :oacp-suite :org-agent-tests))
|
||||
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :cognitive-suite :org-agent-cognitive-tests))
|
||||
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :boot-suite :org-agent-boot-tests))
|
||||
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :object-store-suite :org-agent-object-store-tests))
|
||||
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :immune-suite :org-agent-immune-system-tests))
|
||||
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :chaos-suite :org-agent-chaos-qa))))
|
||||
#+end_src
|
||||
Reference in New Issue
Block a user