[Git][ghc/ghc][wip/andreask/deep_discounts] 2 commits: minor touches

[Andreas Klebinger (@AndreasK)]

Andreas Klebinger pushed to branch wip/andreask/deep_discounts at Glasgow Haskell Compiler / GHC


Commits:
c7c19d76 by Andreas Klebinger at 2022-10-18T23:53:33+02:00
minor touches

- - - - -
abf2eb85 by Andreas Klebinger at 2022-10-19T09:36:45+02:00
Only apply minimum value discounts once per top level argument.

- - - - -


5 changed files:

- compiler/GHC/Core.hs
- compiler/GHC/Core/Opt/Simplify/Inline.hs
- compiler/GHC/Core/Opt/Simplify/Utils.hs
- compiler/GHC/Core/Seq.hs
- compiler/GHC/Core/Unfold.hs


Changes:

=====================================
compiler/GHC/Core.hs
=====================================
@@ -41,7 +41,7 @@ module GHC.Core (
         isId, cmpAltCon, cmpAlt, ltAlt,
 
         -- ** Simple 'Expr' access functions and predicates
-        bindersOf, foldBindersOf, bindersOfBinds, rhssOfBind, rhssOfAlts,
+        bindersOf, bindersOfBinds, rhssOfBind, rhssOfAlts,
         collectBinders, collectTyBinders, collectTyAndValBinders,
         collectNBinders, collectNValBinders_maybe,
         collectArgs, stripNArgs, collectArgsTicks, flattenBinds,
@@ -1375,12 +1375,11 @@ data ArgDiscount
 
 instance Outputable ArgDiscount where
   ppr (SomeArgUse n)= text "seq:" <> ppr n
-  ppr (NoSeqUse)= text "lazy use"
-  ppr (FunDisc d f ) = text "fun-"<>ppr f<>text ":"<> ppr d
+  ppr (NoSeqUse)= text "noseq"
+  ppr (FunDisc d f ) = text "fun"<> (whenPprDebug $ brackets (ppr f))<>text ":"<> ppr d
   ppr (DiscSeq d_seq m)
-    | isNullUFM m = text "disc:"<> ppr d_seq
-    | otherwise = sep (punctuate comma ((text "some_con:"<> ppr d_seq) : map ppr (nonDetEltsUFM m)))
-      -- (text "some_con:"<> ppr d_seq) <> text "||" <> braces (pprUFM m ppr)
+    | isNullUFM m = text "seqd:"<> ppr d_seq
+    | otherwise = braces $ vcat (punctuate comma ((text "seqd:"<> ppr d_seq) : map ppr (nonDetEltsUFM m)))
 
 -- | 'UnfoldingGuidance' says when unfolding should take place
 data UnfoldingGuidance


=====================================
compiler/GHC/Core/Opt/Simplify/Inline.hs
=====================================
@@ -570,9 +570,9 @@ and another of 10 if it's some non-trivial value.
 However when computing unfolding guidance we might have come to
 the conclusion that certain argument values deservere little or no
 discount. But we want to chance of inlining to only ever increase as
-more is known about the argument to keep things more predictable. So
-we always give at least 10 discount if the argument is a value. No matter
-what the actual value is.
+more is known about the argument to keep things more predictable. Hence
+we always give at least 10 discount for the argument if it's a value.
+No matter what the actual value is.
 -}
 
 
@@ -591,24 +591,15 @@ computeDiscount arg_discounts !res_discount arg_infos cont_info
     + total_arg_discount + res_discount'
   where
     (applied_arg_length,total_arg_discount) = zipWithSumLength arg_discounts arg_infos
-    -- actual_arg_discounts = zipWith mk_arg_discount (arg_discounts) arg_infos
-    -- total_arg_discount   = sum actual_arg_discounts
 
-    -- See Note [Minimum value discount]
     mk_arg_discount :: ArgDiscount -> ArgSummary -> Int
     mk_arg_discount _        TrivArg    = 0
     mk_arg_discount _        NonTrivArg = 10
     mk_arg_discount NoSeqUse    _       = 10
