Mercurial > urweb
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 |