summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adam@chlipala.net>2011-03-10 20:22:03 -0500
committerGravatar Adam Chlipala <adam@chlipala.net>2011-03-10 20:22:03 -0500
commit1fe0be9d980e9a4a47874680e4ac4ee1de6dd374 (patch)
treeaacb1636006c4769a35985cd865b599a4ff6d8f9
parentc824364cb48385480667ce646425d37ec0ad87b0 (diff)
Ignore JavaScript events in Effectize; allow extra spaces for 'jsFunc'; eat carriage returns at line ends in .urp files
-rw-r--r--src/compiler.sml20
-rw-r--r--src/effectize.sml36
-rw-r--r--src/jscomp.sml3
-rw-r--r--src/settings.sig1
-rw-r--r--src/settings.sml1
5 files changed, 43 insertions, 18 deletions
diff --git a/src/compiler.sml b/src/compiler.sml
index ed76fa8c..572129bf 100644
--- a/src/compiler.sml
+++ b/src/compiler.sml
@@ -307,6 +307,8 @@ fun trim s =
s
end
+val trimS = Substring.string o trim o Substring.full
+
structure M = BinaryMapFn(struct
type ord_key = string
val compare = String.compare
@@ -347,7 +349,10 @@ fun inputCommentableLine inf =
val s = #1 (Substring.splitr (not o Char.isSpace) s)
in
Substring.string (if Substring.size s > 0 andalso Char.isSpace (Substring.sub (s, Substring.size s - 1)) then
- Substring.trimr 1 s
+ if Substring.size s > 1 andalso Char.isSpace (Substring.sub (s, Substring.size s - 2)) then
+ Substring.trimr 2 s
+ else
+ Substring.trimr 1 s
else
s)
end) (TextIO.inputLine inf)
@@ -636,10 +641,15 @@ fun parseUrp' accLibs fname =
fun ffiM () =
case String.fields (fn ch => ch = #"=") arg of
[f, s] =>
- (case String.fields (fn ch => ch = #".") f of
- [m, x] => ((m, x), s)
- | _ => (ErrorMsg.error (cmd ^ " argument not of the form Module.func=func'");
- (("", ""), "")))
+ let
+ val f = trimS f
+ val s = trimS s
+ in
+ case String.fields (fn ch => ch = #".") f of
+ [m, x] => ((m, x), s)
+ | _ => (ErrorMsg.error (cmd ^ " argument not of the form Module.func=func'");
+ (("", ""), ""))
+ end
| _ => (ErrorMsg.error (cmd ^ " argument not of the form Module.func=func'");
(("", ""), ""))
in
diff --git a/src/effectize.sml b/src/effectize.sml
index 3fb85f7b..03a14ec0 100644
--- a/src/effectize.sml
+++ b/src/effectize.sml
@@ -87,26 +87,38 @@ fun effectize file =
con = fn _ => false,
exp = exp evs}
+ val dejs = U.Exp.map {kind = fn x => x,
+ con = fn c => c,
+ exp = fn ERecord xets => ERecord (List.filter (fn ((CName x, _), _ , _) => x = "Onload" orelse not (String.isPrefix "On" x)
+ | _ => true) xets)
+ | e => e}
+
fun doDecl (d, evs as (writers, readers, pushers)) =
case #1 d of
DVal (x, n, t, e, s) =>
- (d, (if couldWrite writers e then
- IM.insert (writers, n, (#2 d, s))
- else
- writers,
- if couldReadCookie readers e then
- IM.insert (readers, n, (#2 d, s))
- else
- readers,
- if couldWriteWithRpc writers readers pushers e then
- IM.insert (pushers, n, (#2 d, s))
- else
- pushers))
+ let
+ val e = dejs e
+ in
+ (d, (if couldWrite writers e then
+ IM.insert (writers, n, (#2 d, s))
+ else
+ writers,
+ if couldReadCookie readers e then
+ IM.insert (readers, n, (#2 d, s))
+ else
+ readers,
+ if couldWriteWithRpc writers readers pushers e then
+ IM.insert (pushers, n, (#2 d, s))
+ else
+ pushers))
+ end
| DValRec vis =>
let
fun oneRound evs =
foldl (fn ((_, n, _, e, s), (changed, (writers, readers, pushers))) =>
let
+ val e = dejs e
+
val (changed, writers) =
if couldWrite writers e andalso not (IM.inDomain (writers, n)) then
(true, IM.insert (writers, n, (#2 d, s)))
diff --git a/src/jscomp.sml b/src/jscomp.sml
index cd08cc0d..9321b9ce 100644
--- a/src/jscomp.sml
+++ b/src/jscomp.sml
@@ -646,7 +646,8 @@ fun process file =
let
val name = case Settings.jsFunc (m, x) of
NONE => (EM.errorAt loc ("Unsupported FFI function "
- ^ x ^ " in JavaScript");
+ ^ m ^ "." ^ x ^ " in JavaScript");
+ app (fn ((m', x'), _) => print (m' ^ "." ^ x' ^ "\n")) (Settings.allJsFuncs ());
"ERROR")
| SOME s => s
diff --git a/src/settings.sig b/src/settings.sig
index fbf9b3c5..279325c3 100644
--- a/src/settings.sig
+++ b/src/settings.sig
@@ -74,6 +74,7 @@ signature SETTINGS = sig
(* Which FFI functions may be run in JavaScript? (JavaScript function names included) *)
val setJsFuncs : (ffi * string) list -> unit
val jsFunc : ffi -> string option
+ val allJsFuncs : unit -> (ffi * string) list
datatype pattern_kind = Exact | Prefix
datatype action = Allow | Deny
diff --git a/src/settings.sml b/src/settings.sml
index f9af8879..541ff1b4 100644
--- a/src/settings.sml
+++ b/src/settings.sml
@@ -245,6 +245,7 @@ val jsFuncsBase = basisM [("alert", "alert"),
val jsFuncs = ref jsFuncsBase
fun setJsFuncs ls = jsFuncs := foldl (fn ((k, v), m) => M.insert (m, k, v)) jsFuncsBase ls
fun jsFunc x = M.find (!jsFuncs, x)
+fun allJsFuncs () = M.listItemsi (!jsFuncs)
datatype pattern_kind = Exact | Prefix
datatype action = Allow | Deny