amr/passepartout
1
0
Fork 0
Code Issues 15 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

fix: Add normalize-plist-keywords and fix RESPONSE unbound bug

Browse Source 
- Add normalize-plist-keywords to convert LLM output TYPE -> :TYPE
- Fix reason-gate to validate candidate is proper plist
- Add debugging logs to trace LLM responses
- Fix syntax error (extra paren) in think function
This commit is contained in:
Amr Gharbeia
2026-04-22 15:51:03 -04:00
parent 586847bd02
commit cbd786e6b1
3 changed files with 46 additions and 17 deletions
Download Patch File Download Diff File Expand all files Collapse all files

28
harness/reason.org
View File

@@ -58,6 +58,15 @@ The Reason stage is the cognitive engine of the OpenCortex. It bridges the gap b
(string-trim '(#\Space #\Newline #\Tab) cleaned)) (string-trim '(#\Space #\Newline #\Tab) cleaned))
text)) text))
(defun normalize-plist-keywords (plist)
"Normalize all keys in a plist to keywords (e.g., TYPE -> :TYPE)."
(when (listp plist)
(loop for (k . rest) on plist by #'cddr
collect (if (and (symbolp k) (not (keywordp k)))
(intern (string k) :keyword)
k)
collect (car rest))))
(defun think (context) (defun think (context)
"Generates a Lisp action proposal based on current context." "Generates a Lisp action proposal based on current context."
(let* ((active-skill (find-triggered-skill context)) (let* ((active-skill (find-triggered-skill context))
@@ -65,31 +74,33 @@ The Reason stage is the cognitive engine of the OpenCortex. It bridges the gap b
(global-context (context-assemble-global-awareness)) (global-context (context-assemble-global-awareness))
(system-logs (context-get-system-logs)) (system-logs (context-get-system-logs))
(assistant-name (or (uiop:getenv "MEMEX_ASSISTANT") "Agent"))) (assistant-name (or (uiop:getenv "MEMEX_ASSISTANT") "Agent")))
(let* ((prompt-generator (when active-skill (skill-probabilistic-prompt active-skill))) (let* ((prompt-generator (when active-skill (skill-probabilistic-prompt active-skill))))
(raw-prompt (if prompt-generator (raw-prompt (if prompt-generator
(funcall prompt-generator context) (funcall prompt-generator context)
(let ((p (proto-get (proto-get context :payload) :text))) (let ((p (proto-get (proto-get context :payload) :text)))
(if (and p (stringp p)) p "Maintain metabolic stasis.")))) (if (and p (stringp p)) p "Maintain metabolic stasis."))))
(system-prompt (format nil "IDENTITY: ~a. MANDATE: Respond with ONE Lisp plist. ~a ~a RECENT_LOGS: ~a (system-prompt (format nil "IDENTITY: ~a. MANDATE: Respond with ONE Lisp plist. ~a ~a RECENT_LOGS: ~a
IMPORTANT: To reply to the user, you MUST use: IMPORTANT: To reply to the user, you MUST use:
(:TYPE :REQUEST :PAYLOAD (:ACTION :MESSAGE :TEXT "<Response Text>")) (:TYPE :REQUEST :PAYLOAD (:ACTION :MESSAGE :TEXT \"<Response Text>\"))
To call a tool, you MUST use: To call a tool, you MUST use:
(:TYPE :REQUEST :TARGET :TOOL :ACTION :CALL :TOOL "<name>" :ARGS (:arg1 "val")) (:TYPE :REQUEST :TARGET :TOOL :ACTION :CALL :TOOL \"<name>\" :ARGS (:arg1 \"val\"))
MANDATORY VALIDATION RULE: Before declaring any Lisp code edit complete, you MUST call the `:validate-lisp` tool with the proposed code. If the tool returns `:status :error`, read the `:reason` and `:failed` fields, fix the defect, and re-validate. You are strictly forbidden from relying on your own paren-balancing or syntax intuition. MANDATORY VALIDATION RULE: Before declaring any Lisp code edit complete, you MUST call the `:validate-lisp` tool with the proposed code. If the tool returns `:status :error`, read the `:reason` and `:failed` fields, fix the defect, and re-validate. You are strictly forbidden from relying on your own paren-balancing or syntax intuition.
PROVIDER RULE: Always use the default cascade provider unless a specific model or capability is required for the task." PROVIDER RULE: Always use the default cascade provider unless a specific model or capability is required for the task."
assistant-name global-context tool-belt system-logs))) assistant-name global-context tool-belt system-logs)))
(let* ((thought (probabilistic-call raw-prompt :system-prompt system-prompt :context context)) (let* ((thought (probabilistic-call raw-prompt :system-prompt system-prompt :context context))
(cleaned (strip-markdown thought)) (cleaned (strip-markdown thought))
(meta (proto-get context :meta)) (meta (proto-get context :meta))
(source (proto-get meta :source))) (source (proto-get meta :source)))
(harness-log "THINK: raw cleaned = ~a" (subseq cleaned 0 (min 100 (length cleaned))))
(if (and cleaned (stringp cleaned)) (if (and cleaned (stringp cleaned))
(let ((*read-eval* nil)) (let ((*read-eval* nil))
(if (and (> (length cleaned) 0) (char= (char cleaned 0) #\()) (if (and (> (length cleaned) 0) (char= (char cleaned 0) #\())
(handler-case (handler-case
(let ((parsed (read-from-string cleaned))) (let ((parsed (read-from-string cleaned)))
(harness-log "THINK: parsed = ~a" parsed)
(let ((type (proto-get parsed :TYPE)) (let ((type (proto-get parsed :TYPE))
(target (or (proto-get parsed :TARGET) (proto-get parsed :target)))) (target (or (proto-get parsed :TARGET) (proto-get parsed :target))))
(cond ((member type '(:REQUEST :EVENT :STATUS :RESPONSE)) (cond ((member type '(:REQUEST :EVENT :STATUS :RESPONSE))
@@ -100,7 +111,7 @@ PROVIDER RULE: Always use the default cascade provider unless a specific model o
(and (listp parsed) (listp (car parsed)) (keywordp (caar parsed)))) (and (listp parsed) (listp (car parsed)) (keywordp (caar parsed))))
(list :TYPE :REQUEST :TARGET :TOOL :PAYLOAD parsed)) (list :TYPE :REQUEST :TARGET :TOOL :PAYLOAD parsed))
(t (list :TYPE :REQUEST :TARGET (or source :CLI) :PAYLOAD (list :ACTION :MESSAGE :TEXT cleaned)))))) (t (list :TYPE :REQUEST :TARGET (or source :CLI) :PAYLOAD (list :ACTION :MESSAGE :TEXT cleaned))))))
(error (c) (list :TYPE :REQUEST :TARGET (or source :CLI) :PAYLOAD (list :ACTION :MESSAGE :TEXT cleaned)))) (error (c) (harness-log "THINK ERROR: ~a" c) (list :TYPE :REQUEST :TARGET (or source :CLI) :PAYLOAD (list :ACTION :MESSAGE :TEXT cleaned))))
(list :TYPE :REQUEST :TARGET (or source :CLI) :PAYLOAD (list :ACTION :MESSAGE :TEXT cleaned)))) (list :TYPE :REQUEST :TARGET (or source :CLI) :PAYLOAD (list :ACTION :MESSAGE :TEXT cleaned))))
thought))))) thought)))))
#+end_src #+end_src
@@ -139,9 +150,12 @@ PROVIDER RULE: Always use the default cascade provider unless a specific model o
(unless (and (eq type :EVENT) (member sensor '(:user-input :chat-message))) (unless (and (eq type :EVENT) (member sensor '(:user-input :chat-message)))
(return-from reason-gate signal)) (return-from reason-gate signal))
(let ((candidate (think signal))) (let ((candidate (think signal)))
(if candidate (harness-log "REASON: candidate = ~a" (type-of candidate))
(if (and candidate (listp candidate) (keywordp (car candidate)))
(setf (getf signal :approved-action) (deterministic-verify candidate signal)) (setf (getf signal :approved-action) (deterministic-verify candidate signal))
(setf (getf signal :approved-action) nil)) (progn
(harness-log "REASON: Invalid candidate type ~a, dropping" (type-of candidate))
(setf (getf signal :approved-action) nil)))
(setf (getf signal :status) :reasoned) (setf (getf signal :status) :reasoned)
signal))) signal)))
#+end_src #+end_src

