From 09feb51762a3a97abd45e858617cf2b4fbf4aa1e Mon Sep 17 00:00:00 2001 From: giles Date: Mon, 23 Mar 2026 09:45:25 +0000 Subject: [PATCH] Unify scope mechanism: one world (hashtable stacks everywhere) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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) --- hosts/ocaml/bin/sx_server.ml | 30 +++++++++++++ hosts/ocaml/lib/sx_ref.ml | 10 ++--- hosts/ocaml/lib/sx_runtime.ml | 12 +++--- hosts/ocaml/transpiler.sx | 2 + spec/evaluator.sx | 81 ++++++++++++----------------------- 5 files changed, 71 insertions(+), 64 deletions(-) diff --git a/hosts/ocaml/bin/sx_server.ml b/hosts/ocaml/bin/sx_server.ml index da06a5a..85c16d5 100644 --- a/hosts/ocaml/bin/sx_server.ml +++ b/hosts/ocaml/bin/sx_server.ml @@ -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] -> diff --git a/hosts/ocaml/lib/sx_ref.ml b/hosts/ocaml/lib/sx_ref.ml index e314584..918cd67 100644 --- a/hosts/ocaml/lib/sx_ref.ml +++ b/hosts/ocaml/lib/sx_ref.ml @@ -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 = diff --git a/hosts/ocaml/lib/sx_runtime.ml b/hosts/ocaml/lib/sx_runtime.ml index 15cd6a7..5468e17 100644 --- a/hosts/ocaml/lib/sx_runtime.ml +++ b/hosts/ocaml/lib/sx_runtime.ml @@ -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) diff --git a/hosts/ocaml/transpiler.sx b/hosts/ocaml/transpiler.sx index bed73c9..670596b 100644 --- a/hosts/ocaml/transpiler.sx +++ b/hosts/ocaml/transpiler.sx @@ -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" diff --git a/spec/evaluator.sx b/spec/evaluator.sx index e5a05d9..9d1f5ee 100644 --- a/spec/evaluator.sx +++ b/spec/evaluator.sx @@ -1432,7 +1432,11 @@ (make-cek-value (sf-lambda args env) env kont))) ;; scope: evaluate name, then push ScopeFrame -;; scope: push ScopeAccFrame, evaluate body. emit!/emitted walk kont. +;; scope/provide/context/emit!/emitted — ALL use hashtable stacks. +;; One world: the aser and CEK share the same scope mechanism. +;; No continuation frame walking — scope-push!/pop!/peek are the primitives. + +;; scope: push scope, evaluate body, pop scope. ;; (scope name body...) or (scope name :value v body...) (define step-sf-scope (fn (args env kont) @@ -1440,85 +1444,54 @@ (rest-args (slice args 1)) (val nil) (body nil)) - ;; Check for :value keyword (if (and (>= (len rest-args) 2) (= (type-of (first rest-args)) "keyword") (= (keyword-name (first rest-args)) "value")) (do (set! val (trampoline (eval-expr (nth rest-args 1) env))) (set! body (slice rest-args 2))) (set! body rest-args)) - ;; Push ScopeAccFrame and start evaluating body - (if (empty? body) - (make-cek-value nil env kont) - (if (= (len body) 1) - (make-cek-state (first body) env - (kont-push (make-scope-acc-frame name val (list) env) kont)) - (make-cek-state (first body) env - (kont-push - (make-scope-acc-frame name val (rest body) env) - kont))))))) + (scope-push! name val) + (let ((result nil)) + (for-each (fn (expr) (set! result (trampoline (eval-expr expr env)))) body) + (scope-pop! name) + (make-cek-value result env kont))))) -;; provide: push ProvideFrame, evaluate body. context walks kont to read. -;; (provide name value body...) +;; provide: sugar for scope with value. (define step-sf-provide (fn (args env kont) (let ((name (trampoline (eval-expr (first args) env))) (val (trampoline (eval-expr (nth args 1) env))) (body (slice args 2))) - ;; Push ProvideFrame and start evaluating body - (if (empty? body) - (make-cek-value nil env kont) - (if (= (len body) 1) - (make-cek-state (first body) env - (kont-push (make-provide-frame name val (list) env) kont)) - (make-cek-state (first body) env - (kont-push - (make-provide-frame name val (rest body) env) - kont))))))) + (scope-push! name val) + (let ((result nil)) + (for-each (fn (expr) (set! result (trampoline (eval-expr expr env)))) body) + (scope-pop! name) + (make-cek-value result env kont))))) -;; context: check hashtable scope stacks first (set by aser's scope-push!), -;; then walk kont for nearest ProvideFrame with matching name. -;; The hashtable check is needed because aser renders scopes via scope-push!/pop! -;; but inner eval-expr calls (e.g. inside (str ...)) use the CEK continuation. +;; context: read from scope stack. (define step-sf-context (fn (args env kont) (let ((name (trampoline (eval-expr (first args) env))) (default-val (if (>= (len args) 2) (trampoline (eval-expr (nth args 1) env)) - nil))) - ;; Check hashtable scope stacks first (aser rendering path) - (let ((stack-val (if (primitive? "scope-peek") - ((get-primitive "scope-peek") name) - nil))) - (if (not (nil? stack-val)) - (make-cek-value stack-val env kont) - ;; Fall back to continuation-based lookup - (let ((frame (kont-find-provide kont name))) - (if frame - (make-cek-value (get frame "value") env kont) - (if (>= (len args) 2) - (make-cek-value default-val env kont) - (error (str "No provider for: " name)))))))))) + nil)) + (val (scope-peek name))) + (make-cek-value (if (nil? val) default-val val) env kont)))) -;; emit!: walk kont for nearest ScopeAccFrame, append value +;; emit!: append to scope accumulator. (define step-sf-emit (fn (args env kont) (let ((name (trampoline (eval-expr (first args) env))) - (val (trampoline (eval-expr (nth args 1) env))) - (frame (kont-find-scope-acc kont name))) - (if frame - (do (append! (get frame "emitted") val) - (make-cek-value nil env kont)) - (error (str "No scope for emit!: " name)))))) + (val (trampoline (eval-expr (nth args 1) env)))) + (scope-emit! name val) + (make-cek-value nil env kont)))) -;; emitted: walk kont for nearest ScopeAccFrame, return accumulated list +;; emitted: read accumulated scope values. (define step-sf-emitted (fn (args env kont) (let ((name (trampoline (eval-expr (first args) env))) - (frame (kont-find-scope-acc kont name))) - (if frame - (make-cek-value (get frame "emitted") env kont) - (error (str "No scope for emitted: " name)))))) + (val (scope-peek name))) + (make-cek-value (if (nil? val) (list) val) env kont)))) ;; reset: push ResetFrame, evaluate body (define step-sf-reset