Mercurial > urweb
diff src/monoize.sml @ 719:5c099b1308ae
hello compiles with CSS
| author | Adam Chlipala <adamc@hcoop.net> |
|---|---|
| date | Sun, 12 Apr 2009 11:08:00 -0400 |
| parents | f152f215a02c |
| children | acb8537f58f0 |
line wrap: on
line diff
--- a/src/monoize.sml Sun Apr 12 10:08:11 2009 -0400 +++ b/src/monoize.sml Sun Apr 12 11:08:00 2009 -0400 @@ -127,10 +127,14 @@ readType (mt env dtmap t, loc) | L.CFfi ("Basis", "url") => (L'.TFfi ("Basis", "string"), loc) - | L.CApp ((L.CApp ((L.CApp ((L.CFfi ("Basis", "xml"), _), _), _), _), _), _) => + | L.CApp ((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) @@ -2003,7 +2007,9 @@ | L.EApp ( (L.ECApp ( - (L.ECApp ((L.EFfi ("Basis", "cdata"), _), _), _), + (L.ECApp ( + (L.ECApp ((L.EFfi ("Basis", "cdata"), _), _), _), + _), _), _), _), se) => let @@ -2012,19 +2018,32 @@ ((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.ECApp ( - (L.ECApp ( + (L.EApp ( + (L.EApp ( (L.ECApp ( (L.ECApp ( - (L.EFfi ("Basis", "join"), - _), _), _), + (L.ECApp ( + (L.ECApp ( + (L.ECApp ( + (L.ECApp ( + (L.ECApp ( + (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 @@ -2035,18 +2054,26 @@ | L.EApp ( (L.EApp ( (L.EApp ( - (L.ECApp ( - (L.ECApp ( + (L.EApp ( + (L.EApp ( (L.ECApp ( (L.ECApp ( (L.ECApp ( (L.ECApp ( (L.ECApp ( (L.ECApp ( - (L.EFfi ("Basis", "tag"), - _), _), _), _), _), _), _), _), _), _), _), _), _), _), _), _), _), - attrs), _), - tag), _), + (L.ECApp ( + (L.ECApp ( + (L.ECApp ( + (L.ECApp ( + (L.ECApp ( + (L.EFfi ("Basis", "tag"), + _), _), _), _), _), _), _), _), _), _), _), _), _), _), _), _), _), + _), _), _), _), _), _), + attrs), _), + tag), _), + _), _), + _), _), xml) => let fun getTag' (e, _) =