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 | cc0f3b1b858aa0993d48f672fdbda04736afb635 (patch) | |
| tree | 0bde2b80fc3e8df14cd6e16f05bdd88e062aca9a /src/monoize.sml | |
| parent | 00b1094540b7ae07941b97e3714967eb4519cb1b (diff) | |
Eta-expand bodies of transaction functions in Monoization, to enable later optimization
Diffstat (limited to 'src/monoize.sml')
| -rw-r--r-- | src/monoize.sml | 23 |
1 files changed, 23 insertions, 0 deletions
diff --git a/src/monoize.sml b/src/monoize.sml index afe2012f..4d3bfda2 100644 --- a/src/monoize.sml +++ b/src/monoize.sml @@ -3440,6 +3440,29 @@ fun monoDecl (env, fm) (all as (d, loc)) = end | L.DValRec vis => let + val vis = map (fn (x, n, t, e, s) => + let + fun maybeTransaction (t, e) = + case (#1 t, #1 e) of + (L.CApp ((L.CFfi ("Basis", "transaction"), _), _), _) => + SOME (L.EAbs ("_", + (L.TRecord (L.CRecord ((L.KType, loc), []), loc), loc), + t, + (L.EApp (CoreEnv.liftExpInExp 0 e, + (L.ERecord [], loc)), loc)), loc) + | (L.TFun (dom, ran), L.EAbs (x, _, _, e)) => + (case maybeTransaction (ran, e) of + NONE => NONE + | SOME e => SOME (L.EAbs (x, dom, ran, e), loc)) + | _ => NONE + in + (x, n, t, + case maybeTransaction (t, e) of + NONE => e + | SOME e => e, + s) + end) vis + val env = foldl (fn ((x, n, t, e, s), env) => Env.pushENamed env x n t NONE s) env vis val (vis, fm) = ListUtil.foldlMap |