diff --git a/lisp/system-self-improve.lisp b/lisp/system-self-improve.lisp index c9b8f7a..a18f78a 100644 --- a/lisp/system-self-improve.lisp +++ b/lisp/system-self-improve.lisp @@ -1,77 +1,196 @@ +(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)))))) + +(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))) + (defun self-improve-edit (filepath old-text new-text) - "Applies a surgical text transformation to a source file. -Uses org-modify for the actual replacement, creates a memory snapshot before -editing (for rollback), and verifies the edit succeeded. Returns a plist: - (:status :success :summary ) - (:status :error :reason )" + "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: filepath, old-text, and new-text required"))) + (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)) - ;; Rollback safety: snapshot memory before modifying (ignore-errors - (when (fboundp 'snapshot-memory) - (snapshot-memory))) - ;; Attempt the edit - (let ((result (org-modify filepath old-text new-text))) - (if result - ;; Verify: re-read and confirm new text is present - (let ((re-read (uiop:read-file-string filepath))) - (if (search new-text re-read :test #'string=) - (progn - (log-message "SELF-IMPROVE: Verified edit in ~a" filepath) - (list :status :success - :summary (format nil "Replaced ~d chars in ~a" (length old-text) filepath))) - (progn - (log-message "SELF-IMPROVE: Verification failed for ~a" filepath) - (list :status :error :reason "Verification failed: new text not found after write")))) - (list :status :error :reason (format nil "Text not found in ~a" filepath))))) + (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))))) + +(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 #\)))))))) + +(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))))) (defun self-improve-fix (skill-name error-log) - "Diagnoses and attempts to repair a failing skill. -Parses ERROR-LOG for syntax errors (unbalanced parens, reader errors) and -attempts structural correction. Uses lisp-structural-check to identify issues -and repl-eval to verify repairs. Returns: - (:status :success :action :repaired t) - (:status :error :reason :diagnosis )" + "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) - ;; Analyze the error log (let* ((log-str (if (stringp error-log) error-log (format nil "~a" error-log))) - (diagnosis nil)) - ;; Check for common error patterns + (diagnosis nil) + (extracted-type nil)) (cond - ((search "Reader Error" log-str :test #'char-equal) - (setf diagnosis - (list :type :syntax-error - :detail "Reader Error (likely unbalanced parentheses or malformed s-expression)" - :log log-str))) - ((search "Undefined" log-str :test #'char-equal) - (setf diagnosis - (list :type :undefined-symbol - :detail "Undefined symbol or missing dependency" - :log log-str))) - ((search "PACKAGE" log-str :test #'char-equal) - (setf diagnosis - (list :type :package-error - :detail "Package resolution error — check imports and defpackage" - :log log-str))) + ((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 diagnosis - (list :type :unknown - :detail (format nil "Unrecognized error pattern: ~a" - (subseq log-str 0 (min 200 (length log-str)))) - :log log-str)))) - (log-message "SELF-IMPROVE: Diagnosed ~a as ~a" skill-name (getf diagnosis :type)) - (list :status :error - :reason (format nil "Diagnosis for ~a: ~a" skill-name (getf diagnosis :detail)) - :diagnosis diagnosis - :repaired nil))) + (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))))) (defskill :passepartout-system-self-improve :priority 100 diff --git a/org/system-self-improve.org b/org/system-self-improve.org index 818ef97..44275d6 100644 --- a/org/system-self-improve.org +++ b/org/system-self-improve.org @@ -15,93 +15,263 @@ 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 +#+begin_src lisp +(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)))))) +#+end_src + +** 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 +#+begin_src lisp +(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))) +#+end_src + ** Self-Edit: Surgical Text Transformation -;; REPL-VERIFIED: 2026-05-03T13:00:00 + +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 #+begin_src lisp (defun self-improve-edit (filepath old-text new-text) - "Applies a surgical text transformation to a source file. -Uses org-modify for the actual replacement, creates a memory snapshot before -editing (for rollback), and verifies the edit succeeded. Returns a plist: - (:status :success :summary ) - (:status :error :reason )" + "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: filepath, old-text, and new-text required"))) + (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)) - ;; Rollback safety: snapshot memory before modifying (ignore-errors - (when (fboundp 'snapshot-memory) - (snapshot-memory))) - ;; Attempt the edit - (let ((result (org-modify filepath old-text new-text))) - (if result - ;; Verify: re-read and confirm new text is present - (let ((re-read (uiop:read-file-string filepath))) - (if (search new-text re-read :test #'string=) - (progn - (log-message "SELF-IMPROVE: Verified edit in ~a" filepath) - (list :status :success - :summary (format nil "Replaced ~d chars in ~a" (length old-text) filepath))) - (progn - (log-message "SELF-IMPROVE: Verification failed for ~a" filepath) - (list :status :error :reason "Verification failed: new text not found after write")))) - (list :status :error :reason (format nil "Text not found in ~a" filepath))))) + (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))))) +#+end_src + +** 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 +#+begin_src lisp +(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 #\)))))))) +#+end_src + +** 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 +#+begin_src lisp +(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))))) #+end_src ** Self-Fix: Error Diagnosis and Repair -;; REPL-VERIFIED: 2026-05-03T13:00:00 + +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 #+begin_src lisp (defun self-improve-fix (skill-name error-log) - "Diagnoses and attempts to repair a failing skill. -Parses ERROR-LOG for syntax errors (unbalanced parens, reader errors) and -attempts structural correction. Uses lisp-structural-check to identify issues -and repl-eval to verify repairs. Returns: - (:status :success :action :repaired t) - (:status :error :reason :diagnosis )" + "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) - ;; Analyze the error log (let* ((log-str (if (stringp error-log) error-log (format nil "~a" error-log))) - (diagnosis nil)) - ;; Check for common error patterns + (diagnosis nil) + (extracted-type nil)) (cond - ((search "Reader Error" log-str :test #'char-equal) - (setf diagnosis - (list :type :syntax-error - :detail "Reader Error (likely unbalanced parentheses or malformed s-expression)" - :log log-str))) - ((search "Undefined" log-str :test #'char-equal) - (setf diagnosis - (list :type :undefined-symbol - :detail "Undefined symbol or missing dependency" - :log log-str))) - ((search "PACKAGE" log-str :test #'char-equal) - (setf diagnosis - (list :type :package-error - :detail "Package resolution error — check imports and defpackage" - :log log-str))) + ((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 diagnosis - (list :type :unknown - :detail (format nil "Unrecognized error pattern: ~a" - (subseq log-str 0 (min 200 (length log-str)))) - :log log-str)))) - (log-message "SELF-IMPROVE: Diagnosed ~a as ~a" skill-name (getf diagnosis :type)) - (list :status :error - :reason (format nil "Diagnosis for ~a: ~a" skill-name (getf diagnosis :detail)) - :diagnosis diagnosis - :repaired nil))) + (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))))) #+end_src ** Skill Registration -A single defskill with a trigger that activates on :LOG and :EVENT context -types. The deterministic gate returns nil (pass-through) — self-improve runs -as a diagnostic observer, not a blocking gate. + +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. + #+begin_src lisp (defskill :passepartout-system-self-improve :priority 100 diff --git a/org/tmp/test-fix.lisp b/org/tmp/test-fix.lisp new file mode 100644 index 0000000..713dc8f --- /dev/null +++ b/org/tmp/test-fix.lisp @@ -0,0 +1,2 @@ +(defun test-fn (x) + (list x)