Compare commits
11 Commits
v0.1.0
...
d4913261e2
| Author | SHA1 | Date | |
|---|---|---|---|
| d4913261e2 | |||
| 05e166e454 | |||
| 037584b105 | |||
| de9da130a1 | |||
| ac9d1ac2fe | |||
| e685b43b8b | |||
| 40d90cca7a | |||
| 3f46b20192 | |||
| bd19f2f853 | |||
| 92b6f3cf2b | |||
| 9f6e189ea0 |
167
README.org
167
README.org
@@ -204,56 +204,15 @@ The Active Brain is built from the Source of Truth on boot and kept in sync via:
|
||||
|
||||
* The Evolutionary Roadmap
|
||||
|
||||
openCortex's roadmap is designed working backwards from SOTA parity (V 1.0.0), guided by a critical analysis of four reference systems: OpenCode, Claude Code (leaked source), GBrain, and OpenClaw/Hermes. Every borrowed concept is reimplemented in pure Lisp. Every rejected pattern is documented.
|
||||
The roadmap is designed working backwards from SOTA parity (V 1.0.0), guiding each version toward a fully autonomous, self-editing agent. Each version builds on the previous, with features designed to be implemented in pure Common Lisp + Org-mode.
|
||||
|
||||
** Non-Negotiable Identity
|
||||
- Pure Common Lisp + Org-mode. No JSON. No YAML. No external databases.
|
||||
- Single-address-space memory (Lisp hash tables in RAM — we *are* the memory).
|
||||
- Single-address-space memory (Lisp hash tables in RAM — the agent IS the memory).
|
||||
- "Thin harness, fat skills" — complexity lives at the edges, not the kernel.
|
||||
- One agent composed of many skills. No sub-agent topologies.
|
||||
- One agent composed of many skills. Concurrency via bordeaux-threads (shared memory).
|
||||
- Plists everywhere — homoiconic communication between all components.
|
||||
|
||||
*** OpenCode: Borrowed / Rejected
|
||||
|
||||
| Feature | Decision | Rationale |
|
||||
|---------|----------|-----------|
|
||||
| Permission filtering before LLM sees tools | BORROW | Hook into =generate-tool-belt-prompt= to exclude denied tools. We have =:guard= but no pre-filter. |
|
||||
| Hook system (session start/end) | BORROW | Already designing event-orchestrator. Expose via =#+HOOK:= properties. |
|
||||
| Skills with YAML frontmatter | REJECT | Our Org-mode =:PROPERTIES:= + =#+FILETAGS= already do this. |
|
||||
|
||||
*** Claude Code: Borrowed / Rejected
|
||||
|
||||
| Feature | Decision | Rationale |
|
||||
|---------|----------|-----------|
|
||||
| ULTRAPLAN / structured task decomposition | BORROW (reimplement) | LLM already generates plist actions. Add task-tree skill that decomposes into Org-mode headline DAGs with terminal states. |
|
||||
| 43 integrated tools | BORROW (approach) | Start with ~3. Build more as skills. Keep =def-cognitive-tool= pattern. |
|
||||
| 4-tier permission chain (ask/allow/deny) | BORROW (concept) | Three-tier per-tool permission: ask/allow/deny stored in org-objects. |
|
||||
| Multi-agent hub-and-spoke topology | REJECT | We have one agent. Concurrency via bordeaux-threads (shared memory). Skills ARE the specialization — intra-process, not inter-process. |
|
||||
| Mailbox pattern for dangerous ops | REJECT | Jailed skill packages + Policy skill already provide isolation. Bouncer gate satisfies "worker can't self-approve". |
|
||||
|
||||
*** GBrain: Borrowed / Rejected
|
||||
|
||||
| Feature | Decision | Rationale |
|
||||
|---------|----------|-----------|
|
||||
| RESOLVER.md intent routing | BORROW (concept) | =find-triggered-skill= already does this. Enhance with multi-skill triggers for complex intents. |
|
||||
| Three search modes (keyword, hybrid, direct) | BORROW | Keep keyword + direct. Hybrid/vector via local Ollama embeddings — no external DBs. |
|
||||
| Memory segmentation (brain/agent/session) | BORROW (concept) | Extend org-object with =:scope= property: =:memex= (permanent), =:session= (ephemeral), =:project= (scoped). |
|
||||
| 20+ cron jobs for background work | BORROW (concept) | Heartbeat already does this. Enhance with Event Orchestrator's cron registry — pure Lisp. |
|
||||
| Sub-agent model routing for cost | BORROW (concept) | Our =*model-selector-fn*= already selects models. Extend to route by complexity tier. |
|
||||
| Postgres + pgvector | REJECT | Single-address-space hash tables. No external databases. |
|
||||
|
||||
*** opencortex-contrib: Integrate / Reject
|
||||
|
||||
| Skill | Decision | Rationale |
|
||||
|-------|----------|-----------|
|
||||
| self-fix + lisp-repair | INTEGRATE | Merge into =org-skill-self-edit=. Our memory has snapshot/rollback. Add =repair-file= as cognitive tool. |
|
||||
| event-orchestrator | INTEGRATE | Merge hooks + cron + routing into ONE skill. Our loop has no unified orchestration. |
|
||||
| formal-verification | INTEGRATE | =def-invariant= macro + =verify-action-formally= belong in =org-skill-policy.org= as additional checks. |
|
||||
| engineering-standards | INTEGRATE | Git-clean-p gate + "Commit Before Modify" belong in Policy. |
|
||||
| sub-agent-manager | REJECT | Redundant with BT threads. Our =defskill= pattern (trigger + probabilistic + deterministic) is intra-process specialization — same goal, zero process overhead. |
|
||||
| embedding-generator | BORROW | Ollama embeddings for semantic search — no external vector DB. |
|
||||
| playwright + web-research | DEFER | V 0.5.0. Browser automation via Python bridge. |
|
||||
|
||||
** Version Roadmap
|
||||
|
||||
*** v0.1.0: The Autonomous Foundation — CURRENT RELEASE ✅
|
||||
@@ -277,98 +236,104 @@ The secure, auditable Lisp kernel. All core infrastructure in place.
|
||||
|
||||
*** v0.2.0: Self-Improvement + Local LLMs — NEXT
|
||||
|
||||
Priority: Self-editing is the foundation of all growth. Full org-mode manipulation makes the agent a true Emacs citizen.
|
||||
Self-editing is the foundation of all future growth. Full org-mode manipulation makes the agent a true Emacs citizen.
|
||||
|
||||
| Feature | Source | Implementation |
|
||||
|---------|--------|----------------|
|
||||
| org-skill-self-edit (self-modification) | contrib self-fix + lisp-repair | Hook into =:syntax-error= events. Deterministic: auto-balance parens. Probabilistic: LLM surgical fix. Memory rollback on failure. |
|
||||
| org-skill-emacs-edit (full org manipulation) | Own need | Read org buffers, parse AST, create/update/delete headlines, set properties, manage TODO, handle links. Uses org-element. |
|
||||
| Local vector search (Ollama embeddings) | contrib embedding-generator | =generate-embeddings= via Ollama. Add =:vector= to org-object. Semantic search with cosine similarity. |
|
||||
| Tool permission tiers (ask/allow/deny) | Claude Code | Per-tool permission plist in org-object. =generate-tool-belt-prompt= filters denied tools. |
|
||||
| Skill hot-reload (=:reload-skill= tool) | Own need | Swap compiled skill files without breaking sockets. |
|
||||
| Feature | Description |
|
||||
|---------|-------------|
|
||||
| org-skill-self-edit | Hook into =:syntax-error= events. Deterministic: auto-balance parens. Probabilistic: LLM surgical fix with memory rollback on failure. |
|
||||
| org-skill-emacs-edit | Read org buffers, parse AST, create/update/delete headlines, set properties, manage TODO states, handle links. |
|
||||
| Local vector search | =generate-embeddings= via Ollama. Add =:vector= to org-object. Semantic search with cosine similarity. |
|
||||
| Tool permission tiers | Per-tool permission: ask/allow/deny stored in org-objects. Filter tools before LLM sees them. |
|
||||
| Skill hot-reload | Swap compiled skill files without breaking active sockets. |
|
||||
|
||||
*** v0.3.0: Event Orchestration + Context Awareness
|
||||
|
||||
Priority: Unified control plane, deep project understanding before complex work.
|
||||
Unified control plane for deep project understanding before complex work.
|
||||
|
||||
| Feature | Source | Implementation |
|
||||
|---------|--------|----------------|
|
||||
| org-skill-event-orchestrator (hooks+cron+routing) | contrib event-orchestrator | Merge *hook-registry* + *cron-registry* + complexity classifier. Hooks via =#+HOOK:=. Three tiers: =:REFLEX= (no LLM), =:COGNITION= (light LLM), =:REASONING= (full LLM). |
|
||||
| org-skill-context-manager (project scoping) | contrib context-manager | Stack-based context. =push-context= / =pop-context=. Path resolution relative to current context. |
|
||||
| Memory scope segmentation | GBrain | =:scope= on org-objects: memex/session/project. Scope-aware retrieval. |
|
||||
| Model-tier routing (cost optimization) | GBrain | Heartbeat → smallest model. User input → medium. Complex reasoning → large. |
|
||||
| Slash commands (TUI ergonomics) | Own need | =M-x= style command palette. =/-= prefix. Commands defined in org-mode. |
|
||||
| Feature | Description |
|
||||
|---------|-------------|
|
||||
| org-skill-event-orchestrator | Unified hooks + cron + routing. Three tiers: =:REFLEX= (no LLM), =:COGNITION= (light LLM), =:REASONING= (full LLM). |
|
||||
| org-skill-context-manager | Stack-based project scoping. =push-context= / =pop-context=. Path resolution relative to context. |
|
||||
| Memory scope segmentation | =:scope= property on org-objects: memex/session/project. Scope-aware retrieval. |
|
||||
| Model-tier routing | Complexity-based model selection: heartbeat → tiny, user → medium, reasoning → large. |
|
||||
| Slash commands | =M-x= style command palette in TUI. Commands defined in Org-mode. |
|
||||
|
||||
*** v0.4.0: Long-Horizon Planning + Git Workflows
|
||||
|
||||
Priority: Real engineering work spans dozens of steps. Structured tracking, failure handling, course correction.
|
||||
Structured tracking, failure handling, and course correction for multi-step engineering work.
|
||||
|
||||
| Feature | Source | Implementation |
|
||||
|---------|--------|----------------|
|
||||
| org-skill-long-horizon (task tree DAG) | Claude Code ULTRAPLAN | Decompose tasks into Org-mode headline trees. Terminal states: =:done= / =:blocked= / =:stuck=. Parent summarises children. Branch pruning. |
|
||||
| org-skill-git-steward (version control) | contrib git-steward | Status, diff, commit, push, branch. Policy enforces commit-before-modify. |
|
||||
| TDD runner integration | contrib tdd-runner | FiveAM on file save. =:test-failure= events. Hook into self-fix for auto-repair. |
|
||||
| Deep Emacs integration | Own need | Full org-agenda awareness. Clock time, refile, archive. |
|
||||
| Feature | Description |
|
||||
|---------|-------------|
|
||||
| org-skill-long-horizon | Decompose tasks into Org-mode headline trees. Terminal states: =:done= / =:blocked= / =:stuck=. Parent summarises children. Branch pruning. |
|
||||
| org-skill-git-steward | Status, diff, commit, push, branch. Policy enforces commit-before-modify. |
|
||||
| TDD runner | FiveAM on file save. =:test-failure= events. Hook into self-fix for auto-repair. |
|
||||
| Deep Emacs integration | Full org-agenda awareness. Navigate, clock time, refile, archive. |
|
||||
|
||||
*** v0.5.0: Creator + Architect + GTD
|
||||
|
||||
Priority: Agent bootstraps itself. Creates skills autonomously, designs projects from PRDs, tracks work.
|
||||
The agent bootstraps itself: creates skills autonomously, designs projects from PRDs, manages work.
|
||||
|
||||
| Feature | Source | Implementation |
|
||||
|---------|--------|----------------|
|
||||
| org-skill-creator (autonomous skill generation) | contrib creator | LLM drafts complete skill org-file. Mandatory: syntax validation → jail-load → test → register. |
|
||||
| org-skill-architect (PRD → PROTOCOL) | contrib architect | Scan =:STATUS: FROZEN= PRDs. Generate Phase B PROTOCOL. |
|
||||
| org-skill-gtd (project tracking) | contrib gtd | Full GTD cycle. org-gtd v4.0 DAG (=:TRIGGER:=, =:BLOCKER:=). |
|
||||
| Consensus loop (multi-model agreement) | contrib consensus | Run multiple providers, compare results, detect disagreements. |
|
||||
| Web research (Playwright browsing) | contrib playwright | Headless Chromium via Python bridge. Gemini Web UI automation. |
|
||||
| Feature | Description |
|
||||
|---------|-------------|
|
||||
| org-skill-creator | LLM drafts complete skill org-file from natural language. Mandatory: syntax validation → jail-load → test → register. |
|
||||
| org-skill-architect | Scan =:STATUS: FROZEN= PRDs. Generate Phase B PROTOCOL. |
|
||||
| org-skill-gtd | Full GTD cycle: capture, clarify, organize, reflect, engage. org-gtd v4.0 DAG (=:TRIGGER:=, =:BLOCKER:=). |
|
||||
| Consensus loop | Run multiple providers for critical decisions. Compare results, detect disagreements. |
|
||||
| Web research | Headless Chromium via Python bridge. Text extraction, screenshots, Gemini Web UI automation. |
|
||||
|
||||
*** v1.0.0: SOTA Parity
|
||||
|
||||
Feature-complete agent, competitive with commercial agents. All borrowed concepts reimplemented in pure Lisp.
|
||||
Feature-complete agent competitive with commercial agents. All features reimplemented in pure Lisp.
|
||||
|
||||
| Area | Status | Notes |
|
||||
|------|--------|-------|
|
||||
| Self-improvement | ✅ v0.2.0 | Self-edit + lisp-repair = Claude Code self-debug parity |
|
||||
| Planning | ✅ v0.4.0 | Task tree DAGs = ULTRAPLAN equivalent |
|
||||
| Tool ecosystem | 🟡 v0.4.0 | 10+ tools (expand from 3) |
|
||||
| Self-improvement | ✅ v0.2.0 | Self-edit + lisp-repair |
|
||||
| Planning | ✅ v0.4.0 | Task tree DAGs with terminal states |
|
||||
| Tool ecosystem | 🟡 v0.4.0 | 10+ cognitive tools |
|
||||
| Context window | ✅ v0.3.0 | Semantic search + scope segmentation |
|
||||
| Safety | ✅ v0.1.0 | 6 Policy invariants + formal verification |
|
||||
| Multi-step tasks | ✅ v0.4.0 | Task trees with terminal states |
|
||||
| Code editing | ✅ v0.2.0 | Full file read/write via org manipulation |
|
||||
| Memory | 🟡 v0.2.0 | Add vector recall to org-object |
|
||||
| Emacs integration | ✅ v0.2.0 | Full org-mode control — exceeds Claude Code |
|
||||
| Autonomy | ✅ v0.1.0 | 100% local capable (Ollama) — exceeds Claude Code |
|
||||
| Multi-step tasks | ✅ v0.4.0 | Task trees with failure handling |
|
||||
| Code editing | ✅ v0.2.0 | Full org-mode file read/write |
|
||||
| Memory | ✅ v0.2.0 | Vector recall in org-object |
|
||||
| Emacs integration | ✅ v0.2.0 | Full org-mode control |
|
||||
| Autonomy | ✅ v0.1.0 | 100% local capable (Ollama) |
|
||||
|
||||
*** v2.0.0: Lisp Machine Emergence
|
||||
|
||||
The agent moves from "using Lisp" to "being Lisp."
|
||||
From Lisp-using agent to true Lisp machine. Agent IS the Emacs process.
|
||||
|
||||
| Feature | Implementation |
|
||||
|---------|----------------|
|
||||
| Lisp editor (Lish) | Org-mode as IDE. Org-babel for interactive evaluation. Full REPL in TUI. |
|
||||
| Shell replacement (Lish) | Lisp-based shell that speaks plists. Org-mode buffers as file system. |
|
||||
| Feature | Description |
|
||||
|---------|-------------|
|
||||
| Lish: Lisp editor | Org-mode as IDE. Org-babel for interactive evaluation. Full REPL in TUI. No bridge needed. |
|
||||
| Lish: Shell replacement | Lisp-based shell that speaks plists. Org-mode buffers as file system. |
|
||||
|
||||
*** v3.0.0: Neurosymbolic Maturity
|
||||
|
||||
| Feature | Implementation |
|
||||
|---------|----------------|
|
||||
| Deterministic planner | Planner as pure Lisp function. No LLM for scheduling. |
|
||||
Deterministic planner takes the wheel. LLM relegated to semantic translation.
|
||||
|
||||
| Feature | Description |
|
||||
|---------|-------------|
|
||||
| Deterministic planner | Pure Lisp task scheduler. No LLM needed for planning. |
|
||||
| Self-correcting gates | Gates learn from false positives (user override patterns). |
|
||||
|
||||
*** v4.0.0: AI Stack Internalized
|
||||
|
||||
| Feature | Implementation |
|
||||
|---------|----------------|
|
||||
| Llama.cpp in Lisp | FFI binding to llama.cpp. No Python. |
|
||||
| Weights as sexps | Neural weights as Lisp data structures. |
|
||||
The agent understands its own weights. No external inference.
|
||||
|
||||
| Feature | Description |
|
||||
|---------|-------------|
|
||||
| Llama.cpp in Lisp | FFI binding. No Python subprocess. Pure Common Lisp inference. |
|
||||
| Weights as sexps | Neural weights as Lisp data structures. Homoiconic model introspection. |
|
||||
|
||||
*** v5.0.0: True Agency
|
||||
|
||||
| Feature | Implementation |
|
||||
|---------|----------------|
|
||||
| World models | Agent builds predictive models of user behavior, project dynamics, system state. |
|
||||
| Temporal reasoning | The agent reasons about time: scheduling, deadlines, elapsed duration. |
|
||||
| Goal persistence | Goals survive restarts. Long-term projects tracked in org-objects. |
|
||||
World models, temporal reasoning, goal persistence across restarts.
|
||||
|
||||
| Feature | Description |
|
||||
|---------|-------------|
|
||||
| World models | Predictive models of user behavior, project dynamics, system state. |
|
||||
| Temporal reasoning | Scheduling, deadlines, elapsed duration awareness. |
|
||||
| Goal persistence | Goals survive restarts. Long-term projects in org-objects. |
|
||||
|
||||
** Design Principles
|
||||
|
||||
|
||||
@@ -4,24 +4,15 @@
|
||||
#+STARTUP: content
|
||||
|
||||
* System Interface (package.lisp)
|
||||
|
||||
The ~package.lisp~ file defines the public API of the ~opencortex~ harness. It serves as the primary membrane between the deterministic core modules and the dynamic world of skills and actuators.
|
||||
|
||||
** Architectural Intent: The Package Membrane
|
||||
By strictly defining the public interface, we ensure that skills remain decoupled from the harness implementation details. This allows for autonomous replacement of any component (e.g., swapping the Memory or the Probabilistic Engine) without breaking existing skills.
|
||||
|
||||
#+begin_src mermaid
|
||||
flowchart TD
|
||||
External[Actuators / Clients] -- communication protocol --> Package[Package Membrane: API]
|
||||
Skills[Dynamic Skills] -- API Calls --> Package
|
||||
Package --> Internal[Harness Internal Modules]
|
||||
style Package fill:#f9f,stroke:#333,stroke-width:4px
|
||||
#+end_src
|
||||
|
||||
** Public API Export
|
||||
|
||||
#+begin_src lisp :tangle ../library/package.lisp
|
||||
(defpackage :opencortex
|
||||
(:use :cl)
|
||||
(:export
|
||||
(:export
|
||||
;; --- communication protocol ---
|
||||
#:frame-message
|
||||
#:read-framed-message
|
||||
@@ -33,13 +24,13 @@ flowchart TD
|
||||
#:parse-message
|
||||
#:make-hello-message
|
||||
#:validate-communication-protocol-schema
|
||||
|
||||
|
||||
;; --- Daemon Lifecycle ---
|
||||
#:start-daemon
|
||||
#:stop-daemon
|
||||
#:harness-log
|
||||
#:main
|
||||
|
||||
|
||||
;; --- Memory (CLOSOS) ---
|
||||
#:ingest-ast
|
||||
#:lookup-object
|
||||
@@ -61,7 +52,7 @@ flowchart TD
|
||||
#:org-object-hash
|
||||
#:snapshot-memory
|
||||
#:rollback-memory
|
||||
|
||||
|
||||
;; --- Context API (Peripheral Vision) ---
|
||||
#:context-query-store
|
||||
#:context-get-active-projects
|
||||
@@ -73,7 +64,7 @@ flowchart TD
|
||||
#:context-get-skill-telemetry
|
||||
#:harness-track-telemetry
|
||||
#:context-assemble-global-awareness
|
||||
|
||||
|
||||
;; --- Reactive Signal Pipeline ---
|
||||
#:process-signal
|
||||
#:perceive-gate
|
||||
@@ -87,7 +78,7 @@ flowchart TD
|
||||
#:initialize-actuators
|
||||
#:dispatch-action
|
||||
#:register-actuator
|
||||
|
||||
|
||||
;; --- Skill Engine ---
|
||||
#:load-skill-from-org
|
||||
#:initialize-all-skills
|
||||
@@ -125,22 +116,28 @@ flowchart TD
|
||||
#:register-probabilistic-backend
|
||||
#:distill-prompt
|
||||
#:*provider-cascade*
|
||||
|
||||
|
||||
;; --- Security Vault ---
|
||||
#:vault-get-secret
|
||||
#:vault-set-secret
|
||||
|
||||
|
||||
;; --- Deterministic Logic ---
|
||||
#:list-objects-with-attribute
|
||||
#:deterministic-verify
|
||||
|
||||
|
||||
;; --- AST Helpers ---
|
||||
#:find-headline-missing-id))
|
||||
#+end_src
|
||||
|
||||
* Package Implementation
|
||||
|
||||
#+begin_src lisp :tangle ../library/package.lisp
|
||||
(in-package :opencortex)
|
||||
#+end_src
|
||||
|
||||
** Robust Plist Accessor
|
||||
|
||||
#+begin_src lisp :tangle ../library/package.lisp
|
||||
(defun proto-get (plist key)
|
||||
"Robustly retrieves a value from a plist, checking both uppercase and lowercase keyword versions."
|
||||
(let* ((s (string key))
|
||||
@@ -149,27 +146,8 @@ flowchart TD
|
||||
(or (getf plist up) (getf plist dn))))
|
||||
#+end_src
|
||||
|
||||
#+end_src
|
||||
|
||||
#+begin_src lisp :tangle ../library/package.lisp
|
||||
(in-package :opencortex)
|
||||
|
||||
(defun proto-get (plist key)
|
||||
"Robustly retrieves a value from a plist, checking both uppercase and lowercase keyword versions."
|
||||
(let* ((s (string key))
|
||||
(up (intern (string-upcase s) :keyword))
|
||||
(dn (intern (string-downcase s) :keyword)))
|
||||
(or (getf plist up) (getf plist dn))))
|
||||
#+end_src
|
||||
|
||||
#+end_src
|
||||
|
||||
** Package Implementation
|
||||
#+begin_src lisp :tangle ../library/package.lisp
|
||||
(in-package :opencortex)
|
||||
#+end_src
|
||||
|
||||
** Harness Logging State
|
||||
|
||||
The harness maintains a thread-safe circular log buffer to provide context for debugging and neural reasoning.
|
||||
|
||||
#+begin_src lisp :tangle ../library/package.lisp
|
||||
@@ -179,33 +157,37 @@ The harness maintains a thread-safe circular log buffer to provide context for d
|
||||
#+end_src
|
||||
|
||||
** Skills Registry
|
||||
|
||||
#+begin_src lisp :tangle ../library/package.lisp
|
||||
(defvar *skills-registry* (make-hash-table :test 'equal)
|
||||
"Global registry of all loaded skills.")
|
||||
#+end_src
|
||||
|
||||
** Skill Telemetry State
|
||||
|
||||
#+begin_src lisp :tangle ../library/package.lisp
|
||||
(defvar *skill-telemetry* (make-hash-table :test 'equal))
|
||||
(defvar *telemetry-lock* (bt:make-lock "harness-telemetry-lock"))
|
||||
#+end_src
|
||||
|
||||
** Telemetry Implementation
|
||||
The system tracks the performance and reliability of individual skills. This logic is currently preserved in the package layer for future expansion into a dedicated telemetry skill.
|
||||
|
||||
The system tracks the performance and reliability of individual skills.
|
||||
|
||||
#+begin_src lisp :tangle ../library/package.lisp
|
||||
(defun harness-track-telemetry (skill-name duration status)
|
||||
"Updates performance metrics for a specific skill. Status should be :success or :rejected."
|
||||
(when skill-name
|
||||
(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 :executions))
|
||||
(incf (getf entry :total-time) duration)
|
||||
(when (eq status :rejected) (incf (getf entry :failures)))
|
||||
(when (eq status :rejected) (incf (getf entry :failures)))
|
||||
(setf (gethash skill-name *skill-telemetry*) entry)))))
|
||||
#+end_src
|
||||
|
||||
** Cognitive Tool Registry
|
||||
|
||||
The Tool Registry allows the agent to interact with the physical world. Every tool must define a guard (for security) and a body (for execution).
|
||||
|
||||
#+begin_src lisp :tangle ../library/package.lisp
|
||||
@@ -229,6 +211,7 @@ The Tool Registry allows the agent to interact with the physical world. Every to
|
||||
#+end_src
|
||||
|
||||
** Harness Logging Implementation
|
||||
|
||||
Centralized logging function. It simultaneously writes to standard output and the in-memory circular buffer.
|
||||
|
||||
#+begin_src lisp :tangle ../library/package.lisp
|
||||
@@ -241,6 +224,4 @@ Centralized logging function. It simultaneously writes to standard output and th
|
||||
(setq *system-logs* (subseq *system-logs* 0 *max-log-history*))))
|
||||
(format t "~a~%" formatted-msg)
|
||||
(finish-output)))
|
||||
#+end_src
|
||||
|
||||
|
||||
#+end_src
|
||||
@@ -360,3 +360,121 @@ EXAMPLES:
|
||||
(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
|
||||
|
||||
*** The Reload-Skill Tool (Hot Reload)
|
||||
#+begin_src lisp :tangle ../library/skills.lisp
|
||||
(def-cognitive-tool :reload-skill "Reloads a skill from its Org-mode source file, recompiling into the live image without restarting the daemon."
|
||||
((:skill :type :string :description "The skill name (e.g., \"org-skill-policy\") or full path to the .org file"))
|
||||
:guard (lambda (args context)
|
||||
(declare (ignore context))
|
||||
(let ((skill (getf args :skill)))
|
||||
(or (uiop:file-exists-p skill)
|
||||
(let ((skills-dir (or (ignore-errors (uiop:getenv "SKILLS_DIR"))
|
||||
(namestring (merge-pathnames "notes/" (user-homedir-pathname))))))
|
||||
(uiop:file-exists-p (merge-pathnames (format nil "~a.org" skill) skills-dir))))))
|
||||
:body (lambda (args)
|
||||
(let ((skill (getf args :skill)))
|
||||
(snapshot-memory)
|
||||
(let ((skills-dir (or (ignore-errors (uiop:getenv "SKILLS_DIR"))
|
||||
(namestring (merge-pathnames "notes/" (user-homedir-pathname)))))
|
||||
(resolved-path (context-resolve-path skills-dir))
|
||||
(skills-dir-actual (if (ignore-errors (uiop:getenv "SKILLS_DIR"))
|
||||
(uiop:ensure-directory-pathname (context-resolve-path (uiop:getenv "SKILLS_DIR")))
|
||||
(uiop:ensure-directory-pathname (user-homedir-pathname)))))
|
||||
(let ((file (if (uiop:file-exists-p skill)
|
||||
(uiop:ensure-pathname skill)
|
||||
(merge-pathnames (format nil "~a.org" skill) skills-dir-actual))))
|
||||
(cond
|
||||
((not (uiop:file-exists-p file))
|
||||
(format nil "ERROR: Skill file not found: ~a" (uiop:native-namestring file)))
|
||||
(t
|
||||
(harness-log "SKILL: Hot-reloading ~a..." (pathname-name file))
|
||||
(let ((status (load-skill-with-timeout file 10)))
|
||||
(if (eq status :success)
|
||||
(let ((base-name (pathname-name file)))
|
||||
(setf (skill-entry-status (gethash base-name *skill-catalog*)) :ready)
|
||||
(format nil "OK: Skill '~a' reloaded successfully." base-name))
|
||||
(format nil "ERROR: Reload failed with status ~a" status)))))))))
|
||||
#+end_src
|
||||
|
||||
*** The File Read Tool (V 0.2.0 File I/O)
|
||||
#+begin_src lisp :tangle ../library/skills.lisp
|
||||
(def-cognitive-tool :read-file "Reads the contents of a file as a string."
|
||||
((:file :type :string :description "The path to the file to read"))
|
||||
:guard (lambda (args context)
|
||||
(declare (ignore context))
|
||||
(let* ((file (getf args :file))
|
||||
(memex-root (or (uiop:getenv "MEMEX_DIR") "/home/user/memex"))
|
||||
(truename (ignore-errors (namestring (truename file)))))
|
||||
(or (null truename)
|
||||
(str:starts-with-p memex-root truename))))
|
||||
:body (lambda (args)
|
||||
(let ((file (getf args :file)))
|
||||
(handler-case
|
||||
(uiop:read-file-string file)
|
||||
(error (c)
|
||||
(format nil "ERROR reading ~a: ~a" file c)))))
|
||||
#+end_src
|
||||
|
||||
*** The File Write Tool (V 0.2.0 File I/O)
|
||||
#+begin_src lisp :tangle ../library/skills.lisp
|
||||
(def-cognitive-tool :write-file "Writes content to a file, creating it if it doesn't exist."
|
||||
((:file :type :string :description "The path to the file to write")
|
||||
(:content :type :string :description "The content to write")
|
||||
(:append :type :string :description "\"t\" to append instead of overwriting (optional)"))
|
||||
:guard (lambda (args context)
|
||||
(declare (ignore context))
|
||||
(let* ((file (getf args :file))
|
||||
(memex-root (or (uiop:getenv "MEMEX_DIR") "/home/user/memex"))
|
||||
(truename (ignore-errors (namestring (truename file)))))
|
||||
(or (null truename)
|
||||
(str:starts-with-p memex-root truename))))
|
||||
:body (lambda (args)
|
||||
(let ((file (getf args :file))
|
||||
(content (getf args :content))
|
||||
(append-p (string-equal (getf args :append) "t")))
|
||||
(handler-case
|
||||
(progn
|
||||
(snapshot-memory)
|
||||
(with-open-file (out file
|
||||
:direction :output
|
||||
:if-exists (if append-p :append :supersede)
|
||||
:if-does-not-exist :create)
|
||||
(write-string content out))
|
||||
(format nil "OK: ~a written to ~a"
|
||||
(if append-p "content appended" "file written")
|
||||
file))
|
||||
(error (c)
|
||||
(format nil "ERROR writing ~a: ~a" file c)))))
|
||||
#+end_src
|
||||
|
||||
*** The String Replace Tool (V 0.2.0 File I/O)
|
||||
#+begin_src lisp :tangle ../library/skills.lisp
|
||||
(def-cognitive-tool :replace-string "Replaces occurrences of old-string with new-string in a file."
|
||||
((:file :type :string :description "The path to the file")
|
||||
(:old :type :string :description "The substring to find and replace")
|
||||
(:new :type :string :description "The replacement string"))
|
||||
:guard (lambda (args context)
|
||||
(declare (ignore context))
|
||||
(let* ((file (getf args :file))
|
||||
(memex-root (or (uiop:getenv "MEMEX_DIR") "/home/user/memex"))
|
||||
(truename (ignore-errors (namestring (truename file)))))
|
||||
(or (null truename)
|
||||
(str:starts-with-p memex-root truename))))
|
||||
:body (lambda (args)
|
||||
(let ((file (getf args :file))
|
||||
(old (getf args :old))
|
||||
(new (getf args :new)))
|
||||
(handler-case
|
||||
(progn
|
||||
(snapshot-memory)
|
||||
(let ((content (uiop:read-file-string file)))
|
||||
(if (search old content)
|
||||
(let ((new-content (cl-ppcre:regex-replace-all (cl-ppcre:quote-meta-chars old) content new)))
|
||||
(with-open-file (out file :direction :output :if-exists :supersede)
|
||||
(write-string new-content out))
|
||||
(format nil "OK: Replaced first occurrence in ~a" file))
|
||||
(format nil "ERROR: Pattern not found in ~a" file))))
|
||||
(error (c)
|
||||
(format nil "ERROR replacing in ~a: ~a" file c)))))
|
||||
#+end_src
|
||||
|
||||
@@ -42,7 +42,7 @@
|
||||
(defun context-get-system-logs (&optional limit)
|
||||
"Retrieves the most recent lines from the harness's internal log."
|
||||
(let ((log-limit (or limit (ignore-errors (parse-integer (uiop:getenv "CONTEXT_LOG_LIMIT"))) 20)))
|
||||
(bt:with-lock-held (*logs-lock*)
|
||||
(bordeaux-threads:with-lock-held (*logs-lock*)
|
||||
(let ((count (min log-limit (length *system-logs*))))
|
||||
(subseq *system-logs* 0 count)))))
|
||||
|
||||
|
||||
@@ -56,13 +56,13 @@
|
||||
"Starts the TCP listener for local CLI clients."
|
||||
(setf *cli-server-socket* (usocket:socket-listen "0.0.0.0" port :reuse-address t))
|
||||
(setf *cli-server-thread*
|
||||
(bt:make-thread
|
||||
(bordeaux-threads:make-thread
|
||||
(lambda ()
|
||||
(unwind-protect
|
||||
(loop
|
||||
(let* ((socket (usocket:socket-accept *cli-server-socket*))
|
||||
(stream (usocket:socket-stream socket)))
|
||||
(bt:make-thread (lambda ()
|
||||
(bordeaux-threads:make-thread (lambda ()
|
||||
(unwind-protect (handle-cli-client stream)
|
||||
(usocket:socket-close socket)))
|
||||
:name "opencortex-cli-client-handler")))
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
(in-package :opencortex)
|
||||
|
||||
(defvar *interrupt-flag* nil)
|
||||
(defvar *interrupt-lock* (bt:make-lock "harness-interrupt-lock"))
|
||||
(defvar *interrupt-lock* (bordeaux-threads:make-lock "harness-interrupt-lock"))
|
||||
(defvar *heartbeat-thread* nil)
|
||||
|
||||
(defun process-signal (signal)
|
||||
@@ -11,9 +11,9 @@
|
||||
(let ((depth (getf current-signal :depth 0))
|
||||
(meta (getf current-signal :meta)))
|
||||
(when (> depth 10) (harness-log "METABOLISM ERROR: Max depth reached.") (return nil))
|
||||
(when (bt:with-lock-held (*interrupt-lock*) *interrupt-flag*)
|
||||
(when (bordeaux-threads:with-lock-held (*interrupt-lock*) *interrupt-flag*)
|
||||
(harness-log "METABOLISM: Interrupted.")
|
||||
(bt:with-lock-held (*interrupt-lock*) (setf *interrupt-flag* nil))
|
||||
(bordeaux-threads:with-lock-held (*interrupt-lock*) (setf *interrupt-flag* nil))
|
||||
(return nil))
|
||||
(handler-case
|
||||
(progn
|
||||
@@ -52,7 +52,7 @@
|
||||
(setf *auto-save-interval* auto-save)
|
||||
(setf *heartbeat-save-counter* 0)
|
||||
(setf *heartbeat-thread*
|
||||
(bt:make-thread
|
||||
(bordeaux-threads:make-thread
|
||||
(lambda ()
|
||||
(loop
|
||||
(sleep interval)
|
||||
@@ -92,7 +92,7 @@
|
||||
|
||||
(let ((sleep-interval (or (ignore-errors (parse-integer (uiop:getenv "DAEMON_SLEEP_INTERVAL"))) 3600)))
|
||||
(loop
|
||||
(when (bt:with-lock-held (*interrupt-lock*) *interrupt-flag*)
|
||||
(when (bordeaux-threads:with-lock-held (*interrupt-lock*) *interrupt-flag*)
|
||||
(harness-log "SHUTDOWN: Interrupt flag set. Saving memory...")
|
||||
(when *shutdown-save-enabled* (save-memory-to-disk))
|
||||
(return))
|
||||
|
||||
@@ -120,38 +120,20 @@
|
||||
|
||||
(in-package :opencortex)
|
||||
|
||||
(defun proto-get (plist key)
|
||||
"Robustly retrieves a value from a plist, checking both uppercase and lowercase keyword versions."
|
||||
(let* ((s (string key))
|
||||
(up (intern (string-upcase s) :keyword))
|
||||
(dn (intern (string-downcase s) :keyword)))
|
||||
(or (getf plist up) (getf plist dn))))
|
||||
|
||||
(in-package :opencortex)
|
||||
|
||||
(defun proto-get (plist key)
|
||||
"Robustly retrieves a value from a plist, checking both uppercase and lowercase keyword versions."
|
||||
(let* ((s (string key))
|
||||
(up (intern (string-upcase s) :keyword))
|
||||
(dn (intern (string-downcase s) :keyword)))
|
||||
(or (getf plist up) (getf plist dn))))
|
||||
|
||||
(in-package :opencortex)
|
||||
|
||||
(defvar *system-logs* nil)
|
||||
(defvar *logs-lock* (bt:make-lock "harness-logs-lock"))
|
||||
(defvar *logs-lock* (bordeaux-threads:make-lock "harness-logs-lock"))
|
||||
(defvar *max-log-history* 100)
|
||||
|
||||
(defvar *skills-registry* (make-hash-table :test 'equal)
|
||||
"Global registry of all loaded skills.")
|
||||
|
||||
(defvar *skill-telemetry* (make-hash-table :test 'equal))
|
||||
(defvar *telemetry-lock* (bt:make-lock "harness-telemetry-lock"))
|
||||
(defvar *telemetry-lock* (bordeaux-threads:make-lock "harness-telemetry-lock"))
|
||||
|
||||
(defun harness-track-telemetry (skill-name duration status)
|
||||
"Updates performance metrics for a specific skill. Status should be :success or :rejected."
|
||||
(when skill-name
|
||||
(bt:with-lock-held (*telemetry-lock*)
|
||||
(bordeaux-threads: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)
|
||||
@@ -179,7 +161,7 @@
|
||||
(defun harness-log (msg &rest args)
|
||||
"Centralized logging for the harness."
|
||||
(let ((formatted-msg (apply #'format nil msg args)))
|
||||
(bt:with-lock-held (*logs-lock*)
|
||||
(bordeaux-threads:with-lock-held (*logs-lock*)
|
||||
(push formatted-msg *system-logs*)
|
||||
(when (> (length *system-logs*) *max-log-history*)
|
||||
(setq *system-logs* (subseq *system-logs* 0 *max-log-history*))))
|
||||
|
||||
@@ -19,7 +19,7 @@
|
||||
(setf (getf raw-message :meta) meta)
|
||||
|
||||
(if async-p
|
||||
(bt:make-thread
|
||||
(bordeaux-threads:make-thread
|
||||
(lambda ()
|
||||
(restart-case (handler-bind ((error (lambda (c) (harness-log "ASYNC ERROR: ~a" c) (invoke-restart 'skip-event))))
|
||||
(process-signal raw-message))
|
||||
@@ -51,7 +51,7 @@
|
||||
(setf *foveal-focus-id* (ignore-errors (getf element :id)))
|
||||
(ingest-ast element))))
|
||||
(:interrupt
|
||||
(bt:with-lock-held (*interrupt-lock*) (setf *interrupt-flag* t)))))
|
||||
(bordeaux-threads:with-lock-held (*interrupt-lock*) (setf *interrupt-flag* t)))))
|
||||
((eq type :RESPONSE)
|
||||
(harness-log "GATE [Perceive]: Act Result -> ~a" (getf payload :status))))
|
||||
|
||||
|
||||
Binary file not shown.
@@ -321,3 +321,44 @@ EXAMPLES:
|
||||
(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)))))
|
||||
|
||||
(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||
(def-cognitive-tool :reload-skill "Reloads a skill from its Org-mode source file."
|
||||
((:skill :type :string :description "The skill name"))
|
||||
:guard (lambda (args context)
|
||||
(declare (ignore context))
|
||||
(let ((skill (getf args :skill)))
|
||||
(or (uiop:file-exists-p skill)
|
||||
(let ((dir (or (ignore-errors (uiop:getenv "SKILLS_DIR"))
|
||||
(namestring (user-homedir-pathname)))))
|
||||
(uiop:file-exists-p (merge-pathnames (format nil "~a.org" skill) dir))))))
|
||||
:body (lambda (args)
|
||||
(let ((skill (getf args :skill))
|
||||
(dir (or (ignore-errors (uiop:getenv "SKILLS_DIR"))
|
||||
(namestring (user-homedir-pathname)))))
|
||||
(let ((file (merge-pathnames (format nil "~a.org" skill) (uiop:ensure-directory-pathname dir))))
|
||||
(if (uiop:file-exists-p file)
|
||||
(format nil "OK: skill ~a found" skill)
|
||||
(format nil "ERROR: skill ~a not found" skill))))))
|
||||
|
||||
(def-cognitive-tool :read-File "Reads the contents of a file."
|
||||
((:file :type :string))
|
||||
:body (lambda (args)
|
||||
(uiop:read-file-string (getf args :file))))
|
||||
|
||||
(def-cognitive-tool :write-file "Writes content to a file."
|
||||
((:file :type :string) (:content :type :string))
|
||||
:body (lambda (args)
|
||||
(with-open-file (out (getf args :file) :direction :output :if-exists :supersede)
|
||||
(write-string (getf args :content) out))
|
||||
"OK"))
|
||||
|
||||
(def-cognitive-tool :replace-string "Replaces text in a file."
|
||||
((:file :type :string) (:old :type :string) (:new :type :string))
|
||||
:body (lambda (args)
|
||||
(let ((content (uiop:read-file-string (getf args :file))))
|
||||
(setf content (cl-ppcre:regex-replace-all (cl-ppcre:quote-meta-chars (getf args :old)) content (getf args :new)))
|
||||
(with-open-file (out (getf args :file) :direction :output :if-exists :supersede)
|
||||
(write-string content out))
|
||||
"OK")))
|
||||
)
|
||||
|
||||
@@ -12,15 +12,15 @@
|
||||
(defvar *status-text* "Connecting...")
|
||||
(defvar *input-buffer* (make-array 0 :element-type 'char :fill-pointer 0 :adjustable t))
|
||||
(defvar *is-running* t)
|
||||
(defvar *queue-lock* (bt:make-lock))
|
||||
(defvar *queue-lock* (bordeaux-threads:make-lock))
|
||||
(defvar *incoming-msgs* nil)
|
||||
|
||||
(defun enqueue-msg (msg)
|
||||
(bt:with-lock-held (*queue-lock*)
|
||||
(bordeaux-threads:with-lock-held (*queue-lock*)
|
||||
(push msg *incoming-msgs*)))
|
||||
|
||||
(defun dequeue-msgs ()
|
||||
(bt:with-lock-held (*queue-lock*)
|
||||
(bordeaux-threads:with-lock-held (*queue-lock*)
|
||||
(let ((msgs (nreverse *incoming-msgs*)))
|
||||
(setf *incoming-msgs* nil)
|
||||
msgs)))
|
||||
@@ -90,7 +90,7 @@
|
||||
(setf *socket* (usocket:socket-connect *daemon-host* *daemon-port*))
|
||||
(error (e) (format t "Error connecting: ~a~%" e) (return-from main)))
|
||||
(setf *stream* (usocket:socket-stream *socket*))
|
||||
(bt:make-thread #'listen-thread :name "tui-listener")
|
||||
(bordeaux-threads:make-thread #'listen-thread :name "tui-listener")
|
||||
|
||||
(unwind-protect
|
||||
(with-screen (scr :input-echoing nil :input-blocking nil :enable-colors t :cursor-visible t)
|
||||
|
||||
@@ -7,15 +7,15 @@
|
||||
:depends-on (:usocket :bordeaux-threads :dexador :uiop :cl-dotenv :cl-ppcre :hunchentoot :ironclad :str :cl-json :uuid)
|
||||
:serial t
|
||||
:components ((:file "library/package")
|
||||
(:file "library/skills")
|
||||
(:file "library/communication")
|
||||
(:file "library/communication-validator")
|
||||
(:file "library/memory")
|
||||
(:file "library/context")
|
||||
(:file "library/perceive")
|
||||
(:file "library/reason")
|
||||
(:file "library/act")
|
||||
(:file "library/loop"))
|
||||
(:file "library/skills" :depends-on ("library/package"))
|
||||
(:file "library/memory" :depends-on ("library/package"))
|
||||
(:file "library/context" :depends-on ("library/package" "library/memory"))
|
||||
(:file "library/communication" :depends-on ("library/package"))
|
||||
(:file "library/communication-validator" :depends-on ("library/package" "library/communication"))
|
||||
(:file "library/perceive" :depends-on ("library/package"))
|
||||
(:file "library/reason" :depends-on ("library/package" "library/perceive"))
|
||||
(:file "library/act" :depends-on ("library/package" "library/reason"))
|
||||
(:file "library/loop" :depends-on ("library/package" "library/act")))
|
||||
:build-operation "program-op"
|
||||
:build-pathname "opencortex-server"
|
||||
:entry-point "opencortex:main")
|
||||
@@ -27,14 +27,17 @@
|
||||
(:file "tests/act-tests")
|
||||
(:file "tests/boot-sequence-tests")
|
||||
(:file "tests/memory-tests")
|
||||
(:file "tests/immune-system-tests"))
|
||||
(:file "tests/immune-system-tests")
|
||||
(:file "tests/lisp-utils-tests"))
|
||||
:perform (test-op (o s)
|
||||
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :communication-protocol-suite :opencortex-tests))
|
||||
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :pipeline-suite :opencortex-pipeline-tests))
|
||||
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :safety-suite :opencortex-safety-tests))
|
||||
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :boot-suite :opencortex-boot-tests))
|
||||
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :memory-suite :opencortex-memory-tests))
|
||||
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :immune-suite :opencortex-immune-system-tests))))
|
||||
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :communication-protocol-suite :opencortex-tests))
|
||||
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :pipeline-suite :opencortex-pipeline-tests))
|
||||
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :safety-suite :opencortex-safety-tests))
|
||||
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :boot-suite :opencortex-boot-tests))
|
||||
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :memory-suite :opencortex-memory-tests))
|
||||
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :immune-suite :opencortex-immune-system-tests))
|
||||
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :emacs-edit-suite :opencortex-emacs-edit-tests))
|
||||
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :lisp-utils-suite :opencortex-lisp-utils-tests)))))
|
||||
|
||||
(defsystem :opencortex/tui
|
||||
:depends-on (:opencortex :croatoan :usocket :bordeaux-threads)
|
||||
|
||||
432
skills/org-skill-emacs-edit.org
Normal file
432
skills/org-skill-emacs-edit.org
Normal file
@@ -0,0 +1,432 @@
|
||||
:PROPERTIES:
|
||||
:ID: emacs-edit-skill
|
||||
:CREATED: [2026-04-23 Thu]
|
||||
:END:
|
||||
#+TITLE: SKILL: Emacs Edit (Org-Mode Structured Manipulation)
|
||||
#+STARTUP: content
|
||||
#+FILETAGS: :system:emacs:org:manipulation:edit:
|
||||
|
||||
* Overview
|
||||
The *Emacs Edit* skill enables structured manipulation of org-mode files WITHOUT requiring an Emacs process. It provides read/write operations on org files using structured parsing.
|
||||
|
||||
Why NOT Emacs subprocess:
|
||||
- Keeps harness lightweight (no external process)
|
||||
- Simpler architecture, faster execution
|
||||
- Pure Lisp - easier to test and maintain
|
||||
|
||||
Capabilities:
|
||||
- Parse org files to AST (already exists via ingest-ast)
|
||||
- Write AST back to org format preserving structure
|
||||
- Create/update/delete headlines
|
||||
- Set properties with proper :ID: generation
|
||||
- Manage TODO states
|
||||
|
||||
* Phase A: Demand (PRD)
|
||||
:PROPERTIES:
|
||||
:STATUS: SIGNED
|
||||
:END:
|
||||
|
||||
** 1. Purpose
|
||||
Enable structured org-file modification without breaking tangling.
|
||||
|
||||
** 2. User Needs
|
||||
- Parse org file → structured AST
|
||||
- Modify AST (add headline, set property, change TODO)
|
||||
- Write AST back → valid org file (preserves #+begin_src blocks)
|
||||
|
||||
** 3. Success Criteria
|
||||
- [X] Read org files as structured data
|
||||
- [X] Write back preserving PROPERTIES, drawers, code blocks
|
||||
- [X] Generate unique IDs for new headlines
|
||||
- [X] Change TODO states (TODO → DONE)
|
||||
|
||||
* Phase B: Blueprint (PROTOCOL)
|
||||
:PROPERTIES:
|
||||
:STATUS: SIGNED
|
||||
:END:
|
||||
|
||||
** 1. Architectural Intent
|
||||
Single entry point `emacs-edit-modify` takes a file path, operation, and parameters.
|
||||
|
||||
** 2. Operations
|
||||
- `:read` - Parse file to AST
|
||||
- `:write` - Write AST back to file
|
||||
- `:add-headline` - Add new headline
|
||||
- `:set-property` - Set property on headline
|
||||
- `:set-todo` - Change TODO state
|
||||
|
||||
* Phase D: Build (Implementation)
|
||||
|
||||
** Package Context
|
||||
#+begin_src lisp :tangle ../library/gen/org-skill-emacs-edit.lisp
|
||||
(in-package :opencortex)
|
||||
#+end_src
|
||||
|
||||
** ID Generation
|
||||
Generate unique IDs for headlines.
|
||||
|
||||
#+begin_src lisp :tangle ../library/gen/org-skill-emacs-edit.lisp
|
||||
(defun emacs-edit-generate-id ()
|
||||
"Generates a unique ID for org-mode headlines.
|
||||
Format: 8-char hex + timestamp for uniqueness."
|
||||
(let ((uuid (ironclad:byte-array-to-hex-string
|
||||
(ironclad:produce-digest :sha256
|
||||
(format nil "~a-~a"
|
||||
(get-universal-time)
|
||||
(random 999999))))))
|
||||
(subseq uuid 0 8)))
|
||||
|
||||
(defun emacs-edit-id-format (id)
|
||||
"Formats ID for org-mode (e.g., 'abc12345')."
|
||||
(if (search "id:" id)
|
||||
id
|
||||
(format nil "id:~a" id)))
|
||||
#+end_src
|
||||
|
||||
** Org Printer (AST → Org Format)
|
||||
Converts AST back to org format, preserving structure.
|
||||
|
||||
#+begin_src lisp :tangle ../library/gen/org-skill-emacs-edit.lisp
|
||||
(defun emacs-edit-print-headline (ast &key indent-level)
|
||||
"Converts a HEADLINE AST node to org text.
|
||||
INDENT-LEVEL is number of leading asterisks."
|
||||
(let ((level (or indent-level 1))
|
||||
(stars (make-string level :initial-element #\*))
|
||||
(title (or (getf (getf ast :properties) :TITLE) ""))
|
||||
(todo (getf (getf ast :properties) :TODO)))
|
||||
(format nil "~a ~a~%~a"
|
||||
stars
|
||||
(if todo (format nil "[~a] " (string-upcase todo)) "")
|
||||
title)))
|
||||
|
||||
(defun emacs-edit-print-properties (props)
|
||||
"Converts property list to :PROPERTIES: drawer."
|
||||
(when props
|
||||
(let ((lines (loop for (k v) on props by #'cddr
|
||||
unless (member k '(:title :todo :created :id))
|
||||
collect (format nil ":~a:~a" k v))))
|
||||
(when lines
|
||||
(format nil ":PROPERTIES:~%~{~a~^~%~}~:END:~%"
|
||||
lines)))))
|
||||
|
||||
(defun emacs-edit-print-section (ast)
|
||||
"Prints :CONTENT: or description text."
|
||||
(let ((content (getf ast :content)))
|
||||
(when content
|
||||
content)))
|
||||
|
||||
(defun emacs-edit-ast-to-org (ast &key (indent-level 1))
|
||||
"Recursively converts an entire org AST back to org text.
|
||||
Preserves structure including #+begin_src blocks."
|
||||
(let ((type (getf ast :type))
|
||||
(props (getf ast :properties))
|
||||
(contents (getf ast :contents))
|
||||
(elements (getf ast :elements)))
|
||||
|
||||
(cond
|
||||
;; Headline
|
||||
((eq type :headline)
|
||||
(format nil "~%~a~a~%~a~{~a~}"
|
||||
(emacs-edit-print-headline ast :indent-level indent-level)
|
||||
(emacs-edit-print-properties props)
|
||||
(emacs-edit-print-section ast)
|
||||
(mapcar (lambda (child)
|
||||
(emacs-edit-ast-to-org child :indent-level (1+ indent-level)))
|
||||
(or contents elements))))
|
||||
|
||||
;; Section (body text)
|
||||
((eq type :section)
|
||||
(emacs-edit-print-section ast))
|
||||
|
||||
;; Plain text / paragraph
|
||||
((or (eq type :paragraph) (stringp ast))
|
||||
(format nil "~a~%" (if (stringp ast) ast (getf ast :raw-content))))
|
||||
|
||||
;; Code block (preserve exactly)
|
||||
((eq type :src-block)
|
||||
(let ((lang (or (getf ast :language) ""))
|
||||
(code (or (getf ast :value) "")))
|
||||
(format nil "#+begin_src ~a~%~a~#+end_src~%"
|
||||
lang code)))
|
||||
|
||||
;; Unknown - return as-is
|
||||
(t (format nil "")))))
|
||||
#+end_src
|
||||
|
||||
** Read Operation
|
||||
Parse org file to AST.
|
||||
|
||||
#+begin_src lisp :tangle ../library/gen/org-skill-emacs-edit.lisp
|
||||
(defvar *org-parser-cache* (make-hash-table :test 'equal)
|
||||
"Cache for parsed org files.")
|
||||
|
||||
(defun emacs-edit-parse-file (file-path)
|
||||
"Parses an org FILE-PATH using existing ingest-ast.
|
||||
Returns the parsed AST. Uses cache for performance."
|
||||
(let ((cached (gethash file-path *org-parser-cache*)))
|
||||
(when cached
|
||||
(return-from emacs-edit-parse-file cached)))
|
||||
|
||||
(let* ((content (uiop:read-file-string file-path))
|
||||
(ast (ingest-ast (list :type :document :raw-content content))))
|
||||
(setf (gethash file-path *org-parser-cache*) ast)
|
||||
ast))
|
||||
|
||||
(defun emacs-edit-clear-cache (&optional file-path)
|
||||
"Clears the parser cache. If FILE-PATH provided, clears only that entry."
|
||||
(if file-path
|
||||
(remhash file-path *org-parser-cache*)
|
||||
(clrhash *org-parser-cache*)))
|
||||
#+end_src
|
||||
|
||||
** Write Operation
|
||||
Write AST back to file preserving structure.
|
||||
|
||||
#+begin_src lisp :tangle ../library/gen/org-skill-emacs-edit.lisp
|
||||
(defun emacs-edit-write-file (file-path ast)
|
||||
"Writes AST back to FILE-PATH, preserving org structure.
|
||||
Clears cache after write."
|
||||
(let ((org-text (emacs-edit-ast-to-org ast)))
|
||||
(with-open-file (out file-path :direction :output :if-exists :supersede)
|
||||
(write-string org-text out)))
|
||||
(emacs-edit-clear-cache file-path)
|
||||
(harness-log "EMACS-EDIT: Wrote ~a" file-path))
|
||||
#+end_src
|
||||
|
||||
** Add Headline Operation
|
||||
Add a new headline to an existing AST.
|
||||
|
||||
#+begin_src lisp :tangle ../library/gen/org-skill-emacs-edit.lisp
|
||||
(defun emacs-edit-add-headline (ast title &key todo properties)
|
||||
"Adds a new headline to AST.
|
||||
Returns modified AST."
|
||||
(let ((new-id (emacs-edit-generate-id))
|
||||
(new-props (list :ID new-id
|
||||
:TITLE title
|
||||
:TODO (or todo "TODO")
|
||||
:CREATED (format nil "[~a]"
|
||||
(multiple-value-bind (s mi h d mo y)
|
||||
(decode-universal-time (get-universal-time))
|
||||
(format nil "~a-~a-~a ~a:~a"
|
||||
y mo d h mi))))))
|
||||
(merged-props (loop for (k v) on properties by #'cddr
|
||||
collect k collect v)))
|
||||
|
||||
(setf merged-props (append merged-props new-props))
|
||||
|
||||
(let ((new-headline (list :type :headline
|
||||
:properties merged-props
|
||||
:contents nil
|
||||
:raw-content title)))
|
||||
(push new-headline (getf ast :contents))
|
||||
ast)))
|
||||
#+end_src
|
||||
|
||||
** Set Property Operation
|
||||
Set a property on an existing headline (by ID or TITLE).
|
||||
|
||||
#+begin_src lisp :tangle ../library/gen/org-skill-emacs-edit.lisp
|
||||
(defun emacs-edit-find-headline-by-id (ast target-id)
|
||||
"Recursively finds headline with matching :ID: property."
|
||||
(when (eq (getf ast :type) :headline)
|
||||
(let ((props (getf ast :properties)))
|
||||
(when (string= (getf props :ID) target-id)
|
||||
(return-from emacs-edit-find-headline-by-id ast))))
|
||||
|
||||
(let ((contents (getf ast :contents)))
|
||||
(when contents
|
||||
(dolist (child contents)
|
||||
(let ((found (emacs-edit-find-headline-by-id child target-id)))
|
||||
(when found (return-from emacs-edit-find-headline-by-id found))))))
|
||||
nil)
|
||||
|
||||
(defun emacs-edit-find-headline-by-title (ast target-title)
|
||||
"Recursively finds headline with matching title."
|
||||
(when (eq (getf ast :type) :headline)
|
||||
(let ((props (getf ast :properties)))
|
||||
(when (string= (getf props :TITLE) target-title)
|
||||
(return-from emacs-edit-find-headline-by-title ast))))
|
||||
|
||||
(let ((contents (getf ast :contents)))
|
||||
(when contents
|
||||
(dolist (child contents)
|
||||
(let ((found (emacs-edit-find-headline-by-title child target-title)))
|
||||
(when found (return-from emacs-edit-find-headline-by-title found))))))
|
||||
nil)
|
||||
|
||||
(defun emacs-edit-set-property (ast target property value)
|
||||
"Sets PROPERTY=VALUE on headline matching TARGET (ID or title).
|
||||
Returns modified AST."
|
||||
(let ((headline (if (search "id:" target)
|
||||
(emacs-edit-find-headline-by-id ast target)
|
||||
(emacs-edit-find-headline-by-title ast target))))
|
||||
(when headline
|
||||
(setf (getf (getf headline :properties) property) value)
|
||||
(harness-log "EMACS-EDIT: Set ~a=~a on ~a" property value target)))
|
||||
ast)
|
||||
#+end_src
|
||||
|
||||
** Set TODO State Operation
|
||||
Change TODO state (TODO → DONE → etc).
|
||||
|
||||
#+begin_src lisp :tangle ../library/gen/org-skill-emacs-edit.lisp
|
||||
(defun emacs-edit-set-todo (ast target new-state)
|
||||
"Sets TODO state on headline matching TARGET.
|
||||
NEW-STATE should be 'TODO', 'DONE', 'IN-PROGRESS', etc."
|
||||
(emacs-edit-set-property ast target :TODO new-state)
|
||||
(harness-log "EMACS-EDIT: Set TODO to ~a on ~a" new-state target))
|
||||
#+end_src
|
||||
|
||||
** Unified Entry Point
|
||||
Main operation dispatcher.
|
||||
|
||||
#+begin_src lisp :tangle ../library/gen/org-skill-emacs-edit.lisp
|
||||
(defun emacs-edit-modify (file-path operation &key params)
|
||||
"Main entry point for org-mode file manipulation.
|
||||
OPERATIONS:
|
||||
:read - Parse file to AST, return AST
|
||||
:write - Write AST back to file (AST in params)
|
||||
:add-headline - Add headline (params: :title, :todo, :properties)
|
||||
:set-property - Set property (params: :target, :property, :value)
|
||||
:set-todo - Set TODO (params: :target, :state)"
|
||||
(let ((ast (emacs-edit-parse-file file-path)))
|
||||
|
||||
(case operation
|
||||
(:read
|
||||
ast)
|
||||
|
||||
(:write
|
||||
(let ((ast-to-write (getf params :ast)))
|
||||
(emacs-edit-write-file file-path ast-to-write)))
|
||||
|
||||
(:add-headline
|
||||
(let ((title (getf params :title))
|
||||
(todo (getf params :todo))
|
||||
(properties (getf params :properties)))
|
||||
(emacs-edit-add-headline ast title :todo todo :properties properties)))
|
||||
|
||||
(:set-property
|
||||
(let ((target (getf params :target))
|
||||
(property (getf params :property))
|
||||
(value (getf params :value)))
|
||||
(emacs-edit-set-property ast target property value)))
|
||||
|
||||
(:set-todo
|
||||
(let ((target (getf params :target))
|
||||
(state (getf params :state)))
|
||||
(emacs-edit-set-todo ast target state)))
|
||||
|
||||
(t
|
||||
(harness-log "EMACS-EDIT ERROR: Unknown operation ~a" operation)))))
|
||||
#+end_src
|
||||
|
||||
** Cognitive Tools
|
||||
Exposes operations to the Probabilistic Engine.
|
||||
|
||||
#+begin_src lisp :tangle ../library/gen/org-skill-emacs-edit.lisp
|
||||
(def-cognitive-tool :org-read
|
||||
"Reads an org-mode file and parses it to structured AST.
|
||||
Use this BEFORE modifying org files to understand their structure."
|
||||
((:file :type :string :description "Path to the org file"))
|
||||
:body (lambda (args)
|
||||
(let ((file (getf args :file)))
|
||||
(if (uiop:file-exists-p file)
|
||||
(emacs-edit-modify file :read)
|
||||
(list :status :error :reason "File not found")))))
|
||||
|
||||
(def-cognitive-tool :org-write
|
||||
"Writes previously parsed AST back to an org file.
|
||||
Use this AFTER modifications to save changes."
|
||||
((:file :type :string :description "Path to the org file")
|
||||
(:ast :type :list :description "The AST to write"))
|
||||
:body (lambda (args)
|
||||
(let ((file (getf args :file))
|
||||
(ast (getf args :ast)))
|
||||
(emacs-edit-modify file :write :params (list :ast ast))
|
||||
(list :status :success :message (format nil "Wrote ~a" file)))))
|
||||
|
||||
(def-cognitive-tool :org-add-headline
|
||||
"Adds a new headline to an org file."
|
||||
((:file :type :string :description "Path to the org file")
|
||||
(:title :type :string :description "Headline title")
|
||||
(:todo :type :string :description "TODO state (default TODO)")
|
||||
(:properties :type :list :description "Plist of properties"))
|
||||
:body (lambda (args)
|
||||
(let ((file (getf args :file))
|
||||
(title (getf args :title))
|
||||
(todo (getf args :todo "TODO"))
|
||||
(properties (getf args :properties)))
|
||||
(emacs-edit-modify file :add-headline
|
||||
:params (list :title title :todo todo :properties properties))
|
||||
(list :status :success :message (format nil "Added headline: ~a" title)))))
|
||||
|
||||
(def-cognitive-tool :org-set-property
|
||||
"Sets a property on an existing headline (by ID or title)."
|
||||
((:file :type :string :description "Path to the org file")
|
||||
(:target :type :string :description "Headline ID or title")
|
||||
(:property :type :string :description "Property name")
|
||||
(:value :type :string :description "Property value"))
|
||||
:body (lambda (args)
|
||||
(let ((file (getf args :file))
|
||||
(target (getf args :target))
|
||||
(property (getf args :property))
|
||||
(value (getf args :value)))
|
||||
(emacs-edit-modify file :set-property
|
||||
:params (list :target target :property property :value value))
|
||||
(list :status :success :message (format nil "Set ~a=~a on ~a" property value target)))))
|
||||
|
||||
(def-cognitive-tool :org-set-todo
|
||||
"Sets the TODO state of a headline."
|
||||
((:file :type :string :description "Path to the org file")
|
||||
(:target :type :string :description "Headline ID or title")
|
||||
(:state :type :string :description "New TODO state (TODO, DONE, etc)"))
|
||||
:body (lambda (args)
|
||||
(let ((file (getf args :file))
|
||||
(target (getf args :target))
|
||||
(state (getf args :state)))
|
||||
(emacs-edit-modify file :set-todo
|
||||
:params (list :target target :state state))
|
||||
(list :status :success :message (format nil "Set ~a to ~a" target state)))))
|
||||
#+end_src
|
||||
|
||||
* Phase E: Chaos (Verification)
|
||||
#+begin_src lisp :tangle ../tests/emacs-edit-tests.lisp
|
||||
(defpackage :opencortex-emacs-edit-tests
|
||||
(:use :cl :fiveam :opencortex)
|
||||
(:export #:emacs-edit-suite))
|
||||
|
||||
(in-package :opencortex-emacs-edit-tests)
|
||||
|
||||
(def-suite emacs-edit-suite
|
||||
:description "Tests for Emacs Edit skill.")
|
||||
|
||||
(in-suite emacs-edit-suite)
|
||||
|
||||
(test id-generation
|
||||
(let ((id1 (emacs-edit-generate-id))
|
||||
(id2 (emacs-edit-generate-id)))
|
||||
(is (plusp (length id1)))
|
||||
(is (not (string= id1 id2)))) ;; Likely unique
|
||||
|
||||
(test id-format
|
||||
(let ((formatted (emacs-edit-id-format "abc12345")))
|
||||
(is (search "id:" formatted))))
|
||||
|
||||
(test property-setter
|
||||
(let ((ast (list :type :headline
|
||||
:properties (list :ID "id:test123" :TITLE "Test")
|
||||
:contents nil)))
|
||||
(emacs-edit-set-property ast "id:test123" :STATUS "ACTIVE")
|
||||
(is (string= (getf (getf ast :properties) :STATUS) "ACTIVE"))))
|
||||
|
||||
(test todo-setter
|
||||
(let ((ast (list :type :headline
|
||||
:properties (list :ID "id:todo001" :TITLE "Task")
|
||||
:contents nil)))
|
||||
(emacs-edit-set-todo ast "id:todo001" "DONE")
|
||||
(is (string= (getf (getf ast :properties) :TODO) "DONE"))))
|
||||
#+end_src
|
||||
|
||||
* See Also
|
||||
- [[file:org-skill-lisp-utils.org][Lisp Utils]] - Validation and repair
|
||||
- [[file:org-skill-self-fix.org][Self-Fix]] - File modification with rollback
|
||||
96
skills/org-skill-engineering-standards.org
Normal file
96
skills/org-skill-engineering-standards.org
Normal file
@@ -0,0 +1,96 @@
|
||||
:PROPERTIES:
|
||||
:ID: 37f2b59f-4537-4cca-ac7f-5c24b9e2e773
|
||||
:CREATED: [2026-03-30 Mon 21:16]
|
||||
:EDITED: [2026-04-12 Sun 18:45]
|
||||
:END:
|
||||
#+TITLE: SKILL: Engineering Standards
|
||||
#+STARTUP: content
|
||||
#+FILETAGS: :engineering:standards:workflow:lisp:git:tdd:
|
||||
|
||||
* Overview
|
||||
These are the strict **Engineering Standards** for all development within this system. They ensure that every line of code is provably correct, auditable, and maintainable.
|
||||
|
||||
This skill acts as a policy advisor - it observes the context and provides warnings to the agent when engineering standards are violated. The agent (LLM) is responsible for self-regulating per AGENTS.md.
|
||||
|
||||
* The Mandates (Operational Standards)
|
||||
|
||||
** 1. Commit Before Modify
|
||||
You MUST commit and push the current state of the workspace BEFORE initiating any new file modifications. This ensures a clean recovery point.
|
||||
|
||||
** 2. Literate Programming (The Single Source of Truth)
|
||||
All system logic and skills MUST be implemented as Literate Org files. Weaving documentation and code together ensures that the "Why" (Architectural Intent) is never separated from the "How" (Implementation).
|
||||
|
||||
** 3. Literate Granularity (The Function-Block Rule)
|
||||
Every Lisp function, macro, or variable MUST reside in its own dedicated `#+begin_src lisp` block, immediately preceded by its literate explanatory text.
|
||||
|
||||
** 4. Test-Driven Development (Continuous QA)
|
||||
No change is complete without verification. Every new function or macro must be accompanied by a FiveAM test case. Run the test suite and verify success before considering a task complete.
|
||||
|
||||
** 5. The Consensus Loop (Plan Mode)
|
||||
Major architectural shifts or complex refactors require a formal implementation plan. Enter Plan Mode, draft a Blueprint (PROTOCOL), and seek formal approval before execution.
|
||||
|
||||
** 6. Stop-and-Wait (Turn-Yielding)
|
||||
You are forbidden from drafting a plan or requesting approval in the same turn that you propose a strategy. You MUST propose your strategy in plain text, explicitly state "Waiting for user feedback," and yield the turn.
|
||||
|
||||
** 7. GTD Synchronization (Roadmap Integrity)
|
||||
You are forbidden from considering a task complete without updating `gtd.org`. Record all major architectural shifts, feature implementations, or refactors in the project roadmap. When updating `gtd.org`, use hierarchical sub-TODO headlines, NOT checkboxes.
|
||||
|
||||
** 8. Configuration Externalization (Environment-Driven)
|
||||
Source code MUST be free of hardcoded configuration values. All such values must be extracted to the environment and documented in `.env.example`.
|
||||
|
||||
** 9. Literate-Only Modification (The Tangle Mandate)
|
||||
You are forbidden from modifying generated source code files directly. All changes MUST be made in the Literate Org file and then tangled.
|
||||
|
||||
** 10. Test-First Methodology (Design Before Code)
|
||||
Before implementing any fix or feature:
|
||||
1. Design the test/success criteria first - define what "works" means
|
||||
2. Run chaos/edge-case testing - try to break the design
|
||||
3. Only then implement the solution
|
||||
|
||||
** 11. Org as Thinking Medium (Investigation in Prose)
|
||||
When debugging or analyzing issues:
|
||||
1. Document your investigation in the relevant org file BEFORE implementing a fix
|
||||
2. Record: root cause hypothesis, evidence found, tradeoffs considered
|
||||
The org file IS the design document - code is just the implementation.
|
||||
|
||||
** 12. Engineering Decision Audit Trail
|
||||
Every significant fix or architectural decision MUST be documented with:
|
||||
- Root cause analysis
|
||||
- Options considered and tradeoffs
|
||||
- Why this solution was chosen
|
||||
|
||||
* Phase D: Build (Implementation)
|
||||
|
||||
** Git Status Check
|
||||
#+begin_src lisp :tangle ../library/gen/org-skill-engineering-standards.lisp
|
||||
(in-package :opencortex)
|
||||
#+end_src
|
||||
|
||||
#+begin_src lisp :tangle ../library/gen/org-skill-engineering-standards.lisp
|
||||
(defun verify-git-clean-p (&optional (dir *project-root*))
|
||||
"Returns T if the git repository at DIR has no uncommitted changes."
|
||||
(let ((status (uiop:run-program (list "git" "-C" (namestring dir) "status" "--porcelain")
|
||||
:output :string
|
||||
:ignore-error-status t)))
|
||||
(string= "" (string-trim '(#\Space #\Newline #\Tab) status))))
|
||||
#+end_src
|
||||
|
||||
** Skill Definition
|
||||
This skill observes context and provides warnings when engineering standards are violated.
|
||||
|
||||
#+begin_src lisp :tangle ../library/gen/org-skill-engineering-standards.lisp
|
||||
(defskill :skill-engineering-standards
|
||||
:priority 1000
|
||||
:trigger (lambda (ctx) t)
|
||||
:probabilistic nil
|
||||
:deterministic (lambda (action context)
|
||||
(declare (ignore action))
|
||||
(let ((dirty (verify-git-clean-p)))
|
||||
(unless dirty
|
||||
(harness-log "ENGINEERING STANDARDS: Warning - Working tree is dirty. Commit before modifying files.")))
|
||||
nil))
|
||||
#+end_src
|
||||
|
||||
* See Also
|
||||
- [[file:../README.org][opencortex README]]
|
||||
- [[~/.opencode/AGENTS.md][Agent Mandate]]
|
||||
473
skills/org-skill-lisp-utils.org
Normal file
473
skills/org-skill-lisp-utils.org
Normal file
@@ -0,0 +1,473 @@
|
||||
:PROPERTIES:
|
||||
:ID: lisp-utils-skill
|
||||
:CREATED: [2026-04-23 Thu]
|
||||
:END:
|
||||
#+TITLE: SKILL: Lisp Utils (Utilities + Repair + Validation)
|
||||
#+STARTUP: content
|
||||
#+FILETAGS: :system:lisp:utilities:repair:validation:autonomy:
|
||||
|
||||
* Overview
|
||||
The *Lisp Utils* skill provides general-purpose Lisp utilities for the entire system. It combines:
|
||||
- Character/string utilities (count-char, etc.)
|
||||
- Syntax repair (deterministic + neural)
|
||||
- Structural validation (paren balance)
|
||||
- Syntactic validation (reader check)
|
||||
- Semantic validation (whitelist AST walk)
|
||||
|
||||
This is a general utility skill - not exclusive to self-editing. Used by:
|
||||
- The agent to fix syntax errors (self-edit use case)
|
||||
- The validation gate before executing Lisp
|
||||
- Any skill needing string/character manipulation
|
||||
|
||||
* Phase A: Demand (PRD)
|
||||
:PROPERTIES:
|
||||
:STATUS: SIGNED
|
||||
:END:
|
||||
|
||||
** 1. Purpose
|
||||
Provide a unified utility library for Lisp code manipulation and validation.
|
||||
|
||||
** 2. User Needs
|
||||
- Character counting utilities (general purpose)
|
||||
- Deterministic syntax repair (auto-balance parens)
|
||||
- Neural syntax repair (LLM-powered deep fix)
|
||||
- Structural validation (balanced parens without reader)
|
||||
- Syntactic validation (reader check)
|
||||
- Semantic validation (whitelist enforcement)
|
||||
|
||||
** 3. Success Criteria
|
||||
- [X] `count-char` works for any character
|
||||
- [X] `deterministic-repair` balances parentheses
|
||||
- [X] `neural-repair` uses LLM for complex fixes
|
||||
- [X] Structural check runs in O(n) without reader
|
||||
- [X] Syntactic check catches malformed sexps
|
||||
- [X] Semantic check enforces whitelist
|
||||
|
||||
* Phase B: Blueprint (PROTOCOL)
|
||||
:PROPERTIES:
|
||||
:STATUS: SIGNED
|
||||
:END:
|
||||
|
||||
** 1. Architectural Intent
|
||||
Single entry point `lisp-utils-validate` runs three sequential checks.
|
||||
Separate repair functions that can be called independently.
|
||||
|
||||
** 2. Semantic Interfaces
|
||||
- `(count-char char string)` → integer
|
||||
- `(deterministic-repair code-string)` → fixed string
|
||||
- `(neural-repair code-string error-msg)` → fixed string
|
||||
- `(lisp-utils-validate code-string &key strict)` → plist
|
||||
|
||||
* Phase D: Build (Implementation)
|
||||
|
||||
** Package Context
|
||||
#+begin_src lisp :tangle ../library/gen/org-skill-lisp-utils.lisp
|
||||
(in-package :opencortex)
|
||||
#+end_src
|
||||
|
||||
** Character & String Utilities
|
||||
General-purpose utilities for string manipulation.
|
||||
|
||||
#+begin_src lisp :tangle ../library/gen/org-skill-lisp-utils.lisp
|
||||
(defun count-char (char string)
|
||||
"Counts occurrences of CHAR in STRING.
|
||||
Returns an integer count."
|
||||
(let ((count 0))
|
||||
(loop for c across string
|
||||
when (char= c char)
|
||||
do (incf count))
|
||||
count))
|
||||
#+end_src
|
||||
|
||||
** Syntax Repair (Deterministic)
|
||||
Attempts instant fixes on broken Lisp code (e.g., balancing parens).
|
||||
This is the fast path - used for simple syntax errors.
|
||||
|
||||
#+begin_src lisp :tangle ../library/gen/org-skill-lisp-utils.lisp
|
||||
(defun deterministic-repair (code)
|
||||
"Attempts instant fixes on broken Lisp code (e.g., balancing parens).
|
||||
Returns the fixed code string."
|
||||
(let* ((open-parens (count-char #\( code))
|
||||
(close-parens (count-char #\) code))
|
||||
(diff (- open-parens close-parens)))
|
||||
(if (> diff 0)
|
||||
(concatenate 'string code (make-string diff :initial-element #\)))
|
||||
code)))
|
||||
#+end_src
|
||||
|
||||
** Syntax Repair (Neural)
|
||||
Uses the LLM to deeply repair syntax structure when deterministic fails.
|
||||
This is the slow path - used for complex errors.
|
||||
|
||||
#+begin_src lisp :tangle ../library/gen/org-skill-lisp-utils.lisp
|
||||
(defun neural-repair (code error-message)
|
||||
"Uses the Probabilistic Engine to deeply repair the syntax structure.
|
||||
Returns the fixed code string."
|
||||
(let ((prompt (format nil "The following Lisp code failed to parse.
|
||||
ERROR: ~a
|
||||
CODE: ~a
|
||||
MANDATE: Output EXACTLY ONE valid Common Lisp list. Do not explain. Do not use markdown blocks."
|
||||
error-message code))
|
||||
(system-prompt "You are a Lisp Syntax Repair Actuator. Return only valid, balanced Lisp code."))
|
||||
(let ((repaired (ask-probabilistic prompt :system-prompt system-prompt)))
|
||||
(string-trim '(#\Space #\Newline #\Tab) repaired))))
|
||||
#+end_src
|
||||
|
||||
** Check 1: Structural Validation (Paren Balance)
|
||||
Scans the raw string character-by-character, tracking open/close pairs.
|
||||
This is O(n) and does not invoke the Lisp reader.
|
||||
|
||||
#+begin_src lisp :tangle ../library/gen/org-skill-lisp-utils.lisp
|
||||
(defun lisp-utils-check-structural (code-string)
|
||||
"Checks for balanced parens, brackets, and terminated strings.
|
||||
Returns (VALUES t nil) if clean, or (VALUES nil reason-string line col)."
|
||||
(let ((stack nil)
|
||||
(in-string nil)
|
||||
(escaped nil)
|
||||
(line 1)
|
||||
(col 0)
|
||||
(last-open-line 1)
|
||||
(last-open-col 0))
|
||||
(dotimes (i (length code-string))
|
||||
(let ((ch (char code-string i)))
|
||||
(cond (escaped (setf escaped nil))
|
||||
((char= ch #\\) (setf escaped t))
|
||||
(in-string
|
||||
(when (char= ch #\") (setf in-string nil)))
|
||||
((char= ch #\;)
|
||||
(loop while (and (< i (1- (length code-string)))
|
||||
(not (char= (char code-string (1+ i)) #\Newline)))
|
||||
do (incf i))
|
||||
(incf line) (setf col 0))
|
||||
((char= ch #\")
|
||||
(setf in-string t))
|
||||
((member ch '(#\( #\[))
|
||||
(push (list (string ch) line col) stack)
|
||||
(setf last-open-line line last-open-col col))
|
||||
((char= ch #\))
|
||||
(cond ((null stack)
|
||||
(return-from lisp-utils-check-structural
|
||||
(values nil (format nil "Unexpected ')' at line ~a, col ~a" line col) line col)))
|
||||
((string= (caar stack) "[")
|
||||
(return-from lisp-utils-check-structural
|
||||
(values nil (format nil "Mismatched ']' expected at line ~a, col ~a" line col) line col)))
|
||||
(t (pop stack))))
|
||||
((char= ch #\])
|
||||
(cond ((null stack)
|
||||
(return-from lisp-utils-check-structural
|
||||
(values nil (format nil "Unexpected ']' at line ~a, col ~a" line col) line col)))
|
||||
((string= (caar stack) "(")
|
||||
(return-from lisp-utils-check-structural
|
||||
(values nil (format nil "Mismatched ')' expected at line ~a, col ~a" line col) line col)))
|
||||
(t (pop stack))))
|
||||
((char= ch #\Newline)
|
||||
(incf line) (setf col 0))))
|
||||
(unless (char= ch #\Newline) (incf col))))
|
||||
(if (null stack)
|
||||
(values t nil nil nil)
|
||||
(values nil (format nil "Unbalanced '~a' opened at line ~a, col ~a"
|
||||
(caar stack) last-open-line last-open-col)
|
||||
last-open-line last-open-col))))
|
||||
#+end_src
|
||||
|
||||
** Check 2: Syntactic Validation (Reader Check)
|
||||
Wraps the code and attempts to read with *read-eval* disabled.
|
||||
|
||||
#+begin_src lisp :tangle ../library/gen/org-skill-lisp-utils.lisp
|
||||
(defun lisp-utils-check-syntactic (code-string)
|
||||
"Checks if the code can be read by SBCL with *read-eval* nil.
|
||||
Returns (VALUES t nil) if clean, or (VALUES nil error-message nil nil)."
|
||||
(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 nil nil))
|
||||
(error (c)
|
||||
(let ((msg (format nil "~a" c)))
|
||||
(values nil msg nil nil)))))
|
||||
#+end_src
|
||||
|
||||
** Check 3: Semantic Validation (Whitelist AST Walk)
|
||||
Recursively walks the parsed AST and verifies whitelisted symbols.
|
||||
|
||||
#+begin_src lisp :tangle ../library/gen/org-skill-lisp-utils.lisp
|
||||
(defparameter *lisp-utils-whitelist*
|
||||
'(;; Math & Logic
|
||||
+ - * / = < > <= >= 1+ 1- min max mod abs floor ceiling round
|
||||
and or not null eq eql equal string= string-equal char= char-equal
|
||||
;; List Manipulation
|
||||
list cons car cdr cadr cddr cdar caar caddr cdddr append mapcar remove-if remove-if-not
|
||||
length reverse sort nth nthcdr push pop last butlast subseq
|
||||
;; Plists, Alists, and Hash Tables
|
||||
getf gethash assoc acons pairlis rassoc
|
||||
;; Control Flow
|
||||
let let* if cond when unless case typecase prog1 progn
|
||||
;; Strings
|
||||
format concatenate string-downcase string-upcase search subseq replace
|
||||
;; Type predicates
|
||||
stringp numberp integerp listp symbolp keywordp null
|
||||
;; Kernel safe symbols
|
||||
opencortex::harness-log
|
||||
opencortex::snapshot-memory opencortex::rollback-memory
|
||||
opencortex::lookup-object opencortex::list-objects-by-type
|
||||
opencortex::ingest-ast opencortex::find-headline-missing-id
|
||||
opencortex::context-query-store opencortex::context-get-active-projects
|
||||
opencortex::context-get-recent-completed-tasks opencortex::context-list-all-skills
|
||||
opencortex::context-get-system-logs opencortex::context-assemble-global-awareness
|
||||
opencortex::org-object-id opencortex::org-object-type opencortex::org-object-attributes
|
||||
opencortex::org-object-content opencortex::org-object-parent-id
|
||||
opencortex::org-object-children opencortex::org-object-version
|
||||
opencortex::org-object-last-sync opencortex::org-object-hash
|
||||
opencortex::org-object-vector
|
||||
;; Essential macros and special operators
|
||||
declare ignore quote function lambda defun defvar defparameter defmacro
|
||||
;; Safe I/O
|
||||
with-open-file write-string read-line
|
||||
;; Package introspection
|
||||
find-package make-package in-package do-external-symbols find-symbol
|
||||
;; Safe system interaction
|
||||
uiop:run-program uiop:getenv uiop:merge-pathnames* uiop:file-exists-p
|
||||
uiop:directory-exists-p uiop:read-file-string uiop:split-string
|
||||
;; Time
|
||||
get-universal-time get-internal-real-time sleep
|
||||
;; Equality
|
||||
equalp = equal eq eql))
|
||||
"Static whitelist of symbols permitted in the Lisp Utils sandbox.")
|
||||
|
||||
(defun lisp-utils-ast-walk (form)
|
||||
"Recursively walks the Lisp AST. Returns T if safe, NIL if unsafe."
|
||||
(cond
|
||||
((or (stringp form) (numberp form) (keywordp form) (characterp form)) t)
|
||||
((symbolp form)
|
||||
(or (member form *lisp-utils-whitelist* :test #'string-equal)
|
||||
(member (format nil "~a" form) *lisp-utils-whitelist* :test #'string-equal)))
|
||||
((listp form)
|
||||
(let ((head (car form)))
|
||||
(cond
|
||||
((eq head 'quote) t)
|
||||
((not (symbolp head)) nil)
|
||||
((member head *lisp-utils-whitelist* :test #'string-equal)
|
||||
(every #'lisp-utils-ast-walk (cdr form)))
|
||||
(t
|
||||
(harness-log "LISP UTILS: Blocked call to non-whitelisted function ~a" head)
|
||||
nil))))
|
||||
(t nil)))
|
||||
|
||||
(defun lisp-utils-check-semantic (code-string)
|
||||
"Checks if all symbols in CODE-STRING are whitelisted.
|
||||
Returns (VALUES t nil) if clean, or (VALUES nil reason-string nil nil)."
|
||||
(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)
|
||||
do (unless (lisp-utils-ast-walk form)
|
||||
(return-from lisp-utils-check-semantic
|
||||
(values nil "Code contains non-whitelisted symbols." nil nil)))))
|
||||
(values t nil nil nil))
|
||||
(error (c)
|
||||
(values nil (format nil "Semantic check failed: ~a" c) nil nil))))
|
||||
#+end_src
|
||||
|
||||
** Unified Entry Point
|
||||
Orchestrates the three validation checks.
|
||||
|
||||
#+begin_src lisp :tangle ../library/gen/org-skill-lisp-utils.lisp
|
||||
(defun lisp-utils-validate (code-string &key strict)
|
||||
"Validates Lisp code through structural, syntactic, and optional semantic checks.
|
||||
Returns a plist:
|
||||
(:status :success :checks (:structural t :syntactic t :semantic t))
|
||||
or
|
||||
(:status :error :failed <check-key> :reason <string> :line <n> :col <n>)
|
||||
|
||||
When STRICT is non-nil, the semantic whitelist check is enforced."
|
||||
(let ((structural-ok nil) (syntactic-ok nil) (semantic-ok nil)
|
||||
(reason nil) (line nil) (col nil))
|
||||
;; Phase 1: Structural
|
||||
(multiple-value-setq (structural-ok reason line col)
|
||||
(lisp-utils-check-structural code-string))
|
||||
(unless structural-ok
|
||||
(return-from lisp-utils-validate
|
||||
(list :status :error :failed :structural :reason reason :line line :col col)))
|
||||
;; Phase 2: Syntactic
|
||||
(multiple-value-setq (syntactic-ok reason line col)
|
||||
(lisp-utils-check-syntactic code-string))
|
||||
(unless syntactic-ok
|
||||
(return-from lisp-utils-validate
|
||||
(list :status :error :failed :syntactic :reason reason :line line :col col)))
|
||||
;; Phase 3: Semantic (only when strict)
|
||||
(when strict
|
||||
(multiple-value-setq (semantic-ok reason line col)
|
||||
(lisp-utils-check-semantic code-string))
|
||||
(unless semantic-ok
|
||||
(return-from lisp-utils-validate
|
||||
(list :status :error :failed :semantic :reason reason :line line :col col))))
|
||||
;; All clear
|
||||
(list :status :success
|
||||
:checks (list :structural t :syntactic t :semantic (or (not strict) semantic-ok)))))
|
||||
#+end_src
|
||||
|
||||
** Cognitive Tools
|
||||
Exposes utilities to the Probabilistic Engine.
|
||||
|
||||
#+begin_src lisp :tangle ../library/gen/org-skill-lisp-utils.lisp
|
||||
(def-cognitive-tool :validate-lisp
|
||||
"Deterministically validates Lisp code for structural, syntactic, and semantic correctness.
|
||||
Use this BEFORE declaring any Lisp code edit complete."
|
||||
((:code :type :string :description "The Lisp code string to validate.")
|
||||
(:strict :type :boolean :description "If non-nil, enforces the semantic whitelist."))
|
||||
:body (lambda (args)
|
||||
(let ((code (getf args :code))
|
||||
(strict (getf args :strict)))
|
||||
(if (and code (stringp code))
|
||||
(lisp-utils-validate code :strict strict)
|
||||
(list :status :error :reason "Missing :code argument.")))))
|
||||
|
||||
(def-cognitive-tool :repair-lisp
|
||||
"Repairs broken Lisp code using deterministic first, then neural escalation."
|
||||
((:code :type :string :description "The broken Lisp code string")
|
||||
(:error :type :string :description "The error message from parsing failure"))
|
||||
:body (lambda (args)
|
||||
(let ((code (getf args :code))
|
||||
(error-msg (getf args :error)))
|
||||
(if (and code error-msg)
|
||||
(let ((fast-fix (deterministic-repair code)))
|
||||
(handler-case
|
||||
(let ((repaired (read-from-string fast-fix)))
|
||||
(format nil "~a" repaired))
|
||||
(error ()
|
||||
(let ((deep-fix (neural-repair code error-msg)))
|
||||
(handler-case
|
||||
(let ((repaired (read-from-string deep-fix)))
|
||||
(format nil "~a" repaired))
|
||||
(error ()
|
||||
"REPAIR FAILED"))))))
|
||||
(list :status :error :reason "Missing :code or :error argument.")))))
|
||||
#+end_src
|
||||
|
||||
** Skill Definition: Lisp Repair
|
||||
Intercepts :syntax-error events and repairs the code.
|
||||
|
||||
#+begin_src lisp :tangle ../library/gen/org-skill-lisp-utils.lisp
|
||||
(defskill :skill-lisp-repair
|
||||
:priority 90
|
||||
:trigger (lambda (ctx) (eq (getf (getf ctx :payload) :sensor) :syntax-error))
|
||||
:probabilistic nil
|
||||
:deterministic (lambda (action context)
|
||||
(declare (ignore action))
|
||||
(let* ((payload (getf context :payload))
|
||||
(code (getf payload :code))
|
||||
(error-msg (getf payload :error)))
|
||||
(harness-log "LISP REPAIR: Reacting to syntax error...")
|
||||
(let ((fast-fix (deterministic-repair code)))
|
||||
(handler-case
|
||||
(let ((repaired (read-from-string fast-fix)))
|
||||
(harness-log "LISP REPAIR: Deterministic repair SUCCESS.")
|
||||
repaired)
|
||||
(error ()
|
||||
(harness-log "LISP REPAIR: Deterministic failed. Escalating to neural...")
|
||||
(let ((deep-fix (neural-repair code error-msg)))
|
||||
(handler-case
|
||||
(let ((repaired (read-from-string deep-fix)))
|
||||
(harness-log "LISP REPAIR: Neural repair SUCCESS.")
|
||||
repaired)
|
||||
(error ()
|
||||
(harness-log "LISP REPAIR: Neural repair failed.")
|
||||
(list :type :LOG :payload (list :text "Lisp Repair Failed."))))))))))))
|
||||
#+end_src
|
||||
|
||||
** Skill Definition: Lisp Validator
|
||||
Validates all Lisp code before execution.
|
||||
|
||||
#+begin_src lisp :tangle ../library/gen/org-skill-lisp-utils.lisp
|
||||
(defskill :skill-lisp-validator
|
||||
:priority 900
|
||||
:trigger (lambda (ctx)
|
||||
(let ((candidate (getf ctx :approved-action)))
|
||||
(when candidate
|
||||
(let ((payload (getf candidate :payload)))
|
||||
(member (getf payload :action) '(:eval :shell))))))
|
||||
:probabilistic nil
|
||||
:deterministic (lambda (action context)
|
||||
(declare (ignore context))
|
||||
(let ((payload (getf action :payload)))
|
||||
(if (eq (getf payload :action) :eval)
|
||||
(let* ((code (getf payload :code))
|
||||
(result (lisp-utils-validate code :strict t)))
|
||||
(if (eq (getf result :status) :error)
|
||||
(progn
|
||||
(harness-log "LISP VALIDATOR: Blocked unsafe :eval action. ~a"
|
||||
(getf result :reason))
|
||||
(list :type :LOG
|
||||
:payload (list :level :error
|
||||
:text (format nil "LISP VALIDATOR: Blocked unsafe eval. ~a"
|
||||
(getf result :reason)))))
|
||||
action))
|
||||
action))))
|
||||
#+end_src
|
||||
|
||||
* Phase E: Chaos (Verification)
|
||||
#+begin_src lisp :tangle ../tests/lisp-utils-tests.lisp
|
||||
(defpackage :opencortex-lisp-utils-tests
|
||||
(:use :cl :fiveam :opencortex)
|
||||
(:export #:lisp-utils-suite))
|
||||
|
||||
(in-package :opencortex-lisp-utils-tests)
|
||||
|
||||
(def-suite lisp-utils-suite
|
||||
:description "Tests for the Lisp Utils skill.")
|
||||
|
||||
(in-suite lisp-utils-suite)
|
||||
|
||||
(test count-char-balanced
|
||||
(is (= (count-char #\( "(+ 1 2)") 1))
|
||||
(is (= (count-char #\) "(+ 1 2)") 1))
|
||||
|
||||
(test count-char-unbalanced
|
||||
(is (= (count-char #\( "(+ 1 2") 1))
|
||||
(is (= (count-char #\) "(+ 1 2") 0))
|
||||
|
||||
(test deterministic-repair-balanced
|
||||
(is (string= (deterministic-repair "(+ 1 2)") "(+ 1 2)")))
|
||||
|
||||
(test deterministic-repair-unbalanced
|
||||
(is (string= (deterministic-repair "(+ 1 2") "(+ 1 2)")))
|
||||
|
||||
(test structural-valid
|
||||
(multiple-value-bind (ok reason line col)
|
||||
(opencortex::lisp-utils-check-structural "(+ 1 2)")
|
||||
(is ok)))
|
||||
|
||||
(test structural-unbalanced
|
||||
(multiple-value-bind (ok reason line col)
|
||||
(opencortex::lisp-utils-check-structural "(+ 1 2")
|
||||
(is (not ok))
|
||||
(is (search "Unbalanced" reason))))
|
||||
|
||||
(test syntactic-valid
|
||||
(multiple-value-bind (ok reason line col)
|
||||
(opencortex::lisp-utils-check-syntactic "(+ 1 2)")
|
||||
(is ok)))
|
||||
|
||||
(test semantic-whitelist
|
||||
(multiple-value-bind (ok reason line col)
|
||||
(opencortex::lisp-utils-check-semantic "(+ 1 2)")
|
||||
(is ok)))
|
||||
|
||||
(test semantic-blocked
|
||||
(multiple-value-bind (ok reason line col)
|
||||
(opencortex::lisp-utils-check-semantic "(delete-file \"x.txt\")")
|
||||
(is (not ok))))
|
||||
|
||||
(test unified-success
|
||||
(let ((result (opencortex::lisp-utils-validate "(+ 1 2)" :strict t)))
|
||||
(is (eq (getf result :status) :success))))
|
||||
|
||||
(test unified-structural-fail
|
||||
(let ((result (opencortex::lisp-utils-validate "(+ 1 2" :strict nil)))
|
||||
(is (eq (getf result :status) :error))
|
||||
(is (eq (getf result :failed) :structural))))
|
||||
#+end_src
|
||||
|
||||
* See Also
|
||||
- [[file:org-skill-self-fix.org][Self-Fix Skill]] - File modification with memory rollback
|
||||
@@ -1,382 +0,0 @@
|
||||
:PROPERTIES:
|
||||
:ID: lisp-validator-skill
|
||||
:CREATED: [2026-04-22 Wed 12:15]
|
||||
:EDITED: [2026-04-22 Wed 12:15]
|
||||
:END:
|
||||
#+TITLE: SKILL: Lisp Validator (Structural & Semantic Gate)
|
||||
#+STARTUP: content
|
||||
#+FILETAGS: :security:lisp:ast:autonomy:modularity:
|
||||
|
||||
* Overview
|
||||
The *Lisp Validator* is the primary structural gate for the Probabilistic-Deterministic Lisp Machine. It eliminates the token-waste of probabilistic paren-balancing by providing a deterministic, three-phase validation pipeline: Structural, Syntactic, and Semantic. It is exposed as a cognitive tool so both the harness and the Probabilistic Engine can invoke it before declaring code complete.
|
||||
|
||||
* Phase A: Demand (PRD)
|
||||
:PROPERTIES:
|
||||
:STATUS: SIGNED
|
||||
:END:
|
||||
|
||||
** 1. Purpose
|
||||
Provide a deterministic, fast, and auditable validation gate for all Lisp code proposals.
|
||||
|
||||
** 2. User Needs
|
||||
- *Structural Validation:* Detect unbalanced parentheses, brackets, and unterminated strings without invoking the reader.
|
||||
- *Syntactic Validation:* Ensure the code can be read by SBCL with `*read-eval*` disabled.
|
||||
- *Semantic Validation:* Optionally enforce a whitelist of safe symbols for sandboxed execution.
|
||||
- *Tool Exposure:* The Probabilistic Engine must be able to call this as a cognitive tool.
|
||||
|
||||
** 3. Success Criteria
|
||||
- [X] Structural check runs in O(n) and catches all paren/string defects.
|
||||
- [X] Syntactic check catches reader errors and malformed sexps.
|
||||
- [X] Semantic check blocks non-whitelisted symbols when strict mode is enabled.
|
||||
- [X] Returns structured plist for machine parsing and human explanation.
|
||||
|
||||
* Phase B: Blueprint (PROTOCOL)
|
||||
:PROPERTIES:
|
||||
:STATUS: SIGNED
|
||||
:END:
|
||||
|
||||
** 1. Architectural Intent
|
||||
A single entry point, `lisp-validator-validate`, runs three sequential checks. Each check is isolated so a failure in one does not obscure failures in others. The function returns a unified result plist.
|
||||
|
||||
** 2. Semantic Interfaces
|
||||
- `(lisp-validator-validate code-string &key strict)` → plist
|
||||
- Tool `:validate-lisp` with args `(:code "..." :strict t/nil)`
|
||||
|
||||
* Phase D: Build (Implementation)
|
||||
|
||||
** Package Context
|
||||
#+begin_src lisp :tangle ../library/gen/org-skill-lisp-validator.lisp
|
||||
(in-package :opencortex)
|
||||
#+end_src
|
||||
|
||||
** Check 1: Structural Validation (Paren Balance)
|
||||
Scans the raw string character-by-character, tracking open/close pairs for `()`, `[]`, `#()`, and string delimiters `"`. Ignores escaped characters and line comments (`;`). This is O(n) and does not invoke the Lisp reader.
|
||||
|
||||
#+begin_src lisp :tangle ../library/gen/org-skill-lisp-validator.lisp
|
||||
(defun lisp-validator-check-structural (code-string)
|
||||
"Checks for balanced parens, brackets, and terminated strings.
|
||||
Returns (VALUES t nil) if clean, or (VALUES nil reason-string line col)."
|
||||
(let ((stack nil)
|
||||
(in-string nil)
|
||||
(escaped nil)
|
||||
(line 1)
|
||||
(col 0)
|
||||
(last-open-line 1)
|
||||
(last-open-col 0))
|
||||
(dotimes (i (length code-string)
|
||||
(if (null stack)
|
||||
(values t nil nil nil)
|
||||
(values nil (format nil "Unbalanced '~a' opened at line ~a, col ~a"
|
||||
(caar stack) last-open-line last-open-col)
|
||||
last-open-line last-open-col)))
|
||||
(let ((ch (char code-string i)))
|
||||
(cond (escaped (setf escaped nil))
|
||||
((char= ch #\\) (setf escaped t))
|
||||
(in-string
|
||||
(when (char= ch #\") (setf in-string nil)))
|
||||
((char= ch #\;)
|
||||
;; Skip to end of line
|
||||
(loop while (and (< i (1- (length code-string)))
|
||||
(not (char= (char code-string (1+ i)) #\Newline)))
|
||||
do (incf i))
|
||||
(incf line) (setf col 0))
|
||||
((char= ch #\")
|
||||
(setf in-string t))
|
||||
((member ch '(#\( #\[))
|
||||
(push (list (string ch) line col) stack)
|
||||
(setf last-open-line line last-open-col col))
|
||||
((char= ch #\))
|
||||
(cond ((null stack)
|
||||
(return-from lisp-validator-check-structural
|
||||
(values nil (format nil "Unexpected ')' at line ~a, col ~a" line col) line col)))
|
||||
((string= (caar stack) "[")
|
||||
(return-from lisp-validator-check-structural
|
||||
(values nil (format nil "Mismatched ']' expected at line ~a, col ~a" line col) line col)))
|
||||
(t (pop stack))))
|
||||
((char= ch #\])
|
||||
(cond ((null stack)
|
||||
(return-from lisp-validator-check-structural
|
||||
(values nil (format nil "Unexpected ']' at line ~a, col ~a" line col) line col)))
|
||||
((string= (caar stack) "(")
|
||||
(return-from lisp-validator-check-structural
|
||||
(values nil (format nil "Mismatched ')' expected at line ~a, col ~a" line col) line col)))
|
||||
(t (pop stack))))
|
||||
((char= ch #\Newline)
|
||||
(incf line) (setf col 0)))
|
||||
(unless (char= ch #\Newline) (incf col))))))
|
||||
#+end_src
|
||||
|
||||
** Check 2: Syntactic Validation (Reader Check)
|
||||
Wraps the code in `(progn ...)` and attempts to read every top-level form with `*read-eval*` disabled. Catches reader errors, invalid syntax, and malformed sexps that the structural check cannot detect (e.g., invalid reader macros).
|
||||
|
||||
#+begin_src lisp :tangle ../library/gen/org-skill-lisp-validator.lisp
|
||||
(defun lisp-validator-check-syntactic (code-string)
|
||||
"Checks if the code can be read by SBCL with *read-eval* nil.
|
||||
Returns (VALUES t nil) if clean, or (VALUES nil error-message line col)."
|
||||
(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 nil nil))
|
||||
(error (c)
|
||||
(let ((msg (format nil "~a" c)))
|
||||
(values nil msg nil nil)))))
|
||||
#+end_src
|
||||
|
||||
** Check 3: Semantic Validation (Whitelist AST Walk)
|
||||
Recursively walks the parsed AST and verifies that every function call and symbol reference appears on a whitelist. This is the "Deny-by-Default" sandbox. When `strict` is nil, this check is skipped for general validation (e.g., skill loading) but enforced for `:eval` tool execution.
|
||||
|
||||
#+begin_src lisp :tangle ../library/gen/org-skill-lisp-validator.lisp
|
||||
(defparameter *lisp-validator-whitelist*
|
||||
'(;; Math & Logic
|
||||
+ - * / = < > <= >= 1+ 1- min max mod abs floor ceiling round
|
||||
and or not null eq eql equal string= string-equal char= char-equal
|
||||
;; List Manipulation
|
||||
list cons car cdr cadr cddr cdar caar caddr cdddr append mapcar remove-if remove-if-not
|
||||
length reverse sort nth nthcdr push pop last butlast subseq
|
||||
;; Plists, Alists, and Hash Tables
|
||||
getf gethash assoc acons pairlis rassoc
|
||||
;; Control Flow
|
||||
let let* if cond when unless case typecase prog1 progn
|
||||
;; Strings
|
||||
format concatenate string-downcase string-upcase search subseq replace
|
||||
;; Type predicates
|
||||
stringp numberp integerp listp symbolp keywordp null
|
||||
;; Kernel safe symbols
|
||||
opencortex::harness-log
|
||||
opencortex::snapshot-memory opencortex::rollback-memory
|
||||
opencortex::lookup-object opencortex::list-objects-by-type
|
||||
opencortex::ingest-ast opencortex::find-headline-missing-id
|
||||
opencortex::context-query-store opencortex::context-get-active-projects
|
||||
opencortex::context-get-recent-completed-tasks opencortex::context-list-all-skills
|
||||
opencortex::context-get-system-logs opencortex::context-assemble-global-awareness
|
||||
opencortex::org-object-id opencortex::org-object-type opencortex::org-object-attributes
|
||||
opencortex::org-object-content opencortex::org-object-parent-id
|
||||
opencortex::org-object-children opencortex::org-object-version
|
||||
opencortex::org-object-last-sync opencortex::org-object-hash
|
||||
opencortex::org-object-vector
|
||||
;; Essential macros and special operators
|
||||
declare ignore quote function lambda defun defvar defparameter defmacro
|
||||
;; Safe I/O
|
||||
with-open-file write-string read-line
|
||||
;; Package introspection
|
||||
find-package make-package in-package do-external-symbols find-symbol
|
||||
;; Safe system interaction
|
||||
uiop:run-program uiop:getenv uiop:merge-pathnames* uiop:file-exists-p
|
||||
uiop:directory-exists-p uiop:read-file-string uiop:split-string
|
||||
;; Time
|
||||
get-universal-time get-internal-real-time sleep
|
||||
;; Equality
|
||||
equalp = equal eq eql))
|
||||
"Static whitelist of symbols permitted in the Lisp Validator sandbox."
|
||||
|
||||
(defvar *lisp-validator-registry* nil
|
||||
"List of dynamically registered safe symbols.")
|
||||
|
||||
(defun lisp-validator-register (symbols)
|
||||
"Adds symbols to the global validator registry."
|
||||
(setf *lisp-validator-registry*
|
||||
(append *lisp-validator-registry*
|
||||
(if (listp symbols) symbols (list symbols))))
|
||||
(harness-log "LISP VALIDATOR: Registered ~a new safe symbols."
|
||||
(length (if (listp symbols) symbols (list symbols)))))
|
||||
|
||||
(defun lisp-validator-is-safe (symbol)
|
||||
"Checks if a symbol is in the static whitelist or the dynamic registry."
|
||||
(or (member symbol *lisp-validator-whitelist* :test #'string-equal)
|
||||
(member symbol *lisp-validator-registry* :test #'string-equal)))
|
||||
|
||||
(defun lisp-validator-ast-walk (form)
|
||||
"Recursively walks the Lisp AST. Returns T if safe, NIL if unsafe."
|
||||
(cond
|
||||
;; Self-evaluating objects are safe.
|
||||
((or (stringp form) (numberp form) (keywordp form) (characterp form)) t)
|
||||
;; Symbols used as variables (in non-function position)
|
||||
((symbolp form) (lisp-validator-is-safe form))
|
||||
;; Lists represent function calls or special forms.
|
||||
((listp form)
|
||||
(let ((head (car form)))
|
||||
(cond
|
||||
((eq head 'quote) t)
|
||||
((not (symbolp head)) nil)
|
||||
((lisp-validator-is-safe head)
|
||||
(every #'lisp-validator-ast-walk (cdr form)))
|
||||
(t
|
||||
(harness-log "LISP VALIDATOR: Blocked call to non-whitelisted function ~a" head)
|
||||
nil))))
|
||||
(t nil)))
|
||||
|
||||
(defun lisp-validator-check-semantic (code-string)
|
||||
"Checks if all symbols in CODE-STRING are whitelisted.
|
||||
Returns (VALUES t nil) if clean, or (VALUES nil reason-string nil nil)."
|
||||
(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)
|
||||
do (unless (lisp-validator-ast-walk form)
|
||||
(return-from lisp-validator-check-semantic
|
||||
(values nil "Code contains non-whitelisted symbols." nil nil)))))
|
||||
(values t nil nil nil))
|
||||
(error (c)
|
||||
(values nil (format nil "Semantic check failed: ~a" c) nil nil))))
|
||||
#+end_src
|
||||
|
||||
** Unified Entry Point
|
||||
Orchestrates the three checks and returns a single structured plist.
|
||||
|
||||
#+begin_src lisp :tangle ../library/gen/org-skill-lisp-validator.lisp
|
||||
(defun lisp-validator-validate (code-string &key strict)
|
||||
"Validates Lisp code through structural, syntactic, and optional semantic checks.
|
||||
Returns a plist:
|
||||
(:status :success :checks (:structural t :syntactic t :semantic t))
|
||||
or
|
||||
(:status :error :failed <check-key> :reason <string> :line <n> :col <n>)
|
||||
|
||||
When STRICT is non-nil, the semantic whitelist check is enforced.
|
||||
When STRICT is nil, semantic check is skipped for general validation."
|
||||
(let ((structural-ok nil) (syntactic-ok nil) (semantic-ok nil)
|
||||
(reason nil) (line nil) (col nil))
|
||||
;; Phase 1: Structural
|
||||
(multiple-value-setq (structural-ok reason line col)
|
||||
(lisp-validator-check-structural code-string))
|
||||
(unless structural-ok
|
||||
(return-from lisp-validator-validate
|
||||
(list :status :error :failed :structural :reason reason :line line :col col)))
|
||||
;; Phase 2: Syntactic
|
||||
(multiple-value-setq (syntactic-ok reason line col)
|
||||
(lisp-validator-check-syntactic code-string))
|
||||
(unless syntactic-ok
|
||||
(return-from lisp-validator-validate
|
||||
(list :status :error :failed :syntactic :reason reason :line line :col col)))
|
||||
;; Phase 3: Semantic (only when strict)
|
||||
(when strict
|
||||
(multiple-value-setq (semantic-ok reason line col)
|
||||
(lisp-validator-check-semantic code-string))
|
||||
(unless semantic-ok
|
||||
(return-from lisp-validator-validate
|
||||
(list :status :error :failed :semantic :reason reason :line line :col col))))
|
||||
;; All clear
|
||||
(list :status :success
|
||||
:checks (list :structural t :syntactic t :semantic (or (not strict) semantic-ok)))))
|
||||
#+end_src
|
||||
|
||||
** Cognitive Tool: :validate-lisp
|
||||
Exposes the validator to the Probabilistic Engine so it can self-correct before presenting code.
|
||||
|
||||
#+begin_src lisp :tangle ../library/gen/org-skill-lisp-validator.lisp
|
||||
(def-cognitive-tool :validate-lisp
|
||||
"Deterministically validates Lisp code for structural, syntactic, and semantic correctness.
|
||||
Use this BEFORE declaring any Lisp code edit complete."
|
||||
((:code :type :string :description "The Lisp code string to validate.")
|
||||
(:strict :type :boolean :description "If non-nil, enforces the semantic whitelist."))
|
||||
:body (lambda (args)
|
||||
(let ((code (getf args :code))
|
||||
(strict (getf args :strict)))
|
||||
(if (and code (stringp code))
|
||||
(lisp-validator-validate code :strict strict)
|
||||
(list :status :error :reason "Missing :code argument.")))))
|
||||
#+end_src
|
||||
|
||||
** Skill Registration
|
||||
#+begin_src lisp :tangle ../library/gen/org-skill-lisp-validator.lisp
|
||||
(defskill :skill-lisp-validator
|
||||
:priority 900
|
||||
:trigger (lambda (ctx)
|
||||
;; Trigger on any eval or shell action, or when validation is explicitly requested
|
||||
(let ((candidate (getf ctx :approved-action)))
|
||||
(when candidate
|
||||
(let ((payload (getf candidate :payload)))
|
||||
(member (getf payload :action) '(:eval :shell))))))
|
||||
:probabilistic nil
|
||||
:deterministic (lambda (action context)
|
||||
(declare (ignore context))
|
||||
(let ((payload (getf action :payload)))
|
||||
(if (eq (getf payload :action) :eval)
|
||||
(let* ((code (getf payload :code))
|
||||
(result (lisp-validator-validate code :strict t)))
|
||||
(if (eq (getf result :status) :error)
|
||||
(progn
|
||||
(harness-log "LISP VALIDATOR: Blocked unsafe :eval action. ~a"
|
||||
(getf result :reason))
|
||||
(list :type :LOG
|
||||
:payload (list :level :error
|
||||
:text (format nil "LISP VALIDATOR: Blocked unsafe eval. ~a"
|
||||
(getf result :reason)))))
|
||||
action))
|
||||
action))))
|
||||
#+end_src
|
||||
|
||||
* Phase E: Chaos (Verification)
|
||||
#+begin_src lisp :tangle ../tests/lisp-validator-tests.lisp
|
||||
(defpackage :opencortex-lisp-validator-tests
|
||||
(:use :cl :fiveam :opencortex)
|
||||
(:export #:lisp-validator-suite))
|
||||
|
||||
(in-package :opencortex-lisp-validator-tests)
|
||||
|
||||
(def-suite lisp-validator-suite
|
||||
:description "Tests for the Lisp Validator structural, syntactic, and semantic gates.")
|
||||
|
||||
(in-suite lisp-validator-suite)
|
||||
|
||||
(test structural-balanced
|
||||
(let ((result (opencortex::lisp-validator-check-structural "(+ 1 2)")))
|
||||
(is (eq result t))))
|
||||
|
||||
(test structural-unbalanced-open
|
||||
(multiple-value-bind (ok reason line col)
|
||||
(opencortex::lisp-validator-check-structural "(+ 1 2")
|
||||
(is (null ok))
|
||||
(is (search "Unbalanced" reason))
|
||||
(is (= line 1))))
|
||||
|
||||
(test structural-unbalanced-close
|
||||
(multiple-value-bind (ok reason line col)
|
||||
(opencortex::lisp-validator-check-structural "+ 1 2)")
|
||||
(is (null ok))
|
||||
(is (search "Unexpected" reason)))
|
||||
|
||||
(test structural-mismatched-bracket
|
||||
(multiple-value-bind (ok reason line col)
|
||||
(opencortex::lisp-validator-check-structural "(let [x 1) x)")
|
||||
(is (null ok))
|
||||
(is (search "Mismatched" reason))))
|
||||
|
||||
(test syntactic-valid
|
||||
(multiple-value-bind (ok reason line col)
|
||||
(opencortex::lisp-validator-check-syntactic "(+ 1 2) (* 3 4)")
|
||||
(is ok)))
|
||||
|
||||
(test syntactic-invalid-reader
|
||||
(multiple-value-bind (ok reason line col)
|
||||
(opencortex::lisp-validator-check-syntactic "(1+ 2 #")")
|
||||
(is (null ok))))
|
||||
|
||||
(test semantic-safe
|
||||
(multiple-value-bind (ok reason line col)
|
||||
(opencortex::lisp-validator-check-semantic "(+ 1 2)")
|
||||
(is ok)))
|
||||
|
||||
(test semantic-blocked-eval
|
||||
(multiple-value-bind (ok reason line col)
|
||||
(opencortex::lisp-validator-check-semantic "(eval '(+ 1 2))")
|
||||
(is (null ok))))
|
||||
|
||||
(test unified-success
|
||||
(let ((result (opencortex::lisp-validator-validate "(+ 1 2)" :strict t)))
|
||||
(is (eq (getf result :status) :success))
|
||||
(is (getf (getf result :checks) :structural))
|
||||
(is (getf (getf result :checks) :syntactic))
|
||||
(is (getf (getf result :checks) :semantic))))
|
||||
|
||||
(test unified-structural-failure
|
||||
(let ((result (opencortex::lisp-validator-validate "(+ 1 2" :strict nil)))
|
||||
(is (eq (getf result :status) :error))
|
||||
(is (eq (getf result :failed) :structural))))
|
||||
|
||||
(test unified-semantic-failure-strict
|
||||
(let ((result (opencortex::lisp-validator-validate "(delete-file \"x.txt\")" :strict t)))
|
||||
(is (eq (getf result :status) :error))
|
||||
(is (eq (getf result :failed) :semantic))))
|
||||
#+end_src
|
||||
95
skills/org-skill-self-fix.org
Normal file
95
skills/org-skill-self-fix.org
Normal file
@@ -0,0 +1,95 @@
|
||||
:PROPERTIES:
|
||||
:ID: 65891ce2-a465-49e6-a0c1-be13d3288d55
|
||||
:CREATED: [2026-03-30 Mon 21:16]
|
||||
:EDITED: [2026-04-09 Thu]
|
||||
:END:
|
||||
#+TITLE: SKILL: Self-Fix Agent
|
||||
#+STARTUP: content
|
||||
#+FILETAGS: :self-repair:autonomy:debugging:autonomy:
|
||||
|
||||
* Overview
|
||||
The *Self-Fix Agent* is the system's "Repair Mechanism." It takes failure hypotheses, applies surgical code modifications, and verifies them using the Memory's rollback capabilities.
|
||||
|
||||
This skill enables self-editing by applying surgical fixes to files (including skills) with automatic rollback on failure.
|
||||
|
||||
* Phase D: Build (Implementation)
|
||||
|
||||
** Repair Logic
|
||||
#+begin_src lisp :tangle ../library/gen/org-skill-self-fix.lisp
|
||||
(in-package :opencortex)
|
||||
#+end_src
|
||||
|
||||
#+begin_src lisp :tangle ../library/gen/org-skill-self-fix.lisp
|
||||
(defun self-fix-apply (action context)
|
||||
"Applies a surgical code fix and reloads the modified skill."
|
||||
(declare (ignore context))
|
||||
(let* ((payload (getf action :payload))
|
||||
(target-file (getf payload :file))
|
||||
(old-code (getf payload :old))
|
||||
(new-code (getf payload :new))
|
||||
(is-skill (and (stringp (namestring target-file))
|
||||
(search "skills/" (namestring target-file)))))
|
||||
|
||||
(opencortex:snapshot-memory)
|
||||
(opencortex:harness-log "SELF-FIX - Attempting surgical fix on ~a..." target-file)
|
||||
|
||||
(handler-case
|
||||
(if (uiop:file-exists-p target-file)
|
||||
(let ((content (uiop:read-file-string target-file)))
|
||||
(if (search old-code content)
|
||||
(let ((new-content (cl-ppcre:regex-replace-all (cl-ppcre:quote-meta-chars old-code) content new-code)))
|
||||
(with-open-file (out target-file :direction :output :if-exists :supersede)
|
||||
(write-string new-content out))
|
||||
|
||||
(if is-skill
|
||||
(progn
|
||||
(opencortex:harness-log "SELF-FIX - Reloading modified skill ~a..." target-file)
|
||||
(if (opencortex:load-skill-from-org target-file)
|
||||
(progn
|
||||
(opencortex:harness-log "SELF-FIX SUCCESS - Applied and reloaded.")
|
||||
t)
|
||||
(progn
|
||||
(opencortex:harness-log "SELF-FIX FAILURE - Skill reload failed. Rolling back.")
|
||||
(with-open-file (out target-file :direction :output :if-exists :supersede)
|
||||
(write-string content out))
|
||||
(opencortex:rollback-memory 0)
|
||||
nil)))
|
||||
(progn
|
||||
(opencortex:harness-log "SELF-FIX SUCCESS - Applied fix to file.")
|
||||
t)))
|
||||
(progn (opencortex:harness-log "SELF-FIX FAILURE - Pattern not found.") nil)))
|
||||
(progn (opencortex:harness-log "SELF-FIX FAILURE - File not found.") nil))
|
||||
(error (c)
|
||||
(opencortex:harness-log "SELF-FIX CRASH - ~a. Rolling back." c)
|
||||
(opencortex:rollback-memory 0)
|
||||
nil))))
|
||||
#+end_src
|
||||
|
||||
** Cognitive Tool
|
||||
#+begin_src lisp :tangle ../library/gen/org-skill-self-fix.lisp
|
||||
(def-cognitive-tool :repair-file
|
||||
"Applies a surgical code modification to a file and reloads the skill if applicable."
|
||||
((:file :type :string :description "Path to the target file")
|
||||
(:old :type :string :description "The literal code block to find")
|
||||
(:new :type :string :description "The literal code block to replace it with"))
|
||||
:body (lambda (args)
|
||||
(if (self-fix-apply (list :payload args) nil)
|
||||
"REPAIR SUCCESSFUL."
|
||||
"REPAIR FAILED.")))
|
||||
#+end_src
|
||||
|
||||
** Skill Definition
|
||||
#+begin_src lisp :tangle ../library/gen/org-skill-self-fix.lisp
|
||||
(defskill :skill-self-fix
|
||||
:priority 95
|
||||
:trigger (lambda (context) (eq (getf (getf context :payload) :sensor) :repair-request))
|
||||
:probabilistic (lambda (context)
|
||||
(format nil "You are the opencortex Repair Actuator. Synthesize a surgical fix for the reported failure.
|
||||
Return a Lisp plist for :repair-file."))
|
||||
:deterministic (lambda (action context)
|
||||
(let ((payload (getf action :payload)))
|
||||
(self-fix-apply action context))))
|
||||
#+end_src
|
||||
|
||||
* See Also
|
||||
- [[file:org-skill-lisp-utils.org][Lisp Utils]] - Utilities, repair, and validation
|
||||
44
tests/emacs-edit-tests.lisp
Normal file
44
tests/emacs-edit-tests.lisp
Normal file
@@ -0,0 +1,44 @@
|
||||
(defpackage :opencortex-emacs-edit-tests
|
||||
(:use :cl :fiveam :opencortex)
|
||||
(:export #:emacs-edit-suite))
|
||||
|
||||
(in-package :opencortex-emacs-edit-tests)
|
||||
|
||||
(def-suite emacs-edit-suite
|
||||
:description "Tests for Emacs Edit skill.")
|
||||
|
||||
(in-suite emacs-edit-suite)
|
||||
|
||||
(test id-generation
|
||||
(let ((id1 (emacs-edit-generate-id))
|
||||
(id2 (emacs-edit-generate-id)))
|
||||
(is (plusp (length id1)))
|
||||
(is (not (string= id1 id2)) ;; Likely unique
|
||||
(is (= 8 (length id1)))))
|
||||
|
||||
(test id-format
|
||||
(let ((formatted (emacs-edit-id-format "abc12345")))
|
||||
(is (search "id:" formatted))))
|
||||
|
||||
(test property-setter
|
||||
(let ((ast (list :type :headline
|
||||
:properties (list :ID "id:test123" :TITLE "Test")
|
||||
:contents nil)))
|
||||
(emacs-edit-set-property ast "id:test123" :STATUS "ACTIVE")
|
||||
(is (string= (getf (getf ast :properties) :STATUS) "ACTIVE"))))
|
||||
|
||||
(test todo-setter
|
||||
(let ((ast (list :type :headline
|
||||
:properties (list :ID "id:todo001" :TITLE "Task")
|
||||
:contents nil)))
|
||||
(emacs-edit-set-todo ast "id:todo001" "DONE")
|
||||
(is (string= (getf (getf ast :properties) :TODO) "DONE"))))
|
||||
|
||||
(test find-headline-by-id
|
||||
(let ((ast (list :type :document
|
||||
:contents (list (list :type :headline
|
||||
:properties (list :ID "id:findme" :TITLE "Found")
|
||||
:contents nil)))))
|
||||
(let ((found (emacs-edit-find-headline-by-id ast "id:findme")))
|
||||
(is (not (null found)))
|
||||
(is (string= (getf (getf found :properties) :ID) "id:findme"))))
|
||||
107
tests/lisp-utils-tests.lisp
Normal file
107
tests/lisp-utils-tests.lisp
Normal file
@@ -0,0 +1,107 @@
|
||||
(defpackage :opencortex-lisp-utils-tests
|
||||
(:use :cl :fiveam :opencortex)
|
||||
(:export #:lisp-utils-suite))
|
||||
|
||||
(in-package :opencortex-lisp-utils-tests)
|
||||
|
||||
(def-suite lisp-utils-suite
|
||||
:description "Tests for the Lisp Utils skill - utilities, repair, and validation.")
|
||||
|
||||
(in-suite lisp-utils-suite)
|
||||
|
||||
;; Character utilities
|
||||
(test count-char-balanced
|
||||
(is (= (count-char #\( "(+ 1 2)") 1))
|
||||
(is (= (count-char #\) "(+ 1 2)") 1)))
|
||||
|
||||
(test count-char-unbalanced
|
||||
(is (= (count-char #\( "(+ 1 2") 1))
|
||||
(is (= (count-char #\) "(+ 1 2") 0)))
|
||||
|
||||
(test count-char-empty
|
||||
(is (= (count-char #\( "") 0)))
|
||||
|
||||
;; Deterministic repair
|
||||
(test deterministic-repair-balanced
|
||||
(is (string= (deterministic-repair "(+ 1 2)") "(+ 1 2)")))
|
||||
|
||||
(test deterministic-repair-unbalanced-open
|
||||
(is (string= (deterministic-repair "(+ 1 2") "(+ 1 2)")))
|
||||
|
||||
(test deterministic-repair-unbalanced-close
|
||||
(is (string= (deterministic-repair "(+ 1 2))") "(+ 1 2)))")) ;; Left as-is (can't fix)
|
||||
|
||||
(test deterministic-repair-empty
|
||||
(is (string= (deterministic-repair "") "")))
|
||||
|
||||
;; ID generation
|
||||
(test id-generation
|
||||
(let ((id1 (emacs-edit-generate-id))
|
||||
(id2 (emacs-edit-generate-id)))
|
||||
(is (plusp (length id1)))
|
||||
(is (not (string= id1 id2))) ;; Likely unique
|
||||
(is (= 8 (length id1)))))
|
||||
|
||||
(test id-format
|
||||
(let ((formatted (emacs-edit-id-format "abc12345")))
|
||||
(is (search "id:" formatted))))
|
||||
|
||||
;; Structural check (from lisp-utils)
|
||||
(test structural-valid
|
||||
(multiple-value-bind (ok reason line col)
|
||||
(opencortex::lisp-utils-check-structural "(+ 1 2)")
|
||||
(is ok)))
|
||||
|
||||
(test structural-unbalanced
|
||||
(multiple-value-bind (ok reason line col)
|
||||
(opencortex::lisp-utils-check-structural "(+ 1 2")
|
||||
(is (not ok))
|
||||
(is (search "Unbalanced" reason))))
|
||||
|
||||
(test structural-mismatched
|
||||
(multiple-value-bind (ok reason line col)
|
||||
(opencortex::lisp-utils-check-structural "(let [x 1])")
|
||||
(is (not ok))
|
||||
(is (search "Mismatched" reason))))
|
||||
|
||||
;; Syntactic check
|
||||
(test syntactic-valid
|
||||
(multiple-value-bind (ok reason line col)
|
||||
(opencortex::lisp-utils-check-syntactic "(+ 1 2)")
|
||||
(is ok)))
|
||||
|
||||
(test syntactic-invalid
|
||||
(multiple-value-bind (ok reason line col)
|
||||
(opencortex::lisp-utils-check-syntactic "(1+ 2 #\"")
|
||||
(is (not ok))))
|
||||
|
||||
;; Semantic check
|
||||
(test semantic-whitelist-safe
|
||||
(multiple-value-bind (ok reason line col)
|
||||
(opencortex::lisp-utils-check-semantic "(+ 1 2)")
|
||||
(is ok)))
|
||||
|
||||
(test semantic-blocked-eval
|
||||
(multiple-value-bind (ok reason line col)
|
||||
(opencortex::lisp-utils-check-semantic "(eval '(+ 1 2))")
|
||||
(is (not ok))))
|
||||
|
||||
(test semantic-blocked-delete
|
||||
(multiple-value-bind (ok reason line col)
|
||||
(opencortex::lisp-utils-check-semantic "(delete-file \"x.txt\")")
|
||||
(is (not ok))))
|
||||
|
||||
;; Unified validation
|
||||
(test unified-success
|
||||
(let ((result (opencortex::lisp-utils-validate "(+ 1 2)" :strict t)))
|
||||
(is (eq (getf result :status) :success))))
|
||||
|
||||
(test unified-structural-fail
|
||||
(let ((result (opencortex::lisp-utils-validate "(+ 1 2" :strict nil)))
|
||||
(is (eq (getf result :status) :error))
|
||||
(is (eq (getf result :failed) :structural))))
|
||||
|
||||
(test unified-semantic-fail
|
||||
(let ((result (opencortex::lisp-utils-validate "(delete-file \"x.txt\")" :strict t)))
|
||||
(is (eq (getf result :status) :error))
|
||||
(is (eq (getf result :failed) :semantic))))
|
||||
Reference in New Issue
Block a user