Amr Gharbeia
ee81fa2755
Some checks failed
Deploy (Gitea) / deploy (push) Has been cancelled
Reworked the system-self-improve skill end-to-end:
1. self-improve-edit:
- Inline text replacement (no longer depends on org-modify which was
in an unexported skill package and broken)
- After editing a .org file, automatically tangles to .lisp, compiles,
and loads the result into the running daemon
- Memory snapshot before edit for rollback safety
2. self-improve-balance-parens:
- New utility: detects unbalanced parens via the Lisp reader, counts
open/close parens using loop+char= (avoiding #\( #\) which
confuse text-based paren counting)
- Returns balanced code or nil if already balanced
3. self-improve-repair-syntax:
- New driver: locates a skill's .org source file, extracts all lisp
blocks, runs each through balance-parens, writes fixes back,
then tangles+compiles+loads
4. self-improve-fix:
- Diagnosis phase (unchanged): pattern-matches error logs for Reader
Error, Undefined symbol, or PACKAGE errors
- Repair phase (new): dispatches syntax errors to
self-improve-repair-syntax; other error types return diagnosis
with :repaired nil
5. Infrastructure:
- org-tangle-file: reads #+PROPERTY: header-args:lisp :tangle from
any .org file, extracts blocks, writes .lisp, compiles, loads
- org-extract-lisp-blocks: extracts all #+begin_src lisp blocks
from an Org content string
199 lines
9.1 KiB
Common Lisp
199 lines
9.1 KiB
Common 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))))))
|
|
|
|
(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)
|
|
"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)))))
|
|
|
|
(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."
|
|
(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)))))
|
|
|
|
(defskill :passepartout-system-self-improve
|
|
:priority 100
|
|
:trigger (lambda (ctx) (member (getf ctx :type) '(:LOG :EVENT)))
|
|
:deterministic (lambda (action ctx) (declare (ignore action ctx)) nil))
|