summaryrefslogtreecommitdiff
path: root/src/scriptcheck.sml
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2009-04-04 14:03:39 -0400
committerGravatar Adam Chlipala <adamc@hcoop.net>2009-04-04 14:03:39 -0400
commitdfe722a61e5c81cdfa6ed844933a14783cd9bd9c (patch)
treef845ffce49085952ab6313d30ed7d977dc2ab8d6 /src/scriptcheck.sml
parentabb3bffd224cb7bdbbbc1461643a8e58fb03ed8f (diff)
_Really_ implement embedded closure GC; extend Scriptcheck to figure out when client IDs must be assigned
Diffstat (limited to 'src/scriptcheck.sml')
-rw-r--r--src/scriptcheck.sml80
1 files changed, 49 insertions, 31 deletions
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