changeset 649:96ebc6bdb5a0

Batch example
author Adam Chlipala <adamc@hcoop.net>
date Tue, 10 Mar 2009 15:17:23 -0400
parents 3c6d535d3d8b
children fcf0bd3d1667
files demo/batch.ur demo/batch.urp demo/batch.urs demo/increment.urp demo/prose lib/js/urweb.js src/jscomp.sml src/mono_opt.sml src/rpcify.sml
diffstat 9 files changed, 381 insertions(+), 219 deletions(-) [+]
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/demo/batch.ur	Tue Mar 10 15:17:23 2009 -0400
@@ -0,0 +1,80 @@
+datatype list t = Nil | Cons of t * list t
+
+table t : {Id : int, A : string}
+
+fun allRows () =
+    query (SELECT * FROM t)
+    (fn r acc => return (Cons ((r.T.Id, r.T.A), acc)))
+    Nil
+
+fun doBatch ls =
+    case ls of
+        Nil => return ()
+      | Cons ((id, a), ls') =>
+        dml (INSERT INTO t (Id, A) VALUES ({[id]}, {[a]}));
+        doBatch ls'
+
+fun del id =
+    dml (DELETE FROM t WHERE t.Id = {[id]})
+
+fun show withDel lss =
+    let
+        fun show' ls =
+            case ls of
+                Nil => <xml/>
+              | Cons ((id, a), ls) => <xml>
+                <tr><td>{[id]}</td> <td>{[a]}</td> {if withDel then
+                                                        <xml><td><button value="Delete" onclick={del id}/></td></xml>
+                                                    else
+                                                        <xml/>} </tr>
+                {show' ls}
+              </xml>
+    in
+        <xml><dyn signal={ls <- signal lss; return <xml><table>
+          <tr> <th>Id</th> <th>A</th> </tr>
+          {show' ls}
+        </table></xml>}/></xml>
+    end
+
+fun main () =
+    lss <- source Nil;
+    batched <- source Nil;
+
+    id <- source "";
+    a <- source "";
+
+    let
+        fun add () =
+            id <- get id;
+            a <- get a;
+            ls <- get batched;
+
+            set batched (Cons ((readError id, a), ls))
+
+        fun exec () =
+            ls <- get batched;
+
+            doBatch ls;
+            set batched Nil
+    in
+        return <xml><body>
+          <h2>Rows</h2>
+
+          {show True lss}
+
+          <button value="Update" onclick={ls <- allRows (); set lss ls}/><br/>
+          <br/>
+
+          <h2>Batch new rows to add</h2>
+
+          <table>
+            <tr> <th>Id:</th> <td><ctextbox source={id}/></td> </tr>
+            <tr> <th>A:</th> <td><ctextbox source={a}/></td> </tr>
+            <tr> <th/> <td><button value="Batch it" onclick={add ()}/></td> </tr>
+          </table>
+
+          <h2>Already batched:</h2>
+          {show False batched}
+          <button value="Execute" onclick={exec ()}/>
+        </body></xml>
+    end
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/demo/batch.urp	Tue Mar 10 15:17:23 2009 -0400
@@ -0,0 +1,3 @@
+database dbname=test
+
+batch
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/demo/batch.urs	Tue Mar 10 15:17:23 2009 -0400
@@ -0,0 +1,1 @@
+val main : unit -> transaction page
--- a/demo/increment.urp	Tue Mar 10 13:57:09 2009 -0400
+++ b/demo/increment.urp	Tue Mar 10 15:17:23 2009 -0400
@@ -1,4 +1,3 @@
 database dbname=test
-sql increment.sql
 
 increment
--- a/demo/prose	Tue Mar 10 13:57:09 2009 -0400
+++ b/demo/prose	Tue Mar 10 15:17:23 2009 -0400
@@ -209,3 +209,7 @@
 increment.urp
 
 <p>Here's an example where client-side code needs to run more code on the server.  We maintain a (server-side) SQL sequence.  When the user clicks a button, an AJAX request increments the remote sequence and gets the new value.</p>
+
+batch.urp
+
+<p>This example shows more of what is possible with mixed client/server code.  The application is an editor for a simple database table, where additions of new rows can be batched in the client, before a button is clicked to trigger a mass addition.</p>
--- a/lib/js/urweb.js	Tue Mar 10 13:57:09 2009 -0400
+++ b/lib/js/urweb.js	Tue Mar 10 15:17:23 2009 -0400
@@ -99,7 +99,26 @@
 function ts(x) { return x.toString() }
 function bs(b) { return (b ? "True" : "False") }
 
-function pf() { alert("Pattern match failure") }
+function pi(s) {
+  var r = parseInt(s);
+  if (r.toString() == s)
+    return r;
+  else
+    throw "Can't parse int: " + s;
+}
+
+function pfl(s) {
+  var r = parseFloat(s);
+  if (r.toString() == s)
+    return r;
+  else
+    throw "Can't parse float: " + s;
+}
+
+function pf() {
+  alert("Pattern match failure");
+  throw "Pattern match failure";
+}
 
 var closures = [];
 
@@ -145,8 +164,10 @@
 
       if (isok)
         k(parse(xhr.responseText));
-      else
+      else {
         alert("Error querying remote server!");
+        throw "Error querying remote server!";
+      }
     }
   };
 
--- a/src/jscomp.sml	Tue Mar 10 13:57:09 2009 -0400
+++ b/src/jscomp.sml	Tue Mar 10 15:17:23 2009 -0400
@@ -44,6 +44,8 @@
              (("Basis", "htmlifyString"), "eh"),
              (("Basis", "new_client_source"), "sc"),
              (("Basis", "set_client_source"), "sv"),
+             (("Basis", "stringToFloat_error"), "pfl"),
+             (("Basis", "stringToInt_error"), "pi"),
              (("Basis", "urlifyInt"), "ts"),
              (("Basis", "urlifyFloat"), "ts"),
              (("Basis", "urlifyString"), "escape")]
