# HG changeset patch
# User Adam Chlipala <adamc@hcoop.net>
# Date 1244917776 14400
# Node ID 0f7e2cca6d9b40977ee1eeff95152f015893f899
# Parent  0d30e6338c651631dcc46ed22342977e6beaeeb1
<dyn> inside <table>; fix Specialize bug with datatype decls generating other mutually-recursive datatype decls

diff -r 0d30e6338c65 -r 0f7e2cca6d9b lib/js/urweb.js
--- a/lib/js/urweb.js	Tue Jun 09 18:11:59 2009 -0400
+++ b/lib/js/urweb.js	Sat Jun 13 14:29:36 2009 -0400
@@ -278,15 +278,20 @@
     for (var ls = x.closures; ls; ls = ls.next)
       freeClosure(ls.data);
 
-    var spans = x.getElementsByTagName("span");
-    for (var i = 0; i < spans.length; ++i) {
-      var span = spans[i];
-      span.dead = true;
-      for (var ls = span.sources; ls; ls = ls.next)
-        ls.data.dyns = remove(span, ls.data.dyns);
-      for (var ls = span.closures; ls; ls = ls.next)
-        freeClosure(ls.data);
-    }
+    var doKind = function(kind) {
+      var arr = x.getElementsByTagName(kind);
+      for (var i = 0; i < arr.length; ++i) {
+        var span = arr[i];
+        span.dead = true;
+        for (var ls = span.sources; ls; ls = ls.next)
+          ls.data.dyns = remove(span, ls.data.dyns);
+        for (var ls = span.closures; ls; ls = ls.next)
+          freeClosure(ls.data);
+      }
+    };
+
+    doKind("span");
+    doKind("tbody");
 
     var cls = {v : null};
     x.innerHTML = flatten(cls, v);
diff -r 0d30e6338c65 -r 0f7e2cca6d9b lib/ur/basis.urs
--- a/lib/ur/basis.urs	Tue Jun 09 18:11:59 2009 -0400
+++ b/lib/ur/basis.urs	Sat Jun 13 14:29:36 2009 -0400
@@ -530,8 +530,8 @@
 val bless : string -> url
 val checkUrl : string -> option url
 
-val dyn : use ::: {Type} -> bind ::: {Type} -> unit
-          -> tag [Signal = signal (xml body use bind)] body [] use bind
+val dyn : ctx ::: {Unit} -> use ::: {Type} -> bind ::: {Type} -> [ctx ~ body] => unit
+          -> tag [Signal = signal (xml (body ++ ctx) use bind)] (body ++ ctx) [] use bind
 
 val head : unit -> tag [] html head [] []
 val title : unit -> tag [] head [] [] []
diff -r 0d30e6338c65 -r 0f7e2cca6d9b src/jscomp.sml
--- a/src/jscomp.sml	Tue Jun 09 18:11:59 2009 -0400
+++ b/src/jscomp.sml	Sat Jun 13 14:29:36 2009 -0400
@@ -171,6 +171,13 @@
 
 exception CantEmbed of typ
 
+fun inString {needle, haystack} =
+    let
+        val (_, suffix) = Substring.position needle (Substring.full haystack)
+    in
+        not (Substring.isEmpty suffix)
+    end
+
 fun process file =
     let
         val (someTs, nameds) =
