Mercurial > urweb

comparison src/mono_reduce.sml @ 975:8fe576c0bee9

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Quoting JavaScript working
author Adam Chlipala <adamc@hcoop.net>
date Tue, 22 Sep 2009 15:12:09 -0400
parents b03d48aac959
children 166ea3944b91
comparison
equal deleted inserted replaced
974:b851675a2c3d 975:8fe576c0bee9
280 ERel x' => if x = x' then n + 1 else n 280 ERel x' => if x = x' then n + 1 else n
281 | _ => n, 281 | _ => n,
282 bind = fn (n, b) => 282 bind = fn (n, b) =>
283 case b of 283 case b of
284 U.Exp.RelE _ => n + 1 284 U.Exp.RelE _ => n + 1
285 | _ => n} 0 0 285 | _ => n}
286
287 val freeInAbs = U.Exp.existsB {typ = fn _ => false,
288 exp = fn (n, e) =>
289 case e of
290 EAbs (_, _, _, b) => countFree n 0 b > 0
291 | EJavaScript (_, b) => countFree n 0 b > 0
292 | _ => false,
293 bind = fn (n, b) =>
294 case b of
295 U.Exp.RelE _ => n + 1
296 | _ => n} 0
286 297
287 fun reduce file = 298 fun reduce file =
288 let 299 let
289 val (timpures, impures, absCounts) = 300 val (timpures, impures, absCounts) =
290 foldl (fn ((d, _), (timpures, impures, absCounts)) => 301 foldl (fn ((d, _), (timpures, impures, absCounts)) =>
455 466
456 | EApp ((EAbs (x, t, _, e1), loc), e2) => 467 | EApp ((EAbs (x, t, _, e1), loc), e2) =>
457 ((*Print.prefaces "Considering" [("e1", MonoPrint.p_exp (E.pushERel env x t NONE) e1), 468 ((*Print.prefaces "Considering" [("e1", MonoPrint.p_exp (E.pushERel env x t NONE) e1),
458 ("e2", MonoPrint.p_exp env e2), 469 ("e2", MonoPrint.p_exp env e2),
459 ("sub", MonoPrint.p_exp env (reduceExp env (subExpInExp (0, e2) e1)))];*) 470 ("sub", MonoPrint.p_exp env (reduceExp env (subExpInExp (0, e2) e1)))];*)
460 if impure env e2 orelse countFree e1 > 1 then 471 if impure env e2 orelse countFree 0 0 e1 > 1 then
461 #1 (reduceExp env (ELet (x, t, e2, e1), loc)) 472 #1 (reduceExp env (ELet (x, t, e2, e1), loc))
462 else 473 else
463 #1 (reduceExp env (subExpInExp (0, e2) e1))) 474 #1 (reduceExp env (subExpInExp (0, e2) e1)))
464 475
465 | ECase (e', pes, {disc, result}) => 476 | ECase (e', pes, {disc, result}) =>
606 orelse (List.all (fn eff => eff <> Unsure) effs_e' 617 orelse (List.all (fn eff => eff <> Unsure) effs_e'
607 andalso verifyCompatible effs_b) 618 andalso verifyCompatible effs_b)
608 orelse (case effs_b of 619 orelse (case effs_b of
609 UseRel :: effs => List.all verifyUnused effs 620 UseRel :: effs => List.all verifyUnused effs
610 | _ => false)) 621 | _ => false))
611 andalso countFree b = 1 then 622 andalso countFree 0 0 b = 1
623 andalso not (freeInAbs b) then
612 trySub () 624 trySub ()
613 else 625 else
614 e 626 e
615 end 627 end
616 else 628 else