expert: auto-escalate on stuck or low-confidence primary responses
ober
9f3323e536ec33cdd871a5c7034fd0b81bd18d38
--- a/build-binary.ss +++ b/build-binary.ss @@ -107,6 +107,8 @@ "lib/jcode/core/log" "lib/jcode/core/session" "lib/jcode/core/message" + "lib/jcode/core/escalation" + "lib/jcode/core/expert" "lib/jcode/core/agent" "lib/jcode/core/plugin" "lib/jcode/core/debug-repl" new file mode 100644 --- /dev/null +++ b/src/jcode/core/escalation.ss @@ -0,0 +1,219 @@ +;;; jcode escalation — automatic signals to route hard prompts to the expert. +;;; +;;; The sentinel `<expert/>` (in expert.ss) requires the model to volunteer +;;; that it's stuck. Local tool-calling LoRAs often emit pure tool calls +;;; with empty content, so they cannot self-report. The signals here observe +;;; the conversation trace and the per-response stats to detect stuckness +;;; without model cooperation. +;;; +;;; Six independent signals — any one fires escalation: +;;; +;;; 1. identical-tool-loop — last N assistant turns called the same +;;; (tool, args) tuples. Catches edit-spam loops. +;;; 2. no-text-rounds — last N assistant turns had no text content. +;;; Useful when a thinking model has stopped +;;; thinking and is reflex-emitting tool calls. +;;; 3. tool-error-streak — last N tool results in a row started with +;;; "error" / "Error". Model failing to recover. +;;; 4. low-mean-logprob — current response's mean token logprob below +;;; threshold. True low-confidence signal. +;;; 5. high-mean-entropy — top-k entropy averaged over response above +;;; threshold. The model was at a fork. +;;; 6. truncated-response — finish_reason == "length". Model hit the +;;; token cap mid-thought. +;;; +;;; All thresholds are configurable under expert.escalation in jcode.json. + +(export *escalation-defaults* + escalation-config + should-escalate? + format-escalation-reason) + +(import :std/misc/string + :jcode/core/config + :jcode/core/log + :jcode/core/message) + +(def logger (make-logger "escalation")) + +;; Built-in defaults; each can be overridden in config under expert.escalation. +;; Use #f to DISABLE a signal entirely. +(def *escalation-defaults* + '((max_identical_tool_calls . 3) ;; #f to disable + (max_rounds_without_text . 5) ;; #f to disable + (max_tool_errors . 3) ;; #f to disable + (min_mean_logprob . #f) ;; e.g. -2.5; #f disables (no logprobs by default) + (max_mean_entropy . #f) ;; e.g. 2.0; #f disables + (request_logprobs . #f) ;; whether providers should request logprobs + )) + +(def (escalation-config key) + "Look up an escalation knob: first under expert.escalation in jcode.json, + then fall back to *escalation-defaults*." + (let* ((str-key (symbol->string key)) + (configured (config-ref "expert" "escalation" str-key))) + (if (eq? configured #f) + (let ((pair (assq key *escalation-defaults*))) + (and pair (cdr pair))) + configured))) + +;;; --- pure detection helpers (no I/O) --- + +(def (assistant-with-tools? msg) + (and (equal? (message-role msg) "assistant") + (let ((tcs (message-tool-calls msg))) + (and tcs (pair? tcs))))) + +(def (tool-call-signature tc) + ;; Comparable key: name + raw args string. Heuristic — different JSON + ;; whitespace will compare unequal, but degenerate loops re-emit the + ;; exact same bytes, so this catches the cases that matter. + (cons (tool-call-name tc) (tool-call-arguments tc))) + +(def (assistant-tool-signature msg) + (map tool-call-signature (or (message-tool-calls msg) '()))) + +(def (tool-result-message? msg) + (equal? (message-role msg) "tool")) + +(def (looks-like-error? text) + (and text + (string? text) + (let ((trimmed (string-trim text))) + (or (string-prefix? "error" trimmed) + (string-prefix? "Error" trimmed) + (string-prefix? "ERROR" trimmed) + ;; Common nested-result form from MCP wrapper + (string-contains trimmed "\"isError\":true"))))) + +(def (last-n-where pred lst n) + ;; Walk lst from the END, collect at most n items where pred holds, + ;; stopping as soon as a non-matching item is hit (consecutive run). + (let loop ((rev (reverse lst)) (acc '()) (k 0)) + (if (or (null? rev) (>= k n)) + acc + (let ((x (car rev))) + (if (pred x) + (loop (cdr rev) (cons x acc) (+ k 1)) + acc))))) + +;;; --- individual signal detectors --- +;;; Each returns #f or a reason alist for logging. + +(def (detect-identical-loop messages response) + (let ((threshold (escalation-config 'max_identical_tool_calls))) + (if (or (not threshold) (not (assistant-with-tools? response))) + #f + (let* ((current-sig (assistant-tool-signature response)) + (prior-asst (filter assistant-with-tools? messages)) + (recent (last-n-where (lambda (m) + (equal? (assistant-tool-signature m) + current-sig)) + prior-asst + (- threshold 1))) + (run-length (+ 1 (length recent)))) + (and (>= run-length threshold) + `((signal . identical-tool-loop) + (run-length . ,run-length) + (threshold . ,threshold) + (tool-names . ,(map car current-sig)))))))) + +(def (detect-no-text-rounds messages response) + (let ((threshold (escalation-config 'max_rounds_without_text))) + (if (not threshold) + #f + (let* ((no-text? (lambda (m) + (and (equal? (message-role m) "assistant") + (let ((c (message-content m))) + (or (not c) (string=? (string-trim (or c "")) "")))))) + (current-no-text? (no-text? response)) + (prior-asst (filter (lambda (m) (equal? (message-role m) "assistant")) + messages)) + (recent (last-n-where no-text? prior-asst (- threshold 1))) + (run-length (+ (if current-no-text? 1 0) (length recent)))) + (and current-no-text? + (>= run-length threshold) + `((signal . no-text-rounds) + (run-length . ,run-length) + (threshold . ,threshold))))))) + +(def (detect-tool-error-streak messages) + (let ((threshold (escalation-config 'max_tool_errors))) + (if (not threshold) + #f + (let* ((tool-msgs (filter tool-result-message? messages)) + (recent (last-n-where (lambda (m) (looks-like-error? (message-content m))) + tool-msgs + threshold)) + (run-length (length recent))) + (and (>= run-length threshold) + `((signal . tool-error-streak) + (run-length . ,run-length) + (threshold . ,threshold))))))) + +(def (detect-low-logprob stats) + (let ((threshold (escalation-config 'min_mean_logprob)) + (mean-lp (and stats (assq 'mean_logprob stats) (cdr (assq 'mean_logprob stats))))) + (and threshold + mean-lp + (real? mean-lp) + (< mean-lp threshold) + `((signal . low-mean-logprob) + (mean_logprob . ,mean-lp) + (threshold . ,threshold))))) + +(def (detect-high-entropy stats) + (let ((threshold (escalation-config 'max_mean_entropy)) + (mean-e (and stats (assq 'mean_entropy stats) (cdr (assq 'mean_entropy stats))))) + (and threshold + mean-e + (real? mean-e) + (> mean-e threshold) + `((signal . high-mean-entropy) + (mean_entropy . ,mean-e) + (threshold . ,threshold))))) + +(def (detect-truncated stats) + (let ((fr (and stats (assq 'finish_reason stats) (cdr (assq 'finish_reason stats))))) + (and (or (equal? fr "length") (eq? fr 'length)) + `((signal . truncated-response) + (finish_reason . ,fr))))) + +;;; --- aggregator --- + +(def (should-escalate? messages response stats) + "Run all detectors. Return #f if none fire, or the first matching reason + alist. `messages` is the conversation history excluding `response`." + (or (detect-identical-loop messages response) + (detect-no-text-rounds messages response) + (detect-tool-error-streak messages) + (detect-low-logprob stats) + (detect-high-entropy stats) + (detect-truncated stats))) + +(def (format-escalation-reason reason) + ;; One-line human-readable summary for the streaming notice. + (let ((sig (cdr (assq 'signal reason)))) + (case sig + ((identical-tool-loop) + (format "tool ~a repeated ~a times" + (let ((names (cdr (assq 'tool-names reason)))) + (if (null? names) "(none)" (car names))) + (cdr (assq 'run-length reason)))) + ((no-text-rounds) + (format "~a assistant turns with no text" + (cdr (assq 'run-length reason)))) + ((tool-error-streak) + (format "~a consecutive tool errors" + (cdr (assq 'run-length reason)))) + ((low-mean-logprob) + (format "low confidence (mean logprob ~a < ~a)" + (cdr (assq 'mean_logprob reason)) + (cdr (assq 'threshold reason)))) + ((high-mean-entropy) + (format "high uncertainty (mean entropy ~a > ~a)" + (cdr (assq 'mean_entropy reason)) + (cdr (assq 'threshold reason)))) + ((truncated-response) + "response truncated at token cap") + (else (format "~a" sig))))) --- a/src/jcode/core/expert.ss +++ b/src/jcode/core/expert.ss @@ -32,6 +32,7 @@ (import :std/misc/string :jcode/core/config + :jcode/core/escalation :jcode/core/log :jcode/core/message :jcode/provider/provider) @@ -93,48 +94,72 @@ "")) ;; Non-streaming wrapper. Calls the primary provider; if its response -;; contains the sentinel and an expert is configured, re-sends the same -;; messages to the expert and returns that response instead. The primary's -;; attempt is discarded (not added to session). +;; contains the sentinel OR triggers any auto-escalation signal, and an +;; expert is configured, re-sends the same messages to the expert and +;; returns that response instead. The primary's attempt is discarded. (def (chat-with-expert provider messages tools) - (let* ((response (provider-chat provider messages tools)) - (content (message-content response))) - (cond - ((and (wants-expert? content) (config-expert-enabled?)) - (let ((expert (get-expert-provider))) - (log-info logger "escalating-to-expert" - `((from . ,(provider-name provider)) - (to . ,(provider-name expert)) - (model . ,(provider-model expert)))) - (provider-chat expert messages tools))) - ((wants-expert? content) - (log-warn logger "expert-requested-but-not-configured" '()) - (make-assistant-message - (strip-expert-sentinel content) - (message-tool-calls response))) - (else response)))) + (let-values (((response stats) + (provider-chat-with-stats provider messages tools))) + (let* ((content (message-content response)) + (sentinel? (wants-expert? content)) + (auto-reason (should-escalate? messages response stats)) + (escalate? (or sentinel? auto-reason))) + (cond + ((and escalate? (config-expert-enabled?)) + (let ((expert (get-expert-provider))) + (log-info logger "escalating-to-expert" + `((from . ,(provider-name provider)) + (to . ,(provider-name expert)) + (model . ,(provider-model expert)) + (trigger . ,(if sentinel? 'sentinel 'auto)) + (reason . ,(if auto-reason + (format-escalation-reason auto-reason) + "sentinel")))) + (provider-chat expert messages tools))) + (sentinel? + (log-warn logger "expert-requested-but-not-configured" '()) + (make-assistant-message + (strip-expert-sentinel content) + (message-tool-calls response))) + (else response))))) ;; Streaming wrapper. The primary stream is shown to the user as it arrives ;; (so they see the partial attempt and the sentinel itself if emitted). -;; Once the primary stream completes we check for the sentinel and, if -;; present, stream the expert response. The expert's (content tool-calls +;; Once the primary stream completes we check for either the explicit +;; sentinel OR any of the auto-escalation signals (loops, error streaks, +;; low confidence, truncation …). On any trigger, stream the expert +;; response in place of the primary's. The expert's (content tool-calls ;; usage) is what gets returned and recorded. (def (stream-chat-with-expert provider messages tools token-cb) - (let-values (((content tcs usage) - (provider-stream-chat provider messages tools token-cb))) - (cond - ((and (wants-expert? content) (config-expert-enabled?)) - (let ((expert (get-expert-provider))) - (log-info logger "escalating-to-expert" - `((from . ,(provider-name provider)) - (to . ,(provider-name expert)) - (model . ,(provider-model expert)))) - (when token-cb - (token-cb (format "\n\n[escalating to ~a/~a]\n\n" - (provider-name expert) - (provider-model expert)))) - (provider-stream-chat expert messages tools token-cb))) - ((wants-expert? content) - (log-warn logger "expert-requested-but-not-configured" '()) - (values (strip-expert-sentinel content) tcs usage)) - (else (values content tcs usage))))) + (let-values (((content tcs usage stats) + (provider-stream-chat-with-stats provider messages tools token-cb))) + (let* ((sentinel? (wants-expert? content)) + ;; Build a synthetic assistant message so should-escalate? can + ;; inspect tool-call shapes without touching the live session. + (synth (make-assistant-message content tcs)) + (auto-reason (should-escalate? messages synth stats)) + (escalate? (or sentinel? auto-reason))) + (cond + ((and escalate? (config-expert-enabled?)) + (let ((expert (get-expert-provider))) + (log-info logger "escalating-to-expert" + `((from . ,(provider-name provider)) + (to . ,(provider-name expert)) + (model . ,(provider-model expert)) + (trigger . ,(if sentinel? 'sentinel 'auto)) + (reason . ,(if auto-reason + (format-escalation-reason auto-reason) + "sentinel")))) + (when token-cb + (token-cb + (format "\n\n[escalating to ~a/~a~a]\n\n" + (provider-name expert) + (provider-model expert) + (if auto-reason + (string-append " — " (format-escalation-reason auto-reason)) + "")))) + (provider-stream-chat expert messages tools token-cb))) + (sentinel? + (log-warn logger "expert-requested-but-not-configured" '()) + (values (strip-expert-sentinel content) tcs usage)) + (else (values content tcs usage)))))) --- a/src/jcode/provider/provider.ss +++ b/src/jcode/provider/provider.ss @@ -2,8 +2,10 @@ (export make-provider provider-chat + provider-chat-with-stats provider-stream provider-stream-chat + provider-stream-chat-with-stats provider-list-models provider-list-pricing provider-name @@ -16,6 +18,7 @@ :std/net/tcp :std/misc/string :std/misc/retry + :jcode/core/config :jcode/core/log :jcode/core/message :jcode/core/models @@ -127,6 +130,30 @@ (callback response) response)) +;; provider-chat-with-stats: non-streaming variant that also returns a +;; stats alist (finish_reason / mean_logprob / mean_entropy when the +;; provider exposes them). Returns (values message stats-alist). +;; For non-OpenAI-style providers, stats is an empty placeholder. +(def (provider-chat-with-stats provider messages tools) + (unless (or (provider-api-key provider) + (equal? (provider-name provider) "ollama") + (equal? (provider-name provider) "mlx")) + (error 'provider-chat-with-stats + (format "No API key configured for provider '~a'. Set the appropriate env var or add it to jcode.json." + (provider-name provider)))) + (log-info logger "chat" + `((provider . ,(provider-name provider)) + (model . ,(provider-model provider)) + (messages . ,(length messages)))) + (api-call-with-retry + (lambda () + (case (string->symbol (provider-name provider)) + ((openai openrouter deepseek xai groq mistral together cerebras perplexity mlx) + (openai-chat-with-stats provider messages tools)) + (else + (values (provider-chat provider messages tools) + (build-stats #f '() '()))))))) + ;;; HTTPS-capable HTTP POST ;;; ;;; Uses rustls for https:// and raw tcp for http:// @@ -483,6 +510,69 @@ (hash-put! body "top_p" 0.9) (hash-put! body "repetition_penalty" 1.05))) +;; --- logprobs / confidence stats --- +;; Opt-in via config: expert.escalation.request_logprobs = true. Cheap to +;; ignore on providers that don't honor it; for openai-style endpoints +;; (incl. mlx_lm) it adds top-k log probabilities to each token in the +;; SSE stream so we can derive a confidence signal. + +(def (request-logprobs?) + (and (config-ref "expert" "escalation" "request_logprobs") #t)) + +(def (apply-logprobs! body) + (when (request-logprobs?) + (hash-put! body "logprobs" #t) + (hash-put! body "top_logprobs" 5))) + +(def (mean-of lst) + (and (pair? lst) + (/ (apply + lst) (length lst) 1.0))) + +(def (min-of lst) + (and (pair? lst) (apply min lst))) + +(def (token-entropy top-logprobs) + ;; top-logprobs: list of {"token":..., "logprob":...}. Compute Shannon + ;; entropy over the (renormalized) top-k probability mass. Conservative — + ;; we don't see tail probability, but high entropy in top-k still signals + ;; the model was at a fork. + (let* ((logps (map (lambda (h) (or (hash-get h "logprob") 0)) top-logprobs)) + (probs (map exp logps)) + (z (apply + probs))) + (if (or (null? probs) (= z 0)) + 0 + (let ((norms (map (lambda (p) (/ p z)) probs))) + (- (apply + (map (lambda (p) + (if (> p 0) (* p (log p)) 0)) + norms))))))) + +(def (accumulate-logprobs! delta logprob-box entropy-box) + ;; delta is a hash-table; if it has logprobs.content[], walk each token + ;; entry, push logprob and (top-k entropy if available). + (let ((lp (and (hash-table? delta) (hash-get delta "logprobs")))) + (when (and lp (hash-table? lp)) + (let ((entries (hash-get lp "content"))) + (when (and entries (list? entries)) + (for-each + (lambda (e) + (when (hash-table? e) + (let ((logp (hash-get e "logprob")) + (top (hash-get e "top_logprobs"))) + (when (real? logp) + (set-box! logprob-box (cons logp (unbox logprob-box)))) + (when (and top (list? top) (pair? top)) + (set-box! entropy-box + (cons (token-entropy top) (unbox entropy-box))))))) + entries)))))) + +(def (build-stats finish-reason logprob-list entropy-list) + ;; Return alist with whatever signals we managed to capture. Missing + ;; entries are #f rather than absent so consumers can use (assq ...). + `((finish_reason . ,finish-reason) + (mean_logprob . ,(mean-of logprob-list)) + (min_logprob . ,(min-of logprob-list)) + (mean_entropy . ,(mean-of entropy-list)))) + (def (openai-chat provider messages tools) (let* ((url (string-append (provider-base-url provider) "/chat/completions")) (headers (openai-headers provider)) @@ -511,6 +601,7 @@ (hash-put! body "model" (provider-model provider)) (hash-put! body "max_tokens" 32768) (apply-mlx-sampling! provider body) + (apply-logprobs! body) (hash-put! body "messages" (map message->json messages)) (when (and tools (not (null? tools))) (hash-put! body "tools" tools) @@ -525,6 +616,54 @@ (json->message msg) (error 'openai-parse-response "No message in response")))) +(def (openai-extract-stats json) + ;; Pull finish_reason and (if logprobs were requested) per-token logprobs + ;; out of a non-streaming OpenAI-style completion response. Returns the + ;; same alist shape as build-stats. + (let* ((choices (hash-ref json "choices" '())) + (choice (if (null? choices) #f (car choices))) + (fr (and choice (hash-get choice "finish_reason"))) + (lp-box (box '())) + (en-box (box '()))) + (when choice + (let ((lp (hash-get choice "logprobs"))) + (when (and lp (hash-table? lp)) + (let ((entries (hash-get lp "content"))) + (when (and entries (list? entries)) + (for-each + (lambda (e) + (when (hash-table? e) + (let ((logp (hash-get e "logprob")) + (top (hash-get e "top_logprobs"))) + (when (real? logp) + (set-box! lp-box (cons logp (unbox lp-box)))) + (when (and top (list? top) (pair? top)) + (set-box! en-box (cons (token-entropy top) (unbox en-box))))))) + entries)))))) + (build-stats fr (unbox lp-box) (unbox en-box)))) + +(def (openai-chat-with-stats provider messages tools) + ;; Non-streaming variant of openai-chat that also returns a stats alist. + ;; Returns (values message stats). + (let* ((url (string-append (provider-base-url provider) "/chat/completions")) + (headers (openai-headers provider)) + (body (openai-body provider messages tools)) + (body-json (json-object->string body))) + (when (tracing?) + (log-trace logger "openai-request" + `((url . ,(redact-url url)) + (headers . ,(redact-headers headers)) + (body . ,body-json)))) + (let-values (((status text) (http-post-json url headers body-json))) + (when (tracing?) + (log-trace logger "openai-response" + `((status . ,status) (body . ,text)))) + (if (= status 200) + (let ((json (string->json-object text))) + (values (openai-parse-response json) + (openai-extract-stats json))) + (error 'openai-chat-with-stats (format "API error ~a: ~a" status text)))))) + ;;; Anthropic API ;;; (def (anthropic-chat provider messages tools) @@ -794,6 +933,7 @@ (hash-put! body "stream" #t) (hash-put! body "max_tokens" 32768) (apply-mlx-sampling! provider body) + (apply-logprobs! body) ;; Request usage data in stream (let ((opts (make-hash-table))) (hash-put! opts "include_usage" #t) @@ -813,7 +953,10 @@ (text-acc (open-output-string)) ;; tool-call accumulators: index -> alist with id/name/args-so-far (tc-table (make-hash-table)) - (usage-acc (make-hash-table))) + (usage-acc (make-hash-table)) + (logprob-box (box '())) + (entropy-box (box '())) + (finish-reason-box (box #f))) (let* ((body-json (json-object->string body)) (dummy (begin (log-info logger "stream-request" @@ -849,7 +992,14 @@ (let* ((choices (hash-get json "choices")) (choice (and (pair? choices) (car choices))) (delta (and choice (hash-get choice "delta")))) + ;; Capture finish_reason whenever a choice carries one + (when choice + (let ((fr (hash-get choice "finish_reason"))) + (when (and fr (string? fr) (not (string=? fr ""))) + (set-box! finish-reason-box fr)))) (when delta + ;; Accumulate per-token logprobs/entropy when requested + (accumulate-logprobs! delta logprob-box entropy-box) ;; Text content token (let ((content (hash-get delta "content"))) (when (and content (string? content) (> (string-length content) 0)) @@ -910,7 +1060,10 @@ (values content tool-calls (list (cons 'tokens-in (or (hash-get usage-acc "prompt_tokens") 0)) (cons 'tokens-out (or (hash-get usage-acc "completion_tokens") 0)) - (cons 'cost cost))))))) + (cons 'cost cost)) + (build-stats (unbox finish-reason-box) + (unbox logprob-box) + (unbox entropy-box))))))) ;;; Anthropic Streaming ;;; @@ -1035,15 +1188,19 @@ (list (cons 'tokens-in (or (hash-get usage-acc "input_tokens") 0)) (cons 'tokens-out (or (hash-get usage-acc "output_tokens") 0)) (cons 'cost (compute-cost (provider-model provider) - usage-acc))))))) - -;; provider-stream-chat: stream text tokens to token-cb, accumulate tool calls. -;; Returns (values content-str tool-call-list usage-alist). -(def (provider-stream-chat provider messages tools token-cb) + usage-acc))) + ;; Anthropic streaming does not surface logprobs; stats are empty. + (build-stats #f '() '()))))) + +;; provider-stream-chat-with-stats: like provider-stream-chat but also +;; returns a `stats` alist with finish_reason / mean_logprob / mean_entropy +;; (whatever the provider exposed). Used by the expert-escalation path. +;; Returns (values content-str tool-call-list usage-alist stats-alist). +(def (provider-stream-chat-with-stats provider messages tools token-cb) (unless (or (provider-api-key provider) (equal? (provider-name provider) "ollama") (equal? (provider-name provider) "mlx")) - (error 'provider-stream-chat + (error 'provider-stream-chat-with-stats (format "No API key configured for provider '~a'. Set the appropriate env var or add it to jcode.json." (provider-name provider)))) (log-info logger "stream-chat" @@ -1055,16 +1212,24 @@ (openai-stream-chat provider messages tools token-cb)) ((anthropic) (anthropic-stream-chat provider messages tools token-cb)) ((google) - ;; Google: non-streaming fallback + ;; Google: non-streaming fallback — no stats available. (let* ((response (provider-chat provider messages tools)) (content (or (message-content response) "")) (tcs (or (message-tool-calls response) '()))) (when (> (string-length content) 0) (token-cb content)) - (values content tcs '()))) + (values content tcs '() (build-stats #f '() '())))) (else - (error 'provider-stream-chat + (error 'provider-stream-chat-with-stats (format "Unknown provider '~a'" (provider-name provider)))))) +;; provider-stream-chat: 3-value backward-compatible wrapper. Discards +;; the stats alist for callers that don't need confidence signals (TUI). +;; Returns (values content-str tool-call-list usage-alist). +(def (provider-stream-chat provider messages tools token-cb) + (let-values (((content tool-calls usage stats) + (provider-stream-chat-with-stats provider messages tools token-cb))) + (values content tool-calls usage))) + ;;; ================================================================ ;;; Model listing: live fetch from provider /models endpoints ;;; ================================================================