Nudge forced tool turns with current schema

ober

1b6b1bb4bd7b04b4c51002e9c3df8d799e73dfd3

diff --git a/src/jcode/core/verified-run.ss b/src/jcode/core/verified-run.ss
index 0844f13..33ba31e 100644
--- a/src/jcode/core/verified-run.ss
+++ b/src/jcode/core/verified-run.ss
@@ -27,6 +27,7 @@
         :std/misc/ports
         :jcode/core/agent-defs
         :jcode/core/workflow
+        :jcode/core/message
         :jcode/core/verified
         :jcode/core/best-of-k
         :jcode/core/workflow-runner
@@ -516,8 +517,34 @@
       '("edit" "write")
       (list staged-tool))))
 
+(def (verified-tool-spec-name-list specs)
+  (map tool-spec-name specs))
+
+(def (forced-tool-turn-user-message specs)
+  (let ((names (verified-tool-spec-name-list specs)))
+    (string-append
+      "THIS TURN HAS A NARROW STRUCTURED TOOL SCHEMA. Only these tool names "
+      "are callable now: "
+      (string-join names ", ")
+      ". Ignore any earlier mention of other tools in the system prompt; "
+      "they are unavailable for this turn. Do not explain or summarize. "
+      (if (and (member "edit" names) (member "write" names))
+        "Respond with exactly one structured edit(...) or write(...) call that writes the complete implementation."
+        "Respond with exactly one structured call from the current list."))))
+
+(def (with-forced-tool-turn-user-message messages specs forced-specs)
+  (if (equal? (verified-tool-spec-name-list specs)
+              (verified-tool-spec-name-list forced-specs))
+    messages
+    (append messages
+            (list (make-user-message
+                    (forced-tool-turn-user-message forced-specs))))))
+
 (def (forced-first-edit-messages messages specs forced-specs)
-  (with-visible-tool-system-note messages specs forced-specs))
+  (with-forced-tool-turn-user-message
+    (with-visible-tool-system-note messages specs forced-specs)
+    specs
+    forced-specs))
 
 (def (specified-tool-choice-supported? provider)
   (not (and (equal? (provider-name provider) "openrouter")
diff --git a/test/run.ss b/test/run.ss
index 619963c..7b7aa6a 100644
--- a/test/run.ss
+++ b/test/run.ss
@@ -6834,6 +6834,7 @@
          [readme "jcode-verified-remote-force-first-edit-readme.txt"]
          [readme-path (string-append vr-dir "/" readme)]
          [forced-spec-names '()]
+         [forced-provider-messages '()]
          [tool-results '()]
          [seen-messages '()]
          [calls 0]
@@ -6844,10 +6845,11 @@
                            (cons "start" line)
                            (cons "end" line)) #f)))]
          [responder
-           (lambda (_messages specs _step)
+           (lambda (messages specs _step)
              (set! calls (+ calls 1))
              (when (= calls 7)
-               (set! forced-spec-names (map tool-spec-name specs)))
+               (set! forced-spec-names (map tool-spec-name specs))
+               (set! forced-provider-messages messages))
              (cond
                [(<= calls 6) (read-call calls)]
                [(= calls 7)
@@ -6908,6 +6910,21 @@
                    #t]
                   [else (loop (cdr xs))]))
               #f)
+      (check-pred! "verified-run: forced first-edit provider message narrows current turn"
+        forced-provider-messages
+        (lambda (xs)
+          (let loop ([ys xs])
+            (cond
+              [(null? ys) #f]
+              [(and (equal? (message-role (car ys)) "user")
+                    (str-contains? (message-content (car ys))
+                                   "THIS TURN HAS A NARROW STRUCTURED TOOL SCHEMA")
+                    (str-contains? (message-content (car ys))
+                                   "Only these tool names are callable now: edit, write")
+                    (str-contains? (message-content (car ys))
+                                   "Respond with exactly one structured edit(...) or write(...) call"))
+               #t]
+              [else (loop (cdr ys))]))))
       (check-pred! "verified-run: forced first-edit retry names visible edit tools"
         seen-messages
         (lambda (xs)