coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Fix 2 pre-existing scope test failures: CEK-to-scope_stacks fallback

Browse Source 
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) <noreply@anthropic.com>
This commit is contained in:
giles
2026-04-03 15:59:12 +00:00
parent 41e76b886f
commit a79caed27b
2 changed files with 21 additions and 12 deletions
Download Patch File Download Diff File Expand all files Collapse all files

6
hosts/ocaml/lib/sx_ref.ml
View File

@@ -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 =

27
spec/evaluator.sx
View File

@@ -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))))