Basis.tryRpc

22 files changed, 180 insertions, 75 deletions

diff --git a/doc/manual.tex b/doc/manual.tex
index a402c6b6..0af87d8e 100644
--- a/doc/manual.tex
+++ b/doc/manual.tex
@@ -2157,6 +2157,12 @@ $$\begin{array}{l}
   \mt{val} \; \mt{rpc} : \mt{t} ::: \mt{Type} \to \mt{transaction} \; \mt{t} \to \mt{transaction} \; \mt{t}
 \end{array}$$
 
+There is an alternate form that uses $\mt{None}$ to indicate that an error occurred during RPC processing, rather than raising an exception to abort this branch of control flow.
+
+$$\begin{array}{l}
+  \mt{val} \; \mt{tryRpc} : \mt{t} ::: \mt{Type} \to \mt{transaction} \; \mt{t} \to \mt{transaction} \; (\mt{option} \; \mt{t})
+\end{array}$$
+
 \subsubsection{Asynchronous Message-Passing}
 
 To support asynchronous, ``server push'' delivery of messages to clients, any client that might need to receive an asynchronous message is assigned a unique ID.  These IDs may be retrieved both on the client and on the server, during execution of code related to a client.
diff --git a/lib/js/urweb.js b/lib/js/urweb.js
index cc65ab8f..f56ba4c6 100644
--- a/lib/js/urweb.js
+++ b/lib/js/urweb.js
@@ -1365,7 +1365,14 @@ function redirect(s) {
     window.location = s;
 }
 
