never executed always true always false
    1 {-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
    2 
    3 -- | Unfolding creation
    4 module GHC.Core.Unfold.Make
    5    ( noUnfolding
    6    , mkUnfolding
    7    , mkCoreUnfolding
    8    , mkFinalUnfolding
    9    , mkSimpleUnfolding
   10    , mkWorkerUnfolding
   11    , mkInlineUnfolding
   12    , mkInlineUnfoldingWithArity
   13    , mkInlinableUnfolding
   14    , mkWrapperUnfolding
   15    , mkCompulsoryUnfolding
   16    , mkCompulsoryUnfolding'
   17    , mkDFunUnfolding
   18    , specUnfolding
   19    , certainlyWillInline
   20    )
   21 where
   22 
   23 import GHC.Prelude
   24 import GHC.Core
   25 import GHC.Core.Unfold
   26 import GHC.Core.Opt.OccurAnal ( occurAnalyseExpr )
   27 import GHC.Core.Opt.Arity   ( manifestArity )
   28 import GHC.Core.DataCon
   29 import GHC.Core.Utils
   30 import GHC.Types.Basic
   31 import GHC.Types.Id
   32 import GHC.Types.Id.Info
   33 import GHC.Types.Demand ( DmdSig, isDeadEndSig )
   34 
   35 import GHC.Utils.Outputable
   36 import GHC.Utils.Misc
   37 import GHC.Utils.Panic
   38 
   39 -- the very simple optimiser is used to optimise unfoldings
   40 import {-# SOURCE #-} GHC.Core.SimpleOpt
   41 
   42 
   43 
   44 mkFinalUnfolding :: UnfoldingOpts -> UnfoldingSource -> DmdSig -> CoreExpr -> Unfolding
   45 -- "Final" in the sense that this is a GlobalId that will not be further
   46 -- simplified; so the unfolding should be occurrence-analysed
   47 mkFinalUnfolding opts src strict_sig expr
   48   = mkUnfolding opts src
   49                 True {- Top level -}
   50                 (isDeadEndSig strict_sig)
   51                 expr
   52 
   53 -- | Used for things that absolutely must be unfolded
   54 mkCompulsoryUnfolding :: SimpleOpts -> CoreExpr -> Unfolding
   55 mkCompulsoryUnfolding opts expr = mkCompulsoryUnfolding' (simpleOptExpr opts expr)
   56 
   57 -- | Same as 'mkCompulsoryUnfolding' but no simple optimiser pass is performed
   58 -- on the unfolding.
   59 mkCompulsoryUnfolding' :: CoreExpr -> Unfolding
   60 mkCompulsoryUnfolding' expr
   61   = mkCoreUnfolding InlineCompulsory True
   62                     expr
   63                     (UnfWhen { ug_arity = 0    -- Arity of unfolding doesn't matter
   64                              , ug_unsat_ok = unSaturatedOk, ug_boring_ok = boringCxtOk })
   65 
   66 -- Note [Top-level flag on inline rules]
   67 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
   68 -- Slight hack: note that mk_inline_rules conservatively sets the
   69 -- top-level flag to True.  It gets set more accurately by the simplifier
   70 -- Simplify.simplUnfolding.
   71 
   72 mkSimpleUnfolding :: UnfoldingOpts -> CoreExpr -> Unfolding
   73 mkSimpleUnfolding !opts rhs
   74   = mkUnfolding opts InlineRhs False False rhs
   75 
   76 mkDFunUnfolding :: [Var] -> DataCon -> [CoreExpr] -> Unfolding
   77 mkDFunUnfolding bndrs con ops
   78   = DFunUnfolding { df_bndrs = bndrs
   79                   , df_con = con
   80                   , df_args = map occurAnalyseExpr ops }
   81                   -- See Note [Occurrence analysis of unfoldings]
   82 
   83 mkWrapperUnfolding :: SimpleOpts -> CoreExpr -> Arity -> Unfolding
   84 -- Make the unfolding for the wrapper in a worker/wrapper split
   85 -- after demand/CPR analysis
   86 mkWrapperUnfolding opts expr arity
   87   = mkCoreUnfolding InlineStable True
   88                     (simpleOptExpr opts expr)
   89                     (UnfWhen { ug_arity     = arity
   90                              , ug_unsat_ok  = unSaturatedOk
   91                              , ug_boring_ok = boringCxtNotOk })
   92 
   93 mkWorkerUnfolding :: SimpleOpts -> (CoreExpr -> CoreExpr) -> Unfolding -> Unfolding
   94 -- See Note [Worker/wrapper for INLINABLE functions] in GHC.Core.Opt.WorkWrap
   95 mkWorkerUnfolding opts work_fn
   96                   (CoreUnfolding { uf_src = src, uf_tmpl = tmpl
   97                                  , uf_is_top = top_lvl })
   98   | isStableSource src
   99   = mkCoreUnfolding src top_lvl new_tmpl guidance
  100   where
  101     new_tmpl = simpleOptExpr opts (work_fn tmpl)
  102     guidance = calcUnfoldingGuidance (so_uf_opts opts) False new_tmpl
  103 
  104 mkWorkerUnfolding _ _ _ = noUnfolding
  105 
  106 -- | Make an unfolding that may be used unsaturated
  107 -- (ug_unsat_ok = unSaturatedOk) and that is reported as having its
  108 -- manifest arity (the number of outer lambdas applications will
  109 -- resolve before doing any work).
  110 mkInlineUnfolding :: SimpleOpts -> CoreExpr -> Unfolding
  111 mkInlineUnfolding opts expr
  112   = mkCoreUnfolding InlineStable
  113                     True         -- Note [Top-level flag on inline rules]
  114                     expr' guide
  115   where
  116     expr' = simpleOptExpr opts expr
  117     guide = UnfWhen { ug_arity = manifestArity expr'
  118                     , ug_unsat_ok = unSaturatedOk
  119                     , ug_boring_ok = boring_ok }
  120     boring_ok = inlineBoringOk expr'
  121 
  122 -- | Make an unfolding that will be used once the RHS has been saturated
  123 -- to the given arity.
  124 mkInlineUnfoldingWithArity :: Arity -> SimpleOpts -> CoreExpr -> Unfolding
  125 mkInlineUnfoldingWithArity arity opts expr
  126   = mkCoreUnfolding InlineStable
  127                     True         -- Note [Top-level flag on inline rules]
  128                     expr' guide
  129   where
  130     expr' = simpleOptExpr opts expr
  131     guide = UnfWhen { ug_arity = arity
  132                     , ug_unsat_ok = needSaturated
  133                     , ug_boring_ok = boring_ok }
  134     -- See Note [INLINE pragmas and boring contexts] as to why we need to look
  135     -- at the arity here.
  136     boring_ok | arity == 0 = True
  137               | otherwise  = inlineBoringOk expr'
  138 
  139 mkInlinableUnfolding :: SimpleOpts -> CoreExpr -> Unfolding
  140 mkInlinableUnfolding opts expr
  141   = mkUnfolding (so_uf_opts opts) InlineStable False False expr'
  142   where
  143     expr' = simpleOptExpr opts expr
  144 
  145 specUnfolding :: SimpleOpts
  146               -> [Var] -> (CoreExpr -> CoreExpr)
  147               -> [CoreArg]   -- LHS arguments in the RULE
  148               -> Unfolding -> Unfolding
  149 -- See Note [Specialising unfoldings]
  150 -- specUnfolding spec_bndrs spec_args unf
  151 --   = \spec_bndrs. unf spec_args
  152 --
  153 specUnfolding opts spec_bndrs spec_app rule_lhs_args
  154               df@(DFunUnfolding { df_bndrs = old_bndrs, df_con = con, df_args = args })
  155   = assertPpr (rule_lhs_args `equalLength` old_bndrs)
  156               (ppr df $$ ppr rule_lhs_args) $
  157            -- For this ASSERT see Note [DFunUnfoldings] in GHC.Core.Opt.Specialise
  158     mkDFunUnfolding spec_bndrs con (map spec_arg args)
  159       -- For DFunUnfoldings we transform
  160       --       \obs. MkD <op1> ... <opn>
  161       -- to
  162       --       \sbs. MkD ((\obs. <op1>) spec_args) ... ditto <opn>
  163   where
  164     spec_arg arg = simpleOptExpr opts $
  165                    spec_app (mkLams old_bndrs arg)
  166                    -- The beta-redexes created by spec_app will be
  167                    -- simplified away by simplOptExpr
  168 
  169 specUnfolding opts spec_bndrs spec_app rule_lhs_args
  170               (CoreUnfolding { uf_src = src, uf_tmpl = tmpl
  171                              , uf_is_top = top_lvl
  172                              , uf_guidance = old_guidance })
  173  | isStableSource src  -- See Note [Specialising unfoldings]
  174  , UnfWhen { ug_arity = old_arity } <- old_guidance
  175  = mkCoreUnfolding src top_lvl new_tmpl
  176                    (old_guidance { ug_arity = old_arity - arity_decrease })
  177  where
  178    new_tmpl = simpleOptExpr opts $
  179               mkLams spec_bndrs  $
  180               spec_app tmpl  -- The beta-redexes created by spec_app
  181                              -- will be simplified away by simplOptExpr
  182    arity_decrease = count isValArg rule_lhs_args - count isId spec_bndrs
  183 
  184 
  185 specUnfolding _ _ _ _ _ = noUnfolding
  186 
  187 {- Note [Specialising unfoldings]
  188 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  189 When we specialise a function for some given type-class arguments, we use
  190 specUnfolding to specialise its unfolding.  Some important points:
  191 
  192 * If the original function has a DFunUnfolding, the specialised one
  193   must do so too!  Otherwise we lose the magic rules that make it
  194   interact with ClassOps
  195 
  196 * There is a bit of hack for INLINABLE functions:
  197      f :: Ord a => ....
  198      f = <big-rhs>
  199      {- INLINABLE f #-}
  200   Now if we specialise f, should the specialised version still have
  201   an INLINABLE pragma?  If it does, we'll capture a specialised copy
  202   of <big-rhs> as its unfolding, and that probably won't inline.  But
  203   if we don't, the specialised version of <big-rhs> might be small
  204   enough to inline at a call site. This happens with Control.Monad.liftM3,
  205   and can cause a lot more allocation as a result (nofib n-body shows this).
  206 
  207   Moreover, keeping the INLINABLE thing isn't much help, because
  208   the specialised function (probably) isn't overloaded any more.
  209 
  210   Conclusion: drop the INLINEALE pragma.  In practice what this means is:
  211      if a stable unfolding has UnfoldingGuidance of UnfWhen,
  212         we keep it (so the specialised thing too will always inline)
  213      if a stable unfolding has UnfoldingGuidance of UnfIfGoodArgs
  214         (which arises from INLINABLE), we discard it
  215 
  216 Note [Honour INLINE on 0-ary bindings]
  217 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  218 Consider
  219 
  220    x = <expensive>
  221    {-# INLINE x #-}
  222 
  223    f y = ...x...
  224 
  225 The semantics of an INLINE pragma is
  226 
  227   inline x at every call site, provided it is saturated;
  228   that is, applied to at least as many arguments as appear
  229   on the LHS of the Haskell source definition.
  230 
  231 (This source-code-derived arity is stored in the `ug_arity` field of
  232 the `UnfoldingGuidance`.)
  233 
  234 In the example, x's ug_arity is 0, so we should inline it at every use
  235 site.  It's rare to have such an INLINE pragma (usually INLINE is on
  236 functions), but it's occasionally very important (#15578, #15519).
  237 In #15519 we had something like
  238    x = case (g a b) of I# r -> T r
  239    {-# INLINE x #-}
  240    f y = ...(h x)....
  241 
  242 where h is strict.  So we got
  243    f y = ...(case g a b of I# r -> h (T r))...
  244 
  245 and that in turn allowed SpecConstr to ramp up performance.
  246 
  247 How do we deliver on this?  By adjusting the ug_boring_ok
  248 flag in mkInlineUnfoldingWithArity; see
  249 Note [INLINE pragmas and boring contexts]
  250 
  251 NB: there is a real risk that full laziness will float it right back
  252 out again. Consider again
  253   x = factorial 200
  254   {-# INLINE x #-}
  255   f y = ...x...
  256 
  257 After inlining we get
  258   f y = ...(factorial 200)...
  259 
  260 but it's entirely possible that full laziness will do
  261   lvl23 = factorial 200
  262   f y = ...lvl23...
  263 
  264 That's a problem for another day.
  265 
  266 Note [INLINE pragmas and boring contexts]
  267 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  268 An INLINE pragma uses mkInlineUnfoldingWithArity to build the
  269 unfolding.  That sets the ug_boring_ok flag to False if the function
  270 is not tiny (inlineBoringOK), so that even INLINE functions are not
  271 inlined in an utterly boring context.  E.g.
  272      \x y. Just (f y x)
  273 Nothing is gained by inlining f here, even if it has an INLINE
  274 pragma.
  275 
  276 But for 0-ary bindings, we want to inline regardless; see
  277 Note [Honour INLINE on 0-ary bindings].
  278 
  279 I'm a bit worried that it's possible for the same kind of problem
  280 to arise for non-0-ary functions too, but let's wait and see.
  281 -}
  282 
  283 mkUnfolding :: UnfoldingOpts
  284             -> UnfoldingSource
  285             -> Bool       -- Is top-level
  286             -> Bool       -- Definitely a bottoming binding
  287                           -- (only relevant for top-level bindings)
  288             -> CoreExpr
  289             -> Unfolding
  290 -- Calculates unfolding guidance
  291 -- Occurrence-analyses the expression before capturing it
  292 mkUnfolding opts src top_lvl is_bottoming expr
  293   = mkCoreUnfolding src top_lvl expr guidance
  294   where
  295     is_top_bottoming = top_lvl && is_bottoming
  296     guidance         = calcUnfoldingGuidance opts is_top_bottoming expr
  297         -- NB: *not* (calcUnfoldingGuidance (occurAnalyseExpr expr))!
  298         -- See Note [Calculate unfolding guidance on the non-occ-anal'd expression]
  299 
  300 mkCoreUnfolding :: UnfoldingSource -> Bool -> CoreExpr
  301                 -> UnfoldingGuidance -> Unfolding
  302 -- Occurrence-analyses the expression before capturing it
  303 mkCoreUnfolding src top_lvl expr guidance
  304   = CoreUnfolding { uf_tmpl         = occurAnalyseExpr expr,
  305                       -- See Note [Occurrence analysis of unfoldings]
  306                     uf_src          = src,
  307                     uf_is_top       = top_lvl,
  308                     uf_is_value     = exprIsHNF        expr,
  309                     uf_is_conlike   = exprIsConLike    expr,
  310                     uf_is_work_free = exprIsWorkFree   expr,
  311                     uf_expandable   = exprIsExpandable expr,
  312                     uf_guidance     = guidance }
  313 
  314 ----------------
  315 certainlyWillInline :: UnfoldingOpts -> IdInfo -> CoreExpr -> Maybe Unfolding
  316 -- ^ Sees if the unfolding is pretty certain to inline.
  317 -- If so, return a *stable* unfolding for it, that will always inline.
  318 -- The CoreExpr is the WW'd and simplified RHS. In contrast, the unfolding
  319 -- template might not have been WW'd yet.
  320 certainlyWillInline opts fn_info rhs'
  321   = case fn_unf of
  322       CoreUnfolding { uf_guidance = guidance, uf_src = src }
  323         | noinline -> Nothing       -- See Note [Worker/wrapper for NOINLINE functions]
  324         | otherwise
  325         -> case guidance of
  326              UnfNever   -> Nothing
  327              UnfWhen {} -> Just (fn_unf { uf_src = src', uf_tmpl = tmpl' })
  328                              -- INLINE functions have UnfWhen
  329              UnfIfGoodArgs { ug_size = size, ug_args = args }
  330                         -> do_cunf size args src' tmpl'
  331         where
  332           src' = -- Do not change InlineCompulsory!
  333                  case src of
  334                    InlineCompulsory -> InlineCompulsory
  335                    _                -> InlineStable
  336           tmpl' = -- Do not overwrite stable unfoldings!
  337                   case src of
  338                     InlineRhs -> occurAnalyseExpr rhs'
  339                     _         -> uf_tmpl fn_unf
  340 
  341       DFunUnfolding {} -> Just fn_unf  -- Don't w/w DFuns; it never makes sense
  342                                        -- to do so, and even if it is currently a
  343                                        -- loop breaker, it may not be later
  344 
  345       _other_unf       -> Nothing
  346 
  347   where
  348     noinline = isNoInlinePragma (inlinePragInfo fn_info)
  349     fn_unf   = unfoldingInfo fn_info -- NB: loop-breakers never inline
  350 
  351         -- The UnfIfGoodArgs case seems important.  If we w/w small functions
  352         -- binary sizes go up by 10%!  (This is with SplitObjs.)
  353         -- I'm not totally sure why.
  354         -- INLINABLE functions come via this path
  355         --    See Note [certainlyWillInline: INLINABLE]
  356     do_cunf size args src' tmpl'
  357       | arityInfo fn_info > 0  -- See Note [certainlyWillInline: be careful of thunks]
  358       , not (isDeadEndSig (dmdSigInfo fn_info))
  359               -- Do not unconditionally inline a bottoming functions even if
  360               -- it seems smallish. We've carefully lifted it out to top level,
  361               -- so we don't want to re-inline it.
  362       , let unf_arity = length args
  363       , size - (10 * (unf_arity + 1)) <= unfoldingUseThreshold opts
  364       = Just (fn_unf { uf_src      = src'
  365                      , uf_tmpl     = tmpl'
  366                      , uf_guidance = UnfWhen { ug_arity     = unf_arity
  367                                              , ug_unsat_ok  = unSaturatedOk
  368                                              , ug_boring_ok = inlineBoringOk tmpl' } })
  369              -- Note the "unsaturatedOk". A function like  f = \ab. a
  370              -- will certainly inline, even if partially applied (f e), so we'd
  371              -- better make sure that the transformed inlining has the same property
  372       | otherwise
  373       = Nothing
  374 
  375 {- Note [certainlyWillInline: be careful of thunks]
  376 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  377 Don't claim that thunks will certainly inline, because that risks work
  378 duplication.  Even if the work duplication is not great (eg is_cheap
  379 holds), it can make a big difference in an inner loop In #5623 we
  380 found that the WorkWrap phase thought that
  381        y = case x of F# v -> F# (v +# v)
  382 was certainlyWillInline, so the addition got duplicated.
  383 
  384 Note that we check arityInfo instead of the arity of the unfolding to detect
  385 this case. This is so that we don't accidentally fail to inline small partial
  386 applications, like `f = g 42` (where `g` recurses into `f`) where g has arity 2
  387 (say). Here there is no risk of work duplication, and the RHS is tiny, so
  388 certainlyWillInline should return True. But `unf_arity` is zero! However f's
  389 arity, gotten from `arityInfo fn_info`, is 1.
  390 
  391 Failing to say that `f` will inline forces W/W to generate a potentially huge
  392 worker for f that will immediately cancel with `g`'s wrapper anyway, causing
  393 unnecessary churn in the Simplifier while arriving at the same result.
  394 
  395 Note [certainlyWillInline: INLINABLE]
  396 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  397 certainlyWillInline /must/ return Nothing for a large INLINABLE thing,
  398 even though we have a stable inlining, so that strictness w/w takes
  399 place.  It makes a big difference to efficiency, and the w/w pass knows
  400 how to transfer the INLINABLE info to the worker; see WorkWrap
  401 Note [Worker/wrapper for INLINABLE functions]
  402 -}