CEK frame records: eliminate Hashtbl for all 29 frame types

Transpiler detects dict literals with a "type" string field and emits
CekFrame records instead of Dict(Hashtbl). Maps frame-specific fields
to generic record slots:

  cf_type, cf_env, cf_name, cf_body, cf_remaining, cf_f,
  cf_args (also evaled), cf_results (also raw-args),
  cf_extra (ho-type/scheme/indexed/match-val/current-item/...),
  cf_extra2 (emitted/effect-list/first-render)

Runtime get_val handles CekFrame with direct field match — O(1)
field access vs Hashtbl.find.

Bootstrapper: skip stdlib.sx entirely (already OCaml primitives).

Result: 29 CekFrame + 2 CekState = 31 record types, only 8
Hashtbl.create remaining (effect-annotations, empty dicts).

Benchmark (200 divs): 2.94s → 1.71s (1.7x speedup from baseline).
Real pages: ~same as CekState-only (frames are <20% of allocations;
states dominate at 199K/page).

Foundation for JIT: record-based value representation enables
typed compilation — JIT can emit direct field access instead of
hash table lookups.

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
2026-03-19 17:56:50 +00:00
parent c16142d14c
commit d9e80d8544
4 changed files with 110 additions and 36 deletions

View File

@@ -58,119 +58,119 @@ and cek_value s =
(* make-if-frame *)
and make_if_frame then_expr else_expr env =
(let _d = Hashtbl.create 4 in Hashtbl.replace _d "type" (String "if"); Hashtbl.replace _d "then" then_expr; Hashtbl.replace _d "else" else_expr; Hashtbl.replace _d "env" env; Dict _d)
(CekFrame { cf_type = "if"; cf_env = env; cf_name = else_expr; cf_body = then_expr; cf_remaining = Nil; cf_f = Nil; cf_args = Nil; cf_results = Nil; cf_extra = Nil; cf_extra2 = Nil })
(* make-when-frame *)
and make_when_frame body_exprs env =
(let _d = Hashtbl.create 3 in Hashtbl.replace _d "type" (String "when"); Hashtbl.replace _d "body" body_exprs; Hashtbl.replace _d "env" env; Dict _d)
(CekFrame { cf_type = "when"; cf_env = env; cf_name = Nil; cf_body = body_exprs; cf_remaining = Nil; cf_f = Nil; cf_args = Nil; cf_results = Nil; cf_extra = Nil; cf_extra2 = Nil })
(* make-begin-frame *)
and make_begin_frame remaining env =
(let _d = Hashtbl.create 3 in Hashtbl.replace _d "type" (String "begin"); Hashtbl.replace _d "remaining" remaining; Hashtbl.replace _d "env" env; Dict _d)
(CekFrame { cf_type = "begin"; cf_env = env; cf_name = Nil; cf_body = Nil; cf_remaining = remaining; cf_f = Nil; cf_args = Nil; cf_results = Nil; cf_extra = Nil; cf_extra2 = Nil })
(* make-let-frame *)
and make_let_frame name remaining body local =
(let _d = Hashtbl.create 5 in Hashtbl.replace _d "type" (String "let"); Hashtbl.replace _d "name" name; Hashtbl.replace _d "remaining" remaining; Hashtbl.replace _d "body" body; Hashtbl.replace _d "env" local; Dict _d)
(CekFrame { cf_type = "let"; cf_env = local; cf_name = name; cf_body = body; cf_remaining = remaining; cf_f = Nil; cf_args = Nil; cf_results = Nil; cf_extra = Nil; cf_extra2 = Nil })
(* make-define-frame *)
and make_define_frame name env has_effects effect_list =
(let _d = Hashtbl.create 5 in Hashtbl.replace _d "type" (String "define"); Hashtbl.replace _d "name" name; Hashtbl.replace _d "env" env; Hashtbl.replace _d "has-effects" has_effects; Hashtbl.replace _d "effect-list" effect_list; Dict _d)
(CekFrame { cf_type = "define"; cf_env = env; cf_name = name; cf_body = Nil; cf_remaining = Nil; cf_f = Nil; cf_args = Nil; cf_results = Nil; cf_extra = has_effects; cf_extra2 = effect_list })
(* make-set-frame *)
and make_set_frame name env =
(let _d = Hashtbl.create 3 in Hashtbl.replace _d "type" (String "set"); Hashtbl.replace _d "name" name; Hashtbl.replace _d "env" env; Dict _d)
(CekFrame { cf_type = "set"; cf_env = env; cf_name = name; cf_body = Nil; cf_remaining = Nil; cf_f = Nil; cf_args = Nil; cf_results = Nil; cf_extra = Nil; cf_extra2 = Nil })
(* make-arg-frame *)
and make_arg_frame f evaled remaining env raw_args head_name =
(let _d = Hashtbl.create 7 in Hashtbl.replace _d "type" (String "arg"); Hashtbl.replace _d "f" f; Hashtbl.replace _d "evaled" evaled; Hashtbl.replace _d "remaining" remaining; Hashtbl.replace _d "env" env; Hashtbl.replace _d "raw-args" raw_args; Hashtbl.replace _d "head-name" (let _or = head_name in if sx_truthy _or then _or else Nil); Dict _d)
(CekFrame { cf_type = "arg"; cf_env = env; cf_name = Nil; cf_body = Nil; cf_remaining = remaining; cf_f = f; cf_args = evaled; cf_results = raw_args; cf_extra = (let _or = head_name in if sx_truthy _or then _or else Nil); cf_extra2 = Nil })
(* make-call-frame *)
and make_call_frame f args env =
(let _d = Hashtbl.create 4 in Hashtbl.replace _d "type" (String "call"); Hashtbl.replace _d "f" f; Hashtbl.replace _d "args" args; Hashtbl.replace _d "env" env; Dict _d)
(CekFrame { cf_type = "call"; cf_env = env; cf_name = Nil; cf_body = Nil; cf_remaining = Nil; cf_f = f; cf_args = args; cf_results = Nil; cf_extra = Nil; cf_extra2 = Nil })
(* make-cond-frame *)
and make_cond_frame remaining env scheme_p =
(let _d = Hashtbl.create 4 in Hashtbl.replace _d "type" (String "cond"); Hashtbl.replace _d "remaining" remaining; Hashtbl.replace _d "env" env; Hashtbl.replace _d "scheme" scheme_p; Dict _d)
(CekFrame { cf_type = "cond"; cf_env = env; cf_name = Nil; cf_body = Nil; cf_remaining = remaining; cf_f = Nil; cf_args = Nil; cf_results = Nil; cf_extra = scheme_p; cf_extra2 = Nil })
(* make-case-frame *)
and make_case_frame match_val remaining env =
(let _d = Hashtbl.create 4 in Hashtbl.replace _d "type" (String "case"); Hashtbl.replace _d "match-val" match_val; Hashtbl.replace _d "remaining" remaining; Hashtbl.replace _d "env" env; Dict _d)
(CekFrame { cf_type = "case"; cf_env = env; cf_name = Nil; cf_body = Nil; cf_remaining = remaining; cf_f = Nil; cf_args = Nil; cf_results = Nil; cf_extra = match_val; cf_extra2 = Nil })
(* make-thread-frame *)
and make_thread_frame remaining env =
(let _d = Hashtbl.create 3 in Hashtbl.replace _d "type" (String "thread"); Hashtbl.replace _d "remaining" remaining; Hashtbl.replace _d "env" env; Dict _d)
(CekFrame { cf_type = "thread"; cf_env = env; cf_name = Nil; cf_body = Nil; cf_remaining = remaining; cf_f = Nil; cf_args = Nil; cf_results = Nil; cf_extra = Nil; cf_extra2 = Nil })
(* make-map-frame *)
and make_map_frame f remaining results env =
(let _d = Hashtbl.create 6 in Hashtbl.replace _d "type" (String "map"); Hashtbl.replace _d "f" f; Hashtbl.replace _d "remaining" remaining; Hashtbl.replace _d "results" results; Hashtbl.replace _d "env" env; Hashtbl.replace _d "indexed" (Bool false); Dict _d)
(CekFrame { cf_type = "map"; cf_env = env; cf_name = Nil; cf_body = Nil; cf_remaining = remaining; cf_f = f; cf_args = Nil; cf_results = results; cf_extra = (Bool false); cf_extra2 = Nil })
(* make-map-indexed-frame *)
and make_map_indexed_frame f remaining results env =
(let _d = Hashtbl.create 6 in Hashtbl.replace _d "type" (String "map"); Hashtbl.replace _d "f" f; Hashtbl.replace _d "remaining" remaining; Hashtbl.replace _d "results" results; Hashtbl.replace _d "env" env; Hashtbl.replace _d "indexed" (Bool true); Dict _d)
(CekFrame { cf_type = "map"; cf_env = env; cf_name = Nil; cf_body = Nil; cf_remaining = remaining; cf_f = f; cf_args = Nil; cf_results = results; cf_extra = (Bool true); cf_extra2 = Nil })
(* make-filter-frame *)
and make_filter_frame f remaining results current_item env =
(let _d = Hashtbl.create 6 in Hashtbl.replace _d "type" (String "filter"); Hashtbl.replace _d "f" f; Hashtbl.replace _d "remaining" remaining; Hashtbl.replace _d "results" results; Hashtbl.replace _d "current-item" current_item; Hashtbl.replace _d "env" env; Dict _d)
(CekFrame { cf_type = "filter"; cf_env = env; cf_name = Nil; cf_body = Nil; cf_remaining = remaining; cf_f = f; cf_args = Nil; cf_results = results; cf_extra = current_item; cf_extra2 = Nil })
(* make-reduce-frame *)
and make_reduce_frame f remaining env =
(let _d = Hashtbl.create 4 in Hashtbl.replace _d "type" (String "reduce"); Hashtbl.replace _d "f" f; Hashtbl.replace _d "remaining" remaining; Hashtbl.replace _d "env" env; Dict _d)
(CekFrame { cf_type = "reduce"; cf_env = env; cf_name = Nil; cf_body = Nil; cf_remaining = remaining; cf_f = f; cf_args = Nil; cf_results = Nil; cf_extra = Nil; cf_extra2 = Nil })
(* make-for-each-frame *)
and make_for_each_frame f remaining env =
(let _d = Hashtbl.create 4 in Hashtbl.replace _d "type" (String "for-each"); Hashtbl.replace _d "f" f; Hashtbl.replace _d "remaining" remaining; Hashtbl.replace _d "env" env; Dict _d)
(CekFrame { cf_type = "for-each"; cf_env = env; cf_name = Nil; cf_body = Nil; cf_remaining = remaining; cf_f = f; cf_args = Nil; cf_results = Nil; cf_extra = Nil; cf_extra2 = Nil })
(* make-some-frame *)
and make_some_frame f remaining env =
(let _d = Hashtbl.create 4 in Hashtbl.replace _d "type" (String "some"); Hashtbl.replace _d "f" f; Hashtbl.replace _d "remaining" remaining; Hashtbl.replace _d "env" env; Dict _d)
(CekFrame { cf_type = "some"; cf_env = env; cf_name = Nil; cf_body = Nil; cf_remaining = remaining; cf_f = f; cf_args = Nil; cf_results = Nil; cf_extra = Nil; cf_extra2 = Nil })
(* make-every-frame *)
and make_every_frame f remaining env =
(let _d = Hashtbl.create 4 in Hashtbl.replace _d "type" (String "every"); Hashtbl.replace _d "f" f; Hashtbl.replace _d "remaining" remaining; Hashtbl.replace _d "env" env; Dict _d)
(CekFrame { cf_type = "every"; cf_env = env; cf_name = Nil; cf_body = Nil; cf_remaining = remaining; cf_f = f; cf_args = Nil; cf_results = Nil; cf_extra = Nil; cf_extra2 = Nil })
(* make-scope-frame *)
and make_scope_frame name remaining env =
(let _d = Hashtbl.create 4 in Hashtbl.replace _d "type" (String "scope"); Hashtbl.replace _d "name" name; Hashtbl.replace _d "remaining" remaining; Hashtbl.replace _d "env" env; Dict _d)
(CekFrame { cf_type = "scope"; cf_env = env; cf_name = name; cf_body = Nil; cf_remaining = remaining; cf_f = Nil; cf_args = Nil; cf_results = Nil; cf_extra = Nil; cf_extra2 = Nil })
(* make-provide-frame *)
and make_provide_frame name value remaining env =
(let _d = Hashtbl.create 5 in Hashtbl.replace _d "type" (String "provide"); Hashtbl.replace _d "name" name; Hashtbl.replace _d "value" value; Hashtbl.replace _d "remaining" remaining; Hashtbl.replace _d "env" env; Dict _d)
(CekFrame { cf_type = "provide"; cf_env = env; cf_name = name; cf_body = Nil; cf_remaining = remaining; cf_f = Nil; cf_args = Nil; cf_results = Nil; cf_extra = value; cf_extra2 = Nil })
(* make-scope-acc-frame *)
and make_scope_acc_frame name value remaining env =
(let _d = Hashtbl.create 6 in Hashtbl.replace _d "type" (String "scope-acc"); Hashtbl.replace _d "name" name; Hashtbl.replace _d "value" (let _or = value in if sx_truthy _or then _or else Nil); Hashtbl.replace _d "emitted" (List []); Hashtbl.replace _d "remaining" remaining; Hashtbl.replace _d "env" env; Dict _d)
(CekFrame { cf_type = "scope-acc"; cf_env = env; cf_name = name; cf_body = Nil; cf_remaining = remaining; cf_f = Nil; cf_args = Nil; cf_results = Nil; cf_extra = (let _or = value in if sx_truthy _or then _or else Nil); cf_extra2 = (List []) })
(* make-reset-frame *)
and make_reset_frame env =
(let _d = Hashtbl.create 2 in Hashtbl.replace _d "type" (String "reset"); Hashtbl.replace _d "env" env; Dict _d)
(CekFrame { cf_type = "reset"; cf_env = env; cf_name = Nil; cf_body = Nil; cf_remaining = Nil; cf_f = Nil; cf_args = Nil; cf_results = Nil; cf_extra = Nil; cf_extra2 = Nil })
(* make-dict-frame *)
and make_dict_frame remaining results env =
(let _d = Hashtbl.create 4 in Hashtbl.replace _d "type" (String "dict"); Hashtbl.replace _d "remaining" remaining; Hashtbl.replace _d "results" results; Hashtbl.replace _d "env" env; Dict _d)
(CekFrame { cf_type = "dict"; cf_env = env; cf_name = Nil; cf_body = Nil; cf_remaining = remaining; cf_f = Nil; cf_args = Nil; cf_results = results; cf_extra = Nil; cf_extra2 = Nil })
(* make-and-frame *)
and make_and_frame remaining env =
(let _d = Hashtbl.create 3 in Hashtbl.replace _d "type" (String "and"); Hashtbl.replace _d "remaining" remaining; Hashtbl.replace _d "env" env; Dict _d)
(CekFrame { cf_type = "and"; cf_env = env; cf_name = Nil; cf_body = Nil; cf_remaining = remaining; cf_f = Nil; cf_args = Nil; cf_results = Nil; cf_extra = Nil; cf_extra2 = Nil })
(* make-or-frame *)
and make_or_frame remaining env =
(let _d = Hashtbl.create 3 in Hashtbl.replace _d "type" (String "or"); Hashtbl.replace _d "remaining" remaining; Hashtbl.replace _d "env" env; Dict _d)
(CekFrame { cf_type = "or"; cf_env = env; cf_name = Nil; cf_body = Nil; cf_remaining = remaining; cf_f = Nil; cf_args = Nil; cf_results = Nil; cf_extra = Nil; cf_extra2 = Nil })
(* make-dynamic-wind-frame *)
and make_dynamic_wind_frame phase body_thunk after_thunk env =
(let _d = Hashtbl.create 5 in Hashtbl.replace _d "type" (String "dynamic-wind"); Hashtbl.replace _d "phase" phase; Hashtbl.replace _d "body-thunk" body_thunk; Hashtbl.replace _d "after-thunk" after_thunk; Hashtbl.replace _d "env" env; Dict _d)
(CekFrame { cf_type = "dynamic-wind"; cf_env = env; cf_name = Nil; cf_body = Nil; cf_remaining = Nil; cf_f = Nil; cf_args = Nil; cf_results = Nil; cf_extra = phase; cf_extra2 = Nil })
(* make-reactive-reset-frame *)
and make_reactive_reset_frame env update_fn first_render_p =
(let _d = Hashtbl.create 4 in Hashtbl.replace _d "type" (String "reactive-reset"); Hashtbl.replace _d "env" env; Hashtbl.replace _d "update-fn" update_fn; Hashtbl.replace _d "first-render" first_render_p; Dict _d)
(CekFrame { cf_type = "reactive-reset"; cf_env = env; cf_name = Nil; cf_body = Nil; cf_remaining = Nil; cf_f = Nil; cf_args = Nil; cf_results = Nil; cf_extra = update_fn; cf_extra2 = first_render_p })
(* make-deref-frame *)
and make_deref_frame env =
(let _d = Hashtbl.create 2 in Hashtbl.replace _d "type" (String "deref"); Hashtbl.replace _d "env" env; Dict _d)
(CekFrame { cf_type = "deref"; cf_env = env; cf_name = Nil; cf_body = Nil; cf_remaining = Nil; cf_f = Nil; cf_args = Nil; cf_results = Nil; cf_extra = Nil; cf_extra2 = Nil })
(* make-ho-setup-frame *)
and make_ho_setup_frame ho_type remaining_args evaled_args env =
(let _d = Hashtbl.create 5 in Hashtbl.replace _d "type" (String "ho-setup"); Hashtbl.replace _d "ho-type" ho_type; Hashtbl.replace _d "remaining" remaining_args; Hashtbl.replace _d "evaled" evaled_args; Hashtbl.replace _d "env" env; Dict _d)
(CekFrame { cf_type = "ho-setup"; cf_env = env; cf_name = Nil; cf_body = Nil; cf_remaining = remaining_args; cf_f = Nil; cf_args = evaled_args; cf_results = Nil; cf_extra = ho_type; cf_extra2 = Nil })
(* frame-type *)
and frame_type f =

