Improve local verified ds4 workflows
ober
1f5cce78ed6b862e3e16282df9e6d4be4907bd64
--- a/docs/cli.md +++ b/docs/cli.md @@ -35,6 +35,9 @@ Parsed before any subcommand. | Variable | Effect | |---|---| | `JCODE_CONTEXT_WINDOW` | Overrides model context-window metadata for the current process. Useful when a configured MLX provider points at a remote host with more KV-cache headroom than the local default. | +| `JCODE_MAX_TOKENS` | Overrides the OpenAI-compatible `max_tokens` request cap for the current process. Useful for bounding local model repair turns. | +| `JCODE_READ_ROOTS` | Colon-separated extra read-only roots for verified runs. File tools can inspect those roots, while edits remain limited by write scope. | +| `JCODE_VERIFIED_COMPACT` | When truthy, verified runs expose a smaller MCP tool menu and prompt local-style agents to write an initial complete version earlier, then repair from verifier output. | ## Subcommands --- a/docs/providers.md +++ b/docs/providers.md @@ -212,9 +212,15 @@ a model is unknown and the provider is **MLX**, a safe fallback applies: temperature 0.6 top_p 0.95 top_k 20 repetition_penalty 1.1 ``` -Request-body token caps: OpenAI-style requests default to `max_tokens 32768`, -Anthropic to `max_tokens 8192`. The full mechanism and the card-row provenance -live in [FORGE.md](FORGE.md#the-guardrails) and `provider/sampling.ss`. +Request-body token caps: OpenAI-style cloud requests default to +`max_tokens 32768`, local OpenAI-compatible providers such as `mlx`/`ollama` +default to `max_tokens 8192`, and Anthropic defaults to `max_tokens 8192`. +Override OpenAI-style caps with `JCODE_MAX_TOKENS`, provider config +`providers.NAME.max_tokens`, or global config `max_tokens`. Provider config can +also pass `reasoning_effort` and `verbosity` through to OpenAI-compatible +servers that support those fields. The full mechanism and the card-row +provenance live in [FORGE.md](FORGE.md#the-guardrails) and +`provider/sampling.ss`. ## Hardware tiers --- a/src/jcode/core/verified-run.ss +++ b/src/jcode/core/verified-run.ss @@ -588,9 +588,29 @@ "jerboa_run_tests" "jerboa_eval")) +(def *verified-compact-mcp-name-fragments* + '("jerboa_howto_get" + "jerboa_howto" + "jerboa_check_syntax" + "jerboa_compile_check" + "jerboa_failure_advisor" + "jerboa_error_fix_lookup")) + (def (verified-muted-mcp-tool? name) (string-has-any? name *verified-muted-mcp-name-fragments*)) +(def (verified-compact-mcp-tool? tool-def) + (string-has-any? (tool-def-name tool-def) + *verified-compact-mcp-name-fragments*)) + +(def (env-truthy? name) + (let ((v (getenv name))) + (and v + (not (string=? v "")) + (not (string=? (string-downcase v) "0")) + (not (string=? (string-downcase v) "false")) + (not (string=? (string-downcase v) "no"))))) + (def (schema-function schema) (and (hash-table? schema) (hash-get schema "function"))) @@ -703,6 +723,17 @@ path (string-append cwd "/" path))) +(def (expand-home-path path) + (cond + ((not (string? path)) path) + ((string=? path "~") (or (getenv "HOME") path)) + ((string-prefix? "~/" path) + (let ((home (getenv "HOME"))) + (if home + (string-append home (substring path 1 (string-length path))) + path))) + (else path))) + (def current-pending-ss-create-repair (make-parameter #f)) @@ -1377,14 +1408,56 @@ (string=? rel "..") (string-prefix? "../" rel)))) +(def (split-read-roots raw) + (if (and raw (not (string=? raw ""))) + (filter (lambda (s) (not (string=? s ""))) + (map string-trim (string-split raw #\:))) + '())) + +(def (verified-read-roots cwd) + (map (lambda (root) (abs-path cwd (expand-home-path root))) + (split-read-roots (getenv "JCODE_READ_ROOTS")))) + +(def (path-under-root? path root) + (let ((root-comps (path-components root)) + (path-comps (path-components path))) + (components-prefix? root-comps path-comps))) + +(def (read-root-allowed? cwd path) + (let ((absolute (abs-path cwd path))) + (let loop ((roots (verified-read-roots cwd))) + (cond + ((null? roots) #f) + ((path-under-root? absolute (car roots)) #t) + (else (loop (cdr roots))))))) + +(def (read-roots-label cwd) + (let ((roots (verified-read-roots cwd))) + (and (pair? roots) (string-join roots ", ")))) + (def (read-scope-message cwd tool path) (let ((rel (scope-path cwd path))) (and (outside-scope-path? rel) + (not (read-root-allowed? cwd path)) (string-append tool " refused outside the verified working directory: " path - ". Use read/list only for files under the current repo. If caller guidance permits external discovery, use MCP tools such as module_exports, apropos, howto, or cookbook_task_bundle for external Jerboa APIs; otherwise stay inside the current repo.")))) + ". Use read/list only for files under the current repo" + (let ((roots (read-roots-label cwd))) + (if roots + (string-append " or under JCODE_READ_ROOTS (" roots ")") + "")) + ". If caller guidance permits external discovery, use MCP tools such as module_exports, apropos, howto, or cookbook_task_bundle for external Jerboa APIs; otherwise stay inside the current repo.")))) + +(def (read-roots-instruction cwd) + (let ((roots (read-roots-label cwd))) + (if roots + (string-append + "Read-only external roots allowed by JCODE_READ_ROOTS: " + roots + ". File tools may inspect those paths, but edit/write/line_edit/replace_def/replace_range remain limited by write scope.\n") + ""))) (def (absolute-components->path comps) (string-append "/" (string-join comps "/"))) @@ -1433,10 +1506,13 @@ (let ((len (length xs))) (drop-up-to xs (max 0 (- len n))))) +(def default-read-start-limit 120) + (def (slice-content content args) (let* ((line-no (arg-int args "line" 0)) (start-line (arg-int args "start" 0)) (end-line (arg-int args "end" 0)) + (raw-limit (arg-int args "limit" 0)) (range-start (cond ((> start-line 0) start-line) ((> line-no 0) line-no) @@ -1447,8 +1523,10 @@ (limit (cond ((and (> range-start 0) (>= end-line range-start)) (+ (- end-line range-start) 1)) - ((> range-start 0) 1) - (else (arg-int args "limit" 0))))) + ((> raw-limit 0) raw-limit) + ((> start-line 0) default-read-start-limit) + ((> line-no 0) 1) + (else 0)))) (if (and (= offset 0) (<= limit 0)) content (let* ((lines (string-split content #\newline)) @@ -3291,9 +3369,18 @@ (if p (cdr p) #f))) (external-tools? (let ((p (assoc 'external-tools? o))) (if p (cdr p) #t))) + (compact? (or (let ((p (assoc 'compact? o))) + (and p (cdr p))) + (env-truthy? "JCODE_VERIFIED_COMPACT"))) (terminal-on-verify? (and (opt-get o 'terminal-on-verify) #t)) (task-guidance (opt-get o 'task-guidance)) - (external-tool-defs (if external-tools? (workflow-mcp-tool-defs cwd) '()))) + (external-tool-defs + (if external-tools? + (let ((defs (workflow-mcp-tool-defs cwd))) + (if compact? + (filter verified-compact-mcp-tool? defs) + defs)) + '()))) (let ((read-def (make-tool-def (make-tool-spec "read" @@ -3496,6 +3583,10 @@ "") ", edit(path,content=FULL new file OR old_str/new_str exact replacement), write(path,content) alias for edit, line_edit(path,line,content), replace_def(path,name,content), replace_range(path,start,end,content), verify(), done(summary).\n" "Path aliases accepted by file tools: file, filename, file_path, filepath, target, target_path.\n" + (read-roots-instruction cwd) + (if compact? + "Compact verified mode: inspect only the few files needed to remove uncertainty, then write a complete first version and call verify. Before the first write, prefer read/list on the current repo or JCODE_READ_ROOTS over broad MCP/API discovery. After verify fails, repair the concrete verifier error with the smallest edit and verify again.\n" + "") (if run-aliases? "run/bash/shell are narrow inspection aliases only; use verify for the configured build/test command.\n" "run/bash/shell are not available in this workflow. Use verify for the configured build/test command.\n") --- a/src/jcode/provider/provider.ss +++ b/src/jcode/provider/provider.ss @@ -837,6 +837,38 @@ (unless (skip-logprobs? provider tools) (apply-logprobs! body))) +(def *openai-default-max-tokens* 32768) +(def *openai-local-default-max-tokens* 8192) + +(def (positive-int-value v) + (cond + ((and (integer? v) (> v 0)) v) + ((and (number? v) (> v 0)) (inexact->exact (floor v))) + ((string? v) (positive-int-value (string->number v))) + (else #f))) + +(def (openai-max-tokens provider) + (or (positive-int-value (getenv "JCODE_MAX_TOKENS")) + (positive-int-value + (config-ref "providers" (provider-name provider) "max_tokens")) + (positive-int-value + (config-ref "providers" (provider-name provider) "max_completion_tokens")) + (positive-int-value (config-ref "max_tokens")) + (positive-int-value (config-ref "max_completion_tokens")) + (if (local-provider? (provider-name provider)) + *openai-local-default-max-tokens* + *openai-default-max-tokens*))) + +(def *openai-provider-request-fields* + '("reasoning_effort" "verbosity")) + +(def (apply-openai-provider-overrides! body provider) + (for-each + (lambda (field) + (let ((v (config-ref "providers" (provider-name provider) field))) + (when v (hash-put! body field v)))) + *openai-provider-request-fields*)) + (def (mean-of lst) (and (pair? lst) (/ (apply + lst) (length lst) 1.0))) @@ -1061,8 +1093,9 @@ (def (openai-body provider messages tools) (let ((body (make-hash-table))) (hash-put! body "model" (provider-model provider)) - (hash-put! body "max_tokens" 32768) + (hash-put! body "max_tokens" (openai-max-tokens provider)) (apply-sampling-to-body! body (provider-model provider) (provider-name provider)) + (apply-openai-provider-overrides! body provider) (maybe-apply-logprobs! body provider tools) (apply-prompt-cache-controls! body provider) (hash-put! body "messages" (map message->json messages)) @@ -1756,8 +1789,9 @@ (let ((body (make-hash-table))) (hash-put! body "model" (provider-model provider)) (hash-put! body "stream" #t) - (hash-put! body "max_tokens" 32768) + (hash-put! body "max_tokens" (openai-max-tokens provider)) (apply-sampling-to-body! body (provider-model provider) (provider-name provider)) + (apply-openai-provider-overrides! body provider) (maybe-apply-logprobs! body provider tools) (apply-prompt-cache-controls! body provider) ;; Request usage data in stream --- a/test/run.ss +++ b/test/run.ss @@ -2169,25 +2169,72 @@ (str-contains? s "auto-converted to list") (str-contains? s "Do not retry run/bash/shell"))))) -(let* ([wf (coding-workflow "true" "/tmp/jcode-verified-read-scope" - (list (cons 'run-aliases? #t)))] - [read-tool (tool-def-callable (workflow-get-tool-def wf "read"))] - [list-tool (tool-def-callable (workflow-get-tool-def wf "list"))] - [run-tool (tool-def-callable (workflow-get-tool-def wf "run"))]) - (check-pred! "verified-run: read refuses outside cwd" - (read-tool '(("path" . "/tmp"))) - (lambda (s) - (and (str-contains? s "read refused outside") - (str-contains? s "MCP tools")))) - (check-pred! "verified-run: list refuses outside cwd" - (list-tool '(("path" . "/tmp"))) - (lambda (s) - (str-contains? s "list refused outside"))) - (check-pred! "verified-run: path-only run cannot inspect outside cwd" - (run-tool '(("path" . "/tmp"))) - (lambda (s) - (and (str-contains? s "auto-converted to list") - (str-contains? s "list refused outside"))))) +(let ([old-read-roots (getenv "JCODE_READ_ROOTS")]) + (dynamic-wind + (lambda () (putenv "JCODE_READ_ROOTS" "")) + (lambda () + (let* ([wf (coding-workflow "true" "/tmp/jcode-verified-read-scope" + (list (cons 'run-aliases? #t)))] + [read-tool (tool-def-callable (workflow-get-tool-def wf "read"))] + [list-tool (tool-def-callable (workflow-get-tool-def wf "list"))] + [run-tool (tool-def-callable (workflow-get-tool-def wf "run"))]) + (check-pred! "verified-run: read refuses outside cwd" + (read-tool '(("path" . "/tmp"))) + (lambda (s) + (and (str-contains? s "read refused outside") + (str-contains? s "MCP tools")))) + (check-pred! "verified-run: list refuses outside cwd" + (list-tool '(("path" . "/tmp"))) + (lambda (s) + (str-contains? s "list refused outside"))) + (check-pred! "verified-run: path-only run cannot inspect outside cwd" + (run-tool '(("path" . "/tmp"))) + (lambda (s) + (and (str-contains? s "auto-converted to list") + (str-contains? s "list refused outside")))))) + (lambda () (putenv "JCODE_READ_ROOTS" (or old-read-roots ""))))) + +(let* ([cwd "/tmp/jcode-verified-read-scope"] + [root "/tmp/jcode-verified-read-root"] + [external-file (string-append root "/api.ss")] + [old-read-roots (getenv "JCODE_READ_ROOTS")]) + (guard (e [#t (void)]) (mkdir cwd)) + (guard (e [#t (void)]) (mkdir root)) + (call-with-output-file external-file + (lambda (o) (display "(def qt-api-shape 'ok)\n" o)) + 'replace) + (dynamic-wind + (lambda () (putenv "JCODE_READ_ROOTS" root)) + (lambda () + (let* ([scope (parse-write-scope "local.txt")] + [wf (coding-workflow "true" cwd + (list (cons 'write-scope scope)))] + [read-tool (tool-def-callable (workflow-get-tool-def wf "read"))] + [list-tool (tool-def-callable (workflow-get-tool-def wf "list"))] + [edit-tool (tool-def-callable (workflow-get-tool-def wf "edit"))] + [edit-result + (parameterize ((current-write-scope scope)) + (guard (e [#t (condition-message e)]) + (edit-tool + (list (cons "path" external-file) + (cons "content" "bad")))))]) + (check! "verified-run: JCODE_READ_ROOTS allows external read" + (read-tool (list (cons "path" external-file))) + "(def qt-api-shape 'ok)\n") + (check-pred! "verified-run: JCODE_READ_ROOTS allows external list" + (list-tool (list (cons "path" root))) + (lambda (s) (str-contains? s "api.ss"))) + (check-pred! "verified-run: prompt advertises read roots" + (workflow-system-prompt-template wf) + (lambda (s) + (and (str-contains? s "JCODE_READ_ROOTS") + (str-contains? s root)))) + (check-pred! "verified-run: read roots do not widen write scope" + edit-result + (lambda (s) + (and (str-contains? s "edit refused") + (str-contains? s "outside")))))) + (lambda () (putenv "JCODE_READ_ROOTS" (or old-read-roots ""))))) (let* ([wf (coding-workflow "true" "/tmp")] [names (workflow-tool-names wf)]) @@ -2288,6 +2335,11 @@ '(("type" . "object")) (lambda (a) "balance")) (set-tool-origin! "jerboa_check_balance" 'mcp) + (register-tool! "jerboa_howto_get" + "A compact-mode allowed MCP cookbook reader." + '(("type" . "object")) + (lambda (a) "recipe")) + (set-tool-origin! "jerboa_howto_get" 'mcp) (register-tool! "jerboa_balanced_replace" "A write-capable MCP replace tool that should not bypass jcode edits." '(("type" . "object")) @@ -2297,7 +2349,9 @@ [mcp-tool (workflow-get-tool-def wf "jerboa_test_lookup")] [plain-tool (workflow-get-tool-def wf "jcode_test_plain_lookup")] [disabled-wf (coding-workflow "true" "/tmp" - (list (cons 'external-tools? #f)))]) + (list (cons 'external-tools? #f)))] + [compact-wf (coding-workflow "true" "/tmp" + (list (cons 'compact? #t)))]) (check! "verified-run: MCP-origin custom prefix is exposed" (and mcp-tool #t) #t) (check! "verified-run: plain registry tool is not exposed" @@ -2312,6 +2366,15 @@ (workflow-get-tool-def wf "jerboa_balanced_replace") #f) (check! "verified-run: external tools option disables MCP bridge" (workflow-get-tool-def disabled-wf "jerboa_test_lookup") #f) + (check! "verified-run: compact MCP keeps cookbook reader" + (and (workflow-get-tool-def compact-wf "jerboa_howto_get") #t) #t) + (check! "verified-run: compact MCP hides broad lookup" + (workflow-get-tool-def compact-wf "jerboa_test_lookup") #f) + (check-pred! "verified-run: compact prompt asks for earlier writes" + (workflow-system-prompt-template compact-wf) + (lambda (s) + (and (str-contains? s "Compact verified mode") + (str-contains? s "write a complete first version")))) (check-pred! "verified-run: MCP-origin tool receives converted args" ((tool-def-callable mcp-tool) '(("q" . "life"))) (lambda (s) (str-contains? s "\"life\""))) @@ -2454,6 +2517,37 @@ (car (reverse tool-results)) "two\nthree")) (guard (e [#t (void)]) (delete-file "/tmp/jcode-verified-read-range.txt")) + (let* ([wf (coding-workflow "true" "/tmp")] + [target "jcode-verified-read-start-window.txt"] + [target-path (string-append "/tmp/" target)] + [tool-results '()] + [resp (scripted-responder + (list + (list + (make-wtool-call + "read" + (list (cons "path" target) + (cons "start" 2)) + #f)) + (list (make-wtool-call "verify" '() #f)) + (list (make-wtool-call "done" '(("summary" . "read-start-ok")) #f))))] + [result (begin + (call-with-output-file target-path + (lambda (o) (display "one\ntwo\nthree\nfour" o)) + 'replace) + (run-workflow wf "inspect from a start line" resp + (list (cons 'max-iterations 8) + (cons 'on-message + (lambda (m) + (when (equal? (message-role m) "tool") + (set! tool-results + (cons (message-content m) tool-results))))))))]) + (check! "verified-run: read start-only reaches verified done" + result "read-start-ok") + (check! "verified-run: read start-only returns useful window" + (car (reverse tool-results)) "two\nthree\nfour")) + (guard (e [#t (void)]) (delete-file "/tmp/jcode-verified-read-start-window.txt")) + (let* ([vr-dir "/tmp"] [target "jcode-verified-verify-after-edit.txt"] [target-path (string-append vr-dir "/" target)] @@ -5500,12 +5594,19 @@ [cfg (make-hashtable equal-hash equal?)] [expert (make-hashtable equal-hash equal?)] [esc (make-hashtable equal-hash equal?)] + [providers (make-hashtable equal-hash equal?)] + [mlx (make-hashtable equal-hash equal?)] [tool (make-hashtable equal-hash equal?)] [fn (make-hashtable equal-hash equal?)] - [params (make-hashtable equal-hash equal?)]) + [params (make-hashtable equal-hash equal?)] + [old-max-tokens (getenv "JCODE_MAX_TOKENS")]) (hashtable-set! esc "request_logprobs" #t) (hashtable-set! expert "escalation" esc) (hashtable-set! cfg "expert" expert) + (hashtable-set! mlx "max_tokens" 1234) + (hashtable-set! mlx "reasoning_effort" "low") + (hashtable-set! providers "mlx" mlx) + (hashtable-set! cfg "providers" providers) (hashtable-set! params "type" "object") (hashtable-set! fn "name" "lookup") (hashtable-set! fn "description" "lookup") @@ -5513,7 +5614,7 @@ (hashtable-set! tool "type" "function") (hashtable-set! tool "function" fn) (dynamic-wind - (lambda () (void)) + (lambda () (putenv "JCODE_MAX_TOKENS" "")) (lambda () (serve-one-captured-json! srv captured 200 chat-body) (let* ([p (make-provider "mlx" "" "unit-test-model" base-url)] @@ -5526,8 +5627,14 @@ (check! "mlx local tool chat omits logprobs" (and req (str-contains? req "\"logprobs\"")) #f) (check! "mlx local tool chat omits top_logprobs" - (and req (str-contains? req "\"top_logprobs\"")) #f))) - (lambda () (tcp-close srv)))) + (and req (str-contains? req "\"top_logprobs\"")) #f) + (check! "mlx local tool chat honors provider max_tokens" + (and req (str-contains? req "\"max_tokens\":1234")) #t) + (check! "mlx local tool chat passes reasoning_effort override" + (and req (str-contains? req "\"reasoning_effort\":\"low\"")) #t))) + (lambda () + (putenv "JCODE_MAX_TOKENS" (or old-max-tokens "")) + (tcp-close srv)))) (let* ([sse-body (string-append "data: {\"id\":\"chatcmpl-test\",\"object\":\"chat.completion.chunk\",\"created\":0,\"model\":\"unit\",\"choices\":[{\"index\":0,\"delta\":{\"role\":\"assistant\",\"content\":\"ok\"},\"finish_reason\":null}]}\n\n" @@ -5536,9 +5643,10 @@ "data: [DONE]\n\n")] [srv (tcp-listen "127.0.0.1" 0)] [base-url (format "http://127.0.0.1:~a/v1" (tcp-server-port srv))] - [captured (vector #f)]) + [captured (vector #f)] + [old-max-tokens (getenv "JCODE_MAX_TOKENS")]) (dynamic-wind - (lambda () (void)) + (lambda () (putenv "JCODE_MAX_TOKENS" "")) (lambda () (serve-one-captured-sse! srv captured sse-body) (let* ([p (make-provider "mlx" "" "unit-test-model" base-url)] @@ -5556,9 +5664,13 @@ (check! "mlx stream cache reply" (car result) "ok") (check! "mlx stream prompt cache key" (and req (str-contains? req "\"prompt_cache_key\"")) #t) + (check! "mlx stream default max_tokens is bounded" + (and req (str-contains? req "\"max_tokens\":8192")) #t) (check! "mlx stream cached token accounting" (and cache-hit (cdr cache-hit)) 42))) - (lambda () (tcp-close srv)))) + (lambda () + (putenv "JCODE_MAX_TOKENS" (or old-max-tokens "")) + (tcp-close srv)))) (let* ([sse-body (string-append "data: {\"id\":\"chatcmpl-test\",\"object\":\"chat.completion.chunk\",\"created\":0,\"model\":\"unit\",\"choices\":[{\"index\":0,\"delta\":{\"role\":\"assistant\",\"content\":\"ok\"},\"finish_reason\":null}]}\n\n"