Mercurial > urweb

comparison src/monoize.sml @ 720:acb8537f58f0

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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
comparison
equal deleted inserted replaced
719:5c099b1308ae 720:acb8537f58f0
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.CApp ((L.CFfi ("Basis", "xml"), _), _), _), _), _), _), _), _) => 130 | 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)
138 134
139 | L.CApp ((L.CFfi ("Basis", "transaction"), _), t) => 135 | L.CApp ((L.CFfi ("Basis", "transaction"), _), t) =>
140 (L'.TFun ((L'.TRecord [], loc), mt env dtmap t), loc) 136 (L'.TFun ((L'.TRecord [], loc), mt env dtmap t), loc)
141 | L.CApp ((L.CFfi ("Basis", "source"), _), t) => 137 | L.CApp ((L.CFfi ("Basis", "source"), _), t) =>
142 (L'.TSource, loc) 138 (L'.TSource, loc)
2005 ((L'.ENextval e, loc), fm) 2001 ((L'.ENextval e, loc), fm)
2006 end 2002 end
2007 2003
2008 | L.EApp ( 2004 | L.EApp (
2009 (L.ECApp ( 2005 (L.ECApp (
2010 (L.ECApp ( 2006 (L.ECApp ((L.EFfi ("Basis", "cdata"), _), _), _),
2011 (L.ECApp ((L.EFfi ("Basis", "cdata"), _), _), _),
2012 _), _),
2013 _), _), 2007 _), _),
2014 se) => 2008 se) =>
2015 let 2009 let
2016 val (se, fm) = monoExp (env, st, fm) se 2010 val (se, fm) = monoExp (env, st, fm) se
2017 in 2011 in
2018 ((L'.EFfiApp ("Basis", "htmlifyString", [se]), loc), fm) 2012 ((L'.EFfiApp ("Basis", "htmlifyString", [se]), loc), fm)
2019 end 2013 end
2020 2014
2021 | L.ECApp ((L.ECApp ((L.EFfi ("Basis", "css_subset"), _), _), _), _) => 2015 | L.EApp (
2022 ((L'.ERecord [], loc), fm) 2016 (L.EApp (
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
2023 2034
2024 | L.EApp ( 2035 | L.EApp (
2025 (L.EApp ( 2036 (L.EApp (
2026 (L.EApp ( 2037 (L.EApp (
2027 (L.EApp ( 2038 (L.ECApp (
2028 (L.ECApp ( 2039 (L.ECApp (
2029 (L.ECApp ( 2040 (L.ECApp (
2030 (L.ECApp ( 2041 (L.ECApp (
2031 (L.ECApp ( 2042 (L.ECApp (
2032 (L.ECApp ( 2043 (L.ECApp (
2033 (L.ECApp ( 2044 (L.ECApp (
2034 (L.ECApp ( 2045 (L.ECApp (
2035 (L.EFfi ("Basis", "join"), 2046 (L.EFfi ("Basis", "tag"),
2036 _), _), _), 2047 _), _), _), _), _), _), _), _), _), _), _), _), _), _), _), _), _),
2037 _), _), 2048 attrs), _),
2038 _), _), 2049 tag), _),
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 _), _),
2077 xml) => 2050 xml) =>
2078 let 2051 let
2079 fun getTag' (e, _) = 2052 fun getTag' (e, _) =
2080 case e of 2053 case e of
2081 L.EFfi ("Basis", tag) => (tag, []) 2054 L.EFfi ("Basis", tag) => (tag, [])
2730 in 2703 in
2731 SOME (Env.pushENamed env x n t NONE s, 2704 SOME (Env.pushENamed env x n t NONE s,
2732 fm, 2705 fm,
2733 [(L'.DVal (x, n, t', e, s), loc)]) 2706 [(L'.DVal (x, n, t', e, s), loc)])
2734 end 2707 end
2735 | L.DStyle (x, n, (L.CRecord (_, xcs), _), s) => 2708 | L.DStyle (x, n, s) =>
2736 let 2709 let
2737 val xs = map (fn ((L.CName x, _), _) => x
2738 | (x, _) => (E.errorAt (#2 x) "Undetermined style component";
2739 Print.eprefaces' [("Name", CorePrint.p_con env x)];
2740 "")) xcs
2741
2742 val t = (L.CFfi ("Basis", "string"), loc) 2710 val t = (L.CFfi ("Basis", "string"), loc)
2743 val t' = (L'.TFfi ("Basis", "string"), loc) 2711 val t' = (L'.TFfi ("Basis", "string"), loc)
2744 val e = (L'.EPrim (Prim.String s), loc) 2712 val e = (L'.EPrim (Prim.String s), loc)
2745 in 2713 in
2746 SOME (Env.pushENamed env x n t NONE s, 2714 SOME (Env.pushENamed env x n t NONE s,
2747 fm, 2715 fm,
2748 [(L'.DStyle (s, xs), loc), 2716 [(L'.DStyle s, loc),
2749 (L'.DVal (x, n, t', e, s), loc)]) 2717 (L'.DVal (x, n, t', e, s), loc)])
2750 end 2718 end
2751 | L.DStyle _ => poly ()
2752 end 2719 end
2753 2720
2754 datatype expungable = Client | Channel 2721 datatype expungable = Client | Channel
2755 2722
2756 fun monoize env file = 2723 fun monoize env file =