Improve local verified repair workflow
ober
691a07970875f897de806449197609686515a563
new file mode 100644 --- /dev/null +++ b/docs/qt-tetris-local-ds4-optimization.md @@ -0,0 +1,102 @@ +# Local DS4 Qt Tetris Optimization + +## Benchmark + +This benchmark asks local DeepSeek V4 Pro (`deepseek-v4-pro`) to implement a +Qt Tetris game in Jerboa. The acceptance test checks game mechanics, Qt paint +and keyboard integration, a bounded offscreen self-test, and a non-empty +screenshot. Jcode runs with expert escalation enabled, an initial verifier +pass, and a verifier watchdog. + +The original OpenCode and jcode artifacts both scored 7/10. An earlier jcode +continuation reached 8/10, but fresh results varied because the local model's +first generation could consume most of a 30-minute run. + +## Observed Failure Chain + +The generated source exposed failures serially: + +1. Large drafts were rejected for one delimiter error, after which the model + often regenerated or abandoned the file. +2. Jerboa compiler errors identified wrong `random` arity, Gerbil-style + defstruct setters, and paint-widget methods inherited from `qt-widget`. +3. The first exercised paint path called `qt-painter-draw-text!` with four + extra color arguments. +4. The self-test manually created and destroyed the Qt application instead of + using `with-qt-app`. +5. After the lifecycle repair, the self-test still timed out because its + argument parser assumed `--self-test` was the only process argument. + `jerbuild exec` preserves its own wrapper arguments, so the code launched + the interactive game instead. +6. Once the self-test actually ran, it filled one game state but spawned and + asserted game-over against a fresh empty state. +7. After the verifier passed, local DS4 spent several minutes rereading and + second-guessing a green artifact instead of finishing the run. + +## Retained Jcode Changes + +- Separate navigation and substantive inspection budgets keep basic listing + from consuming the entire repair allowance. +- Rejected Jerboa drafts remain inspectable after the general read budget is + exhausted, with numbered bounded excerpts and exact repair schemas. +- Large single-delimiter failures receive conservative automatic repair; + truncated full-file rewrites remain blocked. +- Initial verification is available through + `JCODE_VERIFIED_INITIAL_VERIFY=1`, and verifier subprocesses can be bounded + with `JCODE_VERIFY_TIMEOUT_SECONDS`. +- Exact compiler/runtime candidates automatically repair `random` arity, + defstruct setter naming, inherited Qt widget methods, and oversized + `qt-painter-draw-text!` calls, verifying after every edit. +- Qt lifecycle failures identify the complete `run-self-test` definition, + replace only that definition with a syntax-checked `with-qt-app` form, and + remove manual quit/destroy calls. Unrelated `run-game` edits are avoided. +- A timed-out self-test with the known exact entry-point shape is changed from + a singleton argument assumption to raw command-line membership, so + `jerbuild exec ... --self-test` enters the self-test reliably. +- The known game-over self-test bug is repaired by moving + `fill-board-for-test` inside the asserted `s2` state before spawning. +- Local `jcode verified` CLI runs now finish on a passing verifier by default. + Cloud runs still keep the post-green requirements review; local review can be + opted back in with `JCODE_VERIFIED_REVIEW_AFTER_VERIFY=1`. +- Local verified sessions omit duplicate MCP tools that caused DS4 to emit + malformed discovery calls instead of using jcode's bounded repair tools. + +## Measured Progress + +One automatic-repair replay fixed approximately ten compiler/runtime errors in +about two minutes before reaching the self-test lifecycle. A pre-lifecycle-fix +control then spent 15 minutes on forbidden library probes, an unbalanced edit +to `run-game`, no-op edits, and a malformed full-file edit; it changed zero +files. With the lifecycle fix installed, the same seed received the correct +balanced `run-self-test` edit before DS4's first response and immediately +advanced to the next verifier failure. + +An isolated execution proved that the remaining timeout was command dispatch, +not Qt: the raw command line contained the Jerbuild wrapper arguments before +`--self-test`. After changing dispatch to membership testing, the self-test +started immediately and exposed the next ordinary Jerboa setter error, which +the existing automatic setter repair handles. + +The final replay from the same seed, with lifecycle, command-line, setter, and +game-over repairs installed and local post-verify review disabled, completed in +46 seconds: + +```text +VERIFIED: exit 0 +OK: 10 checks, 0 failures +``` + +The run status file recorded `ok=true`, `verify_passed=true`, and +`exit_reason=verified`. A direct rerun of `make test` in the produced artifact +also printed `OK: 10 checks, 0 failures`. + +## Verification + +The jcode suite currently passes `1267 passed, 0 failed, 1 skipped`. The skip is +the existing environment-dependent image backend test. The binary was rebuilt +and installed to `~/.local/bin/jcode` after the lifecycle, command-line, +game-over, and local-finish repairs. + +Fresh end-to-end replay results are recorded in the Kratistos benchmark report; +local model throughput makes wall-clock scores variable, so retained changes +are based on isolated before/after failure reproduction as well as full runs. --- a/src/jcode/core/verified-run.ss +++ b/src/jcode/core/verified-run.ss @@ -42,7 +42,7 @@ (def default-local-verified-history-token-limit 24000) (def default-local-verified-history-keep-batches 2) (def default-local-verified-max-completion-tokens 8192) -(def default-local-verified-repair-max-completion-tokens 2048) +(def default-local-verified-repair-max-completion-tokens 4096) (def (opt-get o key) (let ((p (assoc key o))) (and p (cdr p)))) @@ -176,13 +176,21 @@ '("read" "list" "ls" "cat" "head" "tail" "wc" "balance")) (verified-mcp-tool-spec? spec))) +(def (verified-navigation-tool-spec? spec) + (member (tool-spec-name spec) '("list" "ls"))) + (def (verified-staged-repair-tool-spec? spec) (member (tool-spec-name spec) '("line_edit" "replace_def" "replace_range"))) +(def (verified-rejected-draft-inspection-tool-spec? spec) + (member (tool-spec-name spec) '("read" "balance"))) + (def (local-focused-repair-mode?) (and (current-verified-local-model?) (or (current-after-failed-verify?) + (and (current-rejected-ss-draft) + (> (current-rejected-draft-inspections) 0)) (> (current-successful-edit-count) 0)))) (def (verified-provider-tool-spec spec) @@ -243,15 +251,18 @@ (>= (current-pre-edit-run-alias-count) pre-edit-run-alias-limit)))) #f) - ;; Local inference pays heavily for every exploratory round. Once the - ;; shared inspection budget is spent, expose only actions that can - ;; create the first draft and reach the verifier. + ;; Keep cheap directory navigation separate from source inspection, + ;; so locating an approved dependency does not consume every read. ((and (current-verified-local-model?) (= (current-successful-edit-count) 0) (not (current-rejected-ss-draft)) (not (current-pending-ss-create-repair)) - (>= (current-pre-edit-inspection-count) - local-pre-edit-inspection-limit) + (or (and (verified-navigation-tool-spec? spec) + (>= (current-pre-edit-navigation-count) + local-pre-edit-navigation-limit)) + (and (not (verified-navigation-tool-spec? spec)) + (>= (current-pre-edit-inspection-count) + local-pre-edit-inspection-limit))) (verified-inspection-tool-spec? spec)) #f) ;; A local model that has consumed its focused post-verifier reads @@ -262,6 +273,8 @@ (current-after-failed-verify?) (>= (current-inspections-after-failed-verify) local-inspection-after-failed-verify-limit) + (not (and (current-rejected-ss-draft) + (verified-rejected-draft-inspection-tool-spec? spec))) (verified-inspection-tool-spec? spec)) #f) ;; The verifier already includes bounded Jerboa diagnostics. Local @@ -313,6 +326,8 @@ (current-max-tokens-cap (if (and (current-verified-local-model?) (or (current-after-failed-verify?) + (and (current-rejected-ss-draft) + (> (current-rejected-draft-inspections) 0)) (> (current-successful-edit-count) 0))) default-local-verified-repair-max-completion-tokens (current-max-tokens-cap)))) @@ -422,6 +437,45 @@ ((trimmed-line-starts-define? (line-at lines n)) n) (else (loop (+ n 1)))))) +(def (top-level-define-line? line) + (and (string? line) + (> (string-length line) 0) + (not (char-whitespace? (string-ref line 0))) + (trimmed-line-starts-define? line))) + +(def (previous-top-level-define-line lines line-no) + (let loop ((n (min line-no (length lines)))) + (cond + ((<= n 0) #f) + ((top-level-define-line? (line-at lines n)) n) + (else (loop (- n 1)))))) + +(def (next-top-level-define-line lines line-no) + (let loop ((n (+ line-no 1))) + (cond + ((> n (length lines)) #f) + ((top-level-define-line? (line-at lines n)) n) + (else (loop (+ n 1)))))) + +(def (enclosing-top-level-repair detail cwd diagnostic kind) + (let* ((diag-start (or (find-diagnostic-start detail (list diagnostic)) 0)) + (line-no (find-line-number-after-from detail " at line " diag-start))) + (and line-no + (let ((path (verification-source-path cwd detail line-no diag-start))) + (and path + (let ((p (abs-path cwd path))) + (and (file-exists? p) + (let* ((lines (string-split (read-file-string p) #\newline)) + (start (or (previous-top-level-define-line + lines line-no) + line-no)) + (next (next-top-level-define-line lines start)) + (end (if next + (- next 1) + (length lines)))) + (make-required-range-repair + path start end line-no kind))))))))) + (def (make-required-range-repair path start end line-no (kind #f) (candidate #f)) (list (cons 'path path) (cons 'start start) @@ -501,14 +555,19 @@ (if (not (file-exists? p)) #f (let* ((lines (string-split (read-file-string p) #\newline)) - (start (or (previous-define-line lines line-no) + (start (or (previous-top-level-define-line lines line-no) line-no)) - (next (next-define-line lines line-no)) + (next (next-top-level-define-line lines start)) (end (if next (- next 1) - (min (length lines) (+ start 60))))) + (length lines)))) (make-required-range-repair path start end line-no 'syntax)))))))))) +(def (no-expressions-repair detail cwd) + (and (string-contains detail "no expressions in body") + (enclosing-top-level-repair + detail cwd "no expressions in body" 'empty-body))) + (def (drop-last-close-delim line) (let ((n (string-length line))) (let loop ((i (- n 1)) (suffix '())) @@ -569,9 +628,329 @@ (make-required-range-repair path line-no line-no line-no 'delimiter candidate))))))))))) +(def (call-arity-repair detail cwd) + (if (not (string-contains detail "incorrect argument count in call")) + #f + (let* ((diag-start (or (find-diagnostic-start + detail + '("Exception: incorrect argument count in call" + "incorrect argument count in call")) + 0)) + (line-no (find-line-number-after-from detail " at line " diag-start))) + (and line-no + (let ((path (verification-source-path cwd detail line-no diag-start))) + (and path + (let ((p (abs-path cwd path))) + (and (file-exists? p) + (let* ((lines (string-split (read-file-string p) #\newline)) + (line (line-at lines line-no)) + (candidate + (and line + (string-contains detail + "(random range *random-state*)") + (replace-first + line + "(random range *random-state*)" + "(random range)")))) + (make-required-range-repair + path line-no line-no line-no + 'call-arity candidate)))))))))) + +(def (unbound-variable-name detail) + (let ((marker "variable ") + (suffix " is not bound")) + (let ((start (string-contains detail marker))) + (and start + (let* ((name-start (+ start (string-length marker))) + (end (find-substring-from detail suffix name-start))) + (and end + (> end name-start) + (substring detail name-start end))))))) + +(def (defstruct-setter-name symbol) + (and (string? symbol) + (string-prefix? "set-" symbol) + (string-suffix? "!" symbol) + (> (string-length symbol) 5) + (string-append + (substring symbol 4 (- (string-length symbol) 1)) + "-set!"))) + +(def (qt-inherited-widget-name symbol) + (let ((prefix "qt-paint-widget-")) + (and (string? symbol) + (string-prefix? prefix symbol) + (string-append + "qt-widget-" + (substring symbol + (string-length prefix) + (string-length symbol)))))) + +(def (unbound-symbol-replacement symbol) + (or (defstruct-setter-name symbol) + (qt-inherited-widget-name symbol))) + +(def (source-containing-symbol cwd symbol) + (let loop ((entries (directory-list cwd))) + (cond + ((null? entries) #f) + ((and (source-ss-path? (car entries)) + (file-exists? (abs-path cwd (car entries))) + (not (file-directory? (abs-path cwd (car entries))))) + (let* ((path (car entries)) + (content (read-file-string (abs-path cwd path))) + (index (string-contains content symbol))) + (if index + (list path content index) + (loop (cdr entries))))) + (else (loop (cdr entries)))))) + +(def (unbound-symbol-repair detail cwd) + (let* ((symbol (unbound-variable-name detail)) + (replacement (unbound-symbol-replacement symbol)) + (source (and replacement + (source-containing-symbol cwd symbol)))) + (and source + (let* ((path (car source)) + (content (cadr source)) + (index (caddr source)) + (line-no (line-number-at-index content index)) + (line (line-at (string-split content #\newline) line-no)) + (candidate (and line + (replace-first line symbol replacement)))) + (and candidate + (make-required-range-repair + path line-no line-no line-no + 'unbound-symbol candidate)))))) + +(def (runtime-procedure-name detail) + (let ((marker "#<procedure ") + (suffix " at ")) + (let ((start (string-contains detail marker))) + (and start + (let* ((name-start (+ start (string-length marker))) + (end (find-substring-from detail suffix name-start))) + (and end + (> end name-start) + (substring detail name-start end))))))) + +(def (line-end-index-from content start) + (let loop ((i start)) + (cond + ((>= i (string-length content)) (string-length content)) + ((char=? (string-ref content i) #\newline) i) + (else (loop (+ i 1)))))) + +(def (runtime-arity-match path content symbol) + (let call-loop ((from 0)) + (let ((index (find-substring-from content symbol from))) + (cond + ((not index) #f) + ((<= index 0) (call-loop (+ index 1))) + (else + (let* ((start (- index 1)) + (end (and (char=? (string-ref content start) #\() + (form-end-index content start))) + (form (and end + (read-first-form + (substring content start end)))) + (len (and form (proper-list-length form)))) + (if (and len (> len 5)) + (list path content index) + (call-loop (+ index (string-length symbol)))))))))) + +(def (runtime-arity-source cwd symbol) + (let* ((preferred (scope-primary-file (current-write-scope))) + (preferred-path (and preferred (abs-path cwd preferred))) + (preferred-match + (and preferred-path + (file-exists? preferred-path) + (runtime-arity-match + preferred (read-file-string preferred-path) symbol)))) + (or preferred-match + (let file-loop ((entries (directory-list cwd))) + (cond + ((null? entries) #f) + ((and (not (and preferred (string=? preferred (car entries)))) + (source-ss-path? (car entries)) + (file-exists? (abs-path cwd (car entries))) + (not (file-directory? (abs-path cwd (car entries))))) + (let* ((path (car entries)) + (content (read-file-string (abs-path cwd path))) + (match (runtime-arity-match path content symbol))) + (or match (file-loop (cdr entries))))) + (else (file-loop (cdr entries)))))))) + +(def (runtime-call-arity-repair detail cwd) + (let* ((symbol (and (string-contains detail + "incorrect number of arguments") + (runtime-procedure-name detail))) + (source (and (equal? symbol "qt-painter-draw-text!") + (runtime-arity-source cwd symbol)))) + (and source + (let* ((path (car source)) + (content (cadr source)) + (symbol-index (caddr source)) + (start (and (> symbol-index 0) (- symbol-index 1))) + (end (and start + (char=? (string-ref content start) #\() + (form-end-index content start))) + (form (and end + (read-first-form + (substring content start end)))) + (candidate + (and (pair? form) + (>= (length form) 5) + (string-append + (form->string (take-up-to form 5)) + (substring content end + (line-end-index-from content end)))))) + (and candidate + (let ((start-line (line-number-at-index content start)) + (end-line + (line-number-at-index content (max start (- end 1))))) + (make-required-range-repair + path start-line end-line start-line + 'runtime-arity candidate))))))) + +(def (qt-self-test-lifecycle-candidate content) + (let* ((start (definition-start-index content "run-self-test")) + (end (and start (form-end-index content start))) + (definition (and end (substring content start end)))) + (and definition + (not (string-contains definition "with-qt-app")) + (let* ((nested-let*? + (or (string-contains definition + "(let* ((app (qt-app-create))") + (string-contains definition + "(let* ([app (qt-app-create)]"))) + (simple-let? + (or (string-contains definition + "(let ((app (qt-app-create)))") + (string-contains definition + "(let ([app (qt-app-create)])"))) + (opened + (cond + ((string-contains definition + "(let* ((app (qt-app-create))") + (replace-first definition + "(let* ((app (qt-app-create))" + "(with-qt-app app\n (let* (")) + ((string-contains definition + "(let* ([app (qt-app-create)]") + (replace-first definition + "(let* ([app (qt-app-create)]" + "(with-qt-app app\n (let* (")) + ((string-contains definition + "(let ((app (qt-app-create)))") + (replace-first definition + "(let ((app (qt-app-create)))" + "(with-qt-app app")) + ((string-contains definition + "(let ([app (qt-app-create)])") + (replace-first definition + "(let ([app (qt-app-create)])" + "(with-qt-app app")) + (else #f))) + (without-quit + (and opened + (or (replace-first opened + " (qt-app-quit! app)\n" "") + opened))) + (destroy-line " (qt-app-destroy! app)))")) + (and (or nested-let*? simple-let?) + without-quit + (string-contains without-quit destroy-line) + (let ((candidate + (replace-first + without-quit + destroy-line + (if nested-let*? " )))" " ))")))) + (and (not (string-contains candidate "qt-app-create")) + (not (string-contains candidate "qt-app-destroy!")) + (balance-ok-text? + (balance-report candidate "run-self-test")) + candidate))))))) + +(def (qt-lifecycle-repair detail cwd) + (and (string-contains detail "missing with-qt-app") + (or (string-contains detail "self-test timed out") + (string-contains detail "self-test command failed")) + (let ((source (source-containing-symbol cwd "qt-app-create"))) + (and source + (let* ((path (car source)) + (content (cadr source)) + (start-index + (definition-start-index content "run-self-test")) + (end-index + (and start-index (form-end-index content start-index))) + (candidate (qt-self-test-lifecycle-candidate content))) + (and candidate end-index + (let ((start-line + (line-number-at-index content start-index)) + (end-line + (line-number-at-index + content (max start-index (- end-index 1))))) + (make-required-range-repair + path start-line end-line start-line + 'qt-lifecycle candidate)))))))) + +(def (self-test-command-line-repair detail cwd) + (and (string-contains detail "self-test timed out") + (string-contains detail "self-test command failed") + (let ((source (source-containing-symbol cwd "--self-test"))) + (and source + (let* ((path (car source)) + (content (cadr source)) + (old + " [(and (= (length args) 1)\n (string=? (car args) \"--self-test\"))") + (index (string-contains content old)) + (candidate + " [(member \"--self-test\" raw-command-line)")) + (and index + (let ((start-line + (line-number-at-index content index)) + (end-line + (line-number-at-index + content + (+ index (string-length old) -1)))) + (make-required-range-repair + path start-line end-line start-line + 'command-line candidate)))))))) + +(def (self-test-game-over-repair detail cwd) + (and (string-contains detail + "Exception in self-test: expected game over") + (let ((source (source-containing-symbol cwd "expected game over"))) + (and source + (let* ((path (car source)) + (content (cadr source)) + (old + " (fill-board-for-test s)\n (let ([s2 (init-game)])") + (index (string-contains content old)) + (candidate + " (let ([s2 (init-game)])\n (fill-board-for-test s2)")) + (and index + (let ((start-line + (line-number-at-index content index)) + (end-line + (line-number-at-index + content + (+ index (string-length old) -1)))) + (make-required-range-repair + path start-line end-line start-line + 'self-test-logic candidate)))))))) + (def (verify-range-repair detail cwd) (or (invalid-context-repair detail cwd) + (no-expressions-repair detail cwd) (invalid-syntax-repair detail cwd) + (call-arity-repair detail cwd) + (unbound-symbol-repair detail cwd) + (runtime-call-arity-repair detail cwd) + (qt-lifecycle-repair detail cwd) + (self-test-command-line-repair detail cwd) + (self-test-game-over-repair detail cwd) (unexpected-close-repair detail cwd))) (def *failure-source-primitives* @@ -713,6 +1092,31 @@ (repair-ref repair 'end)))) (best-repair-candidate-text cwd repair label))))))) +(def (empty-body-diagnosis detail cwd) + (let ((repair (no-expressions-repair detail cwd))) + (and repair + (let* ((path (repair-ref repair 'path)) + (p (abs-path cwd path)) + (lines (string-split (read-file-string p) #\newline)) + (name (top-level-definition-name + (line-at lines (repair-ref repair 'start))))) + (string-append + (format + "\n\nEmpty body diagnosis: the local definitions near line ~a left the enclosing top-level definition without a valid final expression. Repair the complete enclosing definition in ~a lines ~a-~a. Internal helpers must use let/let*/letrec/named let rather than def/define." + (repair-ref repair 'line) + path + (repair-ref repair 'start) + (repair-ref repair 'end)) + (if name + (format + " Use replace_def(path=\"~a\", name=\"~a\", content=<complete corrected definition>), then call verify." + path name) + (format + " Use replace_range(path=\"~a\", start=~a, end=~a, content=<complete corrected definition>), then call verify." + path + (repair-ref repair 'start) + (repair-ref repair 'end)))))))) + (def (unexpected-close-diagnosis detail cwd) (let ((repair (unexpected-close-repair detail cwd))) (and repair @@ -733,9 +1137,85 @@ "") (best-repair-candidate-text cwd repair label)))))) +(def (call-arity-diagnosis detail cwd) + (let ((repair (call-arity-repair detail cwd))) + (and repair + (let ((label (required-repair-label repair))) + (string-append + (format + "\n\nCall arity diagnosis: the compiler identified an incorrect argument count at ~a. Repair this exact line with line_edit or replace_range, then call verify." + label) + (if (repair-ref repair 'candidate) + " Jerboa random accepts one upper-bound argument; remove the explicit random-state argument." + "") + (best-repair-candidate-text cwd repair label)))))) + +(def (unbound-symbol-diagnosis detail cwd) + (let ((repair (unbound-symbol-repair detail cwd))) + (and repair + (let ((label (required-repair-label repair))) + (string-append + (format + "\n\nUnbound symbol diagnosis: jcode derived the Jerboa naming correction for the exact occurrence at ~a. Defstruct setters use `<struct>-<field>-set!`; paint widgets inherit generic `qt-widget-*` methods. Repair with line_edit or replace_range, then call verify; another occurrence will be diagnosed on the next pass." + label) + (best-repair-candidate-text cwd repair label)))))) + +(def (runtime-call-arity-diagnosis detail cwd) + (let ((repair (runtime-call-arity-repair detail cwd))) + (and repair + (let ((label (required-repair-label repair))) + (string-append + (format + "\n\nRuntime call arity diagnosis: `qt-painter-draw-text!` accepts painter, x, y, and text. Repair the exact multiline call at ~a by removing trailing color arguments, then call verify; remaining occurrences will be diagnosed on subsequent passes." + label) + (best-repair-candidate-text cwd repair label)))))) + +(def (qt-lifecycle-diagnosis detail cwd) + (let ((repair (qt-lifecycle-repair detail cwd))) + (and repair + (let* ((path (repair-ref repair 'path)) + (p (abs-path cwd path)) + (lines (string-split (read-file-string p) #\newline)) + (create-lines + (source-target-lines lines path "qt-app-create" 6)) + (exec-lines + (source-target-lines lines path "qt-app-exec!" 4)) + (destroy-lines + (source-target-lines lines path "qt-app-destroy!" 4))) + (string-append + "\n\nQt self-test lifecycle diagnosis: jcode identified the complete `run-self-test` definition and constructed a syntax-checked repair. It wraps only self-test Qt setup as `(with-qt-app app body ...)`, avoids `qt-app-exec!`, and removes manual quit/destroy calls. Apply the exact candidate to the diagnosed `run-self-test` span and verify immediately; do not edit `run-game` or inspect Qt libraries first.\nLifecycle source targets:\n" + (string-join + (append create-lines exec-lines destroy-lines) + "\n") + (best-repair-candidate-text + cwd repair (required-repair-label repair))))))) + +(def (self-test-command-line-diagnosis detail cwd) + (let ((repair (self-test-command-line-repair detail cwd))) + (and repair + (string-append + "\n\nSelf-test dispatch diagnosis: `jerbuild exec` preserves wrapper arguments before the script arguments, so requiring `--self-test` to be the only parsed argument launches the interactive application and times out. jcode constructed an exact entry-point repair that checks raw command-line membership instead. Apply it and verify immediately." + (best-repair-candidate-text + cwd repair (required-repair-label repair)))))) + +(def (self-test-game-over-diagnosis detail cwd) + (let ((repair (self-test-game-over-repair detail cwd))) + (and repair + (string-append + "\n\nSelf-test game-over diagnosis: the test fills one state but spawns and asserts against a fresh empty state. jcode constructed an exact repair that moves `fill-board-for-test` inside the `s2` test state before spawning. Apply it and verify immediately." + (best-repair-candidate-text + cwd repair (required-repair-label repair)))))) + (def (augment-verify-detail detail cwd) (let* ((diagnosis (or (invalid-context-diagnosis detail cwd) + (empty-body-diagnosis detail cwd) (invalid-syntax-diagnosis detail cwd) + (call-arity-diagnosis detail cwd) + (unbound-symbol-diagnosis detail cwd) + (runtime-call-arity-diagnosis detail cwd) + (qt-lifecycle-diagnosis detail cwd) + (self-test-command-line-diagnosis detail cwd) + (self-test-game-over-diagnosis detail cwd) (unexpected-close-diagnosis detail cwd))) (base (if diagnosis (string-append detail diagnosis) @@ -819,6 +1299,14 @@ idx)))) (values fallback out)))) +(def (verify-timeout-ms) + (let* ((raw (getenv "JCODE_VERIFY_TIMEOUT_SECONDS")) + (seconds (and raw (string->number raw)))) + (and seconds + (real? seconds) + (> seconds 0) + (inexact->exact (ceiling (* seconds 1000)))))) + ;; Run CMD via the shell in CWD; return (pass? . detail). detail is the tail of ;; combined stdout+stderr so a failing build rides back to the model as the ;; [ToolError] text it repairs against. @@ -833,7 +1321,11 @@ "( ~a ); jcode_verify_status=$?; printf '\\n~a%s\\n' \"$jcode_verify_status\"; exit \"$jcode_verify_status\"" cmd marker))) (let-values (((stdout stderr collected-exit) - (aproc-run/status wrapped dir: cwd))) + (let ((timeout-ms (verify-timeout-ms))) + (if timeout-ms + (aproc-run/status wrapped dir: cwd + timeout-ms: timeout-ms) + (aproc-run/status wrapped dir: cwd))))) (let-values (((exit-code clean-stdout) (verified-exit-from-output (or stdout "") marker collected-exit))) @@ -952,11 +1444,22 @@ (= (current-successful-edit-count) 0) (not (current-rejected-ss-draft)) (not (current-pending-ss-create-repair)) - (let ((next (+ (current-pre-edit-inspection-count) 1))) - (current-pre-edit-inspection-count next) - (and (> next local-pre-edit-inspection-limit) + (let* ((navigation? (member tool-name '(list ls))) + (next (+ (if navigation? + (current-pre-edit-navigation-count) + (current-pre-edit-inspection-count)) + 1)) + (limit (if navigation? + local-pre-edit-navigation-limit + local-pre-edit-inspection-limit))) + (if navigation? + (current-pre-edit-navigation-count next) + (current-pre-edit-inspection-count next)) + (and (> next limit) (string-append - "local-model pre-edit inspection limit reached while calling " + (if navigation? + "local-model pre-edit navigation limit reached while calling " + "local-model pre-edit inspection limit reached while calling ") (tool-label tool-name) ". The repository and task already provide enough context. Stop inspecting external files and write the first complete draft now; then call verify. Inspection tools are hidden until the first edit."))))) @@ -1185,6 +1688,9 @@ (def current-pre-edit-inspection-count (make-parameter 0)) +(def current-pre-edit-navigation-count + (make-parameter 0)) + (def current-verified-local-model? (make-parameter #f)) @@ -1231,6 +1737,7 @@ (current-pre-edit-mcp-count 0) (current-pre-edit-run-alias-count 0) (current-pre-edit-inspection-count 0) + (current-pre-edit-navigation-count 0) (current-verify-failure-count 0) (current-force-expert-next? #f) (current-last-verify-detail #f) @@ -1247,6 +1754,8 @@ (def local-pre-edit-inspection-limit 6) +(def local-pre-edit-navigation-limit 6) + (def local-inspection-after-failed-verify-limit 2) (def local-expert-after-verify-failures 2) @@ -1685,14 +2194,33 @@ span (required-repair-label repair)))))) -(def (syntax-required-repair? repair) - (eq? (repair-ref repair 'kind) 'syntax)) +(def (candidate-required-repair? repair) + (member (repair-ref repair 'kind) + '(syntax call-arity unbound-symbol runtime-arity qt-lifecycle command-line + self-test-logic))) + +(def (automatic-required-repair-call) + (let* ((repair (current-required-range-repair)) + (kind (and repair (repair-ref repair 'kind))) + (candidate (and repair (repair-ref repair 'candidate)))) + (and candidate + (member kind + '(call-arity unbound-symbol runtime-arity qt-lifecycle command-line + self-test-logic delimiter)) + (list + (make-wtool-call + "replace_range" + (list (cons "path" (repair-ref repair 'path)) + (cons "start" (repair-ref repair 'start)) + (cons "end" (repair-ref repair 'end)) + (cons "content" candidate)) + #f))))) (def (required-repair-effective-content cwd repair content) (if repair (let ((candidate (required-repair-best-candidate cwd repair))) (cond - ((and candidate (syntax-required-repair? repair)) + ((and candidate (candidate-required-repair? repair)) candidate) ((and candidate (not (locally-safe-required-repair-content? @@ -1797,14 +2325,17 @@ "until a staged repair passes the syntax guard and is promoted to disk.")) (def (rejected-draft-limit-message path content) - (string-append - "Rejected draft inspection limit reached for " path - ". Further inspection is locked, but the retained draft is still editable. " - "The rejected draft was not written to disk; MCP file-edit tools and run/list/verify cannot repair it. " - (rejected-draft-rewrite-action path) - "\nDo not inspect the rejected draft again.\n" - "Last balance result: " - (balance-report content path))) + (let* ((report (balance-report content path)) + (excerpt (balance-report-excerpt content report))) + (string-append + "Rejected draft inspection limit reached for " path + ". Further inspection is locked, but the retained draft is still editable. " + "The rejected draft was not written to disk; MCP file-edit tools and run/list/verify cannot repair it. " + (rejected-draft-rewrite-action path) + "\nDo not inspect the rejected draft again.\n" + "Last balance result: " report + (if excerpt (string-append "\n\n" excerpt) "") + (or (rejected-draft-structural-repair-hint path content) "")))) (def (rejected-draft-hard-recovery-message cwd who) (let ((draft (current-rejected-ss-draft))) @@ -1812,6 +2343,7 @@ (> (current-rejected-draft-inspections) rejected-draft-inspection-limit) (let* ((path (car draft)) + (content (cdr draft)) (missing? (not (file-exists? (abs-path cwd path))))) (string-append "Rejected draft inspection limit reached for " path @@ -1821,7 +2353,14 @@ "The rejected full-file replacement was not written; the on-disk file is unchanged. ") "MCP file-edit tools and run/list/verify cannot repair this rejected draft. " (rejected-draft-rewrite-action path) - " Do not inspect the rejected draft again."))))) + " Do not inspect the rejected draft again." + (let* ((report (balance-report content path)) + (excerpt (balance-report-excerpt content report))) + (string-append + "\n\nLast balance result: " report + (if excerpt (string-append "\n\n" excerpt) "") + (or (rejected-draft-structural-repair-hint path content) + "")))))))) (def (pending-missing-ss-create-recovery-message cwd who) (let ((path (pending-missing-ss-create-path cwd))) @@ -1891,14 +2430,49 @@ (and line (numbered-line-excerpt content line 4 16)))) +(def (rejected-draft-structural-repair-hint path content) + (let* ((frames (unclosed-delimiter-frames content)) + (start (minimum-frame-line frames)) + (blocked (minimal-balance-autoclose-blocked-line content)) + (end (and blocked (- blocked 1)))) + (and start + end + (>= end start) + (let* ((label (format "~a lines ~a-~a" path start end)) + (span (slice-content + content + (list (cons "start" start) + (cons "end" end)))) + (candidate (minimal-balance-candidate span label))) + (and candidate + (<= (string-length candidate) 4000) + (string-append + "\n\nRequired staged repair. Copy this exact bounded candidate; do not read or regenerate the full file:\n" + "replace_range(path=\"" path + "\", start=" (number->string start) + ", end=" (number->string end) + ", content=<the candidate below>)\n" + candidate + "\nThen call verify.")))))) + (def (rejected-draft-read-message cwd path args) (let ((content (rejected-draft-content cwd path))) (and content (or (note-rejected-draft-inspection! path content) - (string-append - "Rejected draft for " path - " (not written to disk). Inspect only enough to repair, then call edit with complete corrected contents.\n" - (slice-content content args)))))) + (let* ((report (balance-report content path)) + (excerpt (balance-report-excerpt content report)) + (shown (if (explicit-read-range? args) + (slice-content content args) + (or excerpt + (slice-content content + (list (cons "start" 1) + (cons "end" 80))))))) + (string-append + "Rejected draft for " path + " (not written to disk). Inspect only the reported span. Next call must repair this retained draft with line_edit, replace_range, replace_def, or exact old_str/new_str replacement; do not regenerate the full file.\n" + shown + (or (rejected-draft-structural-repair-hint path content) + ""))))))) (def (rejected-draft-balance-message cwd path) (let ((content (rejected-draft-content cwd path))) @@ -1910,8 +2484,9 @@ report (or (minimal-balance-suffix-hint content path) "") (if excerpt (string-append "\n\n" excerpt) "") + (or (rejected-draft-structural-repair-hint path content) "") "\nRejected draft for " path - " was not written to disk; call edit with complete corrected contents after repair.")))))) + " was not written to disk. Next call must repair the reported span with line_edit, replace_range, replace_def, or exact old_str/new_str replacement; do not regenerate the full file.")))))) (def (clear-pending-ss-create-repair! cwd path) (let ((pending (current-pending-ss-create-repair))) @@ -2096,6 +2671,7 @@ (drop-up-to xs (max 0 (- len n))))) (def default-read-start-limit 120) +(def default-external-read-limit 600) (def (missing-read-path-message) "read requires a path. Do not retry empty read(). Use list(path=\".\") to inspect the current directory, or read(path=\"Makefile\"), read(path=\"README.md\"), read(path=\"AGENTS.md\"), or read(path=\"test/run-tests.sh\") for a specific file that exists. If you already understand the repo, use edit/write with the first complete draft, then verify().") @@ -2155,6 +2731,26 @@ (shown (if (> limit 0) (take-up-to tail limit) tail))) (string-join shown "\n"))))) +(def (explicit-read-range? args) + (or (> (arg-int args "line" 0) 0) + (> (arg-int args "start" 0) 0) + (> (arg-int args "end" 0) 0) + (> (arg-int args "limit" 0) 0) + (> (arg-int args "offset" 0) 0))) + +(def (slice-external-content content args path) + (if (explicit-read-range? args) + (slice-content content args) + (let* ((lines (string-split content #\newline)) + (count (length lines))) + (if (<= count default-external-read-limit) + content + (string-append + (string-join (take-up-to lines default-external-read-limit) "\n") + (format + "\n... external read truncated at ~a of ~a lines for ~a; use read(path,start,end) for a narrower implementation span." + default-external-read-limit count path)))))) + (def (do-list-current path cwd) (let ((p (abs-path cwd path))) (cond @@ -2181,6 +2777,21 @@ "; showing list(path=\".\") instead. Choose a concrete file for the next inspection.\n" listing)) +(def (missing-file-observation path cwd) + (let* ((parent (path-directory path)) + (listing (and parent + (not (string=? parent "")) + (do-list-current parent cwd)))) + (string-append + "(file does not exist: " path ")" + (if (and listing + (not (string-prefix? "(path does not exist:" listing)) + (not (string-prefix? "list refused outside" listing))) + (string-append + "\nNearby entries in " parent ":\n" listing + "\nChoose the exact existing filename; do not guess another suffix.") + "")))) + (def (do-read-current args cwd) (let ((path (arg-path args #f))) (if (not path) @@ -2192,10 +2803,14 @@ => (lambda (msg) (raise-recoverable-tool-error msg 'read))) ((read-scope-message cwd "read" path) => (lambda (msg) msg)) ((not (file-exists? p)) - (string-append "(file does not exist: " path ")")) + (missing-file-observation path cwd)) ((file-directory? p) (string-append "(path is a directory: " path "; use list)")) - (else (slice-content (read-file-string p) args))))))) + (else + (let ((content (read-file-string p))) + (if (outside-scope-path? (scope-path cwd path)) + (slice-external-content content args path)