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 (2011-03-11)
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