@@ -1086,7 +1093,14 @@
         fun exp outer (e as (_, loc), st) =
             ((*Print.preface ("exp", MonoPrint.p_exp MonoEnv.empty e);*)
              case #1 e of
-                 EPrim _ => (e, st)
+                 EPrim p =>
+                 (case p of
+                      Prim.String s => if inString {needle = "<script", haystack = s} then
+                                           foundJavaScript := true
+                                       else
+                                           ()
+                    | _ => ();
+                  (e, st))
                | ERel _ => (e, st)
                | ENamed _ => (e, st)
                | ECon (_, _, NONE) => (e, st)
diff -r 0d30e6338c65 -r 0f7e2cca6d9b src/list_util.sig
--- a/src/list_util.sig	Tue Jun 09 18:11:59 2009 -0400
+++ b/src/list_util.sig	Sat Jun 13 14:29:36 2009 -0400
@@ -37,6 +37,8 @@
     val foldlMap : ('data1 * 'state -> 'data2 * 'state) -> 'state -> 'data1 list -> 'data2 list * 'state
     val foldlMapPartial : ('data1 * 'state -> 'data2 option * 'state) -> 'state -> 'data1 list -> 'data2 list * 'state
     val foldlMapConcat : ('data1 * 'state -> 'data2 list * 'state) -> 'state -> 'data1 list -> 'data2 list * 'state
+    val foldlMapAbort : ('data1 * 'state -> ('data2 * 'state) option)
+                        -> 'state -> 'data1 list -> ('data2 list * 'state) option
 
     val search : ('a -> 'b option) -> 'a list -> 'b option
     val searchi : (int * 'a -> 'b option) -> 'a list -> 'b option
diff -r 0d30e6338c65 -r 0f7e2cca6d9b src/list_util.sml
--- a/src/list_util.sml	Tue Jun 09 18:11:59 2009 -0400
+++ b/src/list_util.sml	Sat Jun 13 14:29:36 2009 -0400
@@ -123,6 +123,19 @@
         fm ([], s)
     end
 
+fun foldlMapAbort f s =
+    let
+        fun fm (ls', s) ls =
+            case ls of
+                nil => SOME (rev ls', s)
+              | h :: t =>
+                case f (h, s) of
+                    NONE => NONE
+                  | SOME (h', s') => fm (h' :: ls', s') t
+    in
+        fm ([], s)
+    end
+
 fun search f =
     let
         fun s ls =
diff -r 0d30e6338c65 -r 0f7e2cca6d9b src/monoize.sml
--- a/src/monoize.sml	Tue Jun 09 18:11:59 2009 -0400
+++ b/src/monoize.sml	Sat Jun 13 14:29:36 2009 -0400
@@ -2595,11 +2595,24 @@
                   | "dyn" =>
                     (case attrs of
                          [("Signal", e, _)] =>
-                         ((L'.EStrcat
-                               ((L'.EPrim (Prim.String "<span><script type=\"text/javascript\">dyn("), loc),
-                                (L'.EStrcat ((L'.EJavaScript (L'.Script, e), loc),
-                                             (L'.EPrim (Prim.String ")</script></span>"), loc)), loc)), loc),
-                          fm)
+                         let
+                             val inTable = case targs of
+                                               (L.CRecord (_, ctx), _) :: _ =>
+                                               List.exists (fn ((L.CName "Table", _), _) => true
+                                                             | _ => false) ctx
+                                             | _ => false
+
+                             val tag = if inTable then
+                                           "tbody"
+                                       else
+                                           "span"
+                         in
+                             ((L'.EStrcat
+                                   ((L'.EPrim (Prim.String ("<" ^ tag ^ "><script type=\"text/javascript\">dyn(")), loc),
+                                    (L'.EStrcat ((L'.EJavaScript (L'.Script, e), loc),
+                                                 (L'.EPrim (Prim.String (")</script></" ^ tag ^ ">")), loc)), loc)), loc),
+                              fm)
+                         end
                        | _ => raise Fail "Monoize: Bad dyn attributes")
                     
                   | "submit" => normal ("input type=\"submit\"", NONE, NONE)
diff -r 0d30e6338c65 -r 0f7e2cca6d9b src/specialize.sml
--- a/src/specialize.sml	Tue Jun 09 18:11:59 2009 -0400
+++ b/src/specialize.sml	Sat Jun 13 14:29:36 2009 -0400
@@ -246,15 +246,12 @@
             let
                 (*val () = Print.preface ("decl:", CorePrint.p_decl CoreEnv.empty all)*)
                 val (d, st) = specDecl st d
-
-                val ds =
-                    case #decls st of
-                        [] => []
-                      | dts => [(DDatatype dts, #2 d)]
             in
                 case #1 d of
                     DDatatype dts =>
-                    (rev (d :: ds),
+                    ((case #decls st of
+                          [] => [d]
+                        | dts' => [(DDatatype (dts' @ dts), #2 d)]),
                      {count = #count st,
                       datatypes = foldl (fn ((x, n, xs, xnts), dts) =>
                                             IM.insert (dts, n,
@@ -270,7 +267,9 @@
                                            (#constructors st) dts,
                       decls = []})
                   | _ =>
-                    (rev (d :: ds),
+                    (case #decls st of
+                          [] => [d]
+                        | dts => [(DDatatype dts, #2 d), d],
                      {count = #count st,
                       datatypes = #datatypes st,
                       constructors = #constructors st,
@@ -286,5 +285,4 @@
         ds
     end
 
-
 end
diff -r 0d30e6338c65 -r 0f7e2cca6d9b tests/tbody.ur
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/tbody.ur	Sat Jun 13 14:29:36 2009 -0400
@@ -0,0 +1,13 @@
+fun main () : transaction page =
+    s <- source [];
+    entry <- source "";
+    return <xml><body>
+      <table>
+        <dyn signal={s <- signal s;
+                     return (List.mapX (fn s => <xml><tr><td>{[s]}</td></tr></xml>) s)}/>
+      </table>
+
+      Add one: <ctextbox source={entry}/> <button onclick={e <- get entry;
+                                                           v <- get s;
+                                                           set s (e :: v)}/>
+    </body></xml>
diff -r 0d30e6338c65 -r 0f7e2cca6d9b tests/tbody.urp
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/tbody.urp	Sat Jun 13 14:29:36 2009 -0400
@@ -0,0 +1,4 @@
+debug
+
+$/list
+tbody