summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2008-11-26 15:03:45 -0500
committerGravatar Adam Chlipala <adamc@hcoop.net>2008-11-26 15:03:45 -0500
commit9d6ca0836f8b54c672449d1100da3d0d36e07611 (patch)
treec135bfa7e85deaa089dbb3fd679aabd696885f60 /src
parent879bb7d5c760d277348a4ab9f799143013680f08 (diff)
crud1 compiles with new Reduce
Diffstat (limited to 'src')
-rw-r--r--src/reduce.sml18
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