Improve verified local model repair flow
ober
713436053af0895a2a5ca4dc5c173022e77be44b
--- a/src/jcode/core/verified-run.ss +++ b/src/jcode/core/verified-run.ss @@ -503,9 +503,16 @@ (base (if diagnosis (string-append detail diagnosis) detail)) + (repair-first + (string-append + "Repair priority:\n" + "- Treat the verification output below as the behavioral authority.\n" + "- Make the smallest code edit for the concrete failing path, then call verify again.\n" + "- Do not call broad MCP or API discovery tools before that edit unless the failure is a missing API or syntax question.\n\n" + base)) (source-guidance (runtime-source-guidance base cwd)) (with-source (append-guidance-section - base "Source target guidance" source-guidance)) + repair-first "Source target guidance" source-guidance)) (mcp-advice (mcp-failure-guidance base cwd)) (with-failure (if (usable-mcp-guidance? mcp-advice) (append-guidance-section @@ -622,7 +629,7 @@ "") ".\n") ".\n") - "Use MCP tools for language, API, project-specific, or validator facts before guessing. Keep code changes through edit/write/line_edit/replace_def/replace_range and final validation through verify.\n")))) + "MCP tools are optional support for language, API, project-specific, or validator facts; caller guidance may forbid or narrow their use, and that caller guidance wins. After verify() fails, the verifier output is the repair target: make the smallest relevant edit and call verify again before broad MCP/API discovery. Use MCP after a failure only for targeted syntax or API facts that block the edit. Keep code changes through edit/write/line_edit/replace_def/replace_range and final validation through verify.\n")))) (def *tool-path-suffixes* '(".ss" ".scm" ".sls" ".md" ".txt" ".json" ".yaml" ".yml" @@ -1254,6 +1261,27 @@ (and (> n rejected-draft-inspection-limit) (rejected-draft-limit-message path content)))) +(def (numbered-line-excerpt content center before after) + (let* ((lines (string-split content #\newline)) + (len (length lines)) + (line (if center (min len (max 1 center)) 1)) + (start (max 1 (- line before))) + (end (min len (+ line after)))) + (let loop ((n start) (acc '())) + (if (> n end) + (string-append + (format "Rejected draft excerpt around line ~a (~a-~a):\n" + line start end) + (string-join (reverse acc) "\n")) + (loop (+ n 1) + (cons (format "~a: ~a" n (list-ref lines (- n 1))) + acc)))))) + +(def (balance-report-excerpt content report) + (let ((line (find-line-number-after report "line "))) + (and line + (numbered-line-excerpt content line 4 16)))) + (def (rejected-draft-read-message cwd path args) (let ((content (rejected-draft-content cwd path))) (and content @@ -1267,11 +1295,14 @@ (let ((content (rejected-draft-content cwd path))) (and content (or (note-rejected-draft-inspection! path content) - (string-append - (balance-report content path) - (or (minimal-balance-suffix-hint content path) "") - "\nRejected draft for " path - " was not written to disk; call edit with complete corrected contents after repair."))))) + (let* ((report (balance-report content path)) + (excerpt (balance-report-excerpt content report))) + (string-append + report + (or (minimal-balance-suffix-hint content path) "") + (if excerpt (string-append "\n\n" excerpt) "") + "\nRejected draft for " path + " was not written to disk; call edit with complete corrected contents after repair.")))))) (def (clear-pending-ss-create-repair! cwd path) (let ((pending (current-pending-ss-create-repair))) @@ -1353,7 +1384,7 @@ tool " refused outside the verified working directory: " path - ". Use MCP tools such as module_exports, apropos, howto, or cookbook_task_bundle for external Jerboa APIs; use read/list only for files under the current repo.")))) + ". 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.")))) (def (absolute-components->path comps) (string-append "/" (string-join comps "/"))) @@ -3476,7 +3507,7 @@ "1. read any files you need to understand first.\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" + "4. If verify fails, read the error, make the smallest implicated code edit, and verify again. Do not call broad discovery/MCP tools before that repair unless the failure is a missing API or syntax question.\n" (if terminal-on-verify? "5. A passing verify completes the run. You cannot finish on unverified code." "5. Only call done AFTER verify has passed. You cannot finish on unverified code.")))))) --- a/src/jcode/provider/provider.ss +++ b/src/jcode/provider/provider.ss @@ -560,6 +560,38 @@ (max base *local-stream-read-timeout-floor-secs*) base))) +(def *provider-wait-heartbeat-secs* 30) + +(def (call-with-local-provider-heartbeat provider url thunk) + (let-values (((_scheme host _port _path) (parse-url-parts url))) + (if (loopback-host? host) + (let ((done? (vector #f)) + (err-port (current-error-port)) + (log-lvl (current-log-level)) + (started (time-second (current-time)))) + (fork-thread + (lambda () + (parameterize ((current-error-port err-port) + (current-log-level log-lvl)) + (guard (e [#t (when (tracing?) + (log-trace logger "provider-heartbeat-died" + `((err . ,(err->string e)))))]) + (let loop () + (thread-sleep! *provider-wait-heartbeat-secs*) + (unless (vector-ref done? 0) + (log-info logger "waiting-for-local-provider" + `((provider . ,(provider-name provider)) + (model . ,(provider-model provider)) + (elapsed . ,(format "~as" + (- (time-second (current-time)) + started))))) + (loop))))))) + (dynamic-wind + (lambda () (void)) + thunk + (lambda () (vector-set! done? 0 #t)))) + (thunk)))) + ;; Streaming HTTP POST: calls line-cb with each line of the response body. ;; Used for SSE (Server-Sent Events) streaming from LLM APIs. ;; Read a (possibly chunked) HTTP body to a clean string by reading lines and @@ -977,7 +1009,9 @@ `((url . ,(redact-url url)) (headers . ,(redact-headers headers)) (body . ,body-json)))) - (let-values (((status text) (http-post-json url headers body-json))) + (let-values (((status text) + (call-with-local-provider-heartbeat provider url + (lambda () (http-post-json url headers body-json))))) (when (tracing?) (log-trace logger "openai-response" `((status . ,status) (body . ,text)))) @@ -1090,7 +1124,9 @@ `((url . ,(redact-url url)) (headers . ,(redact-headers headers)) (body . ,body-json)))) - (let-values (((status text) (http-post-json url headers body-json))) + (let-values (((status text) + (call-with-local-provider-heartbeat provider url + (lambda () (http-post-json url headers body-json))))) (when (tracing?) (log-trace logger "openai-response" `((status . ,status) (body . ,text)))) --- a/test/run.ss +++ b/test/run.ss @@ -2319,7 +2319,10 @@ (workflow-system-prompt-template wf) (lambda (s) (and (str-contains? s "External MCP tools") - (str-contains? s "jerboa_test_lookup"))))) + (str-contains? s "jerboa_test_lookup") + (str-contains? s "caller guidance wins") + (str-contains? s "After verify() fails") + (str-contains? s "before broad MCP/API discovery"))))) (register-tool! "jerboa_failure_advisor" "Fake MCP failure advisor for verified-run tests." @@ -2342,7 +2345,9 @@ (check-pred! "verified-run: MCP failure guidance augments detail" (cdr result) (lambda (s) - (and (str-contains? s "MCP failure advisor") + (and (str-contains? s "Repair priority") + (str-contains? s "Make the smallest code edit") + (str-contains? s "MCP failure advisor") (str-contains? s "MCP-FAILURE-ADVICE") (str-contains? s "MCP error fix lookup") (str-contains? s "MCP-ERROR-FIX-ADVICE") @@ -3963,7 +3968,9 @@ [(null? ys) #f] [(and (str-contains? (car ys) "Unexpected close") (str-contains? (car ys) "Rejected draft") - (str-contains? (car ys) target)) + (str-contains? (car ys) target) + (str-contains? (car ys) "Rejected draft excerpt") + (str-contains? (car ys) "3: (displayln \"draft\")))")) #t] [else (loop (cdr ys))])))) (guard (e [#t (void)]) (delete-file target-path))))