PSF: Enforce 'Thin Harness' by purging hardcoded vendor logic from core

This commit is contained in:
2026-04-12 16:16:46 -04:00
parent c46c4d4fd7
commit a35480a040
10 changed files with 252 additions and 116 deletions

View File

@@ -26,14 +26,16 @@
(list :api-key legacy)))))))))
(defvar *neuro-backends* (make-hash-table :test 'equal))
(defvar *provider-cascade* '(:openrouter :gemini))
(defvar *consensus-enabled-p* t "If T, ask-neuro queries all backends in parallel.")
(defun register-neuro-backend (name fn) (setf (gethash name *neuro-backends*) fn))
(defvar *model-selector-fn* nil "A function called with (provider context) to return a model ID.")
(defun ask-neuro (prompt &key (system-prompt "You are the System 1 engine of a Neurosymbolic Lisp Machine.") (cascade nil) (context nil))
(defvar *consensus-enabled-p* t "If T, ask-neuro queries all backends in parallel.")
(defun ask-neuro (prompt &key (system-prompt "You are the Associative engine of a Neurosymbolic Lisp Machine.") (cascade nil) (context nil))
"Dispatches a neural request through the provider cascade or parallel consensus."
(let ((backends (cond
((and cascade (listp cascade)) cascade)
@@ -49,7 +51,7 @@
(when backend-fn
(push (bt:make-thread
(lambda ()
(kernel-log "SYSTEM 1 [Consensus]: Querying backend ~a..." backend)
(kernel-log "ASSOCIATIVE [Consensus]: Querying backend ~a..." backend)
(let* ((model (when *model-selector-fn* (funcall *model-selector-fn* backend context)))
(result (ignore-errors
(if model
@@ -73,7 +75,7 @@
(or (dolist (backend backends)
(let ((backend-fn (gethash backend *neuro-backends*)))
(when backend-fn
(kernel-log "SYSTEM 1: Attempting backend ~a..." backend)
(kernel-log "ASSOCIATIVE: Attempting backend ~a..." backend)
(let* ((model (when *model-selector-fn* (funcall *model-selector-fn* backend context)))
(result (if model
(funcall backend-fn prompt system-prompt :model model)
@@ -88,13 +90,14 @@
'(:openrouter :gemini))
(defun think (context)
"Invokes the neural System 1 engine to propose a Lisp action based on context."
"Invokes the neural Associative engine to propose a Lisp action based on context.
If consensus is enabled, it returns a list of proposals from different backends."
(let ((active-skill (find-triggered-skill context))
(tool-belt (generate-tool-belt-prompt))
(global-context (context-assemble-global-awareness)))
(if active-skill
(progn
(kernel-log "SYSTEM 1: Engaging skill '~a'~%" (skill-name active-skill))
(kernel-log "ASSOCIATIVE: Engaging skill '~a'~%" (skill-name active-skill))
(let* ((prompt-generator (skill-neuro-prompt active-skill))
(raw-prompt (when prompt-generator (funcall prompt-generator context)))
(full-system-prompt (concatenate 'string
@@ -122,7 +125,7 @@ To call a tool, you MUST use:
(raw-thoughts (cl-ppcre:split (cl-ppcre:quote-meta-chars "|CONSENSUS-SEP|") thought))
(suggestions nil))
(dolist (raw-thought raw-thoughts)
(kernel-log "SYSTEM 1 RAW: ~a~%" raw-thought)
(kernel-log "ASSOCIATIVE RAW: ~a~%" raw-thought)
(let* ((cleaned-thought
(let ((match (cl-ppcre:scan-to-strings "(?s)```(?:lisp)?\\n?(.*?)\\n?```" raw-thought)))
(if match
@@ -136,7 +139,7 @@ To call a tool, you MUST use:
(list :sensor :syntax-error
:code cleaned-thought
:error (format nil "~a" c)))))))
(kernel-log "SYSTEM 1 Suggestion: ~a~%" cleaned-thought)
(kernel-log "ASSOCIATIVE Suggestion: ~a~%" cleaned-thought)
(when (and suggestion (listp suggestion))
(push suggestion suggestions))))
(if (and *consensus-enabled-p* suggestions)