diff options
| author |  Adam Chlipala <adamc@hcoop.net> | 2008-11-26 15:03:45 -0500 |
|---|---|---|
| committer | Adam Chlipala <adamc@hcoop.net> | 2008-11-26 15:03:45 -0500 |
| commit | 9369eba308c112234336069f83720ef6067482e4 (patch) | |
| tree | c135bfa7e85deaa089dbb3fd679aabd696885f60 /src/reduce.sml | |
| parent | 4272bb95ff184b818f43253972d1bf6de0b4e47e (diff) | |
crud1 compiles with new Reduce
Diffstat (limited to 'src/reduce.sml')
| -rw-r--r-- | src/reduce.sml | 18 |
1 files changed, 16 insertions, 2 deletions
diff --git a/src/reduce.sml b/src/reduce.sml index 5b4d7a49..a08feb26 100644 --- a/src/reduce.sml +++ b/src/reduce.sml @@ -103,13 +103,13 @@ fun conAndExp (namedC, namedE) = 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 @@ fun conAndExp (namedC, namedE) = 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 |