[Git][ghc/ghc][wip/T18962] 2 commits: SAT: Attach SAT'd definition as INLINABLE unfolding

[Sebastian Graf]

Sebastian Graf pushed to branch wip/T18962 at Glasgow Haskell Compiler / GHC


Commits:
db633a78 by Sebastian Graf at 2020-12-02T02:16:45+01:00
SAT: Attach SAT'd definition as INLINABLE unfolding

SAT is most beneficial if we can specialise a recursive function for
the static arguments at a call site by inlining it.

>From the standpoint of generated code, the SAT'd definition is very
often inferior and will be inverted by our selective lambda lifting
pass, which runs late in the STG pipeline.

So we don't even want to execute the SAT'd code, just inline it if we
can! So we just attach an INLINABLE unfolding to a SAT'able function
with the non-recursive SAT'd RHS.

- - - - -
1822f12a by Sebastian Graf at 2020-12-02T02:16:45+01:00
Activate SAT with -O1

To see whether it breaks in CI and so on

- - - - -


3 changed files:

- compiler/GHC/Core/Opt/StaticArgs.hs
- compiler/GHC/Core/SimpleOpt.hs
- compiler/GHC/Driver/Session.hs


Changes:

=====================================
compiler/GHC/Core/Opt/StaticArgs.hs
=====================================
@@ -31,6 +31,12 @@ map = /\ ab -> \f -> \xs -> let map' ys = case ys of
 Notice that for a compiler that uses lambda lifting this is
 useless as map' will be transformed back to what map was.
 
+SG: We do selective lambda lifting, but only for code generation, as
+an alternative to closure conversion. And when lambda lifting fires, it
+makes sure it reduces allocation. The benefit of SAT is from being able
+to specialise for static args and the resulting simplifications! If the
+static arg is left unexploited, we actually end up with worse code.
+
 We could possibly do the same for big lambdas, but we don't as
 they will eventually be removed in later stages of the compiler,
 therefore there is no penalty in keeping them.
@@ -59,6 +65,8 @@ import GHC.Core
 import GHC.Core.Utils
 import GHC.Core.Type
 import GHC.Core.Coercion
+import GHC.Core.SimpleOpt (defaultSimpleOpts)
+import GHC.Core.Unfold.Make (mkInlinableUnfolding)
 import GHC.Types.Id
 import GHC.Types.Name
 import GHC.Types.Var.Env
@@ -95,16 +103,23 @@ satBind (Rec [(binder, rhs)]) interesting_ids = do
     let interesting_ids' = interesting_ids `addOneToUniqSet` binder
         (rhs_binders, rhs_body) = collectBinders rhs
     (rhs_body', sat_info_rhs_body) <- satTopLevelExpr rhs_body interesting_ids'
+    -- The following two lines intersect the SATInfo from call sites with
+    -- the order of parameters from the *definition* (sat_info_rhs_from_args)
+    -- Ex: If we have the only call site @f a v@, but the defn of @f@ is
+    -- @f a b = ...@, then @a@ is a static arg, but @v@ is not.
+    -- TODO: better names!!
     let sat_info_rhs_from_args = unitVarEnv binder (bindersToSATInfo rhs_binders)
         sat_info_rhs' = mergeIdSATInfo sat_info_rhs_from_args sat_info_rhs_body
 
+        -- I don't think the following lines are effective at guarding against
+        -- shadowing:
         shadowing = binder `elementOfUniqSet` interesting_ids
         sat_info_rhs'' = if shadowing
                         then sat_info_rhs' `delFromUFM` binder -- For safety
                         else sat_info_rhs'
 
-    bind' <- saTransformMaybe binder (lookupUFM sat_info_rhs' binder)
-                              rhs_binders rhs_body'
+    bind' <- saTransformUnfolding binder (lookupUFM sat_info_rhs' binder)
+                                  rhs_binders rhs_body'
     return (bind', sat_info_rhs'')
 satBind (Rec pairs) interesting_ids = do
     let (binders, rhss) = unzip pairs
@@ -163,7 +178,7 @@ mergeIdSATInfo = plusUFM_C mergeSATInfo
 mergeIdSATInfos :: [IdSATInfo] -> IdSATInfo
 mergeIdSATInfos = foldl' mergeIdSATInfo emptyIdSATInfo
 
-bindersToSATInfo :: [Id] -> SATInfo
+bindersToSATInfo :: [Var] -> SATInfo
 bindersToSATInfo vs = map (Static . binderToApp) vs
     where binderToApp v | isId v    = VarApp v
                         | isTyVar v = TypeApp $ mkTyVarTy v
@@ -271,6 +286,7 @@ newUnique = getUniqueM
 
 ************************************************************************
 
+SG: This is incomprehensible without giving the map example first.
 To do the transformation, the game plan is to:
 
 1. Create a small nonrecursive RHS that takes the
@@ -367,8 +383,8 @@ type argument. This is bad because it means the application sat_worker_s1aU x_a6
 is not well typed.
 -}
 
