summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSebastian Graf <sgraf1337@gmail.com>2020-10-24 14:03:06 +0200
committerMarge Bot <ben+marge-bot@smart-cactus.org>2020-10-27 14:05:37 -0400
commit28f98b01d055c8027f9495b1669bf875b3e42168 (patch)
tree7acc640e8d81da0249857cbd3ca78a1cf2f74294
parentd2a25f42f884ad4ac841a36474498131596da506 (diff)
downloadhaskell-28f98b01d055c8027f9495b1669bf875b3e42168.tar.gz
DmdAnal: Kill `is_thunk` case in `splitFV`
The `splitFV` function implements the highly dubious hack described in `Note [Lazy und unleashable free variables]` in GHC.Core.Opt.DmdAnal. It arranges it so that demand signatures only carry strictness info on free variables. Usage info is released through other means, see the Note. It's purely for analysis performance reasons. It turns out that `splitFV` has a quite involved case for thunks that produces slightly different usage signatures and it's not clear why we need it: `splitFV` is only relevant in the LetDown case and the only time we call it on thunks is for top-level or local recursive thunks. Since usage signatures of top-level thunks can only reference other top-level bindings and we completely discard demand info we have on top-level things (see the lack of `setIdDemandInfo` in `dmdAnalTopBind`), the `is_thunk` case is completely irrelevant here. For local, recursive thunks, the added benefit of the `is_thunk` test is marginal: We get used-multiple-times in some cases where previously we had used-once if a recursive thunk has multiple call sites. It's very unlikely and not a case to optimise for. So we kill the `is_thunk` case and inline `splitFV` at its call site, exposing `isWeakDmd` from `GHC.Types.Demand` instead. The NoFib summary supports this decision: ``` Min 0.0% -0.0% Max 0.0% +0.0% Geometric Mean -0.0% -0.0% ```
-rw-r--r--compiler/GHC/Core/Opt/DmdAnal.hs8
-rw-r--r--compiler/GHC/Types/Demand.hs23
2 files changed, 5 insertions, 26 deletions
diff --git a/compiler/GHC/Core/Opt/DmdAnal.hs b/compiler/GHC/Core/Opt/DmdAnal.hs
index d3e3b7c87b..c8776d8788 100644
--- a/compiler/GHC/Core/Opt/DmdAnal.hs
+++ b/compiler/GHC/Core/Opt/DmdAnal.hs
@@ -574,8 +574,7 @@ dmdAnalRhsLetDown rec_flag env let_dmd id rhs
rhs_fv2 = rhs_fv1 `keepAliveDmdEnv` extra_fvs
-- See Note [Lazy and unleashable free variables]
- (lazy_fv, sig_fv) = splitFVs is_thunk rhs_fv2
- is_thunk = not (exprIsHNF rhs) && not (isJoinId id)
+ (lazy_fv, sig_fv) = partitionVarEnv isWeakDmd rhs_fv2
-- Find the RHS free vars of the unfoldings and RULES
-- See Note [Absence analysis for stable unfoldings and RULES]
@@ -595,8 +594,9 @@ dmdAnalRhsLetDown rec_flag env let_dmd id rhs
mkRhsDmd :: AnalEnv -> Arity -> CoreExpr -> CleanDemand
mkRhsDmd _env rhs_arity _rhs = mkCallDmds rhs_arity cleanEvalDmd
--- | If given the let-bound 'Id', 'useLetUp' determines whether we should
--- process the binding up (body before rhs) or down (rhs before body).
+-- | If given the (local, non-recursive) let-bound 'Id', 'useLetUp' determines
+-- whether we should process the binding up (body before rhs) or down (rhs
+-- before body).
--
-- We use LetDown if there is a chance to get a useful strictness signature to
-- unleash at call sites. LetDown is generally more precise than LetUp if we can
diff --git a/compiler/GHC/Types/Demand.hs b/compiler/GHC/Types/Demand.hs
index ac1a14d818..b01bb8f444 100644
--- a/compiler/GHC/Types/Demand.hs
+++ b/compiler/GHC/Types/Demand.hs
@@ -42,7 +42,7 @@ module GHC.Types.Demand (
seqDemand, seqDemandList, seqDmdType, seqStrictSig,
evalDmd, cleanEvalDmd, cleanEvalProdDmd, isStrictDmd,
- splitDmdTy, splitFVs, deferAfterPreciseException,
+ splitDmdTy, isWeakDmd, deferAfterPreciseException,
postProcessUnsat, postProcessDmdType,
splitProdDmd_maybe, peelCallDmd, peelManyCalls, mkCallDmd, mkCallDmds,
@@ -796,22 +796,6 @@ cleanUseDmd_maybe :: Demand -> Maybe UseDmd
cleanUseDmd_maybe (JD { ud = Use _ u }) = Just u
cleanUseDmd_maybe _ = Nothing
-splitFVs :: Bool -- Thunk
- -> DmdEnv -> (DmdEnv, DmdEnv)
-splitFVs is_thunk rhs_fvs
- | is_thunk = strictPairToTuple $
- nonDetStrictFoldUFM_Directly add (emptyVarEnv :*: emptyVarEnv) rhs_fvs
- -- It's OK to use a non-deterministic fold because we
- -- immediately forget the ordering by putting the elements
- -- in the envs again
- | otherwise = partitionVarEnv isWeakDmd rhs_fvs
- where
- add uniq dmd@(JD { sd = s, ud = u }) (lazy_fv :*: sig_fv)
- | Lazy <- s = addToUFM_Directly lazy_fv uniq dmd :*: sig_fv
- | otherwise = addToUFM_Directly lazy_fv uniq (JD { sd = Lazy, ud = u })
- :*:
- addToUFM_Directly sig_fv uniq (JD { sd = s, ud = Abs })
-
keepAliveDmdEnv :: DmdEnv -> IdSet -> DmdEnv
-- (keepAliveDmdType dt vs) makes sure that the Ids in vs have
-- /some/ usage in the returned demand types -- they are not Absent
@@ -842,11 +826,6 @@ splitProdDmd_maybe (JD { sd = s, ud = u })
(Lazy, Use _ (UProd ux)) -> Just (mkJointDmds (replicate (length ux) Lazy) ux)
_ -> Nothing
-data StrictPair a b = !a :*: !b
-
-strictPairToTuple :: StrictPair a b -> (a, b)
-strictPairToTuple (x :*: y) = (x, y)
-
{- *********************************************************************
* *
TypeShape and demand trimming