Mercurial > urweb
diff 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 |
line wrap: on
line diff
--- a/src/monoize.sml Sun Jul 20 10:11:16 2008 -0400 +++ b/src/monoize.sml Sun Jul 20 10:40:25 2008 -0400 @@ -151,14 +151,8 @@ (L.ECApp ( (L.ECApp ( (L.ECApp ( - (L.ECApp ( - (L.ECApp ( - (L.ECApp ( - (L.EFfi ("Basis", "join"), + (L.EFfi ("Basis", "join"), _), _), _), - _), _), - _), _), - _), _), _), _), _), _), _), _), @@ -182,9 +176,18 @@ tag), _), xml) => let + fun getTag' (e, _) = + case e of + L.EFfi ("Basis", tag) => tag + | L.ECApp (e, _) => getTag' e + | _ => (E.errorAt loc "Non-constant XML tag"; + Print.eprefaces' [("Expression", CorePrint.p_exp env tag)]; + "") + fun getTag (e, _) = case e of - L.EFfi ("Basis", tag) => tag + L.EFfiApp ("Basis", tag, [(L.ERecord [], _)]) => tag + | L.EApp (e, (L.ERecord [], _)) => getTag' e | _ => (E.errorAt loc "Non-constant XML tag"; Print.eprefaces' [("Expression", CorePrint.p_exp env tag)]; "")