Skip to content

Commit 3daf38d

Browse files
hyperpolymatharena-agent
hyperpolymath
and
arena-agent
committed
fix(loader): use M::{x} must inline x's transitive helpers
tests/codegen-deno/dom_startup_error.affine says `use Dom::{VNode, div, h1, p, text}`. Module_loader.flatten_imports inlined exactly those decls — but stdlib/Dom.affine's div/h1/p are one-line wrappers around Dom's own `pub fn h(...)`. `h` was never named by the import list, so it was left out of the flattened program and the emitted module called an undefined `h`: `ReferenceError: h is not defined`. ImportGlob/ImportSimple already inline every public decl for this reason; ImportList was the odd one out. Close over the named decls' free variables until a fixpoint, pulling in the module's own value decls (private helpers included — a public wrapper may delegate to one) in dependency order. Aliased items keep their behaviour: the closure runs on the original names, then renaming is applied. To share the walker instead of adding a fourth private copy (codegen.ml had one; borrow.ml has another), move find_free_vars into ast.ml and re-export it from codegen.ml for the existing call sites. (Codegen depends on Module_loader, so the loader could not reach the copy where it lived.) Verified locally: the emitted-module call pattern is what the harness died on; the fix makes `h` part of the flattened program. Full verification needs the OCaml build in CI. Co-authored-by: arena-agent <297053741+arena-agent@users.noreply.github.com>
1 parent 45c07de commit 3daf38d

3 files changed

Lines changed: 197 additions & 121 deletions

File tree

‎lib/ast.ml‎

