diff options
Diffstat (limited to 'compiler/GHC/Types/Demand.hs')
| -rw-r--r-- | compiler/GHC/Types/Demand.hs | 138 |
1 files changed, 69 insertions, 69 deletions
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 |