diff src/monoize.sml @ 2012:2b2d07946e65

Fix dynClass for non-<body> contexts
author Adam Chlipala <adam@chlipala.net>
date Sun, 04 May 2014 12:33:44 -0400
parents 93ff76058825
children 924e2ef31f5a
line wrap: on
line diff
--- a/src/monoize.sml	Sat May 03 07:59:45 2014 -0400
+++ b/src/monoize.sml	Sun May 04 12:33:44 2014 -0400
@@ -3230,7 +3230,7 @@
                         (L.ECApp (
                          (L.ECApp (
 			  (L.EFfi ("Basis", "tag"),
-                           _), (L.CRecord (_, attrsGiven), _)), _), _), _), _), _), _), _), _), _), _), _), _), _), _), _),
+                           _), (L.CRecord (_, attrsGiven), _)), _), _), _), ctxOuter), _), _), _), _), _), _), _), _), _), _), _),
 		  class), _),
 	         dynClass), _),
                 style), _),
@@ -3581,6 +3581,19 @@
                                                       (L'.EPrim (Prim.String ")"), loc)), loc)), loc)
                         end
 
+                fun inTag tag' = case ctxOuter of
+				     (L.CRecord (_, ctx), _) =>
+				     List.exists (fn ((L.CName tag'', _), _) => tag'' = tag'
+                                                   | _ => false) ctx
+                                  | _ => false
+
+                fun pnode () = if inTag "Tr" then
+			           "tr"
+                               else if inTag "Table" then
+			           "table"
+                               else
+			           "span"
+
 		val baseAll as (base, fm) =
                     case tag of
 			"body" => let
@@ -3603,24 +3616,12 @@
 
                       | "dyn" =>
 			let
-                            fun inTag tag = case targs of
-						(L.CRecord (_, ctx), _) :: _ =>
-						List.exists (fn ((L.CName tag', _), _) => tag' = tag
-                                                              | _ => false) ctx
-                                              | _ => false
-
-                            val tag = if inTag "Tr" then
-					  "tr"
-                                      else if inTag "Table" then
-					  "table"
-                                      else
-					  "span"
 			in
                             case attrs of
 				[("Signal", e, _)] =>
 				((L'.EStrcat
                                       ((L'.EPrim (Prim.String ("<script type=\"text/javascript\">dyn(\""
-                                                               ^ tag ^ "\", execD(")), loc),
+                                                               ^ pnode () ^ "\", execD(")), loc),
                                        (L'.EStrcat ((L'.EJavaScript (L'.Script, e), loc),
                                                     (L'.EPrim (Prim.String ("))</script>")), loc)), loc)), loc),
 				 fm)
@@ -3834,7 +3835,9 @@
 		    L'.ENone _ =>
 		    (case #1 dynStyle of
 		         L'.ENone _ => baseAll
-		       | L'.ESome (_, ds) => (strcat [str "<script type=\"text/javascript\">dynClass(execD(",
+		       | L'.ESome (_, ds) => (strcat [str "<script type=\"text/javascript\">dynClass(\"",
+                                                      str (pnode ()),
+                                                      str "\",execD(",
 				                      (L'.EJavaScript (L'.Script, base), loc),
 				                      str "),null,execD(",
 				                      (L'.EJavaScript (L'.Script, ds), loc),
@@ -3852,7 +3855,9 @@
                                   | _ => (E.errorAt loc "Absence/presence of 'dynStyle' unknown";
                                           str "null")
                     in
-                        (strcat [str "<script type=\"text/javascript\">dynClass(execD(",
+                        (strcat [str "<script type=\"text/javascript\">dynClass(\"",
+                                 str (pnode ()),
+                                 str "\",execD(",
 				 (L'.EJavaScript (L'.Script, base), loc),
 				 str "),execD(",
 				 (L'.EJavaScript (L'.Script, dc), loc),