Phase 7: deterministic eval harness + /forge ablation
ober
bf5135e764c464a6ef91fb5fffb03e2355b7fe3a
--- a/build-binary.ss +++ b/build-binary.ss @@ -149,6 +149,9 @@ "lib/jcode/proxy/handler" "lib/jcode/core/slot-worker" "lib/jcode/proxy/server" + "lib/jcode/eval/scenario" + "lib/jcode/eval/ablation" + "lib/jcode/eval/runner" "lib/jcode/tool/registry" "lib/jcode/tool/file" "lib/jcode/tool/apply-patch" new file mode 100644 --- /dev/null +++ b/src/jcode/eval/ablation.ss @@ -0,0 +1,82 @@ +;;; jcode eval — ablation configurations +;;; +;;; Faithful port of forge's tests/eval/ablation.py: an AblationConfig records +;;; which guardrails are active, and ABLATION_PRESETS enumerates the standard +;;; knockouts used to attribute outcome gains to individual guardrails. +;;; +;;; In jcode's deterministic harness only the knobs that the *runner* honours +;;; have observable effect: step-enforcement-enabled (strips required-steps), +;;; max-retries-per-step and max-tool-errors (run-workflow budgets). rescue- +;;; enabled and compaction-enabled live in the responder/context seam — which +;;; the harness injects — so they are recorded for fidelity but do not by +;;; themselves change a deterministic run. (See runner.ss.) + +(export make-ablation-config ablation-config? + ablation-config-name ablation-config-rescue-enabled + ablation-config-max-retries-per-step + ablation-config-step-enforcement-enabled + ablation-config-max-tool-errors ablation-config-compaction-enabled + ablation-presets ablation-preset-ref *ablation-preset-order*) + +(import :std/misc/string) + +(def (opt-ref alist key default) + (let ((p (assoc key alist))) (if p (cdr p) default))) + +(defstruct ablc + (name rescue-enabled max-retries-per-step step-enforcement-enabled + max-tool-errors compaction-enabled)) + +(def (make-ablation-config name . opt) + "Construct an ablation config. OPT is an options assoc: 'rescue-enabled (#t) + 'max-retries-per-step (5) 'step-enforcement-enabled (#t) 'max-tool-errors + (2) 'compaction-enabled (#t)." + (let ((o (if (pair? opt) (car opt) '()))) + (make-ablc name + (opt-ref o 'rescue-enabled #t) + (opt-ref o 'max-retries-per-step 5) + (opt-ref o 'step-enforcement-enabled #t) + (opt-ref o 'max-tool-errors 2) + (opt-ref o 'compaction-enabled #t)))) + +(def (ablation-config? x) (ablc? x)) +(def (ablation-config-name c) (ablc-name c)) +(def (ablation-config-rescue-enabled c) (ablc-rescue-enabled c)) +(def (ablation-config-max-retries-per-step c) (ablc-max-retries-per-step c)) +(def (ablation-config-step-enforcement-enabled c) (ablc-step-enforcement-enabled c)) +(def (ablation-config-max-tool-errors c) (ablc-max-tool-errors c)) +(def (ablation-config-compaction-enabled c) (ablc-compaction-enabled c)) + +;; ── Standard presets (forge ABLATION_PRESETS) ──────────────────────── +;; reforged — every guardrail on (the production configuration) +;; no_rescue — disable text→tool rescue +;; no_nudge — disable rescue AND retry nudges (max-retries 0) +;; no_steps — disable step enforcement (required steps no longer enforced) +;; no_recovery— disable tool-error recovery budget (max-tool-errors 0) +;; no_compact — disable context compaction +;; bare — every guardrail off (raw model behaviour) +(def *ablation-preset-order* + '("reforged" "no_rescue" "no_nudge" "no_steps" "no_recovery" "no_compact" "bare")) + +(def (ablation-presets) + "Fresh assoc (name . ablation-config) of the standard presets." + (list + (cons "reforged" (make-ablation-config "reforged")) + (cons "no_rescue" (make-ablation-config "no_rescue" + '((rescue-enabled . #f)))) + (cons "no_nudge" (make-ablation-config "no_nudge" + '((rescue-enabled . #f) (max-retries-per-step . 0)))) + (cons "no_steps" (make-ablation-config "no_steps" + '((step-enforcement-enabled . #f)))) + (cons "no_recovery" (make-ablation-config "no_recovery" + '((max-tool-errors . 0)))) + (cons "no_compact" (make-ablation-config "no_compact" + '((compaction-enabled . #f)))) + (cons "bare" (make-ablation-config "bare" + '((rescue-enabled . #f) (max-retries-per-step . 0) + (step-enforcement-enabled . #f) (max-tool-errors . 0) + (compaction-enabled . #f)))))) + +(def (ablation-preset-ref name) + "Look up a preset ablation-config by NAME, or #f." + (let ((p (assoc name (ablation-presets)))) (and p (cdr p)))) new file mode 100644 --- /dev/null +++ b/src/jcode/eval/runner.ss @@ -0,0 +1,206 @@ +;;; jcode eval — the deterministic scenario/ablation runner +;;; +;;; Faithful port of the portable core of forge's tests/eval/eval_runner.py +;;; (the run-one-scenario + ablation loop + history analysis), decoupled from +;;; forge's LLMClient/asyncio/statistical reporting (judged non-portable in the +;;; scoping pass). The model is replaced by the scenario's scripted responder, +;;; so a run is deterministic and depends only on the script + the guardrails. +;;; +;;; instrument-workflow mirrors forge's _build_workflow_with_capture: it rebuilds +;;; the workflow wrapping the terminal tool's callable so the args the model +;;; passes are captured for accuracy scoring, and — when an ablation disables +;;; step enforcement — strips required-steps to '() (forge sets required_steps=[]). +;;; +;;; analyze-messages mirrors metrics.analyze_history: jcode has no MessageType +;;; tags, so type is derived from message shape (assistant+tool_calls = a tool +;;; batch; assistant prose = reasoning; tool result prefixed [StepEnforcement +;;; Error]/[PrerequisiteError] = a step nudge; [ToolError] = a tool error). + +(export instrument-workflow run-eval-scenario run-ablation + ablation-pass-rates analyze-messages eval-error-type + make-history-stats history-stats? + history-stats-total-tool-calls history-stats-unique-tools + history-stats-step-nudges history-stats-tool-errors + history-stats-reasoning-messages) + +(import :jcode/core/workflow + :jcode/core/workflow-runner + :jcode/core/message + :jcode/core/errors + :jcode/eval/scenario + :jcode/eval/ablation + :std/misc/string) + +(def (assoc-cdr key alist) (let ((p (assoc key alist))) (and p (cdr p)))) + +;; ── Condition classification (forge RunResult.error_type) ───────────── +(def (eval-error-type e) + "Map a raised condition to forge's error_type string." + (cond + ((not (condition? e)) "error") + ((max-iterations-error? e) "max_iterations") + ((step-enforcement-error? e) "step_enforcement") + ((prerequisite-error? e) "prerequisite") + ((tool-execution-error? e) "tool_execution") + ((tool-resolution-error? e) "tool_resolution") + ((workflow-cancelled-error? e) "cancelled") + ((tool-call-error? e) "tool_call") + ((unsupported-model-error? e) "unsupported_model") + ((hardware-detection-error? e) "hardware_detection") + (else "error"))) + +(def (condition->message e) + (cond + ((string? e) e) + ((and (condition? e) (message-condition? e)) (condition-message e)) + ((condition? e) (call-with-string-output-port (lambda (p) (display-condition e p)))) + (else "error"))) + +;; ── Workflow instrumentation (forge _build_workflow_with_capture) ───── +(def (instrument-workflow wf step-enforcement? capture-cell) + "Rebuild WF, wrapping each terminal tool's callable to record its args assoc + into CAPTURE-CELL slot 0. When STEP-ENFORCEMENT? is #f the required-steps + are stripped to '() (premature terminal calls then succeed)." + (let* ((terminals (workflow-terminal-tools wf)) + (tools (map (lambda (td) + (if (member (tool-def-name td) terminals) + (let ((orig (tool-def-callable td))) + (make-tool-def + (tool-def-spec td) + (lambda (args) + (vector-set! capture-cell 0 args) + (orig args)) + (tool-def-prerequisites td))) + td)) + (workflow-tools wf)))) + (make-workflow + (workflow-name wf) + (workflow-description wf) + tools + (if step-enforcement? (workflow-required-steps wf) '()) + terminals + (workflow-system-prompt-template wf)))) + +;; ── Single scenario run ─────────────────────────────────────────────── +(def (run-eval-scenario scenario . opt) + "Run SCENARIO once, returning a run-result. OPT is an options assoc; an + 'ablation entry (an ablation-config) overrides step-enforcement and the + retry/error budgets, otherwise the scenario's own budgets apply. + + Accuracy = completeness AND validate(terminal-args) AND validate-state()." + (let* ((o (if (pair? opt) (car opt) '())) + (ablation (assoc-cdr 'ablation o)) + (step-enf? (if ablation (ablation-config-step-enforcement-enabled ablation) #t)) + (max-retries (if ablation (ablation-config-max-retries-per-step ablation) + (eval-scenario-max-retries-per-step scenario))) + (max-errors (if ablation (ablation-config-max-tool-errors ablation) + (eval-scenario-max-tool-errors scenario))) + (built ((eval-scenario-build-workflow scenario))) + (wf0 (if (pair? built) (car built) built)) + (vstate (if (pair? built) (cdr built) #f)) + (capture (vector 'none)) + (wf (instrument-workflow wf0 step-enf? capture)) + (responder ((eval-scenario-responder-factory scenario))) + (msgs (vector '())) + (iters (vector 0)) + (wrapped (lambda (m s i) + (vector-set! iters 0 (+ i 1)) + (responder m s i))) + (on-msg (lambda (m) + (vector-set! msgs 0 (append (vector-ref msgs 0) (list m)))))) + (define (captured-args) + (let ((a (vector-ref capture 0))) (if (eq? a 'none) #f a))) + (guard (e [#t (make-run-result + (eval-scenario-name scenario) + #f #f (vector-ref iters 0) (captured-args) + (eval-error-type e) (condition->message e) + (vector-ref msgs 0))]) + (run-workflow wf (eval-scenario-user-message scenario) wrapped + (list (cons 'max-iterations (eval-scenario-max-iterations scenario)) + (cons 'max-retries-per-step max-retries) + (cons 'max-tool-errors max-errors) + (cons 'on-message on-msg))) + (let* ((targs (captured-args)) + (validate (eval-scenario-validate scenario)) + (acc (and (or (not validate) (and (validate targs) #t)) + (or (not vstate) (and (vstate) #t))))) + (make-run-result + (eval-scenario-name scenario) + #t acc (vector-ref iters 0) targs + #f #f (vector-ref msgs 0)))))) + +;; ── Ablation sweep ───────────────────────────────────────────────────── +(def (run-ablation scenario configs) + "Run SCENARIO once per ablation-config in CONFIGS. Returns an assoc + (config-name . run-result) in CONFIGS order." + (map (lambda (cfg) + (cons (ablation-config-name cfg) + (run-eval-scenario scenario (list (cons 'ablation cfg))))) + configs)) + +(def (ablation-pass-rates results) + "Aggregate (config-name . run-result) rows into (config-name . (passed . total)) + by config name, preserving first-seen order. Useful when ROWS spans several + scenarios run under the same set of configs." + (let ((names (let loop ((rs results) (seen '())) + (cond + ((null? rs) (reverse seen)) + ((member (caar rs) seen) (loop (cdr rs) seen)) + (else (loop (cdr rs) (cons (caar rs) seen))))))) + (map (lambda (name) + (let loop ((rs results) (passed 0) (total 0)) + (cond + ((null? rs) (cons name (cons passed total))) + ((equal? (caar rs) name) + (loop (cdr rs) + (+ passed (if (run-result-accuracy (cdar rs)) 1 0)) + (+ total 1))) + (else (loop (cdr rs) passed total))))) + names))) + +;; ── History analysis (forge metrics.analyze_history) ────────────────── +(defstruct hstats + (total-tool-calls unique-tools step-nudges tool-errors reasoning-messages)) + +(def (make-history-stats total unique step terr reason) + (make-hstats total unique step terr reason)) +(def (history-stats? x) (hstats? x)) +(def (history-stats-total-tool-calls s) (hstats-total-tool-calls s)) +(def (history-stats-unique-tools s) (hstats-unique-tools s)) +(def (history-stats-step-nudges s) (hstats-step-nudges s)) +(def (history-stats-tool-errors s) (hstats-tool-errors s)) +(def (history-stats-reasoning-messages s) (hstats-reasoning-messages s)) + +(def (add-names seen tcs) + (let loop ((ts tcs) (acc seen)) + (cond + ((null? ts) acc) + ((member (tool-call-name (car ts)) acc) (loop (cdr ts) acc)) + (else (loop (cdr ts) (cons (tool-call-name (car ts)) acc)))))) + +(def (analyze-messages messages) + "Tally tool-call / nudge / error / reasoning counts over MESSAGES (jcode + message structs), deriving message kind from shape." + (let loop ((ms messages) (total 0) (uniq '()) (step 0) (terr 0) (reason 0)) + (cond + ((null? ms) (make-hstats total (length uniq) step terr reason)) + (else + (let* ((m (car ms)) + (role (message-role m)) + (tcs (message-tool-calls m)) + (content (or (message-content m) ""))) + (cond + ((and (equal? role "assistant") tcs (pair? tcs)) + (loop (cdr ms) (+ total (length tcs)) (add-names uniq tcs) + step terr reason)) + ((and (equal? role "assistant") (> (string-length content) 0)) + (loop (cdr ms) total uniq step terr (+ reason 1))) + ((equal? role "tool") + (cond + ((or (string-prefix? "[StepEnforcementError]" content) + (string-prefix? "[PrerequisiteError]" content)) + (loop (cdr ms) total uniq (+ step 1) terr reason)) + ((string-prefix? "[ToolError]" content) + (loop (cdr ms) total uniq step (+ terr 1) reason)) + (else (loop (cdr ms) total uniq step terr reason)))) + (else (loop (cdr ms) total uniq step terr reason)))))))) new file mode 100644 --- /dev/null +++ b/src/jcode/eval/scenario.ss @@ -0,0 +1,106 @@ +;;; jcode eval — scenario + result data types +;;; +;;; Faithful port of forge's tests/eval/scenarios/_base.py (EvalScenario, the +;;; `_check` substring matcher) and the RunResult half of eval_runner.py, +;;; decoupled from forge's asyncio/LLMClient. forge runs scenarios against a +;;; live model; jcode's harness is deterministic — each scenario carries a +;;; RESPONDER-FACTORY that mints a fresh scripted responder (responders are +;;; stateful, so a new one is needed per run), and BUILD-WORKFLOW is a thunk +;;; returning either a workflow or a (workflow . validate-state) pair, matching +;;; forge's build_workflow returning (Workflow, validate_state). +;;; +;;; VALIDATE is (terminal-args-assoc -> bool) or #f; VALIDATE-STATE (the cdr of +;;; build-workflow's result) is (-> bool) or #f. Accuracy in the runner is +;;; completeness AND validate(terminal-args) AND validate-state(). + +(export make-eval-scenario eval-scenario? + eval-scenario-name eval-scenario-description eval-scenario-build-workflow + eval-scenario-user-message eval-scenario-responder-factory + eval-scenario-validate eval-scenario-max-iterations + eval-scenario-max-retries-per-step eval-scenario-max-tool-errors + eval-scenario-tags eval-scenario-ideal-iterations + check-substrings + make-run-result run-result? + run-result-scenario-name run-result-completeness run-result-accuracy + run-result-iterations-used run-result-terminal-args + run-result-error-type run-result-error-message run-result-messages) + +(import :std/misc/string) + +(def (opt-ref alist key default) + (let ((p (assoc key alist))) (if p (cdr p) default))) + +;; ── EvalScenario ────────────────────────────────────────────────────── +(defstruct escn + (name description build-workflow user-message responder-factory validate + max-iterations max-retries-per-step max-tool-errors tags ideal-iterations)) + +(def (make-eval-scenario name description build-workflow user-message + responder-factory validate . opt) + "Construct an eval scenario. BUILD-WORKFLOW is a thunk -> workflow or + (workflow . validate-state). RESPONDER-FACTORY is a thunk -> fresh scripted + responder. VALIDATE is (terminal-args -> bool) or #f. OPT is an options + assoc: 'max-iterations (15) 'max-retries-per-step (5) 'max-tool-errors (2) + 'tags ('()) 'ideal-iterations (#f)." + (let ((o (if (pair? opt) (car opt) '()))) + (make-escn name description build-workflow user-message responder-factory + validate + (opt-ref o 'max-iterations 15) + (opt-ref o 'max-retries-per-step 5) + (opt-ref o 'max-tool-errors 2) + (opt-ref o 'tags '()) + (opt-ref o 'ideal-iterations #f)))) + +(def (eval-scenario? x) (escn? x)) +(def (eval-scenario-name s) (escn-name s)) +(def (eval-scenario-description s) (escn-description s)) +(def (eval-scenario-build-workflow s) (escn-build-workflow s)) +(def (eval-scenario-user-message s) (escn-user-message s)) +(def (eval-scenario-responder-factory s) (escn-responder-factory s)) +(def (eval-scenario-validate s) (escn-validate s)) +(def (eval-scenario-max-iterations s) (escn-max-iterations s)) +(def (eval-scenario-max-retries-per-step s) (escn-max-retries-per-step s)) +(def (eval-scenario-max-tool-errors s) (escn-max-tool-errors s)) +(def (eval-scenario-tags s) (escn-tags s)) +(def (eval-scenario-ideal-iterations s) (escn-ideal-iterations s)) + +;; ── Substring matcher (forge _base._check) ─────────────────────────── +;; Case-insensitive AND over REQUIRED; commas are stripped from the haystack +;; first (forge: text.lower().replace(",", "")) so "1,000" matches "1000". +(def (drop-commas s) + (list->string (filter (lambda (c) (not (char=? c #\,))) (string->list s)))) + +(def (check-substrings text required) + "True iff every string in REQUIRED occurs in TEXT (case-insensitive, with + commas stripped from TEXT). Empty REQUIRED is vacuously true." + (let ((hay (drop-commas (string-downcase (or text ""))))) + (let loop ((rs required)) + (cond + ((null? rs) #t) + ((string-contains hay (string-downcase (car rs))) (loop (cdr rs))) + (else #f))))) + +;; ── RunResult ───────────────────────────────────────────────────────── +;; completeness — did the workflow reach a terminal tool (run-workflow +;; returned rather than raised)? +;; accuracy — completeness AND validate(terminal-args) AND validate-state. +;; terminal-args — the args assoc the terminal tool was called with (or #f). +;; error-type — condition-name string when it raised, else #f. +(defstruct erun + (scenario-name completeness accuracy iterations-used terminal-args + error-type error-message messages)) + +(def (make-run-result scenario-name completeness accuracy iterations-used + terminal-args error-type error-message messages) + (make-erun scenario-name completeness accuracy iterations-used + terminal-args error-type error-message messages)) + +(def (run-result? x) (erun? x)) +(def (run-result-scenario-name r) (erun-scenario-name r)) +(def (run-result-completeness r) (erun-completeness r)) +(def (run-result-accuracy r) (erun-accuracy r)) +(def (run-result-iterations-used r) (erun-iterations-used r)) +(def (run-result-terminal-args r) (erun-terminal-args r)) +(def (run-result-error-type r) (erun-error-type r)) +(def (run-result-error-message r) (erun-error-message r)) +(def (run-result-messages r) (erun-messages r)) --- a/src/jcode/ui/cli.ss +++ b/src/jcode/ui/cli.ss @@ -32,6 +32,9 @@ :jcode/core/workflow-runner :jcode/core/slot-worker :jcode/proxy/server + :jcode/eval/scenario + :jcode/eval/ablation + :jcode/eval/runner :jcode/mcp/client :jcode/tool/lsp :jcode/core/plugin @@ -367,6 +370,66 @@ EXAMPLES: (printf "respond() is injected when the client sends tools, then stripped from~n") (printf "the reply so the model stays in tool-calling mode where guardrails apply.~n")) +;; /forge ablation — a deterministic eval scenario whose scripted model tries +;; to answer before searching. Running it with step enforcement ON vs. OFF +;; shows how the guardrail turns an ungrounded answer into a grounded one. +(def (forge-eval-demo-scenario) + (make-eval-scenario + "research-demo" + "Premature answer must be nudged into searching first." + (lambda () ; build-workflow -> (workflow . validate-state) + (let ((searched (vector #f))) + (cons + (make-workflow + "research" "Search, then answer." + (list + (make-tool-def + (make-tool-spec "search" "Search." '(("type" . "object"))) + (lambda (args) (vector-set! searched 0 #t) "results") + '()) + (make-tool-def + (make-tool-spec "answer" "Final answer." '(("type" . "object"))) + (lambda (args) "answered") + '())) + '("search") "answer" "Research agent.") + (lambda () (vector-ref searched 0))))) ; validate-state: did we search? + "look it up" + (lambda () ; responder-factory -> fresh scripted responder + (let ((n 0) + (script (list (list (make-wtool-call "answer" '(("text" . "early")) "answering")) + (list (make-wtool-call "search" '(("q" . "x")) "searching")) + (list (make-wtool-call "answer" '(("text" . "final")) "answer now"))))) + (lambda (messages tool-specs step) + (let ((r (if (< n (length script)) (list-ref script n) + (make-text-response "stuck")))) + (set! n (+ n 1)) r)))) + (lambda (args) (and args (assoc "text" args) #t)) ; validate terminal-args + '((max-iterations . 8)))) + +(def (forge-print-ablation) + (printf "Eval harness: available (deterministic, scripted-responder runner).~n") + (printf " Presets ~a~n" (string-join *ablation-preset-order* ", ")) + (let* ((scn (forge-eval-demo-scenario)) + (rows (run-ablation scn (list (ablation-preset-ref "reforged") + (ablation-preset-ref "no_steps")))) + (on (cdr (assoc "reforged" rows))) + (off (cdr (assoc "no_steps" rows)))) + (printf " Scenario ~a — ~a~n" + (eval-scenario-name scn) (eval-scenario-description scn)) + (printf " reforged complete=~a accuracy=~a iters=~a~n" + (run-result-completeness on) (run-result-accuracy on) + (run-result-iterations-used on)) + (printf " no_steps complete=~a accuracy=~a iters=~a~n" + (run-result-completeness off) (run-result-accuracy off) + (run-result-iterations-used off)) + (let ((st (analyze-messages (run-result-messages on)))) + (printf " reforged stats tool-calls=~a step-nudges=~a reasoning=~a~n" + (history-stats-total-tool-calls st) + (history-stats-step-nudges st) + (history-stats-reasoning-messages st)))) + (printf "Disabling step enforcement lets the model answer before searching:~n") + (printf "it completes but the answer is ungrounded, so accuracy flips to #f.~n")) + ;; `jcode proxy` — serve the configured provider behind the guardrail proxy. (def (proxy-main args) (let loop ((args args) (port 8080) (bind "127.0.0.1")) @@ -395,7 +458,7 @@ EXAMPLES: (let ((cmd (string-trim (substring input 1 (string-length input))))) (cond ((equal? cmd "help") - (display "\nCommands:\n /help Show this help\n /model [name] Show or set model\n /provider [name] Show or set provider\n /plan Switch to PLAN mode (read-only)\n /build Switch to BUILD mode (read+write)\n /mode Show current mode\n /mcp Toggle MCP tools on/off\n /tools List available tools\n /clear Start a new session\n /sessions List saved sessions\n /compact Show message count\n /undo [N] Revert last N checkpoint(s) (default 1)\n /checkpoints List recent shadow-git checkpoints\n /forge [on|off] Show or toggle forge guardrails\n /forge sampling <off|on|strict> Per-model sampling policy\n /forge workflow Describe + self-test the workflow engine\n /forge proxy Describe + self-test the OpenAI-compatible proxy\n /quit Exit\n\nMulti-line: end a line with \\ to continue on the next line.\n\n")) + (display "\nCommands:\n /help Show this help\n /model [name] Show or set model\n /provider [name] Show or set provider\n /plan Switch to PLAN mode (read-only)\n /build Switch to BUILD mode (read+write)\n /mode Show current mode\n /mcp Toggle MCP tools on/off\n /tools List available tools\n /clear Start a new session\n /sessions List saved sessions\n /compact Show message count\n /undo [N] Revert last N checkpoint(s) (default 1)\n /checkpoints List recent shadow-git checkpoints\n /forge [on|off] Show or toggle forge guardrails\n /forge sampling <off|on|strict> Per-model sampling policy\n /forge workflow Describe + self-test the workflow engine\n /forge proxy Describe + self-test the OpenAI-compatible proxy\n /forge ablation Describe + self-test the eval/ablation harness\n /quit Exit\n\nMulti-line: end a line with \\ to continue on the next line.\n\n")) ((equal? cmd "model") (printf "Provider: ~a~n" (or (current-provider-override) (config-provider))) (printf "Model: ~a~n" (or (current-model-override) (config-model))) @@ -486,6 +549,8 @@ EXAMPLES: (forge-print-workflow)) ((equal? cmd "forge proxy") (forge-print-proxy)) + ((or (equal? cmd "forge eval") (equal? cmd "forge ablation")) + (forge-print-ablation)) ((or (equal? cmd "forge on") (equal? cmd "forge enforce") (equal? cmd "forge enforce on")) (forge-respond-enforced? #t) --- a/test/run.ss +++ b/test/run.ss @@ -27,6 +27,9 @@ (jcode proxy handler) (jcode core slot-worker) (jcode proxy server) + (jcode eval scenario) + (jcode eval ablation) + (jcode eval runner) (std text json)) ;; ── Helpers ────────────────────────────────────────────────────── @@ -1168,6 +1171,156 @@ (let ([r (proxy-dispatch "POST" "/health" "" p6-backend)]) (check! "wrong method → 405" (presp-status r) 405)) +(section "=== eval: scenario + check-substrings ===") +(check! "check-substrings all present" (check-substrings "The Quick Brown Fox" '("quick" "fox")) #t) +(check! "check-substrings missing" (check-substrings "hello world" '("hello" "moon")) #f) +(check! "check-substrings empty required" (check-substrings "anything" '()) #t) +(check! "check-substrings comma-stripped" (check-substrings "total: 1,000 units" '("1000")) #t) +(check! "check-substrings case-insensitive" (check-substrings "RESULT" '("result")) #t) +(let ([s (make-eval-scenario "n" "d" (lambda () #f) "um" (lambda () #f) #f)]) + (check! "scenario name" (eval-scenario-name s) "n") + (check! "scenario default max-iterations 15" (eval-scenario-max-iterations s) 15) + (check! "scenario default max-retries 5" (eval-scenario-max-retries-per-step s) 5) + (check! "scenario default max-tool-errors 2" (eval-scenario-max-tool-errors s) 2) + (check! "scenario default tags" (eval-scenario-tags s) '())) +(let ([s (make-eval-scenario "n" "d" (lambda () #f) "um" (lambda () #f) #f + (list (cons 'max-iterations 3) (cons 'tags '("a"))))]) + (check! "scenario opt max-iterations" (eval-scenario-max-iterations s) 3) + (check! "scenario opt tags" (eval-scenario-tags s) '("a"))) +(let ([r (make-run-result "n" #t #t 4 '(("k" . "v")) #f #f '())]) + (check! "run-result accuracy" (run-result-accuracy r) #t) + (check! "run-result iters" (run-result-iterations-used r) 4)) + +(section "=== eval: ablation presets ===") +(check! "preset count" (length *ablation-preset-order*) 7) +(let ([r (ablation-preset-ref "reforged")]) + (check! "reforged step-enf on" (ablation-config-step-enforcement-enabled r) #t) + (check! "reforged rescue on" (ablation-config-rescue-enabled r) #t) + (check! "reforged max-retries 5" (ablation-config-max-retries-per-step r) 5) + (check! "reforged max-tool-errors 2" (ablation-config-max-tool-errors r) 2)) +(check! "no_steps step-enf off" + (ablation-config-step-enforcement-enabled (ablation-preset-ref "no_steps")) #f) +(check! "no_recovery max-tool-errors 0" + (ablation-config-max-tool-errors (ablation-preset-ref "no_recovery")) 0) +(check! "no_nudge max-retries 0" + (ablation-config-max-retries-per-step (ablation-preset-ref "no_nudge")) 0) +(let ([b (ablation-preset-ref "bare")]) + (check! "bare rescue off" (ablation-config-rescue-enabled b) #f) + (check! "bare step-enf off" (ablation-config-step-enforcement-enabled b) #f) + (check! "bare compaction off" (ablation-config-compaction-enabled b) #f)) +(check! "preset-ref unknown → #f" (ablation-preset-ref "nope") #f) +(check! "make-ablation-config default compaction" + (ablation-config-compaction-enabled (make-ablation-config "x")) #t) + +(section "=== eval: instrument-workflow ===") +(let* ([cap (vector 'none)] + [wf (make-workflow "w" "d" + (list (make-tool-def (make-tool-spec "fin" "f" '()) (lambda (a) "done") '())) + '() "fin" "p")] + [inst (instrument-workflow wf #t cap)]) + ((workflow-get-callable inst "fin") '(("k" . "v"))) + (check! "instrument captures terminal args" (cdr (assoc "k" (vector-ref cap 0))) "v")) +(let ([wf (make-workflow "w" "d" + (list (make-tool-def (make-tool-spec "s" "s" '()) (lambda (a) "r") '()) + (make-tool-def (make-tool-spec "fin" "f" '()) (lambda (a) "done") '())) + '("s") "fin" "p")]) + (check! "instrument keeps required when enf on" + (workflow-required-steps (instrument-workflow wf #t (vector 'none))) '("s")) + (check! "instrument strips required when enf off" + (workflow-required-steps (instrument-workflow wf #f (vector 'none))) '())) + +(section "=== eval: error-type classification ===") +(check! "eval-error-type max-iterations" + (eval-error-type (guard (e [#t e]) (raise-max-iterations 5 '() '("x")))) "max_iterations") +(check! "eval-error-type step-enforcement" + (eval-error-type (guard (e [#t e]) (raise-step-enforcement "t" 3 '("s")))) "step_enforcement") +(check! "eval-error-type prerequisite" + (eval-error-type (guard (e [#t e]) (raise-prerequisite-error "t" 2 '("s")))) "prerequisite") +(check! "eval-error-type tool-execution" + (eval-error-type (guard (e [#t e]) (raise-tool-execution-error "t" "boom"))) "tool_execution") +(check! "eval-error-type non-condition" (eval-error-type "oops") "error") + +(section "=== eval: analyze-messages ===") +(let* ([msgs (list + (make-system-message "sys") + (make-user-message "u") + (make-assistant-message "thinking out loud") + (make-assistant-message "" (list (make-tool-call "search" '()) + (make-tool-call "search" '()))) + (make-tool-result "id1" "[StepEnforcementError] nudge") + (make-tool-result "id2" "[ToolError] boom") + (make-tool-result "id3" "ok result") + (make-assistant-message "" (list (make-tool-call "answer" '()))))] + [st (analyze-messages msgs)]) + (check! "analyze total tool-calls" (history-stats-total-tool-calls st) 3) + (check! "analyze unique tools" (history-stats-unique-tools st) 2) + (check! "analyze step nudges" (history-stats-step-nudges st) 1) + (check! "analyze tool errors" (history-stats-tool-errors st) 1) + (check! "analyze reasoning msgs" (history-stats-reasoning-messages st) 1)) + +(section "=== eval: run-eval-scenario + ablation ===") +;; demo: scripted model answers before searching; step enforcement nudges it. +(define (eval-demo-scenario) + (make-eval-scenario + "demo" "premature answer nudged to search" + (lambda () + (let ([searched (vector #f)]) + (cons + (make-workflow "research" "search then answer" + (list + (make-tool-def (make-tool-spec "search" "s" '(("type" . "object"))) + (lambda (a) (vector-set! searched 0 #t) "results") '()) + (make-tool-def (make-tool-spec "answer" "a" '(("type" . "object"))) + (lambda (a) "answered") '())) + '("search") "answer" "p") + (lambda () (vector-ref searched 0))))) + "look it up" + (lambda () + (scripted-responder + (list (list (make-wtool-call "answer" '(("text" . "early")) #f)) + (list (make-wtool-call "search" '(("q" . "x")) #f)) + (list (make-wtool-call "answer" '(("text" . "final")) #f))))) + (lambda (args) (and args (assoc "text" args) #t)) + '((max-iterations . 8)))) +(let ([on (run-eval-scenario (eval-demo-scenario))]) + (check! "demo reforged completeness" (run-result-completeness on) #t) + (check! "demo reforged accuracy" (run-result-accuracy on) #t) + (check! "demo reforged iters 3" (run-result-iterations-used on) 3) + (check! "demo reforged error-type #f" (run-result-error-type on) #f) + (check! "demo reforged terminal text=final" + (cdr (assoc "text" (run-result-terminal-args on))) "final")) +(let ([off (run-eval-scenario (eval-demo-scenario) + (list (cons 'ablation (ablation-preset-ref "no_steps"))))]) + (check! "demo no_steps completeness" (run-result-completeness off) #t) + (check! "demo no_steps accuracy #f (ungrounded)" (run-result-accuracy off) #f) + (check! "demo no_steps iters 1" (run-result-iterations-used off) 1) + (check! "demo no_steps answered immediately" + (cdr (assoc "text" (run-result-terminal-args off))) "early")) +;; never-terminating scenario → max_iterations +(let ([r (run-eval-scenario + (make-eval-scenario "loop" "never terminates" + (lambda () + (make-workflow "w" "d" + (list (make-tool-def (make-tool-spec "noop" "n" '()) (lambda (a) "ok") '()) + (make-tool-def (make-tool-spec "done" "d" '()) (lambda (a) "x") '())) + '() "done" "p")) + "go" + (lambda () (scripted-responder (list (list (make-wtool-call "noop" '() #f))))) + #f + (list (cons 'max-iterations 3))))]) + (check! "loop scenario not complete" (run-result-completeness r) #f) + (check! "loop scenario error-type max_iterations" (run-result-error-type r) "max_iterations") + (check! "loop scenario accuracy #f" (run-result-accuracy r) #f)) +;; ablation sweep + pass-rate aggregation +(let* ([rows (run-ablation (eval-demo-scenario) + (list (ablation-preset-ref "reforged") (ablation-preset-ref "no_steps")))] + [rates (ablation-pass-rates rows)]) + (check! "ablation rows count" (length rows) 2) + (check! "ablation reforged passed" (run-result-accuracy (cdr (assoc "reforged" rows))) #t) + (check! "ablation no_steps failed" (run-result-accuracy (cdr (assoc "no_steps" rows))) #f) + (check! "pass-rate reforged 1/1" (cdr (assoc "reforged" rates)) '(1 . 1)) + (check! "pass-rate no_steps 0/1" (cdr (assoc "no_steps" rates)) '(0 . 1))) + ;; ── Results ─────────────────────────────────────────────────────── (printf "~n~a passed, ~a failed~n" pass-count fail-count)