summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2009-09-17 17:11:23 -0400
committerGravatar Adam Chlipala <adamc@hcoop.net>2009-09-17 17:11:23 -0400
commitba5ce199f90e1e5947195c4de8a69b7a312d59f1 (patch)
treee331cb18c6b95e0eff9d5dc00133c88cec62613b /src
parentae83d3e44959b43c167ba83736055bf94ace3113 (diff)
tail example working
Diffstat (limited to 'src')
-rw-r--r--src/monoize.sml2
-rw-r--r--src/reduce.sml48
-rw-r--r--src/rpcify.sml8
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), []),