diff options
author | 2008-07-03 17:53:28 -0400 | |
---|---|---|
committer | 2008-07-03 17:53:28 -0400 | |
commit | b11edd2101e896dd0482715686712b67f00d3099 (patch) | |
tree | f06530522246b9f2aa89514b30a136320843b918 | |
parent | 01f5a1802c6ad76f7389c500af27f8a57456b556 (diff) |
Monoizing joins and tags
-rw-r--r-- | src/monoize.sml | 46 | ||||
-rw-r--r-- | src/prim.sml | 2 | ||||
-rw-r--r-- | tests/cdatas.lac | 4 |
3 files changed, 51 insertions, 1 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) => diff --git a/src/prim.sml b/src/prim.sml index 95228842..f58918b7 100644 --- a/src/prim.sml +++ b/src/prim.sml @@ -39,6 +39,6 @@ fun p_t t = case t of Int n => string (Int64.toString n) | Float n => string (Real64.toString n) - | String s => box [string "\"", string s, string "\""] + | String s => box [string "\"", string (String.toString s), string "\""] end diff --git a/tests/cdatas.lac b/tests/cdatas.lac new file mode 100644 index 00000000..ab154e18 --- /dev/null +++ b/tests/cdatas.lac @@ -0,0 +1,4 @@ +val main : {} -> xml[Html] = fn () => <html> + Hi! + Bye! +</html> |