Mercurial > urweb
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