Consolidate Lisp utilities into core skills
Some checks failed
Deploy-Agent-V15-Stdin / JOB-V15-STDIN (push) Failing after 3s
Some checks failed
Deploy-Agent-V15-Stdin / JOB-V15-STDIN (push) Failing after 3s
- Merge lisp-validator + lisp-repair → org-skill-lisp-utils.org - Add self-fix skill (from contrib) - Add engineering standards skill (from contrib) - Delete old org-skill-lisp-validator.org This consolidates all Lisp utilities (count-char, deterministic-repair, neural-repair, structural/syntactic/semantic validation) into one skill.
This commit is contained in:
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
|
||||
Reference in New Issue
Block a user