Proper recv

9 files changed, 60 insertions, 4 deletions

diff --git a/src/cjrize.sml b/src/cjrize.sml
index e637c82c..27287d6e 100644
--- a/src/cjrize.sml
+++ b/src/cjrize.sml
@@ -430,6 +430,7 @@ fun cifyExp (eAll as (e, loc), sm) =
       | L.ESignalSource _ => raise Fail "Cjrize: ESignalSource remains"
 
       | L.EServerCall _ => raise Fail "Cjrize EServerCall"
+      | L.ERecv _ => raise Fail "Cjrize ERecv"
 
 fun cifyDecl ((d, loc), sm) =
     case d of
diff --git a/src/jscomp.sml b/src/jscomp.sml
index be227035..36d42754 100644
--- a/src/jscomp.sml
+++ b/src/jscomp.sml
@@ -49,7 +49,8 @@ val funcs = [(("Basis", "alert"), "alert"),
              (("Basis", "urlifyInt"), "ts"),
              (("Basis", "urlifyFloat"), "ts"),
              (("Basis", "urlifyString"), "escape"),
-             (("Basis", "urlifyChannel"), "ts")]
+             (("Basis", "urlifyChannel"), "ts"),
+             (("Basis", "recv"), "rv")]
 
 structure FM = BinaryMapFn(struct
                            type ord_key = string * string
@@ -106,6 +107,7 @@ fun varDepth (e, _) =
       | ESignalBind (e1, e2) => Int.max (varDepth e1, varDepth e2)
       | ESignalSource e => varDepth e
       | EServerCall (e, ek, _) => Int.max (varDepth e, varDepth ek)
+      | ERecv (e, ek, _) => Int.max (varDepth e, varDepth ek)
 
 fun closedUpto d =
     let
@@ -147,6 +149,7 @@ fun closedUpto d =
               | ESignalBind (e1, e2) => cu inner e1 andalso cu inner e2
               | ESignalSource e => cu inner e
               | EServerCall (e, ek, _) => cu inner e andalso cu inner ek
+              | ERecv (e, ek, _) => cu inner e andalso cu inner ek
     in
         cu 0
     end
@@ -342,7 +345,7 @@ fun process file =
                                     @ ["}"]), st)
                 end
 
-              | TFfi ("Basis", "string") => ("unescape(t[i++])", st)
+              | TFfi ("Basis", "string") => ("unesc(t[i++])", st)
               | TFfi ("Basis", "int") => ("parseInt(t[i++])", st)
               | TFfi ("Basis", "float") => ("parseFloat(t[i++])", st)
 
@@ -952,6 +955,21 @@ fun process file =
                                          str ")"],
                                  st)
                             end
+
+                          | ERecv (e, ek, t) =>
+                            let
+                                val (e, st) = jsE inner (e, st)
+                                val (ek, st) = jsE inner (ek, st)
+                                val (unurl, st) = unurlifyExp loc (t, st)
+                            in
+                                (strcat [str "rv(",
+                                         e,
+                                         str (", function(s){var t=s.split(\"/\");var i=0;return "
+                                              ^ unurl ^ "},"),
+                                         ek,
+                                         str ")"],
+                                 st)
+                            end
                     end
             in
                 jsE
diff --git a/src/mono.sml b/src/mono.sml
index b0be4c5f..3aa65b6a 100644
--- a/src/mono.sml
+++ b/src/mono.sml
@@ -110,6 +110,7 @@ datatype exp' =
        | ESignalSource of exp
 
        | EServerCall of exp * exp * typ
+       | ERecv of exp * exp * typ
 
 withtype exp = exp' located
 
diff --git a/src/mono_print.sml b/src/mono_print.sml
index a61b5847..cbe90371 100644
--- a/src/mono_print.sml
+++ b/src/mono_print.sml
@@ -313,6 +313,11 @@ fun p_exp' par env (e, _) =
                                           string ")[",
                                           p_exp env e,
                                           string "]"]
+      | ERecv (n, e, _) => box [string "Recv(",
+                                p_exp env n,
+                                string ")[",
+                                p_exp env e,
+                                string "]"]
 
 and p_exp env = p_exp' false env
 
