Steer local staged create repairs
Jaime Fournier <jaimef@linbsd.org>
c723fae807c3ed51218a8203d3fdea0b6316f12a
diff --git a/src/jcode/core/verified-run.ss b/src/jcode/core/verified-run.ss
index 574c6f9..011d946 100644
--- a/src/jcode/core/verified-run.ss
+++ b/src/jcode/core/verified-run.ss
@@ -213,8 +213,13 @@
(verified-syntax-create-staged-tool-spec? spec)
((if (current-pending-ss-create-repair)
verified-missing-create-staged-tool-spec?
- verified-staged-repair-tool-spec?)
- spec)))
+ verified-staged-repair-tool-spec?)
+ spec)))
+
+(def (syntax-broken-missing-create-repair-mode?)
+ (and (current-pending-ss-create-repair)
+ (current-rejected-ss-draft)
+ (not (incomplete-rejected-ss-create-draft?))))
(def (verified-rejected-draft-inspection-tool-spec? spec)
(member (tool-spec-name spec) '("read" "balance")))
@@ -439,6 +444,15 @@
(tool-specs-include? specs "edit")
(openai-function-tool-choice "edit")))
+(def (force-staged-create-repair-tool-name specs)
+ (and (current-verified-local-model?)
+ (syntax-broken-missing-create-repair-mode?)
+ (cond
+ ((tool-specs-include? specs "line_edit") "line_edit")
+ ((tool-specs-include? specs "replace_range") "replace_range")
+ ((tool-specs-include? specs "replace_def") "replace_def")
+ (else #f))))
+
(def (forced-first-edit-specs specs forced-choice)
(if forced-choice
(filter (lambda (spec)
@@ -446,19 +460,22 @@
specs)
specs))
-(def (forced-first-edit-response response forced-choice)
+(def (forced-tool-choice-response response forced-choice allowed-tools)
(if (and forced-choice
- (pair? response)
- (let loop ((xs response))
- (cond
- ((null? xs) #f)
- ((not (and (wtool-call? (car xs))
- (member (wtool-call-tool (car xs))
- '("edit" "write"))))
- #t)
- (else (loop (cdr xs))))))
- (make-text-response "JCODE_INTERNAL_FORCE_FIRST_EDIT_RETRY")
- response))
+ (pair? response)
+ (let loop ((xs response))
+ (cond
+ ((null? xs) #f)
+ ((not (and (wtool-call? (car xs))
+ (member (wtool-call-tool (car xs))
+ allowed-tools)))
+ #t)
+ (else (loop (cdr xs))))))
+ (make-text-response "JCODE_INTERNAL_FORCE_FIRST_EDIT_RETRY")
+ response))
+
+(def (forced-first-edit-response response forced-choice)
+ (forced-tool-choice-response response forced-choice '("edit" "write")))
(def (forced-first-edit-messages messages specs forced-specs)
(with-visible-tool-system-note messages specs forced-specs))
@@ -491,17 +508,33 @@
default-verified-repair-max-completion-tokens)
(else
(current-max-tokens-cap)))))
- (if (procedure? provider)
- (let* ((specs (verified-provider-tool-specs tool-specs))
- (forced-choice (and (not (current-verified-local-model?))
- (force-first-edit-tool-choice specs)))
- (forced-specs (forced-first-edit-specs specs forced-choice)))
- (forced-first-edit-response
- (backend (forced-first-edit-messages
- messages specs forced-specs)
- forced-specs
- step)
- forced-choice))
+ (if (procedure? provider)
+ (let* ((specs (verified-provider-tool-specs tool-specs))
+ (staged-tool
+ (force-staged-create-repair-tool-name specs))
+ (staged-choice
+ (and staged-tool
+ (openai-function-tool-choice staged-tool)))
+ (forced-choice
+ (or staged-choice
+ (and (not (current-verified-local-model?))
+ (force-first-edit-tool-choice specs))))
+ (forced-specs
+ (if staged-tool
+ (filter verified-current-staged-repair-tool-spec?
+ specs)
+ (forced-first-edit-specs specs forced-choice))))
+ (if staged-tool
+ (backend (forced-first-edit-messages
+ messages specs forced-specs)
+ forced-specs
+ step)
+ (forced-first-edit-response
+ (backend (forced-first-edit-messages
+ messages specs forced-specs)
+ forced-specs
+ step)
+ forced-choice)))
(let* ((sticky-rejected-draft?
(and (current-verified-local-model?)
(current-rejected-ss-draft)
@@ -522,19 +555,33 @@
((make-provider-backend
(get-expert-provider) chat-direct-via-stream)
messages specs #f))
- (let* ((forced-choice (force-first-edit-tool-choice specs))
- (forced-specs
- (forced-first-edit-specs specs forced-choice)))
- (parameterize
- ((current-tool-choice-override
- (and (specified-tool-choice-supported? provider)
+ (let* ((first-edit-choice (force-first-edit-tool-choice specs))
+ (staged-tool
+ (force-staged-create-repair-tool-name specs))
+ (staged-choice
+ (and staged-tool
+ (openai-function-tool-choice staged-tool)))
+ (forced-choice (or staged-choice first-edit-choice))
+ (forced-specs
+ (if staged-tool
+ (filter verified-current-staged-repair-tool-spec?
+ specs)
+ (forced-first-edit-specs specs forced-choice))))
+ (parameterize
+ ((current-tool-choice-override
+ (and (specified-tool-choice-supported? provider)
forced-choice)))
- (forced-first-edit-response
- (backend (forced-first-edit-messages
- messages specs forced-specs)
- forced-specs
- #f)
- forced-choice)))))))))))
+ (if staged-tool
+ (backend (forced-first-edit-messages
+ messages specs forced-specs)
+ forced-specs
+ #f)
+ (forced-first-edit-response
+ (backend (forced-first-edit-messages
+ messages specs forced-specs)
+ forced-specs
+ #f)
+ forced-choice))))))))))))
;; ── verify oracle ──────────────────────────────────────────────────────
(def (tail-lines s n)
@@ -2766,6 +2813,68 @@
" was rejected by the Jerboa syntax guard and the file still does not exist. "
(ss-repair-instruction path)))))
+(def (staged-create-hidden-write-message cwd name available)
+ (let ((path (pending-missing-ss-create-path cwd)))
+ (and path
+ (current-verified-local-model?)
+ (current-rejected-ss-draft)
+ (not (incomplete-rejected-ss-create-draft?))
+ (member name '("edit" "write"))
+ (string-append
+ "Unknown tool '" name
+ "' in retained missing-file draft repair mode. The full-file "
+ name
+ " tool is intentionally unavailable right now because the previous "
+ "complete create for "
+ path
+ " was syntax-rejected and retained as an editable staged draft. "
+ "Do not resend the whole file. Use only the currently available "
+ "structured repair tools: "
+ (string-join available ", ")
+ ". Next call should be line_edit(path=\""
+ path
+ "\", line=<reported line>, content=<complete corrected line>) "
+ "for a one-line diagnostic, or replace_range(path=\""
+ path
+ "\", start=<start>, end=<end>, content=<complete corrected span>) "
+ "for a structural span. The file does not exist on disk until the "
+ "staged repair passes the syntax guard; do not call verify, read, "
+ "list, balance, MCP, edit, or write before that repair is promoted."))))
+
+(def (staged-create-broad-write-block-message cwd name args)
+ (let* ((path (pending-missing-ss-create-path cwd))
+ (requested-path (arg-path args #f))
+ (content (arg-content args))
+ (line-no (arg-int args "line" 0))
+ (old-str (or (arg-ref args "old_str" #f)
+ (arg-ref args "old_string" #f))))
+ (and path
+ (current-verified-local-model?)
+ (current-rejected-ss-draft)
+ (not (incomplete-rejected-ss-create-draft?))
+ requested-path
+ content
+ (not old-str)
+ (<= line-no 0)
+ (same-verified-path? cwd requested-path path)
+ (string-append
+ "Full-file "
+ (tool-label name)
+ " is unavailable for "
+ path
+ " while a syntax-broken missing-file create is retained as an "
+ "editable staged draft. The submitted full body was not written. "
+ "Do not resend or regenerate the whole file. Use line_edit(path=\""
+ path
+ "\", line=<reported line>, content=<complete corrected line>) for "
+ "a one-line diagnostic, replace_range(path=\""
+ path
+ "\", start=<start>, end=<end>, content=<complete corrected span>) "
+ "for a structural span, replace_def for one top-level definition, "
+ "or exact old_str/new_str replacement against the retained draft. "
+ "The file does not exist on disk until the staged repair passes the "
+ "syntax guard and is promoted."))))
+
(def (pending-existing-rejected-draft-message cwd who)
(let ((draft (current-rejected-ss-draft)))
(and (pair? draft)
@@ -6096,14 +6205,28 @@
"Edit a file. Full write args: {\"path\": string, \"content\": string}; \"file\", \"filename\", \"file_path\", \"filepath\", \"target\", and \"target_path\" are accepted as path aliases. \"file\" is still accepted as a content alias when a separate path is present. \"contents\", \"new_content\", \"body\", and \"text\" are accepted as content aliases. Exact replacement args: {\"path\": string, \"old_str\": string, \"new_str\": string}; old_string/new_string are accepted aliases; \"content\" may be used instead of \"new_str\" when \"old_str\" is present. Line replacement args: {\"path\": string, \"line\": number, \"content\": string}."
(parameterize ((current-write-scope scope))
(scoped-edit-schema)))
- (scoped-tool (lambda (args) (do-edit args cwd))) '()))
+ (scoped-tool
+ (lambda (args)
+ (let ((msg (staged-create-broad-write-block-message
+ cwd 'edit args)))
+ (if msg
+ (raise-recoverable-tool-error msg 'edit)
+ (do-edit args cwd)))))
+ '()))
(write-def
(make-tool-def
(make-tool-spec "write"
"Alias for edit. Full write args: {\"path\": string, \"content\": string}. Exact replacement accepts old_str/new_str or old_string/new_string. \"file\" is accepted as a path alias and content/file/body/text aliases are accepted like edit."
(parameterize ((current-write-scope scope))
(scoped-write-schema)))
- (scoped-tool (lambda (args) (do-edit args cwd))) '()))
+ (scoped-tool
+ (lambda (args)
+ (let ((msg (staged-create-broad-write-block-message
+ cwd 'write args)))
+ (if msg
+ (raise-recoverable-tool-error msg 'write)
+ (do-edit args cwd)))))
+ '()))
(line-edit-def
(make-tool-def
(make-tool-spec "line_edit"
@@ -6612,10 +6735,14 @@
(local-verified-first-draft-cap)))
(current-verify-failure-count 0)
(current-force-expert-next? #f)
- (current-serving-forced-expert? #f)
- (current-last-verify-detail #f)
- (current-required-range-repair #f)
- (current-required-repair-inspections 0))
+ (current-serving-forced-expert? #f)
+ (current-last-verify-detail #f)
+ (current-required-range-repair #f)
+ (current-required-repair-inspections 0)
+ (current-unknown-tool-recovery
+ (lambda (name available)
+ (staged-create-hidden-write-message
+ cwd name available))))
(reset-verified-attempt-state!)
(let ((summary
(if (> k 1)
diff --git a/src/jcode/core/workflow-runner.ss b/src/jcode/core/workflow-runner.ss
index 4d74a24..9361722 100644
--- a/src/jcode/core/workflow-runner.ss
+++ b/src/jcode/core/workflow-runner.ss
@@ -29,7 +29,8 @@
(export run-workflow
compact-verified-history
- with-visible-tool-system-note)
+ with-visible-tool-system-note
+ current-unknown-tool-recovery)
(import :jcode/core/workflow
:jcode/core/steps
@@ -121,6 +122,8 @@
(def (tool-name-available? names name)
(and (member name names) #t))
+(def current-unknown-tool-recovery (make-parameter #f))
+
(def (tool-spec-name-list specs)
(map tool-spec-name specs))
@@ -149,6 +152,8 @@
(car maybe-available)
(workflow-tool-names workflow))))
(cons 'resolution
+ (let ((handler (current-unknown-tool-recovery)))
+ (or (and handler (handler name available))
(if (disabled-shell-tool? name)
(let ((n (+ (current-disabled-shell-tool-count) 1)))
(current-disabled-shell-tool-count n)
@@ -161,7 +166,7 @@
"Call verify again; only then call done. "
(format "Available tools: ~a" available))
(format "Unknown tool '~a'. Available tools: ~a"
- name available))))))
+ name available))))))))
(def (reasoning-of tool-calls)
(and (pair? tool-calls) (wtool-call-reasoning (car tool-calls))))
diff --git a/test/run.ss b/test/run.ss
index 9fe77e6..9eda443 100644
--- a/test/run.ss
+++ b/test/run.ss
@@ -8034,20 +8034,82 @@
result "VERIFIED: exit 0\n")
(check! "verified-run: syntax create staged repair writes file"
(slurp target-path) (string-append fixed "\n"))
- (check-pred! "verified-run: syntax create staged schema hides full writes"
- (reverse seen-specs)
- (lambda (xs)
- (and (>= (length xs) 2)
- (let ([names (list-ref xs 1)])
- (and (member "line_edit" names)
- (member "replace_range" names)
- (not (member "write" names))
- (not (member "edit" names))
- (not (member "verify" names))))))))
- (safe-delete-test-file! target-path))
+ (check-pred! "verified-run: syntax create staged schema hides full writes"
+ (reverse seen-specs)
+ (lambda (xs)
+ (and (>= (length xs) 2)
+ (let ([names (list-ref xs 1)])
+ (and (member "line_edit" names)
+ (member "replace_range" names)
+ (not (member "write" names))
+ (not (member "edit" names))
+ (not (member "verify" names))))))))
+ (safe-delete-test-file! target-path))
- (let* ([vr-dir "/tmp"]
- [target "jcode-verified-replace-range.ss"]
+ (let* ([vr-dir "/tmp"]
+ [target "jcode-verified-hidden-write-after-syntax-create.ss"]
+ [target-path (string-append vr-dir "/" target)]
+ [broken "(import (jerboa prelude))\n(def (main)\n (list-set! xs 0 #t)\n (displayln \"fixed\"))\n(main)\n"]
+ [ignored "(import (jerboa prelude))\n(def (main)\n (displayln \"ignored\"))\n(main)\n"]
+ [tool-results '()]
+ [i 0]
+ [slurp (lambda (p) (call-with-input-file p (lambda (in) (get-string-all in))))])
+ (safe-delete-test-file! target-path)
+ (let* ([scope (parse-write-scope target)]
+ [provider
+ (lambda (_messages _tool-specs _step)
+ (set! i (+ i 1))
+ (cond
+ [(= i 1)
+ (list (make-wtool-call "write"
+ (list (cons "path" target)
+ (cons "content" broken)) #f))]
+ [(= i 2)
+ (list (make-wtool-call "write"
+ (list (cons "path" target)
+ (cons "content" ignored)) #f))]
+ [(= i 3)
+ (list (make-wtool-call "line_edit"
+ (list (cons "path" target)
+ (cons "line" 3)
+ (cons "content" " (displayln \"fixed\")")) #f))]
+ [else
+ (error 'test "hidden write recovery should auto-verify")]))]
+ [result (verified-run provider
+ "recover hidden write after syntax-broken missing create"
+ (list (cons 'cwd vr-dir)
+ (cons 'verify-command
+ (string-append "grep -q fixed " target))
+ (cons 'write-scope scope)
+ (cons 'local-model? #t)
+ (cons 'max-iterations 8)
+ (cons 'max-tool-errors 3)
+ (cons 'on-message
+ (lambda (m)
+ (when (equal? (message-role m) "tool")
+ (set! tool-results
+ (cons (message-content m) tool-results)))))))])
+ (check! "verified-run: hidden write after syntax create recovers"
+ result "VERIFIED: exit 0\n")
+ (check-pred! "verified-run: hidden write after syntax create rejected"
+ (reverse tool-results)
+ (lambda (xs)
+ (let loop ([ys xs])
+ (and (pair? ys)
+ (or (and (str-contains? (car ys) "[ToolRecoverableError]")
+ (str-contains? (car ys) "Full-file write")
+ (str-contains? (car ys) "syntax-broken missing-file create")
+ (str-contains? (car ys) "line_edit"))
+ (loop (cdr ys)))))))
+ (check-pred! "verified-run: hidden write after syntax create keeps ignored body out"
+ (slurp target-path)
+ (lambda (s)
+ (and (str-contains? s "fixed")
+ (not (str-contains? s "ignored"))))))
+ (safe-delete-test-file! target-path))
+
+ (let* ([vr-dir "/tmp"]
+ [target "jcode-verified-replace-range.ss"]
[target-path (string-append vr-dir "/" target)]
[initial "(import (jerboa prelude))\n(define (bad)\n (displayln \"bad\")\n\n(define (ok) 1)\n"]
[replacement "(define (bad)\n (displayln \"fixed\"))"]