Mercurial > urweb
changeset 1433:66092ce45a76
Ignore JavaScript events in Effectize; allow extra spaces for 'jsFunc'; eat carriage returns at line ends in .urp files
| author | Adam Chlipala <adam@chlipala.net> |
|---|---|
| date | Thu, 10 Mar 2011 20:22:03 -0500 |
| parents | 7d024767b024 |
| children | 44f78d6fec29 |
| files | src/compiler.sml src/effectize.sml src/jscomp.sml src/settings.sig src/settings.sml |
| diffstat | 5 files changed, 43 insertions(+), 18 deletions(-) [+] |
line wrap: on
line diff
--- a/src/compiler.sml Thu Mar 10 19:26:35 2011 -0500 +++ b/src/compiler.sml Thu Mar 10 20:22:03 2011 -0500 @@ -307,6 +307,8 @@ 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 @@ 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 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
--- a/src/effectize.sml Thu Mar 10 19:26:35 2011 -0500 +++ b/src/effectize.sml Thu Mar 10 20:22:03 2011 -0500 @@ -87,26 +87,38 @@ 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)))
--- a/src/jscomp.sml Thu Mar 10 19:26:35 2011 -0500 +++ b/src/jscomp.sml Thu Mar 10 20:22:03 2011 -0500 @@ -646,7 +646,8 @@ 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
--- a/src/settings.sig Thu Mar 10 19:26:35 2011 -0500 +++ b/src/settings.sig Thu Mar 10 20:22:03 2011 -0500 @@ -74,6 +74,7 @@ (* 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
--- a/src/settings.sml Thu Mar 10 19:26:35 2011 -0500 +++ b/src/settings.sml Thu Mar 10 20:22:03 2011 -0500 @@ -245,6 +245,7 @@ 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