fix(reason): Definitive clean-room rewrite of cognition engine (verified syntax)
Some checks failed
Deploy-Agent-V15-Stdin / JOB-V15-STDIN (push) Failing after 2s

This commit is contained in:
2026-04-19 17:26:09 -04:00
parent 3374d27e75
commit aa39bbbaa8
3 changed files with 147 additions and 53 deletions

View File

@@ -20,13 +20,10 @@
(result (if model
(funcall backend-fn prompt system-prompt :model model)
(funcall backend-fn prompt system-prompt))))
;; If the result is valid, return it.
;; If it is an error plist from the gateway, continue the cascade but log it.
(cond ((and (listp result) (eq (getf result :status) :success))
(return (getf result :content)))
((stringp result) (return result))
(t (harness-log "PROBABILISTIC: Backend ~a failed: ~a" backend (getf result :message))))))))
;; Final fallback if all backends in the cascade fail.
(list :type :LOG :payload (list :text "Neural Cascade Failure: All providers exhausted.")))))
(defun think (context)
@@ -55,21 +52,16 @@
"Iterates through all skill deterministic-gates sorted by priority."
(let ((current-action proposed-action)
(skills nil))
;; 1. Collect and sort active gates
(maphash (lambda (name skill) (declare (ignore name)) (when (skill-deterministic-fn skill) (push skill skills))) *skills-registry*)
(setf skills (sort skills #'> :key #'skill-priority))
;; 2. Execute gates sequentially if their trigger allows
(dolist (skill skills)
(let ((trigger (skill-trigger-fn skill))
(gate (skill-deterministic-fn skill)))
(when (or (null trigger) (ignore-errors (funcall trigger context)))
(let ((next-action (funcall gate current-action context)))
;; Interception occurs if the gate returns a signal (LOG/EVENT) AND the original was a REQUEST.
;; If the original was already a LOG/EVENT, we only intercept if the gate returns a NEW signal object.
(let ((original-type (getf current-action :type)))
(let ((original-type (proto-get current-action :type)))
(when (and (listp next-action)
(member (getf next-action :type) '(:LOG :EVENT :log :event))
(member (proto-get next-action :type) '(:LOG :EVENT :log :event))
(or (not (member original-type '(:LOG :EVENT :log :event)))
(not (eq next-action current-action))))
(harness-log "DETERMINISTIC: Intercepted by skill '~a'" (skill-name skill))
@@ -79,12 +71,14 @@
(defun reason-gate (signal)
"Unified Stage: Combines Probabilistic proposals and Deterministic verification."
;; Only process events that haven't been reasoned yet.
(unless (eq (getf signal :type) :EVENT) (return-from reason-gate signal))
(let ((candidate (think signal)))
(if candidate
(setf (getf signal :approved-action) (deterministic-verify candidate signal))
(setf (getf signal :approved-action) nil))
(setf (getf signal :status) :reasoned)
signal))
(let* ((type (proto-get signal :type))
(payload (proto-get signal :payload))
(sensor (proto-get payload :sensor)))
(unless (and (eq type :EVENT) (eq sensor :chat-message))
(return-from reason-gate signal))
(let ((candidate (think signal)))
(if candidate
(setf (getf signal :approved-action) (deterministic-verify candidate signal))
(setf (getf signal :approved-action) nil))
(setf (getf signal :status) :reasoned)
signal)))