Mercurial > urweb
diff src/elab_ops.sml @ 326:950320f33232
Crud list works
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Thu, 11 Sep 2008 18:32:41 -0400 |
parents | 1487c712eb12 |
children | 58f1260f293f |
line wrap: on
line diff
--- a/src/elab_ops.sml Thu Sep 11 17:41:52 2008 -0400 +++ b/src/elab_ops.sml Thu Sep 11 18:32:41 2008 -0400 @@ -98,36 +98,40 @@ ("sc", p_con env sc)];*) sc end - | CApp (c', i) => - (case #1 (hnormCon env c') of - CApp (c', f) => - (case #1 (hnormCon env c') of - CFold ks => - (case #1 (hnormCon env c2) of - CRecord (_, []) => hnormCon env i - | CRecord (k, (x, c) :: rest) => - hnormCon env - (CApp ((CApp ((CApp (f, x), loc), c), loc), + | c1' as CApp (c', i) => + let + fun default () = (CApp ((c1', loc), hnormCon env c2), loc) + in + case #1 (hnormCon env c') of + CApp (c', f) => + (case #1 (hnormCon env c') of + CFold ks => + (case #1 (hnormCon env c2) of + CRecord (_, []) => hnormCon env i + | CRecord (k, (x, c) :: rest) => + hnormCon env + (CApp ((CApp ((CApp (f, x), loc), c), loc), (CApp ((CApp ((CApp ((CFold ks, loc), f), loc), i), loc), - (CRecord (k, rest), loc)), loc)), loc) - | CConcat ((CRecord (k, (x, c) :: rest), _), rest') => - let - val rest'' = (CConcat ((CRecord (k, rest), loc), rest'), loc) + (CRecord (k, rest), loc)), loc)), loc) + | CConcat ((CRecord (k, (x, c) :: rest), _), rest') => + let + val rest'' = (CConcat ((CRecord (k, rest), loc), rest'), loc) - (*val ccc = (CApp ((CApp ((CApp (f, x), loc), c), loc), + (*val ccc = (CApp ((CApp ((CApp (f, x), loc), c), loc), + (CApp ((CApp ((CApp ((CFold ks, loc), f), loc), i), loc), + rest''), loc)), loc)*) + in + (*eprefaces "Red to" [("ccc", p_con env ccc), ("ccc'", p_con env (hnormCon env ccc))];*) + hnormCon env + (CApp ((CApp ((CApp (f, x), loc), c), loc), (CApp ((CApp ((CApp ((CFold ks, loc), f), loc), i), loc), - rest''), loc)), loc)*) - in - (*eprefaces "Red to" [("ccc", p_con env ccc), ("ccc'", p_con env (hnormCon env ccc))];*) - hnormCon env - (CApp ((CApp ((CApp (f, x), loc), c), loc), - (CApp ((CApp ((CApp ((CFold ks, loc), f), loc), i), loc), - rest''), loc)), loc) - end - | _ => cAll) - | _ => cAll) - | _ => cAll) - | _ => cAll) + rest''), loc)), loc) + end + | _ => default ()) + | _ => default ()) + | _ => default () + end + | c1' => (CApp ((c1', loc), hnormCon env c2), loc)) | CConcat (c1, c2) => (case (hnormCon env c1, hnormCon env c2) of