Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : master
http://hackage.haskell.org/trac/ghc/changeset/51ba3c27b88ba9bec175342d22e17fe0bfc547d2 >--------------------------------------------------------------- commit 51ba3c27b88ba9bec175342d22e17fe0bfc547d2 Author: Simon Peyton Jones <[email protected]> Date: Tue Jan 17 16:01:41 2012 +0000 Comments only (to support debug tracing in DmdAnal) >--------------------------------------------------------------- compiler/stranal/DmdAnal.lhs | 17 +++++++++++++---- 1 files changed, 13 insertions(+), 4 deletions(-) diff --git a/compiler/stranal/DmdAnal.lhs b/compiler/stranal/DmdAnal.lhs index 6147988..0bfd025 100644 --- a/compiler/stranal/DmdAnal.lhs +++ b/compiler/stranal/DmdAnal.lhs @@ -265,17 +265,26 @@ dmdAnal env dmd (Case scrut case_bndr ty [alt@(DataAlt dc, _, _)]) idDemandInfo case_bndr' (scrut_ty, scrut') = dmdAnal env scrut_dmd scrut + res_ty = alt_ty1 `bothType` scrut_ty in - (alt_ty1 `bothType` scrut_ty, Case scrut' case_bndr' ty [alt']) +-- pprTrace "dmdAnal:Case1" (vcat [ text "scrut" <+> ppr scrut +-- , text "scrut_ty" <+> ppr scrut_ty +-- , text "alt_ty" <+> ppr alt_ty1 +-- , text "res_ty" <+> ppr res_ty ]) $ + (res_ty, Case scrut' case_bndr' ty [alt']) dmdAnal env dmd (Case scrut case_bndr ty alts) = let (alt_tys, alts') = mapAndUnzip (dmdAnalAlt env dmd) alts (scrut_ty, scrut') = dmdAnal env evalDmd scrut (alt_ty, case_bndr') = annotateBndr (foldr1 lubType alt_tys) case_bndr + res_ty = alt_ty `bothType` scrut_ty in --- pprTrace "dmdAnal:Case" (ppr alts $$ ppr alt_tys) - (alt_ty `bothType` scrut_ty, Case scrut' case_bndr' ty alts') +-- pprTrace "dmdAnal:Case2" (vcat [ text "scrut" <+> ppr scrut +-- , text "scrut_ty" <+> ppr scrut_ty +-- , text "alt_ty" <+> ppr alt_ty +-- , text "res_ty" <+> ppr res_ty ]) $ + (res_ty, Case scrut' case_bndr' ty alts') dmdAnal env dmd (Let (NonRec id rhs) body) = let @@ -337,7 +346,7 @@ dmdAnalAlt env dmd (con,bndrs,rhs) -- other -> return () -- So the 'y' isn't necessarily going to be evaluated -- - -- A more complete example where this shows up is: + -- A more complete example (Trac #148, #1592) where this shows up is: -- do { let len = <expensive> ; -- ; when (...) (exitWith ExitSuccess) -- ; print len } _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
