Rewrite as proper Jerboa project with jerbuild pipeline
ober
6ad60e8b440e66b5f65c536dc4f66ebd403c8ff7
new file mode 100644 --- /dev/null +++ b/.gitignore @@ -0,0 +1,4 @@ +*.so +*.wpo +/jcode +.jerbuild-hashes new file mode 100644 --- /dev/null +++ b/.gitmodules @@ -0,0 +1,3 @@ +[submodule "vendor/chez-sqlite"] + path = vendor/chez-sqlite + url = https://github.com/ober/chez-sqlite.git --- a/Makefile +++ b/Makefile @@ -1,15 +1,26 @@ -SCHEME = scheme +SCHEME = scheme JERBOA_HOME ?= $(HOME)/mine/jerboa -LIBDIRS = --libdirs $(JERBOA_HOME)/lib:./lib:vendor/chez-sqlite/src +LIBDIRS = --libdirs $(JERBOA_HOME)/lib:./lib:vendor/chez-sqlite/src +JERBUILD = $(SCHEME) --libdirs $(JERBOA_HOME)/lib --script $(JERBOA_HOME)/jerbuild.ss -.PHONY: all build run test clean repl +# Library paths for FFI shared objects (macOS: dylib, Linux: so) +SQLITE_LIB_DIR := $(shell brew --prefix sqlite 2>/dev/null)/lib +SHIM_DIR := $(CURDIR)/vendor/chez-sqlite +LDPATH := $(SHIM_DIR):$(SQLITE_LIB_DIR) + +.PHONY: all build gen run test clean repl all: build -build: - $(SCHEME) $(LIBDIRS) --compile-imported-libraries --program main.ss +gen: + $(JERBUILD) src lib + +build: gen + DYLD_LIBRARY_PATH=$(LDPATH) LD_LIBRARY_PATH=$(LDPATH) \ + $(SCHEME) $(LIBDIRS) --compile-imported-libraries --script main.ss < /dev/null run: + DYLD_LIBRARY_PATH=$(LDPATH) LD_LIBRARY_PATH=$(LDPATH) \ $(SCHEME) $(LIBDIRS) --script main.ss repl: @@ -19,10 +30,7 @@ test: $(SCHEME) $(LIBDIRS) --script test/run.ss clean: + find lib/jcode -name "*.sls" -delete 2>/dev/null; true find . -name "*.so" -delete find . -name "*.wpo" -delete rm -f jcode - -# Static binary (requires Chez Scheme static libs) -static: build - @echo "Static build not yet implemented" new file mode 100644 --- /dev/null +++ b/lib/jcode/core/agent.sls @@ -0,0 +1,91 @@ +#!chezscheme +;;; Generated by jerbuild — DO NOT EDIT +;;; Source: src/jcode/core/agent.ss + +(library (jcode core agent) + (export agent-run agent-chat agent-step + current-provider-override current-model-override) + (import + (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) + (jcode provider provider) (jcode tool registry) + (jerboa core) (jerboa runtime)) + (def logger (make-logger "agent")) + (def current-provider-override (make-parameter #f)) + (def current-model-override (make-parameter #f)) + (def (system-prompt) + "You are an expert AI coding assistant. You help users with software development tasks.\n\nYou have access to tools that let you:\n- Read and write files\n- Execute shell commands\n- Search code and files\n\nWhen the user asks you to do something:\n1. Think about what tools you need\n2. Use tools to gather information or make changes\n3. Report back with results\n\nBe concise and helpful. When editing files, make minimal changes.") + (def (agent-run session-id user-input) + (log-info logger "agent-run" `((session . ,session-id))) + (let ([existing (session-get-messages session-id)]) + (when (null? existing) + (session-add-message + session-id + (make-system-message (system-prompt))))) + (session-add-message + session-id + (make-user-message user-input)) + (agent-loop session-id (session-get-messages session-id))) + (def (agent-loop session-id messages) + (let* ([provider (get-current-provider)] + [tools (get-tool-schemas)] + [response (provider-chat provider messages tools)]) + (log-debug + logger + "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 (execute-tool-calls tool-calls) + (log-info + logger + "executing-tools" + `((count . ,(length tool-calls)))) + (map execute-single-tool tool-calls)) + (def (execute-single-tool tc) + (let* ([name (tool-call-name tc)] + [args (string->json-object (tool-call-arguments tc))] + [result (tool-execute name args)]) + (log-debug + logger + "tool-result" + `((tool . ,name) (result-length . ,(string-length result)))) + (make-tool-result (tool-call-id tc) result))) + (def (get-current-provider) + (let* ([provider-name (or (current-provider-override) + (config-provider))] + [api-key (config-get-provider-key provider-name)] + [model (or (current-model-override) (config-model))]) + (make-provider provider-name api-key model))) + (def (agent-chat user-input) + (let* ([provider (get-current-provider)] + [tools (get-tool-schemas)] + [messages (list + (make-system-message (system-prompt)) + (make-user-message user-input))]) + (agent-chat-loop provider messages tools))) + (def (agent-chat-loop provider messages tools) + (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-step messages) + (let* ([provider (get-current-provider)] + [tools (get-tool-schemas)]) + (provider-chat provider messages tools)))) new file mode 100644 --- /dev/null +++ b/lib/jcode/core/config.sls @@ -0,0 +1,72 @@ +#!chezscheme +;;; Generated by jerbuild — DO NOT EDIT +;;; Source: src/jcode/core/config.ss + +(library (jcode core config) + (export load-config config-ref config-api-key config-model + config-provider config-get-provider-key *config*) + (import + (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)) + (define *config*--cell (vector (make-parameter #f))) + (def (config-paths) + (list + (path-join (current-directory) "jcode.json") + (path-join + (or (getenv "XDG_CONFIG_HOME") + (path-join (getenv "HOME") ".config")) + "jcode" + "config.json") + (path-join (getenv "HOME") ".jcode.json"))) + (def (find-config-file) + (let loop ([paths (config-paths)]) + (cond + [(null? paths) #f] + [(file-exists? (car paths)) (car paths)] + [else (loop (cdr paths))]))) + (def (load-config) + (let* ([file (find-config-file)] + [file-config (if file + (call-with-input-file file read-json) + (make-hash-table))] + [config (merge-env-config file-config)]) + (*config* config) + config)) + (def (merge-env-config config) + (let ([providers (or (hash-get config "providers") + (make-hash-table))]) + (for-each + (lambda (pair) + (let ([key (getenv (car pair))]) + (when key + (let ([p (or (hash-get providers (cdr pair)) + (make-hash-table))]) + (hash-put! p "api_key" key) + (hash-put! providers (cdr pair) p))))) + '(("OPENAI_API_KEY" . "openai") + ("ANTHROPIC_API_KEY" . "anthropic") + ("GOOGLE_API_KEY" . "google") + ("OPENROUTER_API_KEY" . "openrouter"))) + (hash-put! config "providers" providers) + config)) + (def (config-ref . keys) + (let loop ([obj (*config*)] [keys keys]) + (cond + [(null? keys) obj] + [(not (hash-table? obj)) #f] + [else (loop (hash-get obj (car keys)) (cdr keys))]))) + (def (config-get-provider-key provider) + (config-ref "providers" provider "api_key")) + (def (config-model) + (or (config-ref "model") "claude-sonnet-4-20250514")) + (def (config-provider) + (or (config-ref "provider") "anthropic")) + (def (config-api-key) + (config-get-provider-key (config-provider))) + (define-syntax *config* + (identifier-syntax + [id (vector-ref *config*--cell 0)] + [(set! id val) (vector-set! *config*--cell 0 val)]))) new file mode 100644 --- /dev/null +++ b/lib/jcode/core/log.sls @@ -0,0 +1,51 @@ +#!chezscheme +;;; Generated by jerbuild — DO NOT EDIT +;;; Source: src/jcode/core/log.ss + +(library (jcode core log) + (export make-logger current-log-level log-debug log-info + log-warn log-error err->string) + (import + (except (chezscheme) make-hash-table hash-table? iota \x31;+ \x31;- + getenv path-extension path-absolute? thread? make-mutex + mutex? mutex-name) + (std misc string) + (jerboa core) + (jerboa runtime)) + (def *log-level* (make-parameter 'info)) + (def (current-log-level . args) + (if (null? args) (*log-level*) (*log-level* (car args)))) + (def (err->string e) + (with-output-to-string (lambda () (display-condition e)))) + (def (log-at level label name msg data) + (when (level-enabled? level (*log-level*)) + (let ([line (format "[~a] ~a: ~a" label name msg)]) + (if (null? data) + (fprintf (current-error-port) "~a~n" line) + (fprintf + (current-error-port) + "~a ~a~n" + line + (format-alist data)))))) + (def (level-enabled? level min-level) + (case level + [(0) (eq? min-level 'debug)] + [(1) (memq min-level '(debug info))] + [(2) (memq min-level '(debug info warn))] + [(3) #t] + [else #t])) + (def (format-alist pairs) + (string-join + (map (lambda (p) (format "~a=~a" (car p) (cdr p))) pairs) + " ")) + (def (make-logger name) name) + (def (log-debug name msg . rest) + (log-at 0 "DEBUG" name msg + (if (null? rest) '() (car rest)))) + (def (log-info name msg . rest) + (log-at 1 "INFO" name msg (if (null? rest) '() (car rest)))) + (def (log-warn name msg . rest) + (log-at 2 "WARN" name msg (if (null? rest) '() (car rest)))) + (def (log-error name msg . rest) + (log-at 3 "ERROR" name msg + (if (null? rest) '() (car rest))))) new file mode 100644 --- /dev/null +++ b/lib/jcode/core/message.sls @@ -0,0 +1,86 @@ +#!chezscheme +;;; Generated by jerbuild — DO NOT EDIT +;;; Source: src/jcode/core/message.ss + +(library (jcode core message) + (export make-message message? make-user-message + make-assistant-message make-tool-call restore-tool-call + make-tool-result make-system-message message-role + message-content message-tool-calls message-tool-call-id + message->json json->message tool-call-id tool-call-name + tool-call-arguments tool-call?) + (import + (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 uuid) (jerboa core) + (jerboa runtime)) + (defstruct message (role content tool-calls tool-call-id)) + (defstruct tool-call-data (id name arguments)) + (def (tool-call? x) (tool-call-data? x)) + (def (tool-call-id tc) (tool-call-data-id tc)) + (def (tool-call-name tc) (tool-call-data-name tc)) + (def (tool-call-arguments tc) (tool-call-data-arguments tc)) + (def (make-tool-call name arguments) + (make-tool-call-data (uuid-string) name arguments)) + (def (restore-tool-call id name arguments) + (make-tool-call-data id name arguments)) + (def (make-user-message content) + (make-message "user" content #f #f)) + (def (make-assistant-message content . tool-calls) + (make-message + "assistant" + content + (if (null? tool-calls) #f (car tool-calls)) + #f)) + (def (make-tool-result call-id content) + (make-message "tool" content #f call-id)) + (def (make-system-message content) + (make-message "system" content #f #f)) + (def (json-null->false v) (if (eq? v (void)) #f v)) + (def (message->json msg) + (let ([ht (make-hash-table)]) + (hash-put! ht "role" (message-role msg)) + (when (message-content msg) + (hash-put! ht "content" (message-content msg))) + (when (message-tool-calls msg) + (hash-put! + ht + "tool_calls" + (map tool-call->json (message-tool-calls msg)))) + (when (message-tool-call-id msg) + (hash-put! ht "tool_call_id" (message-tool-call-id msg))) + ht)) + (def (tool-call->json tc) + (let ([ht (make-hash-table)] [fn (make-hash-table)]) + (hash-put! ht "id" (tool-call-id tc)) + (hash-put! ht "type" "function") + (hash-put! fn "name" (tool-call-name tc)) + (hash-put! + fn + "arguments" + (if (string? (tool-call-arguments tc)) + (tool-call-arguments tc) + (json-object->string (tool-call-arguments tc)))) + (hash-put! ht "function" fn) + ht)) + (def (json->message json) + (let ([role (hash-ref json "role" "assistant")] + [content (json-null->false (hash-ref json "content" #f))] + [tool-calls-json (json-null->false + (hash-ref json "tool_calls" #f))] + [tc-id (json-null->false + (hash-ref json "tool_call_id" #f))]) + (make-message + role + content + (and tool-calls-json + (pair? tool-calls-json) + (map json->tool-call tool-calls-json)) + tc-id))) + (def (json->tool-call json) + (let ([fn (hash-ref json "function" #f)]) + (restore-tool-call + (hash-ref json "id" "") + (hash-ref fn "name" "") + (hash-ref fn "arguments" "{}"))))) new file mode 100644 --- /dev/null +++ b/lib/jcode/core/session.sls @@ -0,0 +1,153 @@ +#!chezscheme +;;; Generated by jerbuild — DO NOT EDIT +;;; Source: src/jcode/core/session.ss + +(library (jcode core session) + (export session-init-db session-create session-load session-list + session-add-message session-get-messages + session-update-title session-delete session-id session-title + session-created session-messages) + (import + (except (chezscheme) make-hash-table hash-table? iota \x31;+ \x31;- + getenv path-extension path-absolute? thread? make-mutex + mutex? mutex-name) + (std db sqlite) (std misc uuid) (std os path) + (std text json) (jcode core message) (jerboa core) + (jerboa runtime)) + (defstruct session (id title created messages)) + (def (db-path) + (let* ([data-dir (or (getenv "XDG_DATA_HOME") + (path-join (getenv "HOME") ".local" "share"))] + [dir (path-join data-dir "jcode")]) + (unless (file-exists? dir) (mkdir dir)) + (path-join dir "sessions.db"))) + (def (open-db) (sqlite-open (db-path))) + (def (session-init-db) + (let ([db (open-db)]) + (sqlite-exec + db + "CREATE TABLE IF NOT EXISTS sessions (\n id TEXT PRIMARY KEY,\n title TEXT NOT NULL,\n created_at TEXT NOT NULL,\n updated_at TEXT NOT NULL\n )") + (sqlite-exec + db + "CREATE TABLE IF NOT EXISTS messages (\n id INTEGER PRIMARY KEY AUTOINCREMENT,\n session_id TEXT NOT NULL,\n role TEXT NOT NULL,\n content TEXT,\n tool_calls TEXT,\n tool_call_id TEXT,\n created_at TEXT NOT NULL,\n FOREIGN KEY (session_id) REFERENCES sessions(id)\n )") + (sqlite-exec + db + "CREATE INDEX IF NOT EXISTS idx_messages_session ON messages(session_id)") + (sqlite-close db))) + (def (session-create title) + (let* ([db (open-db)] + [id (uuid-string)] + [now (timestamp-now)]) + (sqlite-eval db + "INSERT INTO sessions (id, title, created_at, updated_at) VALUES (?, ?, ?, ?)" + id title now now) + (sqlite-close db) + (make-session id title now '()))) + (def (session-load id) + (let* ([db (open-db)] + [rows (sqlite-query + db + "SELECT id, title, created_at FROM sessions WHERE id = ?" + id)]) + (if (null? rows) + (begin (sqlite-close db) #f) + (let* ([row (car rows)] [messages (load-messages db id)]) + (sqlite-close db) + (make-session + (vector-ref row 0) + (vector-ref row 1) + (vector-ref row 2) + messages))))) + (def (load-messages db session-id) + (let ([rows (sqlite-query + db + "SELECT role, content, tool_calls, tool_call_id\n FROM messages WHERE session_id = ?\n ORDER BY id ASC" + session-id)]) + (map row->message rows))) + (def (row->message row) + (let ([role (vector-ref row 0)] + [content (vector-ref row 1)] + [tool-calls-json (vector-ref row 2)] + [tc-id (vector-ref row 3)]) + (make-message + role + content + (and tool-calls-json + (not (equal? tool-calls-json "")) + (let ([parsed (string->json-object tool-calls-json)]) + (if (pair? parsed) + (map json->stored-tool-call parsed) + '()))) + tc-id))) + (def (session-list) + (let* ([db (open-db)] + [rows (sqlite-query + db + "SELECT id, title, created_at FROM sessions\n ORDER BY updated_at DESC")]) + (sqlite-close db) + (map (lambda (row) + (make-session + (vector-ref row 0) + (vector-ref row 1) + (vector-ref row 2) + '())) + rows))) + (def (session-add-message session-id msg) + (let* ([db (open-db)] + [now (timestamp-now)] + [tool-calls-json (and (message-tool-calls msg) + (json-object->string + (map tool-call->stored-json + (message-tool-calls msg))))]) + (sqlite-eval db + "INSERT INTO messages (session_id, role, content, tool_calls, tool_call_id, created_at)\n VALUES (?, ?, ?, ?, ?, ?)" + session-id (message-role msg) + (let ([c (message-content msg)]) (if (eq? c (void)) #f c)) + tool-calls-json + (let ([id (message-tool-call-id msg)]) + (if (eq? id (void)) #f id)) + now) + (sqlite-eval + db + "UPDATE sessions SET updated_at = ? WHERE id = ?" + now + session-id) + (sqlite-close db))) + (def (session-get-messages session-id) + (let* ([db (open-db)] + [messages (load-messages db session-id)]) + (sqlite-close db) + messages)) + (def (session-update-title session-id title) + (let ([db (open-db)]) + (sqlite-eval db + "UPDATE sessions SET title = ?, updated_at = ? WHERE id = ?" + title (timestamp-now) session-id) + (sqlite-close db))) + (def (session-delete session-id) + (let ([db (open-db)]) + (sqlite-eval + db + "DELETE FROM messages WHERE session_id = ?" + session-id) + (sqlite-eval + db + "DELETE FROM sessions WHERE id = ?" + session-id) + (sqlite-close db))) + (def (timestamp-now) + (let ([d (current-date)]) + (format "~a-~2,'0d-~2,'0dT~2,'0d:~2,'0d:~2,'0d" (date-year d) + (date-month d) (date-day d) (date-hour d) (date-minute d) + (date-second d)))) + (def (tool-call->stored-json tc) + (let ([ht (make-hash-table)]) + (hash-put! ht "id" (tool-call-id tc)) + (hash-put! ht "name" (tool-call-name tc)) + (hash-put! ht "arguments" (tool-call-arguments tc)) + ht)) + (def (json->stored-tool-call json) + (restore-tool-call + (hash-ref json "id" (uuid-string)) + (hash-ref json "name" "") + (hash-ref json "arguments" "{}")))) new file mode 100644 --- /dev/null +++ b/lib/jcode/provider/provider.sls @@ -0,0 +1,261 @@ +#!chezscheme +;;; Generated by jerbuild — DO NOT EDIT +;;; Source: src/jcode/provider/provider.ss + +(library (jcode provider provider) + (export make-provider provider-chat provider-stream + provider-name provider-model) + (import + (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 shell) (jcode core log) + (jcode core message) (jerboa core) (jerboa runtime)) + (def logger (make-logger "provider")) + (defstruct provider-record (name api-key model base-url)) + (def (provider? x) (provider-record? x)) + (def (provider-name p) (provider-record-name p)) + (def (provider-api-key p) (provider-record-api-key p)) + (def (provider-model p) (provider-record-model p)) + (def (provider-base-url p) (provider-record-base-url p)) + (def make-provider + (case-lambda + [(name api-key model) + (make-provider-record + name + api-key + model + (provider-default-url name))] + [(name api-key model base-url) + (make-provider-record name api-key model base-url)])) + (def (provider-default-url name) + (case (string->symbol name) + [(openai) "https://api.openai.com/v1"] + [(anthropic) "https://api.anthropic.com/v1"] + [(google) + "https://generativelanguage.googleapis.com/v1beta"] + [(openrouter) "https://openrouter.ai/api/v1"] + [(deepseek) "https://api.deepseek.com/v1"] + [(ollama) "http://localhost:11434/api"] + [else + (error 'provider-default-url "Unknown provider" name)])) + (def (provider-chat provider messages tools) + (log-info + logger + "chat" + `((provider . ,(provider-name provider)) + (model . ,(provider-model provider)) + (messages . ,(length messages)))) + (case (string->symbol (provider-name provider)) + [(openai openrouter deepseek) + (openai-chat provider messages tools)] + [(anthropic) (anthropic-chat provider messages tools)] + [(google) (google-chat provider messages tools)] + [(ollama) (ollama-chat provider messages tools)] + [else + (error 'provider-chat + "Unknown provider" + (provider-name provider))])) + (def (provider-stream provider messages tools callback) + (let ([response (provider-chat provider messages tools)]) + (callback response) + response)) + (def (curl-post url headers body-json) + (let* ([header-args (apply + string-append + (map (lambda (h) + (string-append + " -H " + (shell-quote + (string-append + (car h) + ": " + (cdr h))))) + headers))] + [cmd (string-append "curl -s -w '\\n__STATUS__%{http_code}' -X POST " + (shell-quote url) header-args " -d " + (shell-quote body-json))]) + (let-values ([(out err code) (shell/status cmd #f)]) + (if (not (= code 0)) + (error 'curl-post + (format "curl failed (exit ~a): ~a" code err)) + (let* ([marker "__STATUS__"] + [marker-pos (let loop ([i (- (string-length out) + (string-length marker) + 3)]) + (cond + [(< i 0) #f] + [(string=? + (substring + out + i + (+ i (string-length marker))) + marker) + i] + [else (loop (- i 1))]))] + [body (if marker-pos + (substring + out + 0 + (if (and (> marker-pos 0) + (char=? + (string-ref + out + (- marker-pos 1)) + #\newline)) + (- marker-pos 1) + marker-pos)) + out)] + [status (if marker-pos + (string->number + (substring + out + (+ marker-pos (string-length marker)) + (string-length out))) + 0)]) + (values status body)))))) + (def (openai-chat provider messages tools) + (let* ([url (string-append + (provider-base-url provider) + "/chat/completions")] + [headers (openai-headers provider)] + [body (openai-body provider messages tools)]) + (let-values ([(status text) + (curl-post url headers (json-object->string body))]) + (if (= status 200) + (openai-parse-response (string->json-object text)) + (error 'openai-chat + (format "API error ~a: ~a" status text)))))) + (def (openai-headers provider) + `(("Content-Type" . "application/json") + ("Authorization" + . + ,(string-append "Bearer " (provider-api-key provider))))) + (def (openai-body provider messages tools) + (let ([body (make-hash-table)]) + (hash-put! body "model" (provider-model provider)) + (hash-put! body "messages" (map message->json messages)) + (when (and tools (not (null? tools))) + (hash-put! body "tools" tools)) + body)) + (def (openai-parse-response json) + (let* ([choices (hash-ref json "choices" '())] + [choice (if (null? choices) #f (car choices))] + [msg (and choice (hash-get choice "message"))]) + (if msg + (json->message msg) + (error 'openai-parse-response "No message in response")))) + (def (anthropic-chat provider messages tools) + (let* ([url (string-append + (provider-base-url provider) + "/messages")] + [headers (anthropic-headers provider)] + [body (anthropic-body provider messages tools)]) + (let-values ([(status text) + (curl-post url headers (json-object->string body))]) + (if (= status 200) + (anthropic-parse-response (string->json-object text)) + (error 'anthropic-chat + (format "API error ~a: ~a" status text)))))) + (def (anthropic-headers provider) + `(("Content-Type" . "application/json") + ("x-api-key" . ,(provider-api-key provider)) + ("anthropic-version" . "2023-06-01"))) + (def (anthropic-body provider messages tools) + (let ([body (make-hash-table)] + [system-msg (find-system-message messages)] + [other-msgs (remove-system-messages messages)]) + (hash-put! body "model" (provider-model provider)) + (hash-put! body "max_tokens" 8192) + (when system-msg + (hash-put! body "system" (message-content system-msg))) + (hash-put! + body + "messages" + (map anthropic-convert-message other-msgs)) + (when (and tools (not (null? tools))) + (hash-put! body "tools" (map anthropic-convert-tool tools))) + body)) + (def (find-system-message messages) + (find + (lambda (m) (equal? (message-role m) "system")) + messages)) + (def (remove-system-messages messages) + (filter + (lambda (m) (not (equal? (message-role m) "system"))) + messages)) + (def (anthropic-convert-message msg) + (let ([ht (make-hash-table)]) + (hash-put! + ht + "role" + (if (equal? (message-role msg) "tool") + "user" + (message-role msg))) + (cond + [(message-tool-call-id msg) + (hash-put! + ht + "content" + (list + (let ([r (make-hash-table)]) + (hash-put! r "type" "tool_result") + (hash-put! r "tool_use_id" (message-tool-call-id msg)) + (hash-put! r "content" (message-content msg)) + r)))] + [(message-tool-calls msg) + (hash-put! + ht + "content" + (map (lambda (tc) + (let ([t (make-hash-table)]) + (hash-put! t "type" "tool_use") + (hash-put! t "id" (tool-call-id tc)) + (hash-put! t "name" (tool-call-name tc)) + (hash-put! + t + "input" + (string->json-object (tool-call-arguments tc))) + t)) + (message-tool-calls msg)))] + [else (hash-put! ht "content" (message-content msg))]) + ht)) + (def (anthropic-convert-tool tool) + (let ([ht (make-hash-table)]) + (hash-put! ht "name" (hash-ref tool "name" "")) + (hash-put! + ht + "description" + (hash-ref tool "description" "")) + (hash-put! + ht + "input_schema" + (hash-ref tool "parameters" (make-hash-table))) + ht)) + (def (anthropic-parse-response json) + (let* ([content (hash-ref json "content" '())] + [tool-uses (filter + (lambda (c) + (equal? (hash-ref c "type" "") "tool_use")) + content)] + [text-parts (filter + (lambda (c) + (equal? (hash-ref c "type" "") "text")) + content)] + [text (if (null? text-parts) + #f + (hash-ref (car text-parts) "text" ""))]) + (if (null? tool-uses) + (make-assistant-message text) + (make-assistant-message + text + (map (lambda (tu) + (restore-tool-call + (hash-ref tu "id" "") + (hash-ref tu "name" "") + (json-object->string (hash-ref tu "input" #f)))) + tool-uses))))) + (def (google-chat provider messages tools) + (error 'google-chat "Google provider not yet implemented")) + (def (ollama-chat provider messages tools) + (error 'ollama-chat "Ollama provider not yet implemented"))) new file mode 100644 --- /dev/null +++ b/lib/jcode/tool/bash.sls @@ -0,0 +1,76 @@ +#!chezscheme +;;; Generated by jerbuild — DO NOT EDIT +;;; Source: src/jcode/tool/bash.ss + +(library (jcode tool bash) + (export init-bash-tool) + (import + (except (chezscheme) make-hash-table hash-table? iota \x31;+ \x31;- + getenv path-extension path-absolute? thread? make-mutex + mutex? mutex-name) + (std os shell) (std misc string) (jcode core log) + (jcode tool registry) (jerboa core) (jerboa runtime)) + (def logger (make-logger "tool.bash")) + (def (init-bash-tool) + (register-tool! + "bash" + "Execute a shell command. Returns stdout, stderr, and exit code." + (make-bash-schema) + handle-bash)) + (def (make-bash-schema) + (let ([schema (make-hash-table)] + [props (make-hash-table)] + [cmd-prop (make-hash-table)] + [timeout-prop (make-hash-table)] + [cwd-prop (make-hash-table)]) + (hash-put! cmd-prop "type" "string") + (hash-put! + cmd-prop + "description" + "Shell command to execute") + (hash-put! timeout-prop "type" "number") + (hash-put! + timeout-prop + "description" + "Timeout in seconds (default: 120)") + (hash-put! cwd-prop "type" "string") + (hash-put! + cwd-prop + "description" + "Working directory (default: current directory)") + (hash-put! props "command" cmd-prop) + (hash-put! props "timeout" timeout-prop) + (hash-put! props "cwd" cwd-prop) + (hash-put! schema "type" "object") + (hash-put! schema "properties" props) + (hash-put! schema "required" '("command")) + schema)) + (def (handle-bash args) + (let ([command (hash-ref args "command" #f)] + [timeout (hash-ref args "timeout" 120)] + [cwd (let ([c (hash-ref args "cwd" #f)]) + (if (eq? c (void)) #f c))]) + (unless command + (error 'bash "Missing required parameter: command")) + (log-info + logger + "execute" + `((command . ,command) (timeout . ,timeout))) + (run-bash-command command timeout cwd))) + (def (run-bash-command command timeout cwd) + (try (let-values ([(stdout stderr exit-code) + (shell/status command cwd)]) + (format-result stdout stderr exit-code)) + (catch (e) (format "Error: ~a" (err->string e))))) + (def (format-result stdout stderr exit-code) + (let ([parts '()]) + (when (and stdout (not (string=? stdout ""))) + (set! parts (cons stdout parts))) + (when (and stderr (not (string=? stderr ""))) + (set! parts (cons (string-append "STDERR: " stderr) parts))) + (when (not (= exit-code 0)) + (set! parts + (cons (format "Exit code: ~a" exit-code) parts))) + (if (null? parts) + "(no output)" + (string-join (reverse parts) "\n"))))) new file mode 100644 --- /dev/null +++ b/lib/jcode/tool/file.sls @@ -0,0 +1,245 @@ +#!chezscheme +;;; Generated by jerbuild — DO NOT EDIT +;;; Source: src/jcode/tool/file.ss + +(library (jcode tool file) + (export init-file-tools) + (import + (except (chezscheme) make-hash-table hash-table? iota \x31;+ \x31;- + getenv path-extension path-absolute? thread? make-mutex + mutex? mutex-name with-input-from-string + with-output-to-string) + (std text glob) (std pregexp) (std os path) (std misc ports) + (std misc string) (jcode core log) (jcode tool registry) + (jerboa core) (jerboa runtime)) + (def logger (make-logger "tool.file")) + (def (init-file-tools) + (register-tool! + "read" + "Read the contents of a file. Returns the file contents as a string." + (make-schema + '(("path" + "string" + "Absolute or relative path to the file to read" + #t))) + handle-read) + (register-tool! + "write" + "Write content to a file. Creates the file if it doesn't exist, overwrites if it does." + (make-schema + '(("path" + "string" + "Absolute or relative path to the file to write" + #t) + ("content" "string" "Content to write to the file" #t))) + handle-write) + (register-tool! + "edit" + "Edit a file by replacing exact string matches. The old_str must match exactly." + (make-schema + '(("path" "string" "Path to the file to edit" #t) + ("old_str" "string" "Exact string to find and replace" #t) + ("new_str" "string" "String to replace old_str with" #t))) + handle-edit) + (register-tool! + "glob" + "Find files matching a glob pattern. Returns a list of matching file paths." + (make-schema + '(("pattern" + "string" + "Glob pattern (e.g., **/*.ss, src/*.txt)" + #t) + ("path" + "string" + "Base directory to search in (default: current directory)" + #f))) + handle-glob) + (register-tool! + "grep" + "Search for a pattern in files. Returns matching lines with file names and line numbers." + (make-schema + '(("pattern" + "string" + "Regular expression pattern to search for" + #t) + ("path" "string" "File or directory to search in" #t) + ("glob" + "string" + "Glob pattern to filter files (e.g., *.ss)" + #f))) + handle-grep)) + (def (handle-read args) + (let ([path (hash-ref args "path" #f)]) + (unless path + (error 'read "Missing required parameter: path")) + (log-debug logger "read" `((path . ,path))) + (if (file-exists? path) + (read-file-string path) + (format "Error: File not found: ~a" path)))) + (def (handle-write args) + (let ([path (hash-ref args "path" #f)] + [content (hash-ref args "content" #f)]) + (unless path + (error 'write "Missing required parameter: path")) + (unless content + (error 'write "Missing required parameter: content")) + (log-debug + logger + "write" + `((path . ,path) (length . ,(string-length content)))) + (let ([dir (path-directory path)]) + (when (and dir + (not (equal? dir "")) + (not (file-exists? dir))) + (mkdir-p dir))) + (write-file-string path content) + (format + "Successfully wrote ~a bytes to ~a" + (string-length content) + path))) + (def (handle-edit args) + (let ([path (hash-ref args "path" #f)] + [old-str (hash-ref args "old_str" #f)] + [new-str (hash-ref args "new_str" "")]) + (unless path + (error 'edit "Missing required parameter: path")) + (unless old-str + (error 'edit "Missing required parameter: old_str")) + (log-debug logger "edit" `((path . ,path))) + (if (file-exists? path) + (let* ([content (read-file-string path)] + [new-content (string-replace-first + content + old-str + new-str)]) + (if (equal? content new-content) + (format "Error: old_str not found in ~a" path) + (begin + (write-file-string path new-content) + (format "Successfully edited ~a" path)))) + (format "Error: File not found: ~a" path)))) + (def (string-replace-first str old new) + (let ([idx (find-substring str old)]) + (if idx + (string-append + (substring str 0 idx) + new + (substring + str + (+ idx (string-length old)) + (string-length str))) + str))) + (def (find-substring str sub) + (let ([str-len (string-length str)] + [sub-len (string-length sub)]) + (let loop ([i 0]) + (cond + [(> (+ i sub-len) str-len) #f]