diff src/monoize.sml @ 720:acb8537f58f0

Stop tracking CSS classes in XML types
author Adam Chlipala <adamc@hcoop.net>
date Sun, 12 Apr 2009 12:31:54 -0400
parents 5c099b1308ae
children 9864b64b1700
line wrap: on
line diff
--- a/src/monoize.sml	Sun Apr 12 11:08:00 2009 -0400
+++ b/src/monoize.sml	Sun Apr 12 12:31:54 2009 -0400
@@ -127,14 +127,10 @@
                     readType (mt env dtmap t, loc)
 
                   | L.CFfi ("Basis", "url") => (L'.TFfi ("Basis", "string"), loc)
-                  | L.CApp ((L.CApp ((L.CApp ((L.CApp ((L.CFfi ("Basis", "xml"), _), _), _), _), _), _), _), _) =>
+                  | L.CApp ((L.CApp ((L.CApp ((L.CFfi ("Basis", "xml"), _), _), _), _), _), _) =>
                     (L'.TFfi ("Basis", "string"), loc)
                   | L.CApp ((L.CApp ((L.CFfi ("Basis", "xhtml"), _), _), _), _) =>
                     (L'.TFfi ("Basis", "string"), loc)
-                  | L.CApp ((L.CFfi ("Basis", "css_class"), _), _) =>
-                    (L'.TFfi ("Basis", "string"), loc)
-                  | L.CApp ((L.CApp ((L.CFfi ("Basis", "css_subset"), _), _), _), _) =>
-                    (L'.TRecord [], loc)
 
                   | L.CApp ((L.CFfi ("Basis", "transaction"), _), t) =>
                     (L'.TFun ((L'.TRecord [], loc), mt env dtmap t), loc)
@@ -2007,9 +2003,7 @@
 
           | L.EApp (
             (L.ECApp (
-             (L.ECApp (
-              (L.ECApp ((L.EFfi ("Basis", "cdata"), _), _), _),
-              _), _),
+             (L.ECApp ((L.EFfi ("Basis", "cdata"), _), _), _),
              _), _),
             se) =>
             let
@@ -2018,32 +2012,19 @@
                 ((L'.EFfiApp ("Basis", "htmlifyString", [se]), loc), fm)
             end
 
-          | L.ECApp ((L.ECApp ((L.EFfi ("Basis", "css_subset"), _), _), _), _) =>
-            ((L'.ERecord [], loc), fm)
-
           | L.EApp (
             (L.EApp (
-             (L.EApp (
-              (L.EApp (
+             (L.ECApp (
+              (L.ECApp (
                (L.ECApp (
                 (L.ECApp (
-                 (L.ECApp (
-                  (L.ECApp (
-                   (L.ECApp (
-                    (L.ECApp (
-                     (L.ECApp (
-                      (L.EFfi ("Basis", "join"),
-                       _), _), _),
-                     _), _),
-                    _), _),
-                   _), _),
-                  _), _),
-                 _), _),
+                 (L.EFfi ("Basis", "join"),
+                     _), _), _),
                 _), _),
-               xml1), _),
-              xml2), _),
-             _), _),
-            _) =>
+               _), _),
+              _), _),
+             xml1), _),
+            xml2) =>
             let
                 val (xml1, fm) = monoExp (env, st, fm) xml1
                 val (xml2, fm) = monoExp (env, st, fm) xml2
@@ -2054,26 +2035,18 @@
           | L.EApp (
             (L.EApp (
              (L.EApp (
-              (L.EApp (
-               (L.EApp (
+              (L.ECApp (
+               (L.ECApp (
                 (L.ECApp (
                  (L.ECApp (
                   (L.ECApp (
                    (L.ECApp (
                     (L.ECApp (
                      (L.ECApp (
-                      (L.ECApp (
-                       (L.ECApp (
-                        (L.ECApp (
-                         (L.ECApp (
-                          (L.ECApp (
-                           (L.EFfi ("Basis", "tag"),
-                            _), _), _), _), _), _), _), _), _), _), _), _), _), _), _), _), _),
-                   _), _), _), _), _), _),
-                attrs), _),
-               tag), _),
-              _), _),
-             _), _),
+                      (L.EFfi ("Basis", "tag"),
+                       _), _), _), _), _), _), _), _), _), _), _), _), _), _), _), _), _),
+              attrs), _),
+             tag), _),
             xml) =>
             let
                 fun getTag' (e, _) =
@@ -2732,23 +2705,17 @@
                       fm,
                       [(L'.DVal (x, n, t', e, s), loc)])
             end
-          | L.DStyle (x, n, (L.CRecord (_, xcs), _), s) =>
+          | L.DStyle (x, n, s) =>
             let
-                val xs = map (fn ((L.CName x, _), _) => x
-                               | (x, _) => (E.errorAt (#2 x) "Undetermined style component";
-                                            Print.eprefaces' [("Name", CorePrint.p_con env x)];
-                                            "")) xcs
-
                 val t = (L.CFfi ("Basis", "string"), loc)
                 val t' = (L'.TFfi ("Basis", "string"), loc)
                 val e = (L'.EPrim (Prim.String s), loc)
             in
                 SOME (Env.pushENamed env x n t NONE s,
                       fm,
-                      [(L'.DStyle (s, xs), loc),
+                      [(L'.DStyle s, loc),
                        (L'.DVal (x, n, t', e, s), loc)])
             end
-          | L.DStyle _ => poly ()
     end
 
 datatype expungable = Client | Channel