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

REFAC: Configurable mandatory skills via environment

Browse Source
This commit is contained in:
Amr Gharbeia
2026-04-13 17:28:32 -04:00
parent 222a231d40
commit 22e6d3c242
11 changed files with 257 additions and 103 deletions
Download Patch File Download Diff File Expand all files Collapse all files

43
src/reason.lisp
View File

@@ -1,17 +1,16 @@
(in-package :org-agent)
;; --- 1. Probabilistic Mechanisms ---
(defvar *probabilistic-backends* (make-hash-table :test 'equal))
(defvar *provider-cascade* nil)
(defvar *model-selector-fn* nil)
(defvar *consensus-enabled-p* nil)
(defun register-probabilistic-backend (name fn)
"Registers a neural provider (e.g., :gemini, :anthropic) with its calling function."
(setf (gethash name *probabilistic-backends*) fn))
(defun probabilistic-call (prompt &key (system-prompt "You are the Probabilistic engine.") (cascade nil) (context nil))
"Dispatches a neural request through the provider cascade."
"Dispatches a neural request through the provider cascade. Returns a Lisp plist or a failure log."
(let ((backends (or cascade *provider-cascade*)))
(or (dolist (backend backends)
(let ((backend-fn (gethash backend *probabilistic-backends*)))
@@ -21,48 +20,58 @@
(result (if model
(funcall backend-fn prompt system-prompt :model model)
(funcall backend-fn prompt system-prompt))))
(unless (or (null result) (search ":LOG" result))
;; If the result is valid and doesn't contain a failure log, return it.
(unless (or (null result)
(and (stringp result) (search ":LOG" result)))
(return result))))))
"(:type :LOG :payload (:text \"Neural Cascade Failure\"))")))
;; Final fallback if all backends in the cascade fail.
(list :type :LOG :payload (list :text "Neural Cascade Failure: All providers exhausted.")))))
(defun think (context)
"Generates a Lisp action proposal based on current context."
(let ((active-skill (find-triggered-skill context))
(tool-belt (generate-tool-belt-prompt))
(global-context (context-assemble-global-awareness)))
(let* ((active-skill (find-triggered-skill context))
(tool-belt (generate-tool-belt-prompt))
(global-context (context-assemble-global-awareness))
(assistant-name (or (uiop:getenv "MEMEX_ASSISTANT") "Agent")))
(if active-skill
(let* ((prompt-generator (skill-probabilistic-prompt active-skill))
(raw-prompt (when prompt-generator (funcall prompt-generator context)))
(system-prompt (concatenate 'string "IDENTITY: Actuator for org-agent. MANDATE: ONE Lisp plist. " global-context " " tool-belt)))
(system-prompt (format nil "IDENTITY: Actuator for ~a. MANDATE: ONE Lisp plist. ~a ~a"
assistant-name global-context tool-belt)))
(if (and raw-prompt (> (length raw-prompt) 1))
(let* ((thought (probabilistic-call raw-prompt :system-prompt system-prompt :context context))
(cleaned (string-trim '(#\Space #\Newline #\Tab) thought)))
(handler-case (read-from-string cleaned)
(error (c) (list :type :EVENT :payload (list :sensor :syntax-error :code cleaned :error (format nil "~a" c))))))
'(:type :LOG :payload (:text "Skill triggered (Deterministic only)"))))
;; Ensure we are working with a string for read-from-string
(cleaned (if (stringp thought) (string-trim '(#\Space #\Newline #\Tab) thought) thought)))
(if (stringp cleaned)
(handler-case (read-from-string cleaned)
(error (c) (list :type :EVENT :payload (list :sensor :syntax-error :code cleaned :error (format nil "~a" c)))))
cleaned))
(list :type :LOG :payload (list :text (format nil "Skill '~a' triggered (Deterministic only)" (skill-name active-skill))))))
nil)))
;; --- 2. Deterministic Mechanisms ---
(defun deterministic-verify (proposed-action context)
"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
(dolist (skill skills)
(let ((gate (skill-deterministic-fn skill)))
(setf current-action (funcall gate current-action context))
;; If any gate returns a LOG or EVENT, it has intercepted the action.
(when (and (listp current-action) (member (getf current-action :type) '(:LOG :EVENT)))
(harness-log "DETERMINISTIC: Intercepted by skill '~a'" (skill-name skill))
(return-from deterministic-verify current-action))))
current-action))
;; --- 3. The Unified Entrypoint ---
(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))