summaryrefslogtreecommitdiff
path: root/compiler/PureMicroPasses.ml
diff options
context:
space:
mode:
authorSon Ho2023-12-07 12:44:54 +0100
committerSon Ho2023-12-07 12:44:54 +0100
commitc17d8cbb7c32d2c2ce9d737fe5359cfbe7d4418c (patch)
tree21e924e94287dc5f018a8ae6457ef53344715f6b /compiler/PureMicroPasses.ml
parent6dbe9e153043e5091a4d17da9bc7c3ed7d4093b1 (diff)
Update the micro passes to inline deconstruction of tuples with one field
Diffstat (limited to 'compiler/PureMicroPasses.ml')
-rw-r--r--compiler/PureMicroPasses.ml40
1 files changed, 34 insertions, 6 deletions
diff --git a/compiler/PureMicroPasses.ml b/compiler/PureMicroPasses.ml
index 68f8943a..959ec1c8 100644
--- a/compiler/PureMicroPasses.ml
+++ b/compiler/PureMicroPasses.ml
@@ -667,8 +667,8 @@ let intro_struct_updates (ctx : trans_ctx) (def : fun_decl) : fun_decl =
leave the let-bindings where they are, and eliminated them in a subsequent
pass (if they are useless).
*)
-let inline_useless_var_reassignments (inline_named : bool) (inline_pure : bool)
- (def : fun_decl) : fun_decl =
+let inline_useless_var_reassignments (ctx : trans_ctx) (inline_named : bool)
+ (inline_pure : bool) (def : fun_decl) : fun_decl =
let obj =
object (self)
inherit [_] map_expression as super
@@ -677,9 +677,12 @@ let inline_useless_var_reassignments (inline_named : bool) (inline_pure : bool)
the substitution map while doing so *)
method! visit_Let (env : texpression VarId.Map.t) monadic lv re e =
(* In order to filter, we need to check first that:
- * - the let-binding is not monadic
- * - the left-value is a variable
- *)
+ - the let-binding is not monadic
+ - the left-value is a variable
+
+ We also inline if the binding decomposes a structure that is to be
+ extracted as a tuple, and the right value is a variable.
+ *)
match (monadic, lv.value) with
| false, PatVar (lv_var, _) ->
(* We can filter if: *)
@@ -725,6 +728,31 @@ let inline_useless_var_reassignments (inline_named : bool) (inline_pure : bool)
let e = self#visit_texpression env e in
(* Reconstruct the [let], only if the binding is not filtered *)
if filter then e.e else Let (monadic, lv, re, e)
+ | ( false,
+ PatAdt
+ {
+ variant_id = None;
+ field_values = [ { value = PatVar (lv_var, _); ty = _ } ];
+ } ) ->
+ (* Second case: we deconstruct a structure with one field that we will
+ extract as tuple. *)
+ let adt_id, _ = PureUtils.ty_as_adt re.ty in
+ (* Update the rhs (we may perform substitutions inside, and it is
+ * better to do them *before* we inline it *)
+ let re = self#visit_texpression env re in
+ if
+ PureUtils.is_var re
+ && type_decl_from_type_id_is_tuple_struct ctx.type_ctx.type_infos
+ adt_id
+ then
+ (* Update the substitution environment *)
+ let env = VarId.Map.add lv_var.id re env in
+ (* Update the next expression *)
+ let e = self#visit_texpression env e in
+ (* We filter the [let], and thus do not reconstruct it *)
+ e.e
+ else (* Nothing to do *)
+ super#visit_Let env monadic lv re e
| _ -> super#visit_Let env monadic lv re e
(** Substitute the variables *)
@@ -1792,7 +1820,7 @@ let apply_end_passes_to_def (ctx : trans_ctx) (def : fun_decl) : fun_decl =
let inline_named_vars = true in
let inline_pure = true in
let def =
- inline_useless_var_reassignments inline_named_vars inline_pure def
+ inline_useless_var_reassignments ctx inline_named_vars inline_pure def
in
log#ldebug
(lazy