-- | Slowly checks if the coercion is reflexive. Don't call this in a loop,

 -- as it walks over the entire coercion.

 isReflexiveCo :: Coercion -> Bool

 isReflexiveMCo :: MCoercion -> Bool

 isReflexiveMCo MRefl    = True

 module GHC.Core.Opt.OccurAnal (

     occurAnalysePgm,

     occurAnalyseExpr,

   ) where

 import GHC.Prelude hiding ( head, init, last, tail )

 import GHC.Core

 import GHC.Core.FVs

 import GHC.Core.Utils   ( exprIsTrivial, isDefaultAlt, isExpandableApp,

 import GHC.Core.Opt.Arity   ( joinRhsArity, isOneShotBndr )

 import GHC.Core.Coercion

 import GHC.Core.Type

 -}

 addBndrSwap :: OutExpr -> Id -> OccEnv -> OccEnv

 -- See Note [The binder-swap substitution]

 addBndrSwap scrut case_bndr

             env@(OccEnv { occ_bs_env = swap_env, occ_bs_rng = rng_vars })

   , scrut_var /= case_bndr

       -- Consider: case x of x { ... }

       -- Do not add [x :-> x] to occ_bs_env, else lookupBndrSwap will loop

         , occ_bs_rng = rng_vars `extendVarSet` case_bndr'

                        `unionVarSet` tyCoVarsOfMCo mco }

     case_bndr' = zapIdOccInfo case_bndr

                  -- See Note [Zap case binders in proxy bindings]

 lookupBndrSwap :: OccEnv -> Id -> (CoreExpr, Id)

 -- See Note [The binder-swap substitution]

 -- Returns an expression of the same type as Id

 import GHC.Core.Opt.Simplify.Env

 import GHC.Core.Opt.Simplify.Inline

 import GHC.Core.Opt.Simplify.Utils

 import GHC.Core.Make       ( FloatBind, mkImpossibleExpr, castBottomExpr )

 import qualified GHC.Core.Make

 import GHC.Core.Coercion hiding ( substCo, substCoVar )

       Stop {}          -> return (emptyFloats env, expr)

       TickIt t cont    -> rebuild_go env (mkTick t expr) cont

       CastIt { sc_co = co, sc_opt = opt, sc_cont = cont }

            -- NB: mkCast implements the (Coercion co |> g) optimisation

         where

           co' = optOutCoercion env co opt

     env1 = addBinderUnfolding env case_bndr con_app_unf

     -- See Note [Add unfolding for scrutinee]

     env2 | DoBinderSwap v mco <- bndr_swap

          = addBinderUnfolding env1 v $

               if isReflMCo mco  -- isReflMCo: avoid calling mk_simple_unf

               then con_app_unf  --            twice in the common case

          | otherwise = env1

 mkCase mode scrut outer_bndr alts_ty alts

   | sm_case_merge mode

   = do  { tick (CaseMerge outer_bndr)

         ; case_expr <- mkCase1 mode scrut outer_bndr alts_ty alts'

         ; return (mkLets joins case_expr) }

 import GHC.Core.FVs     ( exprsFreeVarsList, exprFreeVars )

 import GHC.Core.Opt.Monad

 import GHC.Core.Opt.WorkWrap.Utils

 import GHC.Core.DataCon

 import GHC.Core.Class( classTyVars )

 import GHC.Core.Coercion hiding( substCo )

 --               , text "spec_call_args" <+> ppr spec_call_args

 --               , text "rule_rhs" <+> ppr rule_rhs

 --               , text "adds_void_worker_arg" <+> ppr add_void_arg

 --               ]

         ; return (spec_usg, OS { os_pat = call_pat, os_rule = rule

                                , os_id = spec_id

         mergeAlts, mergeCaseAlts, trimConArgs,

         filterAlts, combineIdenticalAlts, refineDefaultAlt,

         scaleAltsBy,

         -- * Properties of expressions

         exprType, coreAltType, coreAltsType,

 import Data.Function       ( on )

 import Data.List           ( sort, sortBy, partition, zipWith4, mapAccumL )

 import Data.Ord            ( comparing )

 import qualified Data.Set as Set

 {-

 This makes it easy to find, though it makes matching marginally harder.

 -}

 -- | Extract the default case alternative

 findDefault :: [Alt b] -> ([Alt b], Maybe (Expr b))

 findDefault (Alt DEFAULT args rhs : alts) = assert (null args) (alts, Just rhs)

 -}

 ---------------------------------

 -- See Note [Merge Nested Cases]

   | Just (joins, inner_alts) <- go deflt_rhs

   = Just (joins, mergeAlts outer_alts inner_alts)

                 -- NB: mergeAlts gives priority to the left

                 -- When we merge, we must ensure that e1 takes

                 -- precedence over e2 as the value for A!

   where

     go :: CoreExpr -> Maybe ([CoreBind], [CoreAlt])

     -- Whizzo: we can merge!

       = do { (joins, alts) <- go body

              -- Check for capture; but only if we could otherwise do a merge

       | otherwise

       = Nothing

     go _ = Nothing

 ---------------------------------

 mergeAlts :: [Alt a] -> [Alt a] -> [Alt a]

       non-join-points unless the /outer/ case has just one alternative; doing

       so would risk more allocation

 (MC5) See Note [Cascading case merge]

 See also Note [Example of case-merging and caseRules] in GHC.Core.Opt.Simplify.Utils

 Note [Cascading case merge]

 ~~~~~~~~~~~~~~~~~~~~~~~~~~~