passepartout/literate/reason.org

#+TITLE: Stage 2: Reason (reason.lisp)
#+AUTHOR: Amr
#+FILETAGS: :harness:reason:
#+STARTUP: content

* Stage 2: Reason (reason.lisp)

** Architectural Intent: Unified Cognition
The Reason stage is the cognitive engine of the OpenCortex. Its primary responsibility is to bridge the gap between raw sensory data (Perceive) and physical side-effects (Act). 

Cognition is split into two distinct modes:
1. **Probabilistic Reasoning:** Utilizing LLMs to generate creative proposals and understand natural language intent.
2. **Deterministic Verification:** Utilizing native Lisp logic to verify and constrain the neural proposals against security and physics invariants.

This hybrid approach ensures the agent is both intelligent and mathematically safe.

** Pipeline Initialization
#+begin_src lisp :tangle ../src/reason.lisp
(in-package :opencortex)
#+end_src

* Probabilistic Engine Infrastructure

** Neural Backend Registry
OpenCortex is provider-agnostic. All neural backends (OpenRouter, Ollama, etc.) register themselves here.

#+begin_src lisp :tangle ../src/reason.lisp
(defvar *probabilistic-backends* (make-hash-table :test 'equal)
  "A global mapping of provider identifiers (keywords) to their respective execution functions.")
#+end_src

** Provider Cascade Configuration
#+begin_src lisp :tangle ../src/reason.lisp
(defvar *provider-cascade* nil
  "An ordered list of providers to attempt if the primary one fails.")
#+end_src

#+begin_src lisp :tangle ../src/reason.lisp
(defvar *model-selector-fn* nil
  "A hook for dynamic model selection based on context complexity.")
#+end_src

#+begin_src lisp :tangle ../src/reason.lisp
(defvar *consensus-enabled-p* nil
  "Flag to enable parallel multi-model voting (not implemented in MVP).")
#+end_src

** Backend Registration Helper
#+begin_src lisp :tangle ../src/reason.lisp
(defun register-probabilistic-backend (name fn)
  "Registers a neural provider with its calling function."
  (setf (gethash name *probabilistic-backends*) fn))
#+end_src

* The Cognitive Cycle

** Probabilistic Call (probabilistic-call)
The primary interface for neural reasoning. It iterates through the cascade until a successful response is achieved or the cascade is exhausted.

#+begin_src lisp :tangle ../src/reason.lisp
(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.")))))
#+end_src

** LLM Output Sanitization (strip-markdown)
Modern LLMs often wrap Lisp code in markdown backticks. This helper ensures the code is clean before the Lisp reader touches it.

#+begin_src lisp :tangle ../src/reason.lisp
(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))
#+end_src

** The Thought Process (Think)
The core logic that prepares the "mind" for reasoning. It assembles the global awareness (Memex status, recent logs, active tasks) and provides a strict protocol template for the LLM to follow.

#+begin_src lisp :tangle ../src/reason.lisp
(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)))))
#+end_src

** Deterministic Verification
The final safety check. It iterates through all active skills to verify that the proposed neural action does not violate any invariants.

#+begin_src lisp :tangle ../src/reason.lisp
(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))
#+end_src

* The Reasoning Pipeline Stage

** Reasoning Gate (reason-gate)
The stage that ties it all together. It filters stimuli that don't require cognition (like internal heartbeat pulses) and executes the hybrid neural-logical loop.

#+begin_src lisp :tangle ../src/reason.lisp
(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)))
#+end_src