diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/cjrize.sml | 1 | ||||
| -rw-r--r-- | src/jscomp.sml | 22 | ||||
| -rw-r--r-- | src/mono.sml | 1 | ||||
| -rw-r--r-- | src/mono_print.sml | 5 | ||||
| -rw-r--r-- | src/mono_reduce.sml | 2 | ||||
| -rw-r--r-- | src/mono_util.sml | 8 | ||||
| -rw-r--r-- | src/monoize.sml | 18 | ||||
| -rw-r--r-- | src/rpcify.sml | 3 | ||||
| -rw-r--r-- | src/scriptcheck.sml | 4 |
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 |