-    mk_arg_discount discount ValueArg   = max 10 (ad_seq_discount discount)
-    mk_arg_discount (DiscSeq seq_discount con_discounts) (ConArg con args)
-
-      -- There is a discount specific to this constructor, use that.
-      | Just (ConDiscount _ branch_dc arg_discounts) <- lookupUFM con_discounts con
-      = max 10 $ max seq_discount (branch_dc + (sum $ zipWith mk_arg_discount arg_discounts args))
-
-      -- Otherwise give it the generic seq discount
-      | otherwise = max 10 seq_discount
-    mk_arg_discount (SomeArgUse d) ConArg{} = max 10 d
+    mk_arg_discount discount ValueArg   = (ad_seq_discount discount)
+    mk_arg_discount (DiscSeq seq_disc con_discs) (ConArg con args)
+      = get_con_arg_disc seq_disc con_discs con args
+    mk_arg_discount (SomeArgUse d) ConArg{} = d
     mk_arg_discount (FunDisc d _) (ConArg{})
       -- How can this arise? With dictionary constructors for example.
       -- We see C:Show foo bar and give it a FunDisc for being applied
@@ -617,15 +608,27 @@ computeDiscount arg_discounts !res_discount arg_infos cont_info
       -- since well it is one. This is harmless, but a bit odd for sure.
       -- We just treat it like any other boring ValueArg here.
       = -- pprTrace "Function discount for con arg" (ppr arg_infos)
-        max 10 d
+        d
 
-    -- zipWithSumLength xs ys = (length $ zip xs ys, sum $ zipWith _ xs ys)
+    get_con_arg_disc seq_disc con_discs con args
+      -- There is a discount specific to this constructor, use that.
+      | Just (ConDiscount _ branch_dc arg_discounts) <- lookupUFM con_discs con
+      = max seq_disc (branch_dc + (sum $ zipWith mk_arg_discount arg_discounts args))
+
+      -- Otherwise give it the generic seq discount
+      | otherwise = seq_disc
+
+    -- zipWithSumLength xs ys =
+    --    (length $ zip xs ys, sum $ map (mapIfValue (max 10)) $ zipWith mk_arg_discount xs ys)
+    --    but in fast
     zipWithSumLength :: [ArgDiscount] -> [ArgSummary] -> (Int, Int)
     zipWithSumLength dcs args = go 0 0 dcs args
       where
         go !length !discount (dc:dcs) (arg:args) =
-          let arg_discount = mk_arg_discount dc arg
-          in go (1+length) (discount + arg_discount) dcs args
+          let !arg_discount = mk_arg_discount dc arg
+              -- See Note [Minimum value discount]
+              !monotone_arg_discount = if nonTrivArg arg then max 10 arg_discount else arg_discount
+          in go (1+length) (discount + monotone_arg_discount) dcs args
         go l d [] _ = (l,d)
         go l d _ [] = (l,d)
 
@@ -682,6 +685,20 @@ where df is con-like. Then we'd really like to inline 'f' so that the
 rule for (*) (df d) can fire.  To do this
   a) we give a discount for being an argument of a class-op (eg (*) d)
   b) we say that a con-like argument (eg (df d)) is interesting
+
+Note [Class dicts are simple value arguments]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+It's extremely rare that we actually *case* on a class dictionary.
+Instead uses usually are only in argument position like this:
+
+    fromInteger @a_axP $dNum_axQ T21938.foo1
+
+Indeed these days we take care to avoid taking apart class dictionaries
+as it can interfere with specialization. For example see
+Note [Do not unbox class dictionaries]. This means there is little point
+in carefully recording the structure of such dictionary arguments and we
+can get away with simply recording the fact that we know it is in fact an
+value/dictionary which helps with compile time performance.
 -}
 
 interestingArg :: SimplEnv -> CoreExpr -> ArgSummary
@@ -693,7 +710,7 @@ interestingArg env e =
 
     -- n is # value args to which the expression is applied
     go :: SimplEnv -> Int -> Int -> CoreExpr -> ArgSummary
-    go !_env max_depth _n !_
+    go !_env max_depth !_n !_
       | max_depth <= 0 = TrivArg
     go env depth n (Var v)
        = case substId env v of
@@ -734,13 +751,8 @@ interestingArg env e =
 
     go_var depth n v
       | Just rhs <- maybeUnfoldingTemplate (idUnfolding v)
