diff options
| author |  Adam Chlipala <adamc@hcoop.net> | 2008-12-21 12:30:57 -0500 |
|---|---|---|
| committer | Adam Chlipala <adamc@hcoop.net> | 2008-12-21 12:30:57 -0500 |
| commit | d5c3faacb1c3114fe6802973a62528cda8be8ac7 (patch) | |
| tree | 8193826346d3d4131730c22f1c5fb17eee1e0576 /src/monoize.sml | |
| parent | 0a3abbb2250da6464e91566a1f275829158d3058 (diff) | |
Handling singnal bind
Diffstat (limited to 'src/monoize.sml')
| -rw-r--r-- | src/monoize.sml | 18 |
1 files changed, 16 insertions, 2 deletions
diff --git a/src/monoize.sml b/src/monoize.sml index 63d84d8c..30bd5daa 100644 --- a/src/monoize.sml +++ b/src/monoize.sml @@ -957,8 +957,8 @@ 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 (mt1, (L'.TFun (mt2, (L'.TFun (un, un), loc)), loc)), loc), - (L'.EAbs ("m2", mt2, (L'.TFun (un, un), 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), @@ -989,6 +989,20 @@ fun monoExp (env, st, fm) (all as (e, loc)) = (L'.ESignalReturn (L'.ERel 0, loc), loc)), loc), fm) end + | L.EApp ((L.ECApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "bind"), _), _), _), t1), _), t2), _), + (L.EFfi ("Basis", "signal_monad"), _)) => + let + val t1 = monoType env t1 + val t2 = monoType env t2 + val un = (L'.TRecord [], 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), + fm) + end | L.ECApp ((L.EFfi ("Basis", "getCookie"), _), t) => let |