[Git][ghc/ghc][wip/T25096] Do a bit less demand-zapping when floating

Simon Peyton Jones (@simonpj) gitlab at gitlab.haskell.org
Mon Jul 22 10:32:12 UTC 2024



Simon Peyton Jones pushed to branch wip/T25096 at Glasgow Haskell Compiler / GHC


Commits:
10ee25c4 by Simon Peyton Jones at 2024-07-22T11:31:08+01:00
Do a bit less demand-zapping when floating

See Note [Zapping demand info when floating] in GHC.Core.Opt.SetLevels

- - - - -


6 changed files:

- compiler/GHC/Core/Opt/SetLevels.hs
- compiler/GHC/Core/Opt/Simplify/Iteration.hs
- compiler/GHC/Core/Opt/Specialise.hs
- compiler/GHC/Types/Demand.hs
- compiler/GHC/Types/Id.hs
- compiler/GHC/Types/Id/Info.hs


Changes:

=====================================
compiler/GHC/Core/Opt/SetLevels.hs
=====================================
@@ -1874,7 +1874,6 @@ cloneLetVars is_rec
           env@(LE { le_subst = subst, le_lvl_env = lvl_env, le_env = id_env })
           dest_lvl vs
   = do { let vs1  = map zap vs
-                      -- See Note [Zapping the demand info]
        ; (subst', vs2) <- case is_rec of
                             NonRecursive -> cloneBndrs      subst vs1
                             Recursive    -> cloneRecIdBndrs subst vs1
@@ -1887,9 +1886,12 @@ cloneLetVars is_rec
        ; return (env', vs2) }
   where
     zap :: Var -> Var
-    zap v | isId v    = zap_join (zapIdDemandInfo v)
+    -- See Note [Zapping demand info when floating]
+    -- and Note [Zapping JoinId when floating]
+    zap v | isId v    = zap_join (lazifyIdDemandInfo v)
           | otherwise = v
 
+    -- See Note [Zapping JoinId when floating]
     zap_join | isTopLvl dest_lvl = zapJoinId
              | otherwise         = id
 
@@ -1898,16 +1900,31 @@ add_id id_env (v, v1)
   | isTyVar v = delVarEnv    id_env v
   | otherwise = extendVarEnv id_env v ([v1], assert (not (isCoVar v1)) $ Var v1)
 
-{-
-Note [Zapping the demand info]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-VERY IMPORTANT: we must zap the demand info if the thing is going to
-float out, because it may be less demanded than at its original
-binding site.  Eg
-   f :: Int -> Int
-   f x = let v = 3*4 in v+x
+{- Note [Zapping JoinId when floating]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+If we are floating a join point, it won't be one anymore, so we zap
+the join point information.
+
+Note [Zapping demand info when floating]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+When floating we must lazify the outer demand info on the Id
+because it may be less demanded than at its original binding site.
+For example:
+     f :: Int -> Int
+     f x = let v = 3*4 in v+x
 Here v is strict; but if we float v to top level, it isn't any more.
 
-Similarly, if we're floating a join point, it won't be one anymore, so we zap
-join point information as well.
+But NOTE that we only need to zap the /top-level/ demand info. For example
+     let x = (e1,e2)
+     in ...(case x of (a,b) -> a+b)...
+If we float x outwards, it may no longer be strict, but IF it is ever
+evaluated THEN its components will be evaluated.  So we to lazify its
+demand-info, not discard it entirely.
+
+Same if we have
+     let f = \x y . blah
+     in ...(f a b)...(f c d)...
+Here `f` will get a demand like SC(1C(L)). If we float it out, we can
+keep that `1C` called-once inner demand. It's only the out strictness
+that we kill.
 -}


=====================================
compiler/GHC/Core/Opt/Simplify/Iteration.hs
=====================================
@@ -971,7 +971,7 @@ addLetBndrInfo new_bndr new_arity_type new_unf
 
     -- Demand info: Note [Setting the demand info]
     info3 | isEvaldUnfolding new_unf
-          = zapDemandInfo info2 `orElse` info2
+          = lazifyDemandInfo info2 `orElse` info2
           | otherwise
           = info2
 


=====================================
compiler/GHC/Core/Opt/Specialise.hs
=====================================
@@ -1485,11 +1485,12 @@ specBind top_lvl env (NonRec fn rhs) do_body
              -- This is important: see Note [Update unfolding after specialisation]
              -- And in any case cloneBndrSM discards non-Stable unfoldings
 
-             fn3 = zapIdDemandInfo fn2
+             fn3 = lazifyIdDemandInfo fn2
              -- We zap the demand info because the binding may float,
              -- which would invalidate the demand info (see #17810 for example).
              -- Destroying demand info is not terrible; specialisation is
              -- always followed soon by demand analysis.
+             -- See Note [Zapping demand info when floating] in GHC.Core.Opt.SetLevels
 
              body_env2 = body_env1 `bringFloatedDictsIntoScope` ud_binds rhs_uds
                                    `extendInScope` fn3


=====================================
compiler/GHC/Types/Demand.hs
=====================================
@@ -608,22 +608,22 @@ multCard (Card a) (Card b)
 --
 -- Examples (using Note [Demand notation]):
 --
---   * 'seq' puts demand @1A@ on its first argument: It evaluates the argument
---     strictly (@1@), but not any deeper (@A@).
---   * 'fst' puts demand @1P(1L,A)@ on its argument: It evaluates the argument
+--   * 'seq' puts demand `1A` on its first argument: It evaluates the argument
+--     strictly (`1`), but not any deeper (`A`).
+--   * 'fst' puts demand `1P(1L,A)` on its argument: It evaluates the argument
 --     pair strictly and the first component strictly, but no nested info
---     beyond that (@L@). Its second argument is not used at all.
---   * '$' puts demand @1C(1,L)@ on its first argument: It calls (@C@) the
---     argument function with one argument, exactly once (@1@). No info
---     on how the result of that call is evaluated (@L@).
---   * 'maybe' puts demand @MC(M,L)@ on its second argument: It evaluates
+--     beyond that (`L`). Its second argument is not used at all.
+--   * '$' puts demand `1C(1,L)` on its first argument: It calls (`C`) the
+--     argument function with one argument, exactly once (`1`). No info
+--     on how the result of that call is evaluated (`L`).
+--   * 'maybe' puts demand `MC(M,L)` on its second argument: It evaluates
 --     the argument function at most once ((M)aybe) and calls it once when
 --     it is evaluated.
---   * @fst p + fst p@ puts demand @SP(SL,A)@ on @p@: It's @1P(1L,A)@
---     multiplied by two, so we get @S@ (used at least once, possibly multiple
+--   * `fst p + fst p` puts demand `SP(SL,A)` on `p`: It's `1P(1L,A)`
+--     multiplied by two, so we get `S` (used at least once, possibly multiple
 --     times).
 --
--- This data type is quite similar to @'Scaled' 'SubDemand'@, but it's scaled
+-- This data type is quite similar to `'Scaled' 'SubDemand'`, but it's scaled
 -- by 'Card', which is an /interval/ on 'Multiplicity', the upper bound of
 -- which could be used to infer uniqueness types. Also we treat 'AbsDmd' and
 -- 'BotDmd' specially, as the concept of a 'SubDemand' doesn't apply when there
@@ -2651,7 +2651,12 @@ So, L can denote a 'Card', polymorphic 'SubDemand' or polymorphic 'Demand',
 but it's always clear from context which "overload" is meant. It's like
 return-type inference of e.g. 'read'.
 
-Examples are in the haddock for 'Demand'.
+Examples are in the haddock for 'Demand'.  Here are some more:
+   SA                 Strict, but does not look at subcomponents (`seq`)
+   SP(L,L)            Strict boxed pair, components lazy
+   S!P(L,L)           Strict unboxed pair, components lazy
+   LP(SA,SA)          Lazy pair, but if it is evaluated will evaluated its components
+   LC(1C(L))          Lazy, but if called will apply the result exactly once
 
 This is the syntax for demand signatures:
 


=====================================
compiler/GHC/Types/Id.hs
=====================================
@@ -54,7 +54,7 @@ module GHC.Types.Id (
         setIdExported, setIdNotExported,
         globaliseId, localiseId,
         setIdInfo, lazySetIdInfo, modifyIdInfo, maybeModifyIdInfo,
-        zapLamIdInfo, zapIdDemandInfo, zapIdUsageInfo, zapIdUsageEnvInfo,
+        zapLamIdInfo, lazifyIdDemandInfo, zapIdUsageInfo, zapIdUsageEnvInfo,
         zapIdUsedOnceInfo, zapIdTailCallInfo,
         zapFragileIdInfo, zapIdDmdSig, zapStableUnfolding,
         transferPolyIdInfo, scaleIdBy, scaleVarBy,
@@ -991,8 +991,9 @@ zapLamIdInfo = zapInfo zapLamInfo
 zapFragileIdInfo :: Id -> Id
 zapFragileIdInfo = zapInfo zapFragileInfo
 
-zapIdDemandInfo :: Id -> Id
-zapIdDemandInfo = zapInfo zapDemandInfo
+lazifyIdDemandInfo :: Id -> Id
+-- Lazify (remove the top-level demand, only) the demand on Id
+lazifyIdDemandInfo = zapInfo lazifyDemandInfo
 
 zapIdUsageInfo :: Id -> Id
 zapIdUsageInfo = zapInfo zapUsageInfo


=====================================
compiler/GHC/Types/Id/Info.hs
=====================================
@@ -35,7 +35,7 @@ module GHC.Types.Id.Info (
 
         -- ** Zapping various forms of Info
         zapLamInfo, zapFragileInfo,
-        zapDemandInfo, zapUsageInfo, zapUsageEnvInfo, zapUsedOnceInfo,
+        lazifyDemandInfo, zapUsageInfo, zapUsageEnvInfo, zapUsedOnceInfo,
         zapTailCallInfo, zapCallArityInfo, trimUnfolding,
 
         -- ** The ArityInfo type
@@ -855,11 +855,14 @@ zapLamInfo info@(IdInfo {occInfo = occ, demandInfo = demand})
 
     is_safe_dmd dmd = not (isStrUsedDmd dmd)
 
--- | Remove all demand info on the 'IdInfo'
-zapDemandInfo :: IdInfo -> Maybe IdInfo
-zapDemandInfo info = Just (info {demandInfo = topDmd})
+-- | Lazify (remove the top-level demand, only) the demand in `IdInfo`
+-- Keep nested demands; see Note [Zapping demand info when floating]
+-- in GHC.Core.Opt.SetLevels
+lazifyDemandInfo :: IdInfo -> Maybe IdInfo
+lazifyDemandInfo info@(IdInfo { demandInfo = dmd })
+  = Just (info {demandInfo = lazifyDmd dmd })
 
--- | Remove usage (but not strictness) info on the 'IdInfo'
+-- | Remove usage (but not strictness) info on the `IdInfo`
 zapUsageInfo :: IdInfo -> Maybe IdInfo
 zapUsageInfo info = Just (info {demandInfo = zapUsageDemand (demandInfo info)})
 



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/10ee25c405dde42326eb4ebc82b948f36b748eff

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/10ee25c405dde42326eb4ebc82b948f36b748eff
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/20240722/eeb5e55e/attachment-0001.html>


More information about the ghc-commits mailing list