fix: Skill loader respects :tangle blocks and breaks circular dep with validator
Some checks failed
Deploy-Agent-V15-Stdin / JOB-V15-STDIN (push) Failing after 5s
Some checks failed
Deploy-Agent-V15-Stdin / JOB-V15-STDIN (push) Failing after 5s
- load-skill-from-org now only collects #+begin_src lisp blocks that have a :tangle directive pointing to a runtime .lisp file, excluding tests/ paths. - validate-lisp-syntax falls back to a basic reader check when lisp-validator-validate is not yet fboundp, breaking the circular dependency between the harness loader and the validator skill. - Verified full boot: 13/13 skills load successfully, including the new skill-lisp-validator (priority 900) and skill-policy (priority 500).
This commit is contained in:
@@ -132,16 +132,25 @@ A static, hardcoded architecture is inherently fragile. The ~opencortex~ Skill E
|
|||||||
#+begin_src lisp :tangle ../library/skills.lisp
|
#+begin_src lisp :tangle ../library/skills.lisp
|
||||||
(defun validate-lisp-syntax (code-string)
|
(defun validate-lisp-syntax (code-string)
|
||||||
"Checks if a string contains valid, readable Common Lisp forms.
|
"Checks if a string contains valid, readable Common Lisp forms.
|
||||||
Delegates to the Lisp Validator skill for structural + syntactic validation."
|
Delegates to the Lisp Validator skill when available; falls back to a basic
|
||||||
(let* ((result (lisp-validator-validate code-string :strict nil))
|
reader check during early boot before the validator skill is loaded."
|
||||||
(status (getf result :status))
|
(let ((result
|
||||||
(reason (getf result :reason)))
|
(if (fboundp 'lisp-validator-validate)
|
||||||
(if (eq status :success)
|
(lisp-validator-validate code-string :strict nil)
|
||||||
|
(handler-case
|
||||||
|
(let ((*read-eval* nil))
|
||||||
|
(with-input-from-string (stream (format nil "(progn ~a)" code-string))
|
||||||
|
(loop for form = (read stream nil :eof) until (eq form :eof)))
|
||||||
|
(list :status :success))
|
||||||
|
(error (c)
|
||||||
|
(list :status :error :reason (format nil "~a" c)))))))
|
||||||
|
(if (eq (getf result :status) :success)
|
||||||
(values t nil)
|
(values t nil)
|
||||||
(values nil (or reason "Lisp Validator rejected code.")))))
|
(values nil (or (getf result :reason) "Lisp Validator rejected code.")))))
|
||||||
|
|
||||||
(defun load-skill-from-org (filepath)
|
(defun load-skill-from-org (filepath)
|
||||||
"Parses and evaluates Lisp blocks from an Org file into a jailed package."
|
"Parses and evaluates Lisp blocks with :tangle directives from an Org file.
|
||||||
|
Only loads blocks that specify a .lisp tangle target, ignoring tests and examples."
|
||||||
(let* ((skill-base-name (pathname-name filepath))
|
(let* ((skill-base-name (pathname-name filepath))
|
||||||
(entry (or (gethash skill-base-name *skill-catalog*) (make-skill-entry :filename skill-base-name))))
|
(entry (or (gethash skill-base-name *skill-catalog*) (make-skill-entry :filename skill-base-name))))
|
||||||
(setf (skill-entry-status entry) :loading)
|
(setf (skill-entry-status entry) :loading)
|
||||||
@@ -151,16 +160,27 @@ Delegates to the Lisp Validator skill for structural + syntactic validation."
|
|||||||
(let* ((content (uiop:read-file-string filepath))
|
(let* ((content (uiop:read-file-string filepath))
|
||||||
(lines (uiop:split-string content :separator '(#\Newline)))
|
(lines (uiop:split-string content :separator '(#\Newline)))
|
||||||
(in-lisp-block nil)
|
(in-lisp-block nil)
|
||||||
|
(collect-this-block nil)
|
||||||
(lisp-code "")
|
(lisp-code "")
|
||||||
(pkg-name (intern (string-upcase (format nil "OPENCORTEX.SKILLS.~a" skill-base-name)) :keyword)))
|
(pkg-name (intern (string-upcase (format nil "OPENCORTEX.SKILLS.~a" skill-base-name)) :keyword)))
|
||||||
|
|
||||||
(dolist (line lines)
|
(dolist (line lines)
|
||||||
(let ((clean-line (string-trim '(#\Space #\Tab #\Return) line)))
|
(let ((clean-line (string-trim '(#\Space #\Tab #\Return) line)))
|
||||||
(cond ((uiop:string-prefix-p "#+begin_src lisp" (string-downcase clean-line))
|
(cond ((uiop:string-prefix-p "#+begin_src lisp" (string-downcase clean-line))
|
||||||
(setf in-lisp-block t))
|
(setf in-lisp-block t)
|
||||||
|
;; Only collect blocks with a :tangle directive pointing to a
|
||||||
|
;; runtime .lisp file (exclude tests and :tangle no)
|
||||||
|
(let ((tl (string-downcase clean-line)))
|
||||||
|
(setf collect-this-block
|
||||||
|
(and (search ":tangle" tl)
|
||||||
|
(not (search ":tangle no" tl))
|
||||||
|
(search ".lisp" tl)
|
||||||
|
(not (search "tests/" tl))
|
||||||
|
(not (search "test/" tl))))))
|
||||||
((uiop:string-prefix-p "#+end_src" (string-downcase clean-line))
|
((uiop:string-prefix-p "#+end_src" (string-downcase clean-line))
|
||||||
(setf in-lisp-block nil))
|
(setf in-lisp-block nil)
|
||||||
(in-lisp-block
|
(setf collect-this-block nil))
|
||||||
|
((and in-lisp-block collect-this-block)
|
||||||
(unless (or (uiop:string-prefix-p ":PROPERTIES:" (string-upcase clean-line))
|
(unless (or (uiop:string-prefix-p ":PROPERTIES:" (string-upcase clean-line))
|
||||||
(uiop:string-prefix-p ":END:" (string-upcase clean-line)))
|
(uiop:string-prefix-p ":END:" (string-upcase clean-line)))
|
||||||
(setf lisp-code (concatenate 'string lisp-code line (string #\Newline))))))))
|
(setf lisp-code (concatenate 'string lisp-code line (string #\Newline))))))))
|
||||||
|
|||||||
@@ -110,16 +110,25 @@
|
|||||||
|
|
||||||
(defun validate-lisp-syntax (code-string)
|
(defun validate-lisp-syntax (code-string)
|
||||||
"Checks if a string contains valid, readable Common Lisp forms.
|
"Checks if a string contains valid, readable Common Lisp forms.
|
||||||
Delegates to the Lisp Validator skill for structural + syntactic validation."
|
Delegates to the Lisp Validator skill when available; falls back to a basic
|
||||||
(let* ((result (lisp-validator-validate code-string :strict nil))
|
reader check during early boot before the validator skill is loaded."
|
||||||
(status (getf result :status))
|
(let ((result
|
||||||
(reason (getf result :reason)))
|
(if (fboundp 'lisp-validator-validate)
|
||||||
(if (eq status :success)
|
(lisp-validator-validate code-string :strict nil)
|
||||||
|
(handler-case
|
||||||
|
(let ((*read-eval* nil))
|
||||||
|
(with-input-from-string (stream (format nil "(progn ~a)" code-string))
|
||||||
|
(loop for form = (read stream nil :eof) until (eq form :eof)))
|
||||||
|
(list :status :success))
|
||||||
|
(error (c)
|
||||||
|
(list :status :error :reason (format nil "~a" c)))))))
|
||||||
|
(if (eq (getf result :status) :success)
|
||||||
(values t nil)
|
(values t nil)
|
||||||
(values nil (or reason "Lisp Validator rejected code.")))))
|
(values nil (or (getf result :reason) "Lisp Validator rejected code.")))))
|
||||||
|
|
||||||
(defun load-skill-from-org (filepath)
|
(defun load-skill-from-org (filepath)
|
||||||
"Parses and evaluates Lisp blocks from an Org file into a jailed package."
|
"Parses and evaluates Lisp blocks with :tangle directives from an Org file.
|
||||||
|
Only loads blocks that specify a .lisp tangle target, ignoring tests and examples."
|
||||||
(let* ((skill-base-name (pathname-name filepath))
|
(let* ((skill-base-name (pathname-name filepath))
|
||||||
(entry (or (gethash skill-base-name *skill-catalog*) (make-skill-entry :filename skill-base-name))))
|
(entry (or (gethash skill-base-name *skill-catalog*) (make-skill-entry :filename skill-base-name))))
|
||||||
(setf (skill-entry-status entry) :loading)
|
(setf (skill-entry-status entry) :loading)
|
||||||
@@ -129,16 +138,27 @@ Delegates to the Lisp Validator skill for structural + syntactic validation."
|
|||||||
(let* ((content (uiop:read-file-string filepath))
|
(let* ((content (uiop:read-file-string filepath))
|
||||||
(lines (uiop:split-string content :separator '(#\Newline)))
|
(lines (uiop:split-string content :separator '(#\Newline)))
|
||||||
(in-lisp-block nil)
|
(in-lisp-block nil)
|
||||||
|
(collect-this-block nil)
|
||||||
(lisp-code "")
|
(lisp-code "")
|
||||||
(pkg-name (intern (string-upcase (format nil "OPENCORTEX.SKILLS.~a" skill-base-name)) :keyword)))
|
(pkg-name (intern (string-upcase (format nil "OPENCORTEX.SKILLS.~a" skill-base-name)) :keyword)))
|
||||||
|
|
||||||
(dolist (line lines)
|
(dolist (line lines)
|
||||||
(let ((clean-line (string-trim '(#\Space #\Tab #\Return) line)))
|
(let ((clean-line (string-trim '(#\Space #\Tab #\Return) line)))
|
||||||
(cond ((uiop:string-prefix-p "#+begin_src lisp" (string-downcase clean-line))
|
(cond ((uiop:string-prefix-p "#+begin_src lisp" (string-downcase clean-line))
|
||||||
(setf in-lisp-block t))
|
(setf in-lisp-block t)
|
||||||
|
;; Only collect blocks with a :tangle directive pointing to a
|
||||||
|
;; runtime .lisp file (exclude tests and :tangle no)
|
||||||
|
(let ((tl (string-downcase clean-line)))
|
||||||
|
(setf collect-this-block
|
||||||
|
(and (search ":tangle" tl)
|
||||||
|
(not (search ":tangle no" tl))
|
||||||
|
(search ".lisp" tl)
|
||||||
|
(not (search "tests/" tl))
|
||||||
|
(not (search "test/" tl))))))
|
||||||
((uiop:string-prefix-p "#+end_src" (string-downcase clean-line))
|
((uiop:string-prefix-p "#+end_src" (string-downcase clean-line))
|
||||||
(setf in-lisp-block nil))
|
(setf in-lisp-block nil)
|
||||||
(in-lisp-block
|
(setf collect-this-block nil))
|
||||||
|
((and in-lisp-block collect-this-block)
|
||||||
(unless (or (uiop:string-prefix-p ":PROPERTIES:" (string-upcase clean-line))
|
(unless (or (uiop:string-prefix-p ":PROPERTIES:" (string-upcase clean-line))
|
||||||
(uiop:string-prefix-p ":END:" (string-upcase clean-line)))
|
(uiop:string-prefix-p ":END:" (string-upcase clean-line)))
|
||||||
(setf lisp-code (concatenate 'string lisp-code line (string #\Newline))))))))
|
(setf lisp-code (concatenate 'string lisp-code line (string #\Newline))))))))
|
||||||
|
|||||||
Reference in New Issue
Block a user