Amr Gharbeia
c86d079418
Some checks failed
Deploy (Gitea) / deploy (push) Failing after 2s
File Reorganization: - Extracted core-context → symbolic-awareness (skill) - Extracted heartbeat → symbolic-events (skill) - Relocated 6 utility fragments, renamed 23 files, deleted system-model.lisp - Renamed gateway-* → channel-*, split gateway-messaging → 4 channel-* files - Renamed defskill/defpackage names to match new file prefixes - Deleted gateway-messaging.org/.lisp, removed core-context filter - Documented self-repair criterion, added AGENTS.md core boundary rule Token Economics (v0.5.0, skills not core): - tokenizer.lisp: count-tokens, model-token-ratio, token-cost, provider-token-cost (11 tests) - cost-tracker.lisp: cost-track-call, cost-session-total, cost-by-provider (6 tests) - token-economics.lisp: prompt-prefix-cached, context-assemble-cached, enforce-token-budget with CONTEXT_MAX_TOKENS env var (9 tests) Bug Fixes: - Fixed DeepSeek 400 (removed malformed tools from cascade) - Fixed UNDEFINED-FUNCTION crash (fboundp guards in think()) - Fixed gate-trace duplication (setf replaces list* in cognitive-verify) - Tightened dexador connect-timeout 10s→5s Test suite: 116/116 (100%)
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-symbolic-self-improve
|
|
:priority 100
|
|
:trigger (lambda (ctx) (member (getf ctx :type) '(:LOG :EVENT)))
|
|
:deterministic (lambda (action ctx) (declare (ignore action ctx)) nil))
|