BIN
library/reason.fasl Normal file
View File

Binary file not shown.

35
library/reason.lisp
View File

@@ -36,6 +36,15 @@
(string-trim '(#\Space #\Newline #\Tab) cleaned)) (string-trim '(#\Space #\Newline #\Tab) cleaned))
text)) text))
(defun normalize-plist-keywords (plist)
"Normalize all keys in a plist to keywords (e.g., TYPE -> :TYPE)."
(when (listp plist)
(loop for (k . rest) on plist by #'cddr
collect (if (and (symbolp k) (not (keywordp k)))
(intern (string k) :keyword)
k)
collect (car rest))))
(defun think (context) (defun think (context)
"Generates a Lisp action proposal based on current context." "Generates a Lisp action proposal based on current context."
(let* ((active-skill (find-triggered-skill context)) (let* ((active-skill (find-triggered-skill context))
@@ -50,35 +59,37 @@
(if (and p (stringp p)) p "Maintain metabolic stasis.")))) (if (and p (stringp p)) p "Maintain metabolic stasis."))))
(system-prompt (format nil "IDENTITY: ~a. MANDATE: Respond with ONE Lisp plist. ~a ~a RECENT_LOGS: ~a (system-prompt (format nil "IDENTITY: ~a. MANDATE: Respond with ONE Lisp plist. ~a ~a RECENT_LOGS: ~a
IMPORTANT: To reply to the user, you MUST use: IMPORTANT: To reply to the user, you MUST use:
(:TYPE :REQUEST :PAYLOAD (:ACTION :MESSAGE :TEXT "<Response Text>")) (:TYPE :REQUEST :PAYLOAD (:ACTION :MESSAGE :TEXT \"<Response Text>\"))
To call a tool, you MUST use: To call a tool, you MUST use:
(:TYPE :REQUEST :TARGET :TOOL :ACTION :CALL :TOOL "<name>" :ARGS (:arg1 "val")) (:TYPE :REQUEST :TARGET :TOOL :ACTION :CALL :TOOL \"<name>\" :ARGS (:arg1 \"val\"))
MANDATORY VALIDATION RULE: Before declaring any Lisp code edit complete, you MUST call the `:validate-lisp` tool with the proposed code. If the tool returns `:status :error`, read the `:reason` and `:failed` fields, fix the defect, and re-validate. You are strictly forbidden from relying on your own paren-balancing or syntax intuition. MANDATORY VALIDATION RULE: Before declaring any Lisp code edit complete, you MUST call the `:validate-lisp` tool with the proposed code. If the tool returns `:status :error`, read the `:reason` and `:failed` fields, fix the defect, and re-validate. You are strictly forbidden from relying on your own paren-balancing or syntax intuition.
PROVIDER RULE: Always use the default cascade provider unless a specific model or capability is required for the task." PROVIDER RULE: Always use the default cascade provider unless a specific model or capability is required for the task."
assistant-name global-context tool-belt system-logs))) assistant-name global-context tool-belt system-logs)))
(let* ((thought (probabilistic-call raw-prompt :system-prompt system-prompt :context context)) (let* ((thought (probabilistic-call raw-prompt :system-prompt system-prompt :context context))
(cleaned (strip-markdown thought)) (cleaned (strip-markdown thought))
(meta (proto-get context :meta)) (meta (proto-get context :meta))
(source (proto-get meta :source))) (source (proto-get meta :source)))
(harness-log "THINK: raw cleaned = ~a" (subseq cleaned 0 (min 100 (length cleaned))))
(if (and cleaned (stringp cleaned)) (if (and cleaned (stringp cleaned))
(let ((*read-eval* nil)) (let ((*read-eval* nil))
(if (and (> (length cleaned) 0) (char= (char cleaned 0) #\()) (if (and (> (length cleaned) 0) (char= (char cleaned 0) #\())
(handler-case (handler-case
(let ((parsed (read-from-string cleaned))) (let ((parsed (read-from-string cleaned)))
(let ((type (proto-get parsed :TYPE)) (harness-log "THINK: parsed = ~a" parsed)
(let ((parsed-normalized (normalize-plist-keywords parsed))
(type (proto-get parsed :TYPE))
(target (or (proto-get parsed :TARGET) (proto-get parsed :target)))) (target (or (proto-get parsed :TARGET) (proto-get parsed :target))))
(cond ((member type '(:REQUEST :EVENT :STATUS :RESPONSE)) (cond ((member type '(:REQUEST :EVENT :STATUS :RESPONSE))
(unless (proto-get parsed :target) (setf (getf parsed :target) (or source :CLI))) (unless (proto-get parsed :target) (setf (getf parsed :target) (or source :CLI)))
parsed) parsed-normalized)
;; Handle raw plists or lists of plists that look like tool calls or data
((or (eq target :TOOL) (eq target :tool) (getf parsed :TOOL) (getf parsed :tool) ((or (eq target :TOOL) (eq target :tool) (getf parsed :TOOL) (getf parsed :tool)
(and (listp parsed) (listp (car parsed)) (keywordp (caar parsed)))) (and (listp parsed) (listp (car parsed)) (keywordp (caar parsed))))
(list :TYPE :REQUEST :TARGET :TOOL :PAYLOAD parsed)) (list :TYPE :REQUEST :TARGET :TOOL :PAYLOAD (normalize-plist-keywords parsed)))
(t (list :TYPE :REQUEST :TARGET (or source :CLI) :PAYLOAD (list :ACTION :MESSAGE :TEXT cleaned)))))) (t (list :TYPE :REQUEST :TARGET (or source :CLI) :PAYLOAD (list :ACTION :MESSAGE :TEXT cleaned))))))
(error (c) (list :TYPE :REQUEST :TARGET (or source :CLI) :PAYLOAD (list :ACTION :MESSAGE :TEXT cleaned)))) (error (c) (harness-log "THINK ERROR: ~a" c) (list :TYPE :REQUEST :TARGET (or source :CLI) :PAYLOAD (list :ACTION :MESSAGE :TEXT cleaned))))
(list :TYPE :REQUEST :TARGET (or source :CLI) :PAYLOAD (list :ACTION :MESSAGE :TEXT cleaned)))) (list :TYPE :REQUEST :TARGET (or source :CLI) :PAYLOAD (list :ACTION :MESSAGE :TEXT cleaned))))
thought))))) thought)))))
@@ -111,8 +122,12 @@ PROVIDER RULE: Always use the default cascade provider unless a specific model o
(unless (and (eq type :EVENT) (member sensor '(:user-input :chat-message))) (unless (and (eq type :EVENT) (member sensor '(:user-input :chat-message)))
(return-from reason-gate signal)) (return-from reason-gate signal))
(let ((candidate (think signal))) (let ((candidate (think signal)))
(if candidate (harness-log "REASON: candidate = ~a" (type-of candidate))
(if (and candidate (listp candidate)
(or (keywordp (car candidate)) (eq (car candidate) 'TYPE) (eq (car candidate) 'type)))
(setf (getf signal :approved-action) (deterministic-verify candidate signal)) (setf (getf signal :approved-action) (deterministic-verify candidate signal))
(setf (getf signal :approved-action) nil)) (progn
(harness-log "REASON: Invalid candidate type ~a, dropping" (type-of candidate))
(setf (getf signal :approved-action) nil)))
(setf (getf signal :status) :reasoned) (setf (getf signal :status) :reasoned)
signal))) signal)))