-      , (f, arg_summaries, _ticks) <- mapArgsTicksVal (go env (depth-1) 0) rhs
-      , Var f' <- varView f
-      , Just con <- isDataConId_maybe f'
-      , not (isClassTyCon $ dataConTyCon con)
-      =
-        -- pprTrace "ConArg1" (ppr $ ConArg con $ map (go env 0) args) $
-        ConArg con arg_summaries
+      , Just con_app <- isConApp_maybe rhs
+      = con_app
 
       | Just con <- isDataConId_maybe v
       = ConArg con []
@@ -754,11 +766,21 @@ interestingArg env e =
       where
         conlike_unfolding = isConLikeUnfolding (idUnfolding v)
 
+        isConApp_maybe rhs
+          | (f, arg_summaries, _ticks) <- mapArgsTicksVal (go env (depth-1) 0) rhs
+          , Var f' <- varView f
+          , Just con <- isDataConId_maybe f'
+          -- See Note [Class dicts are simple value arguments]
+          , not (isClassTyCon $ dataConTyCon con)
+          = Just $ ConArg con arg_summaries
+          | otherwise = Nothing
+
+
         varView (Cast e _) = e
         varView (Tick _ e) = e
         varView e = e
 
--- | Like @collectArgs@, but maps over the arguments at the same time.
+-- | Like @collectArgs@, but maps over the arguments at the same time
 -- and also looks through casts.
 mapArgsTicksVal :: (Expr b -> c) -> Expr b
                  -> (Expr b, [c], [CoreTickish])