View File

@@ -79,6 +79,22 @@ let get_val container key =
| "control" -> s.cs_control | "env" -> s.cs_env
| "kont" -> s.cs_kont | "phase" -> String s.cs_phase
| "value" -> s.cs_value | _ -> Nil)
| CekFrame f, String k ->
(match k with
| "type" -> String f.cf_type | "env" -> f.cf_env
| "name" -> f.cf_name | "body" -> f.cf_body
| "remaining" -> f.cf_remaining | "f" -> f.cf_f
| "args" -> f.cf_args | "evaled" -> f.cf_args
| "results" -> f.cf_results | "raw-args" -> f.cf_results
| "then" -> f.cf_body | "else" -> f.cf_name
| "ho-type" -> f.cf_extra | "scheme" -> f.cf_extra
| "indexed" -> f.cf_extra | "value" -> f.cf_extra
| "phase" -> f.cf_extra | "has-effects" -> f.cf_extra
| "match-val" -> f.cf_extra | "current-item" -> f.cf_extra
| "update-fn" -> f.cf_extra | "head-name" -> f.cf_extra
| "emitted" -> f.cf_extra2 | "effect-list" -> f.cf_extra2
| "first-render" -> f.cf_extra2
| _ -> Nil)
| Dict d, String k -> dict_get d k
| Dict d, Keyword k -> dict_get d k
| (List l | ListRef { contents = l }), Number n ->

