Scrub stale tool catalogs on narrowed turns
ober
bb61f9ca19540ef9151bc0bb2671222a12bc7955
--- a/src/jcode/core/workflow-runner.ss +++ b/src/jcode/core/workflow-runner.ss @@ -375,28 +375,45 @@ ". 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 (narrowed-tool-catalog-line? line) + (or (string-prefix? "Tools:" line) + (string-prefix? "Path aliases accepted by file tools:" line) + (string-prefix? "For a new Jerboa .ss script," line) + (string-prefix? "External MCP tools are available" line) + (string-prefix? "MCP tools are optional support" line) + (string-prefix? "Before the first successful edit, MCP discovery" line))) + +(def (scrub-narrowed-tool-catalog content) + (string-join + (filter (lambda (line) + (not (narrowed-tool-catalog-line? line))) + (string-split (or content "") "\n")) + "\n")) + +(def (with-first-system-suffix messages suffix . opt) + (let ((prepare (if (pair? opt) (car opt) (lambda (s) s)))) + (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 + (prepare (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)))) + (visible-tool-system-note visible-tool-specs) + scrub-narrowed-tool-catalog))) (def (latest-tool-result-content messages) (let loop ((rev (reverse messages))) --- a/test/run.ss +++ b/test/run.ss @@ -1567,7 +1567,10 @@ (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"))))) + (str-contains? s "original system prompt tool list is superseded") + (not (str-contains? s "Tools: search")) + (not (str-contains? s "lookup(")) + (not (str-contains? s "mcp_jerboa")))))) (let* ([w (mk-research-wf)] [msgs '()] @@ -6925,6 +6928,14 @@ "Respond with exactly one structured edit(...) or write(...) call")) #t] [else (loop (cdr ys))])))) + (check-pred! "verified-run: forced first-edit provider system hides stale tools" + (first-system-content forced-provider-messages) + (lambda (s) + (and (string? s) + (str-contains? s "JCODE TOOL AVAILABILITY OVERRIDE") + (not (str-contains? s "Tools: read")) + (not (str-contains? s "mcp_jerboa")) + (not (str-contains? s "External MCP tools are available"))))) (check-pred! "verified-run: forced first-edit retry names visible edit tools" seen-messages (lambda (xs)