Mercurial > urweb
comparison src/reduce.sml @ 70:2e0f3b21fb85
Cjrize cfold
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Thu, 26 Jun 2008 10:02:34 -0400 |
parents | d3cc191cb25f |
children | 144d082b47ae |
comparison
equal
deleted
inserted
replaced
69:8e9920db39f2 | 70:2e0f3b21fb85 |
---|---|
119 | 119 |
120 fun kind k = k | 120 fun kind k = k |
121 | 121 |
122 fun con env c = | 122 fun con env c = |
123 case c of | 123 case c of |
124 CApp ((CAbs (_, _, c1), loc), c2) => | 124 CApp ((CApp ((CApp ((CFold ks, _), f), _), i), loc), (CRecord (k, xcs), _)) => |
125 (case xcs of | |
126 [] => #1 i | |
127 | (n, v) :: rest => | |
128 #1 (reduceCon env (CApp ((CApp ((CApp (f, n), loc), v), loc), | |
129 (CApp ((CApp ((CApp ((CFold ks, loc), f), loc), i), loc), | |
130 (CRecord (k, rest), loc)), loc)), loc))) | |
131 | CApp ((CAbs (_, _, c1), loc), c2) => | |
125 #1 (reduceCon env (subConInCon (0, c2) c1)) | 132 #1 (reduceCon env (subConInCon (0, c2) c1)) |
126 | CNamed n => | 133 | CNamed n => |
127 (case E.lookupCNamed env n of | 134 (case E.lookupCNamed env n of |
128 (_, _, SOME c') => #1 c' | 135 (_, _, SOME c') => #1 c' |
129 | _ => c) | 136 | _ => c) |