Amr Gharbeia
94a8a0ab0b
Some checks failed
Deploy-Agent-V15-Stdin / JOB-V15-STDIN (push) Failing after 3s
- Folders: literate->harness, src->library, system->environment, scripts->interfaces. - Synchronized all :tangle paths and system definitions. - Hardened .gitignore for binary and log artifacts. - Consolidated all documentation into docs/.
125 lines
7.2 KiB
Common Lisp
125 lines
7.2 KiB
Common Lisp
(in-package :opencortex)
|
|
|
|
(defvar *probabilistic-backends* (make-hash-table :test 'equal)
|
|
"A global mapping of provider identifiers (keywords) to their respective execution functions.")
|
|
|
|
(defvar *provider-cascade* nil
|
|
"An ordered list of providers to attempt if the primary one fails.")
|
|
|
|
(defvar *model-selector-fn* nil
|
|
"A hook for dynamic model selection based on context complexity.")
|
|
|
|
(defvar *consensus-enabled-p* nil
|
|
"Flag to enable parallel multi-model voting (not implemented in MVP).")
|
|
|
|
(defun register-probabilistic-backend (name fn)
|
|
"Registers a neural provider 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. 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*)))
|
|
(when backend-fn
|
|
(harness-log "PROBABILISTIC: 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)
|
|
(funcall backend-fn prompt system-prompt))))
|
|
(cond ((and (listp result) (eq (getf result :status) :success))
|
|
(return (getf result :content)))
|
|
((stringp result) (return result))
|
|
(t (harness-log "PROBABILISTIC: Backend ~a failed: ~a" backend (getf result :message))))))))
|
|
(list :type :LOG :payload (list :text "Neural Cascade Failure: All providers exhausted.")))))
|
|
|
|
(defun strip-markdown (text)
|
|
"Strips common markdown code block markers from text to ensure valid S-expression parsing."
|
|
(if (and text (stringp text))
|
|
(let ((cleaned text))
|
|
(setf cleaned (cl-ppcre:regex-replace-all "^```[a-z]*\\n" cleaned ""))
|
|
(setf cleaned (cl-ppcre:regex-replace-all "\\n```$" cleaned ""))
|
|
(setf cleaned (cl-ppcre:regex-replace-all "```" cleaned ""))
|
|
(string-trim '(#\Space #\Newline #\Tab) cleaned))
|
|
text))
|
|
|
|
(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))
|
|
(system-logs (context-get-system-logs))
|
|
(assistant-name (or (uiop:getenv "MEMEX_ASSISTANT") "Agent")))
|
|
(let* ((prompt-generator (when active-skill (skill-probabilistic-prompt active-skill)))
|
|
(raw-prompt (if prompt-generator
|
|
(funcall prompt-generator context)
|
|
(let ((p (proto-get (proto-get context :payload) :text)))
|
|
(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
|
|
IMPORTANT: To reply to the user, you MUST use:
|
|
(:TYPE :REQUEST :PAYLOAD (:ACTION :MESSAGE :TEXT \"<Response Text>\"))
|
|
|
|
To call a tool, you MUST use:
|
|
(:TYPE :REQUEST :TARGET :TOOL :ACTION :CALL :TOOL \"<name>\" :ARGS (:arg1 \"val\"))
|
|
|
|
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)))
|
|
(let* ((thought (probabilistic-call raw-prompt :system-prompt system-prompt :context context))
|
|
(cleaned (strip-markdown thought))
|
|
(meta (proto-get context :meta))
|
|
(source (proto-get meta :source)))
|
|
(if (and cleaned (stringp cleaned))
|
|
(let ((*read-eval* nil))
|
|
(if (and (> (length cleaned) 0) (char= (char cleaned 0) #\())
|
|
(handler-case
|
|
(let ((parsed (read-from-string cleaned)))
|
|
(let ((type (proto-get parsed :TYPE))
|
|
(target (or (proto-get parsed :TARGET) (proto-get parsed :target))))
|
|
(cond ((member type '(:REQUEST :EVENT :STATUS :RESPONSE))
|
|
(unless (proto-get parsed :target) (setf (getf parsed :target) (or source :CLI)))
|
|
parsed)
|
|
;; 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)
|
|
(and (listp parsed) (listp (car parsed)) (keywordp (caar parsed))))
|
|
(list :TYPE :REQUEST :TARGET :TOOL :PAYLOAD parsed))
|
|
(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))))
|
|
(list :TYPE :REQUEST :TARGET (or source :CLI) :PAYLOAD (list :ACTION :MESSAGE :TEXT cleaned))))
|
|
thought)))))
|
|
|
|
(defun deterministic-verify (proposed-action context)
|
|
"Iterates through all skill deterministic-gates sorted by priority. Ensures absolute safety of the neural proposal."
|
|
(let ((current-action proposed-action)
|
|
(skills nil))
|
|
(maphash (lambda (name skill) (declare (ignore name)) (when (skill-deterministic-fn skill) (push skill skills))) *skills-registry*)
|
|
(setf skills (sort skills #'> :key #'skill-priority))
|
|
(dolist (skill skills)
|
|
(let ((trigger (skill-trigger-fn skill))
|
|
(gate (skill-deterministic-fn skill)))
|
|
(when (or (null trigger) (ignore-errors (funcall trigger context)))
|
|
(let ((next-action (funcall gate current-action context)))
|
|
(let ((original-type (proto-get current-action :type)))
|
|
(when (and (listp next-action)
|
|
(member (proto-get next-action :type) '(:LOG :EVENT :log :event))
|
|
(or (not (member original-type '(:LOG :EVENT :log :event)))
|
|
(not (eq next-action current-action))))
|
|
(harness-log "DETERMINISTIC: Intercepted by skill '~a'" (skill-name skill))
|
|
(return-from deterministic-verify next-action)))
|
|
(setf current-action next-action)))))
|
|
current-action))
|
|
|
|
(defun reason-gate (signal)
|
|
"Unified Stage: Combines Probabilistic proposals and Deterministic verification."
|
|
(let* ((type (proto-get signal :type))
|
|
(payload (proto-get signal :payload))
|
|
(sensor (proto-get payload :sensor)))
|
|
;; Optimization: Only reason about user input or chat messages.
|
|
(unless (and (eq type :EVENT) (member sensor '(:user-input :chat-message)))
|
|
(return-from reason-gate signal))
|
|
(let ((candidate (think signal)))
|
|
(if candidate
|
|
(setf (getf signal :approved-action) (deterministic-verify candidate signal))
|
|
(setf (getf signal :approved-action) nil))
|
|
(setf (getf signal :status) :reasoned)
|
|
signal)))
|