Supersede hidden tools on narrowed requests
ober
43df6dd4e7481b8ef842e12141597b3bfd2f6fac
--- a/src/jcode/core/verified-run.ss +++ b/src/jcode/core/verified-run.ss @@ -447,6 +447,9 @@ (make-text-response "JCODE_INTERNAL_FORCE_FIRST_EDIT_RETRY") response)) +(def (forced-first-edit-messages messages specs forced-specs) + (with-visible-tool-system-note messages specs forced-specs)) + (def (specified-tool-choice-supported? provider) (not (and (equal? (provider-name provider) "openrouter") (string? (provider-model provider)) @@ -478,10 +481,12 @@ (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)))) + (force-first-edit-tool-choice specs))) + (forced-specs (forced-first-edit-specs specs forced-choice))) (forced-first-edit-response - (backend messages - (forced-first-edit-specs specs forced-choice) + (backend (forced-first-edit-messages + messages specs forced-specs) + forced-specs step) forced-choice)) (let* ((sticky-rejected-draft? @@ -504,14 +509,17 @@ ((make-provider-backend (get-expert-provider) chat-direct-via-stream) messages specs #f)) - (let ((forced-choice (force-first-edit-tool-choice specs))) + (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) forced-choice))) (forced-first-edit-response - (backend messages - (forced-first-edit-specs specs forced-choice) + (backend (forced-first-edit-messages + messages specs forced-specs) + forced-specs #f) forced-choice))))))))))) --- a/src/jcode/core/workflow-runner.ss +++ b/src/jcode/core/workflow-runner.ss @@ -28,7 +28,8 @@ ;;; emits plain role/content messages and lets compaction-strategy re-derive. (export run-workflow - compact-verified-history) + compact-verified-history + with-visible-tool-system-note) (import :jcode/core/workflow :jcode/core/steps @@ -352,6 +353,46 @@ (def (verified-workflow? workflow) (string=? (workflow-name workflow) "verified-coding")) +(def tool-availability-note-marker + "JCODE TOOL AVAILABILITY OVERRIDE:") + +(def (tool-spec-names specs) + (map tool-spec-name specs)) + +(def (same-tool-spec-names? a b) + (equal? (tool-spec-names a) (tool-spec-names b))) + +(def (visible-tool-system-note visible-tool-specs) + (string-append + tool-availability-note-marker + " for this provider request, only these structured tools are available: " + (string-join (tool-spec-names visible-tool-specs) ", ") + ". The original system prompt tool list is superseded for this turn; " + "do not call tools outside this list.")) + +(def (with-first-system-suffix messages suffix) + (let loop ((xs messages) (acc '())) + (cond + ((null? xs) + (reverse (cons (make-system-message suffix) acc))) + ((equal? (message-role (car xs)) "system") + (append (reverse acc) + (cons + (make-system-message + (string-append + (or (message-content (car xs)) "") + "\n\n" + suffix)) + (cdr xs)))) + (else (loop (cdr xs) (cons (car xs) acc)))))) + +(def (with-visible-tool-system-note messages all-tool-specs visible-tool-specs) + (if (same-tool-spec-names? all-tool-specs visible-tool-specs) + messages + (with-first-system-suffix + messages + (visible-tool-system-note visible-tool-specs)))) + (def (latest-tool-result-content messages) (let loop ((rev (reverse messages))) (cond @@ -376,10 +417,12 @@ (string-append "VERIFIED WORKFLOW REQUIRES A STRUCTURED TOOL CALL NOW. " "The previous turn attempted a hidden inspection while only edit/write " - "were available. Do not explain, summarize, ask questions, read, list, " - "balance, verify, or call any other tool. Next response must be exactly " - "one structured edit(path=<scoped target file>, content=<complete file>) " - "or write(path=<scoped target file>, content=<complete file>) tool call.")) + "were available. The original system prompt tool list is superseded for " + "this turn; read, list, balance, verify, done, shell, MCP, and every " + "other non-edit/write tool are unavailable right now. Do not explain, " + "summarize, or ask questions. Next response must be exactly one " + "structured edit(path=<scoped target file>, content=<complete file>) or " + "write(path=<scoped target file>, content=<complete file>) tool call.")) (def (verified-text-retry-message workflow enforcer messages raw retry-count) (let* ((completed (step-enforcer-completed enforcer)) @@ -533,10 +576,13 @@ (if (and (pair? outcome) (eq? (car outcome) 'terminal)) (cdr outcome) (loop iteration))) - (let* ((provider-messages + (let* ((base-provider-messages (if prepare-messages (prepare-messages messages) messages)) + (provider-messages + (with-visible-tool-system-note + base-provider-messages tool-specs visible-tool-specs)) (response (responder provider-messages visible-tool-specs iteration))) (cond --- a/test/run.ss +++ b/test/run.ss @@ -1226,6 +1226,14 @@ (make-text-response "exhausted"))]) (set! i (+ i 1)) r)))) +(define (first-system-content messages) + (let loop ([xs messages]) + (cond + [(null? xs) #f] + [(equal? (message-role (car xs)) "system") + (message-content (car xs))] + [else (loop (cdr xs))]))) + ;; search (required) → answer (terminal, prereq search). lookup is optional. (define (mk-research-wf) (make-workflow "research" "Search then answer." @@ -1531,6 +1539,62 @@ #t] [else (loop (cdr ys))]))))) +(let* ([w (mk-research-wf)] + [captured #f] + [resp + (lambda (messages tool-specs step) + (when (= step 0) + (set! captured (list messages tool-specs))) + (if (= step 0) + (list (make-wtool-call "search" '() #f)) + (list (make-wtool-call "answer" '() #f))))] + [result + (run-workflow w "go" resp + (list (cons 'max-iterations 4) + (cons 'tool-spec-filter + (lambda (specs) + (filter + (lambda (spec) + (not (string=? (tool-spec-name spec) "lookup"))) + specs)))))] + [sys (and captured (first-system-content (car captured)))]) + (check! "filtered tool workflow still reaches terminal" + result "ANSWER delivered") + (check-pred! "filtered provider messages supersede hidden tool list" + sys + (lambda (s) + (and (string? s) + (str-contains? s "JCODE TOOL AVAILABILITY OVERRIDE") + (str-contains? s "only these structured tools are available: search, answer") + (str-contains? s "original system prompt tool list is superseded"))))) + +(let* ([w (mk-research-wf)] + [msgs '()] + [resp (scripted-responder + (list (make-text-response "JCODE_INTERNAL_FORCE_FIRST_EDIT_RETRY") + (list (make-wtool-call "search" '() #f)) + (list (make-wtool-call "answer" '() #f))))] + [result (run-workflow w "go" resp + (list (cons 'max-iterations 6) + (cons 'retry-text-responses? #t) + (cons 'on-message + (lambda (m) (set! msgs (cons m msgs))))))]) + (check! "forced first-edit retry workflow still reaches terminal" + result "ANSWER delivered") + (check-pred! "forced first-edit retry says original tool list is superseded" + (reverse msgs) + (lambda (xs) + (let loop ([ys xs]) + (cond + [(null? ys) #f] + [(and (equal? (message-role (car ys)) "user") + (str-contains? (message-content (car ys)) + "original system prompt tool list is superseded") + (str-contains? (message-content (car ys)) + "every other non-edit/write tool are unavailable")) + #t] + [else (loop (cdr ys))]))))) + ;; Opt-in text retries fail through ToolCallError instead of burning every ;; workflow iteration. (let* ([w (mk-research-wf)]