fix: parse qwen3-coder XML tool calls from mlx-omni reasoning field
ober
145d10c4e92ea82b0e600b2c412a150b9a40eb32
--- a/src/jcode/core/agent.ss +++ b/src/jcode/core/agent.ss @@ -217,88 +217,163 @@ Be concise. Prefer edit over write for modifying existing files. (json-object->string ht)))))))) ;;; Hermes / Qwen3-style XML tool call detection ;;; -;;; Some local backends (notably mlx_lm.server with the jerboa-mlx LoRA) do -;;; not parse the model's tool calls server-side. The model then emits the -;;; raw Hermes-style XML inline in the assistant content: +;;; Some local backends emit the model's tool call as raw XML, either in +;;; the assistant content or (mlx-omni-server) in the `reasoning` field — +;;; the provider then folds reasoning into content as <think>...</think>. +;;; Two formats appear in the wild: ;;; -;;; <tool_call> -;;; <function name="NAME"> -;;; <parameter name="K">V</parameter> -;;; ... -;;; </function> -;;; </tool_call> +;;; Standard Hermes (mlx_lm.server + Qwen base): +;;; <tool_call> +;;; <function name="NAME"> +;;; <parameter name="K">V</parameter> +;;; ... +;;; </function> +;;; </tool_call> ;;; -;;; Without local parsing, jcode would: (a) leak the closing tags onto the -;;; user's screen (Q/A turn looks broken), and (b) never execute the call. +;;; qwen3-coder (mlx-omni-server + jerboa-mlx LoRA): +;;; <function=NAME> +;;; <parameter=K>V</parameter> +;;; ... +;;; </function> +;;; </tool_call> <- closer present, opener missing +;;; +;;; Without local parsing, jcode would: (a) leak XML onto the user's +;;; screen, and (b) never execute the call. -(def *hermes-open* "<tool_call>") -(def *hermes-close* "</tool_call>") +(def *hermes-open* "<tool_call>") +(def *hermes-close* "</tool_call>") +(def *function-close* "</function>") +(def *parameter-close* "</parameter>") (def (try-parse-hermes-tool-calls text) - "Extract every <tool_call>...</tool_call> block from TEXT and return them - as tool-call records. Returns '() if none found. Malformed blocks are - skipped silently." - (let ((open-len (string-length *hermes-open*)) - (close-len (string-length *hermes-close*))) - (let loop ((rest text) (acc '())) - (let ((open (string-contains rest *hermes-open*))) - (if (not open) - (reverse acc) - (let* ((after (substring rest (+ open open-len) (string-length rest))) - (close (string-contains after *hermes-close*))) - (if (not close) - (reverse acc) - (let* ((block (substring after 0 close)) - (tail (substring after (+ close close-len) - (string-length after))) - (tc (parse-hermes-block block))) - (loop tail (if tc (cons tc acc) acc)))))))))) - -(def (parse-hermes-block block) - "Parse one <tool_call> body — looks for <function name=\"NAME\"> plus any - number of <parameter name=\"K\">V</parameter> children. Returns a - tool-call or #f." - (let ((fn-name (extract-quoted-attr block "<function name="))) + "Extract every <function ...>...</function> block from TEXT — works + whether wrapped in <tool_call>...</tool_call> or not, and whether the + function/parameter names use quoted (name=\"X\") or bare (=X) attribute + syntax. Returns '() if none found. Malformed blocks are skipped silently." + (let loop ((rest text) (acc '())) + (let ((pos (find-function-open rest))) + (cond + ((not pos) (reverse acc)) + (else + (let* ((after (substring rest pos (string-length rest))) + (gt (string-index after #\>))) + (cond + ((not gt) (reverse acc)) + (else + (let* ((opener (substring after 0 (+ gt 1))) + (rest2 (substring after (+ gt 1) (string-length after))) + (cpos (string-contains rest2 *function-close*))) + (cond + ((not cpos) (reverse acc)) + (else + (let* ((body (substring rest2 0 cpos)) + (tail (substring rest2 (+ cpos (string-length *function-close*)) + (string-length rest2))) + (tc (parse-function-call opener body))) + (loop tail (if tc (cons tc acc) acc)))))))))))))) + +(def (find-function-open text) + "Find the next '<function ' or '<function=' opener in TEXT. Returns the + position of '<' or #f. Skips '<function' followed by other chars so we + don't false-match arbitrary tokens like '<functions'." + (let loop ((offset 0)) + (cond + ((>= offset (string-length text)) #f) + (else + (let ((pos (string-contains (substring text offset (string-length text)) + "<function"))) + (cond + ((not pos) #f) + (else + (let* ((abs-pos (+ offset pos)) + (next (+ abs-pos (string-length "<function")))) + (cond + ((>= next (string-length text)) #f) + ((let ((c (string-ref text next))) + (or (char=? c #\space) (char=? c #\=) (char=? c #\tab))) + abs-pos) + (else (loop (+ abs-pos 1)))))))))))) + +(def (parse-function-call opener body) + "OPENER is the full opening tag (e.g. '<function name=\"hello\">' or + '<function=hello>'). BODY is the inner text up to (not including) + </function>. Returns a tool-call record or #f if name extraction fails." + (let ((fn-name (or (extract-quoted-attr opener "<function name=") + (extract-bare-attr opener "<function=")))) (and fn-name (let ((args (make-hash-table))) - (collect-hermes-parameters! block args) + (collect-hermes-parameters! body args) (restore-tool-call (format "hermes_~a_~a" fn-name (time-second (current-time))) fn-name (json-object->string args)))))) (def (collect-hermes-parameters! block args) - "Find every <parameter name=\"K\">V</parameter> in BLOCK and store K->V - in ARGS. Trims surrounding whitespace from V (mlx-lm wraps values in - newlines). Tolerates either single or double quoted attribute values." - (let ((p-tag "<parameter name=") - (close-p "</parameter>")) - (let loop ((rest block)) - (let ((p-start (string-contains rest p-tag))) - (when p-start - (let* ((after (substring rest (+ p-start (string-length p-tag)) - (string-length rest))) - (q-char (and (> (string-length after) 0) - (string-ref after 0)))) - (when (and q-char (or (char=? q-char #\") (char=? q-char #\'))) - (let* ((after-q1 (substring after 1 (string-length after))) - (q2 (string-index after-q1 q-char))) - (when q2 - (let* ((key (substring after-q1 0 q2)) - (after-q2 (substring after-q1 (+ q2 1) - (string-length after-q1))) - (gt (string-index after-q2 #\>))) - (when gt - (let* ((val-region (substring after-q2 (+ gt 1) - (string-length after-q2))) - (val-end (string-contains val-region close-p))) - (when val-end - (let* ((val (substring val-region 0 val-end)) - (after-end (substring val-region - (+ val-end (string-length close-p)) - (string-length val-region)))) - (hash-put! args key (string-trim val)) - (loop after-end))))))))))))))) + "Find every <parameter ...>V</parameter> in BLOCK and store K->V in ARGS. + Handles '<parameter name=\"K\">V</parameter>' (Hermes) and + '<parameter=K>V</parameter>' (qwen3-coder). V is whitespace-trimmed." + (let loop ((rest block)) + (let ((p-start (string-contains rest "<parameter"))) + (when p-start + (let* ((after (substring rest (+ p-start (string-length "<parameter")) + (string-length rest))) + (next (and (> (string-length after) 0) (string-ref after 0))) + (tail + (cond + ((eqv? next #\=) + (parse-bare-parameter! after args)) + ((or (eqv? next #\space) (eqv? next #\tab)) + (parse-quoted-parameter! after args)) + (else #f)))) + (when tail (loop tail))))))) + +(def (parse-bare-parameter! after-tag args) + "AFTER-TAG starts at '=' (right after '<parameter'). Parses + '=KEY>VALUE</parameter>' and stores KEY->VALUE in ARGS. Returns the + rest of the text after </parameter>, or #f on malformed." + (let* ((after-eq (substring after-tag 1 (string-length after-tag))) + (gt (string-index after-eq #\>))) + (and gt + (let* ((key (string-trim (substring after-eq 0 gt))) + (after-gt (substring after-eq (+ gt 1) (string-length after-eq))) + (val-end (string-contains after-gt *parameter-close*))) + (and val-end + (begin + (hash-put! args key + (string-trim (substring after-gt 0 val-end))) + (substring after-gt (+ val-end (string-length *parameter-close*)) + (string-length after-gt)))))))) + +(def (parse-quoted-parameter! after-tag args) + "AFTER-TAG starts at space/tab (right after '<parameter'). Parses + ' name=\"KEY\">VALUE</parameter>' (or single-quoted) and stores + KEY->VALUE in ARGS. Returns the rest after </parameter>, or #f." + (let ((name-pos (string-contains after-tag "name="))) + (and name-pos + (let* ((after-name (substring after-tag (+ name-pos 5) + (string-length after-tag))) + (q (and (> (string-length after-name) 0) + (string-ref after-name 0)))) + (and q + (or (char=? q #\") (char=? q #\')) + (let* ((after-q1 (substring after-name 1 (string-length after-name))) + (q2 (string-index after-q1 q))) + (and q2 + (let* ((key (substring after-q1 0 q2)) + (after-q2 (substring after-q1 (+ q2 1) + (string-length after-q1))) + (gt (string-index after-q2 #\>))) + (and gt + (let* ((after-gt (substring after-q2 (+ gt 1) + (string-length after-q2))) + (val-end (string-contains after-gt *parameter-close*))) + (and val-end + (begin + (hash-put! args key + (string-trim (substring after-gt 0 val-end))) + (substring after-gt + (+ val-end (string-length *parameter-close*)) + (string-length after-gt)))))))))))))) (def (extract-quoted-attr block prefix) "Find PREFIX in BLOCK then return the immediately following quoted value @@ -314,28 +389,101 @@ Be concise. Prefer edit over write for modifying existing files. (end (string-index tail q))) (and end (substring tail 0 end)))))))))) +(def (extract-bare-attr block prefix) + "Find PREFIX in BLOCK and return everything up to the next '>' (trimmed). + For unquoted attribute form (e.g. '<function=NAME>'). Returns #f if not found." + (let ((pos (string-contains block prefix))) + (and pos + (let* ((after (substring block (+ pos (string-length prefix)) + (string-length block))) + (end (string-index after #\>))) + (and end (string-trim (substring after 0 end))))))) + (def (strip-hermes-blocks text) - "Return TEXT with all <tool_call>...</tool_call> blocks removed and any - stray closing tags (</parameter>, </function>, </tool_call>) stripped. - The result is right-trimmed." - (let* ((open-len (string-length *hermes-open*)) - (close-len (string-length *hermes-close*)) - (no-blocks - (let loop ((rest text) (acc '())) - (let ((open (string-contains rest *hermes-open*))) - (if (not open) - (apply string-append (reverse (cons rest acc))) - (let* ((before (substring rest 0 open)) - (after (substring rest (+ open open-len) - (string-length rest))) - (close (string-contains after *hermes-close*))) - (if (not close) - ;; Unclosed — drop everything from <tool_call> onward. - (apply string-append (reverse (cons before acc))) - (let ((tail (substring after (+ close close-len) - (string-length after)))) - (loop tail (cons before acc)))))))))) - (string-trim (strip-orphan-hermes-tags no-blocks)))) + "Return TEXT with all tool-call XML removed: <tool_call>...</tool_call> + blocks, bare <function ...>...</function> blocks, stray closing tags + (</parameter>, </function>, </tool_call>), and empty <think>...</think> + shells (left over when the reasoning was entirely a tool call). The + result is right-trimmed." + (let* ((no-tc (strip-paired-blocks text *hermes-open* *hermes-close*)) + (no-func (strip-function-blocks no-tc)) + (no-orphans (strip-orphan-hermes-tags no-func)) + (no-thinks (strip-empty-thinks no-orphans))) + (string-trim no-thinks))) + +(def (strip-paired-blocks text open close) + "Remove every OPEN...CLOSE block from TEXT. If a block is unclosed, + everything from OPEN onward is dropped." + (let ((open-len (string-length open)) + (close-len (string-length close))) + (let loop ((rest text) (acc '())) + (let ((o (string-contains rest open))) + (if (not o) + (apply string-append (reverse (cons rest acc))) + (let* ((before (substring rest 0 o)) + (after (substring rest (+ o open-len) (string-length rest))) + (c (string-contains after close))) + (if (not c) + (apply string-append (reverse (cons before acc))) + (let ((tail (substring after (+ c close-len) (string-length after)))) + (loop tail (cons before acc)))))))))) + +(def (strip-function-blocks text) + "Remove every '<function ...>...</function>' block from TEXT (qwen3-coder + bare form). Standard Hermes blocks are already stripped via + strip-paired-blocks before this runs." + (let ((close-len (string-length *function-close*))) + (let loop ((rest text) (acc '())) + (let ((pos (find-function-open rest))) + (cond + ((not pos) + (apply string-append (reverse (cons rest acc)))) + (else + (let* ((before (substring rest 0 pos)) + (after (substring rest pos (string-length rest))) + (gt (string-index after #\>))) + (cond + ((not gt) + (apply string-append (reverse (cons rest acc)))) + (else + (let* ((rest2 (substring after (+ gt 1) (string-length after))) + (cpos (string-contains rest2 *function-close*))) + (cond + ((not cpos) + (apply string-append (reverse (cons before acc)))) + (else + (let ((tail (substring rest2 (+ cpos close-len) + (string-length rest2)))) + (loop tail (cons before acc))))))))))))))) + +(def (strip-empty-thinks text) + "Remove every '<think>...</think>' shell whose interior is whitespace only. + Non-empty <think> blocks are preserved so downstream sees the model's + thinking." + (let* ((open "<think>") + (close "</think>") + (open-len (string-length open)) + (close-len (string-length close))) + (let loop ((rest text) (acc '())) + (let ((o (string-contains rest open))) + (cond + ((not o) + (apply string-append (reverse (cons rest acc)))) + (else + (let* ((before (substring rest 0 o)) + (after (substring rest (+ o open-len) (string-length rest))) + (c (string-contains after close))) + (cond + ((not c) + (apply string-append (reverse (cons rest acc)))) + ((string=? (string-trim (substring after 0 c)) "") + (let ((tail (substring after (+ c close-len) (string-length after)))) + (loop tail (cons before acc)))) + (else + (let* ((end (+ o open-len c close-len)) + (kept (substring rest 0 end)) + (tail (substring rest end (string-length rest)))) + (loop tail (cons kept acc)))))))))))) (def (strip-orphan-hermes-tags text) (let loop ((s text) --- a/vendor/chez-sqlite +++ b/vendor/chez-sqlite @@ -1 +1 @@ -Subproject commit 11c1031e66ebe961799d8f0862ee8398eae5bd26 +Subproject commit 388d0814b86c84e53544d2077f0616f38d047185