comparison src/monoize.sml @ 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 27a3412d23e4
children d1dbb9a3c804
comparison
equal deleted inserted replaced
983:2cd8c1aa0d3a 984:815afd323d86
33 structure L = Core 33 structure L = Core
34 structure L' = Mono 34 structure L' = Mono
35 35
36 structure IM = IntBinaryMap 36 structure IM = IntBinaryMap
37 structure IS = IntBinarySet 37 structure IS = IntBinarySet
38
39 structure SS = BinarySetFn(struct
40 type ord_key = string
41 val compare = String.compare
42 end)
43
44 val singletons = SS.addList (SS.empty,
45 ["link",
46 "br",
47 "p",
48 "hr",
49 "input",
50 "button"])
38 51
39 val dummyTyp = (L'.TDatatype (0, ref (L'.Enum, [])), E.dummySpan) 52 val dummyTyp = (L'.TDatatype (0, ref (L'.Enum, [])), E.dummySpan)
40 53
41 structure U = MonoUtil 54 structure U = MonoUtil
42 55
2601 (L'.EPrim (Prim.String (String.concat ["</", tag, ">"])), 2614 (L'.EPrim (Prim.String (String.concat ["</", tag, ">"])),
2602 loc)), loc)), 2615 loc)), loc)),
2603 loc), 2616 loc),
2604 fm) 2617 fm)
2605 end 2618 end
2619
2620 fun isSingleton () =
2621 let
2622 val (bef, aft) = Substring.splitl (not o Char.isSpace) (Substring.full tag)
2623 in
2624 SS.member (singletons, if Substring.isEmpty aft then
2625 tag
2626 else
2627 Substring.string bef)
2628 end
2606 in 2629 in
2607 case xml of 2630 case xml of
2608 (L.EApp ((L.ECApp ( 2631 (L.EApp ((L.ECApp (
2609 (L.ECApp ((L.EFfi ("Basis", "cdata"), _), 2632 (L.ECApp ((L.EFfi ("Basis", "cdata"), _),
2610 _), _), 2633 _), _),
2611 _), _), 2634 _), _),
2612 (L.EPrim (Prim.String s), _)), _) => 2635 (L.EPrim (Prim.String s), _)), _) =>
2613 if CharVector.all Char.isSpace s then 2636 if CharVector.all Char.isSpace s andalso isSingleton () then
2614 ((L'.EStrcat (tagStart, (L'.EPrim (Prim.String " />"), loc)), loc), fm) 2637 ((L'.EStrcat (tagStart, (L'.EPrim (Prim.String " />"), loc)), loc), fm)
2615 else 2638 else
2616 normal () 2639 normal ()
2617 | _ => normal () 2640 | _ => normal ()
2618 end 2641 end