View File

@@ -38,6 +38,7 @@ and value =
| Env of env (** First-class environment — used by CEK machine state dicts. *)
| ListRef of value list ref (** Mutable list — JS-style array for append! *)
| CekState of cek_state (** Optimized CEK machine state — avoids Dict allocation. *)
| CekFrame of cek_frame (** Optimized CEK continuation frame. *)
(** CEK machine state — record instead of Dict for performance.
5 fields × 55K steps/sec = 275K Hashtbl allocations/sec eliminated. *)
@@ -49,6 +50,22 @@ and cek_state = {
cs_value : value;
}
(** CEK continuation frame — tagged record covering all 29 frame types.
Fields are named generically; not all are used by every frame type.
Eliminates ~100K Hashtbl allocations per page render. *)
and cek_frame = {
cf_type : string; (* frame type tag: "if", "let", "call", etc. *)
cf_env : value; (* environment — every frame has this *)
cf_name : value; (* let/define/set/scope: binding name *)
cf_body : value; (* when/let: body expr *)
cf_remaining : value; (* begin/cond/map/etc: remaining exprs *)
cf_f : value; (* call/map/filter/etc: function *)
cf_args : value; (* call: raw args; arg: evaled args *)
cf_results : value; (* map/filter/dict: accumulated results *)
cf_extra : value; (* extra field: scheme, indexed, value, phase, etc. *)
cf_extra2 : value; (* second extra: emitted, etc. *)
}
(** Mutable string-keyed table (SX dicts support [dict-set!]). *)
and dict = (string, value) Hashtbl.t
@@ -245,6 +262,7 @@ let type_of = function
| SxExpr _ -> "sx-expr"
| Env _ -> "env"
| CekState _ -> "dict" (* CEK state behaves as a dict for type checks *)
| CekFrame _ -> "dict"
let is_nil = function Nil -> true | _ -> false
let is_lambda = function Lambda _ -> true | _ -> false
@@ -403,3 +421,4 @@ let rec inspect = function
| SxExpr s -> Printf.sprintf "<sx-expr:%d chars>" (String.length s)
| Env _ -> "<env>"
| CekState _ -> "<cek-state>"
| CekFrame f -> Printf.sprintf "<frame:%s>" f.cf_type

