diff options
author | Son Ho | 2022-01-28 21:34:55 +0100 |
---|---|---|
committer | Son Ho | 2022-01-28 21:34:55 +0100 |
commit | 0b145dd4b0ab0ac5ed56121663a25801f20bed67 (patch) | |
tree | a865bf9689d1485c7ed195cc4f181a85cd3bf686 | |
parent | 21dddf2fc6c09495de56250961ab69b2b6506112 (diff) |
Make minor modifications
-rw-r--r-- | src/PureMicroPasses.ml | 41 |
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. |