From 8ea9cd1effd09008656440a93023a02a9c6752af Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Sat, 26 Sep 2009 12:45:19 -0400 Subject: Whitelisting tags that may be self-closed --- src/monoize.sml | 25 ++++++++++++++++++++++++- tests/empties.ur | 4 ++++ tests/empties.urp | 3 +++ tests/empties.urs | 1 + 4 files changed, 32 insertions(+), 1 deletion(-) create mode 100644 tests/empties.ur create mode 100644 tests/empties.urp create mode 100644 tests/empties.urs diff --git a/src/monoize.sml b/src/monoize.sml index e9f1588e..c3d91074 100644 --- a/src/monoize.sml +++ b/src/monoize.sml @@ -36,6 +36,19 @@ structure L' = Mono 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 @@ fun monoExp (env, st, fm) (all as (e, loc)) = 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 @@ fun monoExp (env, st, fm) (all as (e, loc)) = _), _), _), _), (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 () diff --git a/tests/empties.ur b/tests/empties.ur new file mode 100644 index 00000000..62003083 --- /dev/null +++ b/tests/empties.ur @@ -0,0 +1,4 @@ +fun main () = return +

+ diff --git a/tests/empties.urp b/tests/empties.urp new file mode 100644 index 00000000..92ce98f8 --- /dev/null +++ b/tests/empties.urp @@ -0,0 +1,3 @@ +debug + +empties diff --git a/tests/empties.urs b/tests/empties.urs new file mode 100644 index 00000000..6ac44e0b --- /dev/null +++ b/tests/empties.urs @@ -0,0 +1 @@ +val main : unit -> transaction page -- cgit v1.2.3