#+PROPERTY: header-args:lisp :tangle (expand-file-name "harness/reason.lisp" (expand-file-name "harness/"))
#+TITLE: Stage 2: Reason (reason.lisp)
#+AUTHOR: Amr
#+FILETAGS: :harness:reason:
#+STARTUP: content

* Stage 2: Reason (reason.lisp)

** Architectural Intent: The Dual-Engine Cognitive Architecture

The Reason stage implements the core innovation of OpenCortex: the separation of probabilistic reasoning (neural/LLM) from deterministic verification (logic/safety).

This dual-engine design solves a fundamental problem in AI safety:

1. *Probabilistic Engine* - Uses LLMs for semantic understanding, natural language generation, and complex reasoning. It is powerful but can hallucinate, make syntax errors, or propose unsafe actions.

2. *Deterministic Engine* - Uses formal verification (skills) to check LLM proposals before execution. It is slower but provably correct.

The LLM proposes; the skills verify. This is the "Bouncer Pattern" - the deterministic engine is literally a bouncer that checks the LLM's proposals at the door before letting them through to execution.

** Why Plists for Communication?

The Reason stage communicates exclusively through property lists (plists). This design choice reflects the homoiconic nature of Lisp - plists are native data structures that can be read, written, and manipulated by the same code that processes them.

A plist message like:
: (TYPE :REQUEST TARGET :CLI PAYLOAD (ACTION :MESSAGE TEXT "Hello"))

Is simultaneously:
- Human-readable text
- Machine-parseable data structure
- Executable Lisp code

This means the reasoning pipeline can generate, modify, and execute its own communication protocol without external parsing.

* Package Context

#+begin_src lisp
(in-package :opencortex)
#+end_src

* Probabilistic Engine (Neural/LLM Integration)

The probabilistic engine is responsible for all neural/LLM operations. It maintains a registry of provider backends and implements a cascading failover mechanism.

** Backend Registry Variables

#+begin_src lisp
(defvar *probabilistic-backends* (make-hash-table :test 'equal)
  "Registry mapping provider keywords (:openrouter, :ollama) to their calling functions.")

(defvar *provider-cascade* nil
  "Ordered list of provider keywords to try. First available provider wins.")

(defvar *model-selector-fn* nil
  "Optional function that selects a specific model for each provider.
  Signature: (funcall fn provider context) => model-name-string")

(defvar *consensus-enabled-p* nil
  "When T, run multiple providers and compare results for critical decisions.")
#+end_src

** register-probabilistic-backend: Backend Registration

#+begin_src lisp
(defun register-probabilistic-backend (name fn)
  "Register a neural provider backend.

  NAME is a keyword like :openrouter or :ollama.
  FN is a function with signature: (funcall fn prompt system-prompt &key model)
     returning either:
     - (list :status :success :content \"response text\")
     - (list :status :error :message \"error description\")
     - a simple string on success

  Example registration:
    (register-probabilistic-backend :openrouter #'openrouter-call)"

  (setf (gethash name *probabilistic-backends*) fn))
#+end_src

** probabilistic-call: Cascade Dispatch

#+begin_src lisp
(defun probabilistic-call (prompt &key
                                (system-prompt "You are the Probabilistic engine.")
                                (cascade nil)
                                (context nil))
  "Dispatch a neural request through the provider cascade.

  PROMPT - The user's query or task description.
  SYSTEM-PROMPT - Instructions for how the LLM should behave.
  CASCADE - Override the default provider cascade.
  CONTEXT - Current signal context (for model selection).

  Returns the LLM response as a string, or a failure plist if all providers fail.

  The cascade mechanism ensures reliability: if OpenRouter is rate-limited,
  it automatically falls back to OpenAI, then Anthropic, etc."

  (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)

              ;; Optional model selection based on context
              (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))))

                ;; Normalize result format
                (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))))))))

        ;; All providers failed
        (list :type :LOG
              :payload (list :text "Neural Cascade Failure: All providers exhausted.")))))
#+end_src

* Cognitive Proposal Generation (Think)

The `think` function is the heart of the probabilistic engine. It constructs a prompt from context, sends it to the LLM, and parses the response into a structured action.

