summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--doc/manual.tex6
-rw-r--r--lib/js/urweb.js41
-rw-r--r--lib/ur/basis.urs2
-rw-r--r--src/core.sml6
-rw-r--r--src/core_print.sml14
-rw-r--r--src/core_untangle.sml4
-rw-r--r--src/core_util.sml19
-rw-r--r--src/css.sml4
-rw-r--r--src/effectize.sml8
-rw-r--r--src/especialize.sml8
-rw-r--r--src/jscomp.sml21
-rw-r--r--src/mono.sml4
-rw-r--r--src/mono_print.sml4
-rw-r--r--src/mono_reduce.sml4
-rw-r--r--src/mono_util.sml6
-rw-r--r--src/monoize.sml6
-rw-r--r--src/reduce.sml4
-rw-r--r--src/reduce_local.sml4
-rw-r--r--src/rpcify.sml38
-rw-r--r--src/settings.sig2
-rw-r--r--src/shake.sml4
-rw-r--r--tests/tryRpc.ur46
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>
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-20 00:37:17 +0000