summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--src/PureMicroPasses.ml41
1 files changed, 25 insertions, 16 deletions
diff --git a/src/PureMicroPasses.ml b/src/PureMicroPasses.ml
index 99c8341c..82e5ecd2 100644
--- a/src/PureMicroPasses.ml
+++ b/src/PureMicroPasses.ml
@@ -669,22 +669,31 @@ let unit_vars_to_unit (def : fun_def) : fun_def =
let unfold_monadic_let_bindings (ctx : trans_ctx) (def : fun_def) : fun_def =
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 *)
+ let obj =
+ object
+ inherit [_] map_expression as super
+
+ method! visit_Let env monadic lv re e =
+ if not monadic then super#visit_Let env monadic lv re e
+ else
+ let fail_pat = mk_result_fail_lvalue lv.ty in
+ let fail_value = mk_result_fail_rvalue .. in
+ let fail_branch = {pat=fail_pat; branch=Value(fail_value,None)} in
+ let success_pat = mk_result_return_lvalue lv in
+ let success_branch = {pat=success_pat; branch=e} in
+ let switch_body =
+ Match [ fail_branch; success_branch
+
+ ]
+ in
+ let e = Switch (lv, switch_body) in
+ self#visit_expression e
+
+ 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.