View File

@@ -428,13 +428,52 @@
" with String s -> s | _ -> \"\")")))
"; cs_value = " (ml-expr-inner (get d "value") set-vars)
" })")
;; Regular dict — Hashtbl
(str "(let _d = Hashtbl.create " (str (round (len items)))
" in " (join "; " (map (fn (k)
(str "Hashtbl.replace _d " (ml-quote-string k)
" " (ml-expr-inner (get d k) set-vars)))
items))
"; Dict _d)")))))
;; Optimize CEK frame dictsdetected by having a "type" string field.
;; Maps frame fields to generic CekFrame record slots.
(if (and (some (fn (k) (= k "type")) items)
(= (type-of (get d "type")) "string"))
(let ((frame-type (get d "type"))
(ef (fn (field) (if (some (fn (k) (= k field)) items)
(ml-expr-inner (get d field) set-vars) "Nil"))))
(str "(CekFrame { cf_type = " (ml-quote-string frame-type)
"; cf_env = " (ef "env")
"; cf_name = " (if (= frame-type "if") (ef "else") (ef "name"))
"; cf_body = " (if (= frame-type "if") (ef "then") (ef "body"))
"; cf_remaining = " (ef "remaining")
"; cf_f = " (ef "f")
"; cf_args = " (cond
(some (fn (k) (= k "evaled")) items) (ef "evaled")
(some (fn (k) (= k "args")) items) (ef "args")
:else "Nil")
"; cf_results = " (cond
(some (fn (k) (= k "results")) items) (ef "results")
(some (fn (k) (= k "raw-args")) items) (ef "raw-args")
:else "Nil")
"; cf_extra = " (cond
(some (fn (k) (= k "ho-type")) items) (ef "ho-type")
(some (fn (k) (= k "scheme")) items) (ef "scheme")
(some (fn (k) (= k "indexed")) items) (ef "indexed")
(some (fn (k) (= k "value")) items) (ef "value")
(some (fn (k) (= k "phase")) items) (ef "phase")
(some (fn (k) (= k "has-effects")) items) (ef "has-effects")
(some (fn (k) (= k "match-val")) items) (ef "match-val")
(some (fn (k) (= k "current-item")) items) (ef "current-item")
(some (fn (k) (= k "update-fn")) items) (ef "update-fn")
(some (fn (k) (= k "head-name")) items) (ef "head-name")
:else "Nil")
"; cf_extra2 = " (cond
(some (fn (k) (= k "emitted")) items) (ef "emitted")
(some (fn (k) (= k "effect-list")) items) (ef "effect-list")
(some (fn (k) (= k "first-render")) items) (ef "first-render")
:else "Nil")
" })"))
;; Regular dict — Hashtbl
(str "(let _d = Hashtbl.create " (str (round (len items)))
" in " (join "; " (map (fn (k)
(str "Hashtbl.replace _d " (ml-quote-string k)
" " (ml-expr-inner (get d k) set-vars)))
items))
"; Dict _d)"))))))
;; --------------------------------------------------------------------------