-saTransformMaybe :: Id -> Maybe SATInfo -> [Id] -> CoreExpr -> SatM CoreBind
-saTransformMaybe binder maybe_arg_staticness rhs_binders rhs_body
+_saTransformMaybe :: Id -> Maybe SATInfo -> [Id] -> CoreExpr -> SatM CoreBind
+_saTransformMaybe binder maybe_arg_staticness rhs_binders rhs_body
   | Just arg_staticness <- maybe_arg_staticness
   , should_transform arg_staticness
   = saTransform binder arg_staticness rhs_binders rhs_body
@@ -379,6 +395,17 @@ saTransformMaybe binder maybe_arg_staticness rhs_binders rhs_body
       where
         n_static_args = count isStaticValue staticness
 
+saTransformUnfolding :: Id -> Maybe SATInfo -> [Id] -> CoreExpr -> SatM CoreBind
+saTransformUnfolding binder maybe_arg_staticness rhs_binders rhs_body
+  | Just arg_staticness <- maybe_arg_staticness
+  , any isStaticValue arg_staticness
+  , not (isStableUnfolding (idUnfolding binder))
+  = do  { NonRec _binder' rhs' <- saTransform binder arg_staticness rhs_binders rhs_body
+        ; let binder' = binder `setIdUnfolding` mkInlinableUnfolding defaultSimpleOpts rhs'
+        ; return (Rec [(binder', mkLams rhs_binders rhs_body)]) }
+  | otherwise
+  = return (Rec [(binder, mkLams rhs_binders rhs_body)])
+
 saTransform :: Id -> SATInfo -> [Id] -> CoreExpr -> SatM CoreBind
 saTransform binder arg_staticness rhs_binders rhs_body
   = do  { shadow_lam_bndrs <- mapM clone binders_w_staticness


=====================================
compiler/GHC/Core/SimpleOpt.hs
=====================================
@@ -93,6 +93,11 @@ data SimpleOpts = SimpleOpts
    { so_uf_opts :: !UnfoldingOpts   -- ^ Unfolding options
    , so_co_opts :: !OptCoercionOpts -- ^ Coercion optimiser options
    }
+-- SG: I find the name "SimpleOpts" terrible. It's misleading in multiple ways:
+-- You'd read it and mistake it for *Simpl*Opts, options for the Simplifier.
+-- And you might mistake it for Simple*Opts*, simple options for ... what?
+-- And then SimpleOptOpts would be less missleading, but ugly because OptOpts.
+-- So why not SimpleOptConfig?
 
 -- | Default options for the Simple optimiser.
 defaultSimpleOpts :: SimpleOpts


=====================================
compiler/GHC/Driver/Session.hs
=====================================
@@ -4015,7 +4015,7 @@ optLevelFlags -- see Note [Documenting optimisation flags]
     , ([2],     Opt_SpecConstr)
 --  , ([2],     Opt_RegsGraph)
 --   RegsGraph suffers performance regression. See #7679
---  , ([2],     Opt_StaticArgumentTransformation)
+    , ([1,2],     Opt_StaticArgumentTransformation)
 --   Static Argument Transformation needs investigation. See #9374
     ]
 



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7e1fd0f7ff638d5acc13bb84a11819c7fc4745b3...1822f12a313da30fed1cca513a7c26c8620aaeb5

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7e1fd0f7ff638d5acc13bb84a11819c7fc4745b3...1822f12a313da30fed1cca513a7c26c8620aaeb5
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/20201201/200ec69c/attachment-0001.html>