never executed always true always false
    1 {-
    2 (c) The University of Glasgow 2006
    3 (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
    4 -}
    5 
    6 
    7 module GHC.Core.SimpleOpt (
    8         SimpleOpts (..), defaultSimpleOpts,
    9 
   10         -- ** Simple expression optimiser
   11         simpleOptPgm, simpleOptExpr, simpleOptExprWith,
   12 
   13         -- ** Join points
   14         joinPointBinding_maybe, joinPointBindings_maybe,
   15 
   16         -- ** Predicates on expressions
   17         exprIsConApp_maybe, exprIsLiteral_maybe, exprIsLambda_maybe,
   18 
   19     ) where
   20 
   21 import GHC.Prelude
   22 
   23 import GHC.Core
   24 import GHC.Core.Opt.Arity
   25 import GHC.Core.Subst
   26 import GHC.Core.Utils
   27 import GHC.Core.FVs
   28 import GHC.Core.Unfold
   29 import GHC.Core.Unfold.Make
   30 import GHC.Core.Make ( FloatBind(..) )
   31 import GHC.Core.Opt.OccurAnal( occurAnalyseExpr, occurAnalysePgm )
   32 import GHC.Types.Literal
   33 import GHC.Types.Id
   34 import GHC.Types.Id.Info  ( realUnfoldingInfo, setUnfoldingInfo, setRuleInfo, IdInfo (..) )
   35 import GHC.Types.Var      ( isNonCoVarId )
   36 import GHC.Types.Var.Set
   37 import GHC.Types.Var.Env
   38 import GHC.Core.DataCon
   39 import GHC.Types.Demand( etaConvertDmdSig )
   40 import GHC.Types.Tickish
   41 import GHC.Core.Coercion.Opt ( optCoercion, OptCoercionOpts (..) )
   42 import GHC.Core.Type hiding ( substTy, extendTvSubst, extendCvSubst, extendTvSubstList
   43                             , isInScope, substTyVarBndr, cloneTyVarBndr )
   44 import GHC.Core.Coercion hiding ( substCo, substCoVarBndr )
   45 import GHC.Builtin.Types
   46 import GHC.Builtin.Names
   47 import GHC.Types.Basic
   48 import GHC.Unit.Module ( Module )
   49 import GHC.Utils.Encoding
   50 import GHC.Utils.Outputable
   51 import GHC.Utils.Panic
   52 import GHC.Utils.Panic.Plain
   53 import GHC.Utils.Misc
   54 import GHC.Data.Maybe       ( orElse )
   55 import Data.List (mapAccumL)
   56 import qualified Data.ByteString as BS
   57 
   58 {-
   59 ************************************************************************
   60 *                                                                      *
   61         The Simple Optimiser
   62 *                                                                      *
   63 ************************************************************************
   64 
   65 Note [The simple optimiser]
   66 ~~~~~~~~~~~~~~~~~~~~~~~~~~~
   67 The simple optimiser is a lightweight, pure (non-monadic) function
   68 that rapidly does a lot of simple optimisations, including
   69 
   70   - inlining things that occur just once,
   71       or whose RHS turns out to be trivial
   72   - beta reduction
   73   - case of known constructor
   74   - dead code elimination
   75 
   76 It does NOT do any call-site inlining; it only inlines a function if
   77 it can do so unconditionally, dropping the binding.  It thereby
   78 guarantees to leave no un-reduced beta-redexes.
   79 
   80 It is careful to follow the guidance of "Secrets of the GHC inliner",
   81 and in particular the pre-inline-unconditionally and
   82 post-inline-unconditionally story, to do effective beta reduction on
   83 functions called precisely once, without repeatedly optimising the same
   84 expression.  In fact, the simple optimiser is a good example of this
   85 little dance in action; the full Simplifier is a lot more complicated.
   86 
   87 -}
   88 
   89 -- | Simple optimiser options
   90 data SimpleOpts = SimpleOpts
   91    { so_uf_opts :: !UnfoldingOpts   -- ^ Unfolding options
   92    , so_co_opts :: !OptCoercionOpts -- ^ Coercion optimiser options
   93    }
   94 
   95 -- | Default options for the Simple optimiser.
   96 defaultSimpleOpts :: SimpleOpts
   97 defaultSimpleOpts = SimpleOpts
   98    { so_uf_opts = defaultUnfoldingOpts
   99    , so_co_opts = OptCoercionOpts
  100       { optCoercionEnabled = False }
  101    }
  102 
  103 simpleOptExpr :: HasDebugCallStack => SimpleOpts -> CoreExpr -> CoreExpr
  104 -- See Note [The simple optimiser]
  105 -- Do simple optimisation on an expression
  106 -- The optimisation is very straightforward: just
  107 -- inline non-recursive bindings that are used only once,
  108 -- or where the RHS is trivial
  109 --
  110 -- We also inline bindings that bind a Eq# box: see
  111 -- See Note [Getting the map/coerce RULE to work].
  112 --
  113 -- Also we convert functions to join points where possible (as
  114 -- the occurrence analyser does most of the work anyway).
  115 --
  116 -- The result is NOT guaranteed occurrence-analysed, because
  117 -- in  (let x = y in ....) we substitute for x; so y's occ-info
  118 -- may change radically
  119 --
  120 -- Note that simpleOptExpr is a pure function that we want to be able to call
  121 -- from lots of places, including ones that don't have DynFlags (e.g to optimise
  122 -- unfoldings of statically defined Ids via mkCompulsoryUnfolding). It used to
  123 -- fetch its options directly from the DynFlags, however, so some callers had to
  124 -- resort to using unsafeGlobalDynFlags (a global mutable variable containing
  125 -- the DynFlags). It has been modified to take its own SimpleOpts that may be
  126 -- created from DynFlags, but not necessarily.
  127 
  128 simpleOptExpr opts expr
  129   = -- pprTrace "simpleOptExpr" (ppr init_subst $$ ppr expr)
  130     simpleOptExprWith opts init_subst expr
  131   where
  132     init_subst = mkEmptySubst (mkInScopeSet (exprFreeVars expr))
  133         -- It's potentially important to make a proper in-scope set
  134         -- Consider  let x = ..y.. in \y. ...x...
  135         -- Then we should remember to clone y before substituting
  136         -- for x.  It's very unlikely to occur, because we probably
  137         -- won't *be* substituting for x if it occurs inside a
  138         -- lambda.
  139         --
  140         -- It's a bit painful to call exprFreeVars, because it makes
  141         -- three passes instead of two (occ-anal, and go)
  142 
  143 simpleOptExprWith :: HasDebugCallStack => SimpleOpts -> Subst -> InExpr -> OutExpr
  144 -- See Note [The simple optimiser]
  145 simpleOptExprWith opts subst expr
  146   = simple_opt_expr init_env (occurAnalyseExpr expr)
  147   where
  148     init_env = (emptyEnv opts) { soe_subst = subst }
  149 
  150 ----------------------
  151 simpleOptPgm :: SimpleOpts
  152              -> Module
  153              -> CoreProgram
  154              -> [CoreRule]
  155              -> (CoreProgram, [CoreRule], CoreProgram)
  156 -- See Note [The simple optimiser]
  157 simpleOptPgm opts this_mod binds rules =
  158     (reverse binds', rules', occ_anald_binds)
  159   where
  160     occ_anald_binds  = occurAnalysePgm this_mod
  161                           (\_ -> True)  {- All unfoldings active -}
  162                           (\_ -> False) {- No rules active -}
  163                           rules binds
  164 
  165     (final_env, binds') = foldl' do_one (emptyEnv opts, []) occ_anald_binds
  166     final_subst = soe_subst final_env
  167 
  168     rules' = substRulesForImportedIds final_subst rules
  169              -- We never unconditionally inline into rules,
  170              -- hence paying just a substitution
  171 
  172     do_one (env, binds') bind
  173       = case simple_opt_bind env bind TopLevel of
  174           (env', Nothing)    -> (env', binds')
  175           (env', Just bind') -> (env', bind':binds')
  176 
  177 -- In these functions the substitution maps InVar -> OutExpr
  178 
  179 ----------------------
  180 type SimpleClo = (SimpleOptEnv, InExpr)
  181 
  182 data SimpleOptEnv
  183   = SOE { soe_co_opt_opts :: !OptCoercionOpts
  184              -- ^ Options for the coercion optimiser
  185 
  186         , soe_uf_opts :: !UnfoldingOpts
  187              -- ^ Unfolding options
  188 
  189         , soe_inl   :: IdEnv SimpleClo
  190              -- ^ Deals with preInlineUnconditionally; things
  191              -- that occur exactly once and are inlined
  192              -- without having first been simplified
  193 
  194         , soe_subst :: Subst
  195              -- ^ Deals with cloning; includes the InScopeSet
  196         }
  197 
  198 instance Outputable SimpleOptEnv where
  199   ppr (SOE { soe_inl = inl, soe_subst = subst })
  200     = text "SOE {" <+> vcat [ text "soe_inl   =" <+> ppr inl
  201                             , text "soe_subst =" <+> ppr subst ]
  202                    <+> text "}"
  203 
  204 emptyEnv :: SimpleOpts -> SimpleOptEnv
  205 emptyEnv opts = SOE
  206    { soe_inl         = emptyVarEnv
  207    , soe_subst       = emptySubst
  208    , soe_co_opt_opts = so_co_opts opts
  209    , soe_uf_opts     = so_uf_opts opts
  210    }
  211 
  212 soeZapSubst :: SimpleOptEnv -> SimpleOptEnv
  213 soeZapSubst env@(SOE { soe_subst = subst })
  214   = env { soe_inl = emptyVarEnv, soe_subst = zapSubstEnv subst }
  215 
  216 soeSetInScope :: SimpleOptEnv -> SimpleOptEnv -> SimpleOptEnv
  217 -- Take in-scope set from env1, and the rest from env2
  218 soeSetInScope (SOE { soe_subst = subst1 })
  219               env2@(SOE { soe_subst = subst2 })
  220   = env2 { soe_subst = setInScope subst2 (substInScope subst1) }
  221 
  222 ---------------
  223 simple_opt_clo :: SimpleOptEnv -> SimpleClo -> OutExpr
  224 simple_opt_clo env (e_env, e)
  225   = simple_opt_expr (soeSetInScope env e_env) e
  226 
  227 simple_opt_expr :: HasCallStack => SimpleOptEnv -> InExpr -> OutExpr
  228 simple_opt_expr env expr
  229   = go expr
  230   where
  231     subst        = soe_subst env
  232     in_scope     = substInScope subst
  233     in_scope_env = (in_scope, simpleUnfoldingFun)
  234 
  235     ---------------
  236     go (Var v)
  237        | Just clo <- lookupVarEnv (soe_inl env) v
  238        = simple_opt_clo env clo
  239        | otherwise
  240        = lookupIdSubst (soe_subst env) v
  241 
  242     go (App e1 e2)      = simple_app env e1 [(env,e2)]
  243     go (Type ty)        = Type     (substTy subst ty)
  244     go (Coercion co)    = Coercion (go_co co)
  245     go (Lit lit)        = Lit lit
  246     go (Tick tickish e) = mkTick (substTickish subst tickish) (go e)
  247     go (Cast e co)      = mk_cast (go e) (go_co co)
  248     go (Let bind body)  = case simple_opt_bind env bind NotTopLevel of
  249                              (env', Nothing)   -> simple_opt_expr env' body
  250                              (env', Just bind) -> Let bind (simple_opt_expr env' body)
  251 
  252     go lam@(Lam {})     = go_lam env [] lam
  253     go (Case e b ty as)
  254        -- See Note [Getting the map/coerce RULE to work]
  255       | isDeadBinder b
  256       , Just (_, [], con, _tys, es) <- exprIsConApp_maybe in_scope_env e'
  257         -- We don't need to be concerned about floats when looking for coerce.
  258       , Just (Alt altcon bs rhs) <- findAlt (DataAlt con) as
  259       = case altcon of
  260           DEFAULT -> go rhs
  261           _       -> foldr wrapLet (simple_opt_expr env' rhs) mb_prs
  262             where
  263               (env', mb_prs) = mapAccumL (simple_out_bind NotTopLevel) env $
  264                                zipEqual "simpleOptExpr" bs es
  265 
  266          -- Note [Getting the map/coerce RULE to work]
  267       | isDeadBinder b
  268       , [Alt DEFAULT _ rhs] <- as
  269       , isCoVarType (varType b)
  270       , (Var fun, _args) <- collectArgs e
  271       , fun `hasKey` coercibleSCSelIdKey
  272          -- without this last check, we get #11230
  273       = go rhs
  274 
  275       | otherwise
  276       = Case e' b' (substTy subst ty)
  277                    (map (go_alt env') as)
  278       where
  279         e' = go e
  280         (env', b') = subst_opt_bndr env b
  281 
  282     ----------------------
  283     go_co co = optCoercion (soe_co_opt_opts env) (getTCvSubst subst) co
  284 
  285     ----------------------
  286     go_alt env (Alt con bndrs rhs)
  287       = Alt con bndrs' (simple_opt_expr env' rhs)
  288       where
  289         (env', bndrs') = subst_opt_bndrs env bndrs
  290 
  291     ----------------------
  292     -- go_lam tries eta reduction
  293     go_lam env bs' (Lam b e)
  294        = go_lam env' (b':bs') e
  295        where
  296          (env', b') = subst_opt_bndr env b
  297     go_lam env bs' e
  298        | Just etad_e <- tryEtaReduce bs e' = etad_e
  299        | otherwise                         = mkLams bs e'
  300        where
  301          bs = reverse bs'
  302          e' = simple_opt_expr env e
  303 
  304 mk_cast :: CoreExpr -> CoercionR -> CoreExpr
  305 -- Like GHC.Core.Utils.mkCast, but does a full reflexivity check.
  306 -- mkCast doesn't do that because the Simplifier does (in simplCast)
  307 -- But in SimpleOpt it's nice to kill those nested casts (#18112)
  308 mk_cast (Cast e co1) co2        = mk_cast e (co1 `mkTransCo` co2)
  309 mk_cast (Tick t e)   co         = Tick t (mk_cast e co)
  310 mk_cast e co | isReflexiveCo co = e
  311              | otherwise        = Cast e co
  312 
  313 ----------------------
  314 -- simple_app collects arguments for beta reduction
  315 simple_app :: HasDebugCallStack => SimpleOptEnv -> InExpr -> [SimpleClo] -> CoreExpr
  316 
  317 simple_app env (Var v) as
  318   | Just (env', e) <- lookupVarEnv (soe_inl env) v
  319   = simple_app (soeSetInScope env env') e as
  320 
  321   | let unf = idUnfolding v
  322   , isCompulsoryUnfolding (idUnfolding v)
  323   , isAlwaysActive (idInlineActivation v)
  324     -- See Note [Unfold compulsory unfoldings in LHSs]
  325   = simple_app (soeZapSubst env) (unfoldingTemplate unf) as
  326 
  327   | otherwise
  328   , let out_fn = lookupIdSubst (soe_subst env) v
  329   = finish_app env out_fn as
  330 
  331 simple_app env (App e1 e2) as
  332   = simple_app env e1 ((env, e2) : as)
  333 
  334 simple_app env e@(Lam {}) as@(_:_)
  335   | (bndrs, body) <- collectBinders e
  336   , let zapped_bndrs = zapLamBndrs (length as) bndrs
  337     -- Be careful to zap the lambda binders if necessary
  338     -- c.f. the Lam case of simplExprF1 in GHC.Core.Opt.Simplify
  339     -- Lacking this zap caused #19347, when we had a redex
  340     --   (\ a b. K a b) e1 e2
  341     -- where (as it happens) the eta-expanded K is produced by
  342     -- Note [Typechecking data constructors] in GHC.Tc.Gen.Head
  343   = do_beta env zapped_bndrs body as
  344   where
  345     do_beta env (b:bs) body (a:as)
  346       | (env', mb_pr) <- simple_bind_pair env b Nothing a NotTopLevel
  347       = wrapLet mb_pr $ do_beta env' bs body as
  348     do_beta env bs body as = simple_app env (mkLams bs body) as
  349 
  350 simple_app env (Tick t e) as
  351   -- Okay to do "(Tick t e) x ==> Tick t (e x)"?
  352   | t `tickishScopesLike` SoftScope
  353   = mkTick t $ simple_app env e as
  354 
  355 -- (let x = e in b) a1 .. an  =>  let x = e in (b a1 .. an)
  356 -- The let might appear there as a result of inlining
  357 -- e.g.   let f = let x = e in b
  358 --        in f a1 a2
  359 --   (#13208)
  360 -- However, do /not/ do this transformation for join points
  361 --    See Note [simple_app and join points]
  362 simple_app env (Let bind body) args
  363   = case simple_opt_bind env bind NotTopLevel of
  364       (env', Nothing)   -> simple_app env' body args
  365       (env', Just bind')
  366         | isJoinBind bind' -> finish_app env expr' args
  367         | otherwise        -> Let bind' (simple_app env' body args)
  368         where
  369           expr' = Let bind' (simple_opt_expr env' body)
  370 
  371 simple_app env e as
  372   = finish_app env (simple_opt_expr env e) as
  373 
  374 finish_app :: SimpleOptEnv -> OutExpr -> [SimpleClo] -> OutExpr
  375 finish_app _ fun []
  376   = fun
  377 finish_app env fun (arg:args)
  378   = finish_app env (App fun (simple_opt_clo env arg)) args
  379 
  380 ----------------------
  381 simple_opt_bind :: SimpleOptEnv -> InBind -> TopLevelFlag
  382                 -> (SimpleOptEnv, Maybe OutBind)
  383 simple_opt_bind env (NonRec b r) top_level
  384   = (env', case mb_pr of
  385             Nothing    -> Nothing
  386             Just (b,r) -> Just (NonRec b r))
  387   where
  388     (b', r') = joinPointBinding_maybe b r `orElse` (b, r)
  389     (env', mb_pr) = simple_bind_pair env b' Nothing (env,r') top_level
  390 
  391 simple_opt_bind env (Rec prs) top_level
  392   = (env'', res_bind)
  393   where
  394     res_bind          = Just (Rec (reverse rev_prs'))
  395     prs'              = joinPointBindings_maybe prs `orElse` prs
  396     (env', bndrs')    = subst_opt_bndrs env (map fst prs')
  397     (env'', rev_prs') = foldl' do_pr (env', []) (prs' `zip` bndrs')
  398     do_pr (env, prs) ((b,r), b')
  399        = (env', case mb_pr of
  400                   Just pr -> pr : prs
  401                   Nothing -> prs)
  402        where
  403          (env', mb_pr) = simple_bind_pair env b (Just b') (env,r) top_level
  404 
  405 ----------------------
  406 simple_bind_pair :: SimpleOptEnv
  407                  -> InVar -> Maybe OutVar
  408                  -> SimpleClo
  409                  -> TopLevelFlag
  410                  -> (SimpleOptEnv, Maybe (OutVar, OutExpr))
  411     -- (simple_bind_pair subst in_var out_rhs)
  412     --   either extends subst with (in_var -> out_rhs)
  413     --   or     returns Nothing
  414 simple_bind_pair env@(SOE { soe_inl = inl_env, soe_subst = subst })
  415                  in_bndr mb_out_bndr clo@(rhs_env, in_rhs)
  416                  top_level
  417   | Type ty <- in_rhs        -- let a::* = TYPE ty in <body>
  418   , let out_ty = substTy (soe_subst rhs_env) ty
  419   = assertPpr (isTyVar in_bndr) (ppr in_bndr $$ ppr in_rhs) $
  420     (env { soe_subst = extendTvSubst subst in_bndr out_ty }, Nothing)
  421 
  422   | Coercion co <- in_rhs
  423   , let out_co = optCoercion (soe_co_opt_opts env) (getTCvSubst (soe_subst rhs_env)) co
  424   = assert (isCoVar in_bndr)
  425     (env { soe_subst = extendCvSubst subst in_bndr out_co }, Nothing)
  426 
  427   | assertPpr (isNonCoVarId in_bndr) (ppr in_bndr)
  428     -- The previous two guards got rid of tyvars and coercions
  429     -- See Note [Core type and coercion invariant] in GHC.Core
  430     pre_inline_unconditionally
  431   = (env { soe_inl = extendVarEnv inl_env in_bndr clo }, Nothing)
  432 
  433   | otherwise
  434   = simple_out_bind_pair env in_bndr mb_out_bndr out_rhs
  435                          occ active stable_unf top_level
  436   where
  437     stable_unf = isStableUnfolding (idUnfolding in_bndr)
  438     active     = isAlwaysActive (idInlineActivation in_bndr)
  439     occ        = idOccInfo in_bndr
  440 
  441     out_rhs | Just join_arity <- isJoinId_maybe in_bndr
  442             = simple_join_rhs join_arity
  443             | otherwise
  444             = simple_opt_clo env clo
  445 
  446     simple_join_rhs join_arity -- See Note [Preserve join-binding arity]
  447       = mkLams join_bndrs' (simple_opt_expr env_body join_body)
  448       where
  449         env0 = soeSetInScope env rhs_env
  450         (join_bndrs, join_body) = collectNBinders join_arity in_rhs
  451         (env_body, join_bndrs') = subst_opt_bndrs env0 join_bndrs
  452 
  453     pre_inline_unconditionally :: Bool
  454     pre_inline_unconditionally
  455        | isExportedId in_bndr     = False
  456        | stable_unf               = False
  457        | not active               = False    -- Note [Inline prag in simplOpt]
  458        | not (safe_to_inline occ) = False
  459        | otherwise                = True
  460 
  461         -- Unconditionally safe to inline
  462     safe_to_inline :: OccInfo -> Bool
  463     safe_to_inline IAmALoopBreaker{}                  = False
  464     safe_to_inline IAmDead                            = True
  465     safe_to_inline OneOcc{ occ_in_lam = NotInsideLam
  466                          , occ_n_br = 1 }             = True
  467     safe_to_inline OneOcc{}                           = False
  468     safe_to_inline ManyOccs{}                         = False
  469 
  470 -------------------
  471 simple_out_bind :: TopLevelFlag
  472                 -> SimpleOptEnv
  473                 -> (InVar, OutExpr)
  474                 -> (SimpleOptEnv, Maybe (OutVar, OutExpr))
  475 simple_out_bind top_level env@(SOE { soe_subst = subst }) (in_bndr, out_rhs)
  476   | Type out_ty <- out_rhs
  477   = assertPpr (isTyVar in_bndr) (ppr in_bndr $$ ppr out_ty $$ ppr out_rhs)
  478     (env { soe_subst = extendTvSubst subst in_bndr out_ty }, Nothing)
  479 
  480   | Coercion out_co <- out_rhs
  481   = assert (isCoVar in_bndr)
  482     (env { soe_subst = extendCvSubst subst in_bndr out_co }, Nothing)
  483 
  484   | otherwise
  485   = simple_out_bind_pair env in_bndr Nothing out_rhs
  486                          (idOccInfo in_bndr) True False top_level
  487 
  488 -------------------
  489 simple_out_bind_pair :: SimpleOptEnv
  490                      -> InId -> Maybe OutId -> OutExpr
  491                      -> OccInfo -> Bool -> Bool -> TopLevelFlag
  492                      -> (SimpleOptEnv, Maybe (OutVar, OutExpr))
  493 simple_out_bind_pair env in_bndr mb_out_bndr out_rhs
  494                      occ_info active stable_unf top_level
  495   | assertPpr (isNonCoVarId in_bndr) (ppr in_bndr)
  496     -- Type and coercion bindings are caught earlier
  497     -- See Note [Core type and coercion invariant]
  498     post_inline_unconditionally
  499   = ( env' { soe_subst = extendIdSubst (soe_subst env) in_bndr out_rhs }
  500     , Nothing)
  501 
  502   | otherwise
  503   = ( env', Just (out_bndr, out_rhs) )
  504   where
  505     (env', bndr1) = case mb_out_bndr of
  506                       Just out_bndr -> (env, out_bndr)
  507                       Nothing       -> subst_opt_bndr env in_bndr
  508     out_bndr = add_info env' in_bndr top_level out_rhs bndr1
  509 
  510     post_inline_unconditionally :: Bool
  511     post_inline_unconditionally
  512        | isExportedId in_bndr  = False -- Note [Exported Ids and trivial RHSs]
  513        | stable_unf            = False -- Note [Stable unfoldings and postInlineUnconditionally]
  514        | not active            = False --     in GHC.Core.Opt.Simplify.Utils
  515        | is_loop_breaker       = False -- If it's a loop-breaker of any kind, don't inline
  516                                        -- because it might be referred to "earlier"
  517        | exprIsTrivial out_rhs = True
  518        | coercible_hack        = True
  519        | otherwise             = False
  520 
  521     is_loop_breaker = isWeakLoopBreaker occ_info
  522 
  523     -- See Note [Getting the map/coerce RULE to work]
  524     coercible_hack | (Var fun, args) <- collectArgs out_rhs
  525                    , Just dc <- isDataConWorkId_maybe fun
  526                    , dc `hasKey` heqDataConKey || dc `hasKey` coercibleDataConKey
  527                    = all exprIsTrivial args
  528                    | otherwise
  529                    = False
  530 
  531 {- Note [Exported Ids and trivial RHSs]
  532 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  533 We obviously do not want to unconditionally inline an Id that is exported.
  534 In GHC.Core.Opt.Simplify.Utils, Note [Top level and postInlineUnconditionally], we
  535 explain why we don't inline /any/ top-level things unconditionally, even
  536 trivial ones.  But we do here!  Why?  In the simple optimiser
  537 
  538   * We do no rule rewrites
  539   * We do no call-site inlining
  540 
  541 Those differences obviate the reasons for not inlining a trivial rhs,
  542 and increase the benefit for doing so.  So we unconditionally inline trivial
  543 rhss here.
  544 
  545 Note [Preserve join-binding arity]
  546 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  547 Be careful /not/ to eta-reduce the RHS of a join point, lest we lose
  548 the join-point arity invariant.  #15108 was caused by simplifying
  549 the RHS with simple_opt_expr, which does eta-reduction.  Solution:
  550 simplify the RHS of a join point by simplifying under the lambdas
  551 (which of course should be there).
  552 
  553 Note [simple_app and join points]
  554 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  555 In general for let-bindings we can do this:
  556    (let { x = e } in b) a  ==>  let { x = e } in b a
  557 
  558 But not for join points!  For two reasons:
  559 
  560 - We would need to push the continuation into the RHS:
  561    (join { j = e } in b) a  ==>  let { j' = e a } in b[j'/j] a
  562                                       NB ----^^
  563   and also change the type of j, hence j'.
  564   That's a bit sophisticated for the very simple optimiser.
  565 
  566 - We might end up with something like
  567     join { j' = e a } in
  568     (case blah of        )
  569     (  True  -> j' void# ) a
  570     (  False -> blah     )
  571   and now the call to j' doesn't look like a tail call, and
  572   Lint may reject.  I say "may" because this is /explicitly/
  573   allowed in the "Compiling without Continuations" paper
  574   (Section 3, "Managing \Delta").  But GHC currently does not
  575   allow this slightly-more-flexible form.  See GHC.Core
  576   Note [Join points are less general than the paper].
  577 
  578 The simple thing to do is to disable this transformation
  579 for join points in the simple optimiser
  580 
  581 Note [The Let-Unfoldings Invariant]
  582 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  583 A program has the Let-Unfoldings property iff:
  584 
  585 - For every let-bound variable f, whether top-level or nested, whether
  586   recursive or not:
  587   - Both the binding Id of f, and every occurrence Id of f, has an idUnfolding.
  588   - For non-INLINE things, that unfolding will be f's right hand sids
  589   - For INLINE things (which have a "stable" unfolding) that unfolding is
  590     semantically equivalent to f's RHS, but derived from the original RHS of f
  591     rather that its current RHS.
  592 
  593 Informally, we can say that in a program that has the Let-Unfoldings property,
  594 all let-bound Id's have an explicit unfolding attached to them.
  595 
  596 Currently, the simplifier guarantees the Let-Unfoldings invariant for anything
  597 it outputs.
  598 
  599 -}
  600 
  601 ----------------------
  602 subst_opt_bndrs :: SimpleOptEnv -> [InVar] -> (SimpleOptEnv, [OutVar])
  603 subst_opt_bndrs env bndrs = mapAccumL subst_opt_bndr env bndrs
  604 
  605 subst_opt_bndr :: SimpleOptEnv -> InVar -> (SimpleOptEnv, OutVar)
  606 subst_opt_bndr env bndr
  607   | isTyVar bndr  = (env { soe_subst = subst_tv }, tv')
  608   | isCoVar bndr  = (env { soe_subst = subst_cv }, cv')
  609   | otherwise     = subst_opt_id_bndr env bndr
  610   where
  611     subst           = soe_subst env
  612     (subst_tv, tv') = substTyVarBndr subst bndr
  613     (subst_cv, cv') = substCoVarBndr subst bndr
  614 
  615 subst_opt_id_bndr :: SimpleOptEnv -> InId -> (SimpleOptEnv, OutId)
  616 -- Nuke all fragile IdInfo, unfolding, and RULES; it gets added back later by
  617 -- add_info.
  618 --
  619 -- Rather like SimplEnv.substIdBndr
  620 --
  621 -- It's important to zap fragile OccInfo (which GHC.Core.Subst.substIdBndr
  622 -- carefully does not do) because simplOptExpr invalidates it
  623 
  624 subst_opt_id_bndr env@(SOE { soe_subst = subst, soe_inl = inl }) old_id
  625   = (env { soe_subst = new_subst, soe_inl = new_inl }, new_id)
  626   where
  627     Subst in_scope id_subst tv_subst cv_subst = subst
  628 
  629     id1    = uniqAway in_scope old_id
  630     id2    = updateIdTypeAndMult (substTy subst) id1
  631     new_id = zapFragileIdInfo id2
  632              -- Zaps rules, unfolding, and fragile OccInfo
  633              -- The unfolding and rules will get added back later, by add_info
  634 
  635     new_in_scope = in_scope `extendInScopeSet` new_id
  636 
  637     no_change = new_id == old_id
  638 
  639         -- Extend the substitution if the unique has changed,
  640         -- See the notes with substTyVarBndr for the delSubstEnv
  641     new_id_subst
  642       | no_change = delVarEnv id_subst old_id
  643       | otherwise = extendVarEnv id_subst old_id (Var new_id)
  644 
  645     new_subst = Subst new_in_scope new_id_subst tv_subst cv_subst
  646     new_inl   = delVarEnv inl old_id
  647 
  648 ----------------------
  649 add_info :: SimpleOptEnv -> InVar -> TopLevelFlag -> OutExpr -> OutVar -> OutVar
  650 add_info env old_bndr top_level new_rhs new_bndr
  651  | isTyVar old_bndr = new_bndr
  652  | otherwise        = lazySetIdInfo new_bndr new_info
  653  where
  654    subst    = soe_subst env
  655    uf_opts  = soe_uf_opts env
  656    old_info = idInfo old_bndr
  657 
  658    -- Add back in the rules and unfolding which were
  659    -- removed by zapFragileIdInfo in subst_opt_id_bndr.
  660    --
  661    -- See Note [The Let-Unfoldings Invariant]
  662    new_info = idInfo new_bndr `setRuleInfo`      new_rules
  663                               `setUnfoldingInfo` new_unfolding
  664 
  665    old_rules = ruleInfo old_info
  666    new_rules = substRuleInfo subst new_bndr old_rules
  667 
  668    old_unfolding = realUnfoldingInfo old_info
  669    new_unfolding | isStableUnfolding old_unfolding
  670                  = substUnfolding subst old_unfolding
  671                  | otherwise
  672                  = unfolding_from_rhs
  673 
  674    unfolding_from_rhs = mkUnfolding uf_opts InlineRhs
  675                                     (isTopLevel top_level)
  676                                     False -- may be bottom or not
  677                                     new_rhs
  678 
  679 simpleUnfoldingFun :: IdUnfoldingFun
  680 simpleUnfoldingFun id
  681   | isAlwaysActive (idInlineActivation id) = idUnfolding id
  682   | otherwise                              = noUnfolding
  683 
  684 wrapLet :: Maybe (Id,CoreExpr) -> CoreExpr -> CoreExpr
  685 wrapLet Nothing      body = body
  686 wrapLet (Just (b,r)) body = Let (NonRec b r) body
  687 
  688 {-
  689 Note [Inline prag in simplOpt]
  690 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  691 If there's an INLINE/NOINLINE pragma that restricts the phase in
  692 which the binder can be inlined, we don't inline here; after all,
  693 we don't know what phase we're in.  Here's an example
  694 
  695   foo :: Int -> Int -> Int
  696   {-# INLINE foo #-}
  697   foo m n = inner m
  698      where
  699        {-# INLINE [1] inner #-}
  700        inner m = m+n
  701 
  702   bar :: Int -> Int
  703   bar n = foo n 1
  704 
  705 When inlining 'foo' in 'bar' we want the let-binding for 'inner'
  706 to remain visible until Phase 1
  707 
  708 Note [Unfold compulsory unfoldings in LHSs]
  709 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  710 When the user writes `RULES map coerce = coerce` as a rule, the rule
  711 will only ever match if simpleOptExpr replaces coerce by its unfolding
  712 on the LHS, because that is the core that the rule matching engine
  713 will find. So do that for everything that has a compulsory
  714 unfolding. Also see Note [Desugaring coerce as cast] in GHC.HsToCore.
  715 
  716 However, we don't want to inline 'seq', which happens to also have a
  717 compulsory unfolding, so we only do this unfolding only for things
  718 that are always-active.  See Note [User-defined RULES for seq] in GHC.Types.Id.Make.
  719 
  720 Note [Getting the map/coerce RULE to work]
  721 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  722 We wish to allow the "map/coerce" RULE to fire:
  723 
  724   {-# RULES "map/coerce" map coerce = coerce #-}
  725 
  726 The naive core produced for this is
  727 
  728   forall a b (dict :: Coercible * a b).
  729     map @a @b (coerce @a @b @dict) = coerce @[a] @[b] @dict'
  730 
  731   where dict' :: Coercible [a] [b]
  732         dict' = ...
  733 
  734 This matches literal uses of `map coerce` in code, but that's not what we
  735 want. We want it to match, say, `map MkAge` (where newtype Age = MkAge Int)
  736 too. Some of this is addressed by compulsorily unfolding coerce on the LHS,
  737 yielding
  738 
  739   forall a b (dict :: Coercible * a b).
  740     map @a @b (\(x :: a) -> case dict of
  741       MkCoercible (co :: a ~R# b) -> x |> co) = ...
  742 
  743 Getting better. But this isn't exactly what gets produced. This is because
  744 Coercible essentially has ~R# as a superclass, and superclasses get eagerly
  745 extracted during solving. So we get this:
  746 
  747   forall a b (dict :: Coercible * a b).
  748     case Coercible_SCSel @* @a @b dict of
  749       _ [Dead] -> map @a @b (\(x :: a) -> case dict of
  750                                MkCoercible (co :: a ~R# b) -> x |> co) = ...
  751 
  752 Unfortunately, this still abstracts over a Coercible dictionary. We really
  753 want it to abstract over the ~R# evidence. So, we have Desugar.unfold_coerce,
  754 which transforms the above to (see also Note [Desugaring coerce as cast] in
  755 Desugar)
  756 
  757   forall a b (co :: a ~R# b).
  758     let dict = MkCoercible @* @a @b co in
  759     case Coercible_SCSel @* @a @b dict of
  760       _ [Dead] -> map @a @b (\(x :: a) -> case dict of
  761          MkCoercible (co :: a ~R# b) -> x |> co) = let dict = ... in ...
  762 
  763 Now, we need simpleOptExpr to fix this up. It does so by taking three
  764 separate actions:
  765   1. Inline certain non-recursive bindings. The choice whether to inline
  766      is made in simple_bind_pair. Note the rather specific check for
  767      MkCoercible in there.
  768 
  769   2. Stripping case expressions like the Coercible_SCSel one.
  770      See the `Case` case of simple_opt_expr's `go` function.
  771 
  772   3. Look for case expressions that unpack something that was
  773      just packed and inline them. This is also done in simple_opt_expr's
  774      `go` function.
  775 
  776 This is all a fair amount of special-purpose hackery, but it's for
  777 a good cause. And it won't hurt other RULES and such that it comes across.
  778 
  779 
  780 ************************************************************************
  781 *                                                                      *
  782                 Join points
  783 *                                                                      *
  784 ************************************************************************
  785 -}
  786 
  787 {- Note [Strictness and join points]
  788 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  789 Suppose we have
  790 
  791    let f = \x.  if x>200 then e1 else e1
  792 
  793 and we know that f is strict in x.  Then if we subsequently
  794 discover that f is an arity-2 join point, we'll eta-expand it to
  795 
  796    let f = \x y.  if x>200 then e1 else e1
  797 
  798 and now it's only strict if applied to two arguments.  So we should
  799 adjust the strictness info.
  800 
  801 A more common case is when
  802 
  803    f = \x. error ".."
  804 
  805 and again its arity increases (#15517)
  806 -}
  807 
  808 
  809 -- | Returns Just (bndr,rhs) if the binding is a join point:
  810 -- If it's a JoinId, just return it
  811 -- If it's not yet a JoinId but is always tail-called,
  812 --    make it into a JoinId and return it.
  813 -- In the latter case, eta-expand the RHS if necessary, to make the
  814 -- lambdas explicit, as is required for join points
  815 --
  816 -- Precondition: the InBndr has been occurrence-analysed,
  817 --               so its OccInfo is valid
  818 joinPointBinding_maybe :: InBndr -> InExpr -> Maybe (InBndr, InExpr)
  819 joinPointBinding_maybe bndr rhs
  820   | not (isId bndr)
  821   = Nothing
  822 
  823   | isJoinId bndr
  824   = Just (bndr, rhs)
  825 
  826   | AlwaysTailCalled join_arity <- tailCallInfo (idOccInfo bndr)
  827   , (bndrs, body) <- etaExpandToJoinPoint join_arity rhs
  828   , let str_sig   = idDmdSig bndr
  829         str_arity = count isId bndrs  -- Strictness demands are for Ids only
  830         join_bndr = bndr `asJoinId`        join_arity
  831                          `setIdDmdSig` etaConvertDmdSig str_arity str_sig
  832   = Just (join_bndr, mkLams bndrs body)
  833 
  834   | otherwise
  835   = Nothing
  836 
  837 joinPointBindings_maybe :: [(InBndr, InExpr)] -> Maybe [(InBndr, InExpr)]
  838 joinPointBindings_maybe bndrs
  839   = mapM (uncurry joinPointBinding_maybe) bndrs
  840 
  841 
  842 {- *********************************************************************
  843 *                                                                      *
  844          exprIsConApp_maybe
  845 *                                                                      *
  846 ************************************************************************
  847 
  848 Note [exprIsConApp_maybe]
  849 ~~~~~~~~~~~~~~~~~~~~~~~~~
  850 exprIsConApp_maybe is a very important function.  There are two principal
  851 uses:
  852   * case e of { .... }
  853   * cls_op e, where cls_op is a class operation
  854 
  855 In both cases you want to know if e is of form (C e1..en) where C is
  856 a data constructor.
  857 
  858 However e might not *look* as if
  859 
  860 
  861 Note [exprIsConApp_maybe on literal strings]
  862 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  863 See #9400 and #13317.
  864 
  865 Conceptually, a string literal "abc" is just ('a':'b':'c':[]), but in Core
  866 they are represented as unpackCString# "abc"# by GHC.Core.Make.mkStringExprFS, or
  867 unpackCStringUtf8# when the literal contains multi-byte UTF8 characters.
  868 
  869 For optimizations we want to be able to treat it as a list, so they can be
  870 decomposed when used in a case-statement. exprIsConApp_maybe detects those
  871 calls to unpackCString# and returns:
  872 
  873 Just (':', [Char], ['a', unpackCString# "bc"]).
  874 
  875 We need to be careful about UTF8 strings here. ""# contains an encoded ByteString, so
  876 we call utf8UnconsByteString to correctly deal with the encoding and splitting.
  877 
  878 We must also be careful about
  879    lvl = "foo"#
  880    ...(unpackCString# lvl)...
  881 to ensure that we see through the let-binding for 'lvl'.  Hence the
  882 (exprIsLiteral_maybe .. arg) in the guard before the call to
  883 dealWithStringLiteral.
  884 
  885 The tests for this function are in T9400.
  886 
  887 Note [Push coercions in exprIsConApp_maybe]
  888 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  889 In #13025 I found a case where we had
  890     op (df @t1 @t2)     -- op is a ClassOp
  891 where
  892     df = (/\a b. K e1 e2) |> g
  893 
  894 To get this to come out we need to simplify on the fly
  895    ((/\a b. K e1 e2) |> g) @t1 @t2
  896 
  897 Hence the use of pushCoArgs.
  898 
  899 Note [exprIsConApp_maybe on data constructors with wrappers]
  900 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  901 Problem:
  902 - some data constructors have wrappers
  903 - these wrappers inline late (see MkId Note [Activation for data constructor wrappers])
  904 - but we still want case-of-known-constructor to fire early.
  905 
  906 Example:
  907    data T = MkT !Int
  908    $WMkT n = case n of n' -> MkT n'   -- Wrapper for MkT
  909    foo x = case $WMkT e of MkT y -> blah
  910 
  911 Here we want the case-of-known-constructor transformation to fire, giving
  912    foo x = case e of x' -> let y = x' in blah
  913 
  914 Here's how exprIsConApp_maybe achieves this:
  915 
  916 0.  Start with scrutinee = $WMkT e
  917 
  918 1.  Inline $WMkT on-the-fly.  That's why data-constructor wrappers are marked
  919     as expandable. (See GHC.Core.Utils.isExpandableApp.) Now we have
  920       scrutinee = (\n. case n of n' -> MkT n') e
  921 
  922 2.  Beta-reduce the application, generating a floated 'let'.
  923     See Note [beta-reduction in exprIsConApp_maybe] below.  Now we have
  924       scrutinee = case n of n' -> MkT n'
  925       with floats {Let n = e}
  926 
  927 3.  Float the "case x of x' ->" binding out.  Now we have
  928       scrutinee = MkT n'
  929       with floats {Let n = e; case n of n' ->}
  930 
  931 And now we have a known-constructor MkT that we can return.
  932 
  933 Notice that both (2) and (3) require exprIsConApp_maybe to gather and return
  934 a bunch of floats, both let and case bindings.
  935 
  936 Note that this strategy introduces some subtle scenarios where a data-con
  937 wrapper can be replaced by a data-con worker earlier than we’d like, see
  938 Note [exprIsConApp_maybe for data-con wrappers: tricky corner].
  939 
  940 Note [beta-reduction in exprIsConApp_maybe]
  941 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  942 The unfolding a definition (_e.g._ a let-bound variable or a datacon wrapper) is
  943 typically a function. For instance, take the wrapper for MkT in Note
  944 [exprIsConApp_maybe on data constructors with wrappers]:
  945 
  946     $WMkT n = case n of { n' -> T n' }
  947 
  948 If `exprIsConApp_maybe` is trying to analyse `$MkT arg`, upon unfolding of $MkT,
  949 it will see
  950 
  951    (\n -> case n of { n' -> T n' }) arg
  952 
  953 In order to go progress, `exprIsConApp_maybe` must perform a beta-reduction.
  954 
  955 We don't want to blindly substitute `arg` in the body of the function, because
  956 it duplicates work. We can (and, in fact, used to) substitute `arg` in the body,
  957 but only when `arg` is a variable (or something equally work-free).
  958 
  959 But, because of Note [exprIsConApp_maybe on data constructors with wrappers],
  960 'exprIsConApp_maybe' now returns floats. So, instead, we can beta-reduce
  961 _always_:
  962 
  963     (\x -> body) arg
  964 
  965 Is transformed into
  966 
  967    let x = arg in body
  968 
  969 Which, effectively, means emitting a float `let x = arg` and recursively
  970 analysing the body.
  971 
  972 For newtypes, this strategy requires that their wrappers have compulsory unfoldings.
  973 Suppose we have
  974    newtype T a b where
  975      MkT :: a -> T b a   -- Note args swapped
  976 
  977 This defines a worker function MkT, a wrapper function $WMkT, and an axT:
  978    $WMkT :: forall a b. a -> T b a
  979    $WMkT = /\b a. \(x:a). MkT a b x    -- A real binding
  980 
  981    MkT :: forall a b. a -> T a b
  982    MkT = /\a b. \(x:a). x |> (ax a b)  -- A compulsory unfolding
  983 
  984    axiom axT :: a ~R# T a b
  985 
  986 Now we are optimising
  987    case $WMkT (I# 3) |> sym axT of I# y -> ...
  988 we clearly want to simplify this. If $WMkT did not have a compulsory
  989 unfolding, we would end up with
  990    let a = I#3 in case a of I# y -> ...
  991 because in general, we do this on-the-fly beta-reduction
  992    (\x. e) blah  -->  let x = blah in e
  993 and then float the let.  (Substitution would risk duplicating 'blah'.)
  994 
  995 But if the case-of-known-constructor doesn't actually fire (i.e.
  996 exprIsConApp_maybe does not return Just) then nothing happens, and nothing
  997 will happen the next time either.
  998 
  999 See test T16254, which checks the behavior of newtypes.
 1000 
 1001 Note [Don't float join points]
 1002 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 1003 exprIsConApp_maybe should succeed on
 1004    let v = e in Just v
 1005 returning [x=e] as one of the [FloatBind].  But it must
 1006 NOT succeed on
 1007    join j x = rhs in Just v
 1008 because join-points can't be gaily floated.  Consider
 1009    case (join j x = rhs in Just) of
 1010      K p q -> blah
 1011 We absolutely must not "simplify" this to
 1012    join j x = rhs
 1013    in blah
 1014 because j's return type is (Maybe t), quite different to blah's.
 1015 
 1016 You might think this could never happen, because j can't be
 1017 tail-called in the body if the body returns a constructor.  But
 1018 in !3113 we had a /dead/ join point (which is not illegal),
 1019 and its return type was wonky.
 1020 
 1021 The simple thing is not to float a join point.  The next iteration
 1022 of the simplifier will sort everything out.  And it there is
 1023 a join point, the chances are that the body is not a constructor
 1024 application, so failing faster is good.
 1025 
 1026 Note [exprIsConApp_maybe for data-con wrappers: tricky corner]
 1027 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 1028 Generally speaking
 1029 
 1030   * exprIsConApp_maybe honours the inline phase; that is, it does not look
 1031     inside the unfolding for an Id unless its unfolding is active in this phase.
 1032     That phase-sensitivity is expressed in the InScopeEnv (specifically, the
 1033     IdUnfoldingFun component of the InScopeEnv) passed to exprIsConApp_maybe.
 1034 
 1035   * Data-constructor wrappers are active only in phase 0 (the last phase);
 1036     see Note [Activation for data constructor wrappers] in GHC.Types.Id.Make.
 1037 
 1038 On the face of it that means that exprIsConApp_maybe won't look inside data
 1039 constructor wrappers until phase 0. But that seems pretty Bad. So we cheat.
 1040 For data con wrappers we unconditionally look inside its unfolding, regardless
 1041 of phase, so that we get case-of-known-constructor to fire in every phase.
 1042 
 1043 Perhaps unsurprisingly, this cheating can backfire. An example:
 1044 
 1045     data T = C !A B
 1046     foo p q = let x = C e1 e2 in seq x $ f x
 1047     {-# RULE "wurble" f (C a b) = b #-}
 1048 
 1049 In Core, the RHS of foo is
 1050 
 1051     let x = $WC e1 e2 in case x of y { C _ _ -> f x }
 1052 
 1053 and after doing a binder swap and inlining x, we have:
 1054 
 1055     case $WC e1 e2 of y { C _ _ -> f y }
 1056 
 1057 Case-of-known-constructor fires, but now we have to reconstruct a binding for
 1058 `y` (which was dead before the binder swap) on the RHS of the case alternative.
 1059 Naturally, we’ll use the worker:
 1060 
 1061     case e1 of a { DEFAULT -> let y = C a e2 in f y }
 1062 
 1063 and after inlining `y`, we have:
 1064 
 1065     case e1 of a { DEFAULT -> f (C a e2) }
 1066 
 1067 Now we might hope the "wurble" rule would fire, but alas, it will not: we have
 1068 replaced $WC with C, but the (desugared) rule matches on $WC! We weren’t
 1069 supposed to inline $WC yet for precisely that reason (see Note [Activation for
 1070 data constructor wrappers]), but our cheating in exprIsConApp_maybe came back to
 1071 bite us.
 1072 
 1073 This is rather unfortunate, especially since this can happen inside stable
 1074 unfoldings as well as ordinary code (which really happened, see !3041). But
 1075 there is no obvious solution except to delay case-of-known-constructor on
 1076 data-con wrappers, and that cure would be worse than the disease.
 1077 
 1078 This Note exists solely to document the problem.
 1079 -}
 1080 
 1081 data ConCont = CC [CoreExpr] Coercion
 1082                   -- Substitution already applied
 1083 
 1084 -- | Returns @Just ([b1..bp], dc, [t1..tk], [x1..xn])@ if the argument
 1085 -- expression is a *saturated* constructor application of the form @let b1 in
 1086 -- .. let bp in dc t1..tk x1 .. xn@, where t1..tk are the
 1087 -- *universally-quantified* type args of 'dc'. Floats can also be (and most
 1088 -- likely are) single-alternative case expressions. Why does
 1089 -- 'exprIsConApp_maybe' return floats? We may have to look through lets and
 1090 -- cases to detect that we are in the presence of a data constructor wrapper. In
 1091 -- this case, we need to return the lets and cases that we traversed. See Note
 1092 -- [exprIsConApp_maybe on data constructors with wrappers]. Data constructor wrappers
 1093 -- are unfolded late, but we really want to trigger case-of-known-constructor as
 1094 -- early as possible. See also Note [Activation for data constructor wrappers]
 1095 -- in "GHC.Types.Id.Make".
 1096 --
 1097 -- We also return the incoming InScopeSet, augmented with
 1098 -- the binders from any [FloatBind] that we return
 1099 exprIsConApp_maybe :: HasDebugCallStack
 1100                    => InScopeEnv -> CoreExpr
 1101                    -> Maybe (InScopeSet, [FloatBind], DataCon, [Type], [CoreExpr])
 1102 exprIsConApp_maybe (in_scope, id_unf) expr
 1103   = go (Left in_scope) [] expr (CC [] (mkRepReflCo (exprType expr)))
 1104   where
 1105     go :: Either InScopeSet Subst
 1106              -- Left in-scope  means "empty substitution"
 1107              -- Right subst    means "apply this substitution to the CoreExpr"
 1108              -- NB: in the call (go subst floats expr cont)
 1109              --     the substitution applies to 'expr', but /not/ to 'floats' or 'cont'
 1110        -> [FloatBind] -> CoreExpr -> ConCont
 1111              -- Notice that the floats here are in reverse order
 1112        -> Maybe (InScopeSet, [FloatBind], DataCon, [Type], [CoreExpr])
 1113     go subst floats (Tick t expr) cont
 1114        | not (tickishIsCode t) = go subst floats expr cont
 1115 
 1116     go subst floats (Cast expr co1) (CC args co2)
 1117        | Just (args', m_co1') <- pushCoArgs (subst_co subst co1) args
 1118             -- See Note [Push coercions in exprIsConApp_maybe]
 1119        = case m_co1' of
 1120            MCo co1' -> go subst floats expr (CC args' (co1' `mkTransCo` co2))
 1121            MRefl    -> go subst floats expr (CC args' co2)
 1122 
 1123     go subst floats (App fun arg) (CC args co)
 1124        = go subst floats fun (CC (subst_expr subst arg : args) co)
 1125 
 1126     go subst floats (Lam bndr body) (CC (arg:args) co)
 1127        | exprIsTrivial arg          -- Don't duplicate stuff!
 1128        = go (extend subst bndr arg) floats body (CC args co)
 1129        | otherwise
 1130        = let (subst', bndr') = subst_bndr subst bndr
 1131              float           = FloatLet (NonRec bndr' arg)
 1132          in go subst' (float:floats) body (CC args co)
 1133 
 1134     go subst floats (Let (NonRec bndr rhs) expr) cont
 1135        | not (isJoinId bndr)
 1136          -- Crucial guard! See Note [Don't float join points]
 1137        = let rhs'            = subst_expr subst rhs
 1138              (subst', bndr') = subst_bndr subst bndr
 1139              float           = FloatLet (NonRec bndr' rhs')
 1140          in go subst' (float:floats) expr cont
 1141 
 1142     go subst floats (Case scrut b _ [Alt con vars expr]) cont
 1143        = let
 1144           scrut'           = subst_expr subst scrut
 1145           (subst', b')     = subst_bndr subst b
 1146           (subst'', vars') = subst_bndrs subst' vars
 1147           float            = FloatCase scrut' b' con vars'
 1148          in
 1149            go subst'' (float:floats) expr cont
 1150 
 1151     go (Right sub) floats (Var v) cont
 1152        = go (Left (substInScope sub))
 1153             floats
 1154             (lookupIdSubst sub v)
 1155             cont
 1156 
 1157     go (Left in_scope) floats (Var fun) cont@(CC args co)
 1158 
 1159         | Just con <- isDataConWorkId_maybe fun
 1160         , count isValArg args == idArity fun
 1161         = succeedWith in_scope floats $
 1162           pushCoDataCon con args co
 1163 
 1164         -- Look through data constructor wrappers: they inline late (See Note
 1165         -- [Activation for data constructor wrappers]) but we want to do
 1166         -- case-of-known-constructor optimisation eagerly (see Note
 1167         -- [exprIsConApp_maybe on data constructors with wrappers]).
 1168         | isDataConWrapId fun
 1169         , let rhs = uf_tmpl (realIdUnfolding fun)
 1170         = go (Left in_scope) floats rhs cont
 1171 
 1172         -- Look through dictionary functions; see Note [Unfolding DFuns]
 1173         | DFunUnfolding { df_bndrs = bndrs, df_con = con, df_args = dfun_args } <- unfolding
 1174         , bndrs `equalLength` args    -- See Note [DFun arity check]
 1175         , let in_scope' = extend_in_scope (exprsFreeVars dfun_args)
 1176               subst = mkOpenSubst in_scope' (bndrs `zip` args)
 1177               -- We extend the in-scope set here to silence warnings from
 1178               -- substExpr when it finds not-in-scope Ids in dfun_args.
 1179               -- simplOptExpr initialises the in-scope set with exprFreeVars,
 1180               -- but that doesn't account for DFun unfoldings
 1181         = succeedWith in_scope floats $
 1182           pushCoDataCon con (map (substExpr subst) dfun_args) co
 1183 
 1184         -- Look through unfoldings, but only arity-zero one;
 1185         -- if arity > 0 we are effectively inlining a function call,
 1186         -- and that is the business of callSiteInline.
 1187         -- In practice, without this test, most of the "hits" were
 1188         -- CPR'd workers getting inlined back into their wrappers,
 1189         | idArity fun == 0
 1190         , Just rhs <- expandUnfolding_maybe unfolding
 1191         , let in_scope' = extend_in_scope (exprFreeVars rhs)
 1192         = go (Left in_scope') floats rhs cont
 1193 
 1194         -- See Note [exprIsConApp_maybe on literal strings]
 1195         | (fun `hasKey` unpackCStringIdKey) ||
 1196           (fun `hasKey` unpackCStringUtf8IdKey)
 1197         , [arg]              <- args
 1198         , Just (LitString str) <- exprIsLiteral_maybe (in_scope, id_unf) arg
 1199         = succeedWith in_scope floats $
 1200           dealWithStringLiteral fun str co
 1201         where
 1202           unfolding = id_unf fun
 1203           extend_in_scope unf_fvs
 1204             | isLocalId fun = in_scope `extendInScopeSetSet` unf_fvs
 1205             | otherwise     = in_scope
 1206             -- A GlobalId has no (LocalId) free variables; and the
 1207             -- in-scope set tracks only LocalIds
 1208 
 1209     go _ _ _ _ = Nothing
 1210 
 1211     succeedWith :: InScopeSet -> [FloatBind]
 1212                 -> Maybe (DataCon, [Type], [CoreExpr])
 1213                 -> Maybe (InScopeSet, [FloatBind], DataCon, [Type], [CoreExpr])
 1214     succeedWith in_scope rev_floats x
 1215       = do { (con, tys, args) <- x
 1216            ; let floats = reverse rev_floats
 1217            ; return (in_scope, floats, con, tys, args) }
 1218 
 1219     ----------------------------
 1220     -- Operations on the (Either InScopeSet GHC.Core.Subst)
 1221     -- The Left case is wildly dominant
 1222     subst_co (Left {}) co = co
 1223     subst_co (Right s) co = GHC.Core.Subst.substCo s co
 1224 
 1225     subst_expr (Left {}) e = e
 1226     subst_expr (Right s) e = substExpr s e
 1227 
 1228     subst_bndr msubst bndr
 1229       = (Right subst', bndr')
 1230       where
 1231         (subst', bndr') = substBndr subst bndr
 1232         subst = case msubst of
 1233                   Left in_scope -> mkEmptySubst in_scope
 1234                   Right subst   -> subst
 1235 
 1236     subst_bndrs subst bs = mapAccumL subst_bndr subst bs
 1237 
 1238     extend (Left in_scope) v e = Right (extendSubst (mkEmptySubst in_scope) v e)
 1239     extend (Right s)       v e = Right (extendSubst s v e)
 1240 
 1241 
 1242 -- See Note [exprIsConApp_maybe on literal strings]
 1243 dealWithStringLiteral :: Var -> BS.ByteString -> Coercion
 1244                       -> Maybe (DataCon, [Type], [CoreExpr])
 1245 
 1246 -- This is not possible with user-supplied empty literals, GHC.Core.Make.mkStringExprFS
 1247 -- turns those into [] automatically, but just in case something else in GHC
 1248 -- generates a string literal directly.
 1249 dealWithStringLiteral fun str co =
 1250   case utf8UnconsByteString str of
 1251     Nothing -> pushCoDataCon nilDataCon [Type charTy] co
 1252     Just (char, charTail) ->
 1253       let char_expr = mkConApp charDataCon [mkCharLit char]
 1254           -- In singleton strings, just add [] instead of unpackCstring# ""#.
 1255           rest = if BS.null charTail
 1256                    then mkConApp nilDataCon [Type charTy]
 1257                    else App (Var fun)
 1258                             (Lit (LitString charTail))
 1259 
 1260       in pushCoDataCon consDataCon [Type charTy, char_expr, rest] co
 1261 
 1262 {-
 1263 Note [Unfolding DFuns]
 1264 ~~~~~~~~~~~~~~~~~~~~~~
 1265 DFuns look like
 1266 
 1267   df :: forall a b. (Eq a, Eq b) -> Eq (a,b)
 1268   df a b d_a d_b = MkEqD (a,b) ($c1 a b d_a d_b)
 1269                                ($c2 a b d_a d_b)
 1270 
 1271 So to split it up we just need to apply the ops $c1, $c2 etc
 1272 to the very same args as the dfun.  It takes a little more work
 1273 to compute the type arguments to the dictionary constructor.
 1274 
 1275 Note [DFun arity check]
 1276 ~~~~~~~~~~~~~~~~~~~~~~~
 1277 Here we check that the total number of supplied arguments (including
 1278 type args) matches what the dfun is expecting.  This may be *less*
 1279 than the ordinary arity of the dfun: see Note [DFun unfoldings] in GHC.Core
 1280 -}
 1281 
 1282 exprIsLiteral_maybe :: InScopeEnv -> CoreExpr -> Maybe Literal
 1283 -- Same deal as exprIsConApp_maybe, but much simpler
 1284 -- Nevertheless we do need to look through unfoldings for
 1285 -- string literals, which are vigorously hoisted to top level
 1286 -- and not subsequently inlined
 1287 exprIsLiteral_maybe env@(_, id_unf) e
 1288   = case e of
 1289       Lit l     -> Just l
 1290       Tick _ e' -> exprIsLiteral_maybe env e' -- dubious?
 1291       Var v     -> expandUnfolding_maybe (id_unf v)
 1292                     >>= exprIsLiteral_maybe env
 1293       _         -> Nothing
 1294 
 1295 {-
 1296 Note [exprIsLambda_maybe]
 1297 ~~~~~~~~~~~~~~~~~~~~~~~~~~
 1298 exprIsLambda_maybe will, given an expression `e`, try to turn it into the form
 1299 `Lam v e'` (returned as `Just (v,e')`). Besides using lambdas, it looks through
 1300 casts (using the Push rule), and it unfolds function calls if the unfolding
 1301 has a greater arity than arguments are present.
 1302 
 1303 Currently, it is used in GHC.Core.Rules.match, and is required to make
 1304 "map coerce = coerce" match.
 1305 -}
 1306 
 1307 exprIsLambda_maybe :: HasDebugCallStack
 1308                    => InScopeEnv -> CoreExpr
 1309                    -> Maybe (Var, CoreExpr,[CoreTickish])
 1310     -- See Note [exprIsLambda_maybe]
 1311 
 1312 -- The simple case: It is a lambda already
 1313 exprIsLambda_maybe _ (Lam x e)
 1314     = Just (x, e, [])
 1315 
 1316 -- Still straightforward: Ticks that we can float out of the way
 1317 exprIsLambda_maybe (in_scope_set, id_unf) (Tick t e)
 1318     | tickishFloatable t
 1319     , Just (x, e, ts) <- exprIsLambda_maybe (in_scope_set, id_unf) e
 1320     = Just (x, e, t:ts)
 1321 
 1322 -- Also possible: A casted lambda. Push the coercion inside
 1323 exprIsLambda_maybe (in_scope_set, id_unf) (Cast casted_e co)
 1324     | Just (x, e,ts) <- exprIsLambda_maybe (in_scope_set, id_unf) casted_e
 1325     -- Only do value lambdas.
 1326     -- this implies that x is not in scope in gamma (makes this code simpler)
 1327     , not (isTyVar x) && not (isCoVar x)
 1328     , assert (not $ x `elemVarSet` tyCoVarsOfCo co) True
 1329     , Just (x',e') <- pushCoercionIntoLambda in_scope_set x e co
 1330     , let res = Just (x',e',ts)
 1331     = --pprTrace "exprIsLambda_maybe:Cast" (vcat [ppr casted_e,ppr co,ppr res)])
 1332       res
 1333 
 1334 -- Another attempt: See if we find a partial unfolding
 1335 exprIsLambda_maybe (in_scope_set, id_unf) e
 1336     | (Var f, as, ts) <- collectArgsTicks tickishFloatable e
 1337     , idArity f > count isValArg as
 1338     -- Make sure there is hope to get a lambda
 1339     , Just rhs <- expandUnfolding_maybe (id_unf f)
 1340     -- Optimize, for beta-reduction
 1341     , let e' = simpleOptExprWith defaultSimpleOpts (mkEmptySubst in_scope_set) (rhs `mkApps` as)
 1342     -- Recurse, because of possible casts
 1343     , Just (x', e'', ts') <- exprIsLambda_maybe (in_scope_set, id_unf) e'
 1344     , let res = Just (x', e'', ts++ts')
 1345     = -- pprTrace "exprIsLambda_maybe:Unfold" (vcat [ppr e, ppr (x',e'')])
 1346       res
 1347 
 1348 exprIsLambda_maybe _ _e
 1349     = -- pprTrace "exprIsLambda_maybe:Fail" (vcat [ppr _e])
 1350       Nothing