isReflKindCo,isReflKindMCo,

         isReflCo, isReflCo_maybe,

         isReflCoVar_maybe, mkGReflLeftMCo, mkGReflRightMCo,

         mkCoherenceRightMCo,

 -- See Note [KindCoercion] in GHC.Core.TyCo.Rep

 isKindCo :: Coercion -> Bool

 isKindCo co

   where

     (Pair kk1 kk2, role) = coercionKindRole co

 --    so we return True

 -- See Note [KindCoercion] in GHC.Core.TyCo.Rep

 isReflKindCo :: HasDebugCallStack => KindCoercion -> Bool

                              True

 isReflKindCo (Refl{})      = True -- Refl ty == GRefl N ty MRefl

 isReflKindCo _             = False

 -- | Returns the type coerced if this coercion is reflexive. Guaranteed

 -- to work very quickly. Sometimes a coercion can be reflexive, but not

 isReflCo_maybe :: Coercion -> Maybe (Type, Role)

 isReflCo_maybe (Refl ty) = Just (ty, Nominal)

 isReflCo_maybe (GRefl r ty mco) | isReflKindMCo mco = Just (ty, r)

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

 isReflexiveMCo (MCo co) = isReflexiveCo co

 forAllCoKindCo :: TyCoVar -> KindMCoercion -> KindCoercion

 -- Get the kind coercion from a ForAllCo

 forAllCoKindCo _   (MCo co) = co

 -- (c) The University of Glasgow 2006

 {-# LANGUAGE CPP #-}

 module GHC.Core.Coercion.Opt

    , OptCoercionOpts (..)

    )

 where

 import GHC.Tc.Utils.TcType   ( exactTyCoVarsOfType )

 import GHC.Core.TyCo.Rep

 import GHC.Core.TyCo.Subst

 import GHC.Core.TyCo.Compare( eqForAllVis, eqTypeIgnoringMultiplicity )

        to the little bits being substituted.

 -}

 -- | Coercion optimisation options

 newtype OptCoercionOpts = OptCoercionOpts

    { optCoercionEnabled :: Bool  -- ^ Enable coercion optimisation (reduce its size)

     in

       -- We only Lint multiplicities in the output of the typechecker, as

       -- described in Note [Linting linearity] in GHC.Core.Lint. This means

       --

       -- In particular, this gets rid of 'SubMultProv' coercions that were

       -- introduced for typechecking multiplicities of data constructors, as

 import GHC.Core

 import GHC.Core.SimpleOpt (simpleOptPgm)

 import GHC.Core.Opt.CSE  ( cseProgram )

 import GHC.Core.Rules   ( RuleBase, ruleCheckProgram, getRules )

 import GHC.Core.Ppr     ( pprCoreBindings, pprRules )

 import GHC.Core.Utils   ( dumpIdInfoOfProgram )

     strictness    = gopt Opt_Strictness                   dflags

     full_laziness = gopt Opt_FullLaziness                 dflags

     do_specialise = gopt Opt_Specialise                   dflags

     do_float_in   = gopt Opt_FloatIn                      dflags

     cse           = gopt Opt_CSE                          dflags

     spec_constr   = gopt Opt_SpecConstr                   dflags

     static_ptrs   = xopt LangExt.StaticPointers           dflags

     profiling     = ways dflags `hasWay` WayProf

     do_simpl3      = const_fold || rules_on -- TODO: any other optimizations benefit from three-phase simplification?

     maybe_rule_check phase = runMaybe rule_check (CoreDoRuleCheck phase)

         -- after this before anything else

         runWhen static_args (CoreDoPasses [ simpl_gently, CoreDoStaticArgs ]),

         -- Specialisation is best done before full laziness

         -- so that overloaded functions have all their dictionary lambdas manifest

         if full_laziness then

            CoreDoFloatOutwards $ FloatOutSwitches

     CoreCSE                   -> {-# SCC "CommonSubExpr" #-}

                                  updateBinds cseProgram

     CoreLiberateCase          -> {-# SCC "LiberateCase" #-}

                                  updateBinds (liberateCase (initLiberateCaseOpts dflags))

   | CoreDoSpecialising

   | CoreDoSpecConstr

   | CoreCSE

   | CoreDoRuleCheck CompilerPhase String  -- Check for non-application of rules

                                        -- matching this string

   | CoreDoNothing                -- Useful when building up

   ppr CoreDoSpecialising       = text "Specialise"

   ppr CoreDoSpecConstr         = text "SpecConstr"

   ppr CoreCSE                  = text "Common sub-expression"

   ppr CoreDesugar              = text "Desugar (before optimization)"

   ppr CoreDesugarOpt           = text "Desugar (after optimization)"

   ppr CoreTidy                 = text "Tidy Core"

       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

 -- | Initialise coercion optimiser configuration from DynFlags

 initOptCoercionOpts :: DynFlags -> OptCoercionOpts

 initOptCoercionOpts dflags = OptCoercionOpts

    }

 -- | Initialise Simple optimiser configuration from DynFlags

 coreDumpFlag :: CoreToDo -> Maybe DumpFlag

 coreDumpFlag (CoreDoSimplify {})      = Just Opt_D_verbose_core2core

 coreDumpFlag (CoreDoPluginPass {})    = Just Opt_D_verbose_core2core

 coreDumpFlag CoreDoFloatInwards       = Just Opt_D_dump_float_in

 coreDumpFlag (CoreDoFloatOutwards {}) = Just Opt_D_dump_float_out

 coreDumpFlag CoreLiberateCase         = Just Opt_D_dump_liberate_case

 hasNoStateHack = gopt Opt_G_NoStateHack

 hasNoOptCoercion :: DynFlags -> Bool

 -- | Test whether a 'DumpFlag' is set

 dopt :: DumpFlag -> DynFlags -> Bool

     , ([1,2],   Opt_DoCleverArgEtaExpansion) -- See Note [Eta expansion of arguments in CorePrep]

     , ([0,1,2], Opt_DoEtaReduction)          -- See Note [Eta-reduction in -O0]

     , ([0,1,2], Opt_ProfManualCcs )

     , ([2], Opt_DictsStrict)

     , ([0],     Opt_IgnoreInterfacePragmas)

    | Opt_InlineGenerics

    | Opt_InlineGenericsAggressively

    | Opt_StaticArgumentTransformation

    | Opt_CSE

    | Opt_StgCSE

    | Opt_StgLiftLams

    | Opt_PluginTrustworthy

    | Opt_G_NoStateHack

    deriving (Eq, Show, Enum)

 -- | The set of flags which affect optimisation for the purposes of

    , Opt_CrossModuleSpecialise

    , Opt_StaticArgumentTransformation

    , Opt_PolymorphicSpecialisation

    , Opt_CSE

    , Opt_StgCSE

    , Opt_StgLiftLams

         (NoArg (setGeneralFlag Opt_NoHsMain))

   , make_ord_flag defGhcFlag "fno-state-hack"

         (NoArg (setGeneralFlag Opt_G_NoStateHack))

   , make_ord_flag defGhcFlag "with-rtsopts"

         (HasArg setRtsOpts)

   , make_ord_flag defGhcFlag "rtsopts"

   flagSpec "cmm-elim-common-blocks"           Opt_CmmElimCommonBlocks,

   flagSpec "cmm-sink"                         Opt_CmmSink,

   flagSpec "cmm-static-pred"                  Opt_CmmStaticPred,

   flagSpec "cse"                              Opt_CSE,

   flagSpec "stg-cse"                          Opt_StgCSE,

   flagSpec "stg-lift-lams"                    Opt_StgLiftLams,