From 221615de9d28d6fa768ef3ce28483ed90d2aab6c Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Sat, 4 Apr 2009 14:55:36 -0400 Subject: spawn --- include/urweb.h | 2 +- lib/ur/basis.urs | 1 + src/c/urweb.c | 9 ++++----- src/jscomp.sml | 4 +++- src/mono_reduce.sml | 16 +++++++++------- src/monoize.sml | 14 +++++++++++++- tests/spawn.ur | 24 ++++++++++++++++++++++++ tests/spawn.urp | 5 +++++ 8 files changed, 60 insertions(+), 15 deletions(-) create mode 100644 tests/spawn.ur create mode 100644 tests/spawn.urp diff --git a/include/urweb.h b/include/urweb.h index daf965b0..4e0992fd 100644 --- a/include/urweb.h +++ b/include/urweb.h @@ -49,7 +49,7 @@ uw_Basis_int uw_Basis_new_client_source(uw_context, uw_Basis_string); uw_unit uw_Basis_set_client_source(uw_context, uw_Basis_int, uw_Basis_string); void uw_set_script_header(uw_context, const char*); -const char *uw_Basis_get_settings(uw_context, uw_Basis_string); +const char *uw_Basis_get_settings(uw_context, uw_unit); const char *uw_Basis_get_script(uw_context, uw_unit); void uw_set_needs_push(uw_context, int); diff --git a/lib/ur/basis.urs b/lib/ur/basis.urs index f95e8eba..19a7a9f1 100644 --- a/lib/ur/basis.urs +++ b/lib/ur/basis.urs @@ -105,6 +105,7 @@ val setCookie : t ::: Type -> http_cookie t -> t -> transaction unit (** JavaScript-y gadgets *) val alert : string -> transaction unit +val spawn : transaction unit -> transaction unit (** Channels *) diff --git a/src/c/urweb.c b/src/c/urweb.c index 880cd143..6f6f1fc8 100644 --- a/src/c/urweb.c +++ b/src/c/urweb.c @@ -701,17 +701,16 @@ const char *uw_Basis_get_script(uw_context ctx, uw_unit u) { } } -const char *uw_Basis_get_settings(uw_context ctx, uw_Basis_string onload) { +const char *uw_Basis_get_settings(uw_context ctx, uw_unit u) { if (ctx->client == NULL) return ""; else { - char *r = uw_malloc(ctx, 52 + 3 * INTS_MAX + strlen(ctx->url_prefix) + strlen(onload)); - sprintf(r, " onload='client_id=%u;client_pass=%d;url_prefix=\"%s\";timeout=%d;listener();%s'", + char *r = uw_malloc(ctx, 59 + 3 * INTS_MAX + strlen(ctx->url_prefix)); + sprintf(r, "client_id=%u;client_pass=%d;url_prefix=\"%s\";timeout=%d;listener();", ctx->client->id, ctx->client->pass, ctx->url_prefix, - ctx->timeout, - onload); + ctx->timeout); return r; } } diff --git a/src/jscomp.sml b/src/jscomp.sml index c28f58d0..c7577d0c 100644 --- a/src/jscomp.sml +++ b/src/jscomp.sml @@ -50,7 +50,9 @@ val funcs = [(("Basis", "alert"), "alert"), (("Basis", "urlifyFloat"), "ts"), (("Basis", "urlifyString"), "uf"), (("Basis", "recv"), "rv"), - (("Basis", "strcat"), "cat")] + (("Basis", "strcat"), "cat"), + (("Basis", "intToString"), "ts"), + (("Basis", "floatToString"), "ts")] structure FM = BinaryMapFn(struct type ord_key = string * string diff --git a/src/mono_reduce.sml b/src/mono_reduce.sml index 505498b8..08d5ad6d 100644 --- a/src/mono_reduce.sml +++ b/src/mono_reduce.sml @@ -61,6 +61,7 @@ fun impure (e, _) = | EFfiApp ("Basis", "new_channel", _) => true | EFfiApp ("Basis", "subscribe", _) => true | EFfiApp ("Basis", "send", _) => true + | EFfiApp ("Basis", "recv", _) => true | EFfiApp _ => false | EApp ((EFfi _, _), _) => false | EApp _ => true @@ -281,11 +282,12 @@ fun reduce file = | EFfiApp ("Basis", "new_channel", es) => ffi es | EFfiApp ("Basis", "subscribe", es) => ffi es | EFfiApp ("Basis", "send", es) => ffi es + | EFfiApp ("Basis", "recv", es) => ffi es | EFfiApp (_, _, es) => List.concat (map (summarize d) es) | EApp ((EFfi _, _), e) => summarize d e | EApp _ => let - fun unravel (e, ls) = + fun unravel (e, passed, ls) = case e of ENamed n => let @@ -294,10 +296,10 @@ fun reduce file = case IM.find (absCounts, n) of NONE => [Unsure] | SOME len => - if length ls < len then + if passed < len then ls else - [Unsure] + ls @ [Unsure] end | ERel n => List.revAppend (ls, if n = d then @@ -305,10 +307,10 @@ fun reduce file = else [Unsure]) | EApp (f, x) => - unravel (#1 f, summarize d x @ ls) + unravel (#1 f, passed + 1, summarize d x @ ls) | _ => [Unsure] in - unravel (e, []) + unravel (e, 0, []) end | EAbs (_, _, _, e) => List.filter (fn UseRel => true @@ -386,8 +388,8 @@ fun reduce file = | EApp ((EAbs (x, t, _, e1), loc), e2) => ((*Print.prefaces "Considering" [("e1", MonoPrint.p_exp (E.pushERel env x t NONE) e1), - ("e2", MonoPrint.p_exp env e2), - ("sub", MonoPrint.p_exp env (reduceExp env (subExpInExp (0, e2) e1)))];*) + ("e2", MonoPrint.p_exp env e2), + ("sub", MonoPrint.p_exp env (reduceExp env (subExpInExp (0, e2) e1)))];*) if impure e2 then #1 (reduceExp env (ELet (x, t, e2, e1), loc)) else diff --git a/src/monoize.sml b/src/monoize.sml index 71672785..ea2ce751 100644 --- a/src/monoize.sml +++ b/src/monoize.sml @@ -1043,6 +1043,13 @@ fun monoExp (env, st, fm) (all as (e, loc)) = fm) end + | L.EFfiApp ("Basis", "spawn", [e]) => + let + val (e, fm) = monoExp (env, st, fm) e + in + ((L'.EApp (e, (L'.ERecord [], loc)), loc), fm) + end + | L.EApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "return"), _), _), _), t), _), (L.EFfi ("Basis", "signal_monad"), _)) => let @@ -2005,7 +2012,12 @@ fun monoExp (env, st, fm) (all as (e, loc)) = end in normal ("body", - SOME (L'.EFfiApp ("Basis", "get_settings", [onload]), loc), + SOME (L'.EStrcat ((L'.EPrim (Prim.String " onload='"), loc), + (L'.EStrcat ((L'.EFfiApp ("Basis", "get_settings", + [(L'.ERecord [], loc)]), loc), + (L'.EStrcat (onload, + (L'.EPrim (Prim.String "'"), + loc)), loc)), loc)), loc), SOME (L'.EFfiApp ("Basis", "get_script", [(L'.ERecord [], loc)]), loc)) end diff --git a/tests/spawn.ur b/tests/spawn.ur new file mode 100644 index 00000000..263b52bc --- /dev/null +++ b/tests/spawn.ur @@ -0,0 +1,24 @@ +table t : {A : int, Ch : channel string} + +fun listener n ch = + s <- recv ch; + alert (show n ^ ": " ^ s); + listener n ch + +fun speak id msg = + r <- oneRow (SELECT t.Ch FROM t WHERE t.A = {[id]}); + send r.T.Ch msg + +fun main () : transaction page = + ch1 <- channel; + dml (INSERT INTO t (A, Ch) VALUES (1, {[ch1]})); + ch2 <- channel; + dml (INSERT INTO t (A, Ch) VALUES (2, {[ch2]})); + + s1 <- source ""; + s2 <- source ""; + + return + 1: