diff options
| author |  Adam Chlipala <adamc@hcoop.net> | 2008-07-03 17:53:28 -0400 |
|---|---|---|
| committer | Adam Chlipala <adamc@hcoop.net> | 2008-07-03 17:53:28 -0400 |
| commit | b11edd2101e896dd0482715686712b67f00d3099 (patch) | |
| tree | f06530522246b9f2aa89514b30a136320843b918 /src/monoize.sml | |
| parent | 01f5a1802c6ad76f7389c500af27f8a57456b556 (diff) | |
Monoizing joins and tags
Diffstat (limited to 'src/monoize.sml')
| -rw-r--r-- | src/monoize.sml | 46 |
1 files changed, 46 insertions, 0 deletions
diff --git a/src/monoize.sml b/src/monoize.sml index 7d9c1fab..e5d7c374 100644 --- a/src/monoize.sml +++ b/src/monoize.sml @@ -95,6 +95,52 @@ fun monoExp env (all as (e, loc)) = | 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) => |