diff options
| author |  Adam Chlipala <adamc@hcoop.net> | 2008-06-26 10:02:34 -0400 |
|---|---|---|
| committer | Adam Chlipala <adamc@hcoop.net> | 2008-06-26 10:02:34 -0400 |
| commit | 1d4b2683a02155a474d79436247d8a1d293237ae (patch) | |
| tree | 205f8600aad0b2c149e08318f0e6cf64a1b26a67 | |
| parent | f362668549c8db401474c7be1e15cd9e156d0e91 (diff) | |
Cjrize cfold
| -rw-r--r-- | src/reduce.sml | 9 | ||||
| -rw-r--r-- | tests/cfold.lac | 2 |
2 files changed, 10 insertions, 1 deletions
diff --git a/src/reduce.sml b/src/reduce.sml index 4c36268c..887bc0e2 100644 --- a/src/reduce.sml +++ b/src/reduce.sml @@ -121,7 +121,14 @@ fun kind k = k fun con env c = case c of - CApp ((CAbs (_, _, c1), loc), c2) => + CApp ((CApp ((CApp ((CFold ks, _), f), _), i), loc), (CRecord (k, xcs), _)) => + (case xcs of + [] => #1 i + | (n, v) :: rest => + #1 (reduceCon env (CApp ((CApp ((CApp (f, n), loc), v), loc), + (CApp ((CApp ((CApp ((CFold ks, loc), f), loc), i), loc), + (CRecord (k, rest), loc)), loc)), loc))) + | CApp ((CAbs (_, _, c1), loc), c2) => #1 (reduceCon env (subConInCon (0, c2) c1)) | CNamed n => (case E.lookupCNamed env n of diff --git a/tests/cfold.lac b/tests/cfold.lac index 5eda74e9..03f4b695 100644 --- a/tests/cfold.lac +++ b/tests/cfold.lac @@ -8,3 +8,5 @@ val redCurry : redCurry = fn x : int => fn y : string => {} con yellowCurry = currier [A = string, B = int, C = float] val yellowCurry : yellowCurry = fn x => fn y => fn z => {} + +val main = yellowCurry |