Skip to content

Experiment an internal api change #2019

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Draft
wants to merge 1 commit into
base: master
Choose a base branch
from
Draft
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
12 changes: 6 additions & 6 deletions compiler/lib-wasm/closure_conversion.ml
Original file line number Diff line number Diff line change
Expand Up @@ -60,7 +60,7 @@ let collect_free_vars program var_depth depth pc closures =
Code.preorder_traverse
{ fold = Code.fold_children }
(fun pc () ->
let block = Code.Addr.Map.find pc program.blocks in
let block = Code.block pc program in
Freevars.iter_block_free_vars add_if_free_variable block;
List.iter block.body ~f:(fun i ->
match i with
Expand All @@ -71,7 +71,7 @@ let collect_free_vars program var_depth depth pc closures =
| Some _ | None -> ())
| _ -> ()))
pc
program.blocks
program
();
!vars

Expand All @@ -87,7 +87,7 @@ let rec traverse var_depth closures program pc depth =
Code.preorder_traverse
{ fold = Code.fold_children }
(fun pc (program : Code.program) ->
let block = Code.Addr.Map.find pc program.blocks in
let block = Code.block pc program in
mark_bound_variables var_depth block depth;
let program =
List.fold_left
Expand Down Expand Up @@ -151,16 +151,16 @@ let rec traverse var_depth closures program pc depth =
in
List.concat (List.rev (Array.to_list l)))
in
{ program with blocks = Code.Addr.Map.add pc { block with body } program.blocks })
Code.add_block pc { block with body } program)
pc
program.blocks
program
program

let f p =
let t = Timer.make () in
let nv = Var.count () in
let var_depth = Array.make nv (-1) in
let closures = ref Var.Map.empty in
let p = traverse var_depth closures p p.start 0 in
let p = traverse var_depth closures p (Code.start p) 0 in
if Debug.find "times" () then Format.eprintf " closure conversion: %a@." Timer.print t;
p, !closures
44 changes: 17 additions & 27 deletions compiler/lib-wasm/generate.ml
Original file line number Diff line number Diff line change
Expand Up @@ -36,7 +36,7 @@ module Generate (Target : Target_sig.S) = struct
{ live : int array
; in_cps : Effects.in_cps
; deadcode_sentinal : Var.t
; blocks : block Addr.Map.t
; p : program
; closures : Closure_conversion.closure Var.Map.t
; global_context : Code_generation.context
}
Expand Down Expand Up @@ -830,7 +830,7 @@ module Generate (Target : Target_sig.S) = struct
Code.traverse
{ fold = fold_children_skip_try_body }
(fun pc n ->
let block = Addr.Map.find pc p.blocks in
let block = Code.block pc p in
List.fold_left
~f:(fun n i ->
match i with
Expand Down Expand Up @@ -863,7 +863,7 @@ module Generate (Target : Target_sig.S) = struct
~init:n
block.body)
pc
p.blocks
p
(false, false)

let wrap_with_handler needed pc handler ~result_typ ~fall_through ~context body =
Expand Down Expand Up @@ -914,18 +914,18 @@ module Generate (Target : Target_sig.S) = struct
((pc, _) as cont)
cloc
acc =
let g = Structure.build_graph ctx.blocks pc in
let g = Structure.build_graph ctx.p pc in
let dom = Structure.dominator_tree g in
let rec translate_tree result_typ fall_through pc context =
let block = Addr.Map.find pc ctx.blocks in
let block = Code.block pc ctx.p in
let keep_ouside pc' =
match block.branch with
| Switch _ -> true
| Cond (_, (pc1, _), (pc2, _)) when pc' = pc1 && pc' = pc2 -> true
| _ -> Structure.is_merge_node g pc'
in
let code ~context =
let block = Addr.Map.find pc ctx.blocks in
let block = Code.block pc ctx.p in
let* () = translate_instrs ctx context block.body in
translate_node_within
~result_typ
Expand Down Expand Up @@ -960,7 +960,7 @@ module Generate (Target : Target_sig.S) = struct
if
(not (List.is_empty rem))
||
let block = Addr.Map.find pc ctx.blocks in
let block = Code.block pc ctx.p in
match block.branch with
| Cond _ | Pushtrap _ -> false (*ZZZ also some Switch*)
| _ -> true
Expand All @@ -970,7 +970,7 @@ module Generate (Target : Target_sig.S) = struct
in
translate_tree result_typ fall_through pc' context
| [] -> (
let block = Addr.Map.find pc ctx.blocks in
let block = Code.block pc ctx.p in
let branch = block.branch in
match branch with
| Branch cont -> translate_branch result_typ fall_through pc cont context
Expand Down Expand Up @@ -1028,7 +1028,7 @@ module Generate (Target : Target_sig.S) = struct
if List.is_empty args
then return ()
else
let block = Addr.Map.find dst ctx.blocks in
let block = Code.block dst ctx.p in
parallel_renaming block.params args
in
match fall_through with
Expand Down Expand Up @@ -1077,7 +1077,7 @@ module Generate (Target : Target_sig.S) = struct
~param_names
~body:
(let* () =
let block = Addr.Map.find pc ctx.blocks in
let block = Code.block pc ctx.p in
match block.body with
| Event start_loc :: _ -> event start_loc
| _ -> no_event
Expand Down Expand Up @@ -1190,13 +1190,7 @@ module Generate (Target : Target_sig.S) = struct
Code.Print.program (fun _ _ -> "") p;
*)
let ctx =
{ live = live_vars
; in_cps
; deadcode_sentinal
; blocks = p.blocks
; closures
; global_context
}
{ live = live_vars; in_cps; deadcode_sentinal; p; closures; global_context }
in
let toplevel_name = Var.fresh_n "toplevel" in
let functions =
Expand Down Expand Up @@ -1275,16 +1269,12 @@ let fix_switch_branches p =
with
| Some x -> x
| None ->
let pc' = !p'.free_pc in
let pc' = Code.free_pc !p' in
p' :=
{ !p' with
blocks =
Addr.Map.add
pc'
{ params = []; body = []; branch = Branch cont }
!p'.blocks
; free_pc = pc' + 1
};
Code.add_block
pc'
{ params = []; body = []; branch = Branch cont }
!p';
updates := Addr.Map.add pc ((args, pc') :: l) !updates;
pc')
, [] ))
Expand All @@ -1295,7 +1285,7 @@ let fix_switch_branches p =
match block.branch with
| Switch (_, l) -> fix_branches l
| _ -> ())
p.blocks;
(Code.blocks p);
!p'

module G = Generate (Gc_target)
Expand Down
4 changes: 2 additions & 2 deletions compiler/lib-wasm/globalize.ml
Original file line number Diff line number Diff line change
Expand Up @@ -100,13 +100,13 @@ let traverse_instruction st i =
| Event _ -> st

let traverse_block p st pc =
let b = Code.Addr.Map.find pc p.Code.blocks in
let b = Code.block pc p in
let st = List.fold_left ~f:(fun st x -> declare x st) ~init:st b.Code.params in
List.fold_left ~f:(fun st i -> traverse_instruction st i) ~init:st b.Code.body

let f p g closures =
let l = Structure.blocks_in_reverse_post_order g in
let in_loop = Freevars.find_loops_in_closure p p.Code.start in
let in_loop = Freevars.find_loops_in_closure p (Code.start p) in
let st =
List.fold_left
~f:(fun st pc ->
Expand Down
Loading
Loading