summaryrefslogtreecommitdiff
path: root/compiler/GHC/Core/Opt
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/GHC/Core/Opt')
-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
11 files changed, 67 insertions, 67 deletions
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
View Lorry Controller Status