changeset 1020:dfe34fad749d

RPC uses VM support for call/cc
author Adam Chlipala <adamc@hcoop.net>
date Sun, 25 Oct 2009 14:07:10 -0400 (2009-10-25)
parents 68ba074e260f
children 7a4a55e05081
files CHANGELOG lib/js/urweb.js src/compiler.sig src/compiler.sml src/core.sml src/core_print.sml src/core_untangle.sml src/core_util.sml src/effectize.sml src/jscomp.sml src/mono.sml src/mono_print.sml src/mono_reduce.sml src/mono_util.sml src/monoize.sml src/reduce.sml src/reduce_local.sml src/rpcify.sml src/shake.sml src/sources src/tailify.sig src/tailify.sml
diffstat 22 files changed, 59 insertions(+), 471 deletions(-) [+]
line wrap: on
line diff
--- a/CHANGELOG	Sun Oct 25 13:12:24 2009 -0400
+++ b/CHANGELOG	Sun Oct 25 14:07:10 2009 -0400
@@ -1,3 +1,12 @@
+========
+Next
+========
+
+- Bug fixes
+- Optimization improvements
+- Removed a restriction that prevented some RPCs from compiling
+- New extra demo: conference1
+
 ========
 20091012
 ========
--- a/lib/js/urweb.js	Sun Oct 25 13:12:24 2009 -0400
+++ b/lib/js/urweb.js	Sun Oct 25 14:07:10 2009 -0400
@@ -632,7 +632,7 @@
 
       if (isok) {
         try {
-          execF(k, parse(xhr.responseText));
+          k(parse(xhr.responseText));
         } catch (v) {
           doExn(v);
         }
@@ -854,7 +854,11 @@
 }
 
 function exec0(env, e) {
-  var stack = null;
+  return exec1(env, null, e);
+}
+
+function exec1(env, stack, e) {
+  var stack, usedK = false;
 
   var saveEnv = function() {
     if (stack.next != null && stack.next.data.c != "<")
@@ -883,8 +887,9 @@
       case "f":
         fr.args[fr.pos++] = v;
         if (fr.a == null) {
+          stack = stack.next;
           e = {c: "c", v: fr.f.apply(null, fr.args)};
-          stack = stack.next;
+          if (usedK) return null;
         } else {
           e = fr.a.data;
           fr.a = fr.a.next;
@@ -1014,6 +1019,11 @@
       env = e.env;
       e = e.body;
       break;
+    case "K":
+      { var savedStack = stack.next, savedEnv = env;
+      e = {c: "c", v: function(v) { return exec1(savedEnv, savedStack, {c: "c", v: v}); } };}
+      usedK = true;
+      break;      
     default:
       whine("Unknown Ur expression kind " + e.c);
     }
--- a/src/compiler.sig	Sun Oct 25 13:12:24 2009 -0400
+++ b/src/compiler.sig	Sun Oct 25 14:07:10 2009 -0400
@@ -86,7 +86,6 @@
     val reduce : (Core.file, Core.file) phase
     val unpoly : (Core.file, Core.file) phase
     val specialize : (Core.file, Core.file) phase
-    val tailify : (Core.file, Core.file) phase
     val marshalcheck : (Core.file, Core.file) phase
     val effectize : (Core.file, Core.file) phase
     val monoize : (Core.file, Mono.file) phase
@@ -121,7 +120,6 @@
     val toSpecialize : (string, Core.file) transform 
     val toShake3 : (string, Core.file) transform
     val toEspecialize : (string, Core.file) transform 
-    val toTailify : (string, Core.file) transform
     val toReduce2 : (string, Core.file) transform
     val toShake4 : (string, Core.file) transform
     val toMarshalcheck : (string, Core.file) transform
--- a/src/compiler.sml	Sun Oct 25 13:12:24 2009 -0400
+++ b/src/compiler.sml	Sun Oct 25 14:07:10 2009 -0400
@@ -779,14 +779,7 @@
 
 val toEspecialize = transform especialize "especialize" o toShake3
 
-val tailify = {
-    func = Tailify.frob,
-    print = CorePrint.p_file CoreEnv.empty
-}
-
-val toTailify = transform tailify "tailify" o toEspecialize
-
-val toReduce2 = transform reduce "reduce2" o toTailify
+val toReduce2 = transform reduce "reduce2" o toEspecialize
 
 val toShake4 = transform shake "shake4" o toReduce2
 
--- a/src/core.sml	Sun Oct 25 13:12:24 2009 -0400
+++ b/src/core.sml	Sun Oct 25 14:07:10 2009 -0400
@@ -115,8 +115,7 @@
 
        | ELet of string * con * exp * exp
 
-       | EServerCall of int * exp list * exp * con * con
-       | ETailCall of int * exp list * exp * con * con
+       | EServerCall of int * exp list * con
 
 withtype exp = exp' located
 
--- a/src/core_print.sml	Sun Oct 25 13:12:24 2009 -0400
+++ b/src/core_print.sml	Sun Oct 25 14:07:10 2009 -0400
@@ -438,22 +438,12 @@
                                     newline,
                                     p_exp (E.pushERel env x t) e2]
 
-      | EServerCall (n, es, e, _, _) => box [string "Server(",
-                                             p_enamed env n,
-                                             string ",",
-                                             space,
-                                             p_list (p_exp env) es,
-                                             string ")[",
-                                             p_exp env e,
-                                             string "]"]
-      | ETailCall (n, es, e, _, _) => box [string "Tail(",
-                                           p_enamed env n,
-                                           string ",",
-                                           space,
-                                           p_list (p_exp env) es,
-                                           string ")[",
-                                           p_exp env e,
-                                           string "]"]
+      | EServerCall (n, es, _) => box [string "Server(",
+                                       p_enamed env n,
+                                       string ",",
+                                       space,
+                                       p_list (p_exp env) es,
+                                       string ")"]
 
       | EKAbs (x, e) => box [string x,
                              space,
--- a/src/core_untangle.sml	Sun Oct 25 13:12:24 2009 -0400
+++ b/src/core_untangle.sml	Sun Oct 25 14:07:10 2009 -0400
@@ -48,8 +48,7 @@
         case e of
             ENamed n => try n
           | EClosure (n, _) => try n
-          | EServerCall (n, _, _, _, _) => try n
-          | ETailCall (n, _, _, _, _) => try n
+          | EServerCall (n, _, _) => try n
           | _ => s
     end
 
--- a/src/core_util.sml	Sun Oct 25 13:12:24 2009 -0400
+++ b/src/core_util.sml	Sun Oct 25 14:07:10 2009 -0400
@@ -532,20 +532,12 @@
       | (ELet _, _) => LESS
       | (_, ELet _) => GREATER
 
-      | (EServerCall (n1, es1, e1, _, _), EServerCall (n2, es2, e2, _, _)) =>
+      | (EServerCall (n1, es1, _), EServerCall (n2, es2, _)) =>
         join (Int.compare (n1, n2),
-              fn () => join (joinL compare (es1, es2),
-                             fn () => compare (e1, e2)))
+              fn () => joinL compare (es1, es2))
       | (EServerCall _, _) => LESS
       | (_, EServerCall _) => GREATER
 
-      | (ETailCall (n1, es1, e1, _, _), ETailCall (n2, es2, e2, _, _)) =>
-        join (Int.compare (n1, n2),
-              fn () => join (joinL compare (es1, es2),
-                             fn () => compare (e1, e2)))
-      | (ETailCall _, _) => LESS
-      | (_, ETailCall _) => GREATER
-
       | (EKAbs (_, e1), EKAbs (_, e2)) => compare (e1, e2)
       | (EKAbs _, _) => LESS
       | (_, EKAbs _) => GREATER
@@ -725,27 +717,12 @@
                                           fn e2' =>
                                              (ELet (x, t', e1', e2'), loc))))
 
-              | EServerCall (n, es, e, t1, t2) =>
+              | EServerCall (n, es, t) =>
                 S.bind2 (ListUtil.mapfold (mfe ctx) es,
                       fn es' =>
-                         S.bind2 (mfe ctx e,
-                                 fn e' =>
-                                    S.bind2 (mfc ctx t1,
-                                          fn t1' =>
-                                             S.map2 (mfc ctx t2,
-                                                  fn t2' =>
-                                                     (EServerCall (n, es', e', t1', t2'), loc)))))
-
-              | ETailCall (n, es, e, t1, t2) =>
-                S.bind2 (ListUtil.mapfold (mfe ctx) es,
-                      fn es' =>
-                         S.bind2 (mfe ctx e,
-                                 fn e' =>
-                                    S.bind2 (mfc ctx t1,
-                                          fn t1' =>
-                                             S.map2 (mfc ctx t2,
-                                                  fn t2' =>
-                                                     (ETailCall (n, es', e', t1', t2'), loc)))))
+                         S.map2 (mfc ctx t,
+                              fn t' =>
+                                 (EServerCall (n, es', t'), loc)))
 
               | EKAbs (x, e) =>
                 S.map2 (mfe (bind (ctx, RelK x)) e,
--- a/src/effectize.sml	Sun Oct 25 13:12:24 2009 -0400
+++ b/src/effectize.sml	Sun Oct 25 14:07:10 2009 -0400
@@ -46,7 +46,7 @@
                 EFfi f => effectful f
               | EFfiApp (m, x, _) => effectful (m, x)
               | ENamed n => IM.inDomain (evs, n)
-              | EServerCall (n, _, _, _, _) => IM.inDomain (evs, n)
+              | EServerCall (n, _, _) => IM.inDomain (evs, n)
               | _ => false
 
         fun couldWriteOnload evs = U.Exp.exists {kind = fn _ => false,
@@ -70,7 +70,7 @@
             case e of
                 EFfi ("Basis", "getCookie") => true
               | ENamed n => IM.inDomain (evs, n)
-              | EServerCall (n, _, _, _, _) => IM.inDomain (evs, n)
+              | EServerCall (n, _, _) => IM.inDomain (evs, n)
               | _ => false
 
         fun couldReadCookie evs = U.Exp.exists {kind = fn _ => false,
--- a/src/jscomp.sml	Sun Oct 25 13:12:24 2009 -0400
+++ b/src/jscomp.sml	Sun Oct 25 14:07:10 2009 -0400
@@ -900,10 +900,9 @@
                                  st)
                             end
 
-                          | EServerCall (e, ek, t, eff) =>
+                          | EServerCall (e, t, eff) =>
                             let
                                 val (e, st) = jsE inner (e, st)
-                                val (ek, st) = jsE inner (ek, st)
                                 val (unurl, st) = unurlifyExp loc (t, st)
                             in
                                 (strcat [str ("{c:\"f\",f:rc,a:cons({c:\"c\",v:\""
@@ -911,9 +910,7 @@
                                               ^ "\"},cons("),
                                          e,
                                          str (",cons({c:\"c\",v:function(s){var t=s.split(\"/\");var i=0;return "
-                                              ^ unurl ^ "}},cons("),
-                                         ek,
-                                         str (",cons({c:\"c\",v:"
+                                              ^ unurl ^ "}},cons({c:\"K\"},cons({c:\"c\",v:"
                                               ^ (case eff of
                                                      ReadCookieWrite => "true"
                                                    | _ => "false")
@@ -1165,12 +1162,11 @@
                      ((ESignalSource e, loc), st)
                  end
                  
-               | EServerCall (e1, e2, t, ef) =>
+               | EServerCall (e1, t, ef) =>
                  let
                      val (e1, st) = exp outer (e1, st)
-                     val (e2, st) = exp outer (e2, st)
                  in
-                     ((EServerCall (e1, e2, t, ef), loc), st)
+                     ((EServerCall (e1, t, ef), loc), st)
                  end
                | ERecv (e1, e2, t) =>
                  let
--- a/src/mono.sml	Sun Oct 25 13:12:24 2009 -0400
+++ b/src/mono.sml	Sun Oct 25 14:07:10 2009 -0400
@@ -113,8 +113,8 @@
        | ESignalReturn of exp
        | ESignalBind of exp * exp
        | ESignalSource of exp
-
-       | EServerCall of exp * exp * typ * effect
+                              
+       | EServerCall of exp * typ * effect
        | ERecv of exp * exp * typ
        | ESleep of exp * exp
 
--- a/src/mono_print.sml	Sun Oct 25 13:12:24 2009 -0400
+++ b/src/mono_print.sml	Sun Oct 25 14:07:10 2009 -0400
@@ -335,11 +335,9 @@
                                 p_exp env e,
                                 string ")"]
 
-      | EServerCall (n, e, _, _) => box [string "Server(",
-                                         p_exp env n,
-                                         string ")[",
-                                         p_exp env e,
-                                         string "]"]
+      | EServerCall (n, _, _) => box [string "Server(",
+                                      p_exp env n,
+                                      string ")"]
       | ERecv (n, e, _) => box [string "Recv(",
                                 p_exp env n,
                                 string ")[",
--- a/src/mono_reduce.sml	Sun Oct 25 13:12:24 2009 -0400
+++ b/src/mono_reduce.sml	Sun Oct 25 14:07:10 2009 -0400
@@ -450,7 +450,7 @@
                       | ESignalBind (e1, e2) => summarize d e1 @ summarize d e2
                       | ESignalSource e => summarize d e
 
-                      | EServerCall (e, _, _, _) => summarize d e @ [Unsure]
+                      | EServerCall (e, _, _) => summarize d e @ [Unsure]
                       | ERecv (e, _, _) => summarize d e @ [Unsure]
                       | ESleep (e, _) => summarize d e @ [Unsure]
             in
--- a/src/mono_util.sml	Sun Oct 25 13:12:24 2009 -0400
+++ b/src/mono_util.sml	Sun Oct 25 14:07:10 2009 -0400
@@ -362,14 +362,12 @@
                      fn e' =>
                         (ESignalSource e', loc))
 
-              | EServerCall (s, ek, t, eff) =>
+              | EServerCall (s, t, eff) =>
                 S.bind2 (mfe ctx s,
                          fn s' =>
-                            S.bind2 (mfe ctx ek,
-                                  fn ek' =>
-                                     S.map2 (mft t,
-                                          fn t' =>
-                                             (EServerCall (s', ek', t', eff), loc))))
+                            S.map2 (mft t,
+                                  fn t' =>
+                                     (EServerCall (s', t', eff), loc)))
               | ERecv (s, ek, t) =>
                 S.bind2 (mfe ctx s,
                       fn s' =>
--- a/src/monoize.sml	Sun Oct 25 13:12:24 2009 -0400
+++ b/src/monoize.sml	Sun Oct 25 14:07:10 2009 -0400
@@ -3201,22 +3201,7 @@
                 ((L'.ELet (x, t', e1, e2), loc), fm)
             end
 
-          | L.ETailCall (n, es, ek, _, (L.TRecord (L.CRecord (_, []), _), _)) =>
-            let
-                val (es, fm) = ListUtil.foldlMap (fn (e, fm) => monoExp (env, st, fm) e) fm es
-                val (ek, fm) = monoExp (env, st, fm) ek
-
-                val e = (L'.ENamed n, loc)
-                val e = foldl (fn (arg, e) => (L'.EApp (e, arg), loc)) e es
-                val e = (L'.EApp (e, ek), loc)
-            in
-                (e, fm)
-            end
-          | L.ETailCall _ => (E.errorAt loc "Full scope of tail call continuation isn't known";
-                              Print.eprefaces' [("Expression", CorePrint.p_exp env all)];
-                              (dummyExp, fm))
-
-          | L.EServerCall (n, es, ek, t, (L.TRecord (L.CRecord (_, []), _), _)) =>
+          | L.EServerCall (n, es, t) =>
             let
                 val t = monoType env t
                 val (_, ft, _, name) = Env.lookupENamed env n
@@ -3239,37 +3224,19 @@
                 val call = foldl (fn (e, call) => (L'.EStrcat (call, e), loc))
                                  (L'.EPrim (Prim.String name), loc) call
 
-                val (ek, fm) = monoExp (env, st, fm) ek
-
                 val unit = (L'.TRecord [], loc)
 
-                val ekf = (L'.EAbs ("f",
-                                    (L'.TFun (t,
-                                              (L'.TFun ((L'.TRecord [], loc),
-                                                        (L'.TRecord [], loc)), loc)), loc),
-                                    (L'.TFun (t,
-                                              (L'.TRecord [], loc)), loc),
-                                    (L'.EAbs ("x",
-                                              t,
-                                              (L'.TRecord [], loc),
-                                              (L'.EApp ((L'.EApp ((L'.ERel 1, loc),
-                                                                  (L'.ERel 0, loc)), loc),
-                                                        (L'.ERecord [], loc)), loc)), loc)), loc)
-                val ek = (L'.EApp (ekf, ek), loc)
                 val eff = if IS.member (!readCookie, n) then
                               L'.ReadCookieWrite
                           else
                               L'.ReadOnly
 
-                val e = (L'.EServerCall (call, ek, t, eff), loc)
+                val e = (L'.EServerCall (call, t, eff), loc)
                 val e = liftExpInExp 0 e
                 val e = (L'.EAbs ("_", unit, unit, e), loc)
             in
                 (e, fm)
             end
-          | L.EServerCall _ => (E.errorAt loc "Full scope of server call continuation isn't known";
-                                Print.eprefaces' [("Expression", CorePrint.p_exp env all)];
-                                (dummyExp, fm))
 
           | L.EKAbs _ => poly ()
           | L.EKApp _ => poly ()
--- a/src/reduce.sml	Sun Oct 25 13:12:24 2009 -0400
+++ b/src/reduce.sml	Sun Oct 25 14:07:10 2009 -0400
@@ -409,102 +409,6 @@
                                     case #1 e of
                                         EApp
                                             ((EApp
-                                                  ((EApp ((ECApp ((ECApp ((ECApp ((EFfi ("Basis", "bind"), loc), _), _),
-                                                                          t1),
-                                                                   _), t2), _),
-                                                          (EFfi ("Basis", "transaction_monad"), _)), _),
-                                                   (EServerCall (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' = (EServerCall (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"), _)), _),
-                                                   (EServerCall (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' = (EServerCall (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, (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), _),
@@ -792,10 +696,7 @@
                           | ELet (x, t, e1, e2) =>
                             (ELet (x, con env t, exp env e1, exp (UnknownE :: env) e2), loc)
 
-                          | EServerCall (n, es, e, t1, t2) => (EServerCall (n, map (exp env) es, exp env e,
-                                                                            con env t1, con env t2), loc)
-                          | ETailCall (n, es, e, t1, t2) => (ETailCall (n, map (exp env) es, exp env e,
-                                                                        con env t1, con env t2), loc)
+                          | EServerCall (n, es, t) => (EServerCall (n, map (exp env) es, con env t), loc)
             in
                 (*if dangling (edepth' (deKnown env)) r then
                     (Print.prefaces "exp" [("e", CorePrint.p_exp CoreEnv.empty all),
--- a/src/reduce_local.sml	Sun Oct 25 13:12:24 2009 -0400
+++ b/src/reduce_local.sml	Sun Oct 25 14:07:10 2009 -0400
@@ -139,8 +139,7 @@
 
       | ELet (x, t, e1, e2) => (ELet (x, t, exp env e1, exp (Unknown :: env) e2), loc)
 
-      | EServerCall (n, es, e, t1, t2) => (EServerCall (n, map (exp env) es, exp env e, t1, t2), loc)
-      | ETailCall (n, es, e, t1, t2) => (ETailCall (n, map (exp env) es, exp env e, t1, t2), loc)
+      | EServerCall (n, es, t) => (EServerCall (n, map (exp env) es, t), loc)
 
 fun reduce file =
     let
--- a/src/rpcify.sml	Sun Oct 25 13:12:24 2009 -0400
+++ b/src/rpcify.sml	Sun Oct 25 14:07:10 2009 -0400
@@ -112,11 +112,7 @@
                                 val st = {exported = exported,
                                           export_decls = export_decls}
 
-                                val k = (ECApp ((EFfi ("Basis", "return"), loc),
-                                                (CFfi ("Basis", "transaction"), loc)), loc)
-                                val k = (ECApp (k, ran), loc)
-                                val k = (EApp (k, (EFfi ("Basis", "transaction_monad"), loc)), loc)
-                                val e' = EServerCall (n, args, k, ran, ran)
+                                val e' = EServerCall (n, args, ran)
                             in
                                 (e', st)
                             end
--- a/src/shake.sml	Sun Oct 25 13:12:24 2009 -0400
+++ b/src/shake.sml	Sun Oct 25 14:07:10 2009 -0400
@@ -137,8 +137,7 @@
             in
                 case e of
                     ENamed n => check n
-                  | EServerCall (n, _, _, _, _) => check n
-                  | ETailCall (n, _, _, _, _) => check n
+                  | EServerCall (n, _, _) => check n
                   | _ => s
             end
 
--- a/src/sources	Sun Oct 25 13:12:24 2009 -0400
+++ b/src/sources	Sun Oct 25 14:07:10 2009 -0400
@@ -131,9 +131,6 @@
 rpcify.sig
 rpcify.sml
 
-tailify.sig
-tailify.sml
-
 tag.sig
 tag.sml
 
--- a/src/tailify.sig	Sun Oct 25 13:12:24 2009 -0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,32 +0,0 @@
-(* Copyright (c) 2009, Adam Chlipala
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are met:
- *
- * - Redistributions of source code must retain the above copyright notice,
- *   this list of conditions and the following disclaimer.
- * - Redistributions in binary form must reproduce the above copyright notice,
- *   this list of conditions and the following disclaimer in the documentation
- *   and/or other materials provided with the distribution.
- * - The names of contributors may not be used to endorse or promote products
- *   derived from this software without specific prior written permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
- * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
- * POSSIBILITY OF SUCH DAMAGE.
- *)
-
-signature TAILIFY = sig
-
-    val frob : Core.file -> Core.file
-
-end
--- a/src/tailify.sml	Sun Oct 25 13:12:24 2009 -0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,206 +0,0 @@
-(* Copyright (c) 2009, Adam Chlipala
- * All rights reserved.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are met:
- *
- * - Redistributions of source code must retain the above copyright notice,
- *   this list of conditions and the following disclaimer.
- * - Redistributions in binary form must reproduce the above copyright notice,
- *   this list of conditions and the following disclaimer in the documentation
- *   and/or other materials provided with the distribution.
- * - The names of contributors may not be used to endorse or promote products
- *   derived from this software without specific prior written permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
- * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
- * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
- * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
- * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
- * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
- * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
- * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
- * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
- * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
- * POSSIBILITY OF SUCH DAMAGE.
- *)
-
-structure Tailify :> TAILIFY = struct
-
-open Core
-
-structure U = CoreUtil
-structure E = CoreEnv
-
-fun multiLiftExpInExp n e =
-    if n = 0 then
-        e
-    else
-        multiLiftExpInExp (n - 1) (E.liftExpInExp 0 e)
-
-structure IS = IntBinarySet
-structure IM = IntBinaryMap
-
-type state = {
-     cpsed : exp' IM.map,
-     rpc : IS.set
-}
-
-fun frob file =
-    let
-        fun exp (e, st : state) =
-            case e of
-                ENamed n =>
-                (case IM.find (#cpsed st, n) of
-                     NONE => (e, st)
-                   | SOME re => (re, st))
-                
-              | _ => (e, st)
-
-        and doExp (e, st) = U.Exp.foldMap {kind = fn x => x,
-                                           con = fn x => x,
-                                           exp = exp} st (ReduceLocal.reduceExp e)
-
-        fun decl (d, st : state) =
-            let
-                fun makesServerCall b (e, _) =
-                    case e of
-                        EServerCall _ => true
-                      | ETailCall _ => raise Fail "Tailify: ETailCall too early"
-                      | ENamed n => IS.member (#rpc st, n)
-
-                      | EPrim _ => false
-                      | ERel n => List.nth (b, n)
-                      | ECon (_, _, _, NONE) => false
-                      | ECon (_, _, _, SOME e) => makesServerCall b e
-                      | EFfi _ => false
-                      | EFfiApp (_, _, es) => List.exists (makesServerCall b) es
-                      | EApp (e1, e2) => makesServerCall b e1 orelse makesServerCall b e2
-                      | EAbs (_, _, _, e1) => makesServerCall (false :: b) e1
-                      | ECApp (e1, _) => makesServerCall b e1
-                      | ECAbs (_, _, e1) => makesServerCall b e1
-
-                      | EKAbs (_, e1) => makesServerCall b e1
-                      | EKApp (e1, _) => makesServerCall b e1
-
-                      | ERecord xes => List.exists (fn ((CName s, _), e, _) =>
-                                                       not (String.isPrefix "On" s) andalso makesServerCall b e
-                                                     | (_, e, _) => makesServerCall b e) xes
-                      | EField (e1, _, _) => makesServerCall b e1
-                      | EConcat (e1, _, e2, _) => makesServerCall b e1 orelse makesServerCall b e2
-                      | ECut (e1, _, _) => makesServerCall b e1
-                      | ECutMulti (e1, _, _) => makesServerCall b e1
-
-                      | ECase (e1, pes, _) => makesServerCall b e1
-                                              orelse List.exists (fn (p, e) =>
-                                                                     makesServerCall (List.tabulate (E.patBindsN p,
-                                                                                                  fn _ => false) @ b)
-                                                                                     e) pes
-
-                      | EWrite e1 => makesServerCall b e1
-
-                      | EClosure (_, es) => List.exists (makesServerCall b) es
-
-                      | ELet (_, _, e1, e2) => makesServerCall (makesServerCall b e1 :: b) e2
-
-                val makesServerCall = makesServerCall []
-
-                val (d, st) =
-                    case #1 d of
-                        DValRec vis =>
-                        if List.exists (fn (_, _, _, e, _) => makesServerCall e) vis then
-                            let
-                                val rpc = foldl (fn ((_, n, _, _, _), rpc) =>
-                                                    IS.add (rpc, n)) (#rpc st) vis
-
-                                val (cpsed, vis') =
-                                    foldl (fn (vi as (x, n, t, e, s), (cpsed, vis')) =>
-                                              let
-                                                  fun getArgs (t, acc) =
-                                                      case #1 t of
-                                                          TFun (dom, ran) =>
-                                                          getArgs (ran, dom :: acc)
-                                                        | _ => (rev acc, t)
-                                                  val (ts, ran) = getArgs (t, [])
-                                                  val ran = case #1 ran of
-                                                                CApp (_, ran) => ran
-                                                              | _ => raise Fail "Rpcify: Tail function not transactional"
-                                                  val len = length ts
-
-                                                  val loc = #2 e
-                                                  val args = ListUtil.mapi
-                                                                 (fn (i, _) =>
-                                                                     (ERel (len - i - 1), loc))
-                                                                 ts
-                                                  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),
-                                                                            loc),
-                                                                           (TFun (dom, ran), loc)))
-                                                                      (re, ran) ts
-
-                                                  val be = multiLiftExpInExp (len + 1) e
-                                                  val be = ListUtil.foldli
-                                                               (fn (i, _, be) =>
-                                                                   (EApp (be, (ERel (len - i), loc)), loc))
-                                                               be ts
-                                                  val ne = (EFfi ("Basis", "bind"), loc)
-                                                  val ne = (ECApp (ne, trans), loc)
-                                                  val ne = (ECApp (ne, ran), loc)
-                                                  val unit = (TRecord (CRecord ((KType, loc), []),
-                                                                       loc), loc)
-                                                  val ne = (ECApp (ne, unit), loc)
-                                                  val ne = (EApp (ne, (EFfi ("Basis", "transaction_monad"),
-                                                                       loc)), loc)
-                                                  val ne = (EApp (ne, be), loc)
-                                                  val ne = (EApp (ne, (ERel 0, loc)), loc)
-                                                  val tunit = (CApp (trans, unit), loc)
-                                                  val kt = (TFun (ran, tunit), loc)
-                                                  val ne = (EAbs ("k", kt, tunit, ne), loc)
-                                                  val (ne, res) = foldr (fn (dom, (ne, ran)) =>
-                                                                            ((EAbs ("x", dom, ran, ne), loc),
-                                                                             (TFun (dom, ran), loc)))
-                                                                        (ne, (TFun (kt, tunit), loc)) ts
-                                              in
-                                                  (IM.insert (cpsed, n, #1 re),
-                                                   (x, n, res, ne, s) :: vis')
-                                              end)
-                                          (#cpsed st, []) vis
-                            in
-                                ((DValRec (rev vis'), ErrorMsg.dummySpan),
-                                 {cpsed = cpsed,
-                                  rpc = rpc})
-                            end
-                        else
-                            (d, st)
-                      | DVal (x, n, t, e, s) =>
-                        (d,
-                         {cpsed = #cpsed st,
-                          rpc = if makesServerCall e then
-                                    IS.add (#rpc st, n)
-                                else
-                                    #rpc st})
-                      | _ => (d, st)
-            in
-                U.Decl.foldMap {kind = fn x => x,
-                                con = fn x => x,
-                                exp = exp,
-                                decl = fn x => x}
-                               st d
-            end
-
-        val (file, _) = ListUtil.foldlMap decl
-                        {cpsed = IM.empty,
-                         rpc = IS.empty}
-                        file
-    in
-        file
-    end
-
-end