diff options
author | 2009-04-04 14:03:39 -0400 | |
---|---|---|
committer | 2009-04-04 14:03:39 -0400 | |
commit | cfcc0c0553a13a83cf674b00828c89b6f9459936 (patch) | |
tree | f845ffce49085952ab6313d30ed7d977dc2ab8d6 | |
parent | 8e8c217003dcda28e14b330039062d9bf8463e64 (diff) |
_Really_ implement embedded closure GC; extend Scriptcheck to figure out when client IDs must be assigned
-rw-r--r-- | include/urweb.h | 2 | ||||
-rw-r--r-- | lib/js/urweb.js | 30 | ||||
-rw-r--r-- | src/c/urweb.c | 9 | ||||
-rw-r--r-- | src/cjr.sml | 3 | ||||
-rw-r--r-- | src/cjr_print.sml | 17 | ||||
-rw-r--r-- | src/cjrize.sml | 2 | ||||
-rw-r--r-- | src/jscomp.sml | 10 | ||||
-rw-r--r-- | src/scriptcheck.sml | 80 |
8 files changed, 100 insertions, 53 deletions
diff --git a/include/urweb.h b/include/urweb.h index aa574ff3..daf965b0 100644 --- a/include/urweb.h +++ b/include/urweb.h @@ -52,6 +52,8 @@ 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_script(uw_context, uw_unit); +void uw_set_needs_push(uw_context, int); + char *uw_Basis_htmlifyInt(uw_context, uw_Basis_int); char *uw_Basis_htmlifyFloat(uw_context, uw_Basis_float); char *uw_Basis_htmlifyString(uw_context, uw_Basis_string); diff --git a/lib/js/urweb.js b/lib/js/urweb.js index fe996833..de956d3f 100644 --- a/lib/js/urweb.js +++ b/lib/js/urweb.js @@ -22,11 +22,19 @@ function union(ls1, ls2) { // Embedding closures in XML strings +function cs(f) { + return {closure: f}; +} + +function isWeird(v) { + return v.closure != null || v.cat1 != null; +} + function cat(s1, s2) { - if (s1.length && s2.length) - return s1 + s2; + if (isWeird(s1) || isWeird(s2)) + return {cat1: s1, cat2: s2}; else - return {_1: s1, _2: s2}; + return s1 + s2; } var closures = []; @@ -42,12 +50,12 @@ function cr(n) { } function flatten(tr) { - if (tr.length) - return tr; - else if (tr._1) - return cs(tr._1) + cs(tr._2); + if (tr.cat1 != null) + return flatten(tr.cat1) + flatten(tr.cat2); + else if (tr.closure != null) + return "cr(" + newClosure(tr.closure) + ")"; else - return "cr(" + newClosure(tr) + ")"; + return tr; } function clearClosures() { @@ -157,7 +165,7 @@ function dyn(s) { ls.data.dyns = remove(span, ls.data.dyns); } - x.innerHTML = v; + x.innerHTML = flatten(v); runScripts(x); if (--dynDepth == 0) @@ -412,3 +420,7 @@ function rv(chn, parse, k) { k(parse(msg))(null); } } + + +// App-specific code + diff --git a/src/c/urweb.c b/src/c/urweb.c index ed19305e..880cd143 100644 --- a/src/c/urweb.c +++ b/src/c/urweb.c @@ -300,6 +300,8 @@ struct uw_context { const char *script_header, *url_prefix; + int needs_push; + size_t n_deltas, used_deltas; delta *deltas; @@ -333,6 +335,7 @@ uw_context uw_init() { ctx->script_header = ""; ctx->url_prefix = "/"; + ctx->needs_push = 0; ctx->error_message[0] = 0; @@ -476,7 +479,7 @@ uw_Basis_string uw_Basis_requestHeader(uw_context ctx, uw_Basis_string h) { } void uw_login(uw_context ctx) { - if (ctx->script_header[0]) { + if (ctx->needs_push) { char *id_s, *pass_s; if ((id_s = uw_Basis_requestHeader(ctx, "UrWeb-Client")) @@ -578,6 +581,10 @@ void uw_set_url_prefix(uw_context ctx, const char *s) { ctx->url_prefix = s; } +void uw_set_needs_push(uw_context ctx, int n) { + ctx->needs_push = n; +} + static void buf_check_ctx(uw_context ctx, buf *b, size_t extra, const char *desc) { if (b->back - b->front < extra) { diff --git a/src/cjr.sml b/src/cjr.sml index 41bb6a4c..78c2e63b 100644 --- a/src/cjr.sml +++ b/src/cjr.sml @@ -115,7 +115,8 @@ withtype decl = decl' located datatype sidedness = ServerOnly - | ServerAndClient + | ServerAndPull + | ServerAndPullAndPush type file = decl list * (Core.export_kind * string * int * typ list * typ * sidedness) list diff --git a/src/cjr_print.sml b/src/cjr_print.sml index 9c652d4a..54ec3cbf 100644 --- a/src/cjr_print.sml +++ b/src/cjr_print.sml @@ -2391,12 +2391,19 @@ fun p_file env (ds, ps) = newline, string "uw_set_script_header(ctx, \"", string (case side of - ServerAndClient => "<script src=\\\"" - ^ OS.Path.joinDirFile {dir = !Monoize.urlPrefix, - file = "app.js"} - ^ "\\\"></script>\\n" - | ServerOnly => ""), + ServerOnly => "" + | _ => "<script src=\\\"" + ^ OS.Path.joinDirFile {dir = !Monoize.urlPrefix, + file = "app.js"} + ^ "\\\"></script>\\n"), string "\");", + newline, + string "uw_set_needs_push(ctx, ", + string (case side of + ServerAndPullAndPush => "1" + | _ => "0"), + string ");", + newline, string "uw_set_url_prefix(ctx, \"", string (!Monoize.urlPrefix), string "\");", diff --git a/src/cjrize.sml b/src/cjrize.sml index 27287d6e..998ae38e 100644 --- a/src/cjrize.sml +++ b/src/cjrize.sml @@ -520,7 +520,7 @@ fun cifyDecl ((d, loc), sm) = val (ts, sm) = ListUtil.foldlMap cifyTyp sm ts val (t, sm) = cifyTyp (t, sm) in - (NONE, SOME (ek, "/" ^ s, n, ts, t, L'.ServerAndClient), sm) + (NONE, SOME (ek, "/" ^ s, n, ts, t, L'.ServerAndPullAndPush), sm) end | L.DTable (s, xts) => diff --git a/src/jscomp.sml b/src/jscomp.sml index 1409a0cb..c28f58d0 100644 --- a/src/jscomp.sml +++ b/src/jscomp.sml @@ -850,7 +850,7 @@ fun process file = val (e1, st) = jsE inner (e1, st) val (e2, st) = jsE inner (e2, st) in - (strcat [str "(", e1, str "+", e2, str ")"], st) + (strcat [str "cat(", e1, str ",", e2, str ")"], st) end | EError (e, _) => @@ -891,9 +891,9 @@ fun process file = | EJavaScript (Source _, _, SOME _) => (e, st) | EJavaScript (_, _, SOME e) => - (strcat [str "function(){return ", + (strcat [str "cs(function(){return ", e, - str "}"], + str "})"], st) | EClosure _ => unsupported "EClosure" @@ -905,9 +905,9 @@ fun process file = let val (e, st) = jsE inner (e, st) in - (strcat [str "function(){return ", + (strcat [str "cs(function(){return ", e, - str "}"], + str "})"], st) end diff --git a/src/scriptcheck.sml b/src/scriptcheck.sml index 0b51747f..34bf2337 100644 --- a/src/scriptcheck.sml +++ b/src/scriptcheck.sml @@ -35,19 +35,21 @@ structure SS = BinarySetFn(struct end) structure IS = IntBinarySet -val csBasis = SS.addList (SS.empty, - ["new_client_source", - "get_client_source", - "set_client_source", - "new_channel", - "subscribe", - "send", - "recv"]) +val pullBasis = SS.addList (SS.empty, + ["new_client_source", + "get_client_source", + "set_client_source"]) +val pushBasis = SS.addList (SS.empty, + ["new_channel", + "self"]) + val scriptWords = ["<script", " onclick=", " onload="] +val pushWords = ["rv("] + fun classify (ds, ps) = let fun inString {needle, haystack} = @@ -57,11 +59,11 @@ fun classify (ds, ps) = not (Substring.isEmpty suffix) end - fun hasClient csids = + fun hasClient {basis, words} csids = let fun hasClient e = case #1 e of - EPrim (Prim.String s) => List.exists (fn n => inString {needle = n, haystack = s}) scriptWords + EPrim (Prim.String s) => List.exists (fn n => inString {needle = n, haystack = s}) words | EPrim _ => false | ERel _ => false | ENamed n => IS.member (csids, n) @@ -69,9 +71,9 @@ fun classify (ds, ps) = | ECon (_, _, SOME e) => hasClient e | ENone _ => false | ESome (_, e) => hasClient e - | EFfi ("Basis", x) => SS.member (csBasis, x) + | EFfi ("Basis", x) => SS.member (basis, x) | EFfi _ => false - | EFfiApp ("Basis", x, es) => SS.member (csBasis, x) + | EFfiApp ("Basis", x, es) => SS.member (basis, x) orelse List.exists hasClient es | EFfiApp (_, _, es) => List.exists hasClient es | EApp (e, es) => hasClient e orelse List.exists hasClient es @@ -93,33 +95,49 @@ fun classify (ds, ps) = hasClient end - fun decl ((d, _), csids) = + fun decl ((d, _), (pull_ids, push_ids)) = let - val hasClient = hasClient csids + val hasClientPull = hasClient {basis = pullBasis, words = scriptWords} pull_ids + val hasClientPush = hasClient {basis = pushBasis, words = pushWords} push_ids in case d of - DVal (_, n, _, e) => if hasClient e then - IS.add (csids, n) - else - csids - | DFun (_, n, _, _, e) => if hasClient e then - IS.add (csids, n) - else - csids - | DFunRec xes => if List.exists (fn (_, _, _, _, e) => hasClient e) xes then - foldl (fn ((_, n, _, _, _), csids) => IS.add (csids, n)) - csids xes - else - csids - | _ => csids + DVal (_, n, _, e) => (if hasClientPull e then + IS.add (pull_ids, n) + else + pull_ids, + if hasClientPush e then + IS.add (push_ids, n) + else + push_ids) + | DFun (_, n, _, _, e) => (if hasClientPull e then + IS.add (pull_ids, n) + else + pull_ids, + if hasClientPush e then + IS.add (push_ids, n) + else + push_ids) + | DFunRec xes => (if List.exists (fn (_, _, _, _, e) => hasClientPull e) xes then + foldl (fn ((_, n, _, _, _), pull_ids) => IS.add (pull_ids, n)) + pull_ids xes + else + pull_ids, + if List.exists (fn (_, _, _, _, e) => hasClientPush e) xes then + foldl (fn ((_, n, _, _, _), push_ids) => IS.add (push_ids, n)) + push_ids xes + else + push_ids) + | _ => (pull_ids, push_ids) end - val csids = foldl decl IS.empty ds + val (pull_ids, push_ids) = foldl decl (IS.empty, IS.empty) ds val ps = map (fn (ek, x, n, ts, t, _) => (ek, x, n, ts, t, - if IS.member (csids, n) then - ServerAndClient + if IS.member (push_ids, n) then + ServerAndPullAndPush + else if IS.member (pull_ids, n) then + ServerAndPull else ServerOnly)) ps in |