X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fstranal%2FDmdAnal.lhs;h=41f574ab343eb2678299f05f99fa214ea8081d0b;hb=0df5099f0c2088e2ccbb5b8974a7eae4d77eaa1c;hp=2290b1cfd63a7cef8c953bdfb14a0819c4db02a5;hpb=2e06595241350a6548b6ab6430c65d6458f7c197;p=ghc-hetmet.git diff --git a/compiler/stranal/DmdAnal.lhs b/compiler/stranal/DmdAnal.lhs index 2290b1c..41f574a 100644 --- a/compiler/stranal/DmdAnal.lhs +++ b/compiler/stranal/DmdAnal.lhs @@ -25,7 +25,8 @@ import StaticFlags ( opt_MaxWorkerArgs ) import NewDemand -- All of it import CoreSyn import PprCore -import CoreUtils ( exprIsHNF, exprIsTrivial, exprArity ) +import CoreUtils ( exprIsHNF, exprIsTrivial ) +import CoreArity ( exprArity ) import DataCon ( dataConTyCon ) import TyCon ( isProductTyCon, isRecursiveTyCon ) import Id ( Id, idType, idInlinePragma, @@ -77,11 +78,7 @@ To think about dmdAnalPgm :: DynFlags -> [CoreBind] -> IO [CoreBind] dmdAnalPgm dflags binds = do { - showPass dflags "Demand analysis" ; let { binds_plus_dmds = do_prog binds } ; - - endPass dflags "Demand analysis" - Opt_D_dump_stranal binds_plus_dmds ; #ifdef OLD_STRICTNESS -- Only if OLD_STRICTNESS is on, because only then is the old -- strictness analyser run @@ -271,7 +268,7 @@ dmdAnal sigs dmd (Case scrut case_bndr ty [alt@(DataAlt dc,bndrs,rhs)]) -- The insight is, of course, that a demand on y is a demand on the -- scrutinee, so we need to `both` it with the scrut demand - alt_dmd = Eval (Prod [idNewDemandInfo b | b <- bndrs', isIdVar b]) + alt_dmd = Eval (Prod [idNewDemandInfo b | b <- bndrs', isId b]) scrut_dmd = alt_dmd `both` idNewDemandInfo case_bndr' @@ -751,7 +748,7 @@ annotateLamIdBndr :: DmdType -- Demand type of body annotateLamIdBndr dmd_ty@(DmdType fv ds res) id -- For lambdas we add the demand to the argument demands -- Only called for Ids - = ASSERT( isIdVar id ) + = ASSERT( isId id ) (DmdType fv' (hacked_dmd:ds) res, setIdNewDemandInfo id hacked_dmd) where (fv', dmd) = removeFV fv id res