Amr Gharbeia
924bf8f479
Some checks failed
Deploy (Gitea) / deploy (push) Failing after 2s
- Restore (in-package :passepartout) to core-reason - Move *VAULT-MEMORY* back to core-skills - Fix ASDF and defstruct/defpackage ordering - Increase daemon timeout to 120s - Handshake: 0.5.0 Verified: daemon processes messages, TUI clean, gate trace works
369 lines
14 KiB
Org Mode
369 lines
14 KiB
Org Mode
#+TITLE: SKILL: Utils Lisp (org-skill-utils-lisp.org)
|
|
#+AUTHOR: Agent
|
|
#+FILETAGS: :skill:utils:lisp:validation:evaluation:
|
|
#+PROPERTY: header-args:lisp :tangle ../lisp/programming-lisp.lisp
|
|
|
|
* Architectural Intent: The Lisp Surgeon's Toolkit
|
|
|
|
When the agent needs to modify its own code — fix a bug, add a feature, refactor a skill — it reaches for Utils Lisp. This skill provides every operation needed to read, validate, modify, and write Lisp code from within Lisp itself.
|
|
|
|
This is possible only because Lisp is homoiconic: code is data. The agent can parse a function definition from a string, extract its body, wrap it in a new form, inject a new expression, and validate the result — all using the same data structures that the Lisp runtime uses to execute the code.
|
|
|
|
The skill has four layers:
|
|
1. **Validation** — three-phase gate: structural (paren balance) → syntactic (reader safety) → semantic (dangerous forms)
|
|
2. **Evaluation** — sandboxed ~eval~ in a jailed package with ~*read-eval*~ nil
|
|
3. **Structural surgery** — extract, inject, wrap, slurp — surgical code transformations without regex
|
|
4. **Formatting** — auto-indentation via Emacs batch mode
|
|
|
|
** Contract
|
|
|
|
1. (lisp-structural-check code): returns (values T nil) if parentheses
|
|
balanced, (values nil error-msg) if reader errors detected.
|
|
2. (lisp-syntactic-check code): alias for lisp-structural-check.
|
|
3. (lisp-semantic-check code): returns (values T nil) if no unsafe forms
|
|
(eval, load, run-program) found; (values nil reason) if blocked.
|
|
4. (lisp-validate code &key strict): unified gate — returns
|
|
~(:status :success)~ or ~(:status :error :reason ...)~.
|
|
5. (lisp-eval code-string): sandboxed eval with captured output.
|
|
Returns ~(:status :success :result ...)~ or ~(:status :error ...)~.
|
|
6. (lisp-extract code fn-name): extracts a single defun from code.
|
|
7. (lisp-list-definitions code): returns list of defined symbol names.
|
|
8. (lisp-inject code target new-form): injects a form into a function body.
|
|
9. (lisp-slurp code target form): appends a form to a function body.
|
|
|
|
* Implementation
|
|
|
|
** Package Context
|
|
#+begin_src lisp
|
|
(in-package :passepartout)
|
|
#+end_src
|
|
|
|
** Structural Validation
|
|
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
|
#+begin_src lisp
|
|
(defun lisp-structural-check (code)
|
|
"Checks if parentheses are balanced and the code is readable."
|
|
(handler-case
|
|
(let ((*read-eval* nil))
|
|
(with-input-from-string (s code)
|
|
(loop for form = (read s nil :eof) until (eq form :eof)))
|
|
(values t nil))
|
|
(error (c)
|
|
(values nil (format nil "Reader Error: ~a" c)))))
|
|
#+end_src
|
|
|
|
** Syntactic Validation
|
|
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
|
#+begin_src lisp
|
|
(defun lisp-syntactic-check (code)
|
|
"Checks for valid Lisp syntax beyond just balanced parentheses."
|
|
(lisp-structural-check code))
|
|
#+end_src
|
|
|
|
** Semantic Validation (Safety)
|
|
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
|
#+begin_src lisp
|
|
(defun lisp-semantic-check (code)
|
|
"Checks for potentially unsafe forms."
|
|
(let ((unsafe-tokens '("eval" "load" "uiop:run-program" "sb-ext:run-program" "cl-user::eval")))
|
|
(loop for token in unsafe-tokens
|
|
when (search token (string-downcase code))
|
|
do (return-from lisp-semantic-check (values nil (format nil "Unsafe form detected: ~a" token))))
|
|
(values t nil)))
|
|
#+end_src
|
|
|
|
** Unified Validation Gate
|
|
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
|
#+begin_src lisp
|
|
(defun lisp-validate (code &key (strict t))
|
|
"Unified validation gate for Lisp code."
|
|
(multiple-value-bind (struct-ok struct-err) (lisp-structural-check code)
|
|
(unless struct-ok
|
|
(return-from lisp-validate (list :status :error :reason struct-err)))
|
|
(when strict
|
|
(multiple-value-bind (sem-ok sem-err) (lisp-semantic-check code)
|
|
(unless sem-ok
|
|
(return-from lisp-validate (list :status :error :reason sem-err)))))
|
|
(list :status :success)))
|
|
#+end_src
|
|
|
|
** Evaluation (REPL)
|
|
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
|
#+begin_src lisp
|
|
(defun lisp-eval (code-string &key (package :passepartout))
|
|
"Evaluates a Lisp string and captures its output/results."
|
|
(let ((out (make-string-output-stream))
|
|
(err (make-string-output-stream)))
|
|
(handler-case
|
|
(let* ((*standard-output* out)
|
|
(*error-output* err)
|
|
(*package* (or (find-package package) (find-package :passepartout)))
|
|
(result (with-input-from-string (s code-string)
|
|
(let ((last-val nil))
|
|
(loop for form = (read s nil :eof) until (eq form :eof)
|
|
do (setf last-val (eval form)))
|
|
last-val))))
|
|
(list :status :success
|
|
:result (format nil "~a" result)
|
|
:output (get-output-stream-string out)
|
|
:error (get-output-stream-string err)))
|
|
(error (c)
|
|
(list :status :error
|
|
:reason (format nil "~a" c)
|
|
:output (get-output-stream-string out)
|
|
:error (get-output-stream-string err))))))
|
|
#+end_src
|
|
|
|
** Formatting (Emacs Batch)
|
|
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
|
#+begin_src lisp
|
|
(defun lisp-format (code-string)
|
|
"Attempts to format Lisp code using Emacs batch mode if available."
|
|
(handler-case
|
|
(let ((tmp-file "/tmp/oc-format-temp.lisp"))
|
|
(uiop:with-output-file (s tmp-file :if-exists :supersede)
|
|
(format s "~a" code-string))
|
|
(multiple-value-bind (out err code)
|
|
(uiop:run-program (list "emacs" "--batch" tmp-file
|
|
"--eval" "(indent-region (point-min) (point-max))"
|
|
"--eval" "(princ (buffer-string))")
|
|
:output :string :error-output :string :ignore-error-status t)
|
|
(if (= code 0)
|
|
out
|
|
(progn
|
|
(log-message "FORMAT ERROR: ~a" err)
|
|
code-string))))
|
|
(error (c)
|
|
(log-message "FORMAT EXCEPTION: ~a" c)
|
|
code-string)))
|
|
#+end_src
|
|
|
|
** Structural Extraction (AST)
|
|
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
|
#+begin_src lisp
|
|
(defun lisp-extract (code function-name)
|
|
"Extracts the definition of a specific function from a code string."
|
|
(let ((*read-eval* nil))
|
|
(with-input-from-string (s code)
|
|
(loop for form = (read s nil :eof) until (eq form :eof)
|
|
when (and (listp form)
|
|
(symbolp (car form))
|
|
(member (symbol-name (car form)) '("DEFUN" "DEFMACRO" "DEFMETHOD") :test #'string-equal)
|
|
(symbolp (second form))
|
|
(string-equal (symbol-name (second form)) function-name))
|
|
do (return-from lisp-extract (format nil "~s" form))))
|
|
nil))
|
|
#+end_src
|
|
|
|
** Structural Wrapping (AST)
|
|
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
|
#+begin_src lisp
|
|
(defun lisp-wrap (code target-name wrapper-symbol)
|
|
"Wraps a specific form in a wrapper form (e.g., wrap in a let)."
|
|
(let ((*read-eval* nil) (results nil))
|
|
(with-input-from-string (s code)
|
|
(loop for form = (read s nil :eof) until (eq form :eof)
|
|
do (if (and (listp form)
|
|
(symbolp (second form))
|
|
(string-equal (symbol-name (second form)) target-name))
|
|
(push (list wrapper-symbol form) results)
|
|
(push form results))))
|
|
(format nil "~{~s~^~%~%~}" (nreverse results))))
|
|
#+end_src
|
|
|
|
** List Definitions
|
|
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
|
#+begin_src lisp
|
|
(defun lisp-list-definitions (code)
|
|
"Returns a list of names for all top-level definitions (defun, defmacro, etc.)."
|
|
(let ((*read-eval* nil) (names nil))
|
|
(with-input-from-string (s code)
|
|
(loop for form = (read s nil :eof) until (eq form :eof)
|
|
when (and (listp form)
|
|
(symbolp (car form))
|
|
(member (symbol-name (car form))
|
|
'("DEFUN" "DEFMACRO" "DEFMETHOD" "DEFVAR" "DEFPARAMETER")
|
|
:test #'string-equal)
|
|
(symbolp (second form)))
|
|
do (push (second form) names)))
|
|
(nreverse names)))
|
|
#+end_src
|
|
|
|
** Structural Injection (AST)
|
|
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
|
#+begin_src lisp
|
|
(defun lisp-inject (code target-name new-form-string)
|
|
"Injects a new form into the body of a targeted definition."
|
|
(let ((*read-eval* nil)
|
|
(new-form (read-from-string new-form-string))
|
|
(results nil))
|
|
(with-input-from-string (s code)
|
|
(loop for form = (read s nil :eof) until (eq form :eof)
|
|
do (if (and (listp form)
|
|
(symbolp (car form))
|
|
(member (symbol-name (car form)) '("DEFUN" "DEFMACRO" "DEFMETHOD") :test #'string-equal)
|
|
(symbolp (second form))
|
|
(string-equal (symbol-name (second form)) target-name))
|
|
(push (append form (list new-form)) results)
|
|
(push form results))))
|
|
(format nil "~{~s~^~%~%~}" (nreverse results))))
|
|
#+end_src
|
|
|
|
** Structural Slurp (AST)
|
|
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
|
#+begin_src lisp
|
|
(defun lisp-slurp (code target-name form-to-slurp-string)
|
|
"Adds a form to the end of a named list or definition (Paredit slurp)."
|
|
(let ((*read-eval* nil)
|
|
(to-slurp (read-from-string form-to-slurp-string))
|
|
(results nil))
|
|
(with-input-from-string (s code)
|
|
(loop for form = (read s nil :eof) until (eq form :eof)
|
|
do (if (and (listp form)
|
|
(symbolp (second form))
|
|
(string-equal (symbol-name (second form)) target-name))
|
|
(push (append form (list to-slurp)) results)
|
|
(push form results))))
|
|
(format nil "~{~s~^~%~%~}" (nreverse results))))
|
|
#+end_src
|
|
|
|
** Skill Registration
|
|
#+begin_src lisp
|
|
(defskill :passepartout-programming-lisp
|
|
:priority 400
|
|
:trigger (lambda (ctx) (declare (ignore ctx)) nil))
|
|
#+end_src
|
|
|
|
** Plist Keywords Normalize (relocated from core-reason)
|
|
|
|
|
|
|
|
Lisp keywords are case-sensitive. The LLM might produce ~:payload~ or ~:PAYLOAD~ depending on the model. This function normalizes keyword keys to uppercase.
|
|
|
|
|
|
|
|
#+begin_src lisp
|
|
|
|
(defun plist-keywords-normalize (plist)
|
|
|
|
(when (listp plist)
|
|
|
|
(loop for (k v) on plist by #'cddr
|
|
|
|
collect (if (and (symbolp k) (not (keywordp k)))
|
|
|
|
(intern (string k) :keyword)
|
|
|
|
k)
|
|
|
|
collect v)))
|
|
|
|
#+end_src
|
|
|
|
|
|
** Plist Keywords Normalize (relocated from core-reason)
|
|
|
|
Lisp keywords are case-sensitive. The LLM might produce :payload or :PAYLOAD depending on the model. This function normalizes keyword keys to uppercase.
|
|
|
|
#+begin_src lisp
|
|
(defun plist-keywords-normalize (plist)
|
|
(when (listp plist)
|
|
(loop for (k v) on plist by #'cddr
|
|
collect (if (and (symbolp k) (not (keywordp k)))
|
|
(intern (string k) :keyword)
|
|
k)
|
|
collect v)))
|
|
#+end_src
|
|
|
|
* Test Suite
|
|
Tests for the Lisp Validator structural, syntactic, and semantic gates.
|
|
#+begin_src lisp
|
|
(defpackage :passepartout-utils-lisp-tests
|
|
(:use :cl :fiveam :passepartout)
|
|
(:export #:utils-lisp-suite))
|
|
|
|
(in-package :passepartout-utils-lisp-tests)
|
|
|
|
(def-suite utils-lisp-suite
|
|
:description "Tests for the Lisp Validator structural, syntactic, and semantic gates")
|
|
|
|
(in-suite utils-lisp-suite)
|
|
|
|
(test structural-balanced
|
|
"Contract 1: balanced code returns T."
|
|
(is (eq t (passepartout:lisp-structural-check "(+ 1 2)"))))
|
|
|
|
(test structural-unbalanced-open
|
|
"Contract 1: missing close paren returns nil + error."
|
|
(multiple-value-bind (ok reason) (passepartout:lisp-structural-check "(+ 1 2")
|
|
(is (null ok))
|
|
(is (search "Reader Error" reason))))
|
|
|
|
(test structural-unbalanced-close
|
|
"Contract 1: extra close paren returns nil + error."
|
|
(multiple-value-bind (ok reason) (passepartout:lisp-structural-check "+ 1 2)")
|
|
(is (null ok))
|
|
(is (search "Reader Error" reason))))
|
|
|
|
(test syntactic-valid
|
|
"Contract 2: valid syntax passes syntactic check."
|
|
(is (eq t (passepartout:lisp-syntactic-check "(+ 1 2)"))))
|
|
|
|
(test semantic-safe
|
|
"Contract 3: safe code passes semantic check."
|
|
(is (eq t (passepartout:lisp-semantic-check "(+ 1 2)"))))
|
|
|
|
(test semantic-blocked-eval
|
|
"Contract 3: eval forms are blocked by semantic check."
|
|
(multiple-value-bind (ok reason) (passepartout:lisp-semantic-check "(eval '(+ 1 2))")
|
|
(is (null ok))
|
|
(is (search "Unsafe" reason))))
|
|
|
|
(test unified-success
|
|
"Contract 4: valid code returns :success via lisp-validate."
|
|
(let ((result (passepartout:lisp-validate "(+ 1 2)" :strict t)))
|
|
(is (eq (getf result :status) :success))))
|
|
|
|
(test unified-failure
|
|
"Contract 4: invalid code returns :error via lisp-validate."
|
|
(let ((result (passepartout:lisp-validate "(+ 1 2" :strict nil)))
|
|
(is (eq (getf result :status) :error))))
|
|
|
|
(test eval-basic
|
|
"Contract 5: lisp-eval returns :success with captured result."
|
|
(let ((result (passepartout:lisp-eval "(+ 1 2)")))
|
|
(is (eq (getf result :status) :success))
|
|
(is (string= (getf result :result) "3"))))
|
|
|
|
(test structural-extract
|
|
"Contract 6: lisp-extract finds and returns a named function."
|
|
(let* ((code "(defun hello () (print \"hi\")) (defun bye () (print \"bye\"))")
|
|
(extracted (passepartout:lisp-extract code "hello")))
|
|
(is (not (null extracted)))
|
|
(let ((form (read-from-string extracted)))
|
|
(is (eq (car form) 'DEFUN))
|
|
(is (eq (second form) 'HELLO)))))
|
|
|
|
(test list-definitions
|
|
"Contract 7: lisp-list-definitions returns all defined names."
|
|
(let ((code "(defun foo () t) (defmacro bar () nil) (defparameter *baz* 10)"))
|
|
(let ((names (passepartout:lisp-list-definitions code)))
|
|
(is (member 'FOO names))
|
|
(is (member 'BAR names))
|
|
(is (member '*BAZ* names)))))
|
|
|
|
(test structural-inject
|
|
"Contract 8: lisp-inject adds a form to a function body."
|
|
(let* ((code "(defun my-fun (x) (print x))")
|
|
(injected (passepartout:lisp-inject code "my-fun" "(finish-output)")))
|
|
(let ((form (read-from-string injected)))
|
|
(is (equal (last form) '((FINISH-OUTPUT)))))))
|
|
|
|
(test structural-slurp
|
|
"Contract 9: lisp-slurp appends a form to a function body."
|
|
(let* ((code "(defun work () (step-1))")
|
|
(slurped (passepartout:lisp-slurp code "work" "(step-2)")))
|
|
(let ((form (read-from-string slurped)))
|
|
(is (equal (last form) '((STEP-2)))))))
|
|
#+end_src
|