diff options
| -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> |