summaryrefslogtreecommitdiff
path: root/src/reduce.sml
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2008-07-24 10:09:21 -0400
committerGravatar Adam Chlipala <adamc@hcoop.net>2008-07-24 10:09:21 -0400
commit9e860c86c7d9c763deb9d51490a6766d9c72ed25 (patch)
tree7ba7c7cada5e7afa00c3e46879eb9974849286cf /src/reduce.sml
parentf19ae3bb20fa0c60e737606949b2bec6e3ae04f9 (diff)
Record cut
Diffstat (limited to 'src/reduce.sml')
-rw-r--r--src/reduce.sml13
1 files changed, 13 insertions, 0 deletions
diff --git a/src/reduce.sml b/src/reduce.sml
index 5b00ac5a..ecb0777d 100644
--- a/src/reduce.sml
+++ b/src/reduce.sml
@@ -164,6 +164,19 @@ fun exp env e =
| _ => false) xes of
SOME (_, e, _) => #1 e
| NONE => e)
+ | ECut (r as (_, loc), _, {rest = (CRecord (k, xts), _), ...}) =>
+ let
+ fun fields (remaining, passed) =
+ case remaining of
+ [] => []
+ | (x, t) :: rest =>
+ (x,
+ (EField (r, x, {field = t,
+ rest = (CRecord (k, List.revAppend (passed, rest)), loc)}), loc),
+ t) :: fields (rest, (x, t) :: passed)
+ in
+ #1 (reduceExp env (ERecord (fields (xts, [])), loc))
+ end
| _ => e