changeset 984:815afd323d86

Whitelisting tags that may be self-closed
author Adam Chlipala <adamc@hcoop.net>
date Sat, 26 Sep 2009 12:45:19 -0400
parents 2cd8c1aa0d3a
children 28bf725de7f3
files src/monoize.sml tests/empties.ur tests/empties.urp tests/empties.urs
diffstat 4 files changed, 32 insertions(+), 1 deletions(-) [+]
line wrap: on
line diff
--- a/src/monoize.sml	Thu Sep 24 15:45:37 2009 -0400
+++ b/src/monoize.sml	Sat Sep 26 12:45:19 2009 -0400
@@ -36,6 +36,19 @@
 structure IM = IntBinaryMap
 structure IS = IntBinarySet
 
+structure SS = BinarySetFn(struct
+                           type ord_key = string
+                           val compare = String.compare
+                           end)
+
+val singletons = SS.addList (SS.empty,
+                             ["link",
+                              "br",
+                              "p",
+                              "hr",
+                              "input",
+                              "button"])
+
 val dummyTyp = (L'.TDatatype (0, ref (L'.Enum, [])), E.dummySpan)
 
 structure U = MonoUtil
@@ -2603,6 +2616,16 @@
                                   loc),
                                  fm)
                             end
+
+                        fun isSingleton () =
+                            let
+                                val (bef, aft) = Substring.splitl (not o Char.isSpace) (Substring.full tag)
+                            in
+                                SS.member (singletons, if Substring.isEmpty aft then
+                                                           tag
+                                                       else
+                                                           Substring.string bef)
+                            end
                     in
                         case xml of
                             (L.EApp ((L.ECApp (
@@ -2610,7 +2633,7 @@
                                                 _), _),
                                       _), _),
                                      (L.EPrim (Prim.String s), _)), _) =>
-                            if CharVector.all Char.isSpace s then
+                            if CharVector.all Char.isSpace s andalso isSingleton () then
                                 ((L'.EStrcat (tagStart, (L'.EPrim (Prim.String " />"), loc)), loc), fm)
                             else
                                 normal ()
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/empties.ur	Sat Sep 26 12:45:19 2009 -0400
@@ -0,0 +1,4 @@
+fun main () = return <xml><body>
+  <table> <tr> <th/> <td><p/></td> </tr> </table>
+  <form><textbox{#A}/></form>
+</body></xml>
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/empties.urp	Sat Sep 26 12:45:19 2009 -0400
@@ -0,0 +1,3 @@
+debug
+
+empties
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/empties.urs	Sat Sep 26 12:45:19 2009 -0400
@@ -0,0 +1,1 @@
+val main : unit -> transaction page