#+TITLE: SKILL: Utils Lisp (org-skill-utils-lisp.org)
#+AUTHOR: Agent
#+FILETAGS: :skill:utils:lisp:validation:evaluation:
#+PROPERTY: header-args:lisp :tangle /home/user/.local/share/passepartout/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

* 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