Mercurial > urweb
diff src/monoize.sml @ 572:57018f21cd5c
Handling singnal bind
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Sun, 21 Dec 2008 12:30:57 -0500 |
parents | 86d324061ddc |
children | ac947e2f29ff |
line wrap: on
line diff
--- a/src/monoize.sml Sun Dec 21 12:01:00 2008 -0500 +++ b/src/monoize.sml Sun Dec 21 12:30:57 2008 -0500 @@ -957,8 +957,8 @@ 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 @@ (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