X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fstranal%2FDmdAnal.lhs;h=6dc0fb7118a3e24f43a2fdaaf049d073f6bf1340;hb=4fa65a12c1e4c4bcfd92ff30440a9e75d298e0b7;hp=c4453242ef5fb19873c1f3116d04ab60ac970144;hpb=73140a534a87c6b0504fd8f2877052a6bb6c4267;p=ghc-hetmet.git diff --git a/compiler/stranal/DmdAnal.lhs b/compiler/stranal/DmdAnal.lhs index c445324..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, @@ -45,7 +46,7 @@ import Var ( Var ) import VarEnv import TysWiredIn ( unboxedPairDataCon ) import TysPrim ( realWorldStatePrimTy ) -import LazyUniqFM ( plusUFM_C, addToUFM_Directly, lookupUFM_Directly, +import UniqFM ( plusUFM_C, addToUFM_Directly, lookupUFM_Directly, keysUFM, minusUFM, ufmToList, filterUFM ) import Type ( isUnLiftedType, coreEqType, splitTyConApp_maybe ) import Coercion ( coercionKind ) @@ -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 @@ -466,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