Unify scope mechanism: one world (hashtable stacks everywhere)

Replace continuation-based scope frames with hashtable stacks for all
scope operations. The CEK evaluator's scope/provide/context/emit!/emitted
now use scope-push!/pop!/peek/emit! primitives (registered in
sx_primitives table) instead of walking continuation frames.

This eliminates the two-world problem where the aser used hashtable
stacks (scope-push!/pop!) but eval-expr used continuation frames
(ScopeFrame/ScopeAccFrame). Now both paths share the same mechanism.

Benefits:
- scope/context works inside eval-expr calls (e.g. (str ... (context x)))
- O(1) scope lookup vs O(n) continuation walking
- Simpler — no ScopeFrame/ScopeAccFrame/ProvideFrame creation/dispatch
- VM-compiled code and CEK code both see the same scope state

Also registers scope-push!/pop!/peek/emit!/collect!/collected/
clear-collected! as real primitives (sx_primitives table) so the
transpiled evaluator can call them directly.

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
2026-03-23 09:45:25 +00:00
parent 4734d38f3b
commit 09feb51762
5 changed files with 71 additions and 64 deletions

View File

@@ -129,6 +129,20 @@ let io_counter = ref 0
scope-push!/pop!) and step-sf-context (via get-primitive "scope-peek"). *)
let _scope_stacks : (string, value list) Hashtbl.t = Hashtbl.create 8
let () = Sx_primitives.register "scope-push!" (fun args ->
match args with
| [String name; value] ->
let stack = try Hashtbl.find _scope_stacks name with Not_found -> [] in
Hashtbl.replace _scope_stacks name (value :: stack); Nil
| _ -> Nil)
let () = Sx_primitives.register "scope-pop!" (fun args ->
match args with
| [String name] ->
let stack = try Hashtbl.find _scope_stacks name with Not_found -> [] in
(match stack with _ :: rest -> Hashtbl.replace _scope_stacks name rest | [] -> ()); Nil
| _ -> Nil)
let () = Sx_primitives.register "scope-peek" (fun args ->
match args with
| [String name] ->
@@ -160,6 +174,22 @@ let () = Sx_primitives.register "collected" (fun args ->
(match stack with List items :: _ -> List items | _ -> List [])
| _ -> List [])
let () = Sx_primitives.register "scope-emit!" (fun args ->
match args with
| [String name; value] ->
let stack = try Hashtbl.find _scope_stacks name with Not_found -> [] in
(match stack with
| List items :: rest ->
Hashtbl.replace _scope_stacks name (List (items @ [value]) :: rest)
| Nil :: rest ->
Hashtbl.replace _scope_stacks name (List [value] :: rest)
| [] ->
(* Lazy root scope *)
Hashtbl.replace _scope_stacks name [List [value]]
| _ :: _ -> ());
Nil
| _ -> Nil)
let () = Sx_primitives.register "clear-collected!" (fun args ->
match args with
| [String name] ->

View File

@@ -395,23 +395,23 @@ and step_sf_lambda args env kont =
(* step-sf-scope *)
and step_sf_scope args env kont =
(let name = (trampoline ((eval_expr ((first (args))) (env)))) in let rest_args = (prim_call "slice" [args; (Number 1.0)]) in let val' = ref (Nil) in let body = ref (Nil) in (let () = ignore ((if sx_truthy ((let _and = (prim_call ">=" [(len (rest_args)); (Number 2.0)]) in if not (sx_truthy _and) then _and else (let _and = (prim_call "=" [(type_of ((first (rest_args)))); (String "keyword")]) in if not (sx_truthy _and) then _and else (prim_call "=" [(keyword_name ((first (rest_args)))); (String "value")])))) then (let () = ignore ((val' := (trampoline ((eval_expr ((nth (rest_args) ((Number 1.0)))) (env)))); Nil)) in (body := (prim_call "slice" [rest_args; (Number 2.0)]); Nil)) else (body := rest_args; Nil))) in (if sx_truthy ((empty_p (!body))) then (make_cek_value (Nil) (env) (kont)) else (if sx_truthy ((prim_call "=" [(len (!body)); (Number 1.0)])) then (make_cek_state ((first (!body))) (env) ((kont_push ((make_scope_acc_frame (name) (!val') ((List [])) (env))) (kont)))) else (make_cek_state ((first (!body))) (env) ((kont_push ((make_scope_acc_frame (name) (!val') ((rest (!body))) (env))) (kont))))))))
(let name = (trampoline ((eval_expr ((first (args))) (env)))) in let rest_args = (prim_call "slice" [args; (Number 1.0)]) in let val' = ref (Nil) in let body = ref (Nil) in (let () = ignore ((if sx_truthy ((let _and = (prim_call ">=" [(len (rest_args)); (Number 2.0)]) in if not (sx_truthy _and) then _and else (let _and = (prim_call "=" [(type_of ((first (rest_args)))); (String "keyword")]) in if not (sx_truthy _and) then _and else (prim_call "=" [(keyword_name ((first (rest_args)))); (String "value")])))) then (let () = ignore ((val' := (trampoline ((eval_expr ((nth (rest_args) ((Number 1.0)))) (env)))); Nil)) in (body := (prim_call "slice" [rest_args; (Number 2.0)]); Nil)) else (body := rest_args; Nil))) in (let () = ignore ((scope_push (name) (!val'))) in (let result' = ref (Nil) in (let () = ignore ((List.iter (fun expr -> ignore ((result' := (trampoline ((eval_expr (expr) (env)))); Nil))) (sx_to_list !body); Nil)) in (let () = ignore ((scope_pop (name))) in (make_cek_value (!result') (env) (kont))))))))
(* step-sf-provide *)
and step_sf_provide 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 body = (prim_call "slice" [args; (Number 2.0)]) in (if sx_truthy ((empty_p (body))) then (make_cek_value (Nil) (env) (kont)) else (if sx_truthy ((prim_call "=" [(len (body)); (Number 1.0)])) then (make_cek_state ((first (body))) (env) ((kont_push ((make_provide_frame (name) (val') ((List [])) (env))) (kont)))) else (make_cek_state ((first (body))) (env) ((kont_push ((make_provide_frame (name) (val') ((rest (body))) (env))) (kont)))))))
(let name = (trampoline ((eval_expr ((first (args))) (env)))) in let val' = (trampoline ((eval_expr ((nth (args) ((Number 1.0)))) (env)))) in let body = (prim_call "slice" [args; (Number 2.0)]) in (let () = ignore ((scope_push (name) (val'))) in (let result' = ref (Nil) in (let () = ignore ((List.iter (fun expr -> ignore ((result' := (trampoline ((eval_expr (expr) (env)))); Nil))) (sx_to_list body); Nil)) in (let () = ignore ((scope_pop (name))) in (make_cek_value (!result') (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 stack_val = (if sx_truthy ((is_primitive ((String "scope-peek")))) then (cek_call ((get_primitive ((String "scope-peek")))) (List [name])) else Nil) in (if sx_truthy ((Bool (not (sx_truthy ((is_nil (stack_val))))))) then (make_cek_value (stack_val) (env) (kont)) else (let frame = (kont_find_provide (kont) (name)) in (if sx_truthy (frame) then (make_cek_value ((get (frame) ((String "value")))) (env) (kont)) else (if sx_truthy ((prim_call ">=" [(len (args)); (Number 2.0)])) then (make_cek_value (default_val) (env) (kont)) else (raise (Eval_error (value_to_str (String (sx_str [(String "No provider for: "); name])))))))))))
(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 val' = (scope_peek (name)) in (make_cek_value ((if sx_truthy ((is_nil (val'))) then default_val else 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 (if sx_truthy (frame) then (let () = ignore ((sx_append_b (get (frame) ((String "emitted"))) val')) in (make_cek_value (Nil) (env) (kont))) else (raise (Eval_error (value_to_str (String (sx_str [(String "No scope for emit!: "); name])))))))
(let name = (trampoline ((eval_expr ((first (args))) (env)))) in let val' = (trampoline ((eval_expr ((nth (args) ((Number 1.0)))) (env)))) in (let () = ignore ((scope_emit (name) (val'))) 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 (if sx_truthy (frame) then (make_cek_value ((get (frame) ((String "emitted")))) (env) (kont)) else (raise (Eval_error (value_to_str (String (sx_str [(String "No scope for emitted: "); name])))))))
(let name = (trampoline ((eval_expr ((first (args))) (env)))) in let val' = (scope_peek (name)) in (make_cek_value ((if sx_truthy ((is_nil (val'))) then (List []) else val')) (env) (kont)))
(* step-sf-reset *)
and step_sf_reset args env kont =

View File

@@ -315,11 +315,13 @@ let dynamic_wind_call before body after _env =
ignore (sx_call after []);
result
(* Scope stack stubs — delegated to primitives when available *)
let scope_push name value = prim_call "collect!" [name; value]
let scope_pop _name = Nil
let provide_push name value = ignore name; ignore value; Nil
let provide_pop _name = Nil
(* Scope stack — all delegated to primitives registered in sx_server.ml *)
let scope_push name value = prim_call "scope-push!" [name; value]
let scope_pop name = prim_call "scope-pop!" [name]
let scope_peek name = prim_call "scope-peek" [name]
let scope_emit name value = prim_call "scope-emit!" [name; value]
let provide_push name value = prim_call "scope-push!" [name; value]
let provide_pop name = prim_call "scope-pop!" [name]
(* Custom special forms registry — mutable dict *)
let custom_special_forms = Dict (Hashtbl.create 4)

View File

@@ -120,6 +120,8 @@
"emitted" "sx_emitted"
"scope-push!" "scope_push"
"scope-pop!" "scope_pop"
"scope-peek" "scope_peek"
"scope-emit!" "scope_emit"
"provide-push!" "provide_push"
"provide-pop!" "provide_pop"
"sx-serialize" "sx_serialize"