PSF: Standardize core gates and refine skill loading mechanism

- Improved decide-gate to normalize candidates (wrap strings in RESPONSE)
- Refined load-skill-from-org to skip tangled blocks and Org properties
- Updated system definition and test suites for v1.0
This commit is contained in:
2026-04-12 13:38:29 -04:00
parent 397fcc5e8c
commit 04df131f63
13 changed files with 234 additions and 62 deletions

View File

@@ -53,7 +53,7 @@
(let ((neuro-fn (skill-neuro-prompt skill)))
(if neuro-fn
(let ((proposals (funcall neuro-fn signal)))
(setf (getf signal :proposals) (if (listp (first proposals)) proposals (list proposals))))
(setf (getf signal :proposals) (if (and (listp proposals) (listp (first proposals))) proposals (list proposals))))
(setf (getf signal :proposals) nil)))
(setf (getf signal :proposals) nil))
(setf (getf signal :status) :reasoned)
@@ -94,14 +94,12 @@
:context context))))
(defun decide-gate (signal)
"System 2: Safety and validation."
"Stage 3: Symbolic verification (System 2)."
(let ((candidate (getf signal :candidate)))
(if candidate
(let ((decision (decide candidate signal)))
;; If decision is different from candidate, it's an interception (EVENT or LOG)
(setf (getf signal :approved-action) decision)
(unless (equal decision candidate)
(kernel-log "GATE [Decide]: Intercepted/Rejected by System 2")))
(let* ((normalized-candidate (if (listp candidate) candidate (list :type :RESPONSE :payload (list :text candidate))))
(decision (decide normalized-candidate signal)))
(setf (getf signal :approved-action) decision))
(setf (getf signal :approved-action) nil))
(setf (getf signal :status) :decided)
signal))

View File

@@ -110,8 +110,9 @@
;; --- Symbolic Logic ---
#:list-objects-with-attribute
#:org-id-new
;; --- AST Helpers ---
#:find-headline-missing-id
;; --- Environment Config ---

View File

@@ -126,9 +126,17 @@
(dolist (line lines)
(let ((clean-line (string-trim '(#\Space #\Tab #\Return) line)))
(cond ((uiop:string-prefix-p "#+begin_src lisp" (string-downcase clean-line)) (setf in-lisp-block t))
((uiop:string-prefix-p "#+end_src" (string-downcase clean-line)) (setf in-lisp-block nil))
(in-lisp-block (setf lisp-code (concatenate 'string lisp-code line (string #\Newline)))))))
(cond ((uiop:string-prefix-p "#+begin_src lisp" (string-downcase clean-line))
;; Only load blocks that are NOT tangled to src/ or elsewhere
(if (search ":tangle" (string-downcase clean-line))
(setf in-lisp-block nil)
(setf in-lisp-block t)))
((uiop:string-prefix-p "#+end_src" (string-downcase clean-line))
(setf in-lisp-block nil))
(in-lisp-block
(unless (or (uiop:string-prefix-p ":PROPERTIES:" (string-upcase clean-line))
(uiop:string-prefix-p ":END:" (string-upcase clean-line)))
(setf lisp-code (concatenate 'string lisp-code line (string #\Newline))))))))
(if (= (length lisp-code) 0)
(progn (setf (skill-entry-status entry) :ready) t) ;; Valid empty skill