Harden verified local model recovery
ober
5759e7214ff11522a4d2b7a7d8e921da23056d7a
--- a/docs/FORGE.md +++ b/docs/FORGE.md @@ -33,7 +33,7 @@ see [`FORGE_PORT_PLAN.md`](FORGE_PORT_PLAN.md). | `/forge verify` | Describe + self-test the verify-gate (ATLAS verify + repair). | | `/forge bestofk` · `/forge best-of-k` | Describe + self-test best-of-k diverse generation. | | `/forge breaker` · `/forge no-progress` | Describe + self-test the no-progress loop breaker. | -| `/forge run [opts] <task>` | Verify-gated coding on the **live** model (edit → verify → done). Options: `--verify`, `--bestof`, `--cwd`, `--write-scope`, `--guidance-file`, `--json`, `--status-file`, `--no-run-aliases`. See [verified.md](verified.md). | +| `/forge run [opts] <task>` | Verify-gated coding on the **live** model (edit → verify → done). Options: `--verify`, `--bestof`, `--cwd`, `--write-scope`, `--guidance-file`, `--json`, `--status-file`, `--run-aliases`. See [verified.md](verified.md). | The `workflow` / `proxy` / `ablation` / `verify` / `bestofk` / `breaker` self-tests run real code against scripted inputs (no live model), so they double @@ -52,7 +52,7 @@ HTTP endpoint. See [The proxy](#the-openai-compatible-proxy) below. ### `jcode verified` (subcommand) ```bash -jcode verified "<task>" [--bestof K] [--verify CMD] [--cwd DIR] [--write-scope PATHS] [--guidance-file FILE] [--json] [--status-file FILE] [--no-run-aliases] +jcode verified "<task>" [--bestof K] [--verify CMD] [--cwd DIR] [--write-scope PATHS] [--guidance-file FILE] [--json] [--status-file FILE] [--run-aliases] ``` Runs the [verify-gate](#verify-gate) on the live model — edit → run `CMD` → --- a/docs/cli.md +++ b/docs/cli.md @@ -85,7 +85,7 @@ jcode connect HOST:PORT --host NAME [--token T] # controller side ### `verified` ``` -jcode verified "<task>" [--bestof K] [--verify CMD] [--cwd DIR] [--write-scope PATHS] [--guidance-file FILE] [--json] [--status-file FILE] [--no-run-aliases] +jcode verified "<task>" [--bestof K] [--verify CMD] [--cwd DIR] [--write-scope PATHS] [--guidance-file FILE] [--json] [--status-file FILE] [--run-aliases] ``` Runs an edit→verify→done loop on the live model: it edits, runs `--verify CMD` @@ -99,6 +99,12 @@ When MCP is initialized, MCP-origin tools are also exposed to the verified workflow as structured tools, so validators and project-specific MCP helpers are available without bypassing the verified edit/verify gate. Use `--no-mcp` to skip MCP initialization for the process. +By default, `run`, `bash`, and `shell` are not exposed in verified mode. If a +local model calls them anyway, jcode returns corrective tool-resolution +feedback; repeated attempts get stronger wording and do not count against the +normal tool-error budget. `--run-aliases` opts back into the legacy narrow +inspection aliases, but `verify` remains the authority for build and behavior +checks. Automation can use `--json` to emit a single final status object on stdout; the human trajectory is written to stderr in that mode. `--status-file FILE` writes @@ -176,7 +182,7 @@ Useful built-in workflow skill: | `/forge verify` | Describe + self-test the verify-gate. | | `/forge bestofk` · `/forge best-of-k` | Describe + self-test best-of-k generation. | | `/forge breaker` · `/forge no-progress` | Describe + self-test the no-progress breaker. | -| `/forge run [opts] <task>` | Verify-gated coding on the live model. Supports `--verify`, `--bestof`, `--cwd`, `--write-scope`, `--guidance-file`, `--json`, `--status-file`, and `--no-run-aliases`. | +| `/forge run [opts] <task>` | Verify-gated coding on the live model. Supports `--verify`, `--bestof`, `--cwd`, `--write-scope`, `--guidance-file`, `--json`, `--status-file`, and `--run-aliases`. | Each `/forge` self-test runs real code against scripted inputs (no live model), so it doubles as a smoke test. Full semantics in [FORGE.md](FORGE.md). --- a/docs/verified.md +++ b/docs/verified.md @@ -81,7 +81,7 @@ jcode verified <task> [options] | `--guidance-file FILE` | none | Append external task guidance to the workflow prompt. Aliases: `--guide-file`, `--task-guidance`. | | `--json` | off | Emit only final status JSON on stdout; human trace goes to stderr. | | `--status-file FILE` | none | Write final status JSON to a file. | -| `--no-run-aliases` | off | Omit `run`, `bash`, and `shell` inspection aliases from the workflow. | +| `--run-aliases` | off | Opt into legacy `run`, `bash`, and `shell` inspection aliases. | Global flags still apply before the subcommand: @@ -133,7 +133,8 @@ verify() done(summary) ``` -By default, the workflow also includes narrow shell-habit aliases: +By default, the workflow does not expose shell-habit aliases. For legacy +compatibility or focused debugging, `--run-aliases` adds: ```text run(command) @@ -146,8 +147,35 @@ inspection habits such as `ls`, `cat`, `head`, `tail`, `wc`, `grep`, `rg`, plain file reads, directory listings, and `mkdir -p` inside the write scope. The real build or test command must go through `verify`. -Use `--no-run-aliases` when a local model keeps wasting turns trying shell -commands instead of reading, editing, and verifying. +Leave aliases off when a local model keeps wasting turns trying shell commands +instead of reading, editing, and verifying. + +When aliases are off and the model still calls `run`, `bash`, or `shell`, jcode +returns a privileged tool-resolution message instead of spending the normal tool +error budget. The first miss explains the available verified tools. Repeated +misses escalate the wording and tell the model to stop retrying shell habits and +choose `verify`, inspection, or edit tools. This is intentionally generic; it +does not add task-specific knowledge to the harness. + +## Local-Model Recovery Rules + +Verified mode includes generic pressure valves for common weak-model loops: + +- Rejected `.ss` drafts are kept out of the filesystem. The model may inspect a + rejected draft only a few times. +- After the inspection limit, the only valid recovery is a fresh full-file + `edit`/`write` such as `write(path="file.ss", content=<complete corrected file + contents>)`. `run`, `list`, `read`, `balance`, `verify`, MCP file edits, + line edits, range edits, definition edits, and exact `old_str` replacement are + blocked until that full-file write succeeds. +- Minimal EOF delimiter autoclose is conservative. It is applied only when the + draft ends at a safe boundary, would not swallow a later file-level form, and + the auto-closed candidate reads as Scheme without known invalid generic forms + such as bodyless `when` or `unless`. +- For new scripts, the prompt asks the model to write a small complete first + version that parses and runs, verify it, then expand one function or data + transformation at a time. The harness should prefer deterministic, bounded + write targets over broad speculative rewrites. ## Write Scope @@ -232,7 +260,7 @@ Representative success shape: "verify_command": "make test", "cwd": ".", "write_scope": "all", - "run_aliases": true, + "run_aliases": false, "guidance_file": false, "status_file": false } @@ -471,7 +499,7 @@ passes. server's responsibility. jcode only imports tools marked as MCP-origin into the verified workflow. - Use `--no-mcp` when you want a run with no external MCP tools. -- Use `--no-run-aliases` when a model keeps trying shell habits instead of the +- Leave `run_aliases` off when a model keeps trying shell habits instead of the verified edit/verify loop. For high-risk repositories, combine: @@ -497,7 +525,7 @@ If this still loops: - narrow the task, - add a better `--guidance-file`, -- use `--no-run-aliases`, +- keep `run_aliases` off, - increase anti-pattern or error-fix coverage for the failure you saw. ### The run passes but the behavior is wrong --- a/src/jcode/core/verified-run.ss +++ b/src/jcode/core/verified-run.ss @@ -183,6 +183,18 @@ (and idx (parse-digits-at s (+ idx (string-length marker)))))) +(def (find-line-number-after-from s marker start) + (let ((idx (find-substring-from s marker start))) + (and idx + (parse-digits-at s (+ idx (string-length marker)))))) + +(def (find-diagnostic-start s needles) + (let loop ((rest needles)) + (cond + ((null? rest) #f) + ((find-substring-from s (car rest) 0) => (lambda (idx) idx)) + (else (loop (cdr rest)))))) + (def (token-end-index s start) (let ((n (string-length s))) (let loop ((i start)) @@ -242,11 +254,11 @@ (start (repair-ref repair 'start)) (end (repair-ref repair 'end))) (format - "Structural repair required before more probing: read(path=\"~a\", start=~a, end=~a) if needed, then replace_range(path=\"~a\", start=~a, end=~a, content=<complete corrected span>) and call verify." + "Structural repair required before more probing: read(path=\"~a\", start=~a, end=~a) if needed, then replace_range(path=\"~a\", start=~a, end=~a, content=<complete corrected span>) and call verify. If that local repair is blocked, edit/write may replace the same file only with complete corrected file contents that pass syntax." path start end path start end))) -(def (verification-source-path cwd detail line-no) - (let ((from-detail (find-source-path-after detail 0))) +(def (verification-source-path cwd detail line-no (start 0)) + (let ((from-detail (find-source-path-after detail start))) (cond ((and from-detail (file-exists? (abs-path cwd from-detail))) from-detail) @@ -256,10 +268,15 @@ (def (invalid-context-repair detail cwd) (if (not (string-contains detail "invalid context for definition")) #f - (let ((line-no (find-line-number-after detail " at line "))) + (let* ((diag-start (or (find-diagnostic-start + detail + '("Exception: invalid context for definition" + "invalid context for definition")) + 0)) + (line-no (find-line-number-after-from detail " at line " diag-start))) (if (not line-no) #f - (let ((path (verification-source-path cwd detail line-no))) + (let ((path (verification-source-path cwd detail line-no diag-start))) (if (not path) #f (let ((p (abs-path cwd path))) @@ -276,10 +293,15 @@ (def (invalid-syntax-repair detail cwd) (if (not (string-contains detail "invalid syntax")) #f - (let ((line-no (find-line-number-after detail " at line "))) + (let* ((diag-start (or (find-diagnostic-start + detail + '("Exception: invalid syntax" + "invalid syntax")) + 0)) + (line-no (find-line-number-after-from detail " at line " diag-start))) (if (not line-no) #f - (let ((path (verification-source-path cwd detail line-no))) + (let ((path (verification-source-path cwd detail line-no diag-start))) (if (not path) #f (let ((p (abs-path cwd path))) @@ -311,10 +333,16 @@ (if (not (or (string-contains detail "unexpected close parenthesis") (string-contains detail "Unexpected close"))) #f - (let ((line-no (find-line-number-after detail " at line "))) + (let* ((diag-start (or (find-diagnostic-start + detail + '("Exception in read: unexpected close" + "unexpected close parenthesis" + "Unexpected close")) + 0)) + (line-no (find-line-number-after-from detail " at line " diag-start))) (if (not line-no) #f - (let ((path (verification-source-path cwd detail line-no))) + (let ((path (verification-source-path cwd detail line-no diag-start))) (if (not path) #f (let ((p (abs-path cwd path))) @@ -647,6 +675,14 @@ (not (path-like-file-arg? v))) v)))) +(def (arg-replacement-content args) + (or (arg-content args) + (arg-ref args "new_str" #f) + (arg-ref args "new_string" #f) + (arg-ref args "replacement" #f) + (arg-ref args "replacement_content" #f) + (arg-ref args "replacement_text" #f))) + (def (arg-int args key default) (let ((v (arg-ref args key default))) (cond @@ -675,6 +711,12 @@ (def current-rejected-draft-repeat-count (make-parameter 0)) +(def current-rejected-draft-path + (make-parameter #f)) + +(def current-rejected-draft-path-reject-count + (make-parameter 0)) + (def current-existing-ss-rewrite-reject-path (make-parameter #f)) @@ -746,7 +788,9 @@ (current-rejected-ss-draft #f) (current-rejected-draft-inspections 0) (current-rejected-draft-fingerprint #f) - (current-rejected-draft-repeat-count 0)) + (current-rejected-draft-repeat-count 0) + (current-rejected-draft-path #f) + (current-rejected-draft-path-reject-count 0)) (def (reset-existing-ss-rewrite-state!) (current-existing-ss-rewrite-reject-path #f) @@ -822,9 +866,16 @@ (def (record-rejected-ss-draft! path content) (let* ((fp (rejected-draft-fingerprint path content)) - (same? (equal? fp (current-rejected-draft-fingerprint)))) + (same? (equal? fp (current-rejected-draft-fingerprint))) + (old-path (current-rejected-draft-path)) + (same-path? (and old-path (string=? old-path path)))) (current-rejected-ss-draft (cons path content)) (current-rejected-draft-fingerprint fp) + (current-rejected-draft-path path) + (current-rejected-draft-path-reject-count + (if same-path? + (+ (current-rejected-draft-path-reject-count) 1) + 1)) (if same? (let ((n (+ (current-rejected-draft-repeat-count) 1))) (current-rejected-draft-repeat-count n) @@ -846,6 +897,19 @@ path ". It will not get a fresh recovery budget. Send different complete contents, or use edit/write with a corrected complete file body."))) +(def (rejected-draft-blind-loop-note path) + (and (>= (current-rejected-draft-path-reject-count) 2) + (string-append + "\nMultiple full-file writes for " + path + " have been rejected by the syntax guard. Stop guessing with another broad write. " + "Use balance(path=\"" + path + "\") or read(path=\"" + path + "\", start=<near reported line>, end=<near reported line>) on the latest rejected draft, " + "then send one complete corrected file body with edit/write."))) + (def (tool-label who) (cond ((symbol? who) (symbol->string who)) @@ -926,6 +990,31 @@ path (same-verified-path? cwd (repair-ref repair 'path) path))) +(def (required-repair-full-rewrite? cwd path content old-str line-no) + (let ((repair (current-required-range-repair))) + (and repair + (string? path) + (string? content) + (not old-str) + (<= line-no 0) + (source-ss-path? path) + (file-exists? (abs-path cwd path)) + (repair-path-matches? cwd repair path) + (looks-like-complete-file? content)))) + +(def (guard-jerboa-syntax-required-rewrite! cwd path content) + (let ((msg (jerboa-syntax-guard-message path content)) + (repair (current-required-range-repair))) + (when msg + (reset-rejected-draft-state!) + (error 'edit + (string-append + msg + "\nThe same-file full rewrite was not written; the on-disk file is unchanged. " + (if repair + (range-repair-instruction repair) + (ss-repair-instruction path))))))) + (def (read-range-start args) (let ((start-line (arg-int args "start" 0)) (line-no (arg-int args "line" 0)) @@ -1032,6 +1121,30 @@ (not (replace-range-covers-required-repair? cwd args repair)) (required-repair-message 'replace_range repair)))) +(def (replace-range-missing-content-message cwd args) + (let* ((path (arg-path args #f)) + (start-line (arg-int args "start" 0)) + (end-line (arg-int args "end" 0)) + (repair (current-required-range-repair)) + (shape + (if (and path (> start-line 0) (>= end-line start-line)) + (format + "replace_range(path=\"~a\", start=~a, end=~a, content=<complete corrected replacement text>)" + path start-line end-line) + "replace_range(path=<file>, start=<line>, end=<line>, content=<complete corrected replacement text>)"))) + (string-append + "replace_range missing required content; the file was not changed. " + "Path/start/end alone cannot edit a file. Next call must include the replacement text as content: " + shape + ". Accepted content aliases are content, new_content, new_str, new_string, replacement, body, and text." + (if (and repair + path + (> start-line 0) + (>= end-line start-line) + (replace-range-covers-required-repair? cwd args repair)) + (string-append "\n\n" (required-repair-action-message cwd repair)) + "")))) + (def (structural-repair-rejection-message cwd path msg) (let ((repair (current-required-range-repair))) (if (and repair (repair-path-matches? cwd repair path)) @@ -1070,15 +1183,22 @@ (> (current-rejected-draft-inspections) rejected-draft-inspection-limit))) +(def (rejected-draft-rewrite-action path) + (string-append + "Next call must be edit or write with a full file body. " + "Only valid next repair is edit/write with a full file body, for example: " + "write(path=\"" path "\", content=<complete corrected file contents>). " + "Do not call run, bash, shell, list, read, cat, ls, balance, verify, MCP tools, " + "line_edit, replace_def, replace_range, or exact old_str replacement until that full-file write succeeds.")) + (def (rejected-draft-limit-message path content) (string-append "Rejected draft inspection limit reached for " path ". Missing-file recovery is now locked to a fresh full-file create. " "The rejected draft was not written to disk; MCP file-edit tools, run/list/verify, " "line_edit, replace_def, and replace_range cannot repair it. " - "Next call must be edit or write with complete corrected contents for " - path - ". Do not inspect the rejected draft again.\n" + (rejected-draft-rewrite-action path) + "\nDo not inspect the rejected draft again.\n" "Last balance result: " (balance-report content path))) @@ -1096,8 +1216,8 @@ "Missing-file recovery is locked to a fresh full-file create. " "The rejected full-file replacement was not written; the on-disk file is unchanged. ") "MCP file-edit tools, run/list/verify, line_edit, replace_def, and replace_range cannot repair this rejected draft. " - "Next call must be edit or write with path=\"" path - "\" and complete corrected contents. Do not inspect the rejected draft again."))))) + (rejected-draft-rewrite-action path) + " Do not inspect the rejected draft again."))))) (def (pending-missing-ss-create-recovery-message cwd who) (let ((path (pending-missing-ss-create-path cwd))) @@ -1110,8 +1230,8 @@ "Missing-file recovery is locked to a fresh full-file create. " "The rejected draft was not written to disk; MCP file-edit tools, run/list/verify, " "line_edit, replace_def, and replace_range cannot repair it. " - "Next call must be edit or write with path=\"" path - "\" and complete corrected contents. Do not inspect the rejected draft again.")))) + (rejected-draft-rewrite-action path) + " Do not inspect the rejected draft again.")))) (def (pending-ss-create-repair-message cwd) (let ((path (current-pending-ss-create-repair))) @@ -1530,6 +1650,108 @@ (else (loop (+ i 1) next-line next-col stack #f #f #f))))))))) +(def (unclosed-delimiter-frames content) + (let ((n (string-length content))) + (let loop ((i 0) + (line 1) + (col 1) + (stack '()) + (in-string? #f) + (escape? #f) + (in-comment? #f)) + (cond + ((= i n) stack) + (else + (let* ((ch (string-ref content i)) + (newline? (char=? ch #\newline)) + (next-line (if newline? (+ line 1) line)) + (next-col (if newline? 1 (+ col 1)))) + (cond + (in-comment? + (loop (+ i 1) next-line next-col stack #f #f + (and (not newline?) in-comment?))) + (in-string? + (cond + (escape? + (loop (+ i 1) next-line next-col stack #t #f #f)) + ((char=? ch #\\) + (loop (+ i 1) next-line next-col stack #t #t #f)) + ((char=? ch #\") + (loop (+ i 1) next-line next-col stack #f #f #f)) + (else + (loop (+ i 1) next-line next-col stack #t #f #f)))) + ((char=? ch #\;) + (loop (+ i 1) next-line next-col stack #f #f #t)) + ((char=? ch #\") + (loop (+ i 1) next-line next-col stack #t #f #f)) + ((open-delim? ch) + (loop (+ i 1) next-line next-col + (cons (list ch line col) stack) #f #f #f)) + ((close-delim? ch) + (cond + ((null? stack) #f) + ((matching-delim? (caar stack) ch) + (loop (+ i 1) next-line next-col (cdr stack) #f #f #f)) + (else #f))) + (else + (loop (+ i 1) next-line next-col stack #f #f #f))))))))) + +(def (frame-line frame) + (cadr frame)) + +(def (minimum-frame-line frames) + (and (pair? frames) + (let loop ((xs (cdr frames)) + (best (frame-line (car frames)))) + (cond + ((null? xs) best) + ((< (frame-line (car xs)) best) + (loop (cdr xs) (frame-line (car xs)))) + (else + (loop (cdr xs) best)))))) + +(def (apparent-file-level-form-line? line) + (and (string? line) + (> (string-length line) 0) + (string-prefix? "(" line))) + +(def (first-apparent-file-form-after-line content start-line) + (let loop ((lines (string-split content #\newline)) + (line-no 1)) + (cond + ((null? lines) #f) + ((and (> line-no start-line) + (apparent-file-level-form-line? (car lines))) + line-no) + (else + (loop (cdr lines) (+ line-no 1)))))) + +(def (minimal-balance-autoclose-blocked-line content) + (let ((frames (unclosed-delimiter-frames content))) + (and (pair? frames) + (let ((line (minimum-frame-line frames))) + (and line + (first-apparent-file-form-after-line content line)))))) + +(def (minimal-balance-clean-ending? content) + (let ((n (string-length content))) + (and (> n 0) + (let ((ch (string-ref content (- n 1)))) + (or (char-whitespace? ch) + (close-delim? ch) + (char=? ch #\") + (let loop ((lines (reverse (string-split content #\newline)))) + (cond + ((null? lines) #f) + ((string=? (string-trim (car lines)) "") + (loop (cdr lines))) + (else + (string-prefix? ";" (string-trim (car lines))))))))))) + +(def (minimal-balance-autoclose-safe? content) + (and (minimal-balance-clean-ending? content) + (not (minimal-balance-autoclose-blocked-line content)))) + (def (balance-report content path) (let ((n (string-length content))) (let loop ((i 0) @@ -1590,6 +1812,7 @@ (def (minimal-balance-candidate content label) (let ((suffix (missing-closing-delims content))) (and suffix + (minimal-balance-autoclose-safe? content) (let ((candidate (string-append content suffix))) (if (balance-ok-text? (balance-report candidate label)) candidate @@ -1597,11 +1820,106 @@ (and (balance-ok-text? (balance-report line-candidate label)) line-candidate))))))) +(def (read-all-forms content) + (guard (e [#t #f]) + (with-input-from-string content + (lambda () + (let loop ((forms '())) + (let ((form (read))) + (if (eof-object? form) + (reverse forms) + (loop (cons form forms))))))))) + +(def (proper-list-length xs) + (let loop ((rest xs) (n 0)) + (cond + ((null? rest) n) + ((pair? rest) (loop (cdr rest) (+ n 1))) + (else #f)))) + +(def (known-invalid-scheme-form-message form) + (cond + ((not (pair? form)) #f) + ((and (symbol? (car form)) + (or (eq? (car form) 'quote) + (eq? (car form) 'quasiquote))) + #f) + (else + (let ((len (proper-list-length form))) + (or + (and len + (symbol? (car form)) + (or (eq? (car form) 'when) + (eq? (car form) 'unless)) + (< len 3) + (format "~a form has no body" (car form))) + (known-invalid-scheme-form-message (car form)) + (let loop ((rest (cdr form))) + (cond + ((null? rest) #f) + ((pair? rest) + (or (known-invalid-scheme-form-message (car rest)) + (loop (cdr rest)))) + (else + (known-invalid-scheme-form-message rest))))))))) + +(def (forms-invalid-scheme-message forms) + (let loop ((xs forms)) + (cond + ((null? xs) #f) + ((known-invalid-scheme-form-message (car xs)) => (lambda (msg) msg)) + (else (loop (cdr xs)))))) + +(def (autoclose-candidate-syntax-sanity-message candidate label) + (let ((forms (read-all-forms candidate))) + (cond + ((not forms) + (format "auto-closed candidate for ~a is not readable Scheme" label)) + ((forms-invalid-scheme-message forms) + => (lambda (msg) + (format "auto-closed candidate for ~a contains invalid Scheme: ~a" + label msg))) + (else #f)))) + +(def (autoclose-candidate-syntax-sane? candidate label) + (not (autoclose-candidate-syntax-sanity-message candidate label))) + +(def (minimal-balance-autoclose-syntax-hint content label) + (let ((candidate (minimal-balance-candidate content label))) + (and candidate + (let ((msg (autoclose-candidate-syntax-sanity-message candidate label))) + (and msg + (string-append + "\nMinimal EOF delimiter repair was not applied for " + label + ": " + msg + ". Resubmit the complete corrected file contents instead of relying on EOF autoclose.")))))) + +(def (minimal-balance-autoclose-blocked-hint content label) + (and (missing-closing-delims content) + (let ((blocked-line (minimal-balance-autoclose-blocked-line content)) + (frames (unclosed-delimiter-frames content))) + (and blocked-line + (pair? frames) + (let ((open-line (minimum-frame-line frames))) + (format + "\nMinimal EOF delimiter repair was not applied for ~a: line ~a starts another file-level form after an unclosed delimiter from line ~a. Repair the earlier enclosing form instead of appending close delimiters at EOF." + label blocked-line open-line)))))) + +(def (minimal-balance-autoclose-boundary-hint content label) + (and (missing-closing-delims content) + (not (minimal-balance-clean-ending? content)) + (format + "\nMinimal EOF delimiter repair was not applied for ~a: the draft ends mid-token or in non-delimiter text. Resubmit the complete file or span; do not rely on appending close delimiters at EOF." + label))) + (def (minimal-balance-suffix-hint content label) (let ((suffix (missing-closing-delims content))) (and suffix (let ((candidate (minimal-balance-candidate content label))) (and candidate + (autoclose-candidate-syntax-sane? candidate label) (string-append "\nMinimal delimiter repair: append this exact suffix at EOF before resubmitting the complete file contents:\n" suffix)))))) @@ -2411,14 +2729,21 @@ (string-append (format "Jerboa syntax guard rejected ~a: delimiter balance failed: ~a" path report) - (or (minimal-balance-suffix-hint content path) "")))))) + (or (minimal-balance-autoclose-syntax-hint content path) + (minimal-balance-suffix-hint content path) + (minimal-balance-autoclose-boundary-hint content path) + (minimal-balance-autoclose-blocked-hint content path) + "")))))) (def (auto-balance-full-ss-content path content) (and (source-ss-path? path) ;; Keep heredoc-like content out of the lightweight delimiter scanner. (not (string-contains content "#<<")) (not (balance-ok-text? (balance-report content path))) - (minimal-balance-candidate content path))) + (let ((candidate (minimal-balance-candidate content path))) + (and candidate + (autoclose-candidate-syntax-sane? candidate path) + candidate)))) (def (jerboa-syntax-guard-message path content) (and (source-ss-path? path) @@ -2442,7 +2767,8 @@ (string-append msg "\n" (ss-repair-instruction path) - (or (rejected-draft-repeat-note path) "")))))) + (or (rejected-draft-repeat-note path) "") + (or (rejected-draft-blind-loop-note path) "")))))) (def (guard-jerboa-syntax-existing-file-edit! cwd path content) (let ((msg (jerboa-syntax-guard-message path content))) @@ -2460,7 +2786,8 @@ "\") or balance(path=\"" path "\"). Call verify after the replacement is written." - (or (rejected-draft-repeat-note path) "")))) + (or (rejected-draft-repeat-note path) "") + (or (rejected-draft-blind-loop-note path) "")))) (begin (record-existing-ss-rewrite-rejection! cwd path content) (reset-rejected-draft-state!) @@ -2473,7 +2800,21 @@ "\") or verify(), then use line_edit, replace_range, or replace_def for a local repair.\n" (existing-ss-rewrite-lock-message cwd path)))))))) -(def (guard-jerboa-syntax-for-replace-range! cwd path full-content replacement-content) +(def (replace-range-syntax-rejection-message path start-line end-line msg) + (string-append + msg + "\nThe replacement was not written; the on-disk file is unchanged. " + "Do not switch to a full-file edit/write. Retry the same local repair with syntax-correct replacement content:\n" + " replace_range(path=\"" + path + "\", start=" + (number->string start-line) + ", end=" + (number->string end-line) + ", content=<complete corrected replacement span>)\n" + "For a one-line mistake, line_edit may be used instead. Then call verify.")) + +(def (guard-jerboa-syntax-for-replace-range! cwd path start-line end-line full-content replacement-content) (let ((repair (current-required-range-repair)) (msg (jerboa-syntax-guard-message path full-content))) (when msg @@ -2495,7 +2836,9 @@ (reset-rejected-draft-state!) (error 'replace_range (structural-repair-rejection-message cwd path msg))) - (guard-jerboa-syntax! path full-content #f)))))) + (error 'replace_range + (replace-range-syntax-rejection-message + path start-line end-line msg))))))) (def (first-present-index content patterns) (let loop ((ps patterns)) @@ -2577,12 +2920,12 @@ (def (replace-range args cwd) (let ((path (arg-path args #f)) - (content (arg-content args)) + (content (arg-replacement-content args)) (start-line (arg-int args "start" 0)) (end-line (arg-int args "end" 0))) (cond ((not path) (error 'replace_range "missing path arg")) - ((not content) (error 'replace_range "missing content arg")) + ((not content) (replace-range-missing-content-message cwd args)) ((<= start-line 0) (error 'replace_range "missing positive start arg")) ((< end-line start-line) (error 'replace_range "end must be >= start")) ((rejected-draft-hard-recovery-message cwd 'replace_range) => (lambda (msg) msg)) @@ -2613,7 +2956,7 @@ "line range ~a-~a not found in ~a" start-line end-line path)) (guard-jerboa-syntax-for-replace-range! - cwd path new-content replacement-content) + cwd path start-line end-line new-content replacement-content) (write-file-string p new-content) (record-successful-edit! cwd path) (string-append @@ -2632,17 +2975,20 @@ (new-str (or (arg-ref args "new_str" #f) (arg-ref args "new_string" #f) (and old-str content))) - (line-no (arg-int args "line" 0))) + (line-no (arg-int args "line" 0)) + (required-full-rewrite? + (required-repair-full-rewrite? cwd path content old-str line-no))) (cond ((not path) (error 'edit "missing path arg")) ((and (not content) (not old-str)) (error 'edit "missing content arg or old_str/new_str args")) - ((current-required-range-repair) - (required-repair-message 'edit (current-required-range-repair))) ((write-scope-error "edit" (scope-path cwd path)) => (lambda (msg) (error 'edit msg))) ((path-has-symlink-component? cwd path) (error 'edit "refusing write through symlink path component: ~a" path)) + ((and (current-required-range-repair) + (not required-full-rewrite?)) + (required-repair-message 'edit (current-required-range-repair))) ((and old-str (rejected-draft-hard-recovery? cwd)) (string-append (rejected-draft-hard-recovery-message cwd 'edit) @@ -2730,10 +3076,11 @@ ((and (not (file-exists? p)) (source-ss-path? path) (not (looks-like-complete-file? content))) - (reject-incomplete-ss-create + (reject-incomplete-ss-create path content "full-write snippets")) ((and (file-exists? p) - (existing-ss-rewrite-locked? cwd path)) + (existing-ss-rewrite-locked? cwd path) + (not required-full-rewrite?)) (existing-ss-rewrite-lock-message cwd path)) (else (let ((dir (path-directory p))) @@ -2748,7 +3095,9 @@ (auto-balance-full-ss-content path content))) (final-content (or balanced-content content))) (if (file-exists? p) - (guard-jerboa-syntax-existing-file-edit! cwd path final-content) + (if required-full-rewrite? + (guard-jerboa-syntax-required-rewrite! cwd path final-content) + (guard-jerboa-syntax-existing-file-edit! cwd path final-content)) (guard-jerboa-syntax! path final-content #t)) (write-file-string p final-content) (record-successful-edit! cwd path) @@ -2908,7 +3257,7 @@ (let* ((o (if (pair? opt) (car opt) '())) (scope (or (opt-get o 'write-scope) (current-write-scope))) (run-aliases? (let ((p (assoc 'run-aliases? o))) - (if p (cdr p) #t))) + (if p (cdr p) #f))) (external-tools? (let ((p (assoc 'external-tools? o))) (if p (cdr p) #t))) (terminal-on-verify? (and (opt-get o 'terminal-on-verify) #t)) @@ -2980,7 +3329,7 @@ (create-script-def (make-tool-def (make-tool-spec "create_verified_jerboa_script" - "Create a small executable Jerboa .ss starter through the verified edit path. args: {\"path\": string ending .ss, \"kind\": \"minimal-pass\" | \"cli-two-args\" | \"vector-grid\"}. Use only when a generic template clearly matches: minimal-pass for trivial scripts, cli-two-args for simple numeric two-argument CLIs, vector-grid for 2-D vector/grid examples. For nontrivial algorithms, you may skip scaffolding and write the complete file." + "Create a small executable Jerboa .ss starter through the verified edit path. args: {\"path\": string ending .ss, \"kind\": \"minimal-pass\" | \"cli-two-args\" | \"vector-grid\"}. Use only when a generic template clearly matches: minimal-pass for trivial scripts, cli-two-args for simple numeric two-argument CLIs, vector-grid for 2-D vector/grid examples. For nontrivial algorithms, you may skip scaffolding and write a small complete first version, then verify and expand deterministically." *obj-schema*) (lambda (args) (create-verified-jerboa-script args cwd)) '())) @@ -3063,7 +3412,7 @@ (replace-range-def (make-tool-def (make-tool-spec "replace_range" - "Replace an inclusive line range, even if the old code is unbalanced. args: {\"path\": string, \"start\": number, \"end\": number, \"content\": string}. Use this after balance/read/sed identifies a broken span and replace_def cannot parse it." + "Replace an inclusive line range, even if the old code is unbalanced. args: {\"path\": string, \"start\": number, \"end\": number, \"content\": string}. Replacement aliases accepted: new_content, new_str, new_string, replacement, body, text. Path/start/end without content does nothing. Use this after balance/read/sed identifies a broken span and replace_def cannot parse it." *obj-schema*) (lambda (args) (replace-range args cwd)) '())) @@ -3119,14 +3468,14 @@ (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") - "For a new Jerboa .ss script, create_verified_jerboa_script is optional. Use it only when one generic kind clearly matches: minimal-pass for trivial executable scripts, cli-two-args for simple numeric two-argument CLIs, and vector-grid for 2-D vector/grid examples. For nontrivial algorithms, write the complete file directly, then verify.\n" + "For a new Jerboa .ss script, create_verified_jerboa_script is optional. Use it only when one generic kind clearly matches: minimal-pass for trivial executable scripts, cli-two-args for simple numeric two-argument CLIs, and vector-grid for 2-D vector/grid examples. For nontrivial algorithms, write a small complete first version that parses and runs, verify it, then expand one function or data transformation at a time using verifier output.\n" (external-tools-instruction external-tool-defs) (scope-instruction scope) (guidance-instruction task-guidance) "Workflow:\n" "1. read any files you need to understand first.\n" - "2. edit to write or change code. Use line_edit for a known single-line repair. Use replace_def for a balanced whole function. Use replace_range when balance says the function is unbalanced and you know the line span. For existing .ss files, prefer local edits over full-file rewrites.\n" - "3. verify to run the build/tests.\n" + "2. edit to write or change code. Prefer deterministic, bounded targets: one complete file for a new script, one whole function with replace_def, one diagnosed span with replace_range, or one known line with line_edit. For existing .ss files, prefer local edits over full-file rewrites.\n" + "3. verify to run the configured build/tests. For executable CLI scripts that require args or stdin, use MCP verifiers only as syntax/API sanity checks; `verify()` is the behavioral authority.\n" "4. If verify fails, read the error, fix with edit, verify again.\n" (if terminal-on-verify? "5. A passing verify completes the run. You cannot finish on unverified code." @@ -3137,6 +3486,7 @@ ;; verify-command (default "make build") cwd (default ".") ;; write-scope (#f/all, 'none, list, or comma-separated string) ;; task-guidance (optional caller-supplied text added to the system prompt) +;; run-aliases? (#f; opt into legacy run/bash/shell inspection aliases) ;; best-of (1) max-iterations (48) max-repeated-calls (6) on-message (#f) ;; Returns the done tool's summary string, or raises the runner's condition ;; (MaxIterations / StepEnforcement / ToolExecution / NoProgress) on failure. @@ -3154,7 +3504,7 @@ (list (cons 'write-scope scope) (cons 'run-aliases? (let ((p (assoc 'run-aliases? o))) - (if p (cdr p) #t))) + (if p (cdr p) #f))) (cons 'task-guidance task-guidance) (cons 'terminal-on-verify #t)))) (ropt (list (cons 'max-iterations (or (opt-get o 'max-iterations) 48)) --- a/src/jcode/core/workflow-runner.ss +++ b/src/jcode/core/workflow-runner.ss @@ -68,11 +68,45 @@ [#t (cons 'error (condition->string e))]) (cons 'ok (fn args)))) +(def (disabled-shell-tool? name) + (or (string=? name "run") + (string=? name "bash") + (string=? name "shell"))) + +(def current-disabled-shell-tool-count (make-parameter 0)) + +(def (tool-name-available? names name) + (and (member name names) #t)) + +(def (verified-coding-workflow-tools? names) + (or (tool-name-available? names "verify") + (tool-name-available? names "edit") + (tool-name-available? names "replace_range"))) + +(def (disabled-shell-tool-message name available n) + (string-append + (format "Unknown tool '~a'. " name) + (if (> n 1) + (format + "Repeated unavailable shell tool '~a' blocked again. Stop retrying run/bash/shell. " + name) + "This workflow does not provide shell execution under run/bash/shell. ") + (if (verified-coding-workflow-tools? available) + (if (> n 1) + "Next useful tool must be verify, read/list/balance for inspection, or edit/write/line_edit/replace_def/replace_range for code changes. If a rejected draft is pending, use edit/write with complete corrected file contents. " + "Do not retry that tool name. Use verify for the configured build/test command; use read/list/balance for inspection; use edit/write/line_edit/replace_def/replace_range for code changes. ") + "Do not retry that tool name. Choose one of the available workflow tools. ") + (format "Available tools: ~a" available))) + (def (unknown-tool-outcome workflow name) - (cons 'resolution - (format "Unknown tool '~a'. Available tools: ~a" - name - (workflow-tool-names workflow)))) + (let ((available (workflow-tool-names workflow))) + (cons 'resolution + (if (disabled-shell-tool? name) + (let ((n (+ (current-disabled-shell-tool-count) 1))) + (current-disabled-shell-tool-count n) + (disabled-shell-tool-message name available n)) + (format "Unknown tool '~a'. Available tools: ~a" + name available))))) (def (reasoning-of tool-calls) (and (pair? tool-calls) (wtool-call-reasoning (car tool-calls)))) @@ -212,6 +246,7 @@ (define (emit! msg) (set! messages (append messages (list msg))) (when on-message (on-message msg))) + (current-disabled-shell-tool-count 0) ;; Step 1 — seed system prompt + user input (unless replaying history) (unless initial-msgs (emit! (make-system-message (workflow-build-system-prompt workflow prompt-vars))) --- a/src/jcode/provider/provider.ss +++ b/src/jcode/provider/provider.ss @@ -788,15 +788,22 @@ (hash-put! body "logprobs" #t) (hash-put! body "top_logprobs" 5))) -(def (skip-stream-logprobs? provider tools) - ;; Ollama's OpenAI-compatible endpoint rejects logprobs when a streaming - ;; request also carries structured tools. Keep logprobs for plain streaming - ;; and for providers that support the combination. - (and (equal? (provider-kind (provider-name provider)) "ollama") - tools +(def (structured-tools-sent? provider tools) + (and tools (not (null? tools)) (not (model-rejects-tools? (provider-model provider))))) +(def (skip-logprobs? provider tools) + ;; Local OpenAI-compatible servers can make logprobs+tools dramatically more + ;; expensive, and Ollama's compatibility endpoint may reject the combination. + ;; Keep confidence stats for plain generations and cloud providers. + (and (local-provider? (provider-name provider)) + (structured-tools-sent? provider tools))) + +(def (maybe-apply-logprobs! body provider tools) + (unless (skip-logprobs? provider tools) + (apply-logprobs! body))) + (def (mean-of lst) (and (pair? lst) (/ (apply + lst) (length lst) 1.0))) @@ -1021,7 +1028,7 @@ (hash-put! body "model" (provider-model provider)) (hash-put! body "max_tokens" 32768) (apply-sampling-to-body! body (provider-model provider) (provider-name provider)) - (apply-logprobs! body) + (maybe-apply-logprobs! body provider tools) (apply-prompt-cache-controls! body provider) (hash-put! body "messages" (map message->json messages)) (when (and tools (not (null? tools)) @@ -1678,8 +1685,7 @@ (hash-put! body "stream" #t) (hash-put! body "max_tokens" 32768) (apply-sampling-to-body! body (provider-model provider) (provider-name provider)) - (unless (skip-stream-logprobs? provider tools) - (apply-logprobs! body)) + (maybe-apply-logprobs! body provider tools) (apply-prompt-cache-controls! body provider) ;; Request usage data in stream (let ((opts (make-hash-table))) --- a/src/jcode/ui/cli.ss +++ b/src/jcode/ui/cli.ss @@ -291,7 +291,7 @@ COMMANDS: [--guidance-file FILE] add caller-supplied task context. [--json] emit final status JSON on stdout. [--status-file FILE] also write final status JSON to FILE. - [--no-run-aliases] omit run/bash/shell inspection aliases. + [--run-aliases] opt into legacy run/bash/shell inspection aliases. EXAMPLES: jcode Start interactive session jcode \"Read main.ss\" One-shot query @@ -871,7 +871,7 @@ EXAMPLES: (loop (+ i 1) (cons ch cur) words #f #f #t))))))))) (def (parse-verified-options args) - (let loop ((args args) (words '()) (bestof 1) (vcmd #f) (cwd #f) (scope #f) (run-aliases? #t) (guidance-file #f) (json? #f) (status-file #f)) + (let loop ((args args) (words '()) (bestof 1) (vcmd #f) (cwd #f) (scope #f) (run-aliases? #f) (guidance-file #f) (json? #f) (status-file #f)) (cond ((null? args) (let ((task (string-join (reverse words) " "))) @@ -894,17 +894,19 @@ EXAMPLES: (loop (cdr args) words bestof vcmd cwd scope run-aliases? guidance-file #t status-file)) ((and (equal? (car args) "--status-file") (pair? (cdr args))) (loop (cddr args) words bestof vcmd cwd scope run-aliases? guidance-file json? (cadr args))) + ((equal? (car args) "--run-aliases") + (loop (cdr args) words bestof vcmd cwd scope #t guidance-file json? status-file)) ((equal? (car args) "--no-run-aliases") (loop (cdr args) words bestof vcmd cwd scope #f guidance-file json? status-file)) (else (loop (cdr args) (cons (car args) words) bestof vcmd cwd scope run-aliases? guidance-file json? status-file))))) -;; `jcode verified <task> [--bestof K] [--verify CMD] [--cwd DIR] [--write-scope PATHS] [--guidance-file FILE] [--json] [--status-file FILE] [--no-run-aliases]` +;; `jcode verified <task> [--bestof K] [--verify CMD] [--cwd DIR] [--write-scope PATHS] [--guidance-file FILE] [--json] [--status-file FILE] [--run-aliases]` (def (verified-main args) (let-values (((task bestof vcmd cwd scope run-aliases? guidance-file json? status-file) (parse-verified-options args))) (if (string=? task "") (begin (fprintf (current-error-port) - "[ERROR] usage: jcode verified <task> [--bestof K] [--verify CMD] [--cwd DIR] [--write-scope PATHS] [--guidance-file FILE] [--json] [--status-file FILE] [--no-run-aliases]~n") + "[ERROR] usage: jcode verified <task> [--bestof K] [--verify CMD] [--cwd DIR] [--write-scope PATHS] [--guidance-file FILE] [--json] [--status-file FILE] [--run-aliases]~n") (exit 1)) (unless (run-verified-task (get-current-provider) task bestof vcmd cwd scope run-aliases? guidance-file json? status-file)