Mercurial > urweb

changeset 95:274116d1a4cd

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Monoizing joins and tags
author Adam Chlipala <adamc@hcoop.net>
date Thu, 03 Jul 2008 17:53:28 -0400
parents 40d146f467c5
children 82aaa1c406d3
files src/monoize.sml src/prim.sml tests/cdatas.lac
diffstat 3 files changed, 51 insertions(+), 1 deletions(-) [+]
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) =>
--- 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
--- /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 () => <html>
+        Hi!
+        Bye!
+</html>