# HG changeset patch # User Adam Chlipala # Date 1227729825 18000 # Node ID 6d6222e045b0edcfc57f612460c49c3d5f93e3a9 # Parent c644ec94866dc84ee663a9008ea2340e0434ade9 crud1 compiles with new Reduce diff -r c644ec94866d -r 6d6222e045b0 src/reduce.sml --- a/src/reduce.sml Wed Nov 26 14:51:52 2008 -0500 +++ b/src/reduce.sml Wed Nov 26 15:03:45 2008 -0500 @@ -103,13 +103,13 @@ CAbs (_, _, b) => con (KnownC c2 :: deKnown env) b - | CApp ((CApp (fold as (CFold _, _), f), _), i) => + | CApp ((CApp ((CFold _, _), f), _), i) => (case #1 c2 of CRecord (_, []) => i | CRecord (k, (x, c) :: rest) => con (deKnown env) (CApp ((CApp ((CApp (f, x), loc), c), loc), - (CApp ((CApp ((CApp (fold, f), loc), i), loc), + (CApp (c1, (CRecord (k, rest), loc)), loc)), loc) | _ => (CApp (c1, c2), loc)) @@ -215,6 +215,20 @@ in case #1 e of ECAbs (_, _, b) => exp (KnownC c :: deKnown env) b + + | EApp ((EApp ((ECApp ((EFold _, _), _), _), f), _), i) => + (case #1 c of + CRecord (_, []) => i + | CRecord (k, (nm, v) :: rest) => + let + val rest = (CRecord (k, rest), loc) + in + exp (deKnown env) + (EApp ((ECApp ((ECApp ((ECApp (f, nm), loc), v), loc), rest), loc), + (ECApp (e, rest), loc)), loc) + end + | _ => (ECApp (e, c), loc)) + | _ => (ECApp (e, c), loc) end