# HG changeset patch # User Adam Chlipala # Date 1215122008 14400 # Node ID 274116d1a4cdcf0e49ec3e2956b3e3a362ce143e # Parent 40d146f467c50652e5e1ac9795f9c79aa0152fb8 Monoizing joins and tags diff -r 40d146f467c5 -r 274116d1a4cd src/monoize.sml --- 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 [""])), 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 -r 40d146f467c5 -r 274116d1a4cd src/prim.sml --- a/src/prim.sml Thu Jul 03 17:39:17 2008 -0400 +++ b/src/prim.sml Thu Jul 03 17:53:28 2008 -0400 @@ -39,6 +39,6 @@ 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 -r 40d146f467c5 -r 274116d1a4cd tests/cdatas.lac --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/tests/cdatas.lac Thu Jul 03 17:53:28 2008 -0400 @@ -0,0 +1,4 @@ +val main : {} -> xml[Html] = fn () => + Hi! + Bye! +