Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
110 changes: 110 additions & 0 deletions lib/ast.ml
Original file line number Diff line number Diff line change
Expand Up @@ -540,3 +540,113 @@ and stmt_contains_return (s : stmt) : bool =
let fn_body_contains_return : fn_body -> bool = function
| FnExpr e -> expr_contains_return e
| FnBlock b -> block_contains_return b

(** Free variables of an expression.

Returns the names used in [expr] but not bound within it; [bound_vars]
lists the names already bound by the enclosing scope (parameters, let
bindings).

Shared by every pass that needs to know what a body refers to: wasm
codegen, and [Module_loader]'s `use`-list flattening, which uses it to
pull in helpers a selective import never names (`use Dom::{div}` needs
`div`'s own helper `h`; omitting it emitted a module that called an
undefined `h`). Like the other walkers in this module it is deliberately
conservative: constructs it does not inspect contribute [] rather than a
wrong answer. *)
let rec find_free_vars (bound_vars : string list) (expr : expr) : string list =
match expr with
| ExprLit _ -> []
| ExprVar id ->
if List.mem id.name bound_vars then [] else [id.name]
| ExprBinary (e1, _, e2) ->
find_free_vars bound_vars e1 @ find_free_vars bound_vars e2
| ExprStringConcat (e1, e2) ->
find_free_vars bound_vars e1 @ find_free_vars bound_vars e2
| ExprUnary (_, e) ->
find_free_vars bound_vars e
| ExprIf ei ->
find_free_vars bound_vars ei.ei_cond @
find_free_vars bound_vars ei.ei_then @
(match ei.ei_else with
| Some e -> find_free_vars bound_vars e
| None -> [])
| ExprLet lb ->
let rhs_free = find_free_vars bound_vars lb.el_value in
(* Add bound variable to scope for body *)
let new_bound = match lb.el_pat with
| PatVar id -> id.name :: bound_vars
| _ -> bound_vars
in
let body_free = match lb.el_body with
| Some e -> find_free_vars new_bound e
| None -> []
in
rhs_free @ body_free
| ExprLambda lam ->
(* Parameters are bound within lambda *)
let param_names = List.map (fun p -> p.p_name.name) lam.elam_params in
find_free_vars (param_names @ bound_vars) lam.elam_body
| ExprApp (f, args) ->
find_free_vars bound_vars f @
List.concat (List.map (find_free_vars bound_vars) args)
| ExprBlock blk ->
(* Statements may introduce bindings *)
let (bound_after, free) = List.fold_left (fun (bound, acc_free) stmt ->
match stmt with
| StmtLet sl ->
let rhs_free = find_free_vars bound sl.sl_value in
let new_bound = match sl.sl_pat with
| PatVar id -> id.name :: bound
| _ -> bound
in
(new_bound, acc_free @ rhs_free)
| StmtExpr e ->
(bound, acc_free @ find_free_vars bound e)
| _ -> (bound, acc_free)
) (bound_vars, []) blk.blk_stmts in
(* The tail expression is in scope of the block's own `let`
bindings, so its free vars must exclude them — use the
threaded [bound_after], not the original [bound_vars]. (Prior
code used [bound_vars], spuriously reporting block-local
binders as free; surfaced by #225 PR3c chained continuations.) *)
let expr_free = match blk.blk_expr with
| Some e -> find_free_vars bound_after e
| None -> []
in
free @ expr_free
| ExprMatch m ->
find_free_vars bound_vars m.em_scrutinee @
List.concat (List.map (fun arm -> find_free_vars bound_vars arm.ma_body) m.em_arms)
| ExprReturn e_opt ->
(match e_opt with Some e -> find_free_vars bound_vars e | None -> [])
| ExprTuple exprs | ExprArray exprs ->
List.concat (List.map (find_free_vars bound_vars) exprs)
| ExprRecord r ->
List.concat (List.map (fun (_, e_opt) ->
match e_opt with
| Some e -> find_free_vars bound_vars e
| None -> []
) r.er_fields)
| ExprField (e, _) -> find_free_vars bound_vars e
| ExprTupleIndex (e, _) -> find_free_vars bound_vars e
| ExprIndex (e1, e2) ->
find_free_vars bound_vars e1 @ find_free_vars bound_vars e2
| ExprVariant _ -> []
| ExprSpan (e, _) -> find_free_vars bound_vars e
(* Float-wall elaboration nodes (codegen runs on the post-elaborate tree, so
these CAN appear here): traverse them exactly like their pre-elaboration
forms, else a variable captured only inside a float expression is missed
and the closure mis-lowers to UnboundVariable. *)
| ExprFloatBinary (a, _, b) ->
find_free_vars bound_vars a @ find_free_vars bound_vars b
| ExprFloatArray exprs -> List.concat (List.map (find_free_vars bound_vars) exprs)
| ExprFloatIndex (a, b) ->
find_free_vars bound_vars a @ find_free_vars bound_vars b
| ExprCellTuple cells ->
List.concat (List.map (fun (e, _) -> find_free_vars bound_vars e) cells)
| ExprCellTupleIndex (e, _, _) -> find_free_vars bound_vars e
| ExprCellRecord fields ->
List.concat (List.map (fun (_, e, _) -> find_free_vars bound_vars e) fields)
| ExprCellField (e, _, _) -> find_free_vars bound_vars e
| _ -> [] (* Other expressions *)
103 changes: 5 additions & 98 deletions lib/codegen.ml
Original file line number Diff line number Diff line change
Expand Up @@ -344,104 +344,11 @@ let gen_heap_alloc (ctx : context) (size_in_bytes : int) : (context * instr list
(ctx', alloc_code)

(** Find free variables in an expression.
Returns list of variable names that are used but not bound within the expression.
bound_vars: variables already bound in enclosing scope (parameters, let bindings) *)
let rec find_free_vars (bound_vars : string list) (expr : expr) : string list =
match expr with
| ExprLit _ -> []
| ExprVar id ->
if List.mem id.name bound_vars then [] else [id.name]
| ExprBinary (e1, _, e2) ->
find_free_vars bound_vars e1 @ find_free_vars bound_vars e2
| ExprStringConcat (e1, e2) ->
find_free_vars bound_vars e1 @ find_free_vars bound_vars e2
| ExprUnary (_, e) ->
find_free_vars bound_vars e
| ExprIf ei ->
find_free_vars bound_vars ei.ei_cond @
find_free_vars bound_vars ei.ei_then @
(match ei.ei_else with
| Some e -> find_free_vars bound_vars e
| None -> [])
| ExprLet lb ->
let rhs_free = find_free_vars bound_vars lb.el_value in
(* Add bound variable to scope for body *)
let new_bound = match lb.el_pat with
| PatVar id -> id.name :: bound_vars
| _ -> bound_vars
in
let body_free = match lb.el_body with
| Some e -> find_free_vars new_bound e
| None -> []
in
rhs_free @ body_free
| ExprLambda lam ->
(* Parameters are bound within lambda *)
let param_names = List.map (fun p -> p.p_name.name) lam.elam_params in
find_free_vars (param_names @ bound_vars) lam.elam_body
| ExprApp (f, args) ->
find_free_vars bound_vars f @
List.concat (List.map (find_free_vars bound_vars) args)
| ExprBlock blk ->
(* Statements may introduce bindings *)
let (bound_after, free) = List.fold_left (fun (bound, acc_free) stmt ->
match stmt with
| StmtLet sl ->
let rhs_free = find_free_vars bound sl.sl_value in
let new_bound = match sl.sl_pat with
| PatVar id -> id.name :: bound
| _ -> bound
in
(new_bound, acc_free @ rhs_free)
| StmtExpr e ->
(bound, acc_free @ find_free_vars bound e)
| _ -> (bound, acc_free)
) (bound_vars, []) blk.blk_stmts in
(* The tail expression is in scope of the block's own `let`
bindings, so its free vars must exclude them — use the
threaded [bound_after], not the original [bound_vars]. (Prior
code used [bound_vars], spuriously reporting block-local
binders as free; surfaced by #225 PR3c chained continuations.) *)
let expr_free = match blk.blk_expr with
| Some e -> find_free_vars bound_after e
| None -> []
in
free @ expr_free
| ExprMatch m ->
find_free_vars bound_vars m.em_scrutinee @
List.concat (List.map (fun arm -> find_free_vars bound_vars arm.ma_body) m.em_arms)
| ExprReturn e_opt ->
(match e_opt with Some e -> find_free_vars bound_vars e | None -> [])
| ExprTuple exprs | ExprArray exprs ->
List.concat (List.map (find_free_vars bound_vars) exprs)
| ExprRecord r ->
List.concat (List.map (fun (_, e_opt) ->
match e_opt with
| Some e -> find_free_vars bound_vars e
| None -> []
) r.er_fields)
| ExprField (e, _) -> find_free_vars bound_vars e
| ExprTupleIndex (e, _) -> find_free_vars bound_vars e
| ExprIndex (e1, e2) ->
find_free_vars bound_vars e1 @ find_free_vars bound_vars e2
| ExprVariant _ -> []
| ExprSpan (e, _) -> find_free_vars bound_vars e
(* Float-wall elaboration nodes (codegen runs on the post-elaborate tree, so
these CAN appear here): traverse them exactly like their pre-elaboration
forms, else a variable captured only inside a float expression is missed
and the closure mis-lowers to UnboundVariable. *)
| ExprFloatBinary (a, _, b) ->
find_free_vars bound_vars a @ find_free_vars bound_vars b
| ExprFloatArray exprs -> List.concat (List.map (find_free_vars bound_vars) exprs)
| ExprFloatIndex (a, b) ->
find_free_vars bound_vars a @ find_free_vars bound_vars b
| ExprCellTuple cells ->
List.concat (List.map (fun (e, _) -> find_free_vars bound_vars e) cells)
| ExprCellTupleIndex (e, _, _) -> find_free_vars bound_vars e
| ExprCellRecord fields ->
List.concat (List.map (fun (_, e, _) -> find_free_vars bound_vars e) fields)
| ExprCellField (e, _, _) -> find_free_vars bound_vars e
| _ -> [] (* Other expressions *)
The walker itself lives in {!Ast} so every pass shares one definition
instead of keeping a private copy (module inlining needs the same
answer when it closes over a transitive helper a `use` list never
names). Re-exported here for the existing call sites. *)
let find_free_vars = Ast.find_free_vars

(** Remove duplicates from list *)
let dedup (lst : string list) : string list =
Expand Down
139 changes: 116 additions & 23 deletions lib/module_loader.ml
Original file line number Diff line number Diff line change
Expand Up @@ -275,6 +275,7 @@ let flatten_imports (loader : t) (prog : program) : program =
List.filter_map (function
| TopFn fd -> Some fd.fd_name.name
| TopConst { tc_name; _ } -> Some tc_name.name
| TopType td -> Some td.td_name.name
| _ -> None
) prog.prog_decls
in
Expand Down Expand Up @@ -321,31 +322,122 @@ let flatten_imports (loader : t) (prog : program) : program =
the bodies present. *)
public_decls
| ImportList (_, items) ->
List.filter_map (fun item ->
let target = item.ii_name.name in
List.find_opt (fun (n, _) -> n = target) public_decls
|> Option.map (fun (_, found) ->
let bound_name = match item.ii_alias with
| Some a -> a.name
| None -> target
in
let renamed = match found with
(* The name a directly-named item is imported under (alias
honoured). *)
let bound_name_of target =
match List.find_opt (fun item -> item.ii_name.name = target) items with
| Some { ii_alias = Some a; _ } -> a.name
| _ -> target
in
let rename_decl bound_name found =
match found with
| `Fn fd ->
`Fn { fd with fd_name = { fd.fd_name with name = bound_name } }
| `Const (TopConst { tc_vis; tc_mut; tc_name; tc_ty; tc_value }) ->
`Const (TopConst {
tc_vis;
tc_mut;
tc_name = { tc_name with name = bound_name };
tc_ty;
tc_value;
})
| `Const _ | `Type _ ->
(* `Const` here is unreachable: public_decls only stores
TopConst under `Const`. `Type` decls are never renamed —
they are carried under their own name. *)
found
in
let direct =
List.filter_map (fun item ->
let target = item.ii_name.name in
List.find_opt (fun (n, _) -> n = target) public_decls
|> Option.map (fun (_, found) -> (target, found))
) items
in
(* Transitive closure. A selected declaration's body may call
helpers of the same module that the import list never names:
`use Dom::{div}` pulls in `div`, whose body calls `h`. Leaving
`h` out of the flattened program produced
`ReferenceError: h is not defined` in the emitted module
(tests/codegen-deno/dom_startup_error). Private helpers are
pulled in too — a public wrapper may delegate to one. *)
let module_value_decls =
List.filter_map (fun decl ->
match decl with
| TopFn fd when fd.fd_body <> FnExtern ->
Some (fd.fd_name.name, `Fn fd)
| TopConst { tc_name; _ } as d ->
Some (tc_name.name, `Const d)
| _ -> None
) lm.mod_program.prog_decls
in
(* Constructors of this module's own enums, keyed by constructor
name. An inlined wrapper body can name a constructor
(`text` returns `VText(content)`) and the constructor exists
only where the enum is declared. Option/Result constructors
are excluded: every non-wasm preamble already defines
Some/None/Ok/Err, and re-emitting them is the duplicate-`const`
crash that reverted type-carrying in #138 — this narrows the
carry to user enums a backend preamble cannot supply. *)
let preamble_ctors = [ "Some"; "None"; "Ok"; "Err" ] in
let ctor_decls = Hashtbl.create 16 in
List.iter (fun decl ->
match decl with
| TopType td ->
(match td.td_body with
| TyEnum variants ->
List.iter (fun (vd : variant_decl) ->
if not (List.mem vd.vd_name.name preamble_ctors) then
Hashtbl.replace ctor_decls vd.vd_name.name
(td.td_name.name, decl)
) variants
| _ -> ())
| _ -> ()) lm.mod_program.prog_decls;
let by_name = Hashtbl.create 16 in
List.iter (fun (n, d) -> Hashtbl.replace by_name n d) module_value_decls;
let seen = Hashtbl.create 16 in
List.iter (fun (n, _) -> Hashtbl.replace seen n ()) direct;
let rec close pending acc =
match pending with
| [] -> List.rev acc
| (_, dk) :: rest ->
let free = match dk with
| `Fn fd ->
`Fn { fd with fd_name = { fd.fd_name with name = bound_name } }
| `Const (TopConst { tc_vis; tc_mut; tc_name; tc_ty; tc_value }) ->
`Const (TopConst {
tc_vis;
tc_mut;
tc_name = { tc_name with name = bound_name };
tc_ty;
tc_value;
})
| `Const _ ->
(* Unreachable: public_decls only stores TopConst under `Const`. *)
found
let params =
List.map (fun (p : param) -> p.p_name.name) fd.fd_params
in
(match fd.fd_body with
| FnExtern -> []
| FnExpr e -> find_free_vars params e
| FnBlock b -> find_free_vars params (ExprBlock b))
| `Const (TopConst { tc_value; _ }) -> find_free_vars [] tc_value
| `Const _ | `Type _ -> []
in
let (pending, acc) =
List.fold_left (fun (pending, acc) name ->
if Hashtbl.mem seen name then (pending, acc)
else begin
Hashtbl.replace seen name ();
match Hashtbl.find_opt by_name name with
| Some dep -> ((name, dep) :: pending, (name, dep) :: acc)
| None ->
(* A constructor name: carry the enum it belongs to,
once per type. *)
(match Hashtbl.find_opt ctor_decls name with
| Some (td_name, decl) when not (Hashtbl.mem seen td_name) ->
Hashtbl.replace seen td_name ();
((td_name, `Type decl) :: pending,
(td_name, `Type decl) :: acc)
| _ -> (pending, acc))
end
) (rest, acc) free
in
(bound_name, renamed))
) items
close pending acc
in
let extras = close direct [] in
List.map
(fun (n, dk) -> (bound_name_of n, rename_decl (bound_name_of n) dk))
(direct @ extras)
in
List.iter (fun (name, decl_kind) -> add_imported name decl_kind) select
) prog.prog_imports;
Expand All @@ -355,6 +447,7 @@ let flatten_imports (loader : t) (prog : program) : program =
match Hashtbl.find_opt imported_by_name name with
| Some (`Fn fd) -> Some (TopFn fd)
| Some (`Const decl) -> Some decl
| Some (`Type decl) -> Some decl
| None -> None)
in
(* #138 follow-up: imported TYPE decls are intentionally NOT inlined here.
Expand Down
Loading