Recover XML-style tool calls from DeepSeek; fix Termux binary link
ober
97e2f45a445af7f311a57a19f902dd4e9fff84e4
--- a/build-binary.ss +++ b/build-binary.ss @@ -515,7 +515,11 @@ (macos? (format "-lkernel -llz4 -lz -lm -lpthread -lncurses -liconv -lc++ ~a -lsqlite3" sqlite-lib)) (termux? - "-lkernel -llz4 -lz -lm -ldl -lpthread -lncurses -liconv -lsqlite3") + ;; -lc++_shared is required: libjerboa_native.a bundles DuckDB (C++) + ;; whose internals reference std::__ndk1::* symbols that live in + ;; Termux's libc++_shared.so. Without this the link fails with hundreds + ;; of "undefined symbol: std::__ndk1::__next_prime" etc. + "-lkernel -llz4 -lz -lm -ldl -lpthread -lncurses -liconv -lsqlite3 -lc++_shared") (else ;; -lstdc++ needed because libjerboa_native.a (built with --features full ;; in jerboa's `make native`) bundles duckdb, which is a C++ codebase --- a/src/jcode/core/agent.ss +++ b/src/jcode/core/agent.ss @@ -8,7 +8,9 @@ current-usage-cb current-provider-override current-model-override - get-current-provider) + get-current-provider + try-parse-text-tool-calls + try-parse-xml-tool-calls) (import :std/text/json :std/misc/thread @@ -51,6 +53,12 @@ IMPORTANT RULES: - Do NOT call the same tool repeatedly with the same or similar arguments. Use grep/glob to locate code instead of guessing paths. - Use batch to parallelize independent reads. +CRITICAL — Tool invocation format: Invoke tools ONLY through the function-calling +API (the structured tool_calls field of your response). NEVER write tool calls as +XML such as <tool ... />, <batch>...</batch>, or inside markdown code blocks. +Text-form tool invocations are not part of the protocol and may be silently +dropped — emit a real tool_call message instead. + When the user asks you to do something: 1. Use grep or glob to FIND the relevant source files in src/ 2. READ those files to see what's actually there @@ -154,18 +162,22 @@ Be concise. Prefer edit over write for modifying existing files. ;;; agent loop can still execute them. (def (try-parse-text-tool-calls text) - "Check if text consists entirely of tool-call patterns like 'read(path=\"f\")'.\n Returns list of tool-call objects, or '()." + "Detect tool calls embedded in assistant text. Tries paren-style first + (lines like 'read(path=\"f\")'), then XML-style (<tool ... /> wrapped in + <batch>...</batch>) as a fallback. Returns list of tool-call objects, or '()." (let* ((trimmed (string-trim text)) (lines (string-split trimmed #\newline)) (non-empty (filter (lambda (l) (not (string=? (string-trim l) ""))) lines)) (parsed (filter (lambda (x) x) (map parse-one-text-tool-call non-empty)))) - (if (and (not (null? parsed)) (= (length parsed) (length non-empty))) - (begin - (log-warn logger "text-tool-calls-detected" - `((count . ,(length parsed)) - (names . ,(map tool-call-name parsed)))) - parsed) - '()))) + (cond + ((and (not (null? parsed)) + (= (length parsed) (length non-empty))) + (log-warn logger "text-tool-calls-detected" + `((style . paren) + (count . ,(length parsed)) + (names . ,(map tool-call-name parsed)))) + parsed) + (else (try-parse-xml-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." @@ -549,6 +561,253 @@ Be concise. Prefer edit over write for modifying existing files. (inner-cb (substring pending 0 fwd)) (set! pending (substring pending fwd slen))))))))))))) +;;; XML-format tool call detection ;;; +;;; DeepSeek (and other models given a large tools schema) sometimes emits +;;; tool calls as Claude-Code-style XML in the assistant message instead of +;;; using the OpenAI tool_calls API. Recognise the common shapes: +;;; <tool /> args = {} +;;; <tool key="val" /> args from attributes +;;; <tool>body</tool> body parsed as JSON if it looks like one +;;; <batch>...</batch> wrapper; children become parallel tool calls +;;; To avoid false positives from prose that mentions tag names informally, +;;; we only fire when a <batch> wrapper is present. Tags whose names are +;;; not in the registry are silently skipped. + +(def (try-parse-xml-tool-calls text) + (cond + ((not (xml-find-from text "<batch" 0 (string-length text))) '()) + (else + (let ((calls (xml-collect-tool-calls text))) + (when (not (null? calls)) + (log-warn logger "text-tool-calls-detected" + `((style . xml) + (count . ,(length calls)) + (names . ,(map tool-call-name calls))))) + calls)))) + +(def (xml-collect-tool-calls text) + (let ((end (string-length text))) + (let loop ((pos 0) (acc '())) + (let ((lt (xml-find-lt text pos end))) + (cond + ((not lt) (reverse acc)) + (else + (let ((tag (xml-parse-tag text lt end))) + (cond + ((not tag) (loop (+ lt 1) acc)) + (else + (let ((name (vector-ref tag 0)) + (attrs (vector-ref tag 1)) + (body (vector-ref tag 2)) + (next (vector-ref tag 3))) + (cond + ((equal? name "batch") + (loop next + (append (reverse (xml-collect-tool-calls body)) acc))) + ((tool-exists? name) + (loop next + (cons (make-tool-call name (xml->json-args attrs body)) + acc))) + (else (loop next acc))))))))))))) + +(def (xml-find-lt text start end) + (let loop ((i start)) + (cond + ((>= i end) #f) + ((and (char=? (string-ref text i) #\<) + (< (+ i 1) end) + (let ((c (string-ref text (+ i 1)))) + (or (and (char>=? c #\a) (char<=? c #\z)) + (and (char>=? c #\A) (char<=? c #\Z)) + (char=? c #\_)))) + i) + (else (loop (+ i 1)))))) + +(def (xml-name-char? c) + (or (and (char>=? c #\a) (char<=? c #\z)) + (and (char>=? c #\A) (char<=? c #\Z)) + (and (char>=? c #\0) (char<=? c #\9)) + (char=? c #\_) + (char=? c #\-) + (char=? c #\.))) + +(def (xml-scan-name text start end) + (let loop ((i start)) + (cond + ((>= i end) i) + ((xml-name-char? (string-ref text i)) (loop (+ i 1))) + (else i)))) + +(def (xml-find-gt text start end) + ;; Find first '>' from start that closes the tag. Quote-aware so '>' inside + ;; "..." or '...' is skipped. Returns (gt-pos . self-closing?) or #f. + (let loop ((i start) (in-q #f)) + (cond + ((>= i end) #f) + (in-q + (cond + ((char=? (string-ref text i) in-q) (loop (+ i 1) #f)) + (else (loop (+ i 1) in-q)))) + ((or (char=? (string-ref text i) #\") + (char=? (string-ref text i) #\')) + (loop (+ i 1) (string-ref text i))) + ((char=? (string-ref text i) #\>) + (cons i + (and (> i start) + (char=? (string-ref text (- i 1)) #\/)))) + (else (loop (+ i 1) in-q))))) + +(def (xml-find-from text pat start end) + (let* ((plen (string-length pat)) + (limit (- end plen))) + (let loop ((i start)) + (cond + ((> i limit) #f) + ((let m ((j 0)) + (cond + ((>= j plen) #t) + ((char=? (string-ref text (+ i j)) (string-ref pat j)) + (m (+ j 1))) + (else #f))) + i) + (else (loop (+ i 1))))))) + +(def (xml-strip-trailing-slash s) + (let ((al (string-length s))) + (if (and (> al 0) (char=? (string-ref s (- al 1)) #\/)) + (substring s 0 (- al 1)) + s))) + +(def (xml-parse-tag text lt end) + ;; lt points at '<'. Returns #(name attrs body next-pos) or #f. + (let* ((name-start (+ lt 1)) + (name-end (xml-scan-name text name-start end))) + (cond + ((<= name-end name-start) #f) + (else + (let* ((name (substring text name-start name-end)) + (gt-info (xml-find-gt text name-end end))) + (and gt-info + (xml-build-tag text name name-end gt-info end))))))) + +(def (xml-build-tag text name name-end gt-info end) + (let* ((gt-pos (car gt-info)) + (self-closing? (cdr gt-info)) + (attrs-raw (substring text name-end gt-pos)) + (attrs-str (if self-closing? + (xml-strip-trailing-slash attrs-raw) + attrs-raw)) + (attrs (xml-parse-attrs attrs-str))) + (cond + (self-closing? + (vector name attrs "" (+ gt-pos 1))) + (else + (let* ((body-start (+ gt-pos 1)) + (close-tag (string-append "</" name ">")) + (body-end (xml-find-from text close-tag body-start end))) + (and body-end + (vector name attrs + (substring text body-start body-end) + (+ body-end (string-length close-tag))))))))) + +(def (xml-parse-attrs s) + (let ((len (string-length s))) + (let loop ((i 0) (acc '())) + (let skip ((j i)) + (cond + ((>= j len) (reverse acc)) + ((or (char-whitespace? (string-ref s j)) + (char=? (string-ref s j) #\/)) + (skip (+ j 1))) + (else + (let* ((nstart j) + (nend + (let nloop ((k j)) + (cond + ((>= k len) k) + ((or (char=? (string-ref s k) #\=) + (char-whitespace? (string-ref s k)) + (char=? (string-ref s k) #\/)) + k) + (else (nloop (+ k 1))))))) + (cond + ((= nstart nend) (reverse acc)) + ((and (< nend len) (char=? (string-ref s nend) #\=)) + (let ((vstart (+ nend 1))) + (cond + ((>= vstart len) + (reverse (cons (cons (substring s nstart nend) "") acc))) + ((or (char=? (string-ref s vstart) #\") + (char=? (string-ref s vstart) #\')) + (let* ((qch (string-ref s vstart)) + (qstart (+ vstart 1)) + (qend + (let qloop ((k qstart)) + (cond + ((>= k len) k) + ((char=? (string-ref s k) qch) k) + (else (qloop (+ k 1))))))) + (loop (if (< qend len) (+ qend 1) qend) + (cons (cons (substring s nstart nend) + (xml-unescape (substring s qstart qend))) + acc)))) + (else + (let ((vend + (let vloop ((k vstart)) + (cond + ((>= k len) k) + ((char-whitespace? (string-ref s k)) k) + (else (vloop (+ k 1))))))) + (loop vend + (cons (cons (substring s nstart nend) + (substring s vstart vend)) + acc))))))) + (else + (loop nend + (cons (cons (substring s nstart nend) "true") acc))))))))))) + +(def (xml-unescape s) + (xml-replace-all + (xml-replace-all + (xml-replace-all + (xml-replace-all + (xml-replace-all s "<" "<") + ">" ">") + """ "\"") + "'" "'") + "&" "&")) + +(def (xml-replace-all s old new) + (let ((olen (string-length old))) + (if (= olen 0) s + (let ((slen (string-length s)) + (out (open-output-string))) + (let loop ((i 0)) + (let ((idx (xml-find-from s old i slen))) + (cond + ((not idx) + (put-string out (substring s i slen)) + (get-output-string out)) + (else + (put-string out (substring s i idx)) + (put-string out new) + (loop (+ idx olen)))))))))) + +(def (xml->json-args attrs body) + (let ((ht (make-hash-table))) + (for-each + (lambda (p) (hash-put! ht (car p) (cdr p))) + attrs) + (let ((trimmed (string-trim body))) + (when (and (> (string-length trimmed) 0) (null? attrs)) + (let ((parsed (guard (e [#t #f]) + (string->json-object trimmed)))) + (cond + ((hash-table? parsed) + (hash-for-each (lambda (k v) (hash-put! ht k v)) parsed)) + (else (hash-put! ht "_body" trimmed)))))) + (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)))