Merge remote-tracking branch 'origin/master' into linux
ober
33fbe4c9b8ba470afdb15dcdaf0d2657b61a526a
--- a/build-binary.ss +++ b/build-binary.ss @@ -101,7 +101,8 @@ (library-directories))) (define jcode-modules - '("lib/jcode/core/config" + '("lib/jcode/core/models" + "lib/jcode/core/config" "lib/jcode/core/log" "lib/jcode/core/session" "lib/jcode/core/message" @@ -219,6 +220,14 @@ (generate-wpo-files #t)) (compile-program "main-binary.ss")) +;; Keep plugin-facing libraries visible at runtime by excluding from WPO. +(for-each (lambda (m) + (let ((wpo (format "~a.wpo" m))) + (when (file-exists? wpo) + (printf " Excluding ~a from WPO (plugin-visible)~n" m) + (delete-file wpo)))) + '("lib/jcode/tool/registry")) + ;; --- Step 2: Whole-program optimization --- (printf "[2/6] Running whole-program optimization...~n") (let ((missing (compile-whole-program "main-binary.wpo" "jcode-all.so"))) @@ -240,6 +249,7 @@ (map (lambda (m) (format "~a/~a.so" jerboa-lib-dir m)) '("jerboa/core" "jerboa/runtime" + "jerboa/prelude" "std/error" "std/format" "std/sort" --- a/lib/jcode/core/agent.sls +++ b/lib/jcode/core/agent.sls @@ -4,7 +4,7 @@ (library (jcode core agent) (export agent-run agent-chat agent-step current-stream-cb - current-tool-cb current-provider-override + current-tool-cb current-usage-cb current-provider-override current-model-override) (import (except (chezscheme) make-hash-table hash-table? iota \x31;+ \x31;- @@ -23,6 +23,8 @@ (current-directory))) (def current-stream-cb (make-parameter #f)) (def current-tool-cb (make-parameter #f)) + (def current-usage-cb (make-parameter #f)) + (def *max-tool-rounds* 8) (def (agent-run session-id user-input) (log-info logger "agent-run" `((session . ,session-id))) (let ([existing (session-get-messages session-id)]) @@ -36,9 +38,13 @@ (if (current-stream-cb) (agent-loop-stream session-id - (session-get-messages session-id)) - (agent-loop session-id (session-get-messages session-id)))) - (def (agent-loop session-id messages) + (session-get-messages session-id) + 0) + (agent-loop + session-id + (session-get-messages session-id) + 0))) + (def (agent-loop session-id messages round) (let* ([provider (get-current-provider)] [tools (get-tool-schemas)] [response (provider-chat provider messages tools)]) @@ -47,36 +53,50 @@ "got-response" `((role . ,(message-role response)))) (session-add-message session-id response) - (if (message-tool-calls response) - (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))) - response))) - (def (agent-loop-stream session-id messages) + (cond + [(not (message-tool-calls response)) response] + [(>= round *max-tool-rounds*) + (log-warn logger "max-rounds" `((round . ,round))) + response] + [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)))]))) + (def (agent-loop-stream session-id messages round) (let* ([provider (get-current-provider)] [tools (get-tool-schemas)]) - (let-values ([(content tool-calls) + (let-values ([(content tool-calls usage) (provider-stream-chat provider messages 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))]) (session-add-message session-id response) - (if (null? tool-calls) - response - (let ([results (execute-tool-calls tool-calls)]) - (for-each - (lambda (r) (session-add-message session-id r)) - results) - (agent-loop-stream - session-id - (session-get-messages session-id)))))))) + (cond + [(null? tool-calls) response] + [(>= round *max-tool-rounds*) + (log-warn logger "max-rounds" `((round . ,round))) + response] + [else + (let ([results (execute-tool-calls tool-calls)]) + (for-each + (lambda (r) (session-add-message session-id r)) + results) + (agent-loop-stream + session-id + (session-get-messages session-id) + (+ round 1)))]))))) (def (execute-tool-calls tool-calls) (log-info logger @@ -110,34 +130,48 @@ (make-system-message (system-prompt)) (make-user-message user-input))]) (if (current-stream-cb) - (agent-chat-loop-stream provider messages tools) - (agent-chat-loop provider messages tools)))) - (def (agent-chat-loop provider messages tools) + (agent-chat-loop-stream provider messages tools 0) + (agent-chat-loop provider messages tools 0)))) + (def (agent-chat-loop provider messages tools round) (let ([response (provider-chat provider messages tools)]) - (if (message-tool-calls response) - (let* ([results (execute-tool-calls - (message-tool-calls response))] - [new-messages (append - messages - (list response) - results)]) - (agent-chat-loop provider new-messages tools)) - (message-content response)))) - (def (agent-chat-loop-stream provider messages tools) - (let-values ([(content tool-calls) + (cond + [(not (message-tool-calls response)) + (message-content response)] + [(>= round *max-tool-rounds*) + (or (message-content response) "")] + [else + (let* ([results (execute-tool-calls + (message-tool-calls response))] + [new-messages (append + messages + (list response) + results)]) + (agent-chat-loop + provider + new-messages + tools + (+ round 1)))]))) + (def (agent-chat-loop-stream provider messages tools round) + (let-values ([(content tool-calls usage) (provider-stream-chat provider messages tools (current-stream-cb))]) - (if (null? tool-calls) - content - (let* ([response (make-assistant-message - (if (string=? content "") #f content) - tool-calls)] - [results (execute-tool-calls tool-calls)] - [new-msgs (append messages (list response) results)]) - (agent-chat-loop-stream provider new-msgs tools))))) + (cond + [(null? tool-calls) content] + [(>= round *max-tool-rounds*) content] + [else + (let* ([response (make-assistant-message + (if (string=? content "") #f content) + tool-calls)] + [results (execute-tool-calls tool-calls)] + [new-msgs (append messages (list response) results)]) + (agent-chat-loop-stream + provider + new-msgs + tools + (+ round 1)))]))) (def (agent-step messages) (let* ([provider (get-current-provider)] [tools (get-tool-schemas)]) --- a/lib/jcode/core/config.sls +++ b/lib/jcode/core/config.sls @@ -10,8 +10,8 @@ (except (chezscheme) make-hash-table hash-table? iota \x31;+ \x31;- getenv path-extension path-absolute? thread? make-mutex mutex? mutex-name) - (std text json) (std os path) (jerboa core) - (jerboa runtime)) + (std text json) (std os path) (jcode core models) + (jerboa core) (jerboa runtime)) (define *config*--cell (vector (make-parameter #f))) (def (jcode-home) "Return ~/.jcode, creating it if needed." @@ -56,8 +56,13 @@ (hash-put! config "providers" providers) config)) (def (merge-opencode-keys! providers) - (let ([auth-file (path-join (getenv "HOME") ".local" "share" - "opencode" "auth.json")]) + (let ([auth-file (let ([jcode-auth (path-join + (jcode-home) + "auth.json")]) + (if (file-exists? jcode-auth) + jcode-auth + (path-join (getenv "HOME") ".local" "share" + "opencode" "auth.json")))]) (when (file-exists? auth-file) (try (let ([auth (call-with-input-file auth-file @@ -92,14 +97,7 @@ (or (config-ref "model") (config-default-model (config-provider)))) (def (config-default-model provider) - (case (string->symbol provider) - [(anthropic) "claude-sonnet-4-20250514"] - [(openai) "gpt-4o"] - [(openrouter) "anthropic/claude-sonnet-4"] - [(deepseek) "deepseek-chat"] - [(google) "gemini-2.0-flash"] - [(ollama) "llama3.2"] - [else "gpt-4o"])) + (provider-default-model provider)) (def (config-provider) (or (config-ref "provider") (config-detect-provider) new file mode 100644 --- /dev/null +++ b/lib/jcode/core/models.sls @@ -0,0 +1,92 @@ +#!chezscheme +;;; Generated by jerbuild — DO NOT EDIT +;;; Source: src/jcode/core/models.ss + +(library (jcode core models) + (export + provider-models + all-providers + provider-display-name + provider-default-model) + (import + (except (chezscheme) make-hash-table hash-table? iota \x31;+ \x31;- + getenv path-extension path-absolute? thread? make-mutex + mutex? mutex-name) + (jerboa core) + (jerboa runtime)) + (def (all-providers) + '("anthropic" "openai" "openrouter" "deepseek" "google" + "ollama")) + (def (provider-display-name p) + (case (string->symbol p) + [(anthropic) "Anthropic"] + [(openai) "OpenAI"] + [(openrouter) "OpenRouter"] + [(deepseek) "DeepSeek"] + [(google) "Google"] + [(ollama) "Ollama (local)"] + [else p])) + (def (provider-default-model provider) + (case (string->symbol provider) + [(anthropic) "claude-sonnet-4-20250514"] + [(openai) "gpt-4o"] + [(openrouter) "anthropic/claude-sonnet-4"] + [(deepseek) "deepseek-chat"] + [(google) "gemini-2.5-flash"] + [(ollama) "llama3.2"] + [else "gpt-4o"])) + (def (provider-models provider) + (case (string->symbol provider) + [(anthropic) anthropic-models] + [(openai) openai-models] + [(deepseek) deepseek-models] + [(google) google-models] + [(openrouter) openrouter-models] + [(ollama) ollama-models] + [else '()])) + (def anthropic-models + '(("claude-sonnet-4-20250514" . "Claude Sonnet 4") + ("claude-opus-4-20250514" . "Claude Opus 4") + ("claude-haiku-35-20241022" . "Claude 3.5 Haiku"))) + (def openai-models + '(("gpt-4o" . "GPT-4o") ("gpt-4o-mini" . "GPT-4o Mini") + ("gpt-4-turbo" . "GPT-4 Turbo") ("o3" . "o3") + ("o3-mini" . "o3 Mini") ("o4-mini" . "o4 Mini"))) + (def deepseek-models + '(("deepseek-chat" . "DeepSeek V3") + ("deepseek-reasoner" . "DeepSeek R1"))) + (def google-models + '(("gemini-2.5-pro" . "Gemini 2.5 Pro") + ("gemini-2.5-flash" . "Gemini 2.5 Flash") + ("gemini-2.0-flash" . "Gemini 2.0 Flash"))) + (def openrouter-models + '(("anthropic/claude-sonnet-4" . "Claude Sonnet 4") + ("anthropic/claude-opus-4" . "Claude Opus 4") + ("anthropic/claude-haiku-3.5" . "Claude 3.5 Haiku") + ("openai/gpt-4o" . "GPT-4o") + ("openai/gpt-4o-mini" . "GPT-4o Mini") ("openai/o3" . "o3") + ("openai/o3-mini" . "o3 Mini") + ("openai/o4-mini" . "o4 Mini") + ("google/gemini-2.5-pro" . "Gemini 2.5 Pro") + ("google/gemini-2.5-flash" . "Gemini 2.5 Flash") + ("google/gemini-2.0-flash" . "Gemini 2.0 Flash") + ("meta-llama/llama-4-maverick" . "Llama 4 Maverick") + ("meta-llama/llama-4-scout" . "Llama 4 Scout") + ("meta-llama/llama-3.3-70b-instruct" . "Llama 3.3 70B") + ("deepseek/deepseek-chat-v3-0324" . "DeepSeek V3 0324") + ("deepseek/deepseek-r1" . "DeepSeek R1") + ("qwen/qwen3-235b-a22b" . "Qwen3 235B") + ("qwen/qwen3-30b-a3b" . "Qwen3 30B") + ("mistralai/mistral-large" . "Mistral Large") + ("mistralai/mistral-medium" . "Mistral Medium") + ("mistralai/codestral" . "Codestral") + ("cohere/command-r-plus" . "Command R+") + ("x-ai/grok-3" . "Grok 3") + ("x-ai/grok-3-mini" . "Grok 3 Mini") + ("microsoft/phi-4" . "Phi-4") + ("nousresearch/hermes-3-llama-3.1-405b" . "Hermes 3 405B"))) + (def ollama-models + '(("llama3.2" . "Llama 3.2") ("llama3.1" . "Llama 3.1") + ("qwen2.5-coder" . "Qwen 2.5 Coder") + ("deepseek-r1" . "DeepSeek R1") ("mistral" . "Mistral") + ("codellama" . "Code Llama") ("gemma2" . "Gemma 2")))) --- a/lib/jcode/core/plugin.sls +++ b/lib/jcode/core/plugin.sls @@ -37,9 +37,20 @@ (let ([entries (directory-list dir)]) (if (list? entries) entries '()))))) dirs)))) - (def (load-plugin path) - "Load a single plugin file." + (def (ensure-library-dirs!) + "Ensure library-directories includes Jerboa lib dir for plugin imports." + (let ([jerboa-lib (path-join + (or (getenv "JERBOA_HOME") + (path-join (getenv "HOME") "mine/jerboa")) + "lib")]) + (when (file-directory? jerboa-lib) + (let ([entry (cons jerboa-lib jerboa-lib)]) + (unless (member entry (library-directories)) + (library-directories + (cons entry (library-directories)))))))) + (def (load-plugin path) "Load a single plugin file." (log-info logger "loading" `((path . ,path))) + (ensure-library-dirs!) (try (load path) (set! *loaded-plugins* (cons path *loaded-plugins*)) (log-info logger "loaded" `((path . ,path))) #t --- a/lib/jcode/mcp/client.sls +++ b/lib/jcode/mcp/client.sls @@ -5,7 +5,7 @@ (library (jcode mcp client) (export init-mcp-tools mcp-conn? mcp-conn-name mcp-start mcp-initialize mcp-list-tools mcp-call-tool mcp-stop! - mcp-stop-all!) + mcp-stop-all! mcp-active-servers) (import (except (chezscheme) make-hash-table hash-table? iota \x31;+ \x31;- getenv path-extension path-absolute? thread? make-mutex @@ -48,6 +48,13 @@ (def (mcp-stop-all!) (for-each mcp-stop! *mcp-servers*) (set! *mcp-servers* '())) + (def (mcp-active-servers) + "Return list of (name . tool-count) for active MCP servers." + (map (lambda (conn) + (cons + (mcp-conn-name conn) + (length (try (mcp-list-tools conn) (catch (e) '()))))) + *mcp-servers*)) (def (mcp-next-id! conn) (let ([id (mcp-conn-next-id conn)]) (mcp-conn-next-id-set! conn (+ id 1)) @@ -159,7 +166,7 @@ [schema (or (hash-get tool "inputSchema") (make-hash-table))]) (let ([jcode-name (string-append prefix name)]) - (register-tool! + (register-internal-tool! jcode-name desc schema @@ -174,6 +181,7 @@ '()))) (def (init-mcp-tools) "Initialize all configured MCP servers." + (mcp-stop-all!) (let ([configs (load-mcp-config)]) (for-each (lambda (pair) --- a/lib/jcode/provider/provider.sls +++ b/lib/jcode/provider/provider.sls @@ -594,6 +594,9 @@ (let ([body (make-hash-table)]) (hash-put! body "model" (provider-model provider)) (hash-put! body "stream" #t) + (let ([opts (make-hash-table)]) + (hash-put! opts "include_usage" #t) + (hash-put! body "stream_options" opts)) (hash-put! body "messages" (map message->json messages)) (when (and tools (not (null? tools))) (hash-put! body "tools" tools)) @@ -605,67 +608,139 @@ [headers (openai-headers provider)] [body (openai-stream-body provider messages tools)] [text-acc (open-output-string)] - [tc-table (make-hash-table)]) - (http-post-stream - url - headers - (json-object->string body) - (lambda (event-str) - (when event-str - (let* ([data (if (string-prefix? "data: " event-str) - (substring - event-str - 6 - (string-length event-str)) - event-str)]) - (cond - [(equal? data "[DONE]") (void)] - [else - (let ([json (guard (e [list #t #f]) - (string->json-object data))]) - (when json - (let* ([choices (hash-get json "choices")] - [choice (and (pair? choices) (car choices))] - [delta (and choice - (hash-get choice "delta"))]) - (when delta - (let ([content (hash-get delta "content")]) - (when (and content - (not (eq? content (void)))) - (put-string text-acc content) - (token-cb content))) - (let ([tcs (hash-get delta "tool_calls")]) - (when (and tcs (list? tcs)) - (for-each - (lambda (tc) - (let* ([idx (or (hash-get tc "index") - 0)] - [acc (or (hash-get tc-table idx) - (let ([a (make-hash-table)]) - (hash-put! - tc-table - idx - a) - a))] - [id (hash-get tc "id")] - [fn (hash-get tc "function")]) - (when id (hash-put! acc "id" id)) - (when fn - (let ([name (hash-get fn "name")] - [args (hash-get - fn - "arguments")]) - (when name - (hash-put! acc "name" name)) - (when args - (hash-put! - acc - "args" - (string-append - (or (hash-get acc "args") - "") - args))))))) - tcs)))))))]))))) + [tc-table (make-hash-table)] + [usage-acc (make-hash-table)]) + (let* ([body-json (json-object->string body)] + [dummy (log-info + logger + "stream-request" + `((url . ,url) + (body-len . ,(string-length body-json))))] + [http-status (http-post-stream + url + headers + body-json + (lambda (event-str) + (when event-str + (log-info + logger + "sse-event" + `((data + . + ,(if (> (string-length event-str) + 120) + (substring event-str 0 120) + event-str)))) + (let* ([data (if (string-prefix? + "data: " + event-str) + (substring + event-str + 6 + (string-length + event-str)) + event-str)]) + (cond + [(equal? data "[DONE]") (void)] + [else + (let ([json (guard (e [list #t #f]) + (string->json-object + data))]) + (when (and json + (hash-table? json)) + (let ([usage (hash-get + json + "usage")]) + (when (and usage + (hash-table? + usage)) + (hash-for-each + (lambda (k v) + (hash-put! + usage-acc + k + v)) + usage))) + (let* ([choices (hash-get + json + "choices")] + [choice (and (pair? + choices) + (car choices))] + [delta (and choice + (hash-get + choice + "delta"))]) + (when delta + (let ([content (hash-get + delta + "content")]) + (when (and content + (not (eq? content + (void)))) + (put-string + text-acc + content) + (token-cb content))) + (let ([tcs (hash-get + delta + "tool_calls")]) + (when (and tcs + (list? tcs)) + (for-each + (lambda (tc) + (let* ([idx (or (hash-get + tc + "index") + 0)] + [acc (or (hash-get + tc-table + idx) + (let ([a (make-hash-table)]) + (hash-put! + tc-table + idx + a) + a))] + [id (hash-get + tc + "id")] + [fn (hash-get + tc + "function")]) + (when id + (hash-put! + acc + "id" + id)) + (when fn + (let ([name (hash-get + fn + "name")] + [args (hash-get + fn + "arguments")]) + (when name + (hash-put! + acc + "name" + name)) + (when args + (hash-put! + acc + "args" + (string-append + (or (hash-get + acc + "args") + "") + args))))))) + tcs)))))))])))))]) + (unless (= http-status 200) + (log-error + logger + "stream-http-error" + `((status . ,http-status) (url . ,url))))) (let* ([content (get-output-string text-acc)] [indices (sort < (hash-keys tc-table))] [tool-calls (map (lambda (idx) @@ -676,7 +751,27 @@ (or (hash-get acc "name") "unknown") (or (hash-get acc "args") "{}")))) indices)]) - (values content tool-calls)))) + (log-info + logger + "stream-result" + `((content-len . ,(string-length content)) + (tool-calls . ,(length tool-calls)) + (tokens-in . ,(or (hash-get usage-acc "prompt_tokens") 0)) + (tokens-out + . + ,(or (hash-get usage-acc "completion_tokens") 0)) + (cost . ,(or (hash-get usage-acc "cost") 0)))) + (values + content + tool-calls + (list + (cons + 'tokens-in + (or (hash-get usage-acc "prompt_tokens") 0)) + (cons + 'tokens-out + (or (hash-get usage-acc "completion_tokens") 0)) + (cons 'cost (or (hash-get usage-acc "cost") 0))))))) (def (anthropic-stream-headers provider) `(("Content-Type" . "application/json") ("x-api-key" . ,(provider-api-key provider)) @@ -697,80 +792,166 @@ [body (anthropic-stream-body provider messages tools)] [text-acc (open-output-string)] [tu-table (make-hash-table)] - [current-idx (make-parameter #f)]) - (http-post-stream - url - headers - (json-object->string body) - (lambda (event-str) - (when event-str - (let* ([lines (string-split event-str #\newline)] - [event-type #f] - [data-str #f]) - (for-each - (lambda (line) - (cond - [(string-prefix? "event: " line) - (set! event-type - (substring line 7 (string-length line)))] - [(string-prefix? "data: " line) - (set! data-str - (substring line 6 (string-length line)))])) - lines) - (when (and event-type data-str) - (let ([json (guard (e [list #t #f]) - (string->json-object data-str))]) - (when json - (cond - [(equal? event-type "content_block_delta") - (let ([delta (hash-get json "delta")]) - (when delta - (let ([dtype (hash-get delta "type")]) - (cond - [(equal? dtype "text_delta") - (let ([text (hash-get delta "text")]) - (when text - (put-string text-acc text) - (token-cb text)))] - [(equal? dtype "input_json_delta") - (let ([idx (current-idx)] - [partial (hash-get - delta - "partial_json")]) - (when (and idx partial) - (let ([acc (hash-ref - tu-table - idx - #f)]) - (when acc - (hash-put! - acc - "args" - (string-append - (or (hash-get acc "args") - "") - partial))))))])))) - ((equal? event-type "content_block_start") - (let ([block (hash-get json "content_block")]) - (when (and block - (equal? - (hash-get block "type") - "tool_use")) - (let ([idx (hash-get json "index")]) - (current-idx idx) - (let ([acc (make-hash-table)]) - (hash-put! - acc - "id" - (hash-get block "id")) - (hash-put! - acc - "name" - (hash-get block "name")) - (hash-put! tu-table idx acc)))))) - ((equal? event-type "content_block_stop") - (current-idx #f)) - (#t (void))])))))))) + [current-idx (make-parameter #f)] + [usage-acc (make-hash-table)]) + (let ([http-status (http-post-stream + url + headers + (json-object->string body) + (lambda (event-str) + (when event-str + (let* ([lines (string-split + event-str + #\newline)] + [event-type #f] + [data-str #f]) + (for-each + (lambda (line) + (cond + [(string-prefix? "event: " line) + (set! event-type + (substring + line + 7 + (string-length line)))] + [(string-prefix? "data: " line) + (set! data-str + (substring + line + 6 + (string-length line)))])) + lines) + (when (and event-type data-str) + (let ([json (guard (e [list #t #f]) + (string->json-object + data-str))]) + (when (and json (hash-table? json)) + (cond + [(equal? + event-type + "content_block_delta") + (let ([delta (hash-get + json + "delta")]) + (when delta + (let ([dtype (hash-get + delta + "type")]) + (cond + [(equal? + dtype + "text_delta") + (let ([text (hash-get + delta + "text")]) + (when text + (put-string + text-acc + text) + (token-cb + text)))] + [(equal? + dtype + "input_json_delta") + (let ([idx (current-idx)] + [partial (hash-get + delta + "partial_json")]) + (when (and idx + partial) + (let ([acc (hash-ref + tu-table + idx + #f)]) + (when acc + (hash-put! + acc + "args" + (string-append + (or (hash-get + acc + "args") + "") + partial))))))])))) + ((equal? + event-type + "content_block_start") + (let ([block (hash-get + json + "content_block")]) + (when (and block + (equal? + (hash-get + block + "type") + "tool_use")) + (let ([idx (hash-get + json + "index")]) + (current-idx idx) + (let ([acc (make-hash-table)]) + (hash-put! + acc + "id" + (hash-get + block + "id")) + (hash-put! + acc + "name" + (hash-get + block + "name")) + (hash-put! + tu-table + idx + acc)))))) + ((equal? + event-type + "content_block_stop") + (current-idx #f)) + ((equal? + event-type + "message_start") + (let ([msg (hash-get + json + "message")]) + (when msg + (let ([usage (hash-get + msg + "usage")]) + (when (and usage + (hash-table? + usage)) + (hash-for-each + (lambda (k v) + (hash-put! + usage-acc + k + v)) + usage)))))) + ((equal? + event-type + "message_delta") + (let ([usage (hash-get + json + "usage")]) + (when (and usage + (hash-table? + usage)) + (hash-for-each + (lambda (k v) + (hash-put! + usage-acc + k + v)) + usage)))) + (#t (void))]))))))))]) + (unless (= http-status 200) + (log-error + logger + "stream-http-error" + `((status . ,http-status) (url . ,url))))) (let* ([content (get-output-string text-acc)] [indices (sort < (hash-keys tu-table))] [tool-calls (map (lambda (idx) @@ -781,16 +962,40 @@ (or (hash-get acc "name") "unknown") (or (hash-get acc "args") "{}")))) indices)]) - (values content tool-calls)))) + (values + content + tool-calls + (list + (cons 'tokens-in (or (hash-get usage-acc "input_tokens") 0)) + (cons + 'tokens-out + (or (hash-get usage-acc "output_tokens") 0)) + (cons 'cost 0)))))) (def (provider-stream-chat provider messages tools token-cb) + (unless (provider-api-key provider) + (error 'provider-stream-chat + (format + "No API key configured for provider '~a'. Set the appropriate env var or add it to jcode.json." + (provider-name provider)))) + (log-info + logger + "stream-chat" + `((provider . ,(provider-name provider)) + (model . ,(provider-model provider)) + (messages . ,(length messages)))) (case (string->symbol (provider-name provider)) [(openai openrouter deepseek ollama) (openai-stream-chat provider messages tools token-cb)] [(anthropic) (anthropic-stream-chat provider messages tools token-cb)] - [else + [(google) (let* ([response (provider-chat provider messages tools)] [content (or (message-content response) "")] [tcs (or (message-tool-calls response) '())]) (when (> (string-length content) 0) (token-cb content)) - (values content tcs))]))) + (values content tcs '()))] + [else + (error 'provider-stream-chat + (format + "Unknown provider '~a'" + (provider-name provider)))]))) --- a/lib/jcode/tool/lsp.sls +++ b/lib/jcode/tool/lsp.sls @@ -256,17 +256,17 @@ root)]) (lsp-initialize conn) (let ([schema (make-lsp-schema)]) - (register-tool! + (register-internal-tool! "lsp_definition" "Go to definition of symbol at file:line:character" schema handle-lsp-definition) - (register-tool! + (register-internal-tool! "lsp_hover" "Get hover information (type, docs) for symbol at file:line:character" schema handle-lsp-hover) - (register-tool! + (register-internal-tool! "lsp_references" "Find all references to symbol at file:line:character" schema --- a/lib/jcode/tool/registry.sls +++ b/lib/jcode/tool/registry.sls @@ -3,8 +3,8 @@ ;;; Source: src/jcode/tool/registry.ss (library (jcode tool registry) - (export register-tool! tool-execute get-tool-schemas - list-tools tool->openai-schema) + (export register-tool! register-internal-tool! tool-execute + get-tool-schemas list-tools tool->openai-schema) (import (except (chezscheme) make-hash-table hash-table? iota \x31;+ \x31;- getenv path-extension path-absolute? thread? make-mutex @@ -26,22 +26,46 @@ (let ([ht (make-hash-table)]) (for-each (lambda (p) (hash-put! ht (car p) (cdr p))) pairs) ht)) + (def (register-internal-tool! + name + description + schema + handler) + "Register a tool that won't be sent to the LLM (MCP, LSP, etc)." + (register-tool! name description schema handler) + (let ([t (hash-get *tools* name)]) + (when t (hash-put! t "internal" #t)))) + (def *max-tool-result-len* 16000) + (def (truncate-result str) + (if (<= (string-length str) *max-tool-result-len*) + str + (let ([keep (quotient *max-tool-result-len* 2)]) + (string-append + (substring str 0 keep) + (format + "\n\n... [truncated ~a chars] ...\n\n" + (- (string-length str) *max-tool-result-len*)) + (substring + str