diff --git a/src/mono_reduce.sml b/src/mono_reduce.sml
index b789e05f..b2f0ecee 100644
--- a/src/mono_reduce.sml
+++ b/src/mono_reduce.sml
@@ -85,6 +85,7 @@ fun impure (e, _) =
       | ESignalBind (e1, e2) => impure e1 orelse impure e2
       | ESignalSource e => impure e
       | EServerCall _ => true
+      | ERecv _ => true
 
 
 val liftExpInExp = Monoize.liftExpInExp
@@ -355,6 +356,7 @@ fun reduce file =
                       | ESignalSource e => summarize d e
 
                       | EServerCall (e, ek, _) => summarize d e @ summarize d ek @ [Unsure]
+                      | ERecv (e, ek, _) => summarize d e @ summarize d ek @ [Unsure]
             in
                 (*Print.prefaces "Summarize"
                                [("e", MonoPrint.p_exp MonoEnv.empty (e, ErrorMsg.dummySpan)),
diff --git a/src/mono_util.sml b/src/mono_util.sml
index dd5107c6..bbc9c7e7 100644
--- a/src/mono_util.sml
+++ b/src/mono_util.sml
@@ -358,6 +358,14 @@ fun mapfoldB {typ = fc, exp = fe, bind} =
                                      S.map2 (mft t,
                                           fn t' =>
                                              (EServerCall (s', ek', t'), loc))))
+              | ERecv (s, ek, t) =>
+                S.bind2 (mfe ctx s,
+                         fn s' =>
+                            S.bind2 (mfe ctx ek,
+                                  fn ek' =>
+                                     S.map2 (mft t,
+                                          fn t' =>
+                                             (ERecv (s', ek', t'), loc))))
     in
         mfe
     end
diff --git a/src/monoize.sml b/src/monoize.sml
index d6b5ae15..87530070 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -979,6 +979,24 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                                                           loc)), loc)), loc)), loc)), loc),
                  fm)
             end
+          | L.EApp ((L.EApp ((L.ECApp ((L.ECApp ((L.ECApp ((L.EFfi ("Basis", "bind"), _), _), _), _), _), t2), _),
+                             (L.EFfi ("Basis", "transaction_monad"), _)), _),
+                    (L.EApp ((L.ECApp ((L.EFfi ("Basis", "recv"), _), t1), _),
+                             ch), loc)) =>
+            let
+                val t1 = monoType env t1
+                val t2 = monoType env t2
+                val un = (L'.TRecord [], loc)
+                val mt2 = (L'.TFun (un, t2), loc)
+                val (ch, fm) = monoExp (env, st, fm) ch
+            in
+                ((L'.EAbs ("m2", (L'.TFun (t1, mt2), loc), (L'.TFun (un, un), loc),
+                           (L'.EAbs ("_", un, un,
+                                     (L'.ERecv (liftExpInExp 0 (liftExpInExp 0 ch),
+                                                (L'.ERel 1, loc),
+                                                t1), loc)), loc)), loc),
+                 fm)
+            end
 
           | L.ECApp ((L.EFfi ("Basis", "source"), _), t) =>
             let
diff --git a/src/rpcify.sml b/src/rpcify.sml
index 1212b81e..a4bfe71a 100644
--- a/src/rpcify.sml
+++ b/src/rpcify.sml
@@ -59,7 +59,8 @@ val csBasis = SS.addList (SS.empty,
                           ["source",
                            "get",
                            "set",
-                           "alert"])
+                           "alert",
+                           "recv"])
 
 type state = {
      cpsed : int IM.map,
diff --git a/src/scriptcheck.sml b/src/scriptcheck.sml
index 2bc185f9..0b51747f 100644
--- a/src/scriptcheck.sml
+++ b/src/scriptcheck.sml
@@ -41,10 +41,12 @@ val csBasis = SS.addList (SS.empty,
                            "set_client_source",
                            "new_channel",
                            "subscribe",
+                           "send",
                            "recv"])
 
 val scriptWords = ["<script",
-                   " onclick="]
+                   " onclick=",
+                   " onload="]
 
 fun classify (ds, ps) =
     let