Focus syntax-broken creates on staged repair

ober

b695f5cf3e6b3cd61028e01d424816b22eac531e

diff --git a/src/jcode/core/verified-run.ss b/src/jcode/core/verified-run.ss
index 0c5bb7f..574c6f9 100644
--- a/src/jcode/core/verified-run.ss
+++ b/src/jcode/core/verified-run.ss
@@ -190,6 +190,10 @@
   (member (tool-spec-name spec)
           '("line_edit" "replace_def" "replace_range" "verify")))
 
+(def (verified-syntax-create-staged-tool-spec? spec)
+  (member (tool-spec-name spec)
+          '("line_edit" "replace_def" "replace_range")))
+
 (def (verified-missing-create-staged-tool-spec? spec)
   (member (tool-spec-name spec)
           '("edit" "write" "line_edit" "replace_def" "replace_range" "verify")))
@@ -198,6 +202,20 @@
   (member (tool-spec-name spec)
           '("edit" "write" "line_edit" "replace_def" "replace_range")))
 
+(def (verified-current-create-draft-tool-spec? spec)
+  (if (incomplete-rejected-ss-create-draft?)
+    (verified-missing-create-repair-tool-spec? spec)
+    (verified-syntax-create-staged-tool-spec? spec)))
+
+(def (verified-current-staged-repair-tool-spec? spec)
+  (if (and (current-pending-ss-create-repair)
+           (not (incomplete-rejected-ss-create-draft?)))
+    (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)))
+
 (def (verified-rejected-draft-inspection-tool-spec? spec)
   (member (tool-spec-name spec) '("read" "balance")))
 
@@ -280,7 +298,7 @@
           ;; repo/API inspection keeps models away from the absent target.
           ((and (current-pending-ss-create-repair)
                 (current-rejected-ss-draft)
-                (not (verified-missing-create-repair-tool-spec? spec)))
+                (not (verified-current-create-draft-tool-spec? spec)))
            #f)
           ;; After a successful edit, another observation should come from the
           ;; authoritative verifier. Keep repair tools in case the model spots
@@ -357,10 +375,7 @@
           ;; expensive failure cycle.
           ((and (current-verified-local-model?)
                 (rejected-draft-staged-repair-mode?)
-                (not ((if (current-pending-ss-create-repair)
-                        verified-missing-create-staged-tool-spec?
-                        verified-staged-repair-tool-spec?)
-                      spec)))
+                (not (verified-current-staged-repair-tool-spec? spec)))
            #f)
           ((not (verified-mcp-tool-spec? spec)) #t)
           (else
@@ -386,9 +401,7 @@
   (if (and (current-verified-local-model?)
            (rejected-draft-staged-repair-mode?))
     (filter
-      (if (current-pending-ss-create-repair)
-        verified-missing-create-staged-tool-spec?
-        verified-staged-repair-tool-spec?)
+      verified-current-staged-repair-tool-spec?
       specs)
     specs))
 
diff --git a/test/run.ss b/test/run.ss
index 1b45f30..9fe77e6 100644
--- a/test/run.ss
+++ b/test/run.ss
@@ -3843,11 +3843,11 @@
 	    (check-pred! "verified-run: repeated local rejection focuses staged tools"
 	      staged-tool-names
 	      (lambda (names)
-	        (and (member "edit" names)
-	             (member "write" names)
-	             (member "line_edit" names)
+	        (and (member "line_edit" names)
 	             (member "replace_def" names)
 	             (member "replace_range" names)
+	             (not (member "edit" names))
+	             (not (member "write" names))
 	             (not (member "verify" names))
 	             (not (member "read" names))
 	             (not (member "balance" names)))))
@@ -4464,8 +4464,10 @@
 	            (cadr observed) 8192)
 	    (check! "verified-run: inspected rejected draft repair uses 4k cap"
 	            (caddr observed) 4096))
-	  (check-pred! "verified-run: inspected missing draft keeps broad write"
-	    repair-tool-names (lambda (names) (member "write" names)))
+	  (check-pred! "verified-run: inspected syntax draft hides broad write"
+	    repair-tool-names (lambda (names) (not (member "write" names))))
+	  (check-pred! "verified-run: inspected syntax draft hides full edit"
+	    repair-tool-names (lambda (names) (not (member "edit" names))))
 	  (check-pred! "verified-run: inspected rejected draft keeps line edit"
 	    repair-tool-names (lambda (names) (member "line_edit" names)))
 	  (safe-delete-test-file! target-path))
@@ -4505,8 +4507,8 @@
 	              (cons 'max-iterations 8)))])
 	    (check! "verified-run: repeated rejected draft schema repair verifies"
 	            result "VERIFIED: exit 0\n"))
-	  (check-pred! "verified-run: repeated missing draft keeps write schema"
-	    tool-names-after-repeat (lambda (names) (member "write" names)))
+	  (check-pred! "verified-run: repeated syntax draft hides write schema"
+	    tool-names-after-repeat (lambda (names) (not (member "write" names))))
 	  (check-pred! "verified-run: repeated rejected draft keeps line edit schema"
 	    tool-names-after-repeat (lambda (names) (member "line_edit" names)))
 	  (safe-delete-test-file! target-path))
@@ -4578,7 +4580,7 @@
 	  (safe-delete-test-file! target-path))
 
 	(let* ([vr-dir "/tmp"]
-	       [target "jcode-local-missing-create-full-write-after-reject.ss"]
+	       [target "jcode-local-missing-create-staged-repair-after-reject.ss"]
 	       [target-path (string-append vr-dir "/" target)]
 	       [bad-a "(import (jerboa prelude))\n(def (main)\n  (displayln \"bad\")))\n"]
 	       [bad-b "(import (jerboa prelude))\n(def (main)\n  (displayln \"still bad\")))\n"]
@@ -4597,26 +4599,28 @@
 	             [(2) (list (make-wtool-call "write"
 	                         (list (cons "path" target)
 	                               (cons "content" bad-b)) #f))]
-	             [(3) (list (make-wtool-call "write"
+	             [(3) (list (make-wtool-call "replace_range"
 	                         (list (cons "path" target)
+	                               (cons "start" 1)
+	                               (cons "end" 3)
 	                               (cons "content" good)) #f))]
-	             [else (error 'test "missing create full write should auto-verify")]))])
+	             [else (error 'test "missing create staged repair should auto-verify")]))])
 	  (safe-delete-test-file! target-path)
 	  (let ([result
-	          (verified-run responder "allow corrected full write for missing create"
+	          (verified-run responder "repair missing create with staged range"
 	            (list
 	              (cons 'cwd vr-dir)
 	              (cons 'verify-command (string-append "grep -q fixed " target))
 	              (cons 'write-scope (parse-write-scope target))
 	              (cons 'local-model? #t)
 	              (cons 'max-iterations 8)))])
-	    (check! "verified-run: missing create full write after rejects verifies"
+	    (check! "verified-run: missing create staged repair after rejects verifies"
 	            result "VERIFIED: exit 0\n"))
-	  (check-pred! "verified-run: missing create staged repair keeps write"
-	    tool-names-after-repeat (lambda (names) (member "write" names)))
-	  (check-pred! "verified-run: missing create staged repair keeps edit"
-	    tool-names-after-repeat (lambda (names) (member "edit" names)))
-	  (check-pred! "verified-run: missing create corrected full write reaches disk"
+	  (check-pred! "verified-run: missing create staged repair hides write"
+	    tool-names-after-repeat (lambda (names) (not (member "write" names))))
+	  (check-pred! "verified-run: missing create staged repair hides edit"
+	    tool-names-after-repeat (lambda (names) (not (member "edit" names))))
+	  (check-pred! "verified-run: missing create staged range reaches disk"
 	    (call-with-input-file target-path (lambda (p) (get-string-all p)))
 	    (lambda (s) (str-contains? s "fixed")))
 	  (safe-delete-test-file! target-path))
@@ -7843,14 +7847,16 @@
                            (cons 'max-tool-errors 3))))])
     (check! "verified-run: missing create schema repair reaches done"
             result "missing-create-schema-ok")
-    (check-pred! "verified-run: missing create repair hides inspection schemas"
+    (check-pred! "verified-run: syntax create repair hides broad schemas"
       (reverse seen-specs)
       (lambda (xs)
         (and (>= (length xs) 2)
              (let ([names (list-ref xs 1)])
-               (and (member "edit" names)
-                    (member "write" names)
-                    (member "line_edit" names)
+               (and (member "line_edit" names)
+                    (member "replace_def" names)
+                    (member "replace_range" names)
+                    (not (member "edit" names))
+                    (not (member "write" names))
                     (not (member "read" names))
                     (not (member "list" names))
                     (not (member "balance" names))
@@ -7986,6 +7992,60 @@
 	            forced-edit-specs? #t))
 	  (safe-delete-test-file! target-path))
 
+	(let* ([vr-dir "/tmp"]
+	       [target "jcode-verified-syntax-create-staged-schema.ss"]
+	       [target-path (string-append vr-dir "/" target)]
+	       [broken "(import (jerboa prelude))\n(def (main)\n  (displayln \"fixed\")\n(main)\n"]
+	       [fixed "(import (jerboa prelude))\n(def (main)\n  (displayln \"fixed\"))\n(main)\n"]
+	       [seen-specs '()]
+	       [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! seen-specs
+	               (cons (map tool-spec-name tool-specs) seen-specs))
+	             (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 "replace_range"
+	                        (list (cons "path" target)
+	                              (cons "start" 1)
+	                              (cons "end" 4)
+	                              (cons "content" fixed)) #f))]
+	               [(= i 3)
+	                (list (make-wtool-call "verify" '() #f))]
+	               [else
+	                (list (make-wtool-call "done"
+	                        '(("summary" . "syntax-create-staged-schema-ok")) #f))]))]
+	         [result (verified-run provider "hide full writes after syntax-broken create"
+	                   (list (cons 'cwd vr-dir)
+	                         (cons 'verify-command
+	                               (string-append "grep -q fixed " target))
+	                         (cons 'write-scope scope)
+	                         (cons 'max-iterations 8)
+	                         (cons 'max-tool-errors 3)))])
+	    (check! "verified-run: syntax create staged repair reaches done"
+	            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))
+
 	(let* ([vr-dir  "/tmp"]
 	       [target "jcode-verified-replace-range.ss"]
 	       [target-path (string-append vr-dir "/" target)]