comparison src/monoize.sml @ 140:f214c535d253

A simpler context encoding
author Adam Chlipala <adamc@hcoop.net>
date Sun, 20 Jul 2008 10:40:25 -0400
parents adfa2c7a75da
children 63c699450281
comparison
equal deleted inserted replaced
139:adfa2c7a75da 140:f214c535d253
149 (L.EApp ( 149 (L.EApp (
150 (L.ECApp ( 150 (L.ECApp (
151 (L.ECApp ( 151 (L.ECApp (
152 (L.ECApp ( 152 (L.ECApp (
153 (L.ECApp ( 153 (L.ECApp (
154 (L.ECApp ( 154 (L.EFfi ("Basis", "join"),
155 (L.ECApp (
156 (L.ECApp (
157 (L.EFfi ("Basis", "join"),
158 _), _), _), 155 _), _), _),
159 _), _),
160 _), _),
161 _), _),
162 _), _), 156 _), _),
163 _), _), 157 _), _),
164 _), _), 158 _), _),
165 xml1), _), 159 xml1), _),
166 xml2) => (L'.EStrcat (monoExp env xml1, monoExp env xml2), loc) 160 xml2) => (L'.EStrcat (monoExp env xml1, monoExp env xml2), loc)
180 _), _), _), _), _), _), _), _), _), _), _), _), _), _), _), _), _), 174 _), _), _), _), _), _), _), _), _), _), _), _), _), _), _), _), _),
181 attrs), _), 175 attrs), _),
182 tag), _), 176 tag), _),
183 xml) => 177 xml) =>
184 let 178 let
179 fun getTag' (e, _) =
180 case e of
181 L.EFfi ("Basis", tag) => tag
182 | L.ECApp (e, _) => getTag' e
183 | _ => (E.errorAt loc "Non-constant XML tag";
184 Print.eprefaces' [("Expression", CorePrint.p_exp env tag)];
185 "")
186
185 fun getTag (e, _) = 187 fun getTag (e, _) =
186 case e of 188 case e of
187 L.EFfi ("Basis", tag) => tag 189 L.EFfiApp ("Basis", tag, [(L.ERecord [], _)]) => tag
190 | L.EApp (e, (L.ERecord [], _)) => getTag' e
188 | _ => (E.errorAt loc "Non-constant XML tag"; 191 | _ => (E.errorAt loc "Non-constant XML tag";
189 Print.eprefaces' [("Expression", CorePrint.p_exp env tag)]; 192 Print.eprefaces' [("Expression", CorePrint.p_exp env tag)];
190 "") 193 "")
191 194
192 val tag = getTag tag 195 val tag = getTag tag