summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorSon Ho2022-01-28 17:01:39 +0100
committerSon Ho2022-01-28 17:01:39 +0100
commit65435f03dba02adbaf7ba64cba6566fb01d376ef (patch)
tree59b40dc1de1dd57c90b588243faa97f83cf14512 /src
parenta6d7e406cbf7318b29b8e4ebb6f2b2872da37ece (diff)
Make more progress on filter_unused_assignments
Diffstat (limited to 'src')
-rw-r--r--src/PureMicroPasses.ml25
1 files changed, 21 insertions, 4 deletions
diff --git a/src/PureMicroPasses.ml b/src/PureMicroPasses.ml
index c1311acb..0cd8f123 100644
--- a/src/PureMicroPasses.ml
+++ b/src/PureMicroPasses.ml
@@ -383,9 +383,26 @@ let filter_unused_assignments (ctx : trans_ctx) (def : fun_def) : fun_def =
* appears at the left of a let-binding, this binding might potentially be
* removed).
*)
+ let lv_visitor =
+ object
+ inherit [_] mapreduce_typed_lvalue
+
+ method zero _ = true
+
+ method plus b0 b1 _ = b0 () && b1 ()
+
+ method! visit_var_or_dummy env v =
+ match v with
+ | Dummy -> (Dummy, fun _ -> true)
+ | Var (v, mp) ->
+ if VarId.Set.mem v.id env then (Var (v, mp), fun _ -> false)
+ else (Dummy, fun _ -> true)
+ end
+ in
let filter_typed_lvalue (used_vars : VarId.Set.t) (lv : typed_lvalue) :
typed_lvalue * bool =
- raise Unimplemented
+ let lv, all_dummies = lv_visitor#visit_typed_lvalue used_vars lv in
+ (lv, all_dummies ())
in
(* We then implement the transformation on *expressions* through a mapreduce.
@@ -393,7 +410,7 @@ let filter_unused_assignments (ctx : trans_ctx) (def : fun_def) : fun_def =
* The map filters the unused assignments, the reduce computes the set of
* used variables.
*)
- let obj =
+ let expr_visitor =
object (self)
inherit [_] mapreduce_expression as super
@@ -433,7 +450,7 @@ let filter_unused_assignments (ctx : trans_ctx) (def : fun_def) : fun_def =
expression_contains_child_call_in_all_paths ctx call e
in
if has_child_call then (* Filter *)
- raise Unimplemented
+ (e, fun _ -> used)
else (* Don't filter *)
dont_filter ()
| _ ->
@@ -444,7 +461,7 @@ let filter_unused_assignments (ctx : trans_ctx) (def : fun_def) : fun_def =
end
in
(* Visit the body *)
- let body, used_vars = obj#visit_expression () def.body in
+ let body, used_vars = expr_visitor#visit_expression () def.body in
(* Visit the parameters *)
let used_vars = used_vars () in
let inputs_lvs =