diff options
author | 2009-05-23 10:14:51 -0400 | |
---|---|---|
committer | 2009-05-23 10:14:51 -0400 | |
commit | 5232b7e45cf55208a0a3ea41395bb9f87d06dd21 (patch) | |
tree | 8afc65ee353c134c317e06064d25e94328af4c3b /src/monoize.sml | |
parent | cabd451f495af6f122b77c61903cc17ee7832d71 (diff) |
Change monoization of monads to allow partial applications of operations
Diffstat (limited to 'src/monoize.sml')
-rw-r--r-- | src/monoize.sml | 62 |
1 files changed, 36 insertions, 26 deletions
diff --git a/src/monoize.sml b/src/monoize.sml index bfb95644..19bb1a11 100644 --- a/src/monoize.sml +++ b/src/monoize.sml @@ -95,6 +95,9 @@ fun monoType env = | L.CApp ((L.CFfi ("Basis", "list"), _), t) => (L'.TList (mt env dtmap t), loc) + | L.CApp ((L.CFfi ("Basis", "monad"), _), _) => + (L'.TRecord [], loc) + | L.CApp ((L.CFfi ("Basis", "eq"), _), t) => let val t = mt env dtmap t @@ -1096,18 +1099,20 @@ fun monoExp (env, st, fm) (all as (e, loc)) = fm) end - | L.EApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "return"), _), _), _), t), _), - (L.EFfi ("Basis", "transaction_monad"), _)) => + | L.EFfi ("Basis", "transaction_monad") => ((L'.ERecord [], loc), fm) + | L.ECApp ((L.ECApp ((L.EFfi ("Basis", "return"), _), (L.CFfi ("Basis", "transaction"), _)), _), t) => let val t = monoType env t in - ((L'.EAbs ("x", t, - (L'.TFun ((L'.TRecord [], loc), t), loc), - (L'.EAbs ("_", (L'.TRecord [], loc), t, - (L'.ERel 1, loc)), loc)), loc), fm) + ((L'.EAbs ("_", (L'.TRecord [], loc), (L'.TFun (t, (L'.TFun ((L'.TRecord [], loc), t), loc)), loc), + (L'.EAbs ("x", t, + (L'.TFun ((L'.TRecord [], loc), t), loc), + (L'.EAbs ("_", (L'.TRecord [], loc), t, + (L'.ERel 1, loc)), loc)), loc)), loc), + fm) end - | L.EApp ((L.ECApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "bind"), _), _), _), t1), _), t2), _), - (L.EFfi ("Basis", "transaction_monad"), _)) => + | L.ECApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "bind"), _), (L.CFfi ("Basis", "transaction"), _)), _), + t1), _), t2) => let val t1 = monoType env t1 val t2 = monoType env t2 @@ -1115,15 +1120,17 @@ fun monoExp (env, st, fm) (all as (e, loc)) = val mt1 = (L'.TFun (un, t1), loc) val mt2 = (L'.TFun (un, t2), loc) in - ((L'.EAbs ("m1", mt1, (L'.TFun ((L'.TFun (t1, mt2), loc), (L'.TFun (un, un), loc)), loc), - (L'.EAbs ("m2", (L'.TFun (t1, mt2), loc), (L'.TFun (un, un), loc), - (L'.EAbs ("_", un, un, - (L'.ELet ("r", t1, (L'.EApp ((L'.ERel 2, loc), - (L'.ERecord [], loc)), loc), - (L'.EApp ( - (L'.EApp ((L'.ERel 2, loc), (L'.ERel 0, loc)), loc), - (L'.ERecord [], loc)), - loc)), loc)), loc)), loc)), loc), + ((L'.EAbs ("_", un, + (L'.TFun (mt1, (L'.TFun ((L'.TFun (t1, mt2), loc), (L'.TFun (un, un), loc)), loc)), loc), + (L'.EAbs ("m1", mt1, (L'.TFun ((L'.TFun (t1, mt2), loc), (L'.TFun (un, un), loc)), loc), + (L'.EAbs ("m2", (L'.TFun (t1, mt2), loc), (L'.TFun (un, un), loc), + (L'.EAbs ("_", un, un, + (L'.ELet ("r", t1, (L'.EApp ((L'.ERel 2, loc), + (L'.ERecord [], loc)), loc), + (L'.EApp ( + (L'.EApp ((L'.ERel 2, loc), (L'.ERel 0, loc)), loc), + (L'.ERecord [], loc)), + loc)), loc)), loc)), loc)), loc)), loc), fm) end @@ -1213,17 +1220,18 @@ fun monoExp (env, st, fm) (all as (e, loc)) = ((L'.EApp (e, (L'.ERecord [], loc)), loc), fm) end - | L.EApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "return"), _), _), _), t), _), - (L.EFfi ("Basis", "signal_monad"), _)) => + | L.EFfi ("Basis", "signal_monad") => ((L'.ERecord [], loc), fm) + | L.ECApp ((L.ECApp ((L.EFfi ("Basis", "return"), _), (L.CFfi ("Basis", "signal"), _)), _), t) => let val t = monoType env t in - ((L'.EAbs ("x", t, (L'.TSignal t, loc), - (L'.ESignalReturn (L'.ERel 0, loc), loc)), loc), + ((L'.EAbs ("_", (L'.TRecord [], loc), (L'.TFun (t, (L'.TSignal t, loc)), loc), + (L'.EAbs ("x", t, (L'.TSignal t, loc), + (L'.ESignalReturn (L'.ERel 0, loc), loc)), loc)), loc), fm) end - | L.EApp ((L.ECApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "bind"), _), _), _), t1), _), t2), _), - (L.EFfi ("Basis", "signal_monad"), _)) => + | L.ECApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "bind"), _), (L.CFfi ("Basis", "signal"), _)), _), + t1), _), t2) => let val t1 = monoType env t1 val t2 = monoType env t2 @@ -1231,9 +1239,11 @@ fun monoExp (env, st, fm) (all as (e, loc)) = val mt1 = (L'.TSignal t1, loc) val mt2 = (L'.TSignal t2, loc) in - ((L'.EAbs ("m1", mt1, (L'.TFun ((L'.TFun (t1, mt2), loc), mt2), loc), - (L'.EAbs ("m2", (L'.TFun (t1, mt2), loc), mt2, - (L'.ESignalBind ((L'.ERel 1, loc), (L'.ERel 0, loc)), loc)), loc)), loc), + ((L'.EAbs ("_", un, (L'.TFun (mt1, (L'.TFun ((L'.TFun (t1, mt2), loc), mt2), loc)), loc), + (L'.EAbs ("m1", mt1, (L'.TFun ((L'.TFun (t1, mt2), loc), mt2), loc), + (L'.EAbs ("m2", (L'.TFun (t1, mt2), loc), mt2, + (L'.ESignalBind ((L'.ERel 1, loc), (L'.ERel 0, loc)), loc)), loc)), loc)), + loc), fm) end | L.ECApp ((L.EFfi ("Basis", "signal"), _), t) => |