=====================================
compiler/GHC/Core/Opt/Simplify/Utils.hs
=====================================
@@ -24,8 +24,8 @@ module GHC.Core.Opt.Simplify.Utils (
         SimplCont(..), DupFlag(..), StaticEnv,
         isSimplified, contIsStop,
         contIsDupable, contResultType, contHoleType, contHoleScaling,
-        contIsTrivial, contIsRhs,
-        countArgs, contArgs,
+        contIsTrivial, contArgs, contIsRhs,
+        countArgs,
         mkBoringStop, mkRhsStop, mkLazyArgStop,
         interestingCallContext,
 


=====================================
compiler/GHC/Core/Seq.hs
=====================================
@@ -117,9 +117,6 @@ seqGuidance :: UnfoldingGuidance -> ()
 seqGuidance (UnfIfGoodArgs ns n b) = n `seq` (seqList (map seqArgDiscount ns) ()) `seq` b `seq` ()
 seqGuidance _                      = ()
 
--- seqTopDiscount :: (a, ArgDiscount) -> ()
--- seqTopDiscount (!_,dc) = seqArgDiscount dc
-
 seqArgDiscount :: ArgDiscount -> ()
 seqArgDiscount (DiscSeq !_ sub_args) = seqEltsUFM seqConDiscount sub_args
 seqArgDiscount !_ = ()


=====================================
compiler/GHC/Core/Unfold.hs
=====================================
@@ -163,7 +163,6 @@ updateReportPrefix n opts = opts { unfoldingReportPrefix = n }
 updateMaxDiscountDepth :: Int -> UnfoldingOpts -> UnfoldingOpts
 updateMaxDiscountDepth n opts = opts { unfoldingMaxDiscountDepth = n }
 
-
 {-
 Note [Occurrence analysis of unfoldings]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -274,7 +273,6 @@ calcUnfoldingGuidance opts is_top_bottoming expr
     mk_discount :: VarEnv ArgDiscount -> Id -> (ArgDiscount)
     mk_discount cbs bndr =
         let !dc = lookupWithDefaultVarEnv cbs NoSeqUse bndr
-            -- !depth = discountDepth dc
         in (dc)
 
 {- Note [Inline unsafeCoerce]
@@ -410,37 +408,68 @@ sharing the wrapper closure.
 
 The solution: don’t ignore coercion arguments after all.
 
-Note [Nested discounts]
-~~~~~~~~~~~~~~~~~~~~~~~
-If we have code like:
-
-f :: Either Bool Int -> Int
-f x = case x of
-    Left l -> case l of
-        True -> 1
-        False -> sum [1..200] :: Int
-    Right r -> case r of
-        r -> r + succ r
-
-What should the discount be? I argue it should be a discount *tree* like this:
-    [some_con:62,
-      Left:43
-        [some_con:30, False:10[], True:49[]],
-      Right:70
-        [some_con:20, GHC.Types.I#:11[disc:30]]
-        ]
-
-How can we compute this? While we traverse the expression if we see a case on a interesting
-binder (e.g. x):
-* We look at all the alternatives(Left,Right), treating the constructor bound vars(l,r) as
-  additional interesting binders for their rhss.
-* We compute a default discount `some_con` which assumes we will statically choose the largest
-  alternative if we inline.
-* We compute specific discounts for each constructor alternative by attributing any
-  discount on alternative binders(l,r) to the constructor this alternative is matching on.
-* The discounts for the whole case are then represented by the combination of the flat default discount
-  as well as a list of constructor specific discounts, which carry inside them the discounts for their
-  arguments.
+Note [Deep Discounts]
+~~~~~~~~~~~~~~~~~~~~~
+We used to have a simple model of inlining discounts for function arguments,
+where we would simply compute a numerical value to use as discount if a function
+was applied to a value in this specific argument position. For many functions
+this works reasonably well, however it completely fell apart for generics heavy
+code. The issue arose from code like:
+
+f x y =
+    case x of
+      Just x' -> case x' of x' -> x'
+      Nothing -> y : <veryVeryLarge>
+
+If `f` is applied to `Just y` inlining it at a call site is certainly always the
+right choice. But if the argument is unknown or known to be `Nothing` it could
+be quite bad for code size to do so.
+
+Deep discounts solve this issue. Instead of computing a single numerical discount
+value per argument we compute "deep" discount information. Together with the
+structure of an argument deep discount information can be evaluated to a more
+accurate numerical discount for a concrete argument.
+
+How can we compute this? This is done by sizeExpr where while we traverse
+the expression to compute unfolding guidance we keep track of a set of
+"interesting" binders and if they are used in interesting ways. We are
+seeding this set with the original function arguments.
+The relevant part for deep discounts happens if a subexpression cases on
+an interesting binder, which means:
+* We look at all the alternatives and compute discounts for them under the
+  assumption that case-of-known-con will trigger:
+  + Inside the rhss we are treating the constructor bound vars as additional
+    interesting binders.
+    E.g. in the above example for the `Just x'` case we look for interesting uses
+    of x' inside the RHS.
+  + We compute a discount for each alternative which is the combination of the
+    benefit of having ruled out the other alternatives and the discounts of using
+    any interesting binders inside the rhs of the alternative.
+  * We compute a flat default discount for the whole case expression. For this we
+    simple assume case-of-known-con will select the largest alternative.
+    This discount will be used if we know an argument is a value
+    but we don't have any more information about the exact constructor.
+* The discounts resulting from the case expression is then represented by the
+   combination of the default discount as well as a list of constructor/alternative specific
+  discounts, which carry inside them nested discounts which relate to the binders
+  each alternative binds.
+
+
+For our simple example function above the final discounts will then look
+something like this: [{seqd:110,Nothing:90[],Just:371[seq:20]} noseq].
+* The `noseq` at the end is the discount information for `y` and says that `y`
+  being a value does not warrant any discount.
+* In the curly braces we have the (deep) discount information about the `x` argument.
+  + seqd:110 tells us the discount for generic value argument should be 110
+  + Nothing:90 tells us the discount for a `Nothing` value argument should be
+    somewhat small at 90.
+  + Just:371 let's us now that we should apply a very high discount of 371 if
+    the argument is a `Just` constructor, with an additional discount of 20
+    if the argument to the `Just` constructor itself is also an value.
+
+If later on during simplification we see an application of f:  `f (Just [1]) 1`
+and need to decide on inlining we match up arguments to discounts in a recursive
+fashion. This is done by computeDiscount.
 
 -}
 



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b95caae5a4beca361c002e231b58e9f76bcc23d2...abf2eb85c4a47a4f1ead9cf069da3393f50c45fa

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b95caae5a4beca361c002e231b58e9f76bcc23d2...abf2eb85c4a47a4f1ead9cf069da3393f50c45fa
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/20221020/d0213323/attachment-0001.html>