Recover verified runs from no-progress loops

ober

fa746e712b9388bf5645d43c785b8e5abb750dc1

diff --git a/src/jcode/core/verified-run.ss b/src/jcode/core/verified-run.ss
index 39abe23..c048c27 100644
--- a/src/jcode/core/verified-run.ss
+++ b/src/jcode/core/verified-run.ss
@@ -3865,6 +3865,7 @@
 	                           (or (opt-get o 'max-tool-errors)
 	                               default-verified-max-tool-errors))
 	                     (cons 'max-repeated-calls (or (opt-get o 'max-repeated-calls) 6))
+	                     (cons 'max-no-progress-retries (or (opt-get o 'max-no-progress-retries) 2))
 	                     (cons 'retry-text-responses? #t)
 	                     (cons 'on-message         (opt-get o 'on-message)))))
     (parameterize ((current-write-scope scope)
diff --git a/src/jcode/core/workflow-runner.ss b/src/jcode/core/workflow-runner.ss
index d5d1d06..9c3f05f 100644
--- a/src/jcode/core/workflow-runner.ss
+++ b/src/jcode/core/workflow-runner.ss
@@ -232,6 +232,66 @@
           (display ";" p))
         tcs))))
 
+(def (tool-call-name-list tcs)
+  (string-join (map wtool-call-tool tcs) ", "))
+
+(def (verified-no-progress-retry-message workflow enforcer tool-calls retry-count)
+  (let* ((completed (step-enforcer-completed enforcer))
+         (pending (step-enforcer-pending enforcer))
+         (names (tool-call-name-list tool-calls))
+         (has-edit? (workflow-has-tool? workflow "edit"))
+         (has-read? (workflow-has-tool? workflow "read"))
+         (has-verify? (workflow-has-tool? workflow "verify"))
+         (recommended
+           (cond
+             ((and has-edit? (not (member "edit" completed)))
+              "edit(path=\"life.ss\", content=<complete first draft>) or read(path=\"README.md\")/read(path=\"Makefile\") if you need one more fact")
+             ((and has-verify? (member "edit" completed))
+              "verify()")
+             (has-read? "read(path=\"README.md\") or read(path=\"Makefile\")")
+             (has-edit? "edit(path=\"life.ss\", content=<complete file>)")
+             (else "a different useful structured tool"))))
+    (string-append
+      "NO PROGRESS: you repeated the same tool call batch ("
+      names
+      ") without advancing the task. Do not call it again with the same arguments. "
+      "Next response must be one structured tool call: "
+      recommended
+      ".\nCompleted tools: "
+      (if (pair? completed) (string-join completed ", ") "(none)")
+      "\nPending required tools: "
+      (if (pair? pending) (string-join pending ", ") "(none)")
+      "\nIf you already have enough context, write a complete small implementation, call verify(), and repair from verifier output."
+      (if (> retry-count 1)
+        "\nThis is repeated no-progress recovery. You must switch tools now."
+        ""))))
+
+(def (workflow-no-progress-retry! emit! workflow enforcer tool-calls
+                                  max-repeated-calls max-no-progress-retries
+                                  last-sig repeat-n no-progress-retries)
+  (if max-repeated-calls
+    (let ((sig (tool-calls-signature tool-calls)))
+      (if (equal? sig (vector-ref last-sig 0))
+        (vector-set! repeat-n 0 (+ (vector-ref repeat-n 0) 1))
+        (begin (vector-set! last-sig 0 sig)
+               (vector-set! repeat-n 0 1)))
+      (if (>= (vector-ref repeat-n 0) max-repeated-calls)
+        (if (< (vector-ref no-progress-retries 0) max-no-progress-retries)
+          (begin
+            (vector-set! no-progress-retries 0
+              (+ (vector-ref no-progress-retries 0) 1))
+            (emit! (make-user-message
+                     (verified-no-progress-retry-message
+                       workflow enforcer tool-calls
+                       (vector-ref no-progress-retries 0))))
+            (vector-set! last-sig 0 #f)
+            (vector-set! repeat-n 0 0)
+            #t)
+          (raise-no-progress max-repeated-calls sig
+            (step-enforcer-completed enforcer)))
+        #f))
+    #f))
+
 (def (workflow-has-tool? workflow name)
   (and (member name (workflow-tool-names workflow)) #t))
 
@@ -289,7 +349,8 @@
   "Execute WORKFLOW with USER-MESSAGE, driving the loop through RESPONDER.
    Returns the terminal tool's value. OPT is an optional options assoc:
      max-iterations (10) max-retries-per-step (3) max-tool-errors (2)
-     max-repeated-calls (#f = off) retry-text-responses? (#f)
+     max-repeated-calls (#f = off) max-no-progress-retries (0)
+     retry-text-responses? (#f)
      on-message (#f) prompt-vars ('()) initial-messages (#f)
      cancel? (thunk -> bool, default never).
    Raises MaxIterationsError / StepEnforcementError / PrerequisiteError /
@@ -300,6 +361,7 @@
          (max-retries    (or (opt-ref o 'max-retries-per-step) 3))
          (max-tool-errors (or (opt-ref o 'max-tool-errors) 2))
          (max-repeated-calls (opt-ref o 'max-repeated-calls))
+         (max-no-progress-retries (or (opt-ref o 'max-no-progress-retries) 0))
          (retry-text-responses? (and (opt-ref o 'retry-text-responses?) #t))
          (on-message     (opt-ref o 'on-message))
          (prompt-vars    (or (opt-ref o 'prompt-vars) '()))
@@ -322,7 +384,8 @@
            (error-tracker (make-error-tracker max-retries max-tool-errors))
            (tool-specs    (workflow-get-tool-specs workflow))
            (last-sig      (vector #f))   ; signature of the previous executed batch
-           (repeat-n      (vector 0)))   ; consecutive identical-batch count
+           (repeat-n      (vector 0))
+           (no-progress-retries (vector 0))) ; consecutive identical-batch recovery count
       ;; Step 3 — main loop (one responder call per iteration)
       (let loop ((iteration 0))
         (cond
@@ -389,18 +452,16 @@
                             ;; loop the error/step budgets miss (the calls neither
                             ;; error nor finish), so break early instead of
                             ;; silently burning the iteration budget.
-                            (when max-repeated-calls
-                              (let ((sig (tool-calls-signature tool-calls)))
-                                (if (equal? sig (vector-ref last-sig 0))
-                                  (vector-set! repeat-n 0 (+ (vector-ref repeat-n 0) 1))
-                                  (begin (vector-set! last-sig 0 sig)
-                                         (vector-set! repeat-n 0 1)))
-                                (when (>= (vector-ref repeat-n 0) max-repeated-calls)
-                                  (raise-no-progress max-repeated-calls sig
-                                    (step-enforcer-completed enforcer)))))
-                            ;; 3d → 3e — execute the batch
-                            (let ((outcome (execute-batch! emit! workflow enforcer
-                                                           error-tracker tool-calls)))
-                              (if (and (pair? outcome) (eq? (car outcome) 'terminal))
-                                (cdr outcome)
-                                (loop (+ iteration 1))))))))))))))))))))
+                            (let ((retry-no-progress?
+                                    (workflow-no-progress-retry!
+                                      emit! workflow enforcer tool-calls
+                                      max-repeated-calls max-no-progress-retries
+                                      last-sig repeat-n no-progress-retries)))
+                              (if retry-no-progress?
+                                (loop (+ iteration 1))
+                                ;; 3d → 3e — execute the batch
+                                (let ((outcome (execute-batch! emit! workflow enforcer
+                                                               error-tracker tool-calls)))
+                                  (if (and (pair? outcome) (eq? (car outcome) 'terminal))
+                                    (cdr outcome)
+                                    (loop (+ iteration 1))))))))))))))))))))))
diff --git a/test/run.ss b/test/run.ss
index e9ab7f8..0045fa6 100644
--- a/test/run.ss
+++ b/test/run.ss
@@ -2431,6 +2431,42 @@
   (safe-delete-test-file! target-path))
 
 (let* ([vr-dir "/tmp"]
+       [target "jcode-verified-no-progress-recovery.txt"]
+       [target-path (string-append vr-dir "/" target)]
+       [messages '()]
+       [wf (coding-workflow (string-append "grep -q ok " target) vr-dir)]
+       [resp (scripted-responder
+               (append
+                 (make-list 3 (list (make-wtool-call "list" '() #f)))
+                 (list
+                   (list (make-wtool-call "edit" (list (cons "path" target)
+                                                        (cons "content" "ok\n")) #f))
+                   (list (make-wtool-call "verify" '() #f))
+                   (list (make-wtool-call "done" '(("summary" . "no-progress-recovered")) #f)))))])
+  (safe-delete-test-file! target-path)
+  (let ([result (run-workflow wf "recover from repeated list calls" resp
+                  (list (cons 'max-iterations 8)
+                        (cons 'max-repeated-calls 3)
+                        (cons 'max-no-progress-retries 1)
+                        (cons 'on-message
+                          (lambda (m)
+                            (set! messages (cons (message-content m) messages))))))])
+    (check! "verified-run: repeated list no-progress recovers"
+            result "no-progress-recovered")
+    (check-pred! "verified-run: repeated list no-progress gives concrete next step"
+      (reverse messages)
+      (lambda (xs)
+        (let loop ([ys xs])
+          (cond
+            [(null? ys) #f]
+            [(and (str-contains? (car ys) "NO PROGRESS")
+                  (str-contains? (car ys) "edit(path=\"life.ss\"")
+                  (str-contains? (car ys) "Do not call it again"))
+             #t]
+            [else (loop (cdr ys))])))))
+  (safe-delete-test-file! target-path))
+
+(let* ([vr-dir "/tmp"]
        [fixture "jcode-verified-run-budget-fixture.txt"]
        [fixture-path (string-append vr-dir "/" fixture)]
        [target "jcode-verified-run-budget-out.txt"]