22 KiB
22 KiB
SKILL: Lisp Utils (Utilities + Repair + Validation)
- Overview
- Phase A: Demand (PRD)
- Phase B: Blueprint (PROTOCOL)
- Phase D: Build (Implementation)
- Package Context
- Character & String Utilities
- Syntax Repair (Deterministic)
- Syntax Repair (Neural)
- Check 1: Structural Validation (Paren Balance)
- Check 2: Syntactic Validation (Reader Check)
- Check 3: Semantic Validation (Whitelist AST Walk)
- Unified Entry Point
- Cognitive Tools
- Skill Definition: Lisp Repair
- Skill Definition: Lisp Validator
- Phase E: Chaos (Verification)
- Test Suite: Lisp Validator (Structural/Syntactic/Semantic)
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)
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
- `count-char` works for any character
- `deterministic-repair` balances parentheses
- `neural-repair` uses LLM for complex fixes
- Structural check runs in O(n) without reader
- Syntactic check catches malformed sexps
- Semantic check enforces whitelist
Phase B: Blueprint (PROTOCOL)
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
(in-package :opencortex)Character & String Utilities
General-purpose utilities for string manipulation.
(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))Syntax Repair (Deterministic)
Attempts instant fixes on broken Lisp code (e.g., balancing parens). This is the fast path - used for simple syntax errors.
(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)))Syntax Repair (Neural)
Uses the LLM to deeply repair syntax structure when deterministic fails. This is the slow path - used for complex errors.
(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))))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.
(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))))Check 2: Syntactic Validation (Reader Check)
Wraps the code and attempts to read with read-eval disabled.
(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)))))Check 3: Semantic Validation (Whitelist AST Walk)
Recursively walks the parsed AST and verifies whitelisted symbols.
(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))))Unified Entry Point
Orchestrates the three validation checks.
(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)))))Cognitive Tools
Exposes utilities to the Probabilistic Engine.
(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.")))))Skill Definition: Lisp Repair
Intercepts :syntax-error events and repairs the code.
(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.")))))))))))Skill Definition: Lisp Validator
Validates all Lisp code before execution.
(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))))Phase E: Chaos (Verification)
(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)
;; Character utilities
;; Character utilities
(test count-char-balanced
(is (= (opencortex::count-char #\( "(+ 1 2)") 1))
(is (= (opencortex::count-char #\) "(+ 1 2)") 1)))
(test count-char-unbalanced
(is (= (opencortex::count-char #\( "(+ 1 2") 1))
(is (= (opencortex::count-char #\) "(+ 1 2") 0)))
(test count-char-empty
(is (= (opencortex::count-char #\( "") 0)))
;; Deterministic repair
(test deterministic-repair-balanced
(is (string= (opencortex::deterministic-repair "(+ 1 2)") "(+ 1 2)")))
(test deterministic-repair-unbalanced-open
(is (string= (opencortex::deterministic-repair "(+ 1 2") "(+ 1 2)")))
(test deterministic-repair-unbalanced-close
(is (string= (opencortex::deterministic-repair "(+ 1 2))") "(+ 1 2))")))
(test deterministic-repair-empty
(is (string= (opencortex::deterministic-repair "") "")))
;; Structural check
(test structural-valid
(multiple-value-bind (ok reason line col)
(opencortex::lisp-utils-check-structural "(+ 1 2)")
(is (eq ok t))))
(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 "[)")
(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 (eq ok t))))
(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 (eq ok t))))
(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))))Test Suite: Lisp Validator (Structural/Syntactic/Semantic)
These tests verify the Lisp Validator gate. Run with:
(fiveam:run! 'lisp-validator-suite)
(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))))
(test structural-unbalanced-close
(multiple-value-bind (ok reason line col)
(opencortex::lisp-validator-check-structural "+ 1 2)")
(is (null ok))
(is (search "Unbalanced" reason))))
(test syntactic-valid
(multiple-value-bind (ok reason line col)
(opencortex::lisp-validator-check-syntactic "(+ 1 2)")
(is (eq ok t))))
(test syntactic-invalid-reader
(multiple-value-bind (ok reason line col)
(opencortex::lisp-validator-check-syntactic "(1+ 2 #\")")
(is (not ok))))
(test semantic-safe
(multiple-value-bind (ok reason line col)
(opencortex::lisp-validator-check-semantic "(+ 1 2)")
(is (eq ok t))))
(test semantic-blocked-eval
(multiple-value-bind (ok reason line col)
(opencortex::lisp-validator-check-semantic "(eval '(+ 1 2))")
(is (not ok))))
(test unified-success
(let ((result (opencortex::lisp-validator-validate "(+ 1 2)" :strict t)))
(is (eq (getf result :status) :success))))
(test unified-failure
(let ((result (opencortex::lisp-validator-validate "(+ 1 2" :strict nil)))
(is (eq (getf result :status) :error))))- Self-Fix Skill - File modification with memory rollback