diff options
| -rw-r--r-- | src/PureMicroPasses.ml | 52 |
1 files changed, 24 insertions, 28 deletions
diff --git a/src/PureMicroPasses.ml b/src/PureMicroPasses.ml index 2a7293c8..7e74835a 100644 --- a/src/PureMicroPasses.ml +++ b/src/PureMicroPasses.ml @@ -678,34 +678,30 @@ 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 = - def -(* (* It is a very simple map *) - 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}*) + (* It is a very simple map *) + let obj = + object (self) + 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 e.ty in + let fail_branch = + { pat = fail_pat; branch = mk_value_expression 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 (re, switch_body) in + self#visit_expression env e + end + in + (* Update the body *) + let body = obj#visit_texpression () def.body in + (* Return *) + { def with body } (** Apply all the micro-passes to a function. |