@@ -893,7 +895,7 @@
                           | EDml _ => unsupported "DML"
                           | ENextval _ => unsupported "Nextval"
                           | EUnurlify _ => unsupported "EUnurlify"
-                          | EJavaScript (_, e as (EAbs _, _), _) =>
+                          (*| EJavaScript (_, e as (EAbs _, _), _) =>
                             let
                                 val (e, st) = jsE inner (e, st)
                             in
@@ -901,7 +903,7 @@
                                          e,
                                          str ")+\")\""],
                                  st)
-                            end
+                            end*)
                           | EJavaScript (_, e, _) =>
                             let
                                 val (e, st) = jsE inner (e, st)
--- a/src/mono_opt.sml	Tue Mar 10 13:57:09 2009 -0400
+++ b/src/mono_opt.sml	Tue Mar 10 15:17:23 2009 -0400
@@ -365,6 +365,8 @@
 
       | EJavaScript (_, _, SOME (e, _)) => e
 
+      | EApp ((e1 as EServerCall _, _), (ERecord [], _)) => e1
+
       | _ => e
 
 and optExp e = #1 (U.Exp.map {typ = typ, exp = exp} e)
--- a/src/rpcify.sml	Tue Mar 10 13:57:09 2009 -0400
+++ b/src/rpcify.sml	Tue Mar 10 15:17:23 2009 -0400
@@ -140,242 +140,292 @@
                      IM.empty file
                              
         fun exp (e, st) =
