Mercurial > urweb
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 |