summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSebastian Graf <sebastian.graf@kit.edu>2021-03-26 11:54:25 +0100
committerSebastian Graf <sebastian.graf@kit.edu>2021-03-27 22:03:27 +0100
commit8f3aaff863eb9c497ca7a4b6d09893cd04e2c965 (patch)
treed5dd2e86a4fd4da3d2df645250ad9bfd82d1c3da
parentc83e4d05646c6c7b0396c4b984c201faf5c62fda (diff)
downloadhaskell-wip/T19597.tar.gz
Rename StrictSig to DmdSig (#19597)wip/T19597
In #19597, we also settled on the following renamings: * `idStrictness` -> `idDmdSig`, `strictnessInfo` -> `dmdSigInfo`, `HsStrictness` -> `HsDmdSig` * `idCprInfo` -> `idCprSig`, `cprInfo` -> `cprSigInfo`, `HsCpr` -> `HsCprSig` Fixes #19597.
-rw-r--r--compiler/GHC/Builtin/PrimOps.hs6
-rw-r--r--compiler/GHC/Builtin/primops.txt.pp26
-rw-r--r--compiler/GHC/Core/Lint.hs6
-rw-r--r--compiler/GHC/Core/Make.hs10
-rw-r--r--compiler/GHC/Core/Opt/Arity.hs8
-rw-r--r--compiler/GHC/Core/Opt/CallArity.hs2
-rw-r--r--compiler/GHC/Core/Opt/CprAnal.hs14
-rw-r--r--compiler/GHC/Core/Opt/DmdAnal.hs46
-rw-r--r--compiler/GHC/Core/Opt/OccurAnal.hs2
-rw-r--r--compiler/GHC/Core/Opt/Pipeline.hs6
-rw-r--r--compiler/GHC/Core/Opt/SetLevels.hs12
-rw-r--r--compiler/GHC/Core/Opt/Simplify.hs20
-rw-r--r--compiler/GHC/Core/Opt/Simplify/Utils.hs2
-rw-r--r--compiler/GHC/Core/Opt/SpecConstr.hs12
-rw-r--r--compiler/GHC/Core/Opt/WorkWrap.hs10
-rw-r--r--compiler/GHC/Core/Ppr.hs6
-rw-r--r--compiler/GHC/Core/Seq.hs6
-rw-r--r--compiler/GHC/Core/SimpleOpt.hs6
-rw-r--r--compiler/GHC/Core/Tidy.hs2
-rw-r--r--compiler/GHC/Core/Unfold.hs2
-rw-r--r--compiler/GHC/Core/Unfold/Make.hs4
-rw-r--r--compiler/GHC/CoreToIface.hs8
-rw-r--r--compiler/GHC/CoreToStg/Prep.hs6
-rw-r--r--compiler/GHC/Iface/Syntax.hs20
-rw-r--r--compiler/GHC/Iface/Tidy.hs14
-rw-r--r--compiler/GHC/IfaceToCore.hs6
-rw-r--r--compiler/GHC/Types/Cpr.hs6
-rw-r--r--compiler/GHC/Types/Demand.hs138
-rw-r--r--compiler/GHC/Types/Id.hs48
-rw-r--r--compiler/GHC/Types/Id/Info.hs32
-rw-r--r--compiler/GHC/Types/Id/Make.hs26
31 files changed, 256 insertions, 256 deletions
diff --git a/compiler/GHC/Builtin/PrimOps.hs b/compiler/GHC/Builtin/PrimOps.hs
index 14040692bc..58d0c9e76b 100644
--- a/compiler/GHC/Builtin/PrimOps.hs
+++ b/compiler/GHC/Builtin/PrimOps.hs
@@ -130,8 +130,8 @@ mkGenPrimOp str tvs tys ty = GenPrimOp (mkVarOccFS str) tvs tys ty
Not all primops are strict!
-}
-primOpStrictness :: PrimOp -> Arity -> StrictSig
- -- See Demand.StrictnessInfo for discussion of what the results
+primOpStrictness :: PrimOp -> Arity -> DmdSig
+ -- See Demand.DmdSig for discussion of what the results
-- The arity should be the arity of the primop; that's why
-- this function isn't exported.
#include "primop-strictness.hs-incl"
@@ -678,7 +678,7 @@ isComparisonPrimOp op = case primOpInfo op of
-- (type variables, argument types, result type)
-- It also gives arity, strictness info
-primOpSig :: PrimOp -> ([TyVar], [Type], Type, Arity, StrictSig)
+primOpSig :: PrimOp -> ([TyVar], [Type], Type, Arity, DmdSig)
primOpSig op
= (tyvars, arg_tys, res_ty, arity, primOpStrictness op arity)
where
diff --git a/compiler/GHC/Builtin/primops.txt.pp b/compiler/GHC/Builtin/primops.txt.pp
index c11cc05a40..a00f3f8215 100644
--- a/compiler/GHC/Builtin/primops.txt.pp
+++ b/compiler/GHC/Builtin/primops.txt.pp
@@ -142,7 +142,7 @@ defaults
can_fail = False -- See Note [PrimOp can_fail and has_side_effects] in PrimOp
commutable = False
code_size = { primOpCodeSizeDefault }
- strictness = { \ arity -> mkClosedStrictSig (replicate arity topDmd) topDiv }
+ strictness = { \ arity -> mkClosedDmdSig (replicate arity topDmd) topDiv }
fixity = Nothing
llvm_only = False
vector = []
@@ -2455,7 +2455,7 @@ primop CatchOp "catch#" GenPrimOp
-> State# RealWorld
-> (# State# RealWorld, a #)
with
- strictness = { \ _arity -> mkClosedStrictSig [ lazyApply1Dmd
+ strictness = { \ _arity -> mkClosedDmdSig [ lazyApply1Dmd
, lazyApply2Dmd
, topDmd] topDiv }
-- See Note [Strictness for mask/unmask/catch]
@@ -2473,7 +2473,7 @@ primop RaiseOp "raise#" GenPrimOp
-- For the same reasons, 'raise#' is marked as "can_fail" (which 'raiseIO#'
-- is not), but not as "has_side_effects" (which 'raiseIO#' is).
-- See Note [PrimOp can_fail and has_side_effects] in "GHC.Builtin.PrimOps".
- strictness = { \ _arity -> mkClosedStrictSig [topDmd] botDiv }
+ strictness = { \ _arity -> mkClosedDmdSig [topDmd] botDiv }
out_of_line = True
can_fail = True
@@ -2482,7 +2482,7 @@ primop RaiseIOOp "raiseIO#" GenPrimOp
with
-- See Note [Precise exceptions and strictness analysis] in "GHC.Types.Demand"
-- for why this is the *only* primop that has 'exnDiv'
- strictness = { \ _arity -> mkClosedStrictSig [topDmd, topDmd] exnDiv }
+ strictness = { \ _arity -> mkClosedDmdSig [topDmd, topDmd] exnDiv }
out_of_line = True
has_side_effects = True
@@ -2490,7 +2490,7 @@ primop MaskAsyncExceptionsOp "maskAsyncExceptions#" GenPrimOp
(State# RealWorld -> (# State# RealWorld, a #))
-> (State# RealWorld -> (# State# RealWorld, a #))
with
- strictness = { \ _arity -> mkClosedStrictSig [strictOnceApply1Dmd,topDmd] topDiv }
+ strictness = { \ _arity -> mkClosedDmdSig [strictOnceApply1Dmd,topDmd] topDiv }
-- See Note [Strictness for mask/unmask/catch]
out_of_line = True
has_side_effects = True
@@ -2499,7 +2499,7 @@ primop MaskUninterruptibleOp "maskUninterruptible#" GenPrimOp
(State# RealWorld -> (# State# RealWorld, a #))
-> (State# RealWorld -> (# State# RealWorld, a #))
with
- strictness = { \ _arity -> mkClosedStrictSig [strictOnceApply1Dmd,topDmd] topDiv }
+ strictness = { \ _arity -> mkClosedDmdSig [strictOnceApply1Dmd,topDmd] topDiv }
out_of_line = True
has_side_effects = True
@@ -2507,7 +2507,7 @@ primop UnmaskAsyncExceptionsOp "unmaskAsyncExceptions#" GenPrimOp
(State# RealWorld -> (# State# RealWorld, a #))
-> (State# RealWorld -> (# State# RealWorld, a #))
with
- strictness = { \ _arity -> mkClosedStrictSig [strictOnceApply1Dmd,topDmd] topDiv }
+ strictness = { \ _arity -> mkClosedDmdSig [strictOnceApply1Dmd,topDmd] topDiv }
-- See Note [Strictness for mask/unmask/catch]
out_of_line = True
has_side_effects = True
@@ -2528,7 +2528,7 @@ primop AtomicallyOp "atomically#" GenPrimOp
(State# RealWorld -> (# State# RealWorld, a #) )
-> State# RealWorld -> (# State# RealWorld, a #)
with
- strictness = { \ _arity -> mkClosedStrictSig [strictManyApply1Dmd,topDmd] topDiv }
+ strictness = { \ _arity -> mkClosedDmdSig [strictManyApply1Dmd,topDmd] topDiv }
-- See Note [Strictness for mask/unmask/catch]
out_of_line = True
has_side_effects = True
@@ -2546,7 +2546,7 @@ primop AtomicallyOp "atomically#" GenPrimOp
primop RetryOp "retry#" GenPrimOp
State# RealWorld -> (# State# RealWorld, a #)
with
- strictness = { \ _arity -> mkClosedStrictSig [topDmd] botDiv }
+ strictness = { \ _arity -> mkClosedDmdSig [topDmd] botDiv }
out_of_line = True
has_side_effects = True
@@ -2555,7 +2555,7 @@ primop CatchRetryOp "catchRetry#" GenPrimOp
-> (State# RealWorld -> (# State# RealWorld, a #) )
-> (State# RealWorld -> (# State# RealWorld, a #) )
with
- strictness = { \ _arity -> mkClosedStrictSig [ lazyApply1Dmd
+ strictness = { \ _arity -> mkClosedDmdSig [ lazyApply1Dmd
, lazyApply1Dmd
, topDmd ] topDiv }
-- See Note [Strictness for mask/unmask/catch]
@@ -2567,7 +2567,7 @@ primop CatchSTMOp "catchSTM#" GenPrimOp
-> (b -> State# RealWorld -> (# State# RealWorld, a #) )
-> (State# RealWorld -> (# State# RealWorld, a #) )
with
- strictness = { \ _arity -> mkClosedStrictSig [ lazyApply1Dmd
+ strictness = { \ _arity -> mkClosedDmdSig [ lazyApply1Dmd
, lazyApply2Dmd
, topDmd ] topDiv }
-- See Note [Strictness for mask/unmask/catch]
@@ -3135,7 +3135,7 @@ primop KeepAliveOp "keepAlive#" GenPrimOp
o -> State# RealWorld -> (State# RealWorld -> p) -> p
{ TODO. }
with
- strictness = { \ _arity -> mkClosedStrictSig [topDmd, topDmd, strictOnceApply1Dmd] topDiv }
+ strictness = { \ _arity -> mkClosedDmdSig [topDmd, topDmd, strictOnceApply1Dmd] topDiv }
------------------------------------------------------------------------
@@ -3147,7 +3147,7 @@ section "Tag to enum stuff"
primop DataToTagOp "dataToTag#" GenPrimOp
a -> Int# -- Zero-indexed; the first constructor has tag zero
with
- strictness = { \ _arity -> mkClosedStrictSig [evalDmd] topDiv }
+ strictness = { \ _arity -> mkClosedDmdSig [evalDmd] topDiv }
-- See Note [dataToTag# magic] in GHC.Core.Op.ConstantFold
primop TagToEnumOp "tagToEnum#" GenPrimOp
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
diff --git a/compiler/GHC/CoreToIface.hs b/compiler/GHC/CoreToIface.hs
index a4587d58ee..307dfd4893 100644
--- a/compiler/GHC/CoreToIface.hs
+++ b/compiler/GHC/CoreToIface.hs
@@ -469,13 +469,13 @@ toIfaceIdInfo id_info
------------ Strictness --------------
-- No point in explicitly exporting TopSig
- sig_info = strictnessInfo id_info
- strict_hsinfo | not (isTopSig sig_info) = Just (HsStrictness sig_info)
+ sig_info = dmdSigInfo id_info
+ strict_hsinfo | not (isTopSig sig_info) = Just (HsDmdSig sig_info)
| otherwise = Nothing
------------ CPR --------------
- cpr_info = cprInfo id_info
- cpr_hsinfo | cpr_info /= topCprSig = Just (HsCpr cpr_info)
+ cpr_info = cprSigInfo id_info
+ cpr_hsinfo | cpr_info /= topCprSig = Just (HsCprSig cpr_info)
| otherwise = Nothing
------------ Unfolding --------------
unfold_hsinfo = toIfUnfolding loop_breaker (unfoldingInfo id_info)
diff --git a/compiler/GHC/CoreToStg/Prep.hs b/compiler/GHC/CoreToStg/Prep.hs
index af94cb92d7..2e2c4d84af 100644
--- a/compiler/GHC/CoreToStg/Prep.hs
+++ b/compiler/GHC/CoreToStg/Prep.hs
@@ -849,8 +849,8 @@ cpeApp top_env expr
; (app, floats) <- rebuild_app args e2 (exprType e2) emptyFloats stricts
; mb_saturate hd app floats depth }
where
- stricts = case idStrictness v of
- StrictSig (DmdType _ demands _)
+ stricts = case idDmdSig v of
+ DmdSig (DmdType _ demands _)
| listLengthCmp demands depth /= GT -> demands
-- length demands <= depth
| otherwise -> []
@@ -1345,7 +1345,7 @@ Note [Speculative evaluation]
Since call-by-value is much cheaper than call-by-need, we case-bind arguments
that are either
- 1. Strictly evaluated anyway, according to the StrictSig of the callee, or
+ 1. Strictly evaluated anyway, according to the DmdSig of the callee, or
2. ok-for-spec, according to 'exprOkForSpeculation'
While (1) is a no-brainer and always beneficial, (2) is a bit
diff --git a/compiler/GHC/Iface/Syntax.hs b/compiler/GHC/Iface/Syntax.hs
index 908d105de0..dfc39fb244 100644
--- a/compiler/GHC/Iface/Syntax.hs
+++ b/compiler/GHC/Iface/Syntax.hs
@@ -346,8 +346,8 @@ type IfaceIdInfo = [IfaceInfoItem]
data IfaceInfoItem
= HsArity Arity
- | HsStrictness StrictSig
- | HsCpr CprSig
+ | HsDmdSig DmdSig
+ | HsCprSig CprSig
| HsInline InlinePragma
| HsUnfold Bool -- True <=> isStrongLoopBreaker is true
IfaceUnfolding -- See Note [Expose recursive functions]
@@ -1463,8 +1463,8 @@ instance Outputable IfaceInfoItem where
<> colon <+> ppr unf
ppr (HsInline prag) = text "Inline:" <+> ppr prag
ppr (HsArity arity) = text "Arity:" <+> int arity
- ppr (HsStrictness str) = text "Strictness:" <+> ppr str
- ppr (HsCpr cpr) = text "CPR:" <+> ppr cpr
+ ppr (HsDmdSig str) = text "Strictness:" <+> ppr str
+ ppr (HsCprSig cpr) = text "CPR:" <+> ppr cpr
ppr HsNoCafRefs = text "HasNoCafRefs"
ppr HsLevity = text "Never levity-polymorphic"
ppr (HsLFInfo lf_info) = text "LambdaFormInfo:" <+> ppr lf_info
@@ -2224,26 +2224,26 @@ instance Binary IfaceIdDetails where
instance Binary IfaceInfoItem where
put_ bh (HsArity aa) = putByte bh 0 >> put_ bh aa
- put_ bh (HsStrictness ab) = putByte bh 1 >> put_ bh ab
+ put_ bh (HsDmdSig ab) = putByte bh 1 >> put_ bh ab
put_ bh (HsUnfold lb ad) = putByte bh 2 >> put_ bh lb >> put_ bh ad
put_ bh (HsInline ad) = putByte bh 3 >> put_ bh ad
put_ bh HsNoCafRefs = putByte bh 4
put_ bh HsLevity = putByte bh 5
- put_ bh (HsCpr cpr) = putByte bh 6 >> put_ bh cpr
+ put_ bh (HsCprSig cpr) = putByte bh 6 >> put_ bh cpr
put_ bh (HsLFInfo lf_info) = putByte bh 7 >> put_ bh lf_info
get bh = do
h <- getByte bh
case h of
0 -> liftM HsArity $ get bh
- 1 -> liftM HsStrictness $ get bh
+ 1 -> liftM HsDmdSig $ get bh
2 -> do lb <- get bh
ad <- get bh
return (HsUnfold lb ad)
3 -> liftM HsInline $ get bh
4 -> return HsNoCafRefs
5 -> return HsLevity
- 6 -> HsCpr <$> get bh
+ 6 -> HsCprSig <$> get bh
_ -> HsLFInfo <$> get bh
instance Binary IfaceUnfolding where
@@ -2579,12 +2579,12 @@ instance NFData IfaceIdDetails where
instance NFData IfaceInfoItem where
rnf = \case
HsArity a -> rnf a
- HsStrictness str -> seqStrictSig str
+ HsDmdSig str -> seqDmdSig str
HsInline p -> p `seq` () -- TODO: seq further?
HsUnfold b unf -> rnf b `seq` rnf unf
HsNoCafRefs -> ()
HsLevity -> ()
- HsCpr cpr -> cpr `seq` ()
+ HsCprSig cpr -> cpr `seq` ()
HsLFInfo lf_info -> lf_info `seq` () -- TODO: seq further?
instance NFData IfaceUnfolding where
diff --git a/compiler/GHC/Iface/Tidy.hs b/compiler/GHC/Iface/Tidy.hs
index fa6db60736..c6175b2602 100644
--- a/compiler/GHC/Iface/Tidy.hs
+++ b/compiler/GHC/Iface/Tidy.hs
@@ -734,7 +734,7 @@ addExternal omit_prags expose_all id
show_unfold = show_unfolding unfolding
never_active = isNeverActive (inlinePragmaActivation (inlinePragInfo idinfo))
loop_breaker = isStrongLoopBreaker (occInfo idinfo)
- bottoming_fn = isDeadEndSig (strictnessInfo idinfo)
+ bottoming_fn = isDeadEndSig (dmdSigInfo idinfo)
-- Stuff to do with the Id's unfolding
-- We leave the unfolding there even if there is a worker
@@ -1190,16 +1190,16 @@ tidyTopIdInfo uf_opts rhs_tidy_env name orig_rhs tidy_rhs idinfo show_unfold
-- Arity and strictness info are enough;
-- c.f. GHC.Core.Tidy.tidyLetBndr
`setArityInfo` arity
- `setStrictnessInfo` final_sig
- `setCprInfo` final_cpr
+ `setDmdSigInfo` final_sig
+ `setCprSigInfo` final_cpr
`setUnfoldingInfo` minimal_unfold_info -- See note [Preserve evaluatedness]
-- in GHC.Core.Tidy
| otherwise -- Externally-visible Ids get the whole lot
= vanillaIdInfo
`setArityInfo` arity
- `setStrictnessInfo` final_sig
- `setCprInfo` final_cpr
+ `setDmdSigInfo` final_sig
+ `setCprSigInfo` final_cpr
`setOccInfo` robust_occ_info
`setInlinePragInfo` (inlinePragInfo idinfo)
`setUnfoldingInfo` unfold_info
@@ -1216,14 +1216,14 @@ tidyTopIdInfo uf_opts rhs_tidy_env name orig_rhs tidy_rhs idinfo show_unfold
--------- Strictness ------------
mb_bot_str = exprBotStrictness_maybe orig_rhs
- sig = strictnessInfo idinfo
+ sig = dmdSigInfo idinfo
final_sig | not $ isTopSig sig
= WARN( _bottom_hidden sig , ppr name ) sig
-- try a cheap-and-cheerful bottom analyser
| Just (_, nsig) <- mb_bot_str = nsig
| otherwise = sig
- cpr = cprInfo idinfo
+ cpr = cprSigInfo idinfo
final_cpr | Just _ <- mb_bot_str
= mkCprSig arity botCpr
| otherwise
diff --git a/compiler/GHC/IfaceToCore.hs b/compiler/GHC/IfaceToCore.hs
index cf0584615b..b3644633af 100644
--- a/compiler/GHC/IfaceToCore.hs
+++ b/compiler/GHC/IfaceToCore.hs
@@ -1637,8 +1637,8 @@ tcIdInfo ignore_prags toplvl name ty info = do
tcPrag :: IdInfo -> IfaceInfoItem -> IfL IdInfo
tcPrag info HsNoCafRefs = return (info `setCafInfo` NoCafRefs)
tcPrag info (HsArity arity) = return (info `setArityInfo` arity)
- tcPrag info (HsStrictness str) = return (info `setStrictnessInfo` str)
- tcPrag info (HsCpr cpr) = return (info `setCprInfo` cpr)
+ tcPrag info (HsDmdSig str) = return (info `setDmdSigInfo` str)
+ tcPrag info (HsCprSig cpr) = return (info `setCprSigInfo` cpr)
tcPrag info (HsInline prag) = return (info `setInlinePragInfo` prag)
tcPrag info HsLevity = return (info `setNeverLevPoly` ty)
tcPrag info (HsLFInfo lf_info) = do
@@ -1700,7 +1700,7 @@ tcUnfolding toplvl name _ info (IfCoreUnfold stable if_expr)
}
where
-- Strictness should occur before unfolding!
- strict_sig = strictnessInfo info
+ strict_sig = dmdSigInfo info
tcUnfolding toplvl name _ _ (IfCompulsory if_expr)
= do { mb_expr <- tcPragExpr True toplvl name if_expr
diff --git a/compiler/GHC/Types/Cpr.hs b/compiler/GHC/Types/Cpr.hs
index 29b28d23e2..0e12765314 100644
--- a/compiler/GHC/Types/Cpr.hs
+++ b/compiler/GHC/Types/Cpr.hs
@@ -4,7 +4,7 @@
-- | Types for the Constructed Product Result lattice.
-- "GHC.Core.Opt.CprAnal" and "GHC.Core.Opt.WorkWrap.Utils"
--- are its primary customers via 'GHC.Types.Id.idCprInfo'.
+-- are its primary customers via 'GHC.Types.Id.idCprSig'.
module GHC.Types.Cpr (
Cpr (ConCpr), topCpr, botCpr, flatConCpr, asConCpr,
CprType (..), topCprType, botCprType, flatConCprType,
@@ -161,12 +161,12 @@ seqCprTy :: CprType -> ()
seqCprTy (CprType _ cpr) = seqCpr cpr
-- | The arity of the wrapped 'CprType' is the arity at which it is safe
--- to unleash. See Note [Understanding DmdType and StrictSig] in "GHC.Types.Demand"
+-- to unleash. See Note [Understanding DmdType and DmdSig] in "GHC.Types.Demand"
newtype CprSig = CprSig { getCprSig :: CprType }
deriving (Eq, Binary)
-- | Turns a 'CprType' computed for the particular 'Arity' into a 'CprSig'
--- unleashable at that arity. See Note [Understanding DmdType and StrictSig] in
+-- unleashable at that arity. See Note [Understanding DmdType and DmdSig] in
-- "GHC.Types.Demand"
mkCprSigForArity :: Arity -> CprType -> CprSig
mkCprSigForArity arty ty@(CprType n cpr)
diff --git a/compiler/GHC/Types/Demand.hs b/compiler/GHC/Types/Demand.hs
index 3d6f315f66..61038d0492 100644
--- a/compiler/GHC/Types/Demand.hs
+++ b/compiler/GHC/Types/Demand.hs
@@ -58,11 +58,11 @@ module GHC.Types.Demand (
keepAliveDmdType,
-- * Demand signatures
- StrictSig(..), mkStrictSigForArity, mkClosedStrictSig,
- splitStrictSig, strictSigDmdEnv, hasDemandEnvSig,
+ DmdSig(..), mkDmdSigForArity, mkClosedDmdSig,
+ splitDmdSig, dmdSigDmdEnv, hasDemandEnvSig,
nopSig, botSig, isTopSig, isDeadEndSig, appIsDeadEnd,
-- ** Handling arity adjustments
- prependArgsStrictSig, etaConvertStrictSig,
+ prependArgsDmdSig, etaConvertDmdSig,
-- * Demand transformers from demand signatures
DmdTransformer, dmdTransformSig, dmdTransformDataConSig, dmdTransformDictSelSig,
@@ -71,7 +71,7 @@ module GHC.Types.Demand (
TypeShape(..), trimToType,
-- * @seq@ing stuff
- seqDemand, seqDemandList, seqDmdType, seqStrictSig,
+ seqDemand, seqDemandList, seqDmdType, seqDmdSig,
-- * Zapping usage information
zapUsageDemand, zapDmdEnvSig, zapUsedOnceDemand, zapUsedOnceSig
@@ -590,9 +590,9 @@ addCaseBndrDmd sd alt_dmds = zipWith plusDmd ds alt_dmds -- fuse ds!
where
Just ds = viewProd (length alt_dmds) sd -- Guaranteed not to be a call
-argsOneShots :: StrictSig -> Arity -> [[OneShotInfo]]
+argsOneShots :: DmdSig -> Arity -> [[OneShotInfo]]
-- ^ See Note [Computing one-shot info]
-argsOneShots (StrictSig (DmdType _ arg_ds _)) n_val_args
+argsOneShots (DmdSig (DmdType _ arg_ds _)) n_val_args
| unsaturated_call = []
| otherwise = go arg_ds
where
@@ -1257,8 +1257,8 @@ keepAliveDmdType (DmdType fvs ds res) vars =
{-
Note [Demand type Divergence]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-In contrast to StrictSigs, DmdTypes are elicited under a specific incoming demand.
-This is described in detail in Note [Understanding DmdType and StrictSig].
+In contrast to DmdSigs, DmdTypes are elicited under a specific incoming demand.
+This is described in detail in Note [Understanding DmdType and DmdSig].
Here, we'll focus on what that means for a DmdType's Divergence in a higher-order
scenario.
@@ -1362,7 +1362,7 @@ However, in fact we store in the Id an extremely emascuated demand
transfomer, namely
a single DmdType
-(Nevertheless we dignify StrictSig as a distinct type.)
+(Nevertheless we dignify DmdSig as a distinct type.)
This DmdType gives the demands unleashed by the Id when it is applied
to as many arguments as are given in by the arg demands in the DmdType.
@@ -1376,7 +1376,7 @@ demand on all arguments. Otherwise, the demand is specified by Id's
signature.
For example, the demand transformer described by the demand signature
- StrictSig (DmdType {x -> <1L>} <A><1P(L,L)>)
+ DmdSig (DmdType {x -> <1L>} <A><1P(L,L)>)
says that when the function is applied to two arguments, it
unleashes demand 1L on the free var x, A on the first arg,
and 1P(L,L) on the second.
@@ -1384,7 +1384,7 @@ and 1P(L,L) on the second.
If this same function is applied to one arg, all we can say is that it
uses x with 1L, and its arg with demand 1P(L,L).
-Note [Understanding DmdType and StrictSig]
+Note [Understanding DmdType and DmdSig]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Demand types are sound approximations of an expression's semantics relative to
the incoming demand we put the expression under. Consider the following
@@ -1421,51 +1421,51 @@ being a newtype wrapper around DmdType, it actually encodes two things:
met.
Here comes the subtle part: The threshold is encoded in the wrapped demand
-type's depth! So in mkStrictSigForArity we make sure to trim the list of
+type's depth! So in mkDmdSigForArity we make sure to trim the list of
argument demands to the given threshold arity. Call sites will make sure that
this corresponds to the arity of the call demand that elicited the wrapped
demand type. See also Note [What are demand signatures?].
-}
-- | The depth of the wrapped 'DmdType' encodes the arity at which it is safe
--- to unleash. Better construct this through 'mkStrictSigForArity'.
--- See Note [Understanding DmdType and StrictSig]
-newtype StrictSig
- = StrictSig DmdType
+-- to unleash. Better construct this through 'mkDmdSigForArity'.
+-- See Note [Understanding DmdType and DmdSig]
+newtype DmdSig
+ = DmdSig DmdType
deriving Eq
--- | Turns a 'DmdType' computed for the particular 'Arity' into a 'StrictSig'
--- unleashable at that arity. See Note [Understanding DmdType and StrictSig]
-mkStrictSigForArity :: Arity -> DmdType -> StrictSig
-mkStrictSigForArity arity dmd_ty@(DmdType fvs args div)
- | arity < dmdTypeDepth dmd_ty = StrictSig (DmdType fvs (take arity args) div)
- | otherwise = StrictSig (etaExpandDmdType arity dmd_ty)
+-- | Turns a 'DmdType' computed for the particular 'Arity' into a 'DmdSig'
+-- unleashable at that arity. See Note [Understanding DmdType and DmdSig]
+mkDmdSigForArity :: Arity -> DmdType -> DmdSig
+mkDmdSigForArity arity dmd_ty@(DmdType fvs args div)
+ | arity < dmdTypeDepth dmd_ty = DmdSig (DmdType fvs (take arity args) div)
+ | otherwise = DmdSig (etaExpandDmdType arity dmd_ty)
-mkClosedStrictSig :: [Demand] -> Divergence -> StrictSig
-mkClosedStrictSig ds res = mkStrictSigForArity (length ds) (DmdType emptyDmdEnv ds res)
+mkClosedDmdSig :: [Demand] -> Divergence -> DmdSig
+mkClosedDmdSig ds res = mkDmdSigForArity (length ds) (DmdType emptyDmdEnv ds res)
-splitStrictSig :: StrictSig -> ([Demand], Divergence)
-splitStrictSig (StrictSig (DmdType _ dmds res)) = (dmds, res)
+splitDmdSig :: DmdSig -> ([Demand], Divergence)
+splitDmdSig (DmdSig (DmdType _ dmds res)) = (dmds, res)
-strictSigDmdEnv :: StrictSig -> DmdEnv
-strictSigDmdEnv (StrictSig (DmdType env _ _)) = env
+dmdSigDmdEnv :: DmdSig -> DmdEnv
+dmdSigDmdEnv (DmdSig (DmdType env _ _)) = env
-hasDemandEnvSig :: StrictSig -> Bool
-hasDemandEnvSig = not . isEmptyVarEnv . strictSigDmdEnv
+hasDemandEnvSig :: DmdSig -> Bool
+hasDemandEnvSig = not . isEmptyVarEnv . dmdSigDmdEnv
-botSig :: StrictSig
-botSig = StrictSig botDmdType
+botSig :: DmdSig
+botSig = DmdSig botDmdType
-nopSig :: StrictSig
-nopSig = StrictSig nopDmdType
+nopSig :: DmdSig
+nopSig = DmdSig nopDmdType
-isTopSig :: StrictSig -> Bool
-isTopSig (StrictSig ty) = isTopDmdType ty
+isTopSig :: DmdSig -> Bool
+isTopSig (DmdSig ty) = isTopDmdType ty
-- | True if the signature diverges or throws an exception in a saturated call.
-- See Note [Dead ends].
-isDeadEndSig :: StrictSig -> Bool
-isDeadEndSig (StrictSig (DmdType _ _ res)) = isDeadEndDiv res
+isDeadEndSig :: DmdSig -> Bool
+isDeadEndSig (DmdSig (DmdType _ _ res)) = isDeadEndDiv res
-- | Returns true if an application to n args would diverge or throw an
-- exception.
@@ -1474,27 +1474,27 @@ isDeadEndSig (StrictSig (DmdType _ _ res)) = isDeadEndDiv res
-- its syntactic arity, we cannot say for sure that it is going to diverge.
-- Hence this function conservatively returns False in that case.
-- See Note [Dead ends].
-appIsDeadEnd :: StrictSig -> Int -> Bool
-appIsDeadEnd (StrictSig (DmdType _ ds res)) n
+appIsDeadEnd :: DmdSig -> Int -> Bool
+appIsDeadEnd (DmdSig (DmdType _ ds res)) n
= isDeadEndDiv res && not (lengthExceeds ds n)
-prependArgsStrictSig :: Int -> StrictSig -> StrictSig
+prependArgsDmdSig :: Int -> DmdSig -> DmdSig
-- ^ Add extra ('topDmd') arguments to a strictness signature.
--- In contrast to 'etaConvertStrictSig', this /prepends/ additional argument
+-- In contrast to 'etaConvertDmdSig', this /prepends/ additional argument
-- demands. This is used by FloatOut.
-prependArgsStrictSig new_args sig@(StrictSig dmd_ty@(DmdType env dmds res))
+prependArgsDmdSig new_args sig@(DmdSig dmd_ty@(DmdType env dmds res))
| new_args == 0 = sig
| isTopDmdType dmd_ty = sig
- | new_args < 0 = pprPanic "prependArgsStrictSig: negative new_args"
+ | new_args < 0 = pprPanic "prependArgsDmdSig: negative new_args"
(ppr new_args $$ ppr sig)
- | otherwise = StrictSig (DmdType env dmds' res)
+ | otherwise = DmdSig (DmdType env dmds' res)
where
dmds' = replicate new_args topDmd ++ dmds
-etaConvertStrictSig :: Arity -> StrictSig -> StrictSig
+etaConvertDmdSig :: Arity -> DmdSig -> DmdSig
-- ^ We are expanding (\x y. e) to (\x y z. e z) or reducing from the latter to
-- the former (when the Simplifier identifies a new join points, for example).
--- In contrast to 'prependArgsStrictSig', this /appends/ extra arg demands if
+-- In contrast to 'prependArgsDmdSig', this /appends/ extra arg demands if
-- necessary.
-- This works by looking at the 'DmdType' (which was produced under a call
-- demand for the old arity) and trying to transfer as many facts as we can to
@@ -1502,9 +1502,9 @@ etaConvertStrictSig :: Arity -> StrictSig -> StrictSig
-- An arity increase (resulting in a stronger incoming demand) can retain much
-- of the info, while an arity decrease (a weakening of the incoming demand)
-- must fall back to a conservative default.
-etaConvertStrictSig arity (StrictSig dmd_ty)
- | arity < dmdTypeDepth dmd_ty = StrictSig $ decreaseArityDmdType dmd_ty
- | otherwise = StrictSig $ etaExpandDmdType arity dmd_ty
+etaConvertDmdSig arity (DmdSig dmd_ty)
+ | arity < dmdTypeDepth dmd_ty = DmdSig $ decreaseArityDmdType dmd_ty
+ | otherwise = DmdSig $ etaExpandDmdType arity dmd_ty
{-
************************************************************************
@@ -1519,16 +1519,16 @@ etaConvertStrictSig arity (StrictSig dmd_ty)
-- (i.e. expression, function) uses its arguments and free variables, and
-- whether it diverges.
--
--- See Note [Understanding DmdType and StrictSig]
+-- See Note [Understanding DmdType and DmdSig]
-- and Note [What are demand signatures?].
type DmdTransformer = SubDemand -> DmdType
--- | Extrapolate a demand signature ('StrictSig') into a 'DmdTransformer'.
+-- | Extrapolate a demand signature ('DmdSig') into a 'DmdTransformer'.
--
--- Given a function's 'StrictSig' and a 'SubDemand' for the evaluation context,
+-- Given a function's 'DmdSig' and a 'SubDemand' for the evaluation context,
-- return how the function evaluates its free variables and arguments.
-dmdTransformSig :: StrictSig -> DmdTransformer
-dmdTransformSig (StrictSig dmd_ty@(DmdType _ arg_ds _)) sd
+dmdTransformSig :: DmdSig -> DmdTransformer
+dmdTransformSig (DmdSig dmd_ty@(DmdType _ arg_ds _)) sd
= multDmdType (peelManyCalls (length arg_ds) sd) dmd_ty
-- see Note [Demands from unsaturated function calls]
-- and Note [What are demand signatures?]
@@ -1546,10 +1546,10 @@ dmdTransformDataConSig arity sd = case go arity sd of
-- | A special 'DmdTransformer' for dictionary selectors that feeds the demand
-- on the result into the indicated dictionary component (if saturated).
-dmdTransformDictSelSig :: StrictSig -> DmdTransformer
+dmdTransformDictSelSig :: DmdSig -> DmdTransformer
-- NB: This currently doesn't handle newtype dictionaries and it's unclear how
-- it could without additional parameters.
-dmdTransformDictSelSig (StrictSig (DmdType _ [(_ :* sig_sd)] _)) call_sd
+dmdTransformDictSelSig (DmdSig (DmdType _ [(_ :* sig_sd)] _)) call_sd
| (n, sd') <- peelCallDmd call_sd
, Prod sig_ds <- sig_sd
= multDmdType n $
@@ -1642,8 +1642,8 @@ it should not fall over.
-}
-- | Remove the demand environment from the signature.
-zapDmdEnvSig :: StrictSig -> StrictSig
-zapDmdEnvSig (StrictSig (DmdType _ ds r)) = mkClosedStrictSig ds r
+zapDmdEnvSig :: DmdSig -> DmdSig
+zapDmdEnvSig (DmdSig (DmdType _ ds r)) = mkClosedDmdSig ds r
zapUsageDemand :: Demand -> Demand
-- Remove the usage info, but not the strictness info, from the demand
@@ -1663,9 +1663,9 @@ zapUsedOnceDemand = kill_usage $ KillFlags
-- | Remove all `C_01 :*` info (but not `CM` sub-demands) from the strictness
-- signature
-zapUsedOnceSig :: StrictSig -> StrictSig
-zapUsedOnceSig (StrictSig (DmdType env ds r))
- = StrictSig (DmdType env (map zapUsedOnceDemand ds) r)
+zapUsedOnceSig :: DmdSig -> DmdSig
+zapUsedOnceSig (DmdSig (DmdType env ds r))
+ = DmdSig (DmdType env (map zapUsedOnceDemand ds) r)
data KillFlags = KillFlags
{ kf_abs :: Bool
@@ -1740,8 +1740,8 @@ seqDmdType (DmdType env ds res) =
seqDmdEnv :: DmdEnv -> ()
seqDmdEnv env = seqEltsUFM seqDemandList env
-seqStrictSig :: StrictSig -> ()
-seqStrictSig (StrictSig ty) = seqDmdType ty
+seqDmdSig :: DmdSig -> ()
+seqDmdSig (DmdSig ty) = seqDmdType ty
{-
************************************************************************
@@ -1842,8 +1842,8 @@ instance Outputable DmdType where
-- It's OK to use nonDetUFMToList here because we only do it for
-- pretty printing
-instance Outputable StrictSig where
- ppr (StrictSig ty) = ppr ty
+instance Outputable DmdSig where
+ ppr (DmdSig ty) = ppr ty
instance Outputable TypeShape where
ppr TsUnk = text "TsUnk"
@@ -1884,9 +1884,9 @@ instance Binary SubDemand where
2 -> Prod <$> get bh
_ -> pprPanic "Binary:SubDemand" (ppr (fromIntegral h :: Int))
-instance Binary StrictSig where
- put_ bh (StrictSig aa) = put_ bh aa
- get bh = StrictSig <$> get bh
+instance Binary DmdSig where
+ put_ bh (DmdSig aa) = put_ bh aa
+ get bh = DmdSig <$> get bh
instance Binary DmdType where
-- Ignore DmdEnv when spitting out the DmdType
diff --git a/compiler/GHC/Types/Id.hs b/compiler/GHC/Types/Id.hs
index d29bf36d15..dbc2bed651 100644
--- a/compiler/GHC/Types/Id.hs
+++ b/compiler/GHC/Types/Id.hs
@@ -56,7 +56,7 @@ module GHC.Types.Id (
setIdInfo, lazySetIdInfo, modifyIdInfo, maybeModifyIdInfo,
zapLamIdInfo, zapIdDemandInfo, zapIdUsageInfo, zapIdUsageEnvInfo,
zapIdUsedOnceInfo, zapIdTailCallInfo,
- zapFragileIdInfo, zapIdStrictness, zapStableUnfolding,
+ zapFragileIdInfo, zapIdDmdSig, zapStableUnfolding,
transferPolyIdInfo, scaleIdBy, scaleVarBy,
-- ** Predicates on Ids
@@ -111,12 +111,12 @@ module GHC.Types.Id (
setIdLFInfo,
setIdDemandInfo,
- setIdStrictness,
- setIdCprInfo,
+ setIdDmdSig,
+ setIdCprSig,
idDemandInfo,
- idStrictness,
- idCprInfo,
+ idDmdSig,
+ idCprSig,
) where
@@ -178,8 +178,8 @@ infixl 1 `setIdUnfolding`,
`idCafInfo`,
`setIdDemandInfo`,
- `setIdStrictness`,
- `setIdCprInfo`,
+ `setIdDmdSig`,
+ `setIdCprSig`,
`asJoinId`,
`asJoinId_maybe`
@@ -673,24 +673,24 @@ idFunRepArity x = countFunRepArgs (idArity x) (idType x)
-- See Note [Dead ends] in "GHC.Types.Demand".
isDeadEndId :: Var -> Bool
isDeadEndId v
- | isId v = isDeadEndSig (idStrictness v)
+ | isId v = isDeadEndSig (idDmdSig v)
| otherwise = False
--- | Accesses the 'Id''s 'strictnessInfo'.
-idStrictness :: Id -> StrictSig
-idStrictness id = strictnessInfo (idInfo id)
+-- | Accesses the 'Id''s 'dmdSigInfo'.
+idDmdSig :: Id -> DmdSig
+idDmdSig id = dmdSigInfo (idInfo id)
-setIdStrictness :: Id -> StrictSig -> Id
-setIdStrictness id sig = modifyIdInfo (`setStrictnessInfo` sig) id
+setIdDmdSig :: Id -> DmdSig -> Id
+setIdDmdSig id sig = modifyIdInfo (`setDmdSigInfo` sig) id
-idCprInfo :: Id -> CprSig
-idCprInfo id = cprInfo (idInfo id)
+idCprSig :: Id -> CprSig
+idCprSig id = cprSigInfo (idInfo id)
-setIdCprInfo :: Id -> CprSig -> Id
-setIdCprInfo id sig = modifyIdInfo (\info -> setCprInfo info sig) id
+setIdCprSig :: Id -> CprSig -> Id
+setIdCprSig id sig = modifyIdInfo (\info -> setCprSigInfo info sig) id
-zapIdStrictness :: Id -> Id
-zapIdStrictness id = modifyIdInfo (`setStrictnessInfo` nopSig) id
+zapIdDmdSig :: Id -> Id
+zapIdDmdSig id = modifyIdInfo (`setDmdSigInfo` nopSig) id
-- | This predicate says whether the 'Id' has a strict demand placed on it or
-- has a type such that it can always be evaluated strictly (i.e an
@@ -998,15 +998,15 @@ transferPolyIdInfo old_id abstract_wrt new_id
new_arity = old_arity + arity_increase
new_occ_info = zapOccTailCallInfo old_occ_info
- old_strictness = strictnessInfo old_info
- new_strictness = prependArgsStrictSig arity_increase old_strictness
- old_cpr = cprInfo old_info
+ old_strictness = dmdSigInfo old_info
+ new_strictness = prependArgsDmdSig arity_increase old_strictness
+ old_cpr = cprSigInfo old_info
transfer new_info = new_info `setArityInfo` new_arity
`setInlinePragInfo` old_inline_prag
`setOccInfo` new_occ_info
- `setStrictnessInfo` new_strictness
- `setCprInfo` old_cpr
+ `setDmdSigInfo` new_strictness
+ `setCprSigInfo` old_cpr
isNeverLevPolyId :: Id -> Bool
isNeverLevPolyId = isNeverLevPolyIdInfo . idInfo
diff --git a/compiler/GHC/Types/Id/Info.hs b/compiler/GHC/Types/Id/Info.hs
index 0ece12cefa..f9a7cacba8 100644
--- a/compiler/GHC/Types/Id/Info.hs
+++ b/compiler/GHC/Types/Id/Info.hs
@@ -42,8 +42,8 @@ module GHC.Types.Id.Info (
callArityInfo, setCallArityInfo,
-- ** Demand and strictness Info
- strictnessInfo, setStrictnessInfo,
- cprInfo, setCprInfo,
+ dmdSigInfo, setDmdSigInfo,
+ cprSigInfo, setCprSigInfo,
demandInfo, setDemandInfo, pprStrictness,
-- ** Unfolding Info
@@ -125,8 +125,8 @@ infixl 1 `setRuleInfo`,
`setOneShotInfo`,
`setOccInfo`,
`setCafInfo`,
- `setStrictnessInfo`,
- `setCprInfo`,
+ `setDmdSigInfo`,
+ `setCprSigInfo`,
`setDemandInfo`,
`setNeverLevPoly`,
`setLevityInfoWithType`
@@ -263,10 +263,10 @@ data IdInfo
-- ^ Any inline pragma attached to the 'Id'
occInfo :: OccInfo,
-- ^ How the 'Id' occurs in the program
- strictnessInfo :: StrictSig,
+ dmdSigInfo :: DmdSig,
-- ^ A strictness signature. Digests how a function uses its arguments
-- if applied to at least 'arityInfo' arguments.
- cprInfo :: CprSig,
+ cprSigInfo :: CprSig,
-- ^ Information on whether the function will ultimately return a
-- freshly allocated constructor.
demandInfo :: Demand,
@@ -409,11 +409,11 @@ setOneShotInfo info lb =
setDemandInfo :: IdInfo -> Demand -> IdInfo
setDemandInfo info dd = dd `seq` info { demandInfo = dd }
-setStrictnessInfo :: IdInfo -> StrictSig -> IdInfo
-setStrictnessInfo info dd = dd `seq` info { strictnessInfo = dd }
+setDmdSigInfo :: IdInfo -> DmdSig -> IdInfo
+setDmdSigInfo info dd = dd `seq` info { dmdSigInfo = dd }
-setCprInfo :: IdInfo -> CprSig -> IdInfo
-setCprInfo info cpr = cpr `seq` info { cprInfo = cpr }
+setCprSigInfo :: IdInfo -> CprSig -> IdInfo
+setCprSigInfo info cpr = cpr `seq` info { cprSigInfo = cpr }
-- | Basic 'IdInfo' that carries no useful information whatsoever
vanillaIdInfo :: IdInfo
@@ -424,8 +424,8 @@ vanillaIdInfo
inlinePragInfo = defaultInlinePragma,
occInfo = noOccInfo,
demandInfo = topDmd,
- strictnessInfo = nopSig,
- cprInfo = topCprSig,
+ dmdSigInfo = nopSig,
+ cprSigInfo = topCprSig,
bitfield = bitfieldSetCafInfo vanillaCafInfo $
bitfieldSetArityInfo unknownArity $
bitfieldSetCallArityInfo unknownArity $
@@ -501,7 +501,7 @@ type InlinePragInfo = InlinePragma
************************************************************************
-}
-pprStrictness :: StrictSig -> SDoc
+pprStrictness :: DmdSig -> SDoc
pprStrictness sig = ppr sig
{-
@@ -649,14 +649,14 @@ zapUsageInfo info = Just (info {demandInfo = zapUsageDemand (demandInfo info)})
-- | Remove usage environment info from the strictness signature on the 'IdInfo'
zapUsageEnvInfo :: IdInfo -> Maybe IdInfo
zapUsageEnvInfo info
- | hasDemandEnvSig (strictnessInfo info)
- = Just (info {strictnessInfo = zapDmdEnvSig (strictnessInfo info)})
+ | hasDemandEnvSig (dmdSigInfo info)
+ = Just (info {dmdSigInfo = zapDmdEnvSig (dmdSigInfo info)})
| otherwise
= Nothing
zapUsedOnceInfo :: IdInfo -> Maybe IdInfo
zapUsedOnceInfo info
- = Just $ info { strictnessInfo = zapUsedOnceSig (strictnessInfo info)
+ = Just $ info { dmdSigInfo = zapUsedOnceSig (dmdSigInfo info)
, demandInfo = zapUsedOnceDemand (demandInfo info) }
zapFragileInfo :: IdInfo -> Maybe IdInfo
diff --git a/compiler/GHC/Types/Id/Make.hs b/compiler/GHC/Types/Id/Make.hs
index 36a2c9d1df..b2f9dc7adf 100644
--- a/compiler/GHC/Types/Id/Make.hs
+++ b/compiler/GHC/Types/Id/Make.hs
@@ -484,8 +484,8 @@ mkDictSelId name clas
base_info = noCafIdInfo
`setArityInfo` 1
- `setStrictnessInfo` strict_sig
- `setCprInfo` topCprSig
+ `setDmdSigInfo` strict_sig
+ `setCprSigInfo` topCprSig
`setLevityInfoWithType` sel_ty
info | new_tycon
@@ -515,7 +515,7 @@ mkDictSelId name clas
-- It's worth giving one, so that absence info etc is generated
-- even if the selector isn't inlined
- strict_sig = mkClosedStrictSig [arg_dmd] topDiv
+ strict_sig = mkClosedDmdSig [arg_dmd] topDiv
arg_dmd | new_tycon = evalDmd
| otherwise = C_1N :*
Prod [ if name == sel_name then evalDmd else absDmd
@@ -582,7 +582,7 @@ mkDataConWorkId wkr_name data_con
----------- Workers for data types --------------
alg_wkr_info = noCafIdInfo
`setArityInfo` wkr_arity
- `setCprInfo` mkCprSig wkr_arity (dataConCPR data_con)
+ `setCprSigInfo` mkCprSig wkr_arity (dataConCPR data_con)
`setInlinePragInfo` wkr_inline_prag
`setUnfoldingInfo` evaldUnfolding -- Record that it's evaluated,
-- even if arity = 0
@@ -710,14 +710,14 @@ mkDataConRep dflags fam_envs wrap_name mb_bangs data_con
-- applications are treated as values
`setInlinePragInfo` wrap_prag
`setUnfoldingInfo` wrap_unf
- `setStrictnessInfo` wrap_sig
- `setCprInfo` mkCprSig wrap_arity (dataConCPR data_con)
+ `setDmdSigInfo` wrap_sig
+ `setCprSigInfo` mkCprSig wrap_arity (dataConCPR data_con)
-- We need to get the CAF info right here because GHC.Iface.Tidy
-- does not tidy the IdInfo of implicit bindings (like the wrapper)
-- so it not make sure that the CAF info is sane
`setLevityInfoWithType` wrap_ty
- wrap_sig = mkClosedStrictSig wrap_arg_dmds topDiv
+ wrap_sig = mkClosedDmdSig wrap_arg_dmds topDiv
wrap_arg_dmds =
replicate (length theta) topDmd ++ map mk_dmd arg_ibangs
@@ -1322,14 +1322,14 @@ mkPrimOpId prim_op
-- PrimOps don't ever construct a product, but we want to preserve bottoms
cpr
- | isDeadEndDiv (snd (splitStrictSig strict_sig)) = botCpr
+ | isDeadEndDiv (snd (splitDmdSig strict_sig)) = botCpr
| otherwise = topCpr
info = noCafIdInfo
`setRuleInfo` mkRuleInfo (maybeToList $ primOpRules name prim_op)
`setArityInfo` arity
- `setStrictnessInfo` strict_sig
- `setCprInfo` mkCprSig arity cpr
+ `setDmdSigInfo` strict_sig
+ `setCprSigInfo` mkCprSig arity cpr
`setInlinePragInfo` neverInlinePragma
`setLevityInfoWithType` res_ty
-- We give PrimOps a NOINLINE pragma so that we don't
@@ -1361,13 +1361,13 @@ mkFCallId dflags uniq fcall ty
info = noCafIdInfo
`setArityInfo` arity
- `setStrictnessInfo` strict_sig
- `setCprInfo` topCprSig
+ `setDmdSigInfo` strict_sig
+ `setCprSigInfo` topCprSig
`setLevityInfoWithType` ty
(bndrs, _) = tcSplitPiTys ty
arity = count isAnonTyCoBinder bndrs
- strict_sig = mkClosedStrictSig (replicate arity topDmd) topDiv
+ strict_sig = mkClosedDmdSig (replicate arity topDmd) topDiv
-- the call does not claim to be strict in its arguments, since they
-- may be lifted (foreign import prim) and the called code doesn't
-- necessarily force them. See #11076.