-function rc(prefix, uri, parse, k, needsSig) {
+function makeSome(isN, v) {
+    if (isN)
+        return {v: v};
+    else
+        return v;
+}
+
+function rc(prefix, uri, parse, k, needsSig, isN) {
     if (!maySuspend)
         er("May not 'rpc' in main thread of 'code' for <active>");
 
@@ -1384,18 +1391,30 @@ function rc(prefix, uri, parse, k, needsSig) {
 
             if (isok) {
                 var lines = xhr.responseText.split("\n");
-                if (lines.length != 2)
-                    whine("Bad RPC response lines");
-
-                eval(lines[0]);
-
-                try {
-                    k(parse(lines[1]));
-                } catch (v) {
-                    doExn(v);
+                if (lines.length != 2) {
+                    if (isN == null)
+                        whine("Bad RPC response lines");
+                    else
+                        k(null);
+                } else {
+                    eval(lines[0]);
+
+                    try {
+                        var v = parse(lines[1]);
+                        try {
+                            k(makeSome(isN, v));
+                        } catch (v) {
+                            doExn(v);
+                        }
+                    } catch (v) {
+                        k(null);
+                    }
                 }
             } else {
-                conn();
+                if (isN == null)
+                    conn();
+                else
+                    k(null);
             }
 
             xhrFinished(xhr);
diff --git a/lib/ur/basis.urs b/lib/ur/basis.urs
index 71320a28..59715a7e 100644
--- a/lib/ur/basis.urs
+++ b/lib/ur/basis.urs
@@ -206,6 +206,8 @@ val spawn : transaction unit -> transaction unit
 val sleep : int -> transaction unit
 
 val rpc : t ::: Type -> transaction t -> transaction t
+val tryRpc : t ::: Type -> transaction t -> transaction (option t)
+(* Returns [None] on error condition. *)
 
 
 (** Channels *)
diff --git a/src/core.sml b/src/core.sml
index 4641d1ab..193825bf 100644
--- a/src/core.sml
+++ b/src/core.sml
@@ -1,4 +1,4 @@
-(* Copyright (c) 2008, Adam Chlipala
+(* Copyright (c) 2008, 2013, Adam Chlipala
  * All rights reserved.
  *
  * Redistribution and use in source and binary forms, with or without
@@ -86,6 +86,8 @@ datatype pat' =
 
 withtype pat = pat' located
 
+datatype failure_mode = datatype Settings.failure_mode
+
 datatype exp' =
          EPrim of Prim.t
        | ERel of int
@@ -115,7 +117,7 @@ datatype exp' =
 
        | ELet of string * con * exp * exp
 
-       | EServerCall of int * exp list * con
+       | EServerCall of int * exp list * con * failure_mode
 
 withtype exp = exp' located
 
diff --git a/src/core_print.sml b/src/core_print.sml
index 910ec10a..f360f346 100644
--- a/src/core_print.sml
+++ b/src/core_print.sml
@@ -1,4 +1,4 @@
-(* Copyright (c) 2008-2011, Adam Chlipala
+(* Copyright (c) 2008-2011, 2013, Adam Chlipala
  * All rights reserved.
  *
  * Redistribution and use in source and binary forms, with or without
@@ -446,12 +446,12 @@ fun p_exp' par env (e, _) =
                                     newline,
                                     p_exp (E.pushERel env x t) e2]
 
-      | EServerCall (n, es, _) => box [string "Server(",
-                                       p_enamed env n,
-                                       string ",",
-                                       space,
-                                       p_list (p_exp env) es,
-                                       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,
diff --git a/src/core_untangle.sml b/src/core_untangle.sml
index d734cc6f..a3bb5595 100644
--- a/src/core_untangle.sml
+++ b/src/core_untangle.sml
@@ -1,4 +1,4 @@
-(* Copyright (c) 2008, Adam Chlipala
+(* Copyright (c) 2008, 2013, Adam Chlipala
  * All rights reserved.
  *
  * Redistribution and use in source and binary forms, with or without
@@ -48,7 +48,7 @@ fun exp thisGroup (e, s) =
         case e of
             ENamed n => try n
           | EClosure (n, _) => try n
-          | EServerCall (n, _, _) => try n
+          | EServerCall (n, _, _, _) => try n
           | _ => s
     end
 
diff --git a/src/core_util.sml b/src/core_util.sml
index d41dfe33..152ba7ac 100644
--- a/src/core_util.sml
+++ b/src/core_util.sml
@@ -1,4 +1,4 @@
-(* Copyright (c) 2008-2010, Adam Chlipala
+(* Copyright (c) 2008-2010, 2013, Adam Chlipala
  * All rights reserved.
  *
  * Redistribution and use in source and binary forms, with or without
@@ -439,6 +439,14 @@ fun pCompare ((p1, _), (p2, _)) =
                   join (String.compare (x1, x2),
                         fn () => pCompare (p1, p2))) (xps1, xps2)
 
+fun fmCompare (fm1, fm2) =
+    case (fm1, fm2) of
+        (None, None) => EQUAL
+      | (None, _) => LESS
+      | (_, None) => GREATER
+
+      | (Error, Error) => EQUAL
+
 fun compare ((e1, _), (e2, _)) =
     case (e1, e2) of
         (EPrim p1, EPrim p2) => Prim.compare (p1, p2)
@@ -547,9 +555,10 @@ fun compare ((e1, _), (e2, _)) =
       | (ELet _, _) => LESS
       | (_, ELet _) => GREATER
 
-      | (EServerCall (n1, es1, _), EServerCall (n2, es2, _)) =>
+      | (EServerCall (n1, es1, _, fm1), EServerCall (n2, es2, _, fm2)) =>
         join (Int.compare (n1, n2),
-              fn () => joinL compare (es1, es2))
+           fn () => join (fmCompare (fm1, fm2),
+                       fn () => joinL compare (es1, es2)))
       | (EServerCall _, _) => LESS
       | (_, EServerCall _) => GREATER
 
@@ -738,12 +747,12 @@ fun mapfoldB {kind = fk, con = fc, exp = fe, bind} =
                                           fn e2' =>
                                              (ELet (x, t', e1', e2'), loc))))
 
-              | EServerCall (n, es, t) =>
+              | EServerCall (n, es, t, fm) =>
                 S.bind2 (ListUtil.mapfold (mfe ctx) es,
                       fn es' =>
                          S.map2 (mfc ctx t,
                               fn t' =>
-                                 (EServerCall (n, es', t'), loc)))
+                                 (EServerCall (n, es', t', fm), loc)))
 
               | EKAbs (x, e) =>
                 S.map2 (mfe (bind (ctx, RelK x)) e,
diff --git a/src/css.sml b/src/css.sml
index 8ed6a05a..ece8cf6c 100644
--- a/src/css.sml
+++ b/src/css.sml
@@ -1,4 +1,4 @@
-(* Copyright (c) 2010, Adam Chlipala
+(* Copyright (c) 2010, 2013, Adam Chlipala
  * All rights reserved.
  *
  * Redistribution and use in source and binary forms, with or without
@@ -260,7 +260,7 @@ fun summarize file =
                         in
                             (merge' (sm1, sm2), classes)
                         end
-                      | EServerCall (_, es, _) => expList (es, classes)
+                      | EServerCall (_, es, _, _) => expList (es, classes)
 
                 and expList (es, classes) = foldl (fn (e, (sm, classes)) =>
                                                       let
diff --git a/src/effectize.sml b/src/effectize.sml
index 5096a945..332e1372 100644
--- a/src/effectize.sml
+++ b/src/effectize.sml
@@ -1,4 +1,4 @@
-(* Copyright (c) 2009-2010, Adam Chlipala
+(* Copyright (c) 2009-2010, 2013, Adam Chlipala
  * All rights reserved.
  *
  * Redistribution and use in source and binary forms, with or without
@@ -46,7 +46,7 @@ fun effectize file =
                 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,
@@ -69,7 +69,7 @@ fun effectize file =
         fun exp writers readers pushers e =
             case e of
                 ENamed n => IM.inDomain (pushers, n)
-              | EServerCall (n, _, _) => IM.inDomain (writers, n) andalso IM.inDomain (readers, n)
+              | EServerCall (n, _, _, _) => IM.inDomain (writers, n) andalso IM.inDomain (readers, n)
               | _ => false
 
         fun couldWriteWithRpc writers readers pushers = U.Exp.exists {kind = fn _ => false,
@@ -80,7 +80,7 @@ fun effectize file =
             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,
diff --git a/src/especialize.sml b/src/especialize.sml
index a3d59ef9..51e15a2d 100644
--- a/src/especialize.sml
+++ b/src/especialize.sml
@@ -1,4 +1,4 @@
-(* Copyright (c) 2008-2012, Adam Chlipala
+(* Copyright (c) 2008-2013, Adam Chlipala
  * All rights reserved.
  *
  * Redistribution and use in source and binary forms, with or without
@@ -205,7 +205,7 @@ fun calcConstArgs enclosingFunctions e =
               | EWrite e1 => ca depth e1
               | EClosure (_, es) => foldl (fn (e, d) => Int.min (ca depth e, d)) maxInt es
               | ELet (_, _, e1, e2) => Int.min (ca depth e1, ca (depth + 1) e2)
-              | EServerCall (_, es, _) => foldl (fn (e, d) => Int.min (ca depth e, d)) maxInt es
+              | EServerCall (_, es, _, _) => foldl (fn (e, d) => Int.min (ca depth e, d)) maxInt es
 
         fun enterAbs depth e =
             case #1 e of
@@ -348,11 +348,11 @@ fun specialize' (funcs, specialized) file =
                         in
                             ((ELet (x, t, e1, e2), loc), st)
                         end
-                      | EServerCall (n, es, t) =>
+                      | EServerCall (n, es, t, fm) =>
                         let
                             val (es, st) = ListUtil.foldlMap (fn (e, st) => exp (env, e, st)) st es
                         in
-                            ((EServerCall (n, es, t), loc), st)
+                            ((EServerCall (n, es, t, fm), loc), st)
                         end
             in
                 case getApp e of
diff --git a/src/jscomp.sml b/src/jscomp.sml
index 887fbc87..e0d87a8e 100644
--- a/src/jscomp.sml
+++ b/src/jscomp.sml
@@ -1,4 +1,4 @@
-(* Copyright (c) 2008-2012, Adam Chlipala
+(* Copyright (c) 2008-2013, Adam Chlipala
  * All rights reserved.
  *
  * Redistribution and use in source and binary forms, with or without
@@ -930,10 +930,21 @@ fun process (file : file) =
                                  st)
                             end
 
-                          | EServerCall (e, t, eff) =>
+                          | EServerCall (e, t, eff, fm) =>
                             let
                                 val (e, st) = jsE inner (e, st)
                                 val (unurl, st) = unurlifyExp loc (t, st)
+                                val lastArg = case fm of
+                                                  None => "null"
+                                                | Error =>
+                                                  let
+                                                      val isN = if isNullable t then
+                                                                    "true"
+                                                                else
+                                                                    "false"
+                                                  in
+                                                    "cons({c:\"c\",v:" ^ isN ^ "},null)"
+                                                  end
                             in
                                 (strcat [str ("{c:\"f\",f:rc,a:cons({c:\"c\",v:\""
                                               ^ Settings.getUrlPrefix ()
@@ -944,7 +955,7 @@ fun process (file : file) =
                                               ^ (case eff of
                                                      ReadCookieWrite => "true"
                                                    | _ => "false")
-                                              ^ "},null)))))}")],
+                                              ^ "}," ^ lastArg ^ ")))))}")],
                                  st)
                             end
 
@@ -1231,11 +1242,11 @@ fun process (file : file) =
                      ((ESignalSource e, loc), st)
                  end
                  
-               | EServerCall (e1, t, ef) =>
+               | EServerCall (e1, t, ef, fm) =>
                  let
                      val (e1, st) = exp outer (e1, st)
                  in
-                     ((EServerCall (e1, t, ef), loc), st)
+                     ((EServerCall (e1, t, ef, fm), loc), st)
                  end
                | ERecv (e1, t) =>
                  let
diff --git a/src/mono.sml b/src/mono.sml
index f269c52d..f5260419 100644
--- a/src/mono.sml
+++ b/src/mono.sml
@@ -1,4 +1,4 @@
-(* Copyright (c) 2008-2010, Adam Chlipala
+(* Copyright (c) 2008-2010, 2013, Adam Chlipala
  * All rights reserved.
  *
  * Redistribution and use in source and binary forms, with or without
@@ -120,7 +120,7 @@ datatype exp' =
        | ESignalBind of exp * exp
        | ESignalSource of exp
                               
-       | EServerCall of exp * typ * effect
+       | EServerCall of exp * typ * effect * failure_mode
        | ERecv of exp * typ
        | ESleep of exp
        | ESpawn of exp
diff --git a/src/mono_print.sml b/src/mono_print.sml
index 12b36f2a..a5156aca 100644
--- a/src/mono_print.sml
+++ b/src/mono_print.sml
@@ -1,4 +1,4 @@
-(* Copyright (c) 2008, Adam Chlipala
+(* Copyright (c) 2008, 2013, Adam Chlipala
  * All rights reserved.
  *
  * Redistribution and use in source and binary forms, with or without
@@ -357,7 +357,7 @@ fun p_exp' par env (e, _) =
                                 p_exp env e,
                                 string ")"]
 
-      | EServerCall (n, _, _) => box [string "Server(",
+      | EServerCall (n, _, _, _) => box [string "Server(",
                                       p_exp env n,
                                       string ")"]
       | ERecv (n, _) => box [string "Recv(",
diff --git a/src/mono_reduce.sml b/src/mono_reduce.sml
index e7fac5ed..73adafa3 100644
--- a/src/mono_reduce.sml
+++ b/src/mono_reduce.sml
@@ -1,4 +1,4 @@
-(* Copyright (c) 2008, Adam Chlipala
+(* Copyright (c) 2008, 2013, Adam Chlipala
  * All rights reserved.
  *
  * Redistribution and use in source and binary forms, with or without
@@ -515,7 +515,7 @@ fun reduce (file : file) =
                       | 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]
                       | ESpawn e => summarize d e @ [Unsure]
diff --git a/src/mono_util.sml b/src/mono_util.sml
index 116dfa64..cb871891 100644
--- a/src/mono_util.sml
+++ b/src/mono_util.sml
@@ -380,12 +380,12 @@ fun mapfoldB {typ = fc, exp = fe, bind} =
                      fn e' =>
                         (ESignalSource e', loc))
 
-              | EServerCall (s, t, eff) =>
+              | EServerCall (s, t, eff, fm) =>
                 S.bind2 (mfe ctx s,
                          fn s' =>
                             S.map2 (mft t,
                                   fn t' =>
-                                     (EServerCall (s', t', eff), loc)))
+                                     (EServerCall (s', t', eff, fm), loc)))
               | ERecv (s, t) =>
                 S.bind2 (mfe ctx s,
                       fn s' =>
@@ -510,7 +510,7 @@ fun appLoc f =
                | ESignalReturn e1 => appl e1
                | ESignalBind (e1, e2) => (appl e1; appl e2)
                | ESignalSource e1 => appl e1
-               | EServerCall (e1, _, _) => appl e1
+               | EServerCall (e1, _, _, _) => appl e1
                | ERecv (e1, _) => appl e1
                | ESleep e1 => appl e1
                | ESpawn e1 => appl e1)
diff --git a/src/monoize.sml b/src/monoize.sml
index ce7bfbe9..e2f3d5ca 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -1,4 +1,4 @@
-(* Copyright (c) 2008-2012, Adam Chlipala
+(* Copyright (c) 2008-2013, Adam Chlipala
  * All rights reserved.
  *
  * Redistribution and use in source and binary forms, with or without
@@ -4188,7 +4188,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                 ((L'.ELet (x, t', e1, e2), loc), fm)
             end
 
-          | L.EServerCall (n, es, t) =>
+          | L.EServerCall (n, es, t, fmode) =>
             let
                 val t = monoType env t
                 val (_, ft, _, name) = Env.lookupENamed env n
@@ -4218,7 +4218,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                           else
                               L'.ReadOnly
 
-                val e = (L'.EServerCall (call, t, eff), loc)
+                val e = (L'.EServerCall (call, t, eff, fmode), loc)
                 val e = liftExpInExp 0 e
                 val e = (L'.EAbs ("_", unit, unit, e), loc)
             in
diff --git a/src/reduce.sml b/src/reduce.sml
index f065fe2b..aa5408b0 100644
--- a/src/reduce.sml
+++ b/src/reduce.sml
@@ -1,4 +1,4 @@
-(* Copyright (c) 2008-2011, Adam Chlipala
+(* Copyright (c) 2008-2011, 2013, Adam Chlipala
  * All rights reserved.
  *
  * Redistribution and use in source and binary forms, with or without
@@ -804,7 +804,7 @@ fun kindConAndExp (namedC, namedE) =
                                     (ELet (x, t, e1', exp (UnknownE :: env) e2), loc)
                             end
 
-                          | EServerCall (n, es, t) => (EServerCall (n, map (exp env) es, con env t), loc)
+                          | EServerCall (n, es, t, fm) => (EServerCall (n, map (exp env) es, con env t, fm), loc)
             in
                 (*if dangling (edepth' (deKnown env)) r then
                     (Print.prefaces "exp" [("e", CorePrint.p_exp CoreEnv.empty all),
diff --git a/src/reduce_local.sml b/src/reduce_local.sml
index a6e4f7fc..6fbc6a96 100644
--- a/src/reduce_local.sml
+++ b/src/reduce_local.sml
@@ -1,4 +1,4 @@
-(* Copyright (c) 2008-2010, Adam Chlipala
+(* Copyright (c) 2008-2010, 2013, Adam Chlipala
  * All rights reserved.
  *
  * Redistribution and use in source and binary forms, with or without
@@ -353,7 +353,7 @@ fun exp env (all as (e, loc)) =
 
       | ELet (x, t, e1, e2) => (ELet (x, con env t, exp env e1, exp (Unknown :: env) e2), loc)
 
-      | EServerCall (n, es, t) => (EServerCall (n, map (exp env) es, con env t), loc)
+      | EServerCall (n, es, t, fm) => (EServerCall (n, map (exp env) es, con env t, fm), loc)
 
 fun reduce file =
     let
diff --git a/src/rpcify.sml b/src/rpcify.sml
index f8aee6c7..551a1510 100644
--- a/src/rpcify.sml
+++ b/src/rpcify.sml
@@ -1,4 +1,4 @@
-(* Copyright (c) 2009, 2012, Adam Chlipala
+(* Copyright (c) 2009, 2012-2013, Adam Chlipala
  * All rights reserved.
  *
  * Redistribution and use in source and binary forms, with or without
@@ -42,15 +42,22 @@ type state = {
 
 fun frob file =
     let
-        val rpcBaseIds = foldl (fn ((d, _), rpcIds) =>
-                                   case d of
-                                       DVal (_, n, _, (EFfi ("Basis", "rpc"), _), _) => IS.add (rpcIds, n)
-                                     | DVal (_, n, _, (ENamed n', _), _) => if IS.member (rpcIds, n') then
-                                                                                IS.add (rpcIds, n)
-                                                                            else
-                                                                                rpcIds
-                                     | _ => rpcIds)
-                               IS.empty file
+        val (rpcBaseIds, trpcBaseIds) =
+            foldl (fn ((d, _), (rpcIds, trpcIds)) =>
+                      case d of
+                          DVal (_, n, _, (EFfi ("Basis", "rpc"), _), _) =>
+                          (IS.add (rpcIds, n), trpcIds)
+                        | DVal (_, n, _, (EFfi ("Basis", "tryRpc"), _), _) =>
+                          (rpcIds, IS.add (trpcIds, n))
+                        | DVal (_, n, _, (ENamed n', _), _) =>
+                          if IS.member (rpcIds, n') then
+                              (IS.add (rpcIds, n), trpcIds)
+                          else if IS.member (trpcIds, n') then
+                              (rpcIds, IS.add (trpcIds, n))
+                          else
+                              (rpcIds, trpcIds)
+                        | _ => (rpcIds, trpcIds))
+                  (IS.empty, IS.empty) file
 
         val tfuncs = foldl
                      (fn ((d, _), tfuncs) =>
@@ -89,7 +96,7 @@ fun frob file =
                       | EApp (e1, e2) => getApp (#1 e1, e2 :: args)
                       | _ => NONE
 
-                fun newRpc (trans : exp, st : state) =
+                fun newRpc (trans : exp, st : state, fm) =
                     case getApp (#1 trans, []) of
                         NONE => (ErrorMsg.errorAt (#2 trans)
                                                   "RPC code doesn't use a named function or transaction";
@@ -114,16 +121,19 @@ fun frob file =
                                 val st = {exported = exported,
                                           export_decls = export_decls}
 
-                                val e' = EServerCall (n, args, ran)
+                                val e' = EServerCall (n, args, ran, fm)
                             in
                                 (e', st)
                             end
             in
                 case e of
-                    EApp ((ECApp ((EFfi ("Basis", "rpc"), _), ran), _), trans) => newRpc (trans, st)
+                    EApp ((ECApp ((EFfi ("Basis", "rpc"), _), ran), _), trans) => newRpc (trans, st, None)
+                  | EApp ((ECApp ((EFfi ("Basis", "tryRpc"), _), ran), _), trans) => newRpc (trans, st, Error)
                   | EApp ((ECApp ((ENamed n, _), ran), _), trans) =>
                     if IS.member (rpcBaseIds, n) then
-                        newRpc (trans, st)
+                        newRpc (trans, st, None)
+                    else if IS.member (trpcBaseIds, n) then
+                        newRpc (trans, st, Error)
                     else
                         (e, st)
 
diff --git a/src/settings.sig b/src/settings.sig
index 3e3f0985..453ba486 100644
--- a/src/settings.sig
+++ b/src/settings.sig
@@ -1,4 +1,4 @@
-(* Copyright (c) 2008-2011, Adam Chlipala
+(* Copyright (c) 2008-2011, 2013, Adam Chlipala
  * All rights reserved.
  *
  * Redistribution and use in source and binary forms, with or without
diff --git a/src/shake.sml b/src/shake.sml
index 096c31fd..57ebec8e 100644
--- a/src/shake.sml
+++ b/src/shake.sml
@@ -1,4 +1,4 @@
-(* Copyright (c) 2008-2010, Adam Chlipala
+(* Copyright (c) 2008-2010, 2013, Adam Chlipala
  * All rights reserved.
  *
  * Redistribution and use in source and binary forms, with or without
@@ -186,7 +186,7 @@ fun shake file =
             in
                 case e of
                     ENamed n => check n
-                  | EServerCall (n, _, _) => check n
+                  | EServerCall (n, _, _, _) => check n
                   | _ => s
             end
 
diff --git a/tests/tryRpc.ur b/tests/tryRpc.ur
new file mode 100644
index 00000000..7a8d3a8b
--- /dev/null
+++ b/tests/tryRpc.ur
@@ -0,0 +1,46 @@
+fun isBeppo (s : string) : transaction string =
+    case s of
+        "Beppo" => return "Yup, that's him!"
+      | "Mephisto" => error <xml>Great googely moogely!</xml>
+      | _ => return "Who's that?"
+
+fun listOf (n : int) =
+    if n < 0 then
+        error <xml>Negative!</xml>
+    else if n = 0 then
+        return []
+    else
+        ls <- listOf (n - 1);
+        return (n :: ls)
+
+fun length ls =
+    case ls of
+        [] => 0
+      | _ :: ls' => 1 + length ls'
+
+fun main () : transaction page =
+    s <- source "";
+    ns <- source "";
+    return <xml><body>
+      <ctextbox source={s}/>
+      <button value="rpc" onclick={fn _ => v <- get s;
+                                      r <- rpc (isBeppo v);
+                                      alert r}/>
+      <button value="tryRpc" onclick={fn _ => v <- get s;
+                                         r <- tryRpc (isBeppo v);
+                                         case r of
+                                             None => alert "Faaaaaailure."
+                                           | Some r => alert ("Success: " ^ r)}/>
+
+      <hr/>
+
+      <ctextbox source={ns}/>
+      <button value="rpc" onclick={fn _ => v <- get ns;
+                                      r <- rpc (listOf (readError v));
+                                      alert (show (length r))}/>
+      <button value="tryRpc" onclick={fn _ => v <- get ns;
+                                         r <- tryRpc (listOf (readError v));
+                                         case r of
+                                             None => alert "Faaaaaailure."
+                                           | Some r => alert ("Success: " ^ show (length r))}/>
+    </body></xml>