passepartout/org/symbolic-self-improve.org

SKILL: Self-Improve (org-skill-self-improve.org)

• Overview: Self-Modification Primitives
• Implementation
  • Infrastructure: Org Tangle Utility
  • Infrastructure: Org Lisp Block Extractor
  • Self-Edit: Surgical Text Transformation
  • Paren Balancer
  • Syntax Repair Driver
  • Self-Fix: Error Diagnosis and Repair
  • Skill Registration

Overview: Self-Modification Primitives

Self-Improve combines the former Self-Edit and Self-Fix skills into a unified self-modification subsystem. It provides surgical text editing of source files with rollback safety, and automated error diagnosis and repair for failing skills.

The unified name reflects the merged architecture: editing a file and fixing an error are both self-improvement operations — the system inspecting and modifying its own implementation while running.

Implementation

Infrastructure: Org Tangle Utility

Reads an Org file's #+PROPERTY: header-args:lisp :tangle line, extracts all #+begin_src lisp blocks, writes them to the target .lisp file, and compiles+loads the result. Used by the self-improve functions to propagate edits and repairs to the running daemon.

;; REPL-VERIFIED: 2026-05-03T14:00:00

(defun org-tangle-file (filepath)
  "Tangles an Org file's lisp blocks to its :tangle target, compiles, and loads."
  (let ((content (uiop:read-file-string filepath))
        (tangle-path nil)
        (lisp-lines nil)
        (in-block nil))
    (dolist (line (uiop:split-string content :separator '(#\Newline)))
      (let ((trimmed (string-trim '(#\Space #\Tab) line)))
        (cond
          ((and (null tangle-path)
                (search "#+PROPERTY:" trimmed)
                (search ":tangle" trimmed))
           (let* ((parts (uiop:split-string trimmed :separator '(#\Space)))
                  (target (car (last parts)))
                  (org-dir (make-pathname :directory (pathname-directory filepath))))
             (when (and target (not (string-equal target "no")))
               (setf tangle-path
                     (if (char= (aref target 0) #\/)
                         (uiop:parse-unix-namestring target)
                         (uiop:parse-unix-namestring
                          (format nil "~a/~a" (namestring org-dir) target)))))))
          ((search "#+begin_src lisp" trimmed)
           (setf in-block t))
          ((search "#+end_src" trimmed)
           (setf in-block nil)
           (let ((before (search "#+end_src" line)))
             (when (and before (> before 0))
               (push (subseq line 0 before) lisp-lines))))
          (in-block
           (push line lisp-lines)))))
    (when (and tangle-path lisp-lines)
      (setf lisp-lines (nreverse lisp-lines))
      (ensure-directories-exist tangle-path)
      (with-open-file (f tangle-path :direction :output :if-exists :supersede)
        (format f "~{~a~%~}" lisp-lines))
      (let ((compiled (compile-file tangle-path)))
        (when compiled
          (load compiled)
          (list :tangled (namestring tangle-path) :compiled t))))))

Infrastructure: Org Lisp Block Extractor

Extracts all #+begin_src lisp block contents from an Org content string, returning a list of code strings. Used by repair functions to iterate over blocks and apply syntactic fixes.

;; REPL-VERIFIED: 2026-05-03T14:00:00

(defun org-extract-lisp-blocks (content)
  "Extracts all #+begin_src lisp blocks from Org CONTENT as a list of strings."
  (let ((blocks nil)
        (in-block nil)
        (current nil))
    (dolist (line (uiop:split-string content :separator '(#\Newline)))
      (let ((trimmed (string-trim '(#\Space #\Tab) line)))
        (cond
          ((search "#+begin_src lisp" trimmed)
           (setf in-block t current nil))
          ((search "#+end_src" trimmed)
           (when in-block
             (let ((before (search "#+end_src" line)))
               (when (and before (> before 0))
                 (push (subseq line 0 before) current)))
             (push (format nil "~{~a~%~}" (nreverse current)) blocks)
             (setf in-block nil current nil)))
          (in-block
           (push line current)))))
    (nreverse blocks)))

Self-Edit: Surgical Text Transformation

Applies a search-and-replace edit to a file, verifies the edit took effect, and if the file is an .org file, automatically tangles it to .lisp and reloads the compiled result into the running daemon. A memory snapshot is taken before the edit for rollback safety.

;; REPL-VERIFIED: 2026-05-03T14:00:00

(defun self-improve-edit (filepath old-text new-text)
  "Surgical text replacement with tangle+reload for Org source files."
  (when (or (null filepath) (null old-text) (null new-text))
    (return-from self-improve-edit
      (list :status :error :reason "Missing arguments")))
  (when (not (uiop:file-exists-p filepath))
    (return-from self-improve-edit
      (list :status :error :reason (format nil "File not found: ~a" filepath))))
  (log-message "SELF-IMPROVE: Editing ~a (~d chars)" filepath (length old-text))
  (ignore-errors
    (when (fboundp 'snapshot-memory)
      (snapshot-memory)))
  (let* ((content (uiop:read-file-string filepath))
         (pos (search old-text content)))
    (if pos
        (let* ((new-content (concatenate 'string
                              (subseq content 0 pos)
                              new-text
                              (subseq content (+ pos (length old-text)))))
               (ext (pathname-type filepath)))
          (with-open-file (f filepath :direction :output :if-exists :supersede)
            (write-sequence new-content f))
          (let ((re-read (uiop:read-file-string filepath)))
            (if (search new-text re-read :test 'string=)
                (let ((tangle-result
                        (when (string-equal ext "org")
                          (ignore-errors (org-tangle-file filepath)))))
                  (list :status :success
                        :summary (format nil "Replaced ~d chars in ~a"
                                         (length old-text) filepath)
                        :tangle tangle-result))
                (list :status :error :reason "Verification failed"))))
        (list :status :error :reason
              (format nil "Text not found in ~a" filepath)))))

Paren Balancer

Utility that attempts to fix unbalanced parentheses in a Lisp code string. If the code is already balanced, returns nil. Otherwise counts open vs close parens and appends missing closing parens.

;; REPL-VERIFIED: 2026-05-03T14:00:00

(defun self-improve-balance-parens (code)
  "Returns balanced code or nil if already balanced."
  (handler-case
      (progn
        (let ((*read-eval* nil))
          (with-input-from-string (s code)
            (loop for form = (read s nil :eof) until (eq form :eof)))
          (values))
        nil)
    (error ()
      (let* ((opens (loop for ch across code count (char= ch #\()))
             (closes (loop for ch across code count (char= ch #\))))
             (missing (- opens closes)))
        (when (plusp missing)
          (concatenate 'string code
                       (make-string missing :initial-element #\))))))))

Syntax Repair Driver

Given a skill name, locates its .org source file, extracts all Lisp blocks, runs each through the paren balancer, writes fixes back to the file, tangles, compiles, and reloads.

;; REPL-VERIFIED: 2026-05-03T14:00:00

(defun self-improve-repair-syntax (skill-name)
  "Find and fix unbalanced parens in a skill's Org source file."
  (let* ((data-dir (uiop:ensure-directory-pathname
                    (or (uiop:getenv "PASSEPARTOUT_DATA_DIR")
                        (merge-pathnames ".local/share/passepartout/"
                                         (user-homedir-pathname)))))
         (org-path (merge-pathnames (format nil "org/~a.org" skill-name) data-dir)))
    (unless (uiop:file-exists-p org-path)
      (return-from self-improve-repair-syntax
        (list :status :error :reason (format nil "Source not found: ~a" skill-name)
              :repaired nil)))
    (let* ((content (uiop:read-file-string org-path))
           (blocks (org-extract-lisp-blocks content))
           (fixed 0) (result content))
      (dolist (block blocks)
        (let ((balanced (self-improve-balance-parens block)))
          (when (and balanced (not (string= block balanced)))
            (let ((pos (search block result)))
              (when pos
                (setf result (concatenate 'string
                              (subseq result 0 pos)
                              balanced
                              (subseq result (+ pos (length block))))
                      fixed (1+ fixed)))))))
      (if (> fixed 0)
          (progn
            (with-open-file (f org-path :direction :output :if-exists :supersede)
              (write-sequence result f))
            (let ((tangle-result (org-tangle-file org-path)))
              (list :status :success
                    :action (format nil "Fixed ~d block(s) in ~a" fixed skill-name)
                    :repaired t :tangle tangle-result)))
          (list :status :error
                :reason (format nil "No unbalanced blocks in ~a" skill-name)
                :repaired nil)))))

Self-Fix: Error Diagnosis and Repair

Parses an error log to diagnose the error type, then dispatches to the appropriate repair function. Currently supports syntax error repair (unbalanced parentheses). Other error types return a diagnosis without automatic repair.

;; REPL-VERIFIED: 2026-05-03T14:00:00

(defun self-improve-fix (skill-name error-log)
  "Diagnoses and attempts to repair a failing skill."
  (when (or (null skill-name) (null error-log))
    (return-from self-improve-fix
      (list :status :error :reason "Missing arguments: skill-name and error-log required")))
  (log-message "SELF-IMPROVE: Diagnosing ~a..." skill-name)
  (let* ((log-str (if (stringp error-log) error-log (format nil "~a" error-log)))
         (diagnosis nil)
         (extracted-type nil))
    (cond
      ((search "Reader Error" log-str :test 'char-equal)
       (setf extracted-type :syntax-error
             diagnosis (list :type :syntax-error
                            :detail "Reader Error (likely unbalanced parentheses)"
                            :log log-str)))
      ((search "Undefined" log-str :test 'char-equal)
       (setf extracted-type :undefined-symbol
             diagnosis (list :type :undefined-symbol
                            :detail "Undefined symbol or missing dependency"
                            :log log-str)))
      ((search "PACKAGE" log-str :test 'char-equal)
       (setf extracted-type :package-error
             diagnosis (list :type :package-error
                            :detail "Package resolution error"
                            :log log-str)))
      (t
       (setf extracted-type :unknown
             diagnosis (list :type :unknown
                            :detail (format nil "Unrecognized error: ~a"
                                            (subseq log-str 0 (min 200 (length log-str))))
                            :log log-str))))
    (log-message "SELF-IMPROVE: Diagnosed ~a as ~a" skill-name extracted-type)
    (let ((repair-result
            (when (eql extracted-type :syntax-error)
              (self-improve-repair-syntax skill-name))))
      (if (and repair-result (getf repair-result :repaired))
          (progn
            (log-message "SELF-IMPROVE: Successfully repaired ~a" skill-name)
            repair-result)
          (list :status :error
                :reason (format nil "Diagnosis for ~a: ~a" skill-name
                                (getf diagnosis :detail))
                :diagnosis diagnosis
                :repaired nil)))))

Skill Registration

Registered with a trigger on :LOG and :EVENT context types. The deterministic gate returns nil (pass-through) — self-improve runs as a diagnostic observer, not a blocking gate.

(defskill :passepartout-symbolic-self-improve
  :priority 100
  :trigger (lambda (ctx) (member (getf ctx :type) '(:LOG :EVENT)))
  :deterministic (lambda (action ctx) (declare (ignore action ctx)) nil))