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:
@@ -43,7 +43,21 @@ This is not a cosmetic choice. It means the reasoning pipeline can generate, mod
|
||||
(in-package :passepartout)
|
||||
#+end_src
|
||||
|
||||
** Probabilistic Engine State
|
||||
** Probabilistic Backend Registry
|
||||
|
||||
~*probabilistic-backends*~ is a hash table mapping provider keywords to
|
||||
their handler functions. Populated by ~register-probabilistic-backend~.
|
||||
Skills like system-model-provider register into this table at boot time.
|
||||
|
||||
;; REPL-VERIFIED: 2026-05-03T14:00:00
|
||||
#+begin_src lisp
|
||||
(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))
|
||||
#+end_src
|
||||
|
||||
The probabilistic engine maintains four pieces of global state that control how LLM requests are dispatched:
|
||||
|
||||
@@ -107,52 +121,33 @@ This is deliberately resilient. The system should never crash because an LLM pro
|
||||
(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."))))
|
||||
|
||||
#+end_src
|
||||
|
||||
** Cognitive Proposal Generation (think)
|
||||
|
||||
The ~think~ function is where the creative brain does its work. It assembles the full context for the LLM: the system identity, the available tools, the current global context from memory, the recent system logs, and any rejection trace from a previous failed proposal. It also collects augment strings from any skill that has registered a ~system-prompt-augment~ function.
|
||||
|
||||
A note on the augment system: skills can contribute context-specific mandates to the LLM prompt. For example, the REPL skill injects the "prototype in the REPL first" mandate when the context suggests the agent is editing Lisp code. This keeps domain-specific instructions out of the harness while still ensuring they appear in the prompt when relevant.
|
||||
|
||||
The LLM's response is expected to be a plist. If it is, it gets parsed and normalized. If it's a string that starts with ~(~ or ~[~, it's read as Lisp data. If it's neither, it falls back to a REQUEST with a MESSAGE action — the raw text.
|
||||
|
||||
** Pre-processing: strip markdown from LLM output
|
||||
|
||||
LLMs often wrap structured output in markdown code fences:
|
||||
|
||||
```lisp
|
||||
(:TYPE :REQUEST ...)
|
||||
```
|
||||
|
||||
This function strips the fences so the reader can parse the plist.
|
||||
|
||||
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
||||
#+begin_src lisp
|
||||
(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 ""))
|
||||
@@ -219,13 +214,25 @@ The system prompt assembly order — identity, tools, context, logs, mandates
|
||||
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."))))))
|
||||
#+end_src
|
||||
@@ -245,29 +252,29 @@ This architecture makes safety compositional: each skill adds one constraint. Th
|
||||
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
||||
#+begin_src lisp
|
||||
(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