diff options
| author |  Adam Chlipala <adamc@hcoop.net> | 2009-12-31 18:07:53 -0500 |
|---|---|---|
| committer | Adam Chlipala <adamc@hcoop.net> | 2009-12-31 18:07:53 -0500 |
| commit | 76a84dd3fb97b56605292c4f0eab2febe3c6a7ed (patch) | |
| tree | 0bde2b80fc3e8df14cd6e16f05bdd88e062aca9a /src/mono_reduce.sml | |
| parent | d57cc15e6b5c1f77ebfbfa222283809a4f594e36 (diff) | |
Eta-expand bodies of transaction functions in Monoization, to enable later optimization
Diffstat (limited to 'src/mono_reduce.sml')
| -rw-r--r-- | src/mono_reduce.sml | 33 |
1 files changed, 16 insertions, 17 deletions
diff --git a/src/mono_reduce.sml b/src/mono_reduce.sml index aa6b7051..16cfd9f9 100644 --- a/src/mono_reduce.sml +++ b/src/mono_reduce.sml @@ -582,23 +582,22 @@ fun reduce file = fun push () = case result of (TFun (dom, result), loc) => - if List.all (fn (_, (EAbs _, _)) => true | _ => false) pes then - let - val r = - EAbs ("y", dom, result, - (ECase (liftExpInExp 0 e', - map (fn (p, (EAbs (_, _, _, e), _)) => - (p, swapExpVarsPat (0, patBinds p) e) - | _ => raise Fail "MonoReduce ECase") pes, - {disc = disc, result = result}), loc)) - in - (*Print.prefaces "Swapped" - [("e", MonoPrint.p_exp env (e, ErrorMsg.dummySpan)), - ("r", MonoPrint.p_exp env (r, ErrorMsg.dummySpan))];*) - r - end - else - e + let + fun safe (e, _) = + case e of + EAbs _ => true + | _ => false + in + if List.all (safe o #2) pes then + EAbs ("y", dom, result, + (ECase (liftExpInExp 0 e', + map (fn (p, (EAbs (_, _, _, e), _)) => + (p, swapExpVarsPat (0, patBinds p) e) + | _ => raise Fail "MonoReduce ECase") pes, + {disc = disc, result = result}), loc)) + else + e + end | _ => e fun search pes = |