From a79caed27bf47ae22c4a9aa18ab33c3f252ec562 Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 3 Apr 2026 15:59:12 +0000 Subject: [PATCH] Fix 2 pre-existing scope test failures: CEK-to-scope_stacks fallback When aser manages scope via scope_stacks but a sub-expression falls through to the CEK machine, context/emit!/emitted couldn't find the scope frames (they're in scope_stacks, not on the kont). Now the CEK special forms fall back to env-bound primitives when kont lookup fails. 2568/2568 tests pass (was 2566/2568). Co-Authored-By: Claude Opus 4.6 (1M context) --- hosts/ocaml/lib/sx_ref.ml | 6 +++--- spec/evaluator.sx | 27 ++++++++++++++++++--------- 2 files changed, 21 insertions(+), 12 deletions(-) diff --git a/hosts/ocaml/lib/sx_ref.ml b/hosts/ocaml/lib/sx_ref.ml index 7b37d638..5f0e6dc5 100644 --- a/hosts/ocaml/lib/sx_ref.ml +++ b/hosts/ocaml/lib/sx_ref.ml @@ -507,15 +507,15 @@ and step_sf_provide args env kont = (* step-sf-context *) and step_sf_context args env kont = - (let name = (trampoline ((eval_expr ((first (args))) (env)))) in let default_val = (if sx_truthy ((prim_call ">=" [(len (args)); (Number 2.0)])) then (trampoline ((eval_expr ((nth (args) ((Number 1.0)))) (env)))) else Nil) in let frame = (kont_find_provide (kont) (name)) in (make_cek_value ((if sx_truthy ((is_nil (frame))) then default_val else (get (frame) ((String "value"))))) (env) (kont))) + (let name = (trampoline ((eval_expr ((first (args))) (env)))) in let default_val = (if sx_truthy ((prim_call ">=" [(len (args)); (Number 2.0)])) then (trampoline ((eval_expr ((nth (args) ((Number 1.0)))) (env)))) else Nil) in let frame = (kont_find_provide (kont) (name)) in (make_cek_value ((if sx_truthy (frame) then (get (frame) ((String "value"))) else (if sx_truthy ((env_has (env) ((String "context")))) then (sx_apply (env_get (env) ((String "context"))) (List [name; default_val])) else default_val))) (env) (kont))) (* step-sf-emit *) and step_sf_emit args env kont = - (let name = (trampoline ((eval_expr ((first (args))) (env)))) in let val' = (trampoline ((eval_expr ((nth (args) ((Number 1.0)))) (env)))) in let frame = (kont_find_scope_acc (kont) (name)) in (let () = ignore ((if sx_truthy (frame) then (sx_dict_set_b frame (String "emitted") (prim_call "append" [(get (frame) ((String "emitted"))); (List [val'])])) else Nil)) in (make_cek_value (Nil) (env) (kont)))) + (let name = (trampoline ((eval_expr ((first (args))) (env)))) in let val' = (trampoline ((eval_expr ((nth (args) ((Number 1.0)))) (env)))) in let frame = (kont_find_scope_acc (kont) (name)) in (if sx_truthy (frame) then (let () = ignore ((sx_dict_set_b frame (String "emitted") (prim_call "append" [(get (frame) ((String "emitted"))); (List [val'])]))) in (make_cek_value (Nil) (env) (kont))) else (let () = ignore ((if sx_truthy ((env_has (env) ((String "scope-emit!")))) then (sx_apply (env_get (env) ((String "scope-emit!"))) (List [name; val'])) else Nil)) in (make_cek_value (Nil) (env) (kont))))) (* step-sf-emitted *) and step_sf_emitted args env kont = - (let name = (trampoline ((eval_expr ((first (args))) (env)))) in let frame = (kont_find_scope_acc (kont) (name)) in (make_cek_value ((if sx_truthy ((is_nil (frame))) then (List []) else (get (frame) ((String "emitted"))))) (env) (kont))) + (let name = (trampoline ((eval_expr ((first (args))) (env)))) in let frame = (kont_find_scope_acc (kont) (name)) in (make_cek_value ((if sx_truthy (frame) then (get (frame) ((String "emitted"))) else (if sx_truthy ((env_has (env) ((String "emitted")))) then (sx_apply (env_get (env) ((String "emitted"))) (List [name])) else (List [])))) (env) (kont))) (* step-sf-reset *) and step_sf_reset args env kont = diff --git a/spec/evaluator.sx b/spec/evaluator.sx index 7b0dd55f..f781c59d 100644 --- a/spec/evaluator.sx +++ b/spec/evaluator.sx @@ -1701,7 +1701,11 @@ nil)) (frame (kont-find-provide kont name))) (make-cek-value - (if (nil? frame) default-val (get frame "value")) + (if frame + (get frame "value") + (if (env-has? env "context") + (apply (env-get env "context") (list name default-val)) + default-val)) env kont)))) @@ -1713,13 +1717,14 @@ ((name (trampoline (eval-expr (first args) env))) (val (trampoline (eval-expr (nth args 1) env))) (frame (kont-find-scope-acc kont name))) - (when - frame - (dict-set! - frame - "emitted" - (append (get frame "emitted") (list val)))) - (make-cek-value nil env kont)))) + (if frame + (do + (dict-set! frame "emitted" (append (get frame "emitted") (list val))) + (make-cek-value nil env kont)) + (do + (when (env-has? env "scope-emit!") + (apply (env-get env "scope-emit!") (list name val))) + (make-cek-value nil env kont)))))) (define step-sf-emitted @@ -1729,7 +1734,11 @@ ((name (trampoline (eval-expr (first args) env))) (frame (kont-find-scope-acc kont name))) (make-cek-value - (if (nil? frame) (list) (get frame "emitted")) + (if frame + (get frame "emitted") + (if (env-has? env "emitted") + (apply (env-get env "emitted") (list name)) + (list))) env kont))))