updates
ober
f101cc6ef60b60c657e7f4176e4f2c434eb79b28
--- a/docs/FORGE.md +++ b/docs/FORGE.md @@ -163,6 +163,11 @@ iteration budget, roughly halving the wasted compute on a stuck loop while leaving genuine edit/verify/repair cycles untouched. A plain `MaxIterationsError` still backstops the budget. +The interactive chat loop uses the same idea more gently: the first repeated +tool-call hit injects a corrective nudge telling the model to use existing +results or choose a different action; only a second hit ends the turn with the +visible stopped message. + ### Expert escalation `core/escalation.ss` + `core/expert.ss` escalate a hard step to a stronger --- a/src/jcode/core/agent.ss +++ b/src/jcode/core/agent.ss @@ -18,6 +18,8 @@ forge-breaker-state make-forge-breaker-state forge-no-progress? + forge-no-progress-nudge-used? + forge-mark-no-progress-nudged! try-parse-text-tool-calls try-parse-xml-tool-calls) @@ -100,11 +102,29 @@ (def forge-breaker-state (make-parameter #f)) (def forge-no-progress-message "[stopped: repeated the same tool call(s) with no progress]") +(def forge-no-progress-nudge-message + (string-append + "You are repeating tool calls that are not moving the task forward. " + "Do not rerun the same discovery commands. Use the tool results already " + "in the conversation, choose a clearly different next file/action, or if " + "you have enough evidence, write the requested file/final answer now.")) (def (make-forge-breaker-state) ;; #(last-batch-sig consecutive-count seen-batches seen-individual-calls - ;; seen-similar-search-paths) - (vector #f 0 '() '() '())) + ;; seen-similar-search-paths no-progress-nudge-used?) + (vector #f 0 '() '() '() #f)) + +(def (forge-no-progress-nudge-used?) + (let ((st (forge-breaker-state))) + (and st (vector-ref st 5)))) + +(def (forge-mark-no-progress-nudged!) + (let ((st (forge-breaker-state))) + (when st (vector-set! st 5 #t)))) + +(def (forge-no-progress-nudge-available?) + (and (forge-breaker-state) + (not (forge-no-progress-nudge-used?)))) (def (chat-call-signature tc) (let ((a (tool-call-arguments tc))) @@ -1416,12 +1436,21 @@ Be concise. Prefer edit over write for modifying existing files. (let ((final (make-assistant-message (respond-call->text rc) #f))) (session-add-message session-id final) final)) - ;; No-progress breaker: repeated tool calls — stop the turn. + ;; No-progress breaker: repeated tool calls get one corrective + ;; nudge. A second hit stops the turn. ((forge-no-progress? calls) - (log-warn logger "no-progress-break" `((round . ,round))) - (let ((final (make-assistant-message forge-no-progress-message #f))) - (session-add-message session-id final) - final)) + (if (forge-no-progress-nudge-available?) + (begin + (forge-mark-no-progress-nudged!) + (log-warn logger "no-progress-nudge" `((round . ,round))) + (session-add-message session-id + (make-user-message forge-no-progress-nudge-message)) + (agent-loop session-id (session-get-messages session-id) (+ round 1) gr)) + (begin + (log-warn logger "no-progress-break" `((round . ,round))) + (let ((final (make-assistant-message forge-no-progress-message #f))) + (session-add-message session-id final) + final)))) (else ;; If calls were rescued from bare text, effective is only the ;; text — rebuild it carrying the tool_calls so results stay paired. @@ -1538,14 +1567,23 @@ Be concise. Prefer edit over write for modifying existing files. (let ((final (make-assistant-message msg #f))) (session-add-message session-id final) final))) - ;; No-progress breaker: repeated tool calls — stop the turn. + ;; No-progress breaker: repeated tool calls get one corrective + ;; nudge. A second hit stops the turn. ((forge-no-progress? calls) - (log-warn logger "no-progress-break" `((round . ,round))) - (let ((msg forge-no-progress-message)) - (when raw-cb (raw-cb msg)) - (let ((final (make-assistant-message msg #f))) - (session-add-message session-id final) - final))) + (if (forge-no-progress-nudge-available?) + (begin + (forge-mark-no-progress-nudged!) + (log-warn logger "no-progress-nudge" `((round . ,round))) + (session-add-message session-id + (make-user-message forge-no-progress-nudge-message)) + (agent-loop-stream session-id (session-get-messages session-id) (+ round 1) gr)) + (begin + (log-warn logger "no-progress-break" `((round . ,round))) + (let ((msg forge-no-progress-message)) + (when raw-cb (raw-cb msg)) + (let ((final (make-assistant-message msg #f))) + (session-add-message session-id final) + final))))) (else (let ((asst (if (null? tcs) (make-assistant-message #f calls) response))) (session-add-message session-id asst) @@ -1675,8 +1713,17 @@ Be concise. Prefer edit over write for modifying existing files. (final (chat-with-expert provider new-messages '()))) (or (message-content final) ""))) ((forge-no-progress? (message-tool-calls response)) - (log-warn logger "no-progress-break" `((round . ,round))) - forge-no-progress-message) + (if (forge-no-progress-nudge-available?) + (begin + (forge-mark-no-progress-nudged!) + (log-warn logger "no-progress-nudge" `((round . ,round))) + (agent-chat-loop provider + (append msgs (list (make-user-message forge-no-progress-nudge-message))) + tools + (+ round 1))) + (begin + (log-warn logger "no-progress-break" `((round . ,round))) + forge-no-progress-message))) (else (let* ((results (execute-tool-calls (message-tool-calls response))) (new-messages (append msgs (list response) results))) @@ -1709,9 +1756,18 @@ Be concise. Prefer edit over write for modifying existing files. (and raw-cb (make-tool-call-stream-filter raw-cb))))) fc))) ((forge-no-progress? effective-tcs) - (log-warn logger "no-progress-break" `((round . ,round))) - (when raw-cb (raw-cb forge-no-progress-message)) - forge-no-progress-message) + (if (forge-no-progress-nudge-available?) + (begin + (forge-mark-no-progress-nudged!) + (log-warn logger "no-progress-nudge" `((round . ,round))) + (agent-chat-loop-stream provider + (append msgs (list (make-user-message forge-no-progress-nudge-message))) + tools + (+ round 1))) + (begin + (log-warn logger "no-progress-break" `((round . ,round))) + (when raw-cb (raw-cb forge-no-progress-message)) + forge-no-progress-message))) (else (let* ((response (make-assistant-message effective-content effective-tcs)) (results (execute-tool-calls effective-tcs)) @@ -1764,10 +1820,19 @@ Be concise. Prefer edit over write for modifying existing files. (values (or fc "") (append new-messages (list final))))))) ((forge-no-progress? effective-tcs) - (log-warn logger "no-progress-break" `((round . ,round))) - (let ((final (make-assistant-message forge-no-progress-message #f))) - (values forge-no-progress-message - (append messages (list final))))) + (if (forge-no-progress-nudge-available?) + (begin + (forge-mark-no-progress-nudged!) + (log-warn logger "no-progress-nudge" `((round . ,round))) + (agent-chat-loop-track-stream provider + (append msgs (list (make-user-message forge-no-progress-nudge-message))) + tools + (+ round 1))) + (begin + (log-warn logger "no-progress-break" `((round . ,round))) + (let ((final (make-assistant-message forge-no-progress-message #f))) + (values forge-no-progress-message + (append messages (list final))))))) (else (let* ((response (make-assistant-message effective-content effective-tcs)) (results (execute-tool-calls effective-tcs)) @@ -1788,10 +1853,19 @@ Be concise. Prefer edit over write for modifying existing files. (values (or (message-content final) "") (append new-messages (list final))))) ((forge-no-progress? (message-tool-calls response)) - (log-warn logger "no-progress-break" `((round . ,round))) - (let ((final (make-assistant-message forge-no-progress-message #f))) - (values forge-no-progress-message - (append messages (list final))))) + (if (forge-no-progress-nudge-available?) + (begin + (forge-mark-no-progress-nudged!) + (log-warn logger "no-progress-nudge" `((round . ,round))) + (agent-chat-loop-track provider + (append msgs (list (make-user-message forge-no-progress-nudge-message))) + tools + (+ round 1))) + (begin + (log-warn logger "no-progress-break" `((round . ,round))) + (let ((final (make-assistant-message forge-no-progress-message #f))) + (values forge-no-progress-message + (append messages (list final))))))) (else (let* ((results (execute-tool-calls (message-tool-calls response))) (new-messages (append msgs (list response) results))) --- a/test/run.ss +++ b/test/run.ss @@ -1671,6 +1671,10 @@ (check! "agent breaker first similar glob ok" (forge-no-progress? glob-src) #f) (check! "agent breaker second same-pattern glob trips" (forge-no-progress? glob-lib) #t))) +(parameterize ([forge-breaker-state (make-forge-breaker-state)]) + (check! "agent breaker nudge initially unused" (forge-no-progress-nudge-used?) #f) + (forge-mark-no-progress-nudged!) + (check! "agent breaker nudge marked used" (forge-no-progress-nudge-used?) #t)) (section "=== verified-run: coding workflow on a REAL file + REAL shell verify ===") ;; The verify-gate/best-of-k tests above use mock callables. This one drives the