Green threads for parallel tool exec, batch, MCP init; fix one-shot mode
ober
bd259b363a12c9dca6ee7316fff69e5f54832b64
--- a/lib/jcode/core/agent.sls +++ b/lib/jcode/core/agent.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) (jcode core config) (jcode core log) - (jcode core message) (jcode core session) + (std text json) (std misc thread) (jcode core config) + (jcode core log) (jcode core message) (jcode core session) (jcode provider provider) (jcode tool registry) (jerboa core) (jerboa runtime)) (def logger (make-logger "agent")) @@ -102,7 +102,13 @@ logger "executing-tools" `((count . ,(length tool-calls)))) - (map execute-single-tool tool-calls)) + (if (<= (length tool-calls) 1) + (map execute-single-tool tool-calls) + (let ([threads (map (lambda (tc) + (spawn + (lambda () (execute-single-tool tc)))) + tool-calls)]) + (map thread-join! threads)))) (def (execute-single-tool tc) (let* ([name (tool-call-name tc)] [args (string->json-object (tool-call-arguments tc))] --- a/lib/jcode/mcp/client.sls +++ b/lib/jcode/mcp/client.sls @@ -10,9 +10,9 @@ (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 misc string) (jcode core log) - (jcode core config) (jcode tool registry) (jerboa core) - (jerboa runtime)) + (std text json) (std misc string) (std misc thread) + (jcode core log) (jcode core config) (jcode tool registry) + (jerboa core) (jerboa runtime)) (def logger (make-logger "mcp")) (defstruct mcp-conn @@ -180,28 +180,50 @@ (hash->list servers) '()))) (def (init-mcp-tools) - "Initialize all configured MCP servers." + "Initialize all configured MCP servers in parallel." (mcp-stop-all!) - (let ([configs (load-mcp-config)]) - (for-each - (lambda (pair) - (let ([name (car pair)] [cfg (cdr pair)]) - (try (let* ([command (hash-ref cfg "command" "node")] - [args (let ([a (hash-get cfg "args")]) - (if (list? a) a '()))] - [prefix (or (hash-get cfg "prefix") - (string-append "mcp_" name "_"))] - [conn (mcp-start name command args)]) - (mcp-initialize conn) - (let ([count (register-mcp-tools conn prefix)]) - (log-info - logger - "ready" - `((server . ,name) (tools . ,count))))) - (catch - (e) - (log-error - logger - "init-failed" - `((server . ,name) (error . ,(err->string e)))))))) - configs)))) + (let* ([configs (load-mcp-config)] + [threads (map (lambda (pair) + (let ([name (car pair)] [cfg (cdr pair)]) + (spawn + (lambda () + (try (let* ([command (hash-ref + cfg + "command" + "node")] + [args (let ([a (hash-get + cfg + "args")]) + (if (list? a) + a + '()))] + [prefix (or (hash-get + cfg + "prefix") + (string-append + "mcp_" + name + "_"))] + [conn (mcp-start + name + command + args)]) + (mcp-initialize conn) + (let ([count (register-mcp-tools + conn + prefix)]) + (log-info + logger + "ready" + `((server . ,name) + (tools . ,count))))) + (catch + (e) + (log-error + logger + "init-failed" + `((server . ,name) + (error . + ,(err->string e)))))))))) + configs)]) + (for-each thread-join! threads)))) --- a/lib/jcode/provider/provider.sls +++ b/lib/jcode/provider/provider.sls @@ -9,10 +9,10 @@ (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 net request) (std net tls-rustls) - (std net tcp) (std misc string) (std misc retry) - (jcode core log) (jcode core message) (jerboa core) - (jerboa runtime)) + (std text json) (except (std net request) http-post-stream) + (std net tls-rustls) (std net tcp) (std misc string) + (std misc retry) (jcode core log) (jcode core message) + (jerboa core) (jerboa runtime)) (def logger (make-logger "provider")) (def *api-retry-policy* (make-retry-policy 3 1.0 30.0 #t)) (def (retryable-error? e) @@ -299,7 +299,11 @@ (format "API error ~a: ~a" status body)))) (let loop () (let ([line (tls-read-line conn)]) - (when line (line-cb line) (loop)))))) + (when line + (unless (equal? line "0") + (line-cb line) + (loop))))) + status)) (lambda () (rustls-close conn)))) (let-values ([(in out) (tcp-connect host port)]) (dynamic-wind --- a/lib/jcode/tool/batch.sls +++ b/lib/jcode/tool/batch.sls @@ -8,13 +8,14 @@ (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 misc string) (jcode core log) - (jcode tool registry) (jerboa core) (jerboa runtime)) + (std text json) (std misc string) (std misc thread) + (jcode core log) (jcode tool registry) (jerboa core) + (jerboa runtime)) (def logger (make-logger "tool.batch")) (def (init-batch-tool) (register-tool! "batch" - "Execute multiple tool calls in sequence. Use this instead of making separate requests for independent operations (reading multiple files, running multiple commands, etc.). Returns labeled results for each call." + "Execute multiple tool calls in parallel using green threads. Use this instead of making separate requests for independent operations (reading multiple files, running multiple commands, etc.). Returns labeled results for each call." (make-batch-schema) handle-batch)) (def (handle-batch args) @@ -25,26 +26,33 @@ [(not (list? calls)) "Error: 'calls' must be an array of tool call objects"] [else - (let ([results (map (lambda (call) - (let ([tool-name (and (hash-table? call) - (hash-get - call - "tool"))] - [tool-args (and (hash-table? call) - (or (hash-get - call - "args") - (make-hash-table)))]) - (if tool-name - (cons - tool-name - (tool-execute - tool-name - tool-args)) - (cons - "?" - "Error: missing 'tool' field")))) - calls)]) + (let ([results (let ([threads (map (lambda (call) + (let ([tool-name (and (hash-table? + call) + (hash-get + call + "tool"))] + [tool-args (and (hash-table? + call) + (or (hash-get + call + "args") + (make-hash-table)))]) + (if tool-name + (spawn + (lambda () + (cons + tool-name + (tool-execute + tool-name + tool-args)))) + (spawn + (lambda () + (cons + "?" + "Error: missing 'tool' field")))))) + calls)]) + (map thread-join! threads))]) (string-join (map (lambda (r) (format --- a/lib/jcode/ui/cli.sls +++ b/lib/jcode/ui/cli.sls @@ -8,13 +8,13 @@ (except (chezscheme) make-hash-table hash-table? iota \x31;+ \x31;- getenv path-extension path-absolute? thread? make-mutex mutex? mutex-name) - (std misc string) (std text json) (jcode core config) - (jcode core log) (jcode core session) (jcode core message) - (jcode core agent) (jcode tool registry) (jcode tool file) - (jcode tool bash) (jcode tool web) (jcode tool batch) - (jcode tool git) (jcode mcp client) (jcode tool lsp) - (jcode core plugin) (jcode ui tui) (jerboa core) - (jerboa runtime)) + (std misc string) (std misc thread) (std text json) + (jcode core config) (jcode core log) (jcode core session) + (jcode core message) (jcode core agent) + (jcode tool registry) (jcode tool file) (jcode tool bash) + (jcode tool web) (jcode tool batch) (jcode tool git) + (jcode mcp client) (jcode tool lsp) (jcode core plugin) + (jcode ui tui) (jerboa core) (jerboa runtime)) (def logger (make-logger "cli")) (def *version* "0.1.0") (def (cli-main args) @@ -86,7 +86,12 @@ [else (cons (cons '\x2D;- args) (reverse opts))]))) (def (init-tools) (init-file-tools) (init-bash-tool) (init-web-tools) (init-batch-tool) (init-git-tools) - (init-mcp-tools) (init-lsp-tools) (init-plugins)) + (let ([t-mcp (spawn init-mcp-tools)] + [t-lsp (spawn init-lsp-tools)] + [t-plugins (spawn init-plugins)]) + (thread-join! t-mcp) + (thread-join! t-lsp) + (thread-join! t-plugins))) (def (display-help) (display "jcode - Portable AI coding agent\n\nUSAGE:\n jcode [OPTIONS] [PROMPT]\n jcode [COMMAND]\n\nOPTIONS:\n -h, --help Show this help message\n -v, --version Show version\n -d, --debug Enable debug logging\n -m, --model Model to use (default: claude-sonnet-4-20250514)\n -p, --provider Provider to use (default: anthropic)\n --tui Launch terminal UI mode\n --no-tui Force line-mode REPL (default)\n --verbose Log TUI events to ~/jcode.log\n\nCOMMANDS:\n session list List all sessions\n session resume Resume a previous session\n config Show or edit configuration\n\nEXAMPLES:\n jcode Start interactive session\n jcode \"Read main.ss\" One-shot query\n jcode session list List sessions\n")) @@ -240,11 +245,9 @@ (parameterize ([current-stream-cb md-stream-token] [current-tool-cb tool-indicator]) (agent-chat prompt)) - (md-flush!) (newline) - (catch - (e) - (log-error logger "error" `((msg . ,(err->string e)))) - (printf "Error: ~a~n" (format-error e)) + (md-flush!) (newline) (mcp-stop-all!) (exit 0) + (catch (e) (log-error logger "error" `((msg . ,(err->string e)))) + (printf "Error: ~a~n" (format-error e)) (mcp-stop-all!) (exit 1)))) (def *md-line-buf* "") (def *md-in-code-block* #f) --- a/main-binary.ss +++ b/main-binary.ss @@ -7,6 +7,16 @@ (jcode core agent) (jcode ui cli)) -(cli-main (if (member "--no-tui" (command-line-arguments)) +(define (has-positional-args? args) + (cond + ((null? args) #f) + ((member (car args) '("--help" "-h" "--version" "-v" "--debug" "-d" "--tui" "--no-tui" "--verbose")) + (has-positional-args? (cdr args))) + ((member (car args) '("--model" "-m" "--provider" "-p")) + (if (null? (cdr args)) #f (has-positional-args? (cddr args)))) + (else #t))) + +(cli-main (if (or (member "--no-tui" (command-line-arguments)) + (has-positional-args? (command-line-arguments))) (command-line-arguments) (cons "--tui" (command-line-arguments)))) --- a/src/jcode/core/agent.ss +++ b/src/jcode/core/agent.ss @@ -10,6 +10,7 @@ current-model-override) (import :std/text/json + :std/misc/thread ./config ./log ./message @@ -100,7 +101,13 @@ Prefer using the edit tool over write for modifying existing files." (current-di (def (execute-tool-calls tool-calls) (log-info logger "executing-tools" `((count . ,(length tool-calls)))) - (map execute-single-tool tool-calls)) + (if (<= (length tool-calls) 1) + (map execute-single-tool tool-calls) + ;; Parallel: spawn a green thread per tool call, join all + (let ((threads (map (lambda (tc) + (spawn (lambda () (execute-single-tool tc)))) + tool-calls))) + (map thread-join! threads)))) (def (execute-single-tool tc) (let* ((name (tool-call-name tc)) --- a/src/jcode/mcp/client.ss +++ b/src/jcode/mcp/client.ss @@ -15,6 +15,7 @@ (import :std/text/json :std/misc/string + :std/misc/thread :jcode/core/log :jcode/core/config :jcode/tool/registry) @@ -198,25 +199,27 @@ '()))) (def (init-mcp-tools) - "Initialize all configured MCP servers." + "Initialize all configured MCP servers in parallel." (mcp-stop-all!) ;; clear any prior connections - (let ((configs (load-mcp-config))) - (for-each - (lambda (pair) - (let ((name (car pair)) - (cfg (cdr pair))) - (try - (let* ((command (hash-ref cfg "command" "node")) - (args (let ((a (hash-get cfg "args"))) - (if (list? a) a '()))) - (prefix (or (hash-get cfg "prefix") - (string-append "mcp_" name "_"))) - (conn (mcp-start name command args))) - (mcp-initialize conn) - (let ((count (register-mcp-tools conn prefix))) - (log-info logger "ready" - `((server . ,name) (tools . ,count))))) - (catch (e) - (log-error logger "init-failed" - `((server . ,name) (error . ,(err->string e)))))))) - configs))) + (let* ((configs (load-mcp-config)) + (threads + (map (lambda (pair) + (let ((name (car pair)) + (cfg (cdr pair))) + (spawn (lambda () + (try + (let* ((command (hash-ref cfg "command" "node")) + (args (let ((a (hash-get cfg "args"))) + (if (list? a) a '()))) + (prefix (or (hash-get cfg "prefix") + (string-append "mcp_" name "_"))) + (conn (mcp-start name command args))) + (mcp-initialize conn) + (let ((count (register-mcp-tools conn prefix))) + (log-info logger "ready" + `((server . ,name) (tools . ,count))))) + (catch (e) + (log-error logger "init-failed" + `((server . ,name) (error . ,(err->string e)))))))))) + configs))) + (for-each thread-join! threads))) --- a/src/jcode/provider/provider.ss +++ b/src/jcode/provider/provider.ss @@ -8,7 +8,7 @@ provider-model) (import :std/text/json - :std/net/request + (except (std net request) http-post-stream) :std/net/tls-rustls :std/net/tcp :std/misc/string @@ -284,12 +284,14 @@ (let ((body (tls-read-all conn))) (error 'http-post-stream (format "API error ~a: ~a" status body)))) - ;; Read SSE lines until EOF + ;; Read SSE lines until EOF or chunked terminator (let loop () (let ((line (tls-read-line conn))) (when line - (line-cb line) - (loop)))))) + (unless (equal? line "0") ;; chunked transfer end + (line-cb line) + (loop))))) + status)) (lambda () (rustls-close conn)))) ;; Plain HTTP via tcp (let-values (((in out) (tcp-connect host port))) --- a/src/jcode/tool/batch.ss +++ b/src/jcode/tool/batch.ss @@ -4,6 +4,7 @@ (import :std/text/json :std/misc/string + :std/misc/thread :jcode/core/log :jcode/tool/registry) @@ -11,7 +12,7 @@ (def (init-batch-tool) (register-tool! "batch" - "Execute multiple tool calls in sequence. Use this instead of making separate requests for independent operations (reading multiple files, running multiple commands, etc.). Returns labeled results for each call." + "Execute multiple tool calls in parallel using green threads. Use this instead of making separate requests for independent operations (reading multiple files, running multiple commands, etc.). Returns labeled results for each call." (make-batch-schema) handle-batch)) @@ -25,15 +26,17 @@ "Error: 'calls' must be an array of tool call objects") (else (let ((results - (map (lambda (call) - (let ((tool-name (and (hash-table? call) (hash-get call "tool"))) - (tool-args (and (hash-table? call) - (or (hash-get call "args") - (make-hash-table))))) - (if tool-name - (cons tool-name (tool-execute tool-name tool-args)) - (cons "?" "Error: missing 'tool' field")))) - calls))) + (let ((threads + (map (lambda (call) + (let ((tool-name (and (hash-table? call) (hash-get call "tool"))) + (tool-args (and (hash-table? call) + (or (hash-get call "args") + (make-hash-table))))) + (if tool-name + (spawn (lambda () (cons tool-name (tool-execute tool-name tool-args)))) + (spawn (lambda () (cons "?" "Error: missing 'tool' field")))))) + calls))) + (map thread-join! threads)))) (string-join (map (lambda (r) (format "<result tool=\"~a\">\n~a\n</result>" (car r) (cdr r))) --- a/src/jcode/ui/cli.ss +++ b/src/jcode/ui/cli.ss @@ -3,6 +3,7 @@ (export cli-main) (import :std/misc/string + :std/misc/thread :std/text/json :jcode/core/config :jcode/core/log @@ -80,14 +81,19 @@ (else (cons (cons '-- args) (reverse opts)))))) (def (init-tools) + ;; Register local tools (fast, no I/O) (init-file-tools) (init-bash-tool) (init-web-tools) (init-batch-tool) (init-git-tools) - (init-mcp-tools) - (init-lsp-tools) - (init-plugins)) + ;; External servers in parallel (spawn subprocesses, handshake) + (let ((t-mcp (spawn init-mcp-tools)) + (t-lsp (spawn init-lsp-tools)) + (t-plugins (spawn init-plugins))) + (thread-join! t-mcp) + (thread-join! t-lsp) + (thread-join! t-plugins))) (def (display-help) (display "\ @@ -237,9 +243,12 @@ EXAMPLES: (agent-chat prompt)) (md-flush!) (newline) + (mcp-stop-all!) + (exit 0) (catch (e) (log-error logger "error" `((msg . ,(err->string e)))) (printf "Error: ~a~n" (format-error e)) + (mcp-stop-all!) (exit 1)))) ;; --- line-buffered markdown renderer ---