diff options
author | 2011-08-19 15:23:01 -0400 | |
---|---|---|
committer | 2011-08-19 15:23:01 -0400 | |
commit | ed93f02f2bad4c97b361025ebe851331f7640cad (patch) | |
tree | 49a42ce8909e7f3df3a9fe122d4da57b21f67108 /src/monoize.sml | |
parent | 7144b7ff351ce55fe39d107342ba2778331700e6 (diff) |
Basis.mkMonad
Diffstat (limited to 'src/monoize.sml')
-rw-r--r-- | src/monoize.sml | 52 |
1 files changed, 21 insertions, 31 deletions
diff --git a/src/monoize.sml b/src/monoize.sml index 337e198c..7849e1cd 100644 --- a/src/monoize.sml +++ b/src/monoize.sml @@ -1,4 +1,4 @@ -(* Copyright (c) 2008-2010, Adam Chlipala +(* Copyright (c) 2008-2011, Adam Chlipala * All rights reserved. * * Redistribution and use in source and binary forms, with or without @@ -1315,20 +1315,17 @@ fun monoExp (env, st, fm) (all as (e, loc)) = fm) end - | L.EFfi ("Basis", "transaction_monad") => ((L'.ERecord [], loc), fm) - | L.ECApp ((L.ECApp ((L.EFfi ("Basis", "return"), _), (L.CFfi ("Basis", "transaction"), _)), _), t) => + | L.ECApp ((L.EFfi ("Basis", "transaction_return"), _), t) => let val t = monoType env t in - ((L'.EAbs ("_", (L'.TRecord [], loc), (L'.TFun (t, (L'.TFun ((L'.TRecord [], loc), t), loc)), loc), - (L'.EAbs ("x", t, + ((L'.EAbs ("x", t, (L'.TFun ((L'.TRecord [], loc), t), loc), (L'.EAbs ("_", (L'.TRecord [], loc), t, - (L'.ERel 1, loc)), loc)), loc)), loc), + (L'.ERel 1, loc)), loc)), loc), fm) end - | L.ECApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "bind"), _), (L.CFfi ("Basis", "transaction"), _)), _), - t1), _), t2) => + | L.ECApp ((L.ECApp ((L.EFfi ("Basis", "transaction_bind"), _), t1), _), t2) => let val t1 = monoType env t1 val t2 = monoType env t2 @@ -1336,17 +1333,15 @@ 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 ("_", 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), + ((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), fm) end @@ -1427,18 +1422,15 @@ fun monoExp (env, st, fm) (all as (e, loc)) = ((L'.ESpawn e, loc), fm) end - | L.EFfi ("Basis", "signal_monad") => ((L'.ERecord [], loc), fm) - | L.ECApp ((L.ECApp ((L.EFfi ("Basis", "return"), _), (L.CFfi ("Basis", "signal"), _)), _), t) => + | L.ECApp ((L.EFfi ("Basis", "signal_return"), _), t) => let val t = monoType env t in - ((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), + ((L'.EAbs ("x", t, (L'.TSignal t, loc), + (L'.ESignalReturn (L'.ERel 0, loc), loc)), loc), fm) end - | L.ECApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "bind"), _), (L.CFfi ("Basis", "signal"), _)), _), - t1), _), t2) => + | L.ECApp ((L.ECApp ((L.EFfi ("Basis", "signal_bind"), _), t1), _), t2) => let val t1 = monoType env t1 val t2 = monoType env t2 @@ -1446,11 +1438,9 @@ fun monoExp (env, st, fm) (all as (e, loc)) = val mt1 = (L'.TSignal t1, loc) val mt2 = (L'.TSignal t2, loc) in - ((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), + ((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), fm) end | L.ECApp ((L.EFfi ("Basis", "signal"), _), t) => |