changeset 955:01a4d936395a

tail example working
author Adam Chlipala <adamc@hcoop.net>
date Thu, 17 Sep 2009 17:11:23 -0400
parents 2a50da66ffd8
children d80734855790
files src/monoize.sml src/reduce.sml src/rpcify.sml
diffstat 3 files changed, 55 insertions(+), 3 deletions(-) [+]
line wrap: on
line diff
--- a/src/monoize.sml	Thu Sep 17 16:35:11 2009 -0400
+++ b/src/monoize.sml	Thu Sep 17 17:11:23 2009 -0400
@@ -3143,7 +3143,7 @@
                 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)
--- a/src/reduce.sml	Thu Sep 17 16:35:11 2009 -0400
+++ b/src/reduce.sml	Thu Sep 17 17:11:23 2009 -0400
@@ -456,6 +456,54 @@
 
                                       | 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), _),
--- a/src/rpcify.sml	Thu Sep 17 16:35:11 2009 -0400
+++ b/src/rpcify.sml	Thu Sep 17 17:11:23 2009 -0400
@@ -259,7 +259,12 @@
                                                                              (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 @@
                                                                                (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), []),