diff options
| author |  Adam Chlipala <adamc@hcoop.net> | 2008-07-20 10:40:25 -0400 |
|---|---|---|
| committer | Adam Chlipala <adamc@hcoop.net> | 2008-07-20 10:40:25 -0400 |
| commit | 0fe71710d474e4c93392ec9d2069ef36464fbfa0 (patch) | |
| tree | 4a158085273dfa721a1dcf645c70d5083aa52ebc /src/monoize.sml | |
| parent | d76bf83a5e8eb9a0b4e194f83cfadd8d55c00dfd (diff) | |
A simpler context encoding
Diffstat (limited to 'src/monoize.sml')
| -rw-r--r-- | src/monoize.sml | 19 |
1 files changed, 11 insertions, 8 deletions
diff --git a/src/monoize.sml b/src/monoize.sml index d35d9092..6b2974ee 100644 --- a/src/monoize.sml +++ b/src/monoize.sml @@ -151,14 +151,8 @@ fun monoExp env (all as (e, loc)) = (L.ECApp ( (L.ECApp ( (L.ECApp ( - (L.ECApp ( - (L.ECApp ( - (L.ECApp ( - (L.EFfi ("Basis", "join"), + (L.EFfi ("Basis", "join"), _), _), _), - _), _), - _), _), - _), _), _), _), _), _), _), _), @@ -182,9 +176,18 @@ fun monoExp env (all as (e, loc)) = tag), _), xml) => let - fun getTag (e, _) = + 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.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)]; "") |