provider: recover text-form tool calls from content stream
ober
ddeed9f5797ac1e4aba609d297521834d4f6462e
--- a/src/jcode/provider/provider.ss +++ b/src/jcode/provider/provider.ss @@ -11,7 +11,9 @@ provider-name provider-model provider-base-url - model-rejects-tools?) + model-rejects-tools? + extract-text-tool-calls + recover-text-tool-calls) (import :std/text/json :std/net/request @@ -635,6 +637,115 @@ (min_logprob . ,(min-of logprob-list)) (mean_entropy . ,(mean-of entropy-list)))) +;; Some local/Ollama-hosted GGUF models (fine-tuned Qwen, Hermes, etc.) +;; emit tool calls as text inside the content stream instead of via the +;; OpenAI structured tool_calls field. This helper scans CONTENT for the +;; common text-form envelopes and lifts each into a real tool-call. +;; Returns (values stripped-content extra-tool-calls): every recognized +;; block is removed from the content, and recovered calls come back in +;; left-to-right order. Each candidate must parse as a JSON object with +;; both "name" and "arguments" or it is left in the content unchanged. +(def *text-tool-call-markers* + '(("<tool_call>" . "</tool_call>") + ("<|tool_call_begin|>" . "<|tool_call_end|>") + ("```json\n" . "```") + ("```json\r\n" . "```") + ("```tool_call\n" . "```") + ("```tool_call\r\n" . "```"))) + +(def (find-first-text-tool-call-marker s) + (let loop ((markers *text-tool-call-markers*) (best #f) (best-idx #f)) + (cond + ((null? markers) best) + (else + (let* ((m (car markers)) + (op (car m)) + (cl (cdr m)) + (i (string-contains s op))) + (cond + ((and i (or (not best-idx) (< i best-idx))) + (let* ((after (substring s (+ i (string-length op)) (string-length s))) + (j (string-contains after cl))) + (cond + (j + (let ((cand + (vector + (substring s 0 i) + (substring after 0 j) + (substring after (+ j (string-length cl)) + (string-length after)) + op cl))) + (loop (cdr markers) cand i))) + (else (loop (cdr markers) best best-idx))))) + (else (loop (cdr markers) best best-idx)))))))) + +(def (parse-text-tool-call body) + (guard (e [#t #f]) + (let* ((trimmed (string-trim body)) + (json (string->json-object trimmed))) + (and (hash-table? json) + (let ((name (hash-get json "name")) + (args (hash-get json "arguments"))) + (and name (string? name) (> (string-length name) 0) + args + (make-tool-call + name + (cond + ((string? args) args) + (else (json-object->string args)))))))))) + +(def (extract-text-tool-calls content) + (cond + ((or (not content) (not (string? content)) (= (string-length content) 0)) + (values content '())) + (else + (let ((out (open-output-string)) + (calls (box '()))) + (let loop ((s content)) + (let ((m (find-first-text-tool-call-marker s))) + (cond + ((not m) (put-string out s)) + (else + (let ((prefix (vector-ref m 0)) + (body (vector-ref m 1)) + (rest (vector-ref m 2)) + (op (vector-ref m 3)) + (cl (vector-ref m 4))) + (put-string out prefix) + (let ((tc (parse-text-tool-call body))) + (cond + (tc (set-box! calls (cons tc (unbox calls)))) + (else + (put-string out op) + (put-string out body) + (put-string out cl)))) + (loop rest)))))) + (values (get-output-string out) (reverse (unbox calls))))))) + +;; Lift any text-form tool calls in MSG's content into the structured +;; tool_calls list. Logs when recovery actually fires so the user can see +;; in the trace that the fine-tuned model is emitting non-protocol calls. +(def (recover-text-tool-calls msg) + (let ((content (message-content msg)) + (existing-tcs (or (message-tool-calls msg) '()))) + (let-values (((stripped extras) (extract-text-tool-calls content))) + (cond + ((null? extras) msg) + (else + (log-info logger "tool-call-text-recovery" + `((count . ,(length extras)) + (names . ,(map tool-call-name extras)))) + (let* ((trimmed (and stripped (string-trim stripped))) + (new-content (if (and trimmed (> (string-length trimmed) 0)) + stripped + #f))) + (make-message + (message-role msg) + new-content + (append existing-tcs extras) + (message-tool-call-id msg) + (message-thinking msg)))))))) + (def (openai-chat provider messages tools) (let* ((url (string-append (provider-base-url provider) "/chat/completions")) (headers (openai-headers provider)) @@ -650,7 +761,7 @@ (log-trace logger "openai-response" `((status . ,status) (body . ,text)))) (if (= status 200) - (openai-parse-response (string->json-object text)) + (recover-text-tool-calls (openai-parse-response (string->json-object text))) (error 'openai-chat (format "API error ~a: ~a" status text)))))) (def (openai-headers provider) @@ -729,7 +840,7 @@ `((status . ,status) (body . ,text)))) (if (= status 200) (let ((json (string->json-object text))) - (values (openai-parse-response json) + (values (recover-text-tool-calls (openai-parse-response json)) (openai-extract-stats json))) (error 'openai-chat-with-stats (format "API error ~a: ~a" status text)))))) @@ -1140,20 +1251,34 @@ ;; <think>...</think> so the turn isn't empty (which would ;; otherwise trip the auto-escalator and produce an invalid ;; assistant message for downstream providers). - (content (cond - ((> (string-length raw-content) 0) raw-content) - ((> (string-length reasoning) 0) - (string-append "<think>" reasoning "</think>")) - (else ""))) + (initial-content (cond + ((> (string-length raw-content) 0) raw-content) + ((> (string-length reasoning) 0) + (string-append "<think>" reasoning "</think>")) + (else ""))) + ;; Recover any text-form tool calls the model embedded in the + ;; content stream (Ollama-hosted GGUFs frequently emit + ;; ```json {...}``` or <tool_call>...</tool_call> instead of + ;; using the structured tool_calls field). + (recovery (call-with-values + (lambda () (extract-text-tool-calls initial-content)) + cons)) + (content (car recovery)) + (text-extras (cdr recovery)) (indices (sort < (hash-keys tc-table))) - (tool-calls + (struct-tool-calls (map (lambda (idx) (let ((acc (hash-ref tc-table idx))) (restore-tool-call (or (hash-get acc "id") (format "call_~a" idx)) (or (hash-get acc "name") "unknown") (or (hash-get acc "args") "{}")))) - indices))) + indices)) + (tool-calls (append struct-tool-calls text-extras))) + (when (pair? text-extras) + (log-info logger "tool-call-text-recovery" + `((count . ,(length text-extras)) + (names . ,(map tool-call-name text-extras))))) (let ((cost (or (hash-get usage-acc "cost") (compute-cost (provider-model provider) usage-acc)))) (log-info logger "stream-result" --- a/test/run.ss +++ b/test/run.ss @@ -4,6 +4,7 @@ (import (chezscheme) (jcode core log) (jcode core message) + (jcode provider provider) (jcode tool registry) (jcode tool file) (jcode tool bash)) @@ -155,6 +156,68 @@ (let ([r (tool-execute "bash" (args "command" "exit 42"))]) (check-pred! "bash non-zero exit shown" r (lambda (s) (str-contains? s "Exit code")))) +;; ── Text-form tool call recovery ────────────────────────────────── +;; Local Ollama-hosted GGUF models (fine-tuned Qwen/Hermes etc.) often +;; emit tool calls as text in the content stream instead of via the +;; structured tool_calls field. extract-text-tool-calls lifts those. + +(section "=== text-form tool call recovery ===") +(printf "DEBUG model-rejects-tools? = ~s~n" model-rejects-tools?) +(printf "DEBUG extract-text-tool-calls = ~s~n" extract-text-tool-calls) + +(define (extract-call s) + ;; Returns (list stripped count name args) for the first recovered call. + (call-with-values + (lambda () (extract-text-tool-calls s)) + (lambda (stripped extras) + (list stripped (length extras) + (and (pair? extras) (tool-call-name (car extras))) + (and (pair? extras) (tool-call-arguments (car extras))))))) + +(let ([r (extract-call + "Sure:\n```json\n{\"name\":\"grep\",\"arguments\":{\"pattern\":\"defstruct\",\"path\":\"src\"}}\n```\nDone.")]) + (check! "md-fence count" (list-ref r 1) 1) + (check! "md-fence name" (list-ref r 2) "grep") + (check-pred! "md-fence args has pattern" (list-ref r 3) + (lambda (s) (str-contains? s "defstruct")))) + +(let ([r (extract-call + "<tool_call>{\"name\":\"ls\",\"arguments\":{\"path\":\".\"}}</tool_call>")]) + (check! "qwen tag count" (list-ref r 1) 1) + (check! "qwen tag name" (list-ref r 2) "ls")) + +(let ([r (extract-call "Just a normal answer with no tool call.")]) + (check! "no-match count" (list-ref r 1) 0) + (check! "no-match stripped" (list-ref r 0) "Just a normal answer with no tool call.")) + +;; A code block that *isn't* a tool call (no name+arguments) must stay put. +(let ([r (extract-call "```json\n{\"foo\":1,\"bar\":2}\n```")]) + (check! "non-tc fence kept" (list-ref r 1) 0) + (check-pred! "non-tc fence content intact" (list-ref r 0) + (lambda (s) (str-contains? s "\"foo\":1")))) + +;; Multiple calls in one response, with surrounding text. +(let ([r (call-with-values + (lambda () + (extract-text-tool-calls + (string-append + "First:\n<tool_call>{\"name\":\"ls\",\"arguments\":{\"path\":\".\"}}</tool_call>" + "\nThen:\n<tool_call>{\"name\":\"grep\",\"arguments\":{\"pattern\":\"x\"}}</tool_call>"))) + list)]) + (check! "two-call count" (length (cadr r)) 2) + (check! "two-call names" + (map tool-call-name (cadr r)) + '("ls" "grep"))) + +;; recover-text-tool-calls on a message must merge into the structured list. +(let* ([orig (make-assistant-message + "Reply:\n```json\n{\"name\":\"bash\",\"arguments\":{\"command\":\"ls\"}}\n```")] + [fixed (recover-text-tool-calls orig)]) + (check-pred! "recover: tool-calls populated" (message-tool-calls fixed) + (lambda (lst) (and (list? lst) (= (length lst) 1)))) + (check! "recover: tool-call name" + (tool-call-name (car (message-tool-calls fixed))) "bash")) + ;; ── Results ─────────────────────────────────────────────────────── (printf "~n~a passed, ~a failed~n" pass-count fail-count)