diff options
author | Adam Chlipala <adamc@hcoop.net> | 2008-07-24 10:09:21 -0400 |
---|---|---|
committer | Adam Chlipala <adamc@hcoop.net> | 2008-07-24 10:09:21 -0400 |
commit | 9e860c86c7d9c763deb9d51490a6766d9c72ed25 (patch) | |
tree | 7ba7c7cada5e7afa00c3e46879eb9974849286cf /src/reduce.sml | |
parent | f19ae3bb20fa0c60e737606949b2bec6e3ae04f9 (diff) |
Record cut
Diffstat (limited to 'src/reduce.sml')
-rw-r--r-- | src/reduce.sml | 13 |
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 |