diff options
| author |  Adam Chlipala <adamc@hcoop.net> | 2009-09-17 17:11:23 -0400 |
|---|---|---|
| committer | Adam Chlipala <adamc@hcoop.net> | 2009-09-17 17:11:23 -0400 |
| commit | ba5ce199f90e1e5947195c4de8a69b7a312d59f1 (patch) | |
| tree | e331cb18c6b95e0eff9d5dc00133c88cec62613b /src | |
| parent | ae83d3e44959b43c167ba83736055bf94ace3113 (diff) | |
tail example working
Diffstat (limited to 'src')
| -rw-r--r-- | src/monoize.sml | 2 | ||||
| -rw-r--r-- | src/reduce.sml | 48 | ||||
| -rw-r--r-- | src/rpcify.sml | 8 |
3 files changed, 55 insertions, 3 deletions
diff --git a/src/monoize.sml b/src/monoize.sml index 83a520c8..865acff4 100644 --- a/src/monoize.sml +++ b/src/monoize.sml @@ -3143,7 +3143,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) = val (ek, fm) = monoExp (env, st, fm) ek val e = (L'.ENamed n, loc) - val e = foldl (fn (e, arg) => (L'.EApp (e, arg), loc)) e es + val e = foldl (fn (arg, e) => (L'.EApp (e, arg), loc)) e es val e = (L'.EApp (e, ek), loc) in (e, fm) diff --git a/src/reduce.sml b/src/reduce.sml index 137dd02f..c2becb2b 100644 --- a/src/reduce.sml +++ b/src/reduce.sml @@ -456,6 +456,54 @@ fun kindConAndExp (namedC, namedE) = | EApp ((EApp + ((EApp ((ECApp ((ECApp ((ECApp ((EFfi ("Basis", "bind"), loc), _), _), + t1), + _), t2), _), + (EFfi ("Basis", "transaction_monad"), _)), _), + (ETailCall (n, es, (EAbs (_, _, _, ke), _), dom, ran), _)), _), + trans3) => + let + val e' = (EFfi ("Basis", "bind"), loc) + val e' = (ECApp (e', (CFfi ("Basis", "transaction"), loc)), loc) + val e' = (ECApp (e', dom), loc) + val e' = (ECApp (e', t2), loc) + val e' = (EApp (e', (EFfi ("Basis", "transaction_monad"), loc)), loc) + val e' = (EApp (e', ke), loc) + val e' = (EApp (e', E.liftExpInExp 0 trans3), loc) + val e' = reassoc e' + val e' = (EAbs ("x", dom, t2, e'), loc) + val e' = (ETailCall (n, es, e', dom, t2), loc) + in + e' + end + + | EApp + ((EApp + ((EApp ((ECApp ((ECApp ((ECApp ((EFfi ("Basis", "bind"), loc), _), _), + t1), + _), t2), _), + (EFfi ("Basis", "transaction_monad"), _)), _), + (ETailCall (n, es, ke, dom, ran), _)), _), + trans3) => + let + val e' = (EFfi ("Basis", "bind"), loc) + val e' = (ECApp (e', (CFfi ("Basis", "transaction"), loc)), loc) + val e' = (ECApp (e', dom), loc) + val e' = (ECApp (e', t2), loc) + val e' = (EApp (e', (EFfi ("Basis", "transaction_monad"), loc)), loc) + val e' = (EApp (e', exp (UnknownE :: env') + (EApp (E.liftExpInExp 0 ke, (ERel 0, loc)), loc)), + loc) + val e' = (EApp (e', E.liftExpInExp 0 trans3), loc) + val e' = reassoc e' + val e' = (EAbs ("x", dom, t2, e'), loc) + val e' = (ETailCall (n, es, e', dom, t2), loc) + in + e' + end + + | EApp + ((EApp ((EApp ((ECApp ((ECApp ((ECApp ((EFfi ("Basis", "bind"), loc), mt), _), _), _), t3), _), me), _), diff --git a/src/rpcify.sml b/src/rpcify.sml index 0a1ac8ef..a70d94fe 100644 --- a/src/rpcify.sml +++ b/src/rpcify.sml @@ -259,7 +259,12 @@ fun frob file = (fn (i, _) => (ERel (len - i - 1), loc)) ts - val k = (EAbs ("x", ran, ran, (ERel 0, loc)), loc) + val k = (EFfi ("Basis", "return"), loc) + val trans = (CFfi ("Basis", "transaction"), loc) + val k = (ECApp (k, trans), loc) + val k = (ECApp (k, ran), loc) + val k = (EApp (k, (EFfi ("Basis", "transaction_monad"), + loc)), loc) val re = (ETailCall (n, args, k, ran, ran), loc) val (re, _) = foldr (fn (dom, (re, ran)) => ((EAbs ("x", dom, ran, re), @@ -273,7 +278,6 @@ fun frob file = (EApp (be, (ERel (len - i), loc)), loc)) be ts val ne = (EFfi ("Basis", "bind"), loc) - val trans = (CFfi ("Basis", "transaction"), loc) val ne = (ECApp (ne, trans), loc) val ne = (ECApp (ne, ran), loc) val unit = (TRecord (CRecord ((KType, loc), []), |