-            case e of
-                EApp (
-                (EApp
-                     ((EApp ((ECApp ((ECApp ((ECApp ((EFfi ("Basis", "bind"), loc), _), _), t1), _), t2), _),
-                             (EFfi ("Basis", "transaction_monad"), _)), _),
-                      (ECase (ed, pes, {disc, ...}), _)), _),
-                trans2) =>
-                let
-                    val e' = (EFfi ("Basis", "bind"), loc)
-                    val e' = (ECApp (e', (CFfi ("Basis", "transaction"), loc)), loc)
-                    val e' = (ECApp (e', t1), loc)
-                    val e' = (ECApp (e', t2), loc)
-                    val e' = (EApp (e', (EFfi ("Basis", "transaction_monad"), loc)), loc)
-
-                    val (pes, st) = ListUtil.foldlMap (fn ((p, e), st) =>
-                                                          let
-                                                              val e' = (EApp (e', e), loc)
-                                                              val e' = (EApp (e',
-                                                                              multiLiftExpInExp (E.patBindsN p)
-                                                                                                trans2), loc)
-                                                              val (e', st) = doExp (e', st)
-                                                          in
-                                                              ((p, e'), st)
-                                                          end) st pes
-                in
-                    (ECase (ed, pes, {disc = disc,
-                                      result = (CApp ((CFfi ("Basis", "transaction"), loc), t2), loc)}),
-                     st)
-                end
-
-              | EApp (
-                (EApp
-                     ((EApp ((ECApp ((ECApp ((ECApp ((EFfi ("Basis", "bind"), loc), _), _), t1), _), t2), _),
-                             (EFfi ("Basis", "transaction_monad"), _)), _),
-                      (EServerCall (n, es, ke, t), _)), _),
-                trans2) =>
-                let
-                    val e' = (EFfi ("Basis", "bind"), loc)
-                    val e' = (ECApp (e', (CFfi ("Basis", "transaction"), loc)), loc)
-                    val e' = (ECApp (e', t), loc)
-                    val e' = (ECApp (e', t2), loc)
-                    val e' = (EApp (e', (EFfi ("Basis", "transaction_monad"), loc)), loc)
-                    val e' = (EApp (e', (EApp (E.liftExpInExp 0 ke, (ERel 0, loc)), loc)), loc)
-                    val e' = (EApp (e', E.liftExpInExp 0 trans2), loc)
-                    val e' = (EAbs ("x", t, t2, e'), loc)
-                    val e' = (EServerCall (n, es, e', t), loc)
-                    val (e', st) = doExp (e', st)
-                in
-                    (#1 e', st)
-                end
-
-              | EApp (
-                (EApp
-                     ((EApp ((ECApp ((ECApp ((ECApp ((EFfi ("Basis", "bind"), loc), _), _), _), _), t3), _),
-                             (EFfi ("Basis", "transaction_monad"), _)), _),
-                      (EApp ((EApp
-                                  ((EApp ((ECApp ((ECApp ((ECApp ((EFfi ("Basis", "bind"), _), _), _), t1), _), t2), _),
-                                          (EFfi ("Basis", "transaction_monad"), _)), _),
-                                   trans1), _), trans2), _)), _),
-                trans3) =>
-                let
-                    val e'' = (EFfi ("Basis", "bind"), loc)
-                    val e'' = (ECApp (e'', (CFfi ("Basis", "transaction"), loc)), loc)
-                    val e'' = (ECApp (e'', t2), loc)
-                    val e'' = (ECApp (e'', t3), loc)
-                    val e'' = (EApp (e'', (EFfi ("Basis", "transaction_monad"), loc)), loc)
-                    val e'' = (EApp (e'', (EApp (E.liftExpInExp 0 trans2, (ERel 0, loc)), loc)), loc)
-                    val e'' = (EApp (e'', E.liftExpInExp 0 trans3), loc)
-                    val e'' = (EAbs ("x", t1, (CApp ((CFfi ("Basis", "transaction"), loc), t3), loc), e''), loc)
-
-                    val e' = (EFfi ("Basis", "bind"), loc)
-                    val e' = (ECApp (e', (CFfi ("Basis", "transaction"), loc)), loc)
-                    val e' = (ECApp (e', t1), loc)
-                    val e' = (ECApp (e', t3), loc)
-                    val e' = (EApp (e', (EFfi ("Basis", "transaction_monad"), loc)), loc)
-                    val e' = (EApp (e', trans1), loc)
-                    val e' = (EApp (e', e''), loc)
-                    val (e', st) = doExp (e', st)
-                in
-                    (#1 e', st)
-                end
-
-              | EApp (
-                (EApp
-                     ((EApp ((ECApp ((ECApp ((ECApp ((EFfi ("Basis", "bind"), _), _), _), _), _), _), _),
-                             (EFfi ("Basis", "transaction_monad"), _)), _),
-                      _), loc),
-                (EAbs (_, _, _, (EWrite _, _)), _)) => (e, st)
-
-              | EApp (
-                (EApp
-                     ((EApp ((ECApp ((ECApp ((ECApp ((EFfi ("Basis", "bind"), _), _), _), t1), _), t2), _),
-                             (EFfi ("Basis", "transaction_monad"), _)), _),
-                      trans1), loc),
-                trans2) =>
-                let
-                    (*val () = Print.prefaces "Default"
-                                            [("e", CorePrint.p_exp CoreEnv.empty (e, ErrorMsg.dummySpan))]*)
-
-                    fun getApp (e', args) =
+            let
+                fun getApp (e', args) =
+                    let
+                        val loc = #2 e'
+                    in
                         case #1 e' of
                             ENamed n => (n, args)
                           | EApp (e1, e2) => getApp (e1, e2 :: args)
                           | _ => (ErrorMsg.errorAt loc "Mixed client/server code doesn't use a named function for server part";
                                   Print.prefaces "Bad" [("e", CorePrint.p_exp CoreEnv.empty (e, ErrorMsg.dummySpan))];
                                   (0, []))
-                in
-                    case (serverSide (#cpsed_range st) trans1, clientSide (#cpsed_range st) trans1,
-                          serverSide (#cpsed_range st) trans2, clientSide (#cpsed_range st) trans2) of
-                        (true, false, _, true) =>
-                        let
-                            val (n, args) = getApp (trans1, [])
+                    end
 
-                            val (exported, export_decls) =
-                                if IS.member (#exported st, n) then
-                                    (#exported st, #export_decls st)
-                                else
-                                    (IS.add (#exported st, n),
-                                     (DExport (Rpc, n), loc) :: #export_decls st)
+                fun newRpc (trans1, trans2, st : state) =
+                    let
+                        val loc = #2 trans1
 
-                            val st = {cpsed = #cpsed st,
-                                      cpsed_range = #cpsed_range st,
-                                      cps_decls = #cps_decls st,
+                        val (n, args) = getApp (trans1, [])
 
-                                      exported = exported,
-                                      export_decls = export_decls,
+                        val (exported, export_decls) =
+                            if IS.member (#exported st, n) then
+                                (#exported st, #export_decls st)
+                            else
+                                (IS.add (#exported st, n),
+                                 (DExport (Rpc, n), loc) :: #export_decls st)
 
-                                      maxName = #maxName st}
+                        val st = {cpsed = #cpsed st,
+                                  cpsed_range = #cpsed_range st,
+                                  cps_decls = #cps_decls st,
 
-                            val ran =
-                                case IM.find (tfuncs, n) of
-                                    NONE => (Print.prefaces "BAD" [("e", CorePrint.p_exp CoreEnv.empty (e, loc))];
-                                             raise Fail ("Rpcify: Undetected transaction function " ^ Int.toString n))
-                                  | SOME (_, _, ran, _) => ran
+                                  exported = exported,
+                                  export_decls = export_decls,
 
-                            val e' = EServerCall (n, args, trans2, ran)
-                        in
-                            (EServerCall (n, args, trans2, ran), st)
-                        end
-                      | (true, true, _, _) =>
-                        let
-                            val (n, args) = getApp (trans1, [])
+                                  maxName = #maxName st}
 
-                            fun makeCall n' =
-                                let
-                                    val e = (ENamed n', loc)
-                                    val e = (EApp (e, trans2), loc)
-                                in
-                                    #1 (foldl (fn (arg, e) => (EApp (e, arg), loc)) e args)
-                                end
-                        in
-                            case IM.find (#cpsed_range st, n) of
-                                SOME kdom =>
-                                (case args of
-                                     [] => raise Fail "Rpcify: cps'd function lacks first argument"
-                                   | ke :: args =>
+                        val ran =
+                            case IM.find (tfuncs, n) of
+                                NONE => (Print.prefaces "BAD" [("e", CorePrint.p_exp CoreEnv.empty (e, loc))];
+                                         raise Fail ("Rpcify: Undetected transaction function " ^ Int.toString n))
+                              | SOME (_, _, ran, _) => ran
+
+                        val e' = EServerCall (n, args, trans2, ran)
+                    in
+                        (e', st)
+                    end
+            in
+                case e of
+                    EApp (
+                    (EApp
+                         ((EApp ((ECApp ((ECApp ((ECApp ((EFfi ("Basis", "bind"), loc), _), _), t1), _), t2), _),
+                                 (EFfi ("Basis", "transaction_monad"), _)), _),
+                          (ECase (ed, pes, {disc, ...}), _)), _),
+                    trans2) =>
+                    let
+                        val e' = (EFfi ("Basis", "bind"), loc)
+                        val e' = (ECApp (e', (CFfi ("Basis", "transaction"), loc)), loc)
+                        val e' = (ECApp (e', t1), loc)
+                        val e' = (ECApp (e', t2), loc)
+                        val e' = (EApp (e', (EFfi ("Basis", "transaction_monad"), loc)), loc)
+
+                        val (pes, st) = ListUtil.foldlMap (fn ((p, e), st) =>
+                                                              let
+                                                                  val e' = (EApp (e', e), loc)
+                                                                  val e' = (EApp (e',
+                                                                                  multiLiftExpInExp (E.patBindsN p)
+                                                                                                    trans2), loc)
+                                                                  val (e', st) = doExp (e', st)
+                                                              in
+                                                                  ((p, e'), st)
+                                                              end) st pes
+                    in
+                        (ECase (ed, pes, {disc = disc,
+                                          result = (CApp ((CFfi ("Basis", "transaction"), loc), t2), loc)}),
+                         st)
+                    end
+
+                  | EApp (
+                    (EApp
+                         ((EApp ((ECApp ((ECApp ((ECApp ((EFfi ("Basis", "bind"), loc), _), _), t1), _), t2), _),
+                                 (EFfi ("Basis", "transaction_monad"), _)), _),
+                          (EServerCall (n, es, ke, t), _)), _),
+                    trans2) =>
+                    let
+                        val e' = (EFfi ("Basis", "bind"), loc)
+                        val e' = (ECApp (e', (CFfi ("Basis", "transaction"), loc)), loc)
+                        val e' = (ECApp (e', t), loc)
+                        val e' = (ECApp (e', t2), loc)
+                        val e' = (EApp (e', (EFfi ("Basis", "transaction_monad"), loc)), loc)
+                        val e' = (EApp (e', (EApp (E.liftExpInExp 0 ke, (ERel 0, loc)), loc)), loc)
+                        val e' = (EApp (e', E.liftExpInExp 0 trans2), loc)
+                        val e' = (EAbs ("x", t, t2, e'), loc)
+                        val e' = (EServerCall (n, es, e', t), loc)
+                        val (e', st) = doExp (e', st)
+                    in
+                        (#1 e', st)
+                    end
+
+                  | EApp (
+                    (EApp
+                         ((EApp ((ECApp ((ECApp ((ECApp ((EFfi ("Basis", "bind"), loc), _), _), _), _), t3), _),
+                                 (EFfi ("Basis", "transaction_monad"), _)), _),
+                          (EApp ((EApp
+                                      ((EApp ((ECApp ((ECApp ((ECApp ((EFfi ("Basis", "bind"), _), _), _), t1), _), t2), _),
+                                              (EFfi ("Basis", "transaction_monad"), _)), _),
+                                       trans1), _), trans2), _)), _),
+                    trans3) =>
+                    let
+                        val e'' = (EFfi ("Basis", "bind"), loc)
+                        val e'' = (ECApp (e'', (CFfi ("Basis", "transaction"), loc)), loc)
+                        val e'' = (ECApp (e'', t2), loc)
+                        val e'' = (ECApp (e'', t3), loc)
+                        val e'' = (EApp (e'', (EFfi ("Basis", "transaction_monad"), loc)), loc)
+                        val e'' = (EApp (e'', (EApp (E.liftExpInExp 0 trans2, (ERel 0, loc)), loc)), loc)
+                        val e'' = (EApp (e'', E.liftExpInExp 0 trans3), loc)
+                        val e'' = (EAbs ("x", t1, (CApp ((CFfi ("Basis", "transaction"), loc), t3), loc), e''), loc)
+
+                        val e' = (EFfi ("Basis", "bind"), loc)
+                        val e' = (ECApp (e', (CFfi ("Basis", "transaction"), loc)), loc)
+                        val e' = (ECApp (e', t1), loc)
+                        val e' = (ECApp (e', t3), loc)
+                        val e' = (EApp (e', (EFfi ("Basis", "transaction_monad"), loc)), loc)
+                        val e' = (EApp (e', trans1), loc)
+                        val e' = (EApp (e', e''), loc)
+                        val (e', st) = doExp (e', st)
+                    in
+                        (#1 e', st)
+                    end
+
+                  | EApp (
+                    (EApp
+                         ((EApp ((ECApp ((ECApp ((ECApp ((EFfi ("Basis", "bind"), _), _), _), _), _), _), _),
+                                 (EFfi ("Basis", "transaction_monad"), _)), _),
+                          _), loc),
+                    (EAbs (_, _, _, (EWrite _, _)), _)) => (e, st)
+
+                  | EApp (
+                    (EApp
+                         ((EApp ((ECApp ((ECApp ((ECApp ((EFfi ("Basis", "bind"), _), _), _), t1), _), t2), _),
+                                 (EFfi ("Basis", "transaction_monad"), _)), _),
+                          trans1), loc),
+                    trans2) =>
+                    (case (serverSide (#cpsed_range st) trans1, clientSide (#cpsed_range st) trans1,
+                           serverSide (#cpsed_range st) trans2, clientSide (#cpsed_range st) trans2) of
+                         (true, false, _, true) => newRpc (trans1, trans2, st)
+                       | (true, true, _, _) =>
+                         let
+                             val (n, args) = getApp (trans1, [])
+
+                             fun makeCall n' =
+                                 let
+                                     val e = (ENamed n', loc)
+                                     val e = (EApp (e, trans2), loc)
+                                 in
+                                     #1 (foldl (fn (arg, e) => (EApp (e, arg), loc)) e args)
+                                 end
+                         in
+                             case IM.find (#cpsed_range st, n) of
+                                 SOME kdom =>
+                                 (case args of
+                                      [] => raise Fail "Rpcify: cps'd function lacks first argument"
+                                    | ke :: args =>
+                                      let
+                                          val ke' = (EFfi ("Basis", "bind"), loc)
+                                          val ke' = (ECApp (ke', (CFfi ("Basis", "transaction"), loc)), loc)
+                                          val ke' = (ECApp (ke', kdom), loc)
+                                          val ke' = (ECApp (ke', t2), loc)
+                                          val ke' = (EApp (ke', (EFfi ("Basis", "transaction_monad"), loc)), loc)
+                                          val ke' = (EApp (ke', (EApp (E.liftExpInExp 0 ke, (ERel 0, loc)), loc)), loc)
+                                          val ke' = (EApp (ke', E.liftExpInExp 0 trans2), loc)
+                                          val ke' = (EAbs ("x", kdom,
+                                                           (CApp ((CFfi ("Basis", "transaction"), loc), t2), loc),
+                                                           ke'), loc)
+
+                                          val e' = (ENamed n, loc)
+                                          val e' = (EApp (e', ke'), loc)
+                                          val e' = foldl (fn (arg, e') => (EApp (e', arg), loc)) e' args
+                                          val (e', st) = doExp (e', st)
+                                      in
+                                          (#1 e', st)
+                                      end)
+                               | NONE =>
+                                 case IM.find (#cpsed st, n) of
+                                     SOME n' => (makeCall n', st)
+                                   | NONE =>
                                      let
-                                         val ke' = (EFfi ("Basis", "bind"), loc)
-                                         val ke' = (ECApp (ke', (CFfi ("Basis", "transaction"), loc)), loc)
-                                         val ke' = (ECApp (ke', kdom), loc)
-                                         val ke' = (ECApp (ke', t2), loc)
-                                         val ke' = (EApp (ke', (EFfi ("Basis", "transaction_monad"), loc)), loc)
-                                         val ke' = (EApp (ke', (EApp (E.liftExpInExp 0 ke, (ERel 0, loc)), loc)), loc)
-                                         val ke' = (EApp (ke', E.liftExpInExp 0 trans2), loc)
-                                         val ke' = (EAbs ("x", kdom,
-                                                          (CApp ((CFfi ("Basis", "transaction"), loc), t2), loc),
-                                                          ke'), loc)
+                                         val (name, fargs, ran, e) =
+                                             case IM.find (tfuncs, n) of
+                                                 NONE => (Print.prefaces "BAD" [("e",
+                                                                                 CorePrint.p_exp CoreEnv.empty (e, loc))];
+                                                          raise Fail "Rpcify: Undetected transaction function [2]")
+                                               | SOME x => x
 
