Recover Anthropic-style invoke tool calls from DeepSeek
ober
6713809e3d61d220135108166015b955cb728ad4
--- a/src/jcode/core/agent.ss +++ b/src/jcode/core/agent.ss @@ -177,7 +177,11 @@ Be concise. Prefer edit over write for modifying existing files. (count . ,(length parsed)) (names . ,(map tool-call-name parsed)))) parsed) - (else (try-parse-xml-tool-calls text))))) + (else + (let ((xml-calls (try-parse-xml-tool-calls text))) + (if (not (null? xml-calls)) + xml-calls + (try-parse-invoke-tool-calls text))))))) (def (parse-one-text-tool-call line) "Parse 'tool_name(key=\"val\")' into a tool-call, or #f if not a tool call." @@ -868,6 +872,160 @@ Be concise. Prefer edit over write for modifying existing files. (else (hash-put! ht "_body" trimmed)))))) (json-object->string ht))) +;;; Anthropic/DSML invoke-tag tool call detection ;;; +;;; DeepSeek occasionally emits Claude-style invocations wrapped in its own +;;; tokenizer markers, e.g.: +;;; <｜DSML｜tool_calls> +;;; <｜DSML｜invoke name="glob"> +;;; <｜DSML｜parameter name="pattern">**/*.ss</｜DSML｜parameter> +;;; </｜DSML｜invoke> +;;; </｜DSML｜tool_calls> +;;; The wrapper prefix bytes vary per tokenizer; we anchor on the +;;; "invoke name=" / "parameter name=" suffixes which are stable. + +(def (try-parse-invoke-tool-calls text) + (cond + ((not (xml-find-from text "invoke name=" 0 (string-length text))) '()) + (else + (let ((calls (collect-invokes text))) + (when (not (null? calls)) + (log-warn logger "text-tool-calls-detected" + `((style . invoke) + (count . ,(length calls)) + (names . ,(map tool-call-name calls))))) + calls)))) + +(def (collect-invokes text) + (let ((end (string-length text))) + (let loop ((pos 0) (acc '())) + (let ((hit (xml-find-from text "invoke name=" pos end))) + (cond + ((not hit) (reverse acc)) + (else + (let ((parsed (parse-one-invoke text hit end))) + (cond + ((not parsed) (loop (+ hit 12) acc)) + (else + (let ((next-pos (vector-ref parsed 0)) + (call (vector-ref parsed 1))) + (loop next-pos (if call (cons call acc) acc)))))))))))) + +(def (parse-one-invoke text hit end) + ;; hit points at start of "invoke name=...". Read quoted name, then find + ;; the matching </...invoke> and walk parameters in between. + (let* ((after (+ hit (string-length "invoke name=")))) + (cond + ((>= after end) #f) + (else + (let ((name-info (parse-invoke-quoted text after end))) + (cond + ((not name-info) #f) + (else + (let* ((tool-name (car name-info)) + (after-name (cdr name-info)) + (open-gt (xml-find-from text ">" after-name end))) + (cond + ((not open-gt) #f) + (else + (let* ((body-start (+ open-gt 1)) + ;; Match "invoke>" closing — the leading "</prefix" is + ;; the close marker we walk back to from the suffix. + (close-suffix (xml-find-from text "invoke>" body-start end))) + (cond + ((not close-suffix) #f) + (else + (let* ((close-lt (xml-back-to-lt text close-suffix)) + (body-end (or close-lt close-suffix)) + (next-pos (+ close-suffix (string-length "invoke>"))) + (body (substring text body-start body-end)) + (params (collect-parameters body))) + (cond + ((tool-exists? tool-name) + (vector next-pos + (make-tool-call tool-name + (params->json-args params)))) + (else (vector next-pos #f))))))))))))))))) + +(def (parse-invoke-quoted text start end) + ;; Read a quoted attribute value: "..." or '...'. Returns (value . pos-after). + (let loop ((i start)) + (cond + ((>= i end) #f) + ((char-whitespace? (string-ref text i)) (loop (+ i 1))) + ((or (char=? (string-ref text i) #\") + (char=? (string-ref text i) #\')) + (let* ((qch (string-ref text i)) + (vstart (+ i 1)) + (vend (let qloop ((k vstart)) + (cond + ((>= k end) k) + ((char=? (string-ref text k) qch) k) + (else (qloop (+ k 1))))))) + (and (< vend end) + (cons (substring text vstart vend) (+ vend 1))))) + (else #f)))) + +(def (xml-back-to-lt text suffix-pos) + ;; suffix-pos is at the start of "invoke>" or "parameter>". Walk left to + ;; find the '<' that opened the close tag. Stop at first '<' or whitespace + ;; that isn't part of the wrapper prefix. + (let loop ((i (- suffix-pos 1))) + (cond + ((< i 0) #f) + ((char=? (string-ref text i) #\<) i) + ((char=? (string-ref text i) #\>) #f) + (else (loop (- i 1)))))) + +(def (collect-parameters body) + ;; Returns alist ((name . value) ...) of parameter tags inside body. + (let ((end (string-length body))) + (let loop ((pos 0) (acc '())) + (let ((hit (xml-find-from body "parameter name=" pos end))) + (cond + ((not hit) (reverse acc)) + (else + (let* ((after (+ hit (string-length "parameter name="))) + (name-info (parse-invoke-quoted body after end))) + (cond + ((not name-info) (loop (+ hit 15) acc)) + (else + (let* ((pname (car name-info)) + (after-name (cdr name-info)) + (open-gt (xml-find-from body ">" after-name end))) + (cond + ((not open-gt) (loop (+ hit 15) acc)) + (else + (let* ((val-start (+ open-gt 1)) + (close-suffix (xml-find-from body "parameter>" val-start end))) + (cond + ((not close-suffix) (loop (+ hit 15) acc)) + (else + (let* ((close-lt (xml-back-to-lt body close-suffix)) + (val-end (or close-lt close-suffix)) + (next-pos (+ close-suffix (string-length "parameter>"))) + (raw (substring body val-start val-end)) + (val (string-trim raw))) + (loop next-pos + (cons (cons pname val) acc)))))))))))))))))) + +(def (params->json-args params) + ;; Build JSON object from (name . string-value) pairs. If a value parses + ;; as JSON (object/array/number/bool), keep it as-is so e.g. tool args + ;; like {"calls":[...]} pass through unwrapped. Otherwise treat as string. + (let ((ht (make-hash-table))) + (for-each + (lambda (p) + (let* ((k (car p)) + (v (cdr p)) + (parsed (guard (e [#t #f]) + (string->json-object v)))) + (cond + ((or (hash-table? parsed) (list? parsed)) + (hash-put! ht k parsed)) + (else (hash-put! ht k v))))) + params) + (json-object->string ht))) + (def (agent-run session-id user-input) (log-info logger "agent-run" `((session . ,session-id))) (let ((existing (session-get-messages session-id)))