Mercurial > urweb

comparison src/mono_reduce.sml @ 442:9095a95a1bf9

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Don't inline case expressions
author Adam Chlipala <adamc@hcoop.net>
date Thu, 30 Oct 2008 15:39:06 -0400
parents ab3177746c78
children 1a4fa157fedd
comparison
equal deleted inserted replaced
441:c5335613f31e 442:9095a95a1bf9
349 349
350 | ELet (x, t, e, (EAbs (x', t' as (TRecord [], _), ran, e'), loc)) => 350 | ELet (x, t, e, (EAbs (x', t' as (TRecord [], _), ran, e'), loc)) =>
351 EAbs (x', t', ran, (ELet (x, t, liftExpInExp 0 e, swapExpVars 0 e'), loc)) 351 EAbs (x', t', ran, (ELet (x, t, liftExpInExp 0 e, swapExpVars 0 e'), loc))
352 352
353 | ELet (x, t, e', b) => 353 | ELet (x, t, e', b) =>
354 if impure e' then 354 let
355 let 355 fun trySub () =
356 val effs_e' = summarize 0 e' 356 case e' of
357 val effs_b = summarize 0 b 357 (ECase _, _) => e
358 358 | _ => #1 (reduceExp env (subExpInExp (0, e') b))
359 fun does eff = List.exists (fn eff' => eff' = eff) effs_e' 359 in
360 val writesPage = does WritePage 360 if impure e' then
361 val readsDb = does ReadDb 361 let
362 val writesDb = does WriteDb 362 val effs_e' = summarize 0 e'
363 363 val effs_b = summarize 0 b
364 fun verifyUnused eff = 364
365 case eff of 365 fun does eff = List.exists (fn eff' => eff' = eff) effs_e'
366 UseRel r => r <> 0 366 val writesPage = does WritePage
367 | Unsure => false 367 val readsDb = does ReadDb
368 | _ => true 368 val writesDb = does WriteDb
369 369
370 fun verifyCompatible effs = 370 fun verifyUnused eff =
371 case effs of
372 [] => false
373 | eff :: effs =>
374 case eff of 371 case eff of
375 Unsure => false 372 UseRel r => r <> 0
376 | UseRel r => 373 | Unsure => false
377 if r = 0 then 374 | _ => true
378 List.all verifyUnused effs 375
379 else 376 fun verifyCompatible effs =
380 verifyCompatible effs 377 case effs of
381 | WritePage => not writesPage andalso verifyCompatible effs 378 [] => false
382 | ReadDb => not writesDb andalso verifyCompatible effs 379 | eff :: effs =>
383 | WriteDb => not writesDb andalso not readsDb andalso verifyCompatible effs 380 case eff of
384 in 381 Unsure => false
385 (*Print.prefaces "verifyCompatible" 382 | UseRel r =>
386 [("e'", MonoPrint.p_exp env e'), 383 if r = 0 then
387 ("b", MonoPrint.p_exp (E.pushERel env x t NONE) b), 384 List.all verifyUnused effs
388 ("effs_e'", Print.p_list p_event effs_e'), 385 else
389 ("effs_b", Print.p_list p_event effs_b)];*) 386 verifyCompatible effs
390 if verifyCompatible effs_b then 387 | WritePage => not writesPage andalso verifyCompatible effs
391 #1 (reduceExp env (subExpInExp (0, e') b)) 388 | ReadDb => not writesDb andalso verifyCompatible effs
392 else 389 | WriteDb => not writesDb andalso not readsDb andalso verifyCompatible effs
393 e 390 in
394 end 391 (*Print.prefaces "verifyCompatible"
395 else 392 [("e'", MonoPrint.p_exp env e'),
396 #1 (reduceExp env (subExpInExp (0, e') b)) 393 ("b", MonoPrint.p_exp (E.pushERel env x t NONE) b),
394 ("effs_e'", Print.p_list p_event effs_e'),
395 ("effs_b", Print.p_list p_event effs_b)];*)
396 if verifyCompatible effs_b then
397 trySub ()
398 else
399 e
400 end
401 else
402 trySub ()
403 end
397 404
398 | EStrcat ((EPrim (Prim.String s1), _), (EPrim (Prim.String s2), _)) => 405 | EStrcat ((EPrim (Prim.String s1), _), (EPrim (Prim.String s2), _)) =>
399 EPrim (Prim.String (s1 ^ s2)) 406 EPrim (Prim.String (s1 ^ s2))
400 407
401 | _ => e 408 | _ => e