[Git][ghc/ghc][wip/dmdanal-split-fvs] DmdAnal: Kill `is_thunk` case in `splitFV`

[Sebastian Graf]

Sebastian Graf pushed to branch wip/dmdanal-split-fvs at Glasgow Haskell Compiler / GHC


Commits:
2ce74f9b by Sebastian Graf at 2020-10-25T08:51:25+01:00
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.

- - - - -


2 changed files:

- compiler/GHC/Core/Opt/DmdAnal.hs
- compiler/GHC/Types/Demand.hs


Changes:

=====================================
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


=====================================
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



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2ce74f9bfb05d1aeaa97d06c262a78ff0e653544

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2ce74f9bfb05d1aeaa97d06c262a78ff0e653544
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20201025/7392c2a5/attachment-0001.html>