Mercurial > urweb

comparison src/reduce.sml @ 623:588b9d16b00a

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Start of kind polymorphism, up to the point where demo/hello elaborates with updated Basis/Top
author Adam Chlipala <adamc@hcoop.net>
date Sun, 22 Feb 2009 16:10:25 -0500
parents 8998114760c1
children 230654093b51
comparison
equal deleted inserted replaced
622:d64533157f40 623:588b9d16b00a
212 val e = exp env e 212 val e = exp env e
213 val c = con env c 213 val c = con env c
214 in 214 in
215 case #1 e of 215 case #1 e of
216 ECAbs (_, _, b) => exp (KnownC c :: deKnown env) b 216 ECAbs (_, _, b) => exp (KnownC c :: deKnown env) b
217
218 | EApp ((EApp ((ECApp ((EFold _, _), _), _), f), _), i) =>
219 (case #1 c of
220 CRecord (_, []) => i
221 | CRecord (k, (nm, v) :: rest) =>
222 let
223 val rest = (CRecord (k, rest), loc)
224 in
225 exp (deKnown env)
226 (EApp ((ECApp ((ECApp ((ECApp (f, nm), loc), v), loc), rest), loc),
227 (ECApp (e, rest), loc)), loc)
228 end
229 | _ => (ECApp (e, c), loc))
230
231 | _ => (ECApp (e, c), loc) 217 | _ => (ECApp (e, c), loc)
232 end 218 end
233 219
234 | ECAbs (x, k, e) => (ECAbs (x, k, exp (UnknownC :: env) e), loc) 220 | ECAbs (x, k, e) => (ECAbs (x, k, exp (UnknownC :: env) e), loc)
235 221
332 else 318 else
333 default () 319 default ()
334 | _ => default () 320 | _ => default ()
335 end 321 end
336 322
337 | EFold _ => all
338
339 | ECase (e, pes, {disc, result}) => 323 | ECase (e, pes, {disc, result}) =>
340 let 324 let
341 fun patBinds (p, _) = 325 fun patBinds (p, _) =
342 case p of 326 case p of
343 PWild => 0 327 PWild => 0