From d5c3faacb1c3114fe6802973a62528cda8be8ac7 Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Sun, 21 Dec 2008 12:30:57 -0500 Subject: Handling singnal bind --- src/monoize.sml | 18 ++++++++++++++++-- 1 file changed, 16 insertions(+), 2 deletions(-) (limited to 'src/monoize.sml') 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 -- cgit v1.2.3