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:
@@ -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))
|
||||
|
||||
@@ -110,8 +110,9 @@
|
||||
;; --- Symbolic Logic ---
|
||||
#:list-objects-with-attribute
|
||||
#:org-id-new
|
||||
|
||||
|
||||
;; --- AST Helpers ---
|
||||
|
||||
#:find-headline-missing-id
|
||||
|
||||
;; --- Environment Config ---
|
||||
|
||||
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user