rename gateway-* → system-model-* + gateway-messaging, de-ollama, add system-model-explorer
- Rename gateway-provider → system-model-provider (generic :local provider, no hardcoded ollama) - Rename gateway-llm → system-model (model-request dispatcher) - Rename system-embedding-gateway → system-model-embedding - Rename gateway-manager → gateway-messaging (public api renamed to messaging-*) - Add system-model-explorer (model discovery via OpenRouter API, cached, per-slot recommendations) - Fix skill loader export: replace prefix-matching with fbound/boundp-based export (20 skills now export) - Add model-router to skill-loader exclusion list (loaded via CLI) - De-ollama: remove hardcoded assumed-available patterns from provider pipeline - Default cascade: cloud-only (openrouter, openai, groq, gemini, deepseek, nvidia, anthropic) - Env example: add LOCAL_BASE_URL, fix cascade order - All org files updated with architectural prose (literate programming)
This commit is contained in:
@@ -1,5 +1,12 @@
|
||||
(in-package :passepartout)
|
||||
|
||||
(defvar *probabilistic-backends* (make-hash-table :test 'equal)
|
||||
"Maps provider keyword → handler function (prompt system-prompt &key model).")
|
||||
|
||||
(defun register-probabilistic-backend (name fn)
|
||||
"Register FN as the handler for provider NAME."
|
||||
(setf (gethash name *probabilistic-backends*) fn))
|
||||
|
||||
(defvar *backend-registry* (make-hash-table :test 'equal))
|
||||
|
||||
(defvar *provider-cascade* nil)
|
||||
@@ -15,30 +22,33 @@
|
||||
(system-prompt "You are the Probabilistic engine.")
|
||||
(cascade nil)
|
||||
(context nil))
|
||||
(let ((backends (or cascade *provider-cascade*)))
|
||||
(or (dolist (backend backends)
|
||||
(let ((backend-fn (gethash backend *backend-registry*)))
|
||||
(when backend-fn
|
||||
(log-message "PROBABILISTIC: Attempting backend ~a..." backend)
|
||||
(let* ((model-val (when *model-selector*
|
||||
(funcall *model-selector* backend context))))
|
||||
(if (eq model-val :skip)
|
||||
(log-message "PROBABILISTIC: Skipping ~a (filtered)" backend)
|
||||
(let* ((model (if model-val model-val nil))
|
||||
(result (if model
|
||||
(funcall backend-fn prompt system-prompt :model model)
|
||||
(funcall backend-fn prompt system-prompt))))
|
||||
(cond ((and (listp result) (eq (getf result :status) :success))
|
||||
(return (getf result :content)))
|
||||
((stringp result)
|
||||
(return result))
|
||||
(t
|
||||
(log-message "PROBABILISTIC: Backend ~a failed: ~a"
|
||||
backend (getf result :message)))))))))))
|
||||
(list :type :LOG
|
||||
:payload (list :text "Neural Cascade Failure: All providers exhausted."))))
|
||||
|
||||
(defun markdown-strip (text)
|
||||
(let ((backends (or cascade *provider-cascade*))
|
||||
(result nil))
|
||||
(dolist (backend backends (or result
|
||||
(list :type :LOG
|
||||
:payload (list :text "Neural Cascade Failure: All providers exhausted."))))
|
||||
(let ((backend-fn (or (gethash backend *backend-registry*)
|
||||
(gethash backend *probabilistic-backends*))))
|
||||
(when backend-fn
|
||||
(log-message "PROBABILISTIC: Attempting backend ~a..." backend)
|
||||
(let* ((model (and *model-selector*
|
||||
(funcall *model-selector* backend context)))
|
||||
(skip (eq model :skip))
|
||||
(r (unless skip
|
||||
(if (and model (not skip))
|
||||
(funcall backend-fn prompt system-prompt :model model)
|
||||
(funcall backend-fn prompt system-prompt)))))
|
||||
(when skip
|
||||
(log-message "PROBABILISTIC: Skipping ~a (filtered)" backend))
|
||||
(cond ((and (listp r) (eq (getf r :status) :success))
|
||||
(setf result (getf r :content))
|
||||
(return result))
|
||||
((stringp r)
|
||||
(setf result r)
|
||||
(return result))
|
||||
(t
|
||||
(log-message "PROBABILISTIC: Backend ~a failed: ~a"
|
||||
backend (getf r :message))))))))))(defun markdown-strip (text)
|
||||
(if (and text (stringp text))
|
||||
(let ((cleaned text))
|
||||
(setf cleaned (cl-ppcre:regex-replace-all "^```[a-z]*\\n" cleaned ""))
|
||||
@@ -84,40 +94,52 @@
|
||||
assistant-name reflection-feedback tool-belt global-context system-logs
|
||||
(or skill-augments ""))))
|
||||
(let* ((thought (backend-cascade-call raw-prompt :system-prompt system-prompt :context context))
|
||||
(cleaned (markdown-strip thought)))
|
||||
(cleaned (if (and (listp thought) (getf thought :type))
|
||||
(format nil "~a" (getf (getf thought :payload) :text))
|
||||
(markdown-strip thought))))
|
||||
(if (and cleaned (stringp cleaned) (> (length cleaned) 0) (or (char= (char cleaned 0) #\() (char= (char cleaned 0) #\[)))
|
||||
(handler-case
|
||||
(let ((parsed (read-from-string cleaned)))
|
||||
(if (listp parsed)
|
||||
(plist-keywords-normalize parsed)
|
||||
(list :TYPE :REQUEST :PAYLOAD (list :ACTION :MESSAGE :TEXT cleaned :EXPLANATION "Generated by the Probabilistic engine."))))
|
||||
(let ((parsed (read-from-string cleaned)))
|
||||
(if (listp parsed)
|
||||
(let ((normalized (plist-keywords-normalize parsed)))
|
||||
;; Ensure explanation is present in the payload for policy gate
|
||||
(let ((payload (proto-get normalized :payload)))
|
||||
(if (and payload (proto-get payload :explanation))
|
||||
normalized
|
||||
(let ((new-payload (list* :EXPLANATION "Generated by the Probabilistic engine."
|
||||
(if (listp payload) payload nil))))
|
||||
(list* :PAYLOAD new-payload
|
||||
(loop for (k v) on normalized by #'cddr
|
||||
unless (eq k :PAYLOAD)
|
||||
collect k collect v))))))
|
||||
(list :TYPE :REQUEST :PAYLOAD (list :ACTION :MESSAGE :TEXT cleaned :EXPLANATION "Generated by the Probabilistic engine."))))
|
||||
(error () (list :TYPE :REQUEST :PAYLOAD (list :ACTION :MESSAGE :TEXT cleaned :EXPLANATION "Generated by the Probabilistic engine."))))
|
||||
(list :TYPE :REQUEST :PAYLOAD (list :ACTION :MESSAGE :TEXT (if (stringp cleaned) cleaned "No response") :EXPLANATION "Generated by the Probabilistic engine."))))))
|
||||
|
||||
(defun cognitive-verify (proposed-action context)
|
||||
"Runs all registered deterministic gates against the proposed action.
|
||||
Returns either a rejection plist (for :LOG or :EVENT errors) or the
|
||||
modified action (for approval-required or pass)."
|
||||
"Runs all registered deterministic gates against the proposed action,
|
||||
sorted by priority (highest first). Returns a rejection plist or the action."
|
||||
(let ((current-action (copy-tree proposed-action))
|
||||
(approval-needed nil)
|
||||
(approval-action nil))
|
||||
(approval-action nil)
|
||||
(gates nil))
|
||||
;; Collect gates sorted by priority (highest first)
|
||||
(maphash (lambda (name skill)
|
||||
(declare (ignore name))
|
||||
(when (skill-deterministic-fn skill)
|
||||
(let ((gate (skill-deterministic-fn skill)))
|
||||
(when gate
|
||||
(let ((result (funcall gate current-action context)))
|
||||
(cond
|
||||
;; Approval-required: remember it and continue checking
|
||||
((eq (getf result :level) :approval-required)
|
||||
(setf approval-needed t
|
||||
approval-action (getf (getf result :payload) :action)))
|
||||
;; Hard rejection: return immediately
|
||||
((member (getf result :type) '(:LOG :EVENT))
|
||||
(return-from cognitive-verify result))
|
||||
;; Normal: update action
|
||||
(t (setf current-action result))))))))
|
||||
(push (cons (skill-priority skill) (skill-deterministic-fn skill)) gates)))
|
||||
*skill-registry*)
|
||||
(setf gates (sort gates #'> :key #'car))
|
||||
(dolist (gate-pair gates)
|
||||
(let ((result (funcall (cdr gate-pair) current-action context)))
|
||||
(cond
|
||||
((eq (getf result :level) :approval-required)
|
||||
(setf approval-needed t
|
||||
approval-action (getf (getf result :payload) :action)))
|
||||
((member (getf result :type) '(:LOG :EVENT))
|
||||
(return-from cognitive-verify result))
|
||||
((and (listp result) result)
|
||||
(setf current-action result)))))
|
||||
(if approval-needed
|
||||
(list :type :EVENT :level :approval-required
|
||||
:payload (list :sensor :approval-required
|
||||
|
||||
Reference in New Issue
Block a user