Lines changed: 110 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -540,3 +540,113 @@ and stmt_contains_return (s : stmt) : bool =
540540
let fn_body_contains_return : fn_body -> bool = function
541541
| FnExpr e -> expr_contains_return e
542542
| FnBlock b -> block_contains_return b
543+
544+
(** Free variables of an expression.
545+
546+
Returns the names used in [expr] but not bound within it; [bound_vars]
547+
lists the names already bound by the enclosing scope (parameters, let
548+
bindings).
549+
550+
Shared by every pass that needs to know what a body refers to: wasm
551+
codegen, and [Module_loader]'s `use`-list flattening, which uses it to
552+
pull in helpers a selective import never names (`use Dom::{div}` needs
553+
`div`'s own helper `h`; omitting it emitted a module that called an
554+
undefined `h`). Like the other walkers in this module it is deliberately
555+
conservative: constructs it does not inspect contribute [] rather than a
556+
wrong answer. *)
557+
let rec find_free_vars (bound_vars : string list) (expr : expr) : string list =
558+
match expr with
559+
| ExprLit _ -> []
560+
| ExprVar id ->
561+
if List.mem id.name bound_vars then [] else [id.name]
562+
| ExprBinary (e1, _, e2) ->
563+
find_free_vars bound_vars e1 @ find_free_vars bound_vars e2
564+
| ExprStringConcat (e1, e2) ->
565+
find_free_vars bound_vars e1 @ find_free_vars bound_vars e2
566+
| ExprUnary (_, e) ->
567+
find_free_vars bound_vars e
568+
| ExprIf ei ->
569+
find_free_vars bound_vars ei.ei_cond @
570+
find_free_vars bound_vars ei.ei_then @
571+
(match ei.ei_else with
572+
| Some e -> find_free_vars bound_vars e
573+
| None -> [])
574+
| ExprLet lb ->
575+
let rhs_free = find_free_vars bound_vars lb.el_value in
576+
(* Add bound variable to scope for body *)
577+
let new_bound = match lb.el_pat with
578+
| PatVar id -> id.name :: bound_vars
579+
| _ -> bound_vars
580+
in
581+
let body_free = match lb.el_body with
582+
| Some e -> find_free_vars new_bound e
583+
| None -> []
584+
in
585+
rhs_free @ body_free
586+
| ExprLambda lam ->
587+
(* Parameters are bound within lambda *)
588+
let param_names = List.map (fun p -> p.p_name.name) lam.elam_params in
589+
find_free_vars (param_names @ bound_vars) lam.elam_body
590+
| ExprApp (f, args) ->
591+
find_free_vars bound_vars f @
592+
List.concat (List.map (find_free_vars bound_vars) args)
593+
| ExprBlock blk ->
594+
(* Statements may introduce bindings *)
595+
let (bound_after, free) = List.fold_left (fun (bound, acc_free) stmt ->
596+
match stmt with
597+
| StmtLet sl ->
598+
let rhs_free = find_free_vars bound sl.sl_value in
599+
let new_bound = match sl.sl_pat with
600+
| PatVar id -> id.name :: bound
601+
| _ -> bound
602+
in
603+
(new_bound, acc_free @ rhs_free)
604+
| StmtExpr e ->
605+
(bound, acc_free @ find_free_vars bound e)
606+
| _ -> (bound, acc_free)
607+
) (bound_vars, []) blk.blk_stmts in
608+
(* The tail expression is in scope of the block's own `let`
609+
bindings, so its free vars must exclude them — use the
610+
threaded [bound_after], not the original [bound_vars]. (Prior
611+
code used [bound_vars], spuriously reporting block-local
612+
binders as free; surfaced by #225 PR3c chained continuations.) *)
613+
let expr_free = match blk.blk_expr with
614+
| Some e -> find_free_vars bound_after e
615+
| None -> []
616+
in
617+
free @ expr_free
618+
| ExprMatch m ->
619+
find_free_vars bound_vars m.em_scrutinee @
620+
List.concat (List.map (fun arm -> find_free_vars bound_vars arm.ma_body) m.em_arms)
621+
| ExprReturn e_opt ->
622+
(match e_opt with Some e -> find_free_vars bound_vars e | None -> [])
623+
| ExprTuple exprs | ExprArray exprs ->
624+
List.concat (List.map (find_free_vars bound_vars) exprs)
625+
| ExprRecord r ->
626+
List.concat (List.map (fun (_, e_opt) ->
627+
match e_opt with
628+
| Some e -> find_free_vars bound_vars e
629+
| None -> []
630+
) r.er_fields)
631+
| ExprField (e, _) -> find_free_vars bound_vars e
632+
| ExprTupleIndex (e, _) -> find_free_vars bound_vars e
633+
| ExprIndex (e1, e2) ->
634+
find_free_vars bound_vars e1 @ find_free_vars bound_vars e2
635+
| ExprVariant _ -> []
636+
| ExprSpan (e, _) -> find_free_vars bound_vars e
637+
(* Float-wall elaboration nodes (codegen runs on the post-elaborate tree, so
638+
these CAN appear here): traverse them exactly like their pre-elaboration
639+
forms, else a variable captured only inside a float expression is missed
640+
and the closure mis-lowers to UnboundVariable. *)
641+
| ExprFloatBinary (a, _, b) ->
642+
find_free_vars bound_vars a @ find_free_vars bound_vars b
643+
| ExprFloatArray exprs -> List.concat (List.map (find_free_vars bound_vars) exprs)
644+
| ExprFloatIndex (a, b) ->
645+
find_free_vars bound_vars a @ find_free_vars bound_vars b
646+
| ExprCellTuple cells ->
647+
List.concat (List.map (fun (e, _) -> find_free_vars bound_vars e) cells)
648+
| ExprCellTupleIndex (e, _, _) -> find_free_vars bound_vars e
649+
| ExprCellRecord fields ->
650+
List.concat (List.map (fun (_, e, _) -> find_free_vars bound_vars e) fields)
651+
| ExprCellField (e, _, _) -> find_free_vars bound_vars e
652+
| _ -> [] (* Other expressions *)

‎lib/codegen.ml‎

Lines changed: 5 additions & 98 deletions
Original file line numberDiff line numberDiff line change
@@ -344,104 +344,11 @@ let gen_heap_alloc (ctx : context) (size_in_bytes : int) : (context * instr list
344344
(ctx', alloc_code)
345345

346346
(** Find free variables in an expression.
347-
Returns list of variable names that are used but not bound within the expression.
348-
bound_vars: variables already bound in enclosing scope (parameters, let bindings) *)
349-
let rec find_free_vars (bound_vars : string list) (expr : expr) : string list =
350-
match expr with
351-
| ExprLit _ -> []
352-
| ExprVar id ->
353-
if List.mem id.name bound_vars then [] else [id.name]
354-
| ExprBinary (e1, _, e2) ->
355-
find_free_vars bound_vars e1 @ find_free_vars bound_vars e2
356-
| ExprStringConcat (e1, e2) ->
357-
find_free_vars bound_vars e1 @ find_free_vars bound_vars e2
358-
| ExprUnary (_, e) ->
359-
find_free_vars bound_vars e
360-
| ExprIf ei ->
361-
find_free_vars bound_vars ei.ei_cond @
362-
find_free_vars bound_vars ei.ei_then @
363-
(match ei.ei_else with
364-
| Some e -> find_free_vars bound_vars e
365-
| None -> [])
366-
| ExprLet lb ->
367-
let rhs_free = find_free_vars bound_vars lb.el_value in
368-
(* Add bound variable to scope for body *)
369-
let new_bound = match lb.el_pat with
370-
| PatVar id -> id.name :: bound_vars
371-
| _ -> bound_vars
372-
in
373-
let body_free = match lb.el_body with
374-
| Some e -> find_free_vars new_bound e
375-
| None -> []
376-
in
377-
rhs_free @ body_free
378-
| ExprLambda lam ->
379-
(* Parameters are bound within lambda *)
380-
let param_names = List.map (fun p -> p.p_name.name) lam.elam_params in
381-
find_free_vars (param_names @ bound_vars) lam.elam_body
382-
| ExprApp (f, args) ->
383-
find_free_vars bound_vars f @
384-
List.concat (List.map (find_free_vars bound_vars) args)
385-
| ExprBlock blk ->
386-
(* Statements may introduce bindings *)
387-
let (bound_after, free) = List.fold_left (fun (bound, acc_free) stmt ->
388-
match stmt with
389-
| StmtLet sl ->
390-
let rhs_free = find_free_vars bound sl.sl_value in
391-
let new_bound = match sl.sl_pat with
392-
| PatVar id -> id.name :: bound
393-
| _ -> bound
394-
in
395-
(new_bound, acc_free @ rhs_free)
396-
| StmtExpr e ->
397-
(bound, acc_free @ find_free_vars bound e)
398-
| _ -> (bound, acc_free)
399-
) (bound_vars, []) blk.blk_stmts in
400-
(* The tail expression is in scope of the block's own `let`
401-
bindings, so its free vars must exclude them — use the
402-
threaded [bound_after], not the original [bound_vars]. (Prior
403-
code used [bound_vars], spuriously reporting block-local
404-
binders as free; surfaced by #225 PR3c chained continuations.) *)
405-
let expr_free = match blk.blk_expr with
406-
| Some e -> find_free_vars bound_after e
407-
| None -> []
408-
in
409-
free @ expr_free
410-
| ExprMatch m ->
411-
find_free_vars bound_vars m.em_scrutinee @
412-
List.concat (List.map (fun arm -> find_free_vars bound_vars arm.ma_body) m.em_arms)
413-
| ExprReturn e_opt ->
414-
(match e_opt with Some e -> find_free_vars bound_vars e | None -> [])
415-
| ExprTuple exprs | ExprArray exprs ->
416-
List.concat (List.map (find_free_vars bound_vars) exprs)
417-
| ExprRecord r ->
418-
List.concat (List.map (fun (_, e_opt) ->
419-
match e_opt with
420-
| Some e -> find_free_vars bound_vars e
421-
| None -> []
422-
) r.er_fields)
423-
| ExprField (e, _) -> find_free_vars bound_vars e
424-
| ExprTupleIndex (e, _) -> find_free_vars bound_vars e
425-
| ExprIndex (e1, e2) ->
426-
find_free_vars bound_vars e1 @ find_free_vars bound_vars e2
427-
| ExprVariant _ -> []
428-
| ExprSpan (e, _) -> find_free_vars bound_vars e
429-
(* Float-wall elaboration nodes (codegen runs on the post-elaborate tree, so
430-
these CAN appear here): traverse them exactly like their pre-elaboration
431-
forms, else a variable captured only inside a float expression is missed
432-
and the closure mis-lowers to UnboundVariable. *)
433-
| ExprFloatBinary (a, _, b) ->
434-
find_free_vars bound_vars a @ find_free_vars bound_vars b
435-
| ExprFloatArray exprs -> List.concat (List.map (find_free_vars bound_vars) exprs)
436-
| ExprFloatIndex (a, b) ->
437-
find_free_vars bound_vars a @ find_free_vars bound_vars b
438-
| ExprCellTuple cells ->
439-
List.concat (List.map (fun (e, _) -> find_free_vars bound_vars e) cells)
440-
| ExprCellTupleIndex (e, _, _) -> find_free_vars bound_vars e
441-
| ExprCellRecord fields ->
442-
List.concat (List.map (fun (_, e, _) -> find_free_vars bound_vars e) fields)
443-
| ExprCellField (e, _, _) -> find_free_vars bound_vars e
444-
| _ -> [] (* Other expressions *)
347+
The walker itself lives in {!Ast} so every pass shares one definition
348+
instead of keeping a private copy (module inlining needs the same
349+
answer when it closes over a transitive helper a `use` list never
350+
names). Re-exported here for the existing call sites. *)
351+
let find_free_vars = Ast.find_free_vars
445352

446353
(** Remove duplicates from list *)
447354
let dedup (lst : string list) : string list =

‎lib/module_loader.ml‎

Lines changed: 82 additions & 23 deletions
Original file line numberDiff line numberDiff line change
@@ -321,31 +321,90 @@ let flatten_imports (loader : t) (prog : program) : program =
321321
the bodies present. *)
322322
public_decls
323323
| ImportList (_, items) ->
324-
List.filter_map (fun item ->
325-
let target = item.ii_name.name in
326-
List.find_opt (fun (n, _) -> n = target) public_decls
327-
|> Option.map (fun (_, found) ->
328-
let bound_name = match item.ii_alias with
329-
| Some a -> a.name
330-
| None -> target
331-
in
332-
let renamed = match found with
324+
(* The name a directly-named item is imported under (alias
325+
honoured). *)
326+
let bound_name_of target =
327+
match List.find_opt (fun item -> item.ii_name.name = target) items with
328+
| Some { ii_alias = Some a; _ } -> a.name
329+
| _ -> target
330+
in
331+
let rename_decl bound_name found =
332+
match found with
333+
| `Fn fd ->
334+
`Fn { fd with fd_name = { fd.fd_name with name = bound_name } }
335+
| `Const (TopConst { tc_vis; tc_mut; tc_name; tc_ty; tc_value }) ->
336+
`Const (TopConst {
337+
tc_vis;
338+
tc_mut;
339+
tc_name = { tc_name with name = bound_name };
340+
tc_ty;
341+
tc_value;
342+
})
343+
| `Const _ ->
344+
(* Unreachable: public_decls only stores TopConst under `Const`. *)
345+
found
346+
in
347+
let direct =
348+
List.filter_map (fun item ->
349+
let target = item.ii_name.name in
350+
List.find_opt (fun (n, _) -> n = target) public_decls
351+
|> Option.map (fun (_, found) -> (target, found))
352+
) items
353+
in
354+
(* Transitive closure. A selected declaration's body may call
355+
helpers of the same module that the import list never names:
356+
`use Dom::{div}` pulls in `div`, whose body calls `h`. Leaving
357+
`h` out of the flattened program produced
358+
`ReferenceError: h is not defined` in the emitted module
359+
(tests/codegen-deno/dom_startup_error). Private helpers are
360+
pulled in too — a public wrapper may delegate to one. *)
361+
let module_value_decls =
362+
List.filter_map (fun decl ->
363+
match decl with
364+
| TopFn fd when fd.fd_body <> FnExtern ->
365+
Some (fd.fd_name.name, `Fn fd)
366+
| TopConst { tc_name; _ } as d ->
367+
Some (tc_name.name, `Const d)
368+
| _ -> None
369+
) lm.mod_program.prog_decls
370+
in
371+
let by_name = Hashtbl.create 16 in
372+
List.iter (fun (n, d) -> Hashtbl.replace by_name n d) module_value_decls;
373+
let seen = Hashtbl.create 16 in
374+
List.iter (fun (n, _) -> Hashtbl.replace seen n ()) direct;
375+
let rec close pending acc =
376+
match pending with
377+
| [] -> List.rev acc
378+
| (_, dk) :: rest ->
379+
let free = match dk with
333380
| `Fn fd ->
334-
`Fn { fd with fd_name = { fd.fd_name with name = bound_name } }
335-
| `Const (TopConst { tc_vis; tc_mut; tc_name; tc_ty; tc_value }) ->
336-
`Const (TopConst {
337-
tc_vis;
338-
tc_mut;
339-
tc_name = { tc_name with name = bound_name };
340-
tc_ty;
341-
tc_value;
342-
})
343-
| `Const _ ->
344-
(* Unreachable: public_decls only stores TopConst under `Const`. *)
345-
found
381+
let params =
382+
List.map (fun (p : param) -> p.p_name.name) fd.fd_params
383+
in
384+
(match fd.fd_body with
385+
| FnExtern -> []
386+
| FnExpr e -> find_free_vars params e
387+
| FnBlock b -> find_free_vars params (ExprBlock b))
388+
| `Const (TopConst { tc_value; _ }) -> find_free_vars [] tc_value
389+
| `Const _ -> []
390+
in
391+
let (pending, acc) =
392+
List.fold_left (fun (pending, acc) name ->
393+
if Hashtbl.mem seen name then (pending, acc)
394+
else begin
395+
Hashtbl.replace seen name ();
396+
match Hashtbl.find_opt by_name name with
397+
| Some dep -> ((name, dep) :: pending, (name, dep) :: acc)
398+
| None -> (pending, acc)
399+
end
400+
) (rest, acc) free
346401
in
347-
(bound_name, renamed))
348-
) items
402+
close pending acc
403+
in
404+
let extras = close direct [] in
405+
List.map
406+
(fun (n, dk) -> (bound_name_of n, rename_decl (bound_name_of n) dk))
407+
(direct @ extras)
349408
in
350409
List.iter (fun (name, decl_kind) -> add_imported name decl_kind) select
351410
) prog.prog_imports;

0 commit comments

Comments
 (0)