Parse text-format tool calls from models that lack function calling API support
ober
765dd2654227f517e562c4aa8e344f7e2ca2cf47
--- a/lib/jcode/core/agent.sls +++ b/lib/jcode/core/agent.sls @@ -93,6 +93,95 @@ (+ count 1) (+ bytes (string-length line) 1) (cons line acc)))))))) + (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 '()." + (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) + '()))) + (def (parse-one-text-tool-call line) + "Parse 'tool_name(key=\"val\")' into a tool-call, or #f if not a tool call." + (let* ([trimmed (string-trim line)] + [len (string-length trimmed)]) + (and (> len 3) + (char=? (string-ref trimmed (- len 1)) #\)) + (let ([paren (string-contains trimmed "(")]) + (and paren + (> paren 0) + (let ([name (substring trimmed 0 paren)]) + (and (tool-exists? name) + (let* ([args-str (substring + trimmed + (+ paren 1) + (- len 1))] + [json-args (parse-text-tool-args + args-str)]) + (and json-args + (restore-tool-call + (format + "text_~a_~a" + name + (time-second (current-time))) + name + json-args)))))))))) + (def (parse-text-tool-args args-str) + "Parse key=\"value\" pairs or JSON into a JSON string. Returns string or #f." + (let ([trimmed (string-trim args-str)]) + (if (string=? trimmed "") + "{}" + (or (guard (e [list #t #f]) + (let ([ht (string->json-object trimmed)]) + (and (hash-table? ht) (json-object->string ht)))) + (guard (e [list #t #f]) + (let ([ht (string->json-object + (string-append "{" trimmed "}"))]) + (and (hash-table? ht) (json-object->string ht)))) + (guard (e [list #t #f]) + (let ([ht (make-hash-table)]) + (for-each + (lambda (pair) + (let* ([p (string-trim pair)] + [eq-pos (string-contains p "=")]) + (when (and eq-pos (> eq-pos 0)) + (let* ([key (string-trim + (substring p 0 eq-pos))] + [val (string-trim + (substring + p + (+ eq-pos 1) + (string-length p)))]) + (hash-put! + ht + key + (if (and (>= (string-length val) 2) + (char=? (string-ref val 0) #\") + (char=? + (string-ref + val + (- (string-length val) 1)) + #\")) + (substring + val + 1 + (- (string-length val) 1)) + val)))))) + (string-split args-str #\,)) + (and (> (length (hash-keys ht)) 0) + (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)]) @@ -121,31 +210,39 @@ logger "got-response" `((role . ,(message-role response)))) - (session-add-message session-id response) - (cond - [(not (message-tool-calls response)) response] - [(>= round *max-tool-rounds*) - (log-warn logger "max-rounds" `((round . ,round))) - (let ([results (execute-tool-calls - (message-tool-calls response))]) - (for-each - (lambda (r) (session-add-message session-id r)) - results) - (let* ([final-msgs (refresh-system-prompt - (session-get-messages session-id))] - [final (provider-chat provider final-msgs '())]) - (session-add-message session-id final) - final))] - [else - (let ([results (execute-tool-calls - (message-tool-calls response))]) - (for-each - (lambda (result) (session-add-message session-id result)) - results) - (agent-loop - session-id - (session-get-messages session-id) - (+ round 1)))]))) + (let* ([content (or (message-content response) "")] + [real-tcs (message-tool-calls response)] + [text-tcs (if (and (not real-tcs) + (not (string=? content ""))) + (try-parse-text-tool-calls content) + '())] + [effective (if (null? text-tcs) + response + (make-assistant-message #f text-tcs))] + [tcs (or (message-tool-calls effective) '())]) + (session-add-message session-id effective) + (cond + [(null? tcs) effective] + [(>= round *max-tool-rounds*) + (log-warn logger "max-rounds" `((round . ,round))) + (let ([results (execute-tool-calls tcs)]) + (for-each + (lambda (r) (session-add-message session-id r)) + results) + (let* ([final-msgs (refresh-system-prompt + (session-get-messages session-id))] + [final (provider-chat provider final-msgs '())]) + (session-add-message session-id final) + final))] + [else + (let ([results (execute-tool-calls tcs)]) + (for-each + (lambda (result) (session-add-message session-id result)) + results) + (agent-loop + session-id + (session-get-messages session-id) + (+ round 1)))])))) (def (agent-loop-stream session-id messages round) (let* ([provider (get-current-provider)] [tools (get-tool-schemas)] @@ -158,15 +255,30 @@ (current-stream-cb))]) (when (and usage (current-usage-cb)) ((current-usage-cb) usage)) - (let ([response (make-assistant-message - (if (string=? content "") #f content) - (if (null? tool-calls) #f tool-calls))]) + (let* ([text-tcs (if (and (null? tool-calls) + (not (string=? content ""))) + (try-parse-text-tool-calls content) + '())] + [effective-tcs (if (null? tool-calls) + text-tcs + tool-calls)] + [effective-content (if (and (null? tool-calls) + (not (null? text-tcs))) + #f + (if (string=? content "") + #f + content))] + [response (make-assistant-message + effective-content + (if (null? effective-tcs) + #f + effective-tcs))]) (session-add-message session-id response) (cond - [(null? tool-calls) response] + [(null? effective-tcs) response] [(>= round *max-tool-rounds*) (log-warn logger "max-rounds" `((round . ,round))) - (let ([results (execute-tool-calls tool-calls)]) + (let ([results (execute-tool-calls effective-tcs)]) (for-each (lambda (r) (session-add-message session-id r)) results) @@ -183,7 +295,7 @@ (session-add-message session-id final) final)))] [else - (let ([results (execute-tool-calls tool-calls)]) + (let ([results (execute-tool-calls effective-tcs)]) (for-each (lambda (r) (session-add-message session-id r)) results) --- a/src/jcode/core/agent.ss +++ b/src/jcode/core/agent.ss @@ -125,6 +125,74 @@ Prefer using the edit tool over write for modifying existing files." (+ bytes (string-length line) 1) (cons line acc)))))))) +;;; Text-format tool call detection ;;; +;;; Some models (e.g. Llama via OpenRouter) output tool calls as plain text +;;; instead of using the function calling API. Detect and parse these so the +;;; 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 '()." + (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) + '()))) + +(def (parse-one-text-tool-call line) + "Parse 'tool_name(key=\"val\")' into a tool-call, or #f if not a tool call." + (let* ((trimmed (string-trim line)) + (len (string-length trimmed))) + (and (> len 3) + (char=? (string-ref trimmed (- len 1)) #\)) + (let ((paren (string-contains trimmed "("))) + (and paren + (> paren 0) + (let ((name (substring trimmed 0 paren))) + (and (tool-exists? name) + (let* ((args-str (substring trimmed (+ paren 1) (- len 1))) + (json-args (parse-text-tool-args args-str))) + (and json-args + (restore-tool-call + (format "text_~a_~a" name (time-second (current-time))) + name + json-args)))))))))) + +(def (parse-text-tool-args args-str) + "Parse key=\"value\" pairs or JSON into a JSON string. Returns string or #f." + (let ((trimmed (string-trim args-str))) + (if (string=? trimmed "") "{}" + (or + (guard (e [#t #f]) + (let ((ht (string->json-object trimmed))) + (and (hash-table? ht) (json-object->string ht)))) + (guard (e [#t #f]) + (let ((ht (string->json-object (string-append "{" trimmed "}")))) + (and (hash-table? ht) (json-object->string ht)))) + (guard (e [#t #f]) + (let ((ht (make-hash-table))) + (for-each + (lambda (pair) + (let* ((p (string-trim pair)) + (eq-pos (string-contains p "="))) + (when (and eq-pos (> eq-pos 0)) + (let* ((key (string-trim (substring p 0 eq-pos))) + (val (string-trim (substring p (+ eq-pos 1) (string-length p))))) + (hash-put! ht key + (if (and (>= (string-length val) 2) + (char=? (string-ref val 0) #\") + (char=? (string-ref val (- (string-length val) 1)) #\")) + (substring val 1 (- (string-length val) 1)) + val)))))) + (string-split args-str #\,)) + (and (> (length (hash-keys ht)) 0) + (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))) @@ -141,23 +209,33 @@ Prefer using the edit tool over write for modifying existing files." (msgs (refresh-system-prompt messages)) (response (provider-chat provider msgs tools))) (log-debug logger "got-response" `((role . ,(message-role response)))) - (session-add-message session-id response) - (cond - ((not (message-tool-calls response)) response) - ((>= round *max-tool-rounds*) - (log-warn logger "max-rounds" `((round . ,round))) - (let ((results (execute-tool-calls (message-tool-calls response)))) - (for-each (lambda (r) (session-add-message session-id r)) results) - (let* ((final-msgs (refresh-system-prompt (session-get-messages session-id))) - (final (provider-chat provider final-msgs '()))) - (session-add-message session-id final) - final))) - (else - (let ((results (execute-tool-calls (message-tool-calls response)))) - (for-each - (lambda (result) (session-add-message session-id result)) - results) - (agent-loop session-id (session-get-messages session-id) (+ round 1))))))) + ;; Detect text-format tool calls (some models output tool calls as text) + (let* ((content (or (message-content response) "")) + (real-tcs (message-tool-calls response)) + (text-tcs (if (and (not real-tcs) (not (string=? content ""))) + (try-parse-text-tool-calls content) + '())) + (effective (if (null? text-tcs) + response + (make-assistant-message #f text-tcs))) + (tcs (or (message-tool-calls effective) '()))) + (session-add-message session-id effective) + (cond + ((null? tcs) effective) + ((>= round *max-tool-rounds*) + (log-warn logger "max-rounds" `((round . ,round))) + (let ((results (execute-tool-calls tcs))) + (for-each (lambda (r) (session-add-message session-id r)) results) + (let* ((final-msgs (refresh-system-prompt (session-get-messages session-id))) + (final (provider-chat provider final-msgs '()))) + (session-add-message session-id final) + final))) + (else + (let ((results (execute-tool-calls tcs))) + (for-each + (lambda (result) (session-add-message session-id result)) + results) + (agent-loop session-id (session-get-messages session-id) (+ round 1)))))))) (def (agent-loop-stream session-id messages round) ;; Streaming version: calls (current-stream-cb) for each text token. @@ -168,15 +246,23 @@ Prefer using the edit tool over write for modifying existing files." (provider-stream-chat provider msgs tools (current-stream-cb)))) (when (and usage (current-usage-cb)) ((current-usage-cb) usage)) - (let ((response (make-assistant-message - (if (string=? content "") #f content) - (if (null? tool-calls) #f tool-calls)))) + ;; Detect text-format tool calls (some models output tool calls as text) + (let* ((text-tcs (if (and (null? tool-calls) (not (string=? content ""))) + (try-parse-text-tool-calls content) + '())) + (effective-tcs (if (null? tool-calls) text-tcs tool-calls)) + (effective-content (if (and (null? tool-calls) (not (null? text-tcs))) + #f + (if (string=? content "") #f content))) + (response (make-assistant-message + effective-content + (if (null? effective-tcs) #f effective-tcs)))) (session-add-message session-id response) (cond - ((null? tool-calls) response) + ((null? effective-tcs) response) ((>= round *max-tool-rounds*) (log-warn logger "max-rounds" `((round . ,round))) - (let ((results (execute-tool-calls tool-calls))) + (let ((results (execute-tool-calls effective-tcs))) (for-each (lambda (r) (session-add-message session-id r)) results) (let-values (((fc _tc _u) (provider-stream-chat provider @@ -187,7 +273,7 @@ Prefer using the edit tool over write for modifying existing files." (session-add-message session-id final) final)))) (else - (let ((results (execute-tool-calls tool-calls))) + (let ((results (execute-tool-calls effective-tcs))) (for-each (lambda (r) (session-add-message session-id r)) results) (agent-loop-stream session-id (session-get-messages session-id) (+ round 1)))))))))