Mercurial > urweb

comparison src/reduce.sml @ 1176:51e596feec37

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Tone down Reduce and compensate with a new push-lambda-inside-case rule in MonoOpt; expand more Basis synonyms in Monoize
author Adam Chlipala <adamc@hcoop.net>
date Tue, 02 Mar 2010 16:00:48 -0500
parents 85d194409b17
children c58453683bbb
comparison
equal deleted inserted replaced
1175:79f487f51d9f 1176:51e596feec37
325 325
326 fun exp env (all as (e, loc)) = 326 fun exp env (all as (e, loc)) =
327 let 327 let
328 (*val () = Print.prefaces "exp" [("e", CorePrint.p_exp CoreEnv.empty all), 328 (*val () = Print.prefaces "exp" [("e", CorePrint.p_exp CoreEnv.empty all),
329 ("env", Print.PD.string (e2s env))]*) 329 ("env", Print.PD.string (e2s env))]*)
330 val () = if dangling (edepth env) all then 330 (*val () = if dangling (edepth env) all then
331 (Print.prefaces "exp" [("e", CorePrint.p_exp CoreEnv.empty all), 331 (Print.prefaces "exp" [("e", CorePrint.p_exp CoreEnv.empty all),
332 ("env", Print.PD.string (e2s env))]; 332 ("env", Print.PD.string (e2s env))];
333 raise Fail "!") 333 raise Fail "!")
334 else 334 else
335 () 335 ()*)
336 336
337 val r = case e of 337 val r = case e of
338 EPrim _ => all 338 EPrim _ => all
339 | ERel n => 339 | ERel n =>
340 let 340 let
514 514
515 | _ => e 515 | _ => e
516 516
517 val e1 = exp env e1 517 val e1 = exp env e1
518 val e2 = exp env e2 518 val e2 = exp env e2
519 val e12 = reassoc (EApp (e1, e2), loc) 519 val e12 = (*reassoc*) (EApp (e1, e2), loc)
520 in 520 in
521 case #1 e12 of 521 case #1 e12 of
522 EApp ((EAbs (_, _, _, b), _), e2) => 522 EApp ((EAbs (_, _, _, b), _), e2) =>
523 exp (KnownE e2 :: env') b 523 exp (KnownE e2 :: env') b
524 | _ => e12 524 | _ => e12