Mercurial > urweb

changeset 511:6d6222e045b0

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
crud1 compiles with new Reduce
author Adam Chlipala <adamc@hcoop.net>
date Wed, 26 Nov 2008 15:03:45 -0500
parents c644ec94866d
children 40b19310ea9a
files src/reduce.sml
diffstat 1 files changed, 16 insertions(+), 2 deletions(-) [+]
line wrap: on
line diff
--- 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