Mercurial > urweb
diff src/monoize.sml @ 95:274116d1a4cd
Monoizing joins and tags
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Thu, 03 Jul 2008 17:53:28 -0400 |
parents | 40d146f467c5 |
children | f0f59e918cac |
line wrap: on
line diff
--- a/src/monoize.sml Thu Jul 03 17:39:17 2008 -0400 +++ b/src/monoize.sml Thu Jul 03 17:53:28 2008 -0400 @@ -95,6 +95,52 @@ | L.EApp ((L.ECApp ((L.EFfi ("Basis", "cdata"), _), _), _), se) => monoExp env se + | L.EApp ( + (L.EApp ( + (L.ECApp ( + (L.ECApp ( + (L.ECApp ( + (L.EFfi ("Basis", "join"), + _), _), _), + _), _), + _), _), + xml1), _), + xml2) => (L'.EStrcat (monoExp env xml1, monoExp env xml2), loc) + + | L.EApp ( + (L.EApp ( + (L.ECApp ( + (L.ECApp ( + (L.EFfi ("Basis", "tag"), + _), _), _), + _), _), + tag), _), + xml) => + let + fun getTag (e, _) = + case e of + L.EFfi ("Basis", tag) => tag + | _ => (E.errorAt loc "Non-constant XML tag"; + Print.eprefaces' [("Expression", CorePrint.p_exp env tag)]; + "") + + val tag = getTag tag + + fun normal () = + (L'.EStrcat ((L'.EPrim (Prim.String (String.concat ["<", tag, ">"])), loc), + (L'.EStrcat (monoExp env xml, + (L'.EPrim (Prim.String (String.concat ["</", tag, ">"])), loc)), loc)), + loc) + in + case xml of + (L.EApp ((L.ECApp ((L.EFfi ("Basis", "cdata"), _), + _), _), (L.EPrim (Prim.String s), _)), _) => + if CharVector.all Char.isSpace s then + (L'.EPrim (Prim.String (String.concat ["<", tag, "/>"])), loc) + else + normal () + | _ => normal () + end | L.EApp (e1, e2) => (L'.EApp (monoExp env e1, monoExp env e2), loc) | L.EAbs (x, dom, ran, e) =>