From dae758e940e3bf023c25d86f7d05b8cea80c1ed5 Mon Sep 17 00:00:00 2001
From: Son Ho
Date: Fri, 28 Jan 2022 21:06:42 +0100
Subject: Make minor modifications

---
 src/PureMicroPasses.ml | 32 +++++++++++++++++++++++---------
 src/PureUtils.ml       | 12 ++++++++++++
 2 files changed, 35 insertions(+), 9 deletions(-)

(limited to 'src')

diff --git a/src/PureMicroPasses.ml b/src/PureMicroPasses.ml
index 2cf27a7f..23ae22af 100644
--- a/src/PureMicroPasses.ml
+++ b/src/PureMicroPasses.ml
@@ -485,7 +485,7 @@ let expression_contains_child_call_in_all_paths (ctx : trans_ctx) (call0 : call)
 
 (** Filter the unused assignments (removes the unused variables, filters
     the function calls) *)
-let filter_unused_assignments (filter_monadic_calls : bool) (ctx : trans_ctx)
+let filter_unused (filter_monadic_calls : bool) (ctx : trans_ctx)
     (def : fun_def) : fun_def =
   (* We first need a transformation on *left-values*, which filters the unused
    * variables and tells us whether the value contains any variable which has
@@ -667,7 +667,25 @@ let unit_vars_to_unit (def : fun_def) : fun_def =
 
 (** Unfold the monadic let-bindings to explicit matches. *)
 let unfold_monadic_let_bindings (ctx : trans_ctx) (def : fun_def) : fun_def =
-  raise Unimplemented
+  def
+(* (* It is a very simple map *)
+     let obj =
+       object
+         inherit [_] map_expression as super
+
+         method! visit_Let env monadic lv e re =
+          if not monadic then super#visit_Let env monadic lv e re
+          else
+            let fail_pat = mk_result_fail_lvalue lv.ty in
+            let success_pat = mk_result_return_lvalue lv in
+            let e = Switch
+
+       end
+     in
+     (* Update the body *)
+     let body = obj#visit_expression () def.body in
+     (* Return *)
+   { def with body}*)
 
 (** Apply all the micro-passes to a function.
 
@@ -718,13 +736,9 @@ let apply_passes_to_def (config : config) (ctx : trans_ctx) (def : fun_def) :
     (lazy
       ("inline_useless_var_assignments:\n\n" ^ fun_def_to_string ctx def ^ "\n"));
 
-  (* Filter the unused assignments (removes the unused variables, filters
-   * the function calls) *)
-  let def =
-    filter_unused_assignments config.filter_unused_monadic_calls ctx def
-  in
-  log#ldebug
-    (lazy ("filter_unused_assignments:\n\n" ^ fun_def_to_string ctx def ^ "\n"));
+  (* Filter the unused variables, assignments, function calls, etc. *)
+  let def = filter_unused config.filter_unused_monadic_calls ctx def in
+  log#ldebug (lazy ("filter_unused:\n\n" ^ fun_def_to_string ctx def ^ "\n"));
 
   (* Unfold the monadic let-bindings *)
   let def =
diff --git a/src/PureUtils.ml b/src/PureUtils.ml
index 140f4082..9596cd9b 100644
--- a/src/PureUtils.ml
+++ b/src/PureUtils.ml
@@ -58,6 +58,18 @@ let mk_result_return_rvalue (v : typed_rvalue) : typed_rvalue =
   in
   { value; ty }
 
+let mk_result_fail_lvalue (ty : ty) : typed_lvalue =
+  let ty = Adt (Assumed Result, [ ty ]) in
+  let value = LvAdt { variant_id = Some result_fail_id; field_values = [] } in
+  { value; ty }
+
+let mk_result_return_lvalue (v : typed_lvalue) : typed_lvalue =
+  let ty = Adt (Assumed Result, [ v.ty ]) in
+  let value =
+    LvAdt { variant_id = Some result_return_id; field_values = [ v ] }
+  in
+  { value; ty }
+
 let mk_result_ty (ty : ty) : ty = Adt (Assumed Result, [ ty ])
 
 (** Type substitution *)
-- 
cgit v1.2.3