** strip-markdown: Clean LLM Output

#+begin_src lisp
(defun strip-markdown (text)
  "Strip markdown formatting from LLM output.

  LLMs often wrap their responses in code fences (```lisp ...```).
  This function removes those markers to extract the raw plist.

  Handles:
  - Leading code fences with language tags: ```lisp
  - Trailing code fences: ```
  - Orphan closing fences: ```"

  (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

** normalize-plist-keywords: Fix LLM Keyword Output

#+begin_src lisp
(defun normalize-plist-keywords (plist)
  "Normalize all keys in a plist to keywords.

  LLMs often return plists with unquoted keys: (TYPE REQUEST ...)
  instead of keyword syntax: (:TYPE :REQUEST ...)

  This function converts all symbol keys to their keyword equivalents,
  making the plist compatible with standard Lisp property accessors.

  Example transformation:
    (TYPE REQUEST PAYLOAD (ACTION MESSAGE TEXT \"Hi\"))
    => (:TYPE :REQUEST :PAYLOAD (:ACTION :MESSAGE :TEXT \"Hi\"))"

  (when (listp plist)
    (loop for (k . rest) on plist by #'cddr
          collect (if (and (symbolp k) (not (keywordp k)))
                       (intern (string k) :keyword)
                       k)
          collect (car rest))))
#+end_src

** think: Generate Action Proposal

#+begin_src lisp
(defun think (context)
  "Generate a Lisp action proposal based on current context.

  This is the core cognitive function. It:

  1. Finds the most relevant skill based on context
  2. Assembles global awareness (memory context, system logs)
  3. Constructs a detailed prompt with available tools
  4. Calls the LLM via probabilistic-call
  5. Parses the LLM response into a structured action plist

  The LLM is instructed to respond with exactly ONE plist, never prose.
  This constraint makes parsing deterministic and prevents rambling.

  Returns a plist with structure:
    (:TYPE :REQUEST :TARGET :CLI :PAYLOAD (:ACTION :MESSAGE :TEXT \"...\"))"

  ;; Gather context components
  (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 (getenv "MEMEX_ASSISTANT") "Agent"))
         (rejection-trace (proto-get (proto-get context :payload) :rejection-trace)))

    ;; Generate prompt from skill or raw text
    (let* ((prompt-generator (when active-skill
                              (skill-probabilistic-prompt active-skill)))
           (raw-prompt (if prompt-generator
                           (funcall prompt-generator context)
                           ;; Fallback: use raw user input
                           (let ((p (proto-get (proto-get context :payload) :text)))
                             (if (and p (stringp p))
                                 p
                                 "Maintain metabolic stasis."))))
           
           ;; Inject Reflection Loop feedback if a previous proposal was rejected
           (reflection-feedback (if rejection-trace
                                    (format nil "~%~%PREVIOUS PROPOSAL REJECTED:~%Your previous proposal was rejected by the deterministic safety gates.~%Rejection Trace: ~a~%You MUST fix the syntax or logic error described above and try again." rejection-trace)
                                    ""))

           (system-prompt (format nil
                                   "IDENTITY: ~a~a

You are a component of the OpenCortex neurosymbolic AI agent.
Your task is to generate exactly ONE valid Lisp plist response.

MANDATE: Respond with ONE Lisp plist. Never output prose.

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\"))

MANDATORY VALIDATION RULE: Before declaring any Lisp code edit complete,
you MUST call the `:validate-lisp` tool with the proposed code. If the tool
returns `:status :error`, read the `:reason` and `:failed` fields, fix the
defect, and re-validate. You are strictly forbidden from relying on your
own paren-balancing or syntax intuition.

PROVIDER RULE: Always use the default cascade provider unless a specific
model or capability is required for the task.

AVAILABLE TOOLS:
~a

GLOBAL CONTEXT:
~a

RECENT LOGS:
~a"
                                   assistant-name
                                   reflection-feedback
                                   tool-belt
                                   global-context
                                   system-logs)))

      ;; Call LLM and process response
      (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)))

        (when cleaned
          (harness-log "THINK: LLM raw output = ~a"
                       (subseq cleaned 0 (min 200 (length cleaned)))))

        ;; Parse LLM response
        (if (and cleaned (stringp cleaned) (> (length cleaned) 0))
            (let ((*read-eval* nil))
              (if (char= (char cleaned 0) #\()
                  ;; Response starts with paren - try to parse as plist
                  (handler-case
                      (let ((parsed (read-from-string cleaned)))
                        (when parsed
                          (harness-log "THINK: parsed = ~a" parsed)

                          ;; Normalize keyword keys (LLM often returns TYPE instead of :TYPE)
                          (let ((parsed-normalized (normalize-plist-keywords parsed))
                                (type (proto-get parsed :TYPE))
                                (target (or (proto-get parsed :TARGET)
                                           (proto-get parsed :target))))

                            (cond
                              ;; Recognized message type - use directly
                              ((member type '(:REQUEST :EVENT :STATUS :RESPONSE))
                               (unless (proto-get parsed :target)
                                 (setf (getf parsed :target) (or source :CLI)))
                               parsed-normalized)

                              ;; Tool call detected - wrap in standard envelope
                              ((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 (normalize-plist-keywords parsed)))

                              ;; Unknown format - treat as user message
                              (t
                               (list :TYPE :REQUEST
                                     :TARGET (or source :CLI)
                                     :PAYLOAD (list :ACTION :MESSAGE :TEXT cleaned)))))))
                    (error (c)
                      (harness-log "THINK ERROR: ~a" c)
                      (list :TYPE :REQUEST
                            :TARGET (or source :CLI)
                            :PAYLOAD (list :ACTION :MESSAGE :TEXT cleaned))))

                  ;; No leading paren - treat as plain text message
                  (list :TYPE :REQUEST
                        :TARGET (or source :CLI)
                        :PAYLOAD (list :ACTION :MESSAGE :TEXT cleaned))))

            ;; No response from LLM
            thought)))))
#+end_src

* Deterministic Engine (Formal Verification)

The deterministic engine runs all registered skills' verification functions. This is where safety checks, policy enforcement, and skill-specific processing happen.

** deterministic-verify: Skill Chain Verification

#+begin_src lisp
(defun deterministic-verify (proposed-action context)
  "Run all skill deterministic gates on a proposed action.

  Each skill can define a deterministic function that either:
  - Passes the action through unchanged
  - Modifies the action (adds explanation, changes target, etc.)
  - Blocks the action (returns a :LOG message instead)

  Skills are sorted by priority (highest first). A skill with higher
  priority can intercept and modify actions before lower-priority
  skills see them.

  The Bouncer Pattern: If any skill returns a :LOG or :EVENT type,
  processing stops and that message is returned immediately. This
  allows skills to veto actions.

  Example skill chain:
  1. Policy skill (priority 500) - checks for missing explanations
  2. Protocol validator (priority 95) - validates message schema
  3. Shell actuator guard (priority 50) - checks command whitelist"

  (let ((current-action proposed-action)
        (skills nil))

    ;; Collect all skills with deterministic functions
    (maphash (lambda (name skill)
               (declare (ignore name))
               (when (skill-deterministic-fn skill)
                 (push skill skills)))
             *skills-registry*)

    ;; Sort by priority (highest first)
    (setf skills (sort skills #'> :key #'skill-priority))

    ;; Run each skill's gate
    (dolist (skill skills)
      (let ((trigger (skill-trigger-fn skill))
            (gate (skill-deterministic-fn skill)))

        ;; Skill activates if no trigger or trigger returns true
        (when (or (null trigger)
                  (ignore-errors (funcall trigger context)))

          ;; Run the gate
          (let ((next-action (funcall gate current-action context)))
            (let ((original-type (proto-get current-action :type)))

              ;; Check if skill intercepted (returned LOG/EVENT instead of REQUEST)
              (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))))

                ;; Skill blocked or modified - stop processing
                (harness-log "DETERMINISTIC: Intercepted by skill '~a'"
                            (skill-name skill))
                (return-from deterministic-verify next-action)))

            ;; Action passed through - continue to next skill
            (setf current-action next-action)))))

    ;; Return final action (may be modified by skills, or original if all passed)
    current-action))
#+end_src

* Reason Gate (Pipeline Stage)

** reason-gate: The Stage Function

#+begin_src lisp
(defun reason-gate (signal)
  "Stage 2 of the metabolic pipeline: Reason.

  Transforms perceived signals into approved actions by combining:
  1. Probabilistic reasoning (LLM generates proposal)
  2. Deterministic verification (skills validate proposal)

  Only processes :EVENT signals with :user-input or :chat-message sensors.
  Other signals pass through unchanged (heartbeats, tool outputs, etc.).

  Modifies the signal in place by setting:
  - :approved-action - The final verified action, or NIL
  - :status - :reasoned

  Returns the modified signal."

  (let* ((type (proto-get signal :type))
         (payload (proto-get signal :payload))
         (sensor (proto-get payload :sensor)))

    ;; Only reason about user input, not internal signals
    (unless (and (eq type :EVENT)
                (member sensor '(:user-input :chat-message)))
      (return-from reason-gate signal))

    ;; Reflection Loop: Retry up to 3 times if deterministic gates reject
    (let ((retries 3)
          (current-signal (copy-tree signal))
          (last-rejection nil))
      (loop
        (when (<= retries 0)
          (harness-log "REASON: Reflection loop exhausted. Final rejection.")
          (setf (getf signal :approved-action) last-rejection)
          (setf (getf signal :status) :reasoned)
          (return signal))

        (when last-rejection
          (setf (getf (getf current-signal :payload) :rejection-trace) last-rejection))

        (let ((candidate (think current-signal)))
          (harness-log "REASON: candidate type = ~a" (type-of candidate))

          (if (and candidate
                   (listp candidate)
                   (or (keywordp (car candidate))
                       (eq (car candidate) 'TYPE)
                       (eq (car candidate) 'type)))

              (let ((verified (deterministic-verify candidate current-signal)))
                (if (member (getf verified :type) '(:LOG :EVENT :log :event))
                    (progn
                      (harness-log "REASON: Proposal rejected by gate. Retrying (~a left)." (1- retries))
                      (decf retries)
                      (setf last-rejection verified))
                    (progn
                      (setf (getf signal :approved-action) verified)
                      (setf (getf signal :status) :reasoned)
                      (return signal))))

              (progn
                (harness-log "REASON: Invalid candidate type ~a, dropping" (type-of candidate))
                (setf (getf signal :approved-action) nil)
                (setf (getf signal :status) :reasoned)
                (return signal))))))))
#+end_src

* Test Suite

These tests verify the Reason (cognitive) pipeline. Run with:
~(fiveam:run! 'pipeline-reason-suite)~

#+begin_src lisp :tangle (expand-file-name "harness/pipeline-reason-tests.lisp" (concat (concat (or (getenv "INSTALL_DIR") ".") "/harness") "/tests"))
(defpackage :opencortex-pipeline-reason-tests
  (:use :cl :fiveam :opencortex)
  (:export #:pipeline-reason-suite))

(in-package :opencortex-pipeline-reason-tests)

(def-suite pipeline-reason-suite
  :description "Test suite for Reason pipeline")

(in-suite pipeline-reason-suite)

(test test-decide-gate-safety
  "Decide gate should block unsafe LLM proposals."
  ;; Setup: clear skills and register mock
  (clrhash opencortex::*skills-registry*)
  (opencortex::defskill :mock-safety
    :priority 50
    :trigger (lambda (ctx) t)
    :probabilistic (lambda (ctx) "Mock probabilistic")
    :deterministic (lambda (action ctx)
                (list :type :LOG :payload (list :text "Action rejected by skill heuristics"))))
  (let* ((candidate (list :type :REQUEST :payload (list :action :eval :code "(shell-command \"rm -rf /\")")))
         (signal (list :type :EVENT :candidate candidate))
         (result (deterministic-verify candidate signal)))
    (is (eq :LOG (getf result :type)))
    (is (search "Action rejected by skill heuristics" (getf (getf result :payload) :text)))))
#+end_src