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 })

     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 )

 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

                                        , text "rule_act" <+> ppr rule_act

                                        ]

                     , (spec_fn, spec_rhs1) : pairs_acc

                     , rhs_uds2 `thenUDs` uds_acc

                     ) } }

         mergeAlts, mergeCaseAlts, trimConArgs,

         filterAlts, combineIdenticalAlts, refineDefaultAlt,

         scaleAltsBy,

         -- * Properties of expressions

         exprType, coreAltType, coreAltsType,

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

 import qualified Data.List as Partial ( init, last )

 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!

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

              --    (i.e. the recursive `go` succeeds)

       | 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]

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