diff options
| author |  Adam Chlipala <adamc@hcoop.net> | 2009-04-12 11:08:00 -0400 |
|---|---|---|
| committer | Adam Chlipala <adamc@hcoop.net> | 2009-04-12 11:08:00 -0400 |
| commit | 6857918cbca4b1dda5bf378bcacb5dea4f5b5724 (patch) | |
| tree | d4d5c202be4912da6d99166ecc5d1de3413f4c93 /src/monoize.sml | |
| parent | 64f0edf6a5db26ed8f872e18a43416cce7fcbab8 (diff) | |
hello compiles with CSS
Diffstat (limited to 'src/monoize.sml')
| -rw-r--r-- | src/monoize.sml | 59 |
1 files changed, 43 insertions, 16 deletions
diff --git a/src/monoize.sml b/src/monoize.sml index 8030b7ba..e8244c9e 100644 --- a/src/monoize.sml +++ b/src/monoize.sml @@ -127,10 +127,14 @@ fun monoType env = 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 @@ fun monoExp (env, st, fm) (all as (e, loc)) = | L.EApp ( (L.ECApp ( - (L.ECApp ((L.EFfi ("Basis", "cdata"), _), _), _), + (L.ECApp ( + (L.ECApp ((L.EFfi ("Basis", "cdata"), _), _), _), + _), _), _), _), se) => let @@ -2012,19 +2018,32 @@ fun monoExp (env, st, fm) (all as (e, loc)) = ((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 @@ fun monoExp (env, st, fm) (all as (e, loc)) = | 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, _) = |