diff options
author | Sebastian Graf <sebastian.graf@kit.edu> | 2021-03-26 11:54:25 +0100 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2021-03-28 00:12:21 -0400 |
commit | b02c8ef768df33ef4845da2f15583cf143a4d0e2 (patch) | |
tree | 93cc9890baaf66d43818572e9d897687438a84c1 /compiler/GHC/Core | |
parent | f6960b188f4e66bb1c7b00d55a015fdd418614a7 (diff) | |
download | haskell-b02c8ef768df33ef4845da2f15583cf143a4d0e2.tar.gz |
Rename StrictSig to DmdSig (#19597)
In #19597, we also settled on the following renamings:
* `idStrictness` -> `idDmdSig`,
`strictnessInfo` -> `dmdSigInfo`,
`HsStrictness` -> `HsDmdSig`
* `idCprInfo` -> `idCprSig`,
`cprInfo` -> `cprSigInfo`,
`HsCpr` -> `HsCprSig`
Fixes #19597.
Diffstat (limited to 'compiler/GHC/Core')
-rw-r--r-- | compiler/GHC/Core/Lint.hs | 6 | ||||
-rw-r--r-- | compiler/GHC/Core/Make.hs | 10 | ||||
-rw-r--r-- | compiler/GHC/Core/Opt/Arity.hs | 8 | ||||
-rw-r--r-- | compiler/GHC/Core/Opt/CallArity.hs | 2 | ||||
-rw-r--r-- | compiler/GHC/Core/Opt/CprAnal.hs | 14 | ||||
-rw-r--r-- | compiler/GHC/Core/Opt/DmdAnal.hs | 46 | ||||
-rw-r--r-- | compiler/GHC/Core/Opt/OccurAnal.hs | 2 | ||||
-rw-r--r-- | compiler/GHC/Core/Opt/Pipeline.hs | 6 | ||||
-rw-r--r-- | compiler/GHC/Core/Opt/SetLevels.hs | 12 | ||||
-rw-r--r-- | compiler/GHC/Core/Opt/Simplify.hs | 20 | ||||
-rw-r--r-- | compiler/GHC/Core/Opt/Simplify/Utils.hs | 2 | ||||
-rw-r--r-- | compiler/GHC/Core/Opt/SpecConstr.hs | 12 | ||||
-rw-r--r-- | compiler/GHC/Core/Opt/WorkWrap.hs | 10 | ||||
-rw-r--r-- | compiler/GHC/Core/Ppr.hs | 6 | ||||
-rw-r--r-- | compiler/GHC/Core/Seq.hs | 6 | ||||
-rw-r--r-- | compiler/GHC/Core/SimpleOpt.hs | 6 | ||||
-rw-r--r-- | compiler/GHC/Core/Tidy.hs | 2 | ||||
-rw-r--r-- | compiler/GHC/Core/Unfold.hs | 2 | ||||
-rw-r--r-- | compiler/GHC/Core/Unfold/Make.hs | 4 |
19 files changed, 88 insertions, 88 deletions
diff --git a/compiler/GHC/Core/Lint.hs b/compiler/GHC/Core/Lint.hs index a3ea0bb1d3..078d8492ff 100644 --- a/compiler/GHC/Core/Lint.hs +++ b/compiler/GHC/Core/Lint.hs @@ -81,7 +81,7 @@ import GHC.Utils.Misc import GHC.Core.InstEnv ( instanceDFunId ) import GHC.Core.Coercion.Opt ( checkAxInstCo ) import GHC.Core.Opt.Arity ( typeArity ) -import GHC.Types.Demand ( splitStrictSig, isDeadEndDiv ) +import GHC.Types.Demand ( splitDmdSig, isDeadEndDiv ) import GHC.Types.TypeEnv import GHC.Unit.Module.ModGuts import GHC.Runtime.Context @@ -677,12 +677,12 @@ lintLetBind top_lvl rec_flag binder rhs rhs_ty ppr (length (typeArity (idType binder))) <> colon <+> ppr binder) - ; case splitStrictSig (idStrictness binder) of + ; case splitDmdSig (idDmdSig binder) of (demands, result_info) | isDeadEndDiv result_info -> checkL (demands `lengthAtLeast` idArity binder) (text "idArity" <+> ppr (idArity binder) <+> text "exceeds arity imposed by the strictness signature" <+> - ppr (idStrictness binder) <> colon <+> + ppr (idDmdSig binder) <> colon <+> ppr binder) _ -> return () diff --git a/compiler/GHC/Core/Make.hs b/compiler/GHC/Core/Make.hs index 60ae13bee7..3638b43c56 100644 --- a/compiler/GHC/Core/Make.hs +++ b/compiler/GHC/Core/Make.hs @@ -897,8 +897,8 @@ mkExceptionId :: Name -> Id mkExceptionId name = mkVanillaGlobalWithInfo name (mkSpecForAllTys [alphaTyVar] (mkTyVarTy alphaTyVar)) -- forall a . a - (vanillaIdInfo `setStrictnessInfo` mkClosedStrictSig [] botDiv - `setCprInfo` mkCprSig 0 botCpr + (vanillaIdInfo `setDmdSigInfo` mkClosedDmdSig [] botDiv + `setCprSigInfo` mkCprSig 0 botCpr `setArityInfo` 0 `setCafInfo` NoCafRefs) -- #15038 @@ -912,8 +912,8 @@ mkRuntimeErrorId :: Name -> Id mkRuntimeErrorId name = mkVanillaGlobalWithInfo name runtimeErrorTy bottoming_info where - bottoming_info = vanillaIdInfo `setStrictnessInfo` strict_sig - `setCprInfo` mkCprSig 1 botCpr + bottoming_info = vanillaIdInfo `setDmdSigInfo` strict_sig + `setCprSigInfo` mkCprSig 1 botCpr `setArityInfo` 1 -- Make arity and strictness agree @@ -926,7 +926,7 @@ mkRuntimeErrorId name -- any pc_bottoming_Id will itself have CafRefs, which bloats -- SRTs. - strict_sig = mkClosedStrictSig [evalDmd] botDiv + strict_sig = mkClosedDmdSig [evalDmd] botDiv runtimeErrorTy :: Type -- forall (rr :: RuntimeRep) (a :: rr). Addr# -> a diff --git a/compiler/GHC/Core/Opt/Arity.hs b/compiler/GHC/Core/Opt/Arity.hs index ec450ec245..36a2535c09 100644 --- a/compiler/GHC/Core/Opt/Arity.hs +++ b/compiler/GHC/Core/Opt/Arity.hs @@ -171,7 +171,7 @@ typeArity ty = [] --------------- -exprBotStrictness_maybe :: CoreExpr -> Maybe (Arity, StrictSig) +exprBotStrictness_maybe :: CoreExpr -> Maybe (Arity, DmdSig) -- A cheap and cheerful function that identifies bottoming functions -- and gives them a suitable strictness signatures. It's used during -- float-out @@ -180,7 +180,7 @@ exprBotStrictness_maybe e Nothing -> Nothing Just ar -> Just (ar, sig ar) where - sig ar = mkClosedStrictSig (replicate ar topDmd) botDiv + sig ar = mkClosedDmdSig (replicate ar topDmd) botDiv {- Note [exprArity invariant] @@ -1095,9 +1095,9 @@ environment mapping let-bound Ids to their ArityType. idArityType :: Id -> ArityType idArityType v - | strict_sig <- idStrictness v + | strict_sig <- idDmdSig v , not $ isTopSig strict_sig - , (ds, div) <- splitStrictSig strict_sig + , (ds, div) <- splitDmdSig strict_sig , let arity = length ds -- Every strictness signature admits an arity signature! = AT (take arity one_shots) div diff --git a/compiler/GHC/Core/Opt/CallArity.hs b/compiler/GHC/Core/Opt/CallArity.hs index f54962b7cd..53b5983758 100644 --- a/compiler/GHC/Core/Opt/CallArity.hs +++ b/compiler/GHC/Core/Opt/CallArity.hs @@ -706,7 +706,7 @@ trimArity v a = minimum [a, max_arity_by_type, max_arity_by_strsig] | isDeadEndDiv result_info = length demands | otherwise = a - (demands, result_info) = splitStrictSig (idStrictness v) + (demands, result_info) = splitDmdSig (idDmdSig v) --------------------------------------- -- Functions related to CallArityRes -- diff --git a/compiler/GHC/Core/Opt/CprAnal.hs b/compiler/GHC/Core/Opt/CprAnal.hs index be3fa73282..cd4c310b3a 100644 --- a/compiler/GHC/Core/Opt/CprAnal.hs +++ b/compiler/GHC/Core/Opt/CprAnal.hs @@ -114,7 +114,7 @@ cprAnalProgram logger dflags fam_envs binds = do let env = emptyAnalEnv fam_envs let binds_plus_cpr = snd $ mapAccumL cprAnalTopBind env binds dumpIfSet_dyn logger dflags Opt_D_dump_cpr_signatures "Cpr signatures" FormatText $ - dumpIdInfoOfProgram (ppr . cprInfo) binds_plus_cpr + dumpIdInfoOfProgram (ppr . cprSigInfo) binds_plus_cpr -- See Note [Stamp out space leaks in demand analysis] in GHC.Core.Opt.DmdAnal seqBinds binds_plus_cpr `seq` return binds_plus_cpr @@ -252,7 +252,7 @@ cprTransform env id = fst $ cprAnal env rhs -- Imported function or data con worker | isGlobalId id - = getCprSig (idCprInfo id) + = getCprSig (idCprSig id) | otherwise = topCprType @@ -274,11 +274,11 @@ cprFix top_lvl orig_env orig_pairs | otherwise = mkCprSig 0 botCpr -- See Note [Initialising strictness] in GHC.Core.Opt.DmdAnal orig_virgin = ae_virgin orig_env - init_pairs | orig_virgin = [(setIdCprInfo id (init_sig id rhs), rhs) | (id, rhs) <- orig_pairs ] + init_pairs | orig_virgin = [(setIdCprSig id (init_sig id rhs), rhs) | (id, rhs) <- orig_pairs ] | otherwise = orig_pairs init_env = extendSigEnvFromIds orig_env (map fst init_pairs) - -- The fixed-point varies the idCprInfo field of the binders and and their + -- The fixed-point varies the idCprSig field of the binders and and their -- entries in the AnalEnv, and terminates if that annotation does not change -- any more. loop :: Int -> AnalEnv -> [(Id,CoreExpr)] -> (AnalEnv, [(Id,CoreExpr)]) @@ -291,7 +291,7 @@ cprFix top_lvl orig_env orig_pairs (env', pairs') = step (applyWhen (n/=1) nonVirgin env) pairs -- Make sure we reset the virgin flag to what it was when we are stable reset_env' = env'{ ae_virgin = orig_virgin } - found_fixpoint = map (idCprInfo . fst) pairs' == map (idCprInfo . fst) pairs + found_fixpoint = map (idCprSig . fst) pairs' == map (idCprSig . fst) pairs step :: AnalEnv -> [(Id, CoreExpr)] -> (AnalEnv, [(Id, CoreExpr)]) step env pairs = mapAccumL go env pairs @@ -325,7 +325,7 @@ cprAnalBind top_lvl env id rhs | otherwise = rhs_ty -- See Note [Arity trimming for CPR signatures] sig = mkCprSigForArity (idArity id) rhs_ty' - id' = setIdCprInfo id sig + id' = setIdCprSig id sig env' = extendSigEnv env id sig -- See Note [CPR for thunks] @@ -452,7 +452,7 @@ extendSigEnvList env ids_cprs -- | Extend an environment with the CPR sigs attached to the ids extendSigEnvFromIds :: AnalEnv -> [Id] -> AnalEnv extendSigEnvFromIds env ids - = foldl' (\env id -> extendSigEnv env id (idCprInfo id)) env ids + = foldl' (\env id -> extendSigEnv env id (idCprSig id)) env ids -- | Extend an environment with the same CPR sig for all ids extendSigEnvAllSame :: AnalEnv -> [Id] -> CprSig -> AnalEnv diff --git a/compiler/GHC/Core/Opt/DmdAnal.hs b/compiler/GHC/Core/Opt/DmdAnal.hs index eedc9b4489..d1bbc232c7 100644 --- a/compiler/GHC/Core/Opt/DmdAnal.hs +++ b/compiler/GHC/Core/Opt/DmdAnal.hs @@ -220,7 +220,7 @@ position. -- -- It calls a function that knows how to analyse this \"body\" given -- an 'AnalEnv' with updated demand signatures for the binding group --- (reflecting their 'idStrictnessInfo') and expects to receive a +-- (reflecting their 'idDmdSigInfo') and expects to receive a -- 'DmdType' in return, which it uses to annotate the binding group with their -- 'idDemandInfo'. dmdAnalBind @@ -701,11 +701,11 @@ dmdTransform env var dmd -- See #18429 for some perf measurements. | Just _ <- isClassOpId_maybe var = -- pprTrace "dmdTransform:DictSel" (ppr var $$ ppr dmd) $ - dmdTransformDictSelSig (idStrictness var) dmd + dmdTransformDictSelSig (idDmdSig var) dmd -- Imported functions | isGlobalId var - , let res = dmdTransformSig (idStrictness var) dmd - = -- pprTrace "dmdTransform:import" (vcat [ppr var, ppr (idStrictness var), ppr dmd, ppr res]) + , let res = dmdTransformSig (idDmdSig var) dmd + = -- pprTrace "dmdTransform:import" (vcat [ppr var, ppr (idDmdSig var), ppr dmd, ppr res]) res -- Top-level or local let-bound thing for which we use LetDown ('useLetUp'). -- In that case, we have a strictness signature to unleash in our AnalEnv. @@ -772,9 +772,9 @@ dmdAnalRhsSig top_lvl rec_flag env let_dmd id rhs (rhs_dmd_ty, rhs') = dmdAnal env rhs_dmd rhs DmdType rhs_fv rhs_dmds rhs_div = rhs_dmd_ty - sig = mkStrictSigForArity rhs_arity (DmdType sig_fv rhs_dmds rhs_div) + sig = mkDmdSigForArity rhs_arity (DmdType sig_fv rhs_dmds rhs_div) - id' = id `setIdStrictness` sig + id' = id `setIdDmdSig` sig env' = extendAnalEnv top_lvl env id' sig -- See Note [Aggregated demand for cardinality] @@ -901,7 +901,7 @@ trivial RHS (see Note [Demand analysis for trivial right-hand sides]). Because idArity of a function varies independently of its cardinality properties (cf. Note [idArity varies independently of dmdTypeDepth]), we implicitly encode the arity for when a demand signature is sound to unleash -in its 'dmdTypeDepth' (cf. Note [Understanding DmdType and StrictSig] in +in its 'dmdTypeDepth' (cf. Note [Understanding DmdType and DmdSig] in GHC.Types.Demand). It is unsound to unleash a demand signature when the incoming number of arguments is less than that. See Note [What are demand signatures?] in GHC.Types.Demand for more details @@ -950,7 +950,7 @@ reset or decrease arity. That's an unnecessary dependency, because * idArity is analysis information itself, thus volatile * We already *have* dmdTypeDepth, wo why not just use it to encode the threshold for when to unleash the signature - (cf. Note [Understanding DmdType and StrictSig] in GHC.Types.Demand) + (cf. Note [Understanding DmdType and DmdSig] in GHC.Types.Demand) Consider the following expression, for example: @@ -1062,23 +1062,23 @@ dmdFix top_lvl env let_dmd orig_pairs = loop 1 initial_pairs where -- See Note [Initialising strictness] - initial_pairs | ae_virgin env = [(setIdStrictness id botSig, rhs) | (id, rhs) <- orig_pairs ] + initial_pairs | ae_virgin env = [(setIdDmdSig id botSig, rhs) | (id, rhs) <- orig_pairs ] | otherwise = orig_pairs -- If fixed-point iteration does not yield a result we use this instead -- See Note [Safe abortion in the fixed-point iteration] abort :: (AnalEnv, DmdEnv, [(Id,CoreExpr)]) abort = (env, lazy_fv', zapped_pairs) - where (lazy_fv, pairs') = step True (zapIdStrictness orig_pairs) + where (lazy_fv, pairs') = step True (zapIdDmdSig orig_pairs) -- Note [Lazy and unleashable free variables] - non_lazy_fvs = plusVarEnvList $ map (strictSigDmdEnv . idStrictness . fst) pairs' + non_lazy_fvs = plusVarEnvList $ map (dmdSigDmdEnv . idDmdSig . fst) pairs' lazy_fv' = lazy_fv `plusVarEnv` mapVarEnv (const topDmd) non_lazy_fvs - zapped_pairs = zapIdStrictness pairs' + zapped_pairs = zapIdDmdSig pairs' - -- The fixed-point varies the idStrictness field of the binders, and terminates if that + -- The fixed-point varies the idDmdSig field of the binders, and terminates if that -- annotation does not change any more. loop :: Int -> [(Id,CoreExpr)] -> (AnalEnv, DmdEnv, [(Id,CoreExpr)]) - loop n pairs = -- pprTrace "dmdFix" (ppr n <+> vcat [ ppr id <+> ppr (idStrictness id) + loop n pairs = -- pprTrace "dmdFix" (ppr n <+> vcat [ ppr id <+> ppr (idDmdSig id) -- | (id,_)<- pairs]) $ loop' n pairs @@ -1087,7 +1087,7 @@ dmdFix top_lvl env let_dmd orig_pairs | n == 10 = abort | otherwise = loop (n+1) pairs' where - found_fixpoint = map (idStrictness . fst) pairs' == map (idStrictness . fst) pairs + found_fixpoint = map (idDmdSig . fst) pairs' == map (idDmdSig . fst) pairs first_round = n == 1 (lazy_fv, pairs') = step first_round pairs final_anal_env = extendAnalEnvs top_lvl env (map fst pairs') @@ -1107,14 +1107,14 @@ dmdFix top_lvl env let_dmd orig_pairs -- so this can significantly reduce the number of iterations needed my_downRhs (env, lazy_fv) (id,rhs) - = -- pprTrace "my_downRhs" (ppr id $$ ppr (idStrictness id) $$ ppr sig) $ + = -- pprTrace "my_downRhs" (ppr id $$ ppr (idDmdSig id) $$ ppr sig) $ ((env', lazy_fv'), (id', rhs')) where (env', lazy_fv1, id', rhs') = dmdAnalRhsSig top_lvl Recursive env let_dmd id rhs lazy_fv' = plusVarEnv_C plusDmd lazy_fv lazy_fv1 - zapIdStrictness :: [(Id, CoreExpr)] -> [(Id, CoreExpr)] - zapIdStrictness pairs = [(setIdStrictness id nopSig, rhs) | (id, rhs) <- pairs ] + zapIdDmdSig :: [(Id, CoreExpr)] -> [(Id, CoreExpr)] + zapIdDmdSig pairs = [(setIdDmdSig id nopSig, rhs) | (id, rhs) <- pairs ] {- Note [Safe abortion in the fixed-point iteration] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1379,7 +1379,7 @@ data AnalEnv = AE -- The DmdEnv gives the demand on the free vars of the function -- when it is given enough args to satisfy the strictness signature -type SigEnv = VarEnv (StrictSig, TopLevelFlag) +type SigEnv = VarEnv (DmdSig, TopLevelFlag) instance Outputable AnalEnv where ppr env = text "AE" <+> braces (vcat @@ -1406,16 +1406,16 @@ extendAnalEnvs top_lvl env vars extendSigEnvs :: TopLevelFlag -> SigEnv -> [Id] -> SigEnv extendSigEnvs top_lvl sigs vars - = extendVarEnvList sigs [ (var, (idStrictness var, top_lvl)) | var <- vars] + = extendVarEnvList sigs [ (var, (idDmdSig var, top_lvl)) | var <- vars] -extendAnalEnv :: TopLevelFlag -> AnalEnv -> Id -> StrictSig -> AnalEnv +extendAnalEnv :: TopLevelFlag -> AnalEnv -> Id -> DmdSig -> AnalEnv extendAnalEnv top_lvl env var sig = env { ae_sigs = extendSigEnv top_lvl (ae_sigs env) var sig } -extendSigEnv :: TopLevelFlag -> SigEnv -> Id -> StrictSig -> SigEnv +extendSigEnv :: TopLevelFlag -> SigEnv -> Id -> DmdSig -> SigEnv extendSigEnv top_lvl sigs var sig = extendVarEnv sigs var (sig, top_lvl) -lookupSigEnv :: AnalEnv -> Id -> Maybe (StrictSig, TopLevelFlag) +lookupSigEnv :: AnalEnv -> Id -> Maybe (DmdSig, TopLevelFlag) lookupSigEnv env id = lookupVarEnv (ae_sigs env) id nonVirgin :: AnalEnv -> AnalEnv diff --git a/compiler/GHC/Core/Opt/OccurAnal.hs b/compiler/GHC/Core/Opt/OccurAnal.hs index 3861b3e462..83c44dcec2 100644 --- a/compiler/GHC/Core/Opt/OccurAnal.hs +++ b/compiler/GHC/Core/Opt/OccurAnal.hs @@ -2110,7 +2110,7 @@ occAnalApp env (Var fun_id, args, ticks) -- See Note [CONLIKE pragma] in GHC.Types.Basic -- The definition of is_exp should match that in GHC.Core.Opt.Simplify.prepareRhs - one_shots = argsOneShots (idStrictness fun_id) guaranteed_val_args + one_shots = argsOneShots (idDmdSig fun_id) guaranteed_val_args guaranteed_val_args = n_val_args + length (takeWhile isOneShotInfo (occ_one_shots env)) -- See Note [Sources of one-shot information], bullet point A'] diff --git a/compiler/GHC/Core/Opt/Pipeline.hs b/compiler/GHC/Core/Opt/Pipeline.hs index d3dcfb3263..2334436d69 100644 --- a/compiler/GHC/Core/Opt/Pipeline.hs +++ b/compiler/GHC/Core/Opt/Pipeline.hs @@ -1096,8 +1096,8 @@ transferIdInfo exported_id local_id , local_id `setInlinePragma` defaultInlinePragma ) where local_info = idInfo local_id - transfer exp_info = exp_info `setStrictnessInfo` strictnessInfo local_info - `setCprInfo` cprInfo local_info + transfer exp_info = exp_info `setDmdSigInfo` dmdSigInfo local_info + `setCprSigInfo` cprSigInfo local_info `setUnfoldingInfo` unfoldingInfo local_info `setInlinePragInfo` inlinePragInfo local_info `setRuleInfo` addRuleInfo (ruleInfo exp_info) new_info @@ -1115,6 +1115,6 @@ dmdAnal logger dflags fam_envs rules binds = do } binds_plus_dmds = dmdAnalProgram opts fam_envs rules binds Logger.dumpIfSet_dyn logger dflags Opt_D_dump_str_signatures "Strictness signatures" FormatText $ - dumpIdInfoOfProgram (ppr . zapDmdEnvSig . strictnessInfo) binds_plus_dmds + dumpIdInfoOfProgram (ppr . zapDmdEnvSig . dmdSigInfo) binds_plus_dmds -- See Note [Stamp out space leaks in demand analysis] in GHC.Core.Opt.DmdAnal seqBinds binds_plus_dmds `seq` return binds_plus_dmds diff --git a/compiler/GHC/Core/Opt/SetLevels.hs b/compiler/GHC/Core/Opt/SetLevels.hs index 2ea0c8606d..e18c7d3e82 100644 --- a/compiler/GHC/Core/Opt/SetLevels.hs +++ b/compiler/GHC/Core/Opt/SetLevels.hs @@ -103,7 +103,7 @@ import GHC.Types.Unique.Set ( nonDetStrictFoldUniqSet ) import GHC.Types.Unique.DSet ( getUniqDSet ) import GHC.Types.Var.Env import GHC.Types.Literal ( litIsTrivial ) -import GHC.Types.Demand ( StrictSig, Demand, isStrUsedDmd, splitStrictSig, prependArgsStrictSig ) +import GHC.Types.Demand ( DmdSig, Demand, isStrUsedDmd, splitDmdSig, prependArgsDmdSig ) import GHC.Types.Cpr ( mkCprSig, botCpr ) import GHC.Types.Name ( getOccName, mkSystemVarName ) import GHC.Types.Name.Occurrence ( occNameString ) @@ -446,7 +446,7 @@ lvlApp env orig_expr ((_,AnnVar fn), args) arity = idArity fn stricts :: [Demand] -- True for strict /value/ arguments - stricts = case splitStrictSig (idStrictness fn) of + stricts = case splitDmdSig (idDmdSig fn) of (arg_ds, _) | arg_ds `lengthExceeds` n_val_args -> [] | otherwise @@ -822,7 +822,7 @@ Exammples: t = f (g True) If f is lazy, we /do/ float (g True) because then we can allocate the thunk statically rather than dynamically. But if f is strict - we don't (see the use of idStrictness in lvlApp). It's not clear + we don't (see the use of idDmdSig in lvlApp). It's not clear if this test is worth the bother: it's only about CAFs! It's controlled by a flag (floatConsts), because doing this too @@ -1024,7 +1024,7 @@ answer. -} -annotateBotStr :: Id -> Arity -> Maybe (Arity, StrictSig) -> Id +annotateBotStr :: Id -> Arity -> Maybe (Arity, DmdSig) -> Id -- See Note [Bottoming floats] for why we want to add -- bottoming information right now -- @@ -1033,8 +1033,8 @@ annotateBotStr id n_extra mb_str = case mb_str of Nothing -> id Just (arity, sig) -> id `setIdArity` (arity + n_extra) - `setIdStrictness` (prependArgsStrictSig n_extra sig) - `setIdCprInfo` mkCprSig (arity + n_extra) botCpr + `setIdDmdSig` (prependArgsDmdSig n_extra sig) + `setIdCprSig` mkCprSig (arity + n_extra) botCpr notWorthFloating :: CoreExpr -> [Var] -> Bool -- Returns True if the expression would be replaced by diff --git a/compiler/GHC/Core/Opt/Simplify.hs b/compiler/GHC/Core/Opt/Simplify.hs index 701573a55d..5daa7fc157 100644 --- a/compiler/GHC/Core/Opt/Simplify.hs +++ b/compiler/GHC/Core/Opt/Simplify.hs @@ -42,8 +42,8 @@ import GHC.Core.Opt.Monad ( Tick(..), SimplMode(..) ) import GHC.Core import GHC.Builtin.Types.Prim( realWorldStatePrimTy ) import GHC.Builtin.Names( runRWKey ) -import GHC.Types.Demand ( StrictSig(..), Demand, dmdTypeDepth, isStrUsedDmd - , mkClosedStrictSig, topDmd, seqDmd, isDeadEndDiv ) +import GHC.Types.Demand ( DmdSig(..), Demand, dmdTypeDepth, isStrUsedDmd + , mkClosedDmdSig, topDmd, seqDmd, isDeadEndDiv ) import GHC.Types.Cpr ( mkCprSig, botCpr ) import GHC.Core.Ppr ( pprCoreExpr ) import GHC.Types.Unique ( hasKey ) @@ -579,8 +579,8 @@ prepareBinding env top_lvl old_bndr bndr rhs ; return (floats, bndr, rhs') } where info = idInfo bndr - worker_info = vanillaIdInfo `setStrictnessInfo` strictnessInfo info - `setCprInfo` cprInfo info + worker_info = vanillaIdInfo `setDmdSigInfo` dmdSigInfo info + `setCprSigInfo` cprSigInfo info `setDemandInfo` demandInfo info `setInlinePragInfo` inlinePragInfo info `setArityInfo` arityInfo info @@ -852,18 +852,18 @@ addLetBndrInfo new_bndr new_arity_type new_unf -- eta-expansion *reduces* the arity of the binding to less -- than that of the strictness sig. This can happen: see Note [Arity decrease]. info3 | isEvaldUnfolding new_unf - || (case strictnessInfo info2 of - StrictSig dmd_ty -> new_arity < dmdTypeDepth dmd_ty) + || (case dmdSigInfo info2 of + DmdSig dmd_ty -> new_arity < dmdTypeDepth dmd_ty) = zapDemandInfo info2 `orElse` info2 | otherwise = info2 -- Bottoming bindings: see Note [Bottoming bindings] - info4 | isDeadEndDiv div = info3 `setStrictnessInfo` bot_sig - `setCprInfo` bot_cpr + info4 | isDeadEndDiv div = info3 `setDmdSigInfo` bot_sig + `setCprSigInfo` bot_cpr | otherwise = info3 - bot_sig = mkClosedStrictSig (replicate new_arity topDmd) div + bot_sig = mkClosedDmdSig (replicate new_arity topDmd) div bot_cpr = mkCprSig new_arity botCpr -- Zap call arity info. We have used it by now (via @@ -1281,7 +1281,7 @@ simplTick env tickish expr cont -- do { let (inc,outc) = splitCont cont -- ; (env', expr') <- simplExprF (zapFloats env) expr inc -- ; let tickish' = simplTickish env tickish --- ; let wrap_float (b,rhs) = (zapIdStrictness (setIdArity b 0), +-- ; let wrap_float (b,rhs) = (zapIdDmdSig (setIdArity b 0), -- mkTick (mkNoCount tickish') rhs) -- -- when wrapping a float with mkTick, we better zap the Id's -- -- strictness info and arity, because it might be wrong now. diff --git a/compiler/GHC/Core/Opt/Simplify/Utils.hs b/compiler/GHC/Core/Opt/Simplify/Utils.hs index a14e8b24a9..7b22c7881d 100644 --- a/compiler/GHC/Core/Opt/Simplify/Utils.hs +++ b/compiler/GHC/Core/Opt/Simplify/Utils.hs @@ -547,7 +547,7 @@ mkArgInfo env fun rules n_val_args call_cont = vanilla_dmds -- See Note [Do not expose strictness if sm_inline=False] | otherwise = -- add_type_str fun_ty $ - case splitStrictSig (idStrictness fun) of + case splitDmdSig (idDmdSig fun) of (demands, result_info) | not (demands `lengthExceeds` n_val_args) -> -- Enough args, use the strictness given. diff --git a/compiler/GHC/Core/Opt/SpecConstr.hs b/compiler/GHC/Core/Opt/SpecConstr.hs index 4beed6d061..db4701d45a 100644 --- a/compiler/GHC/Core/Opt/SpecConstr.hs +++ b/compiler/GHC/Core/Opt/SpecConstr.hs @@ -1716,7 +1716,7 @@ spec_one env fn arg_bndrs body (call_pat@(qvars, pats), rule_number) -- Usual w/w hack to avoid generating -- a spec_rhs of unlifted type and no args - spec_lam_args_str = handOutStrictnessInformation (fst (splitStrictSig spec_str)) spec_lam_args + spec_lam_args_str = handOutStrictnessInformation (fst (splitDmdSig spec_str)) spec_lam_args -- Annotate the variables with the strictness information from -- the function (see Note [Strictness information in worker binders]) @@ -1725,8 +1725,8 @@ spec_one env fn arg_bndrs body (call_pat@(qvars, pats), rule_number) spec_id = mkLocalId spec_name Many (mkLamTypes spec_lam_args body_ty) -- See Note [Transfer strictness] - `setIdStrictness` spec_str - `setIdCprInfo` topCprSig + `setIdDmdSig` spec_str + `setIdCprSig` topCprSig `setIdArity` count isId spec_lam_args `asJoinId_maybe` spec_join_arity spec_str = calcSpecStrictness fn spec_lam_args pats @@ -1757,13 +1757,13 @@ handOutStrictnessInformation = go calcSpecStrictness :: Id -- The original function -> [Var] -> [CoreExpr] -- Call pattern - -> StrictSig -- Strictness of specialised thing + -> DmdSig -- Strictness of specialised thing -- See Note [Transfer strictness] calcSpecStrictness fn qvars pats - = mkClosedStrictSig spec_dmds div + = mkClosedDmdSig spec_dmds div where spec_dmds = [ lookupVarEnv dmd_env qv `orElse` topDmd | qv <- qvars, isId qv ] - StrictSig (DmdType _ dmds div) = idStrictness fn + DmdSig (DmdType _ dmds div) = idDmdSig fn dmd_env = go emptyVarEnv dmds pats diff --git a/compiler/GHC/Core/Opt/WorkWrap.hs b/compiler/GHC/Core/Opt/WorkWrap.hs index 030cb2ac8a..2ee334b9f8 100644 --- a/compiler/GHC/Core/Opt/WorkWrap.hs +++ b/compiler/GHC/Core/Opt/WorkWrap.hs @@ -511,9 +511,9 @@ tryWW dflags fam_envs is_rec fn_id rhs where uf_opts = unfoldingOpts dflags fn_info = idInfo fn_id - (wrap_dmds, div) = splitStrictSig (strictnessInfo fn_info) + (wrap_dmds, div) = splitDmdSig (dmdSigInfo fn_info) - cpr_ty = getCprSig (cprInfo fn_info) + cpr_ty = getCprSig (cprSigInfo fn_info) -- Arity of the CPR sig should match idArity when it's not a join point. -- See Note [Arity trimming for CPR signatures] in GHC.Core.Opt.CprAnal cpr = ASSERT2( isJoinId fn_id || cpr_ty == topCprType || ct_arty cpr_ty == arityInfo fn_info @@ -584,7 +584,7 @@ divergence, it's also broken for newtypes: where co :: (Int -> Int -> Char) ~ T -Then idArity is 2 (despite the type T), and it can have a StrictSig based on a +Then idArity is 2 (despite the type T), and it can have a DmdSig based on a threshold of 2. But we can't w/w it without a type error. The situation is less grave for PAPs, but the implicit eta expansion caused a @@ -679,11 +679,11 @@ mkWWBindPair dflags fn_id fn_info arity rhs work_uniq div cpr `setIdUnfolding` mkWorkerUnfolding simpl_opts work_fn fn_unfolding -- See Note [Worker-wrapper for INLINABLE functions] - `setIdStrictness` mkClosedStrictSig work_demands div + `setIdDmdSig` mkClosedDmdSig work_demands div -- Even though we may not be at top level, -- it's ok to give it an empty DmdEnv - `setIdCprInfo` mkCprSig work_arity work_cpr_info + `setIdCprSig` mkCprSig work_arity work_cpr_info `setIdDemandInfo` worker_demand diff --git a/compiler/GHC/Core/Ppr.hs b/compiler/GHC/Core/Ppr.hs index a55b545b0a..fd183fba20 100644 --- a/compiler/GHC/Core/Ppr.hs +++ b/compiler/GHC/Core/Ppr.hs @@ -508,7 +508,7 @@ instance Outputable IdInfo where caf_info = cafInfo info has_caf_info = not (mayHaveCafRefs caf_info) - str_info = strictnessInfo info + str_info = dmdSigInfo info has_str_info = not (isTopSig str_info) unf_info = unfoldingInfo info @@ -552,10 +552,10 @@ ppIdInfo id info caf_info = cafInfo info has_caf_info = not (mayHaveCafRefs caf_info) - str_info = strictnessInfo info + str_info = dmdSigInfo info has_str_info = not (isTopSig str_info) - cpr_info = cprInfo info + cpr_info = cprSigInfo info has_cpr_info = cpr_info /= topCprSig unf_info = unfoldingInfo info diff --git a/compiler/GHC/Core/Seq.hs b/compiler/GHC/Core/Seq.hs index 6dfbfef768..129b87f932 100644 --- a/compiler/GHC/Core/Seq.hs +++ b/compiler/GHC/Core/Seq.hs @@ -14,7 +14,7 @@ import GHC.Prelude import GHC.Core import GHC.Types.Id.Info -import GHC.Types.Demand( seqDemand, seqStrictSig ) +import GHC.Types.Demand( seqDemand, seqDmdSig ) import GHC.Types.Cpr( seqCprSig ) import GHC.Types.Basic( seqOccInfo ) import GHC.Types.Tickish @@ -35,8 +35,8 @@ megaSeqIdInfo info -- seqUnfolding (unfoldingInfo info) `seq` seqDemand (demandInfo info) `seq` - seqStrictSig (strictnessInfo info) `seq` - seqCprSig (cprInfo info) `seq` + seqDmdSig (dmdSigInfo info) `seq` + seqCprSig (cprSigInfo info) `seq` seqCaf (cafInfo info) `seq` seqOneShot (oneShotInfo info) `seq` seqOccInfo (occInfo info) diff --git a/compiler/GHC/Core/SimpleOpt.hs b/compiler/GHC/Core/SimpleOpt.hs index 90cd3f039e..9e3e92d247 100644 --- a/compiler/GHC/Core/SimpleOpt.hs +++ b/compiler/GHC/Core/SimpleOpt.hs @@ -40,7 +40,7 @@ import GHC.Types.Var ( isNonCoVarId ) import GHC.Types.Var.Set import GHC.Types.Var.Env import GHC.Core.DataCon -import GHC.Types.Demand( etaConvertStrictSig ) +import GHC.Types.Demand( etaConvertDmdSig ) import GHC.Types.Tickish import GHC.Core.Coercion.Opt ( optCoercion, OptCoercionOpts (..) ) import GHC.Core.Type hiding ( substTy, extendTvSubst, extendCvSubst, extendTvSubstList @@ -828,10 +828,10 @@ joinPointBinding_maybe bndr rhs | AlwaysTailCalled join_arity <- tailCallInfo (idOccInfo bndr) , (bndrs, body) <- etaExpandToJoinPoint join_arity rhs - , let str_sig = idStrictness bndr + , let str_sig = idDmdSig bndr str_arity = count isId bndrs -- Strictness demands are for Ids only join_bndr = bndr `asJoinId` join_arity - `setIdStrictness` etaConvertStrictSig str_arity str_sig + `setIdDmdSig` etaConvertDmdSig str_arity str_sig = Just (join_bndr, mkLams bndrs body) | otherwise diff --git a/compiler/GHC/Core/Tidy.hs b/compiler/GHC/Core/Tidy.hs index 61f98e20a4..2cb8eb5471 100644 --- a/compiler/GHC/Core/Tidy.hs +++ b/compiler/GHC/Core/Tidy.hs @@ -208,7 +208,7 @@ tidyLetBndr rec_tidy_env env@(tidy_env, var_env) id new_info = vanillaIdInfo `setOccInfo` occInfo old_info `setArityInfo` arityInfo old_info - `setStrictnessInfo` zapDmdEnvSig (strictnessInfo old_info) + `setDmdSigInfo` zapDmdEnvSig (dmdSigInfo old_info) `setDemandInfo` demandInfo old_info `setInlinePragInfo` inlinePragInfo old_info `setUnfoldingInfo` new_unf diff --git a/compiler/GHC/Core/Unfold.hs b/compiler/GHC/Core/Unfold.hs index 8fdbc1b891..cc95b3536e 100644 --- a/compiler/GHC/Core/Unfold.hs +++ b/compiler/GHC/Core/Unfold.hs @@ -991,7 +991,7 @@ certainlyWillInline opts fn_info -- See Note [certainlyWillInline: INLINABLE] do_cunf expr size args src' | arityInfo fn_info > 0 -- See Note [certainlyWillInline: be careful of thunks] - , not (isDeadEndSig (strictnessInfo fn_info)) + , not (isDeadEndSig (dmdSigInfo fn_info)) -- Do not unconditionally inline a bottoming functions even if -- it seems smallish. We've carefully lifted it out to top level, -- so we don't want to re-inline it. diff --git a/compiler/GHC/Core/Unfold/Make.hs b/compiler/GHC/Core/Unfold/Make.hs index d9b541e49c..54e44cfe04 100644 --- a/compiler/GHC/Core/Unfold/Make.hs +++ b/compiler/GHC/Core/Unfold/Make.hs @@ -30,7 +30,7 @@ import GHC.Core.DataCon import GHC.Core.Utils import GHC.Types.Basic import GHC.Types.Id -import GHC.Types.Demand ( StrictSig, isDeadEndSig ) +import GHC.Types.Demand ( DmdSig, isDeadEndSig ) import GHC.Utils.Outputable import GHC.Utils.Misc @@ -41,7 +41,7 @@ import {-# SOURCE #-} GHC.Core.SimpleOpt -mkFinalUnfolding :: UnfoldingOpts -> UnfoldingSource -> StrictSig -> CoreExpr -> Unfolding +mkFinalUnfolding :: UnfoldingOpts -> UnfoldingSource -> DmdSig -> CoreExpr -> Unfolding -- "Final" in the sense that this is a GlobalId that will not be further -- simplified; so the unfolding should be occurrence-analysed mkFinalUnfolding opts src strict_sig expr |