-                                         val e' = (ENamed n, loc)
-                                         val e' = (EApp (e', ke'), loc)
-                                         val e' = foldl (fn (arg, e') => (EApp (e', arg), loc)) e' args
-                                         val (e', st) = doExp (e', st)
+                                         val n' = #maxName st
+
+                                         val st = {cpsed = IM.insert (#cpsed st, n, n'),
+                                                   cpsed_range = IM.insert (#cpsed_range st, n', ran),
+                                                   cps_decls = #cps_decls st,
+                                                   exported = #exported st,
+                                                   export_decls = #export_decls st,
+                                                   maxName = n' + 1}
+
+                                         val unit = (TRecord (CRecord ((KType, loc), []), loc), loc)
+                                         val body = (EFfi ("Basis", "bind"), loc)
+                                         val body = (ECApp (body, (CFfi ("Basis", "transaction"), loc)), loc)
+                                         val body = (ECApp (body, t1), loc)
+                                         val body = (ECApp (body, unit), loc)
+                                         val body = (EApp (body, (EFfi ("Basis", "transaction_monad"), loc)), loc)
+                                         val body = (EApp (body, e), loc)
+                                         val body = (EApp (body, (ERel (length args), loc)), loc)
+                                         val bt = (CApp ((CFfi ("Basis", "transaction"), loc), unit), loc)
+                                         val (body, bt) = foldr (fn ((x, t), (body, bt)) =>
+                                                                    ((EAbs (x, t, bt, body), loc),
+                                                                     (TFun (t, bt), loc)))
+                                                                (body, bt) fargs
+                                         val kt = (TFun (ran, (CApp ((CFfi ("Basis", "transaction"), loc),
+                                                                     unit),
+                                                               loc)), loc)
+                                         val body = (EAbs ("k", kt, bt, body), loc)
+                                         val bt = (TFun (kt, bt), loc)
+
+                                         val (body, st) = doExp (body, st)
+
+                                         val vi = (name ^ "_cps",
+                                                   n',
+                                                   bt,
+                                                   body,
+                                                   "")
+
+                                         val st = {cpsed = #cpsed st,
+                                                   cpsed_range = #cpsed_range st,
+                                                   cps_decls = vi :: #cps_decls st,
+                                                   exported = #exported st,
+                                                   export_decls = #export_decls st,
+                                                   maxName = #maxName st}
                                      in
-                                         (#1 e', st)
-                                     end)
-                              | NONE =>
-                                case IM.find (#cpsed st, n) of
-                                    SOME n' => (makeCall n', st)
-                                  | NONE =>
-                                    let
-                                        val (name, fargs, ran, e) =
-                                            case IM.find (tfuncs, n) of
-                                                NONE => (Print.prefaces "BAD" [("e",
-                                                                                CorePrint.p_exp CoreEnv.empty (e, loc))];
-                                                         raise Fail "Rpcify: Undetected transaction function [2]")
-                                              | SOME x => x
+                                         (makeCall n', st)
+                                     end
+                         end
+                       | _ => (e, st))
 
-                                        val n' = #maxName st
+                  | ERecord xes =>
+                    let
+                        val loc = case xes of
+                                      [] => ErrorMsg.dummySpan
+                                    | (_, (_, loc), _) :: _ => loc
 
-                                        val st = {cpsed = IM.insert (#cpsed st, n, n'),
-                                                  cpsed_range = IM.insert (#cpsed_range st, n', ran),
-                                                  cps_decls = #cps_decls st,
-                                                  exported = #exported st,
-                                                  export_decls = #export_decls st,
-                                                  maxName = n' + 1}
+                        fun candidate (x, e) =
+                            String.isPrefix "On" x
+                            andalso serverSide (#cpsed_range st) e
+                            andalso not (clientSide (#cpsed_range st) e)
+                    in
+                        if List.exists (fn ((CName x, _), e, _) => candidate (x, e)
+                                         | _ => false) xes then
+                            let
+                                val unit = (TRecord (CRecord ((KType, loc), []), loc), loc)
 
-                                        val unit = (TRecord (CRecord ((KType, loc), []), loc), loc)
-                                        val body = (EFfi ("Basis", "bind"), loc)
-                                        val body = (ECApp (body, (CFfi ("Basis", "transaction"), loc)), loc)
-                                        val body = (ECApp (body, t1), loc)
-                                        val body = (ECApp (body, unit), loc)
-                                        val body = (EApp (body, (EFfi ("Basis", "transaction_monad"), loc)), loc)
-                                        val body = (EApp (body, e), loc)
-                                        val body = (EApp (body, (ERel (length args), loc)), loc)
-                                        val bt = (CApp ((CFfi ("Basis", "transaction"), loc), unit), loc)
-                                        val (body, bt) = foldr (fn ((x, t), (body, bt)) =>
-                                                                   ((EAbs (x, t, bt, body), loc),
-                                                                    (TFun (t, bt), loc)))
-                                                               (body, bt) fargs
-                                        val kt = (TFun (ran, (CApp ((CFfi ("Basis", "transaction"), loc),
-                                                                    unit),
-                                                              loc)), loc)
-                                        val body = (EAbs ("k", kt, bt, body), loc)
-                                        val bt = (TFun (kt, bt), loc)
+                                val k = (EFfi ("Basis", "return"), loc)
+                                val k = (ECApp (k, (CFfi ("Basis", "transaction"), loc)), loc)
+                                val k = (ECApp (k, unit), loc)
+                                val k = (EApp (k, (EFfi ("Basis", "transaction_monad"), loc)), loc)
+                                val k = (EApp (k, (ERecord [], loc)), loc)
+                                val k = (EAbs ("_", unit, unit, k), loc)
 
-                                        val (body, st) = doExp (body, st)
+                                val (xes, st) = ListUtil.foldlMap
+                                                (fn (y as (nm as (CName x, _), e, t), st) =>
+                                                    if candidate (x, e) then
+                                                        let
+                                                            val (n, args) = getApp (e, [])
 
-                                        val vi = (name ^ "_cps",
-                                                  n',
-                                                  bt,
-                                                  body,
-                                                  "")
+                                                            val (e, st) = newRpc (e, k, st)
+                                                        in
+                                                            ((nm, (e, loc), t), st)
+                                                        end
+                                                    else
+                                                        (y, st)
+                                                  | y => y)
+                                                st xes
+                            in
+                                (ERecord xes, st)
+                            end
+                        else
+                            (e, st)
+                    end
 
-                                        val st = {cpsed = #cpsed st,
-                                                  cpsed_range = #cpsed_range st,
-                                                  cps_decls = vi :: #cps_decls st,
-                                                  exported = #exported st,
-                                                  export_decls = #export_decls st,
-                                                  maxName = #maxName st}
-                                    in
-                                        (makeCall n', st)
-                                    end
-                        end
-                      | _ => (e, st)
-                end
-              | _ => (e, st)
+                  | _ => (e, st)
+            end
 
         and doExp (e, st) = U.Exp.foldMap {kind = fn x => x,
                                            con = fn x => x,