X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fstranal%2FDmdAnal.lhs;h=6dc0fb7118a3e24f43a2fdaaf049d073f6bf1340;hb=7b45c46cbabe1288ea87bd9b94c57e010ed17e60;hp=198e80bacc1ed117785e768e7f604d704a917684;hpb=9bcd95bad83ee937c178970e8b729732e680fe1e;p=ghc-hetmet.git diff --git a/compiler/stranal/DmdAnal.lhs b/compiler/stranal/DmdAnal.lhs index 198e80b..6dc0fb7 100644 --- a/compiler/stranal/DmdAnal.lhs +++ b/compiler/stranal/DmdAnal.lhs @@ -25,10 +25,11 @@ 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, +import Id ( Id, idType, idInlineActivation, isDataConWorkId, isGlobalId, idArity, #ifdef OLD_STRICTNESS idDemandInfo, idStrictness, idCprInfo, idName, @@ -267,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' @@ -462,7 +463,7 @@ mkSigTy :: TopLevelFlag -> RecFlag -> Id -> CoreExpr -> DmdType -> (DmdEnv, Stri mkSigTy top_lvl rec_flag id rhs dmd_ty = mk_sig_ty never_inline thunk_cpr_ok rhs dmd_ty where - never_inline = isNeverActive (idInlinePragma id) + never_inline = isNeverActive (idInlineActivation id) maybe_id_dmd = idNewDemandInfo_maybe id -- Is Nothing the first time round @@ -747,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