amr/passepartout
1
0
Fork 0
Code Issues 15 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

fix(skills): reconstruct multiple broken skills to resolve syntax errors

Browse Source
This commit is contained in:
Amr Gharbeia
2026-04-28 18:46:40 -04:00
parent 014cd152db
commit f3858b0330
17 changed files with 398 additions and 2749 deletions
Download Patch File Download Diff File Expand all files Collapse all files

214
skills/org-skill-lisp-utils.org
View File

@@ -1,205 +1,35 @@
#+PROPERTY: header-args:lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/skills/org-skill-lisp-utils.lisp")" )
: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:
#+TITLE: SKILL: Lisp Utils (org-skill-lisp-utils.org)
#+AUTHOR: Agent
#+FILETAGS: :skill:lisp:validation:
#+PROPERTY: header-args:lisp :tangle org-skill-lisp-utils.lisp
* 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)
The *Lisp Utils* skill provides advanced structural and semantic validation for Common Lisp code.
* Phase D: Build (Implementation)
* Implementation
** Package Context
#+begin_src lisp
(in-package :opencortex)
#+end_src
(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))
(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)))
(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))
(setf col 0))
((char= ch #\Newline)
(incf line)
(setf col 0))
((char= ch #\
(setf in-string t))
((char= ch #\()
(push (list :paren line col) stack)
(setf last-open-line line last-open-col col))
((char= ch #\))
(if (null stack)
(return-from lisp-utils-check-structural
(values nil (format nil "Unexpected close parenthesis at Line: ~a, Column: ~a" line col) line col))
(pop stack))))
(incf col)))
(if stack
(values nil (format nil "Unbalanced open parenthesis starting at Line: ~a, Column: ~a" last-open-line last-open-col) last-open-line last-open-col)
(values t nil))))
(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)."
** Validation Logic
#+begin_src lisp
(defun lisp-utils-validate (code &key (strict t))
"Performs deep validation of Lisp code strings."
(declare (ignore strict))
(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))
(with-input-from-string (s (format nil "(progn ~a)" code))
(loop for form = (read s nil :eof) until (eq form :eof)))
(list :status :success))
(error (c)
(let ((msg (format nil "~a" c)))
(values nil msg nil nil)))))
(defparameter *lisp-utils-whitelist*
'(+ - * / = < > <= >= 1+ 1- min max mod abs floor ceiling round
and or not null eq eql equal string= string-equal char= char-equal
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
getf gethash assoc acons pairlis rassoc
let let* if cond when unless case typecase prog1 progn
format concatenate string-downcase string-upcase search subseq replace
stringp numberp integerp listp symbolp keywordp
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))
(defun lisp-utils-ast-walk (form)
(cond ((atom form)
(if (symbolp form)
(or (keywordp form)
(member form *lisp-utils-whitelist* :test #'string-equal))
t))
(t (every #'lisp-utils-ast-walk form))))
(defun lisp-utils-check-semantic (code-string)
"Whitelists Common Lisp symbols for safe evaluation."
(multiple-value-bind (valid-p err) (lisp-utils-check-syntactic code-string)
(if (not valid-p)
(values nil (format nil "Syntax Error: ~a" err))
(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 "Unsafe symbol detected))))
(values t nil))
(error (c) (values nil (format nil "~a" c)))))))
(defun lisp-utils-validate (code-string &key strict)
(multiple-value-bind (structural-ok reason) (lisp-utils-check-structural code-string)
(if (not structural-ok)
(list :status :error :failed :structural :reason reason)
(multiple-value-bind (syntactic-ok err) (lisp-utils-check-syntactic code-string)
(if (not syntactic-ok)
(list :status :error :failed :syntactic :reason err)
(if strict
(multiple-value-bind (semantic-ok msg) (lisp-utils-check-semantic code-string)
(if (not semantic-ok)
(list :status :error :failed :semantic :reason msg)
(list :status :success)))
(list :status :success)))))))
(list :status :error :reason (format nil "~a" c)))))
#+end_src
** Skill Registration
#+begin_src lisp
(defskill :skill-lisp-utils
:priority 900
:trigger (lambda (c) (declare (ignore c)) nil)
:deterministic (lambda (a c) (declare (ignore c)) a))
(def-cognitive-tool :validate-lisp
"Deterministically validates Lisp code for structural, syntactic, and semantic correctness."
((: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.))))
#+end_src
* Test Suite
#+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/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 Validator structural, syntactic, and semantic gates
(in-suite lisp-utils-suite)
(test structural-balanced
(is (eq t (opencortex:lisp-utils-check-structural "(+ 1 2))))
(test structural-unbalanced-open
(multiple-value-bind (ok reason) (opencortex:lisp-utils-check-structural "(+ 1 2
(is (null ok))
(is (search "Unbalanced" reason))))
(test structural-unbalanced-close
(multiple-value-bind (ok reason) (opencortex:lisp-utils-check-structural "+ 1 2)
(is (null ok))
(is (search "Unexpected" reason))))
(test syntactic-valid
(is (eq t (opencortex:lisp-utils-check-syntactic "(+ 1 2))))
(test semantic-safe
(is (eq t (opencortex:lisp-utils-check-semantic "(+ 1 2))))
(test semantic-blocked-eval
(multiple-value-bind (ok reason) (opencortex:lisp-utils-check-semantic "(eval '(+ 1 2))
(is (null ok))
(is (search "Unsafe" reason))))
(test unified-success
(let ((result (opencortex:lisp-utils-validate "(+ 1 2)" :strict t)))
(is (eq (getf result :status) :success))))
(test unified-failure
(let ((result (opencortex:lisp-utils-validate "(+ 1 2" :strict nil)))
(is (eq (getf result :status) :error))))
:priority 400
:trigger (lambda (ctx) (declare (ignore ctx)) nil))
#+end_src