spawn

8 files changed, 60 insertions, 15 deletions

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 <xml><body onload={spawn (listener 1 ch1); spawn (listener 2 ch2)}>
+      1: <ctextbox source={s1}/><button onclick={msg <- get s1; speak 1 msg}/><br/>
+      2: <ctextbox source={s2}/><button onclick={msg <- get s2; speak 2 msg}/>
+    </body></xml>
diff --git a/tests/spawn.urp b/tests/spawn.urp
new file mode 100644
index 00000000..d24ba14d
--- /dev/null
+++ b/tests/spawn.urp
@@ -0,0 +1,5 @@
+debug
+database dbname=spawn
+sql spawn.sql
+
+spawn