comparison 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
comparison
equal deleted inserted replaced
718:f152f215a02c 719:5c099b1308ae
125 (L'.TFun (mt env dtmap t, (L'.TFfi ("Basis", "string"), loc)), loc) 125 (L'.TFun (mt env dtmap t, (L'.TFfi ("Basis", "string"), loc)), loc)
126 | L.CApp ((L.CFfi ("Basis", "read"), _), t) => 126 | L.CApp ((L.CFfi ("Basis", "read"), _), t) =>
127 readType (mt env dtmap t, loc) 127 readType (mt env dtmap t, loc)
128 128
129 | L.CFfi ("Basis", "url") => (L'.TFfi ("Basis", "string"), loc) 129 | L.CFfi ("Basis", "url") => (L'.TFfi ("Basis", "string"), loc)
130 | L.CApp ((L.CApp ((L.CApp ((L.CFfi ("Basis", "xml"), _), _), _), _), _), _) => 130 | L.CApp ((L.CApp ((L.CApp ((L.CApp ((L.CFfi ("Basis", "xml"), _), _), _), _), _), _), _), _) =>
131 (L'.TFfi ("Basis", "string"), loc) 131 (L'.TFfi ("Basis", "string"), loc)
132 | L.CApp ((L.CApp ((L.CFfi ("Basis", "xhtml"), _), _), _), _) => 132 | L.CApp ((L.CApp ((L.CFfi ("Basis", "xhtml"), _), _), _), _) =>
133 (L'.TFfi ("Basis", "string"), loc) 133 (L'.TFfi ("Basis", "string"), loc)
134 | L.CApp ((L.CFfi ("Basis", "css_class"), _), _) =>
135 (L'.TFfi ("Basis", "string"), loc)
136 | L.CApp ((L.CApp ((L.CFfi ("Basis", "css_subset"), _), _), _), _) =>
137 (L'.TRecord [], loc)
134 138
135 | L.CApp ((L.CFfi ("Basis", "transaction"), _), t) => 139 | L.CApp ((L.CFfi ("Basis", "transaction"), _), t) =>
136 (L'.TFun ((L'.TRecord [], loc), mt env dtmap t), loc) 140 (L'.TFun ((L'.TRecord [], loc), mt env dtmap t), loc)
137 | L.CApp ((L.CFfi ("Basis", "source"), _), t) => 141 | L.CApp ((L.CFfi ("Basis", "source"), _), t) =>
138 (L'.TSource, loc) 142 (L'.TSource, loc)
2001 ((L'.ENextval e, loc), fm) 2005 ((L'.ENextval e, loc), fm)
2002 end 2006 end
2003 2007
2004 | L.EApp ( 2008 | L.EApp (
2005 (L.ECApp ( 2009 (L.ECApp (
2006 (L.ECApp ((L.EFfi ("Basis", "cdata"), _), _), _), 2010 (L.ECApp (
2011 (L.ECApp ((L.EFfi ("Basis", "cdata"), _), _), _),
2012 _), _),
2007 _), _), 2013 _), _),
2008 se) => 2014 se) =>
2009 let 2015 let
2010 val (se, fm) = monoExp (env, st, fm) se 2016 val (se, fm) = monoExp (env, st, fm) se
2011 in 2017 in
2012 ((L'.EFfiApp ("Basis", "htmlifyString", [se]), loc), fm) 2018 ((L'.EFfiApp ("Basis", "htmlifyString", [se]), loc), fm)
2013 end 2019 end
2014 2020
2015 | L.EApp ( 2021 | L.ECApp ((L.ECApp ((L.EFfi ("Basis", "css_subset"), _), _), _), _) =>
2016 (L.EApp ( 2022 ((L'.ERecord [], loc), fm)
2017 (L.ECApp (
2018 (L.ECApp (
2019 (L.ECApp (
2020 (L.ECApp (
2021 (L.EFfi ("Basis", "join"),
2022 _), _), _),
2023 _), _),
2024 _), _),
2025 _), _),
2026 xml1), _),
2027 xml2) =>
2028 let
2029 val (xml1, fm) = monoExp (env, st, fm) xml1
2030 val (xml2, fm) = monoExp (env, st, fm) xml2
2031 in
2032 ((L'.EStrcat (xml1, xml2), loc), fm)
2033 end
2034 2023
2035 | L.EApp ( 2024 | L.EApp (
2036 (L.EApp ( 2025 (L.EApp (
2037 (L.EApp ( 2026 (L.EApp (
2038 (L.ECApp ( 2027 (L.EApp (
2039 (L.ECApp ( 2028 (L.ECApp (
2040 (L.ECApp ( 2029 (L.ECApp (
2041 (L.ECApp ( 2030 (L.ECApp (
2042 (L.ECApp ( 2031 (L.ECApp (
2043 (L.ECApp ( 2032 (L.ECApp (
2044 (L.ECApp ( 2033 (L.ECApp (
2045 (L.ECApp ( 2034 (L.ECApp (
2046 (L.EFfi ("Basis", "tag"), 2035 (L.EFfi ("Basis", "join"),
2047 _), _), _), _), _), _), _), _), _), _), _), _), _), _), _), _), _), 2036 _), _), _),
2048 attrs), _), 2037 _), _),
2049 tag), _), 2038 _), _),
2039 _), _),
2040 _), _),
2041 _), _),
2042 _), _),
2043 xml1), _),
2044 xml2), _),
2045 _), _),
2046 _) =>
2047 let
2048 val (xml1, fm) = monoExp (env, st, fm) xml1
2049 val (xml2, fm) = monoExp (env, st, fm) xml2
2050 in
2051 ((L'.EStrcat (xml1, xml2), loc), fm)
2052 end
2053
2054 | L.EApp (
2055 (L.EApp (
2056 (L.EApp (
2057 (L.EApp (
2058 (L.EApp (
2059 (L.ECApp (
2060 (L.ECApp (
2061 (L.ECApp (
2062 (L.ECApp (
2063 (L.ECApp (
2064 (L.ECApp (
2065 (L.ECApp (
2066 (L.ECApp (
2067 (L.ECApp (
2068 (L.ECApp (
2069 (L.ECApp (
2070 (L.EFfi ("Basis", "tag"),
2071 _), _), _), _), _), _), _), _), _), _), _), _), _), _), _), _), _),
2072 _), _), _), _), _), _),
2073 attrs), _),
2074 tag), _),
2075 _), _),
2076 _), _),
2050 xml) => 2077 xml) =>
2051 let 2078 let
2052 fun getTag' (e, _) = 2079 fun getTag' (e, _) =
2053 case e of 2080 case e of
2054 L.EFfi ("Basis", tag) => (tag, []) 2081 L.EFfi ("Basis", tag) => (tag, [])