Skip to content
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

Remove regions with exclaves #1524

Merged
Merged
Show file tree
Hide file tree
Changes from 1 commit
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
Prev Previous commit
Next Next commit
Use a variant of map_subexpressions
  • Loading branch information
lukemaurer committed Jun 27, 2023
commit d31893cf47f7ab4186c29ba1b4136df169af3e20
48 changes: 29 additions & 19 deletions middle_end/flambda/flambda_iterators.ml
Original file line number Diff line number Diff line change
Expand Up @@ -76,13 +76,15 @@ let map_snd_sharing f ((a, b) as cpl) =
else
(a, new_b)

let map_subexpressions f f_named (tree:Flambda.t) : Flambda.t =
let map_subexpressions_with_tail f f_named (tree:Flambda.t) : Flambda.t =
let f_tail v = f v ~tail:true in
let f_nontail v = f v ~tail:false in
match tree with
| Var _ | Apply _ | Assign _ | Send _ | Proved_unreachable
| Static_raise _ -> tree
| Let { var; defining_expr; body; _ } ->
let new_named = f_named var defining_expr in
let new_body = f body in
let new_body = f_tail body in
if new_named == defining_expr && new_body == body then
tree
else
Expand All @@ -91,22 +93,23 @@ let map_subexpressions f f_named (tree:Flambda.t) : Flambda.t =
let new_defs =
list_map_sharing (map_snd_sharing f_named) defs
in
let new_body = f body in
let new_body = f_tail body in
if new_defs == defs && new_body == body then
tree
else
Let_rec (new_defs, new_body)
| Let_mutable mutable_let ->
let new_body = f mutable_let.body in
let new_body = f_tail mutable_let.body in
if new_body == mutable_let.body then
tree
else
Let_mutable { mutable_let with body = new_body }
| Switch (arg, sw) ->
let aux = map_snd_sharing (fun _ v -> f v) in
let aux = map_snd_sharing (fun _ v -> f_tail v) in
let new_consts = list_map_sharing aux sw.consts in
let new_blocks = list_map_sharing aux sw.blocks in
let new_failaction = may_map_sharing f sw.failaction in
let new_failaction = may_map_sharing f_tail sw.failaction
in
if sw.failaction == new_failaction &&
new_consts == sw.consts &&
new_blocks == sw.blocks then
Expand All @@ -121,59 +124,66 @@ let map_subexpressions f f_named (tree:Flambda.t) : Flambda.t =
in
Switch (arg, sw)
| String_switch (arg, sw, def, kind) ->
let new_sw = list_map_sharing (map_snd_sharing (fun _ v -> f v)) sw in
let new_def = may_map_sharing f def in
let new_sw = list_map_sharing (map_snd_sharing (fun _ v -> f_tail v)) sw in
let new_def = may_map_sharing f_tail def in
if sw == new_sw && def == new_def then
tree
else
String_switch(arg, new_sw, new_def, kind)
| Static_catch (i, vars, body, handler, kind) ->
let new_body = f body in
let new_handler = f handler in
let new_body = f_tail body in
let new_handler = f_tail handler in
if new_body == body && new_handler == handler then
tree
else
Static_catch (i, vars, new_body, new_handler, kind)
| Try_with(body, id, handler, kind) ->
let new_body = f body in
let new_handler = f handler in
let new_body = f_tail body in
let new_handler = f_tail handler in
if body == new_body && handler == new_handler then
tree
else
Try_with(new_body, id, new_handler, kind)
| If_then_else(arg, ifso, ifnot, kind) ->
let new_ifso = f ifso in
let new_ifnot = f ifnot in
let new_ifso = f_tail ifso in
let new_ifnot = f_tail ifnot in
if new_ifso == ifso && new_ifnot == ifnot then
tree
else
If_then_else(arg, new_ifso, new_ifnot, kind)
| While(cond, body) ->
let new_cond = f cond in
let new_body = f body in
let new_cond = f_nontail cond in
let new_body = f_nontail body in
if new_cond == cond && new_body == body then
tree
else
While(new_cond, new_body)
| For { bound_var; from_value; to_value; direction; body; } ->
let new_body = f body in
let new_body = f_nontail body in
if new_body == body then
tree
else
For { bound_var; from_value; to_value; direction; body = new_body; }
| Region body ->
let new_body = f body in
let new_body = f_tail body in
if new_body == body then
tree
else
Region new_body
| Exclave body ->
let new_body = f body in
let new_body = f_tail body in
if new_body == body then
tree
else
Exclave new_body

let map_subexpressions f f_named tree =
map_subexpressions_with_tail (fun v ~tail:_ -> f v) f_named tree

let map_tail_subexpressions f tree =
let f v ~tail = if tail then f v else v in
map_subexpressions_with_tail f (fun _ named -> named) tree

let iter_general = Flambda.iter_general

let iter f f_named t = iter_general ~toplevel:false f f_named (Is_expr t)
Expand Down
2 changes: 2 additions & 0 deletions middle_end/flambda/flambda_iterators.mli
Original file line number Diff line number Diff line change
Expand Up @@ -35,6 +35,8 @@ val map_subexpressions
-> Flambda.t
-> Flambda.t

val map_tail_subexpressions : (Flambda.t -> Flambda.t) -> Flambda.t -> Flambda.t
mshinwell marked this conversation as resolved.
Show resolved Hide resolved

(* CR-soon lwhite: add comment to clarify that these recurse unlike the
ones above *)
val iter
Expand Down
88 changes: 2 additions & 86 deletions middle_end/flambda/inline_and_simplify.ml
Original file line number Diff line number Diff line change
Expand Up @@ -394,20 +394,6 @@ let simplify_move_within_set_of_closures env r
let approx = A.value_closure value_set_of_closures move_to in
Move_within_set_of_closures move_within, ret r approx)

let map_body_of_let f lam (let_expr : Flambda.let_expr) =
let new_body = f let_expr.body in
if new_body == let_expr.body then lam else
let named = Flambda.With_free_variables.of_defining_expr_of_let let_expr in
Flambda.With_free_variables.create_let_reusing_defining_expr
let_expr.var named new_body

let option_map_sharing f opt =
match opt with
| None -> None
| Some a ->
let new_a = f a in
if new_a == a then opt else Some new_a

let remove_exclaves (lam : Flambda.t) =
let rec remove lam ~depth : Flambda.t =
match (lam : Flambda.t) with
Expand All @@ -419,78 +405,8 @@ let remove_exclaves (lam : Flambda.t) =
else
let new_body = remove ~depth:(depth - 1) body in
if new_body == body then lam else Exclave new_body
| Let let_expr -> map_body_of_let (remove ~depth) lam let_expr
| Let_mutable let_mut ->
let new_body = remove ~depth let_mut.body in
if new_body == let_mut.body then lam else
Let_mutable { let_mut with body = new_body }
| Let_rec (bindings, body) ->
let new_body = remove ~depth body in
if new_body == body then lam else Let_rec (bindings, new_body)
| If_then_else (cond, ifso, ifnot, layout) ->
let new_ifso = remove ~depth ifso in
let new_ifnot = remove ~depth ifnot in
if new_ifso == ifso && new_ifnot == ifnot then lam else
If_then_else (cond, new_ifso, new_ifnot, layout)
| Switch (var, switch) ->
let new_switch = remove_from_switch ~depth switch in
if new_switch == switch then lam else Switch (var, new_switch)
| String_switch (var, branches, failaction, layout) ->
let new_branches = remove_from_branches ~depth branches in
let new_failaction = option_map_sharing (remove ~depth) failaction in
if new_branches == branches && new_failaction == failaction then lam
else String_switch (var, new_branches, new_failaction, layout)
| Static_catch (var, params, body, handler, layout) ->
let new_body = remove ~depth body in
let new_handler = remove ~depth handler in
if new_body == body && new_handler == handler then lam
else Static_catch (var, params, new_body, new_handler, layout)
| Try_with (body, var, handler, layout) ->
let new_body = remove ~depth body in
let new_handler = remove ~depth handler in
if new_body == body && new_handler == handler then lam
else Try_with (new_body, var, new_handler, layout)
| Apply apply ->
begin match apply.reg_close, depth with
| Rc_close_at_apply, 0 ->
Apply { apply with reg_close = Rc_normal }
| (Rc_normal | Rc_nontail | Rc_close_at_apply), _ ->
lam
end
| Send send ->
begin match send.reg_close, depth with
| Rc_close_at_apply, 0 ->
Send { send with reg_close = Rc_normal }
| (Rc_normal | Rc_nontail | Rc_close_at_apply), _ ->
lam
end
| Var _
| Assign _
| Static_raise (_, _)
| While (_, _)
| For _
| Proved_unreachable -> lam
and remove_from_switch (switch : Flambda.switch) ~depth =
let new_blocks = remove_from_branches ~depth switch.blocks in
let new_consts = remove_from_branches ~depth switch.consts in
let new_failaction = option_map_sharing (remove ~depth) switch.failaction in
if
new_blocks == switch.blocks
&& new_consts == switch.consts
&& new_failaction == switch.failaction
then switch
else { switch with
blocks = new_blocks;
consts = new_consts;
failaction = new_failaction }
and remove_from_branches
: 'key. ('key * Flambda.t) list -> depth:int -> ('key * Flambda.t) list =
fun branches ~depth ->
Misc.Stdlib.List.map_sharing
(fun ((key, lam) as pair) ->
let new_lam = remove lam ~depth in
if new_lam == lam then pair else (key, new_lam))
branches
| _ ->
Flambda_iterators.map_tail_subexpressions (remove ~depth) lam
in
remove lam ~depth:0

Expand Down