    {-
    (c) The GRASP/AQUA Project, Glasgow University, 1992-1998

    \section[CoreRules]{Rewrite rules}
    -}

    -- | Functions for collecting together and applying rewrite rules to a module.
    -- The 'CoreRule' datatype itself is declared elsewhere.
    module GHC.Core.Rules (
            -- ** Looking up rules
            lookupRule, matchExprs,

            -- ** RuleBase, RuleEnv
            RuleBase, RuleEnv(..), mkRuleEnv, emptyRuleEnv,
            updExternalPackageRules, addLocalRules, updLocalRules,
            emptyRuleBase, mkRuleBase, extendRuleBaseList,
            pprRuleBase,

            -- ** Checking rule applications
            ruleCheckProgram,

            -- ** Manipulating 'RuleInfo' rules
            extendRuleInfo, addRuleInfo,
            addIdSpecialisations, addRulesToId,

            -- ** RuleBase and RuleEnv

            -- * Misc. CoreRule helpers
            rulesOfBinds, getRules, pprRulesForUser,

            -- * Making rules
            mkRule, mkSpecRule, roughTopNames

        ) where

    import GHC.Prelude

    import GHC.Unit.Module   ( Module )
    import GHC.Unit.Module.Env
    import GHC.Unit.Module.ModGuts( ModGuts(..) )
    import GHC.Unit.Module.Deps( Dependencies(..) )

    import GHC.Driver.DynFlags( DynFlags )
    import GHC.Driver.Ppr( showSDoc )

    import GHC.Core         -- All of it
    import GHC.Core.Subst
    import GHC.Core.SimpleOpt ( exprIsLambda_maybe )
    import GHC.Core.FVs       ( exprFreeVars, bindFreeVars
                              , rulesFreeVarsDSet, exprsOrphNames )
    import GHC.Core.Utils     ( exprType, mkTick, mkTicks
                              , stripTicksTopT, stripTicksTopE
                              , isJoinBind, mkCastMCo )
    import GHC.Core.Ppr       ( pprRules )
    import GHC.Core.Unify as Unify ( ruleMatchTyKiX )
    import GHC.Core.Type as Type
       ( Type, extendTvSubst, extendCvSubst
       , substTy, getTyVar_maybe )
    import GHC.Core.TyCo.Ppr( pprParendType )
    import GHC.Core.Coercion as Coercion
    import GHC.Core.Tidy     ( tidyRules )
    import GHC.Core.Map.Expr ( eqCoreExpr )
    import GHC.Core.Opt.Arity( etaExpandToJoinPointRule )
    import GHC.Core.Make     ( mkCoreLams )
    import GHC.Core.Opt.OccurAnal( occurAnalyseExpr )

    import GHC.Tc.Utils.TcType  ( tcSplitTyConApp_maybe )
    import GHC.Builtin.Types    ( anyTypeOfKind )

    import GHC.Types.Id
    import GHC.Types.Id.Info ( RuleInfo( RuleInfo ) )
    import GHC.Types.Var
    import GHC.Types.Var.Env
    import GHC.Types.Var.Set
    import GHC.Types.Name    ( Name, NamedThing(..), nameIsLocalOrFrom )
    import GHC.Types.Name.Set
    import GHC.Types.Name.Env
    import GHC.Types.Name.Occurrence( occNameFS )
    import GHC.Types.Unique.FM
    import GHC.Types.Tickish
    import GHC.Types.Basic

    import GHC.Data.FastString
    import GHC.Data.Maybe
    import GHC.Data.Bag
    import GHC.Data.List.SetOps( hasNoDups )

    import GHC.Utils.FV( filterFV, fvVarSet )
    import GHC.Utils.Misc as Utils
    import GHC.Utils.Outputable
    import GHC.Utils.Panic
    import GHC.Utils.Constants (debugIsOn)

    import Data.List (sortBy, mapAccumL, isPrefixOf)
    import Data.Function    ( on )
    import Control.Monad    ( guard )

    {-
    Note [Overall plumbing for rules]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    * After the desugarer:
       - The ModGuts initially contains mg_rules :: [CoreRule] of
         locally-declared rules for imported Ids.
       - Locally-declared rules for locally-declared Ids are attached to
         the IdInfo for that Id.  See Note [Attach rules to local ids] in
         GHC.HsToCore.Binds

    * GHC.Iface.Tidy strips off all the rules from local Ids and adds them to
      mg_rules, so that the ModGuts has *all* the locally-declared rules.

    * The HomePackageTable contains a ModDetails for each home package
      module.  Each contains md_rules :: [CoreRule] of rules declared in
      that module.  The HomePackageTable grows as ghc --make does its
      up-sweep.  In batch mode (ghc -c), the HPT is empty; all imported modules
      are treated by the "external" route, discussed next, regardless of
      which package they come from.

    * The ExternalPackageState has a single eps_rule_base :: RuleBase for
      Ids in other packages.  This RuleBase simply grow monotonically, as
      ghc --make compiles one module after another.

      During simplification, interface files may get demand-loaded,
      as the simplifier explores the unfoldings for Ids it has in
      its hand.  (Via an unsafePerformIO; the EPS is really a cache.)
      That in turn may make the EPS rule-base grow.  In contrast, the
      HPT never grows in this way.

    * The result of all this is that during Core-to-Core optimisation
      there are four sources of rules:

        (a) Rules in the IdInfo of the Id they are a rule for.  These are
            easy: fast to look up, and if you apply a substitution then
            it'll be applied to the IdInfo as a matter of course.

        (b) Rules declared in this module for imported Ids, kept in the
            ModGuts. If you do a substitution, you'd better apply the
            substitution to these.  There are seldom many of these.

        (c) Rules declared in the HomePackageTable.  These never change.

        (d) Rules in the ExternalPackageTable. These can grow in response
            to lazy demand-loading of interfaces.

    * At the moment (c) is carried in a reader-monad way by the GHC.Core.Opt.Monad.
      The HomePackageTable doesn't have a single RuleBase because technically
      we should only be able to "see" rules "below" this module; so we
      generate a RuleBase for (c) by combining rules from all the modules
      "below" us.  That's why we can't just select the home-package RuleBase
      from HscEnv.

      [NB: we are inconsistent here.  We should do the same for external
      packages, but we don't.  Same for type-class instances.]

    * So in the outer simplifier loop (simplifyPgmIO), we combine (b & c) into a single
      RuleBase, reading
         (b) from the ModGuts,
         (c) from the GHC.Core.Opt.Monad, and
      just before doing rule matching we read
         (d) from its mutable variable
      and combine it with the results from (b & c).

      In a single simplifier run new rules can be added into the EPS so it matters
      to keep an up-to-date view of which rules have been loaded. For examples of
      where this went wrong and caused cryptic performance regressions
      see T19790 and !6735.

    ************************************************************************
    *                                                                      *
    \subsection[specialisation-IdInfo]{Specialisation info about an @Id@}
    *                                                                      *
    ************************************************************************

    A CoreRule holds details of one rule for an Id, which
    includes its specialisations.

    For example, if a rule for f is
       RULE "f" forall @a @b d. f @(List a) @b d = f' a b

    then when we find an application of f to matching types, we simply replace
    it by the matching RHS:
            f (List Int) Bool dict ===>  f' Int Bool
    All the stuff about how many dictionaries to discard, and what types
    to apply the specialised function to, are handled by the fact that the
    Rule contains a template for the result of the specialisation.
    -}

    mkRule :: Module -> Bool -> Bool -> RuleName -> Activation
           -> Name -> [CoreBndr] -> [CoreExpr] -> CoreExpr -> CoreRule
    -- ^ Used to make 'CoreRule' for an 'Id' defined in the module being
    -- compiled. See also 'GHC.Core.CoreRule'
    mkRule :: Module
    -> Bool
    -> Bool
    -> RuleName
    -> Activation
    -> Name
    -> [Var]
    -> [CoreExpr]
    -> CoreExpr
    -> CoreRule
    mkRule Module
    this_mod Bool
    is_auto Bool
    is_local RuleName
    name Activation
    act Name
    fn [Var]
    bndrs [CoreExpr]
    args CoreExpr
    rhs
      = Rule { ru_name :: RuleName
    ru_name   = RuleName
    name
             , ru_act :: Activation
    ru_act    = Activation
    act
             , ru_fn :: Name
    ru_fn     = Name
    fn
             , ru_bndrs :: [Var]
    ru_bndrs  = [Var]
    bndrs
             , ru_args :: [CoreExpr]
    ru_args   = [CoreExpr]
    args
             , ru_rhs :: CoreExpr
    ru_rhs    = CoreExpr -> CoreExpr
    occurAnalyseExpr CoreExpr
    rhs
                           -- See Note [OccInfo in unfoldings and rules]
             , ru_rough :: [Maybe Name]
    ru_rough  = [CoreExpr] -> [Maybe Name]
    roughTopNames [CoreExpr]
    args
             , ru_origin :: Module
    ru_origin = Module
    this_mod
             , ru_orphan :: IsOrphan
    ru_orphan = IsOrphan
    orph
             , ru_auto :: Bool
    ru_auto   = Bool
    is_auto
             , ru_local :: Bool
    ru_local  = Bool
    is_local }
      where
            -- Compute orphanhood.  See Note [Orphans] in GHC.Core.InstEnv
            -- A rule is an orphan only if none of the variables
            -- mentioned on its left-hand side are locally defined
        lhs_names :: NameSet
    lhs_names = NameSet -> Name -> NameSet
    extendNameSet ([CoreExpr] -> NameSet
    exprsOrphNames [CoreExpr]
    args) Name
    fn

            -- Since rules get eventually attached to one of the free names
            -- from the definition when compiling the ABI hash, we should make
            -- it deterministic. This chooses the one with minimal OccName
            -- as opposed to uniq value.
        local_lhs_names :: NameSet
    local_lhs_names = (Name -> Bool) -> NameSet -> NameSet
    filterNameSet (Module -> Name -> Bool
    nameIsLocalOrFrom Module
    this_mod) NameSet
    lhs_names
        orph :: IsOrphan
    orph = NameSet -> IsOrphan
    chooseOrphanAnchor NameSet
    local_lhs_names

    --------------
    mkSpecRule :: DynFlags -> Module -> Bool -> Activation -> SDoc
               -> Id -> [CoreBndr] -> [CoreExpr] -> CoreExpr -> CoreRule
    -- Make a specialisation rule, for Specialise or SpecConstr
    mkSpecRule :: DynFlags
    -> Module
    -> Bool
    -> Activation
    -> SDoc
    -> Var
    -> [Var]
    -> [CoreExpr]
    -> CoreExpr
    -> CoreRule
    mkSpecRule DynFlags
    dflags Module
    this_mod Bool
    is_auto Activation
    inl_act SDoc
    herald Var
    fn [Var]
    bndrs [CoreExpr]
    args CoreExpr
    rhs
      = case Var -> JoinPointHood
    idJoinPointHood Var
    fn of
          JoinPoint Arity
    join_arity -> Arity -> CoreRule -> CoreRule
    etaExpandToJoinPointRule Arity
    join_arity CoreRule
    rule
          JoinPointHood
    NotJoinPoint         -> CoreRule
    rule
      where
        rule :: CoreRule
    rule = Module
    -> Bool
    -> Bool
    -> RuleName
    -> Activation
    -> Name
    -> [Var]
    -> [CoreExpr]
    -> CoreExpr
    -> CoreRule
    mkRule Module
    this_mod Bool
    is_auto Bool
    is_local
                      RuleName
    rule_name
                      Activation
    inl_act       -- Note [Auto-specialisation and RULES]
                      (Var -> Name
    idName Var
    fn)
                      [Var]
    bndrs [CoreExpr]
    args CoreExpr
    rhs

        is_local :: Bool
    is_local = Var -> Bool
    isLocalId Var
    fn
        rule_name :: RuleName
    rule_name = DynFlags -> SDoc -> Var -> [CoreExpr] -> RuleName
    mkSpecRuleName DynFlags
    dflags SDoc
    herald Var
    fn [CoreExpr]
    args

    mkSpecRuleName :: DynFlags -> SDoc -> Id -> [CoreExpr] -> FastString
    mkSpecRuleName :: DynFlags -> SDoc -> Var -> [CoreExpr] -> RuleName
    mkSpecRuleName DynFlags
    dflags SDoc
    herald Var
    fn [CoreExpr]
    args
      = String -> RuleName
    mkFastString (String -> RuleName) -> String -> RuleName
    forall a b. (a -> b) -> a -> b
    $ DynFlags -> SDoc -> String
    showSDoc DynFlags
    dflags (SDoc -> String) -> SDoc -> String
    forall a b. (a -> b) -> a -> b
    $
        SDoc
    herald SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> RuleName -> SDoc
    forall doc. IsLine doc => RuleName -> doc
    ftext (OccName -> RuleName
    occNameFS (Var -> OccName
    forall a. NamedThing a => a -> OccName
    getOccName Var
    fn))
                         -- This name ends up in interface files, so use occNameFS.
                         -- Otherwise uniques end up there, making builds
                         -- less deterministic (See #4012 comment:61 ff)
               SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> [SDoc] -> SDoc
    forall doc. IsLine doc => [doc] -> doc
    hsep ((CoreExpr -> Maybe SDoc) -> [CoreExpr] -> [SDoc]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe CoreExpr -> Maybe SDoc
    ppr_call_key_ty [CoreExpr]
    args)
      where
        ppr_call_key_ty :: CoreExpr -> Maybe SDoc
        ppr_call_key_ty :: CoreExpr -> Maybe SDoc
    ppr_call_key_ty (Type Kind
    ty) = case Kind -> Maybe Var
    getTyVar_maybe Kind
    ty of
                                      Just {} -> SDoc -> Maybe SDoc
    forall a. a -> Maybe a
    Just (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "@_")
                                      Maybe Var
    Nothing -> SDoc -> Maybe SDoc
    forall a. a -> Maybe a
    Just (SDoc -> Maybe SDoc) -> SDoc -> Maybe SDoc
    forall a b. (a -> b) -> a -> b
    $ Char -> SDoc
    forall doc. IsLine doc => Char -> doc
    char Char
    '@' SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> Kind -> SDoc
    pprParendType Kind
    ty
        ppr_call_key_ty CoreExpr
    _ = Maybe SDoc
    forall a. Maybe a
    Nothing

    --------------
    roughTopNames :: [CoreExpr] -> [Maybe Name]
    -- ^ Find the \"top\" free names of several expressions.
    -- Such names are either:
    --
    -- 1. The function finally being applied to in an application chain
    --    (if that name is a GlobalId: see "GHC.Types.Var#globalvslocal"), or
    --
    -- 2. The 'TyCon' if the expression is a 'Type'
    --
    -- This is used for the fast-match-check for rules;
    --      if the top names don't match, the rest can't
    roughTopNames :: [CoreExpr] -> [Maybe Name]
    roughTopNames [CoreExpr]
    args = (CoreExpr -> Maybe Name) -> [CoreExpr] -> [Maybe Name]
    forall a b. (a -> b) -> [a] -> [b]
    map CoreExpr -> Maybe Name
    roughTopName [CoreExpr]
    args

    roughTopName :: CoreExpr -> Maybe Name
    roughTopName :: CoreExpr -> Maybe Name
    roughTopName (Type Kind
    ty) = case HasCallStack => Kind -> Maybe (TyCon, [Kind])
    Kind -> Maybe (TyCon, [Kind])
    tcSplitTyConApp_maybe Kind
    ty of
                                   Just (TyCon
    tc,[Kind]
    _) -> Name -> Maybe Name
    forall a. a -> Maybe a
    Just (TyCon -> Name
    forall a. NamedThing a => a -> Name
    getName TyCon
    tc)
                                   Maybe (TyCon, [Kind])
    Nothing     -> Maybe Name
    forall a. Maybe a
    Nothing
    roughTopName (Coercion Coercion
    _) = Maybe Name
    forall a. Maybe a
    Nothing
    roughTopName (App CoreExpr
    f CoreExpr
    _) = CoreExpr -> Maybe Name
    roughTopName CoreExpr
    f
    roughTopName (Var Var
    f)   | Var -> Bool
    isGlobalId Var
    f   -- Note [Care with roughTopName]
                           , Var -> Bool
    isDataConWorkId Var
    f Bool -> Bool -> Bool
    || Var -> Arity
    idArity Var
    f Arity -> Arity -> Bool
    forall a. Ord a => a -> a -> Bool
    > Arity
    0
                           = Name -> Maybe Name
    forall a. a -> Maybe a
    Just (Var -> Name
    idName Var
    f)
    roughTopName (Tick CoreTickish
    t CoreExpr
    e) | CoreTickish -> Bool
    forall (pass :: TickishPass). GenTickish pass -> Bool
    tickishFloatable CoreTickish
    t
                            = CoreExpr -> Maybe Name
    roughTopName CoreExpr
    e
    roughTopName CoreExpr
    _ = Maybe Name
    forall a. Maybe a
    Nothing

    ruleCantMatch :: [Maybe Name] -> [Maybe Name] -> Bool
    -- ^ @ruleCantMatch tpl actual@ returns True only if @actual@
    -- definitely can't match @tpl@ by instantiating @tpl@.
    -- It's only a one-way match; unlike instance matching we
    -- don't consider unification.
    --
    -- Notice that [_$_]
    --      @ruleCantMatch [Nothing] [Just n2] = False@
    --      Reason: a template variable can be instantiated by a constant
    -- Also:
    --      @ruleCantMatch [Just n1] [Nothing] = False@
    --      Reason: a local variable @v@ in the actuals might [_$_]

    ruleCantMatch :: [Maybe Name] -> [Maybe Name] -> Bool
    ruleCantMatch (Just Name
    n1 : [Maybe Name]
    ts) (Just Name
    n2 : [Maybe Name]
    as) = Name
    n1 Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Name
    n2 Bool -> Bool -> Bool
    || [Maybe Name] -> [Maybe Name] -> Bool
    ruleCantMatch [Maybe Name]
    ts [Maybe Name]
    as
    ruleCantMatch (Maybe Name
    _       : [Maybe Name]
    ts) (Maybe Name
    _       : [Maybe Name]
    as) = [Maybe Name] -> [Maybe Name] -> Bool
    ruleCantMatch [Maybe Name]
    ts [Maybe Name]
    as
    ruleCantMatch [Maybe Name]
    _              [Maybe Name]
    _              = Bool
    False

    {-
    Note [Care with roughTopName]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Consider this
        module M where { x = a:b }
        module N where { ...f x...
                         RULE f (p:q) = ... }
    You'd expect the rule to match, because the matcher can
    look through the unfolding of 'x'.  So we must avoid roughTopName
    returning 'M.x' for the call (f x), or else it'll say "can't match"
    and we won't even try!!

    However, suppose we have
             RULE g (M.h x) = ...
             foo = ...(g (M.k v))....
    where k is a *function* exported by M.  We never really match
    functions (lambdas) except by name, so in this case it seems like
    a good idea to treat 'M.k' as a roughTopName of the call.
    -}

    pprRulesForUser :: [CoreRule] -> SDoc
    -- (a) tidy the rules
    -- (b) sort them into order based on the rule name
    -- (c) suppress uniques (unless -dppr-debug is on)
    -- This combination makes the output stable so we can use in testing
    -- It's here rather than in GHC.Core.Ppr because it calls tidyRules
    pprRulesForUser :: [CoreRule] -> SDoc
    pprRulesForUser [CoreRule]
    rules
      = PprStyle -> SDoc -> SDoc
    withPprStyle PprStyle
    defaultUserStyle (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $
        [CoreRule] -> SDoc
    pprRules ([CoreRule] -> SDoc) -> [CoreRule] -> SDoc
    forall a b. (a -> b) -> a -> b
    $
        (CoreRule -> CoreRule -> Ordering) -> [CoreRule] -> [CoreRule]
    forall a. (a -> a -> Ordering) -> [a] -> [a]
    sortBy (RuleName -> RuleName -> Ordering
    lexicalCompareFS (RuleName -> RuleName -> Ordering)
    -> (CoreRule -> RuleName) -> CoreRule -> CoreRule -> Ordering
    forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
    `on` CoreRule -> RuleName
    ruleName) ([CoreRule] -> [CoreRule]) -> [CoreRule] -> [CoreRule]
    forall a b. (a -> b) -> a -> b
    $
        TidyEnv -> [CoreRule] -> [CoreRule]
    tidyRules TidyEnv
    emptyTidyEnv [CoreRule]
    rules

    {-
    ************************************************************************
    *                                                                      *
                    RuleInfo: the rules in an IdInfo
    *                                                                      *
    ************************************************************************
    -}

    extendRuleInfo :: RuleInfo -> [CoreRule] -> RuleInfo
    extendRuleInfo :: RuleInfo -> [CoreRule] -> RuleInfo
    extendRuleInfo (RuleInfo [CoreRule]
    rs1 DVarSet
    fvs1) [CoreRule]
    rs2
      = [CoreRule] -> DVarSet -> RuleInfo
    RuleInfo ([CoreRule]
    rs2 [CoreRule] -> [CoreRule] -> [CoreRule]
    forall a. [a] -> [a] -> [a]
    ++ [CoreRule]
    rs1) ([CoreRule] -> DVarSet
    rulesFreeVarsDSet [CoreRule]
    rs2 DVarSet -> DVarSet -> DVarSet
    `unionDVarSet` DVarSet
    fvs1)

    addRuleInfo :: RuleInfo -> RuleInfo -> RuleInfo
    addRuleInfo :: RuleInfo -> RuleInfo -> RuleInfo
    addRuleInfo (RuleInfo [CoreRule]
    rs1 DVarSet
    fvs1) (RuleInfo [CoreRule]
    rs2 DVarSet
    fvs2)
      = [CoreRule] -> DVarSet -> RuleInfo
    RuleInfo ([CoreRule]
    rs1 [CoreRule] -> [CoreRule] -> [CoreRule]
    forall a. [a] -> [a] -> [a]
    ++ [CoreRule]
    rs2) (DVarSet
    fvs1 DVarSet -> DVarSet -> DVarSet
    `unionDVarSet` DVarSet
    fvs2)

    addIdSpecialisations :: Id -> [CoreRule] -> Id
    addIdSpecialisations :: Var -> [CoreRule] -> Var
    addIdSpecialisations Var
    id [CoreRule]
    rules
      | [CoreRule] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [CoreRule]
    rules
      = Var
    id
      | Bool
    otherwise
      = Var -> RuleInfo -> Var
    setIdSpecialisation Var
    id (RuleInfo -> Var) -> RuleInfo -> Var
    forall a b. (a -> b) -> a -> b
    $
        RuleInfo -> [CoreRule] -> RuleInfo
    extendRuleInfo (Var -> RuleInfo
    idSpecialisation Var
    id) [CoreRule]
    rules

    addRulesToId :: RuleBase -> Id -> Id
    -- Add rules in the RuleBase to the rules in the Id
    addRulesToId :: RuleBase -> Var -> Var
    addRulesToId RuleBase
    rule_base Var
    bndr
      | Just [CoreRule]
    rules <- RuleBase -> Name -> Maybe [CoreRule]
    forall a. NameEnv a -> Name -> Maybe a
    lookupNameEnv RuleBase
    rule_base (Var -> Name
    idName Var
    bndr)
      = Var
    bndr Var -> [CoreRule] -> Var
    `addIdSpecialisations` [CoreRule]
    rules
      | Bool
    otherwise
      = Var
    bndr

    -- | Gather all the rules for locally bound identifiers from the supplied bindings
    rulesOfBinds :: [CoreBind] -> [CoreRule]
    rulesOfBinds :: [CoreBind] -> [CoreRule]
    rulesOfBinds [CoreBind]
    binds = (CoreBind -> [CoreRule]) -> [CoreBind] -> [CoreRule]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap ((Var -> [CoreRule]) -> [Var] -> [CoreRule]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap Var -> [CoreRule]
    idCoreRules ([Var] -> [CoreRule])
    -> (CoreBind -> [Var]) -> CoreBind -> [CoreRule]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CoreBind -> [Var]
    forall b. Bind b -> [b]
    bindersOf) [CoreBind]
    binds

    {-
    ************************************************************************
    *                                                                      *
                    RuleBase
    *                                                                      *
    ************************************************************************
    -}

    -- | Gathers a collection of 'CoreRule's. Maps (the name of) an 'Id' to its rules
    type RuleBase = NameEnv [CoreRule]
            -- The rules are unordered;
            -- we sort out any overlaps on lookup

    emptyRuleBase :: RuleBase
    emptyRuleBase :: RuleBase
    emptyRuleBase = RuleBase
    forall a. NameEnv a
    emptyNameEnv

    mkRuleBase :: [CoreRule] -> RuleBase
    mkRuleBase :: [CoreRule] -> RuleBase
    mkRuleBase [CoreRule]
    rules = RuleBase -> [CoreRule] -> RuleBase
    extendRuleBaseList RuleBase
    emptyRuleBase [CoreRule]
    rules

    extendRuleBaseList :: RuleBase -> [CoreRule] -> RuleBase
    extendRuleBaseList :: RuleBase -> [CoreRule] -> RuleBase
    extendRuleBaseList RuleBase
    rule_base [CoreRule]
    new_guys
      = (RuleBase -> CoreRule -> RuleBase)
    -> RuleBase -> [CoreRule] -> RuleBase
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' RuleBase -> CoreRule -> RuleBase
    extendRuleBase RuleBase
    rule_base [CoreRule]
    new_guys

    extendRuleBase :: RuleBase -> CoreRule -> RuleBase
    extendRuleBase :: RuleBase -> CoreRule -> RuleBase
    extendRuleBase RuleBase
    rule_base CoreRule
    rule
      = (CoreRule -> [CoreRule] -> [CoreRule])
    -> (CoreRule -> [CoreRule])
    -> RuleBase
    -> Name
    -> CoreRule
    -> RuleBase
    forall a b.
    (a -> b -> b) -> (a -> b) -> NameEnv b -> Name -> a -> NameEnv b
    extendNameEnv_Acc (:) CoreRule -> [CoreRule]
    forall a. a -> [a]
    Utils.singleton RuleBase
    rule_base (CoreRule -> Name
    ruleIdName CoreRule
    rule) CoreRule
    rule

    pprRuleBase :: RuleBase -> SDoc
    pprRuleBase :: RuleBase -> SDoc
    pprRuleBase RuleBase
    rules = RuleBase -> ([[CoreRule]] -> SDoc) -> SDoc
    forall {k} (key :: k) a. UniqFM key a -> ([a] -> SDoc) -> SDoc
    pprUFM RuleBase
    rules (([[CoreRule]] -> SDoc) -> SDoc) -> ([[CoreRule]] -> SDoc) -> SDoc
    forall a b. (a -> b) -> a -> b
    $ \[[CoreRule]]
    rss ->
      [SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat [ [CoreRule] -> SDoc
    pprRules (TidyEnv -> [CoreRule] -> [CoreRule]
    tidyRules TidyEnv
    emptyTidyEnv [CoreRule]
    rs)
           | [CoreRule]
    rs <- [[CoreRule]]
    rss ]

    -- | A full rule environment which we can apply rules from.  Like a 'RuleBase',
    -- but it also includes the set of visible orphans we use to filter out orphan
    -- rules which are not visible (even though we can see them...)
    -- See Note [Orphans] in GHC.Core
    data RuleEnv
        = RuleEnv { RuleEnv -> RuleBase
    re_local_rules   :: !RuleBase -- Rules from this module
                  , RuleEnv -> RuleBase
    re_home_rules    :: !RuleBase -- Rule from the home package
                                                  --   (excl this module)
                  , RuleEnv -> RuleBase
    re_eps_rules     :: !RuleBase -- Rules from other packages
                                                  --   see Note [External package rules]
                  , RuleEnv -> ModuleSet
    re_visible_orphs :: !ModuleSet
                  }

    mkRuleEnv :: ModGuts -> RuleBase -> RuleBase -> RuleEnv
    mkRuleEnv :: ModGuts -> RuleBase -> RuleBase -> RuleEnv
    mkRuleEnv (ModGuts { mg_module :: ModGuts -> Module
    mg_module = Module
    this_mod
                       , mg_deps :: ModGuts -> Dependencies
    mg_deps   = Dependencies
    deps
                       , mg_rules :: ModGuts -> [CoreRule]
    mg_rules  = [CoreRule]
    local_rules })
              RuleBase
    eps_rules RuleBase
    hpt_rules
      = RuleEnv { re_local_rules :: RuleBase
    re_local_rules   = [CoreRule] -> RuleBase
    mkRuleBase [CoreRule]
    local_rules
                , re_home_rules :: RuleBase
    re_home_rules    = RuleBase
    hpt_rules
                , re_eps_rules :: RuleBase
    re_eps_rules     = RuleBase
    eps_rules
                , re_visible_orphs :: ModuleSet
    re_visible_orphs = [Module] -> ModuleSet
    mkModuleSet [Module]
    vis_orphs }
      where
        vis_orphs :: [Module]
    vis_orphs = Module
    this_mod Module -> [Module] -> [Module]
    forall a. a -> [a] -> [a]
    : Dependencies -> [Module]
    dep_orphs Dependencies
    deps

    updExternalPackageRules :: RuleEnv -> RuleBase -> RuleEnv
    -- Completely over-ride the external rules in RuleEnv
    updExternalPackageRules :: RuleEnv -> RuleBase -> RuleEnv
    updExternalPackageRules RuleEnv
    rule_env RuleBase
    eps_rules
      = RuleEnv
    rule_env { re_eps_rules = eps_rules }

    updLocalRules :: RuleEnv -> [CoreRule] -> RuleEnv
    -- Completely over-ride the local rules in RuleEnv
    updLocalRules :: RuleEnv -> [CoreRule] -> RuleEnv
    updLocalRules RuleEnv
    rule_env [CoreRule]
    local_rules
      = RuleEnv
    rule_env { re_local_rules = mkRuleBase local_rules }

    addLocalRules :: RuleEnv -> [CoreRule] -> RuleEnv
    -- Add new local rules
    addLocalRules :: RuleEnv -> [CoreRule] -> RuleEnv
    addLocalRules RuleEnv
    rule_env [CoreRule]
    rules
      = RuleEnv
    rule_env { re_local_rules = extendRuleBaseList (re_local_rules rule_env) rules }

    emptyRuleEnv :: RuleEnv
    emptyRuleEnv :: RuleEnv
    emptyRuleEnv = RuleEnv { re_local_rules :: RuleBase
    re_local_rules   = RuleBase
    forall a. NameEnv a
    emptyNameEnv
                           , re_home_rules :: RuleBase
    re_home_rules    = RuleBase
    forall a. NameEnv a
    emptyNameEnv
                           , re_eps_rules :: RuleBase
    re_eps_rules     = RuleBase
    forall a. NameEnv a
    emptyNameEnv
                           , re_visible_orphs :: ModuleSet
    re_visible_orphs = ModuleSet
    emptyModuleSet }

    getRules :: RuleEnv -> Id -> [CoreRule]
    -- Given a RuleEnv and an Id, find the visible rules for that Id
    -- See Note [Where rules are found]
    --
    -- This function is quite heavily used, so it's worth trying to make it efficient
    getRules :: RuleEnv -> Var -> [CoreRule]
    getRules (RuleEnv { re_local_rules :: RuleEnv -> RuleBase
    re_local_rules   = RuleBase
    local_rule_base
                      , re_home_rules :: RuleEnv -> RuleBase
    re_home_rules    = RuleBase
    home_rule_base
                      , re_eps_rules :: RuleEnv -> RuleBase
    re_eps_rules     = RuleBase
    eps_rule_base
                      , re_visible_orphs :: RuleEnv -> ModuleSet
    re_visible_orphs = ModuleSet
    orphs }) Var
    fn

      | Just {} <- Var -> Maybe DataCon
    isDataConId_maybe Var
    fn   -- Short cut for data constructor workers
      = []                                -- and wrappers, which never have any rules

      | Just ExportFlag
    export_flag <- Var -> Maybe ExportFlag
    isLocalId_maybe Var
    fn
      = -- LocalIds can't have rules in the local_rule_base (used for imported fns)
        -- nor external packages; but there can (just) be rules in another module
        -- in the home package, if it is exported
        case ExportFlag
    export_flag of
          ExportFlag
    NotExported -> Var -> [CoreRule]
    idCoreRules Var
    fn
          ExportFlag
    Exported -> case RuleBase -> [CoreRule]
    get RuleBase
    home_rule_base of
              []           -> Var -> [CoreRule]
    idCoreRules Var
    fn
              [CoreRule]
    home_rules   -> [CoreRule] -> [CoreRule]
    drop_orphs [CoreRule]
    home_rules [CoreRule] -> [CoreRule] -> [CoreRule]
    forall a. [a] -> [a] -> [a]
    ++ Var -> [CoreRule]
    idCoreRules Var
    fn

      | Bool
    otherwise
      = -- This case expression is a fast path, to avoid calling the
        -- recursive (++) in the common case where there are no rules at all
        case (RuleBase -> [CoreRule]
    get RuleBase
    local_rule_base, RuleBase -> [CoreRule]
    get RuleBase
    home_rule_base, RuleBase -> [CoreRule]
    get RuleBase
    eps_rule_base) of
          ([], [], [])                         -> Var -> [CoreRule]
    idCoreRules Var
    fn
          ([CoreRule]
    local_rules, [CoreRule]
    home_rules, [CoreRule]
    eps_rules) -> [CoreRule]
    local_rules           [CoreRule] -> [CoreRule] -> [CoreRule]
    forall a. [a] -> [a] -> [a]
    ++
                                                  [CoreRule] -> [CoreRule]
    drop_orphs [CoreRule]
    home_rules [CoreRule] -> [CoreRule] -> [CoreRule]
    forall a. [a] -> [a] -> [a]
    ++
                                                  [CoreRule] -> [CoreRule]
    drop_orphs [CoreRule]
    eps_rules  [CoreRule] -> [CoreRule] -> [CoreRule]
    forall a. [a] -> [a] -> [a]
    ++
                                                  Var -> [CoreRule]
    idCoreRules Var
    fn
      where
        fn_name :: Name
    fn_name = Var -> Name
    idName Var
    fn
        drop_orphs :: [CoreRule] -> [CoreRule]
    drop_orphs [] = []  -- Fast path; avoid invoking recursive filter
        drop_orphs [CoreRule]
    xs = (CoreRule -> Bool) -> [CoreRule] -> [CoreRule]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (ModuleSet -> CoreRule -> Bool
    ruleIsVisible ModuleSet
    orphs) [CoreRule]
    xs
        get :: RuleBase -> [CoreRule]
    get RuleBase
    rb = RuleBase -> Name -> Maybe [CoreRule]
    forall a. NameEnv a -> Name -> Maybe a
    lookupNameEnv RuleBase
    rb Name
    fn_name Maybe [CoreRule] -> [CoreRule] -> [CoreRule]
    forall a. Maybe a -> a -> a
    `orElse` []

    ruleIsVisible :: ModuleSet -> CoreRule -> Bool
    ruleIsVisible :: ModuleSet -> CoreRule -> Bool
    ruleIsVisible ModuleSet
    _ BuiltinRule{} = Bool
    True
    ruleIsVisible ModuleSet
    vis_orphs Rule { ru_orphan :: CoreRule -> IsOrphan
    ru_orphan = IsOrphan
    orph, ru_origin :: CoreRule -> Module
    ru_origin = Module
    origin }
        = IsOrphan -> Bool
    notOrphan IsOrphan
    orph Bool -> Bool -> Bool
    || Module
    origin Module -> ModuleSet -> Bool
    `elemModuleSet` ModuleSet
    vis_orphs

    {- Note [Where rules are found]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    The rules for an Id come from two places:
      (a) the ones it is born with, stored inside the Id itself (idCoreRules fn),
      (b) rules added in other modules, stored in the global RuleBase (imp_rules)

    It's tempting to think that
         - LocalIds have only (a)
         - non-LocalIds have only (b)

    but that isn't quite right:

         - PrimOps and ClassOps are born with a bunch of rules inside the Id,
           even when they are imported

         - The rules in GHC.Core.Opt.ConstantFold.builtinRules should be active even
           in the module defining the Id (when it's a LocalId), but
           the rules are kept in the global RuleBase

     Note [External package rules]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    In Note [Overall plumbing for rules], it is explained that the final
    RuleBase which we must consider is combined from 4 different sources.

    During simplifier runs, the fourth source of rules is constantly being updated
    as new interfaces are loaded into the EPS. Therefore just before we check to see
    if any rules match we get the EPS RuleBase and combine it with the existing RuleBase
    and then perform exactly 1 lookup into the new map.

    It is more efficient to avoid combining the environments and store the uncombined
    environments as we can instead perform 1 lookup into each environment and then combine
    the results.

    Essentially we use the identity:

    > lookupNameEnv n (plusNameEnv_C (++) rb1 rb2)
    >   = lookupNameEnv n rb1 ++ lookupNameEnv n rb2

    The latter being more efficient as we don't construct an intermediate
    map.
    -}

    {-
    ************************************************************************
    *                                                                      *
                            Matching
    *                                                                      *
    ************************************************************************
    -}

    -- | The main rule matching function. Attempts to apply all (active)
    -- supplied rules to this instance of an application in a given
    -- context, returning the rule applied and the resulting expression if
    -- successful.
    lookupRule :: RuleOpts -> InScopeEnv
               -> (Activation -> Bool)      -- When rule is active
               -> Id -- Function head
               -> [CoreExpr] -- Args
               -> [CoreRule] -- Rules
               -> Maybe (CoreRule, CoreExpr)

    -- See Note [Extra args in the target]
    -- See comments on matchRule
    lookupRule :: RuleOpts
    -> InScopeEnv
    -> (Activation -> Bool)
    -> Var
    -> [CoreExpr]
    -> [CoreRule]
    -> Maybe (CoreRule, CoreExpr)
    lookupRule RuleOpts
    opts rule_env :: InScopeEnv
    rule_env@(ISE InScopeSet
    in_scope IdUnfoldingFun
    _) Activation -> Bool
    is_active Var
    fn [CoreExpr]
    args [CoreRule]
    rules
      = -- pprTrace "lookupRule" (ppr fn <+> ppr args $$ ppr rules $$ ppr in_scope) $
        case [(CoreRule, CoreExpr)] -> [CoreRule] -> [(CoreRule, CoreExpr)]
    go [] [CoreRule]
    rules of
            []     -> Maybe (CoreRule, CoreExpr)
    forall a. Maybe a
    Nothing
            ((CoreRule, CoreExpr)
    m:[(CoreRule, CoreExpr)]
    ms) -> (CoreRule, CoreExpr) -> Maybe (CoreRule, CoreExpr)
    forall a. a -> Maybe a
    Just (InScopeSet
    -> (Var, [CoreExpr])
    -> (CoreRule, CoreExpr)
    -> [(CoreRule, CoreExpr)]
    -> (CoreRule, CoreExpr)
    findBest InScopeSet
    in_scope (Var
    fn,[CoreExpr]
    args') (CoreRule, CoreExpr)
    m [(CoreRule, CoreExpr)]
    ms)
      where
        rough_args :: [Maybe Name]
    rough_args = (CoreExpr -> Maybe Name) -> [CoreExpr] -> [Maybe Name]
    forall a b. (a -> b) -> [a] -> [b]
    map CoreExpr -> Maybe Name
    roughTopName [CoreExpr]
    args

        -- Strip ticks from arguments, see Note [Tick annotations in RULE
        -- matching]. We only collect ticks if a rule actually matches -
        -- this matters for performance tests.
        args' :: [CoreExpr]
    args' = (CoreExpr -> CoreExpr) -> [CoreExpr] -> [CoreExpr]
    forall a b. (a -> b) -> [a] -> [b]
    map ((CoreTickish -> Bool) -> CoreExpr -> CoreExpr
    forall b. (CoreTickish -> Bool) -> Expr b -> Expr b
    stripTicksTopE CoreTickish -> Bool
    forall (pass :: TickishPass). GenTickish pass -> Bool
    tickishFloatable) [CoreExpr]
    args
        ticks :: [CoreTickish]
    ticks = (CoreExpr -> [CoreTickish]) -> [CoreExpr] -> [CoreTickish]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap ((CoreTickish -> Bool) -> CoreExpr -> [CoreTickish]
    forall b. (CoreTickish -> Bool) -> Expr b -> [CoreTickish]
    stripTicksTopT CoreTickish -> Bool
    forall (pass :: TickishPass). GenTickish pass -> Bool
    tickishFloatable) [CoreExpr]
    args

        go :: [(CoreRule,CoreExpr)] -> [CoreRule] -> [(CoreRule,CoreExpr)]
        go :: [(CoreRule, CoreExpr)] -> [CoreRule] -> [(CoreRule, CoreExpr)]
    go [(CoreRule, CoreExpr)]
    ms [] = [(CoreRule, CoreExpr)]
    ms
        go [(CoreRule, CoreExpr)]
    ms (CoreRule
    r:[CoreRule]
    rs)
          | Just CoreExpr
    e <- RuleOpts
    -> InScopeEnv
    -> (Activation -> Bool)
    -> Var
    -> [CoreExpr]
    -> [Maybe Name]
    -> CoreRule
    -> Maybe CoreExpr
    matchRule RuleOpts
    opts InScopeEnv
    rule_env Activation -> Bool
    is_active Var
    fn [CoreExpr]
    args' [Maybe Name]
    rough_args CoreRule
    r
          = [(CoreRule, CoreExpr)] -> [CoreRule] -> [(CoreRule, CoreExpr)]
    go ((CoreRule
    r,[CoreTickish] -> CoreExpr -> CoreExpr
    mkTicks [CoreTickish]
    ticks CoreExpr
    e)(CoreRule, CoreExpr)
    -> [(CoreRule, CoreExpr)] -> [(CoreRule, CoreExpr)]
    forall a. a -> [a] -> [a]
    :[(CoreRule, CoreExpr)]
    ms) [CoreRule]
    rs
          | Bool
    otherwise
          = -- pprTrace "match failed" (ppr r $$ ppr args $$
            --   ppr [ (arg_id, unfoldingTemplate unf)
            --       | Var arg_id <- args
            --       , let unf = idUnfolding arg_id
            --       , isCheapUnfolding unf] )
            [(CoreRule, CoreExpr)] -> [CoreRule] -> [(CoreRule, CoreExpr)]
    go [(CoreRule, CoreExpr)]
    ms [CoreRule]
    rs

    findBest :: InScopeSet -> (Id, [CoreExpr])
             -> (CoreRule,CoreExpr) -> [(CoreRule,CoreExpr)] -> (CoreRule,CoreExpr)
    -- All these pairs matched the expression
    -- Return the pair the most specific rule
    -- The (fn,args) is just for overlap reporting

    findBest :: InScopeSet
    -> (Var, [CoreExpr])
    -> (CoreRule, CoreExpr)
    -> [(CoreRule, CoreExpr)]
    -> (CoreRule, CoreExpr)
    findBest InScopeSet
    _        (Var, [CoreExpr])
    _      (CoreRule
    rule,CoreExpr
    ans)   [] = (CoreRule
    rule,CoreExpr
    ans)
    findBest InScopeSet
    in_scope (Var, [CoreExpr])
    target (CoreRule
    rule1,CoreExpr
    ans1) ((CoreRule
    rule2,CoreExpr
    ans2):[(CoreRule, CoreExpr)]
    prs)
      | InScopeSet -> CoreRule -> CoreRule -> Bool
    isMoreSpecific InScopeSet
    in_scope CoreRule
    rule1 CoreRule
    rule2 = InScopeSet
    -> (Var, [CoreExpr])
    -> (CoreRule, CoreExpr)
    -> [(CoreRule, CoreExpr)]
    -> (CoreRule, CoreExpr)
    findBest InScopeSet
    in_scope (Var, [CoreExpr])
    target (CoreRule
    rule1,CoreExpr
    ans1) [(CoreRule, CoreExpr)]
    prs
      | InScopeSet -> CoreRule -> CoreRule -> Bool
    isMoreSpecific InScopeSet
    in_scope CoreRule
    rule2 CoreRule
    rule1 = InScopeSet
    -> (Var, [CoreExpr])
    -> (CoreRule, CoreExpr)
    -> [(CoreRule, CoreExpr)]
    -> (CoreRule, CoreExpr)
    findBest InScopeSet
    in_scope (Var, [CoreExpr])
    target (CoreRule
    rule2,CoreExpr
    ans2) [(CoreRule, CoreExpr)]
    prs
      | Bool
    debugIsOn = let pp_rule :: CoreRule -> SDoc
    pp_rule CoreRule
    rule
                          = SDoc -> SDoc -> SDoc
    forall doc. IsOutput doc => doc -> doc -> doc
    ifPprDebug (CoreRule -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr CoreRule
    rule)
                                       (SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc
    doubleQuotes (RuleName -> SDoc
    forall doc. IsLine doc => RuleName -> doc
    ftext (CoreRule -> RuleName
    ruleName CoreRule
    rule)))
                    in String -> SDoc -> (CoreRule, CoreExpr) -> (CoreRule, CoreExpr)
    forall a. String -> SDoc -> a -> a
    pprTrace String
    "Rules.findBest: rule overlap (Rule 1 wins)"
                             ([SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat [ SDoc -> SDoc
    forall doc. IsOutput doc => doc -> doc
    whenPprDebug (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $
                                     String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "Expression to match:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Var -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Var
    fn
                                     SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> [SDoc] -> SDoc
    forall doc. IsLine doc => [doc] -> doc
    sep ((CoreExpr -> SDoc) -> [CoreExpr] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map CoreExpr -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [CoreExpr]
    args)
                                   , String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "Rule 1:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> CoreRule -> SDoc
    pp_rule CoreRule
    rule1
                                   , String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "Rule 2:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> CoreRule -> SDoc
    pp_rule CoreRule
    rule2]) ((CoreRule, CoreExpr) -> (CoreRule, CoreExpr))
    -> (CoreRule, CoreExpr) -> (CoreRule, CoreExpr)
    forall a b. (a -> b) -> a -> b
    $
                    InScopeSet
    -> (Var, [CoreExpr])
    -> (CoreRule, CoreExpr)
    -> [(CoreRule, CoreExpr)]
    -> (CoreRule, CoreExpr)
    findBest InScopeSet
    in_scope (Var, [CoreExpr])
    target (CoreRule
    rule1,CoreExpr
    ans1) [(CoreRule, CoreExpr)]
    prs
      | Bool
    otherwise = InScopeSet
    -> (Var, [CoreExpr])
    -> (CoreRule, CoreExpr)
    -> [(CoreRule, CoreExpr)]
    -> (CoreRule, CoreExpr)
    findBest InScopeSet
    in_scope (Var, [CoreExpr])
    target (CoreRule
    rule1,CoreExpr
    ans1) [(CoreRule, CoreExpr)]
    prs
      where
        (Var
    fn,[CoreExpr]
    args) = (Var, [CoreExpr])
    target

    isMoreSpecific :: InScopeSet -> CoreRule -> CoreRule -> Bool
    -- The call (rule1 `isMoreSpecific` rule2)
    -- sees if rule2 can be instantiated to look like rule1
    -- See Note [isMoreSpecific]
    isMoreSpecific :: InScopeSet -> CoreRule -> CoreRule -> Bool
    isMoreSpecific InScopeSet
    _        (BuiltinRule {}) CoreRule
    _                = Bool
    False
    isMoreSpecific InScopeSet
    _        (Rule {})        (BuiltinRule {}) = Bool
    True
    isMoreSpecific InScopeSet
    in_scope (Rule { ru_bndrs :: CoreRule -> [Var]
    ru_bndrs = [Var]
    bndrs1, ru_args :: CoreRule -> [CoreExpr]
    ru_args = [CoreExpr]
    args1 })
                            (Rule { ru_bndrs :: CoreRule -> [Var]
    ru_bndrs = [Var]
    bndrs2, ru_args :: CoreRule -> [CoreExpr]
    ru_args = [CoreExpr]
    args2 })
      = Maybe (CoreExpr -> CoreExpr, [CoreExpr]) -> Bool
    forall a. Maybe a -> Bool
    isJust (InScopeEnv
    -> [Var]
    -> [CoreExpr]
    -> [CoreExpr]
    -> Maybe (CoreExpr -> CoreExpr, [CoreExpr])
    matchExprs InScopeEnv
    in_scope_env [Var]
    bndrs2 [CoreExpr]
    args2 [CoreExpr]
    args1)
      where
       full_in_scope :: InScopeSet
    full_in_scope = InScopeSet
    in_scope InScopeSet -> [Var] -> InScopeSet
    `extendInScopeSetList` [Var]
    bndrs1
       in_scope_env :: InScopeEnv
    in_scope_env  = InScopeSet -> IdUnfoldingFun -> InScopeEnv
    ISE InScopeSet
    full_in_scope IdUnfoldingFun
    noUnfoldingFun
                       -- noUnfoldingFun: don't expand in templates

    noBlackList :: Activation -> Bool
    noBlackList :: Activation -> Bool
    noBlackList Activation
    _ = Bool
    False           -- Nothing is black listed

    {- Note [isMoreSpecific]
    ~~~~~~~~~~~~~~~~~~~~~~~~
    The call (rule1 `isMoreSpecific` rule2)
    sees if rule2 can be instantiated to look like rule1.

    Wrinkle:

    * We take the view that a BuiltinRule is less specific than
      anything else, because we want user-defined rules to "win"
      In particular, class ops have a built-in rule, but we
      prefer any user-specific rules to win:
        eg (#4397)
           truncate :: (RealFrac a, Integral b) => a -> b
           {-# RULES "truncate/Double->Int" truncate = double2Int #-}
           double2Int :: Double -> Int
      We want the specific RULE to beat the built-in class-op rule

    Note [Extra args in the target]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    If we find a matching rule, we return (Just (rule, rhs)),
    /but/ the rule firing has only consumed as many of the input args
    as the ruleArity says.  The unused arguments are handled by the code in
    GHC.Core.Opt.Simplify.tryRules, using the arity of the returned rule.

    E.g. Rule "foo":  forall a b.  f p1 p2 = rhs
         Target:      f e1 e2 e3

    Then lookupRule returns Just (Rule "foo", rhs), where Rule "foo"
    has ruleArity 2.  The real rewrite is
            f e1 e2 e3 ==> rhs e3

    You might think it'd be cleaner for lookupRule to deal with the
    leftover arguments, by applying 'rhs' to them, but the main call
    in the Simplifier works better as it is.  Reason: the 'args' passed
    to lookupRule are the result of a lazy substitution

    Historical note:

    At one stage I tried to match even if there are more args in the
    /template/ than the target.  I now think this is probably a bad idea.
    Should the template (map f xs) match (map g)?  I think not.  For a
    start, in general eta expansion wastes work.  SLPJ July 99
    -}

    ------------------------------------
    matchRule :: RuleOpts -> InScopeEnv -> (Activation -> Bool)
              -> Id -> [CoreExpr] -> [Maybe Name]
              -> CoreRule -> Maybe CoreExpr

    -- If (matchRule rule args) returns Just (name,rhs)
    -- then (f args) matches the rule, and the corresponding
    -- rewritten RHS is rhs
    --
    -- The returned expression is occurrence-analysed
    --
    --      Example
    --
    -- The rule
    --      forall f g x. map f (map g x) ==> map (f . g) x
    -- is stored
    --      CoreRule "map/map"
    --               [f,g,x]                -- tpl_vars
    --               [f,map g x]            -- tpl_args
    --               map (f.g) x)           -- rhs
    --
    -- Then the expression
    --      map e1 (map e2 e3) e4
    -- results in a call to
    --      matchRule the_rule [e1,map e2 e3,e4]
    --        = Just ("map/map", (\f,g,x -> rhs) e1 e2 e3)
    --
    -- NB: The 'surplus' argument e4 in the input is simply dropped.
    -- See Note [Extra args in the target]

    matchRule :: RuleOpts
    -> InScopeEnv
    -> (Activation -> Bool)
    -> Var
    -> [CoreExpr]
    -> [Maybe Name]
    -> CoreRule
    -> Maybe CoreExpr
    matchRule RuleOpts
    opts InScopeEnv
    rule_env Activation -> Bool
    _is_active Var
    fn [CoreExpr]
    args [Maybe Name]
    _rough_args
              (BuiltinRule { ru_try :: CoreRule -> RuleFun
    ru_try = RuleFun
    match_fn })
    -- Built-in rules can't be switched off, it seems
      = case RuleFun
    match_fn RuleOpts
    opts InScopeEnv
    rule_env Var
    fn [CoreExpr]
    args of
            Maybe CoreExpr
    Nothing   -> Maybe CoreExpr
    forall a. Maybe a
    Nothing
            Just CoreExpr
    expr -> CoreExpr -> Maybe CoreExpr
    forall a. a -> Maybe a
    Just CoreExpr
    expr

    matchRule RuleOpts
    _ InScopeEnv
    rule_env Activation -> Bool
    is_active Var
    _ [CoreExpr]
    args [Maybe Name]
    rough_args
              (Rule { ru_name :: CoreRule -> RuleName
    ru_name = RuleName
    rule_name, ru_act :: CoreRule -> Activation
    ru_act = Activation
    act, ru_rough :: CoreRule -> [Maybe Name]
    ru_rough = [Maybe Name]
    tpl_tops
                    , ru_bndrs :: CoreRule -> [Var]
    ru_bndrs = [Var]
    tpl_vars, ru_args :: CoreRule -> [CoreExpr]
    ru_args = [CoreExpr]
    tpl_args, ru_rhs :: CoreRule -> CoreExpr
    ru_rhs = CoreExpr
    rhs })
      | Bool -> Bool
    not (Activation -> Bool
    is_active Activation
    act)               = Maybe CoreExpr
    forall a. Maybe a
    Nothing
      | [Maybe Name] -> [Maybe Name] -> Bool
    ruleCantMatch [Maybe Name]
    tpl_tops [Maybe Name]
    rough_args = Maybe CoreExpr
    forall a. Maybe a
    Nothing
      | Bool
    otherwise = InScopeEnv
    -> RuleName
    -> [Var]
    -> [CoreExpr]
    -> [CoreExpr]
    -> CoreExpr
    -> Maybe CoreExpr
    matchN InScopeEnv
    rule_env RuleName
    rule_name [Var]
    tpl_vars [CoreExpr]
    tpl_args [CoreExpr]
    args CoreExpr
    rhs

    ---------------------------------------
    matchN  :: InScopeEnv
            -> RuleName -> [Var] -> [CoreExpr]
            -> [CoreExpr] -> CoreExpr           -- ^ Target; can have more elements than the template
            -> Maybe CoreExpr
    -- For a given match template and context, find bindings to wrap around
    -- the entire result and what should be substituted for each template variable.
    --
    -- Fail if there are too few actual arguments from the target to match the template
    --
    -- See Note [Extra args in the target]
    -- If there are too /many/ actual arguments, we simply ignore the
    -- trailing ones, returning the result of applying the rule to a prefix
    -- of the actual arguments.

    matchN :: InScopeEnv
    -> RuleName
    -> [Var]
    -> [CoreExpr]
    -> [CoreExpr]
    -> CoreExpr
    -> Maybe CoreExpr
    matchN InScopeEnv
    ise RuleName
    _rule_name [Var]
    tmpl_vars [CoreExpr]
    tmpl_es [CoreExpr]
    target_es CoreExpr
    rhs
      = do { (bind_wrapper, matched_es) <- InScopeEnv
    -> [Var]
    -> [CoreExpr]
    -> [CoreExpr]
    -> Maybe (CoreExpr -> CoreExpr, [CoreExpr])
    matchExprs InScopeEnv
    ise [Var]
    tmpl_vars [CoreExpr]
    tmpl_es [CoreExpr]
    target_es
           ; return (bind_wrapper $
                     mkLams tmpl_vars rhs `mkApps` matched_es) }

    matchExprs :: InScopeEnv -> [Var] -> [CoreExpr] -> [CoreExpr]
               -> Maybe (BindWrapper, [CoreExpr])  -- 1-1 with the [Var]
    matchExprs :: InScopeEnv
    -> [Var]
    -> [CoreExpr]
    -> [CoreExpr]
    -> Maybe (CoreExpr -> CoreExpr, [CoreExpr])
    matchExprs (ISE InScopeSet
    in_scope IdUnfoldingFun
    id_unf) [Var]
    tmpl_vars [CoreExpr]
    tmpl_es [CoreExpr]
    target_es
      = do  { rule_subst <- RuleMatchEnv
    -> RuleSubst -> [CoreExpr] -> [CoreExpr] -> Maybe RuleSubst
    match_exprs RuleMatchEnv
    init_menv RuleSubst
    emptyRuleSubst [CoreExpr]
    tmpl_es [CoreExpr]
    target_es
            ; let (_, matched_es) = mapAccumL (lookup_tmpl rule_subst)
                                              (mkEmptySubst in_scope) $
                                    tmpl_vars `zip` tmpl_vars1

            ; let bind_wrapper = RuleSubst -> CoreExpr -> CoreExpr
    rs_binds RuleSubst
    rule_subst
                                 -- Floated bindings; see Note [Matching lets]

            ; return (bind_wrapper, matched_es) }
      where
        (RnEnv2
    init_rn_env, [Var]
    tmpl_vars1) = (RnEnv2 -> Var -> (RnEnv2, Var))
    -> RnEnv2 -> [Var] -> (RnEnv2, [Var])
    forall (t :: * -> *) s a b.
    Traversable t =>
    (s -> a -> (s, b)) -> s -> t a -> (s, t b)
    mapAccumL RnEnv2 -> Var -> (RnEnv2, Var)
    rnBndrL (InScopeSet -> RnEnv2
    mkRnEnv2 InScopeSet
    in_scope) [Var]
    tmpl_vars
                      -- See Note [Cloning the template binders]

        init_menv :: RuleMatchEnv
    init_menv = RV { rv_tmpls :: VarSet
    rv_tmpls = [Var] -> VarSet
    mkVarSet [Var]
    tmpl_vars1
                       , rv_lcl :: RnEnv2
    rv_lcl   = RnEnv2
    init_rn_env
                       , rv_fltR :: Subst
    rv_fltR  = InScopeSet -> Subst
    mkEmptySubst (RnEnv2 -> InScopeSet
    rnInScopeSet RnEnv2
    init_rn_env)
                       , rv_unf :: IdUnfoldingFun
    rv_unf   = IdUnfoldingFun
    id_unf }

        lookup_tmpl :: RuleSubst -> Subst -> (InVar,OutVar) -> (Subst, CoreExpr)
                       -- Need to return a RuleSubst solely for the benefit of fake_ty
        lookup_tmpl :: RuleSubst -> Subst -> (Var, Var) -> (Subst, CoreExpr)
    lookup_tmpl (RS { rs_tv_subst :: RuleSubst -> TvSubstEnv
    rs_tv_subst = TvSubstEnv
    tv_subst, rs_id_subst :: RuleSubst -> IdSubstEnv
    rs_id_subst = IdSubstEnv
    id_subst })
                    Subst
    tcv_subst (Var
    tmpl_var, Var
    tmpl_var1)
            | Var -> Bool
    isId Var
    tmpl_var1
            = case IdSubstEnv -> Var -> Maybe CoreExpr
    forall a. VarEnv a -> Var -> Maybe a
    lookupVarEnv IdSubstEnv
    id_subst Var
    tmpl_var1 of
                Just CoreExpr
    e | Coercion Coercion
    co <- CoreExpr
    e
                       -> (Subst -> Var -> Coercion -> Subst
    Type.extendCvSubst Subst
    tcv_subst Var
    tmpl_var1 Coercion
    co, Coercion -> CoreExpr
    forall b. Coercion -> Expr b
    Coercion Coercion
    co)
                       | Bool
    otherwise
                       -> (Subst
    tcv_subst, CoreExpr
    e)
                Maybe CoreExpr
    Nothing | Just Coercion
    refl_co <- Var -> Maybe Coercion
    isReflCoVar_maybe Var
    tmpl_var1
                        , let co :: Coercion
    co = HasDebugCallStack => Subst -> Coercion -> Coercion
    Subst -> Coercion -> Coercion
    Coercion.substCo Subst
    tcv_subst Coercion
    refl_co
                        -> -- See Note [Unbound RULE binders]
                           (Subst -> Var -> Coercion -> Subst
    Type.extendCvSubst Subst
    tcv_subst Var
    tmpl_var1 Coercion
    co, Coercion -> CoreExpr
    forall b. Coercion -> Expr b
    Coercion Coercion
    co)
                        | Bool
    otherwise
                        -> Var -> (Subst, CoreExpr)
    unbound Var
    tmpl_var

            | Bool
    otherwise
            = (Subst -> Var -> Kind -> Subst
    Type.extendTvSubst Subst
    tcv_subst Var
    tmpl_var1 Kind
    ty', Kind -> CoreExpr
    forall b. Kind -> Expr b
    Type Kind
    ty')
            where
              ty' :: Kind
    ty' = case TvSubstEnv -> Var -> Maybe Kind
    forall a. VarEnv a -> Var -> Maybe a
    lookupVarEnv TvSubstEnv
    tv_subst Var
    tmpl_var1 of
                      Just Kind
    ty -> Kind
    ty
                      Maybe Kind
    Nothing -> Kind
    fake_ty   -- See Note [Unbound RULE binders]
              fake_ty :: Kind
    fake_ty = Kind -> Kind
    anyTypeOfKind (HasDebugCallStack => Subst -> Kind -> Kind
    Subst -> Kind -> Kind
    Type.substTy Subst
    tcv_subst (Var -> Kind
    tyVarKind Var
    tmpl_var1))
                        -- This substitution is the sole reason we accumulate
                        -- TCvSubst in lookup_tmpl

        unbound :: Var -> (Subst, CoreExpr)
    unbound Var
    tmpl_var
           = String -> SDoc -> (Subst, CoreExpr)
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "Template variable unbound in rewrite rule" (SDoc -> (Subst, CoreExpr)) -> SDoc -> (Subst, CoreExpr)
    forall a b. (a -> b) -> a -> b
    $
             [SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat [ String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "Variable:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Var -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Var
    tmpl_var SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> SDoc
    dcolon SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Kind -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (Var -> Kind
    varType Var
    tmpl_var)
                  , String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "Rule bndrs:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> [Var] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [Var]
    tmpl_vars
                  , String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "LHS args:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> [CoreExpr] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [CoreExpr]
    tmpl_es
                  , String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "Actual args:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> [CoreExpr] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [CoreExpr]
    target_es ]

    ----------------------
    match_exprs :: RuleMatchEnv -> RuleSubst
                -> [CoreExpr]       -- Templates
                -> [CoreExpr]       -- Targets
                -> Maybe RuleSubst
    -- If the targets are longer than templates, succeed, simply ignoring
    -- the leftover targets. This matters in the call in matchN.
    --
    -- Precondition: corresponding elements of es1 and es2 have the same
    --               type, assuming earlier elements match.
    -- Example:  f :: forall v. v -> blah
    --   match_exprs [Type a, y::a] [Type Int, 3]
    -- Then, after matching Type a against Type Int,
    -- the type of (y::a) matches that of (3::Int)
    match_exprs :: RuleMatchEnv
    -> RuleSubst -> [CoreExpr] -> [CoreExpr] -> Maybe RuleSubst
    match_exprs RuleMatchEnv
    _ RuleSubst
    subst [] [CoreExpr]
    _
      = RuleSubst -> Maybe RuleSubst
    forall a. a -> Maybe a
    Just RuleSubst
    subst
    match_exprs RuleMatchEnv
    renv RuleSubst
    subst (CoreExpr
    e1:[CoreExpr]
    es1) (CoreExpr
    e2:[CoreExpr]
    es2)
      = do { subst' <- RuleMatchEnv
    -> RuleSubst
    -> CoreExpr
    -> CoreExpr
    -> MCoercion
    -> Maybe RuleSubst
    match RuleMatchEnv
    renv RuleSubst
    subst CoreExpr
    e1 CoreExpr
    e2 MCoercion
    MRefl
           ; match_exprs renv subst' es1 es2 }
    match_exprs RuleMatchEnv
    _ RuleSubst
    _ [CoreExpr]
    _ [CoreExpr]
    _ = Maybe RuleSubst
    forall a. Maybe a
    Nothing

    {- Note [Unbound RULE binders]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    It can be the case that the binder in a rule is not actually
    bound on the LHS:

    * Type variables.  Type synonyms with phantom args can give rise to
      unbound template type variables.  Consider this (#10689,
      simplCore/should_compile/T10689):

        type Foo a b = b

        f :: Eq a => a -> Bool
        f x = x==x

        {-# RULES "foo" forall (x :: Foo a Char). f x = True #-}
        finkle = f 'c'

      The rule looks like
        forall (a::*) (d::Eq Char) (x :: Foo a Char).
             f (Foo a Char) d x = True

      Matching the rule won't bind 'a', and legitimately so.  We fudge by
      pretending that 'a' is bound to (Any :: *).

    * Coercion variables.  On the LHS of a RULE for a local binder
      we might have
        RULE forall (c :: a~b). f (x |> c) = e
      Now, if that binding is inlined, so that a=b=Int, we'd get
        RULE forall (c :: Int~Int). f (x |> c) = e
      and now when we simplify the LHS (Simplify.simplRule) we
      optCoercion (look at the CoVarCo case) will turn that 'c' into Refl:
        RULE forall (c :: Int~Int). f (x |> <Int>) = e
      and then perhaps drop it altogether.  Now 'c' is unbound.

      It's tricky to be sure this never happens, so instead I
      say it's OK to have an unbound coercion binder in a RULE
      provided its type is (c :: t~t).  Then, when the RULE
      fires we can substitute <t> for c.

      This actually happened (in a RULE for a local function)
      in #13410, and also in test T10602.

    Note [Cloning the template binders]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Consider the following match (example 1):
            Template:  forall x.  f x
            Target:               f (x+1)
    This should succeed, because the template variable 'x' has nothing to
    do with the 'x' in the target.

    Likewise this one (example 2):
            Template:  forall x. f (\x.x)
            Target:              f (\y.y)

    We achieve this simply by using rnBndrL to clone the template
    binders if they are already in scope.

    ------ Historical note -------
    At one point I tried simply adding the template binders to the
    in-scope set /without/ cloning them, but that failed in a horribly
    obscure way in #14777.  Problem was that during matching we look
    up target-term variables in the in-scope set (see Note [Lookup
    in-scope]).  If a target-term variable happens to name-clash with a
    template variable, that lookup will find the template variable, which
    is /utterly/ bogus.  In #14777, this transformed a term variable
    into a type variable, and then crashed when we wanted its idInfo.
    ------ End of historical note -------

    ************************************************************************
    *                                                                      *
                       The main matcher
    *                                                                      *
    ********************************************************************* -}

    data RuleMatchEnv
      = RV { RuleMatchEnv -> RnEnv2
    rv_lcl   :: RnEnv2          -- Renamings for *local bindings*
                                         --   (lambda/case)
           , RuleMatchEnv -> VarSet
    rv_tmpls :: VarSet          -- Template variables
                                         --   (after applying envL of rv_lcl)
           , RuleMatchEnv -> Subst
    rv_fltR  :: Subst           -- Renamings for floated let-bindings
                                         --   (domain disjoint from envR of rv_lcl)
                                         -- See Note [Matching lets]
                                         -- N.B. The InScopeSet of rv_fltR is always ignored;
                                         -- see (4) in Note [Matching lets].
           , RuleMatchEnv -> IdUnfoldingFun
    rv_unf :: IdUnfoldingFun
           }

    {- Note [rv_lcl in RuleMatchEnv]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Consider matching
      Template: \x->f
      Target:   \f->f

    where 'f' is free in the template. When we meet the lambdas we must
    remember to rename f :-> f' in the target, as well as x :-> f
    in the template.  The rv_lcl::RnEnv2 does that.

    Similarly, consider matching
         Template: {a}  \b->b
         Target:        \a->3
    We must rename the \a.  Otherwise when we meet the lambdas we might
    substitute [b :-> a] in the template, and then erroneously succeed in
    matching what looks like the template variable 'a' against 3.

    So we must add the template vars to the in-scope set before starting;
    see `init_menv` in `matchN`.
    -}

    -- * The domain of the TvSubstEnv and IdSubstEnv are the template
    --   variables passed into the match.
    --
    -- * The BindWrapper in a RuleSubst are the bindings floated out
    --   from nested matches; see the Let case of match, below
    --
    data RuleSubst = RS { -- Substitution; applied only to the template, not the target
                          -- Domain is the template variables
                          -- Range never includes template variables
                          RuleSubst -> TvSubstEnv
    rs_tv_subst :: TvSubstEnv
                        , RuleSubst -> IdSubstEnv
    rs_id_subst :: IdSubstEnv

                          -- Floated bindings
                        , RuleSubst -> CoreExpr -> CoreExpr
    rs_binds    :: BindWrapper  -- Floated bindings
                        , RuleSubst -> [Var]
    rs_bndrs    :: [Var]        -- Variables bound by floated lets
                        }

    type BindWrapper = CoreExpr -> CoreExpr
      -- See Notes [Matching lets] and [Matching cases]
      -- we represent the floated bindings as a core-to-core function

    emptyRuleSubst :: RuleSubst
    emptyRuleSubst :: RuleSubst
    emptyRuleSubst = RS { rs_tv_subst :: TvSubstEnv
    rs_tv_subst = TvSubstEnv
    forall a. VarEnv a
    emptyVarEnv, rs_id_subst :: IdSubstEnv
    rs_id_subst = IdSubstEnv
    forall a. VarEnv a
    emptyVarEnv
                        , rs_binds :: CoreExpr -> CoreExpr
    rs_binds = \CoreExpr
    e -> CoreExpr
    e, rs_bndrs :: [Var]
    rs_bndrs = [] }

    {- Note [Casts in the target]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    As far as possible we don't want casts in the target to get in the way of
    matching.  E.g.
    * (let bind in e)  |> co
    * (case e of alts) |> co
    * (\ a b. f a b)   |> co

    In the first two cases we want to float the cast inwards so we can match on
    the let/case.  This is not important in practice because the Simplifier does
    this anyway.

    But the third case /is/ important: we don't want the cast to get in the way
    of eta-reduction.  See Note [Cancel reflexive casts] for a real life example.

    The most convenient thing is to make 'match' take an MCoercion argument, thus:

    * The main matching function
          match env subst template target mco
      matches   template ~ (target |> mco)

    * Invariant: typeof( subst(template) ) = typeof( target |> mco )

    Note that for applications
         (e1 e2) ~ (d1 d2) |> co
    where 'co' is non-reflexive, we simply fail.  You might wonder about
         (e1 e2) ~ ((d1 |> co1) d2) |> co2
    but the Simplifer pushes the casts in an application to to the
    right, if it can, so this doesn't really arise.

    Note [Casts in the template]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    This Note concerns `matchTemplateCast`.  Consider the definition
      f x = e,
    and SpecConstr on call pattern
      f ((e1,e2) |> co)

    The danger is that We'll make a RULE
       RULE forall a,b,g.  f ((a,b)|> g) = $sf a b g
       $sf a b g = e[ ((a,b)|> g) / x ]

    This requires the rule-matcher to bind the coercion variable `g`.
    That is Very Deeply Suspicious:

    * It would be unreasonable to match on a structured coercion in a pattern,
      such as    RULE   forall g.  f (x |> Sym g) = ...
      because the strucure of a coercion is arbitrary and may change -- it's their
      /type/ that matters.

    * We considered insisting that in a template, in a cast (e |> co), the the cast
      `co` is always a /variable/ cv.  That looks a bit more plausible, but #23209
      (and related tickets) shows that it's very fragile.  For example suppose `e`
      is a variable `f`, and the simplifier has an unconditional substitution
         [f :-> g |> co2]
      Now the rule LHS becomes (f |> (co2 ; cv)); not a coercion variable any more!

    In short, it is Very Deeply Suspicious for a rule to quantify over a coercion
    variable.  And SpecConstr no longer does so: see Note [SpecConstr and casts] in
    SpecConstr.

    It is, however, OK for a cast to appear in a template.  For example
        newtype N a = MkN (a,a)    -- Axiom ax:N a :: (a,a) ~R N a
        f :: N a -> bah
        RULE forall b x:b y:b. f @b ((x,y) |> (axN @b)) = ...

    When matching we can just move these casts to the other side:
        match (tmpl |> co) tgt  -->   match tmpl (tgt |> sym co)
    See matchTemplateCast.

    Wrinkles:

    (CT1) We need to be careful about scoping, and to match left-to-right, so that we
      know the substitution [a :-> b] before we meet (co :: (a,a) ~R N a), and so we
      can apply that substitition

    (CT2) Annoyingly, we still want support one case in which the RULE quantifies
      over a coercion variable: the dreaded map/coerce RULE.
      See Note [Getting the map/coerce RULE to work] in GHC.Core.SimpleOpt.

      Since that can happen, matchTemplateCast laboriously checks whether the
      coercion mentions a template coercion variable; and if so does the Very Deeply
      Suspicious `match_co` instead.  It works fine for map/coerce, where the
      coercion is always a variable and will (robustly) remain so.

    See also
    * Note [Coercion arguments]
    * Note [Matching coercion variables] in GHC.Core.Unify.
    * Note [Cast swizzling on rule LHSs] in GHC.Core.Opt.Simplify.Utils:
      sm_cast_swizzle is switched off in the template of a RULE

    Note [Coercion arguments]
    ~~~~~~~~~~~~~~~~~~~~~~~~~
    What if we have (f (Coercion co)) in the template, where the 'co' is a coercion
    argument to f?  Right now we have nothing in place to ensure that a
    coercion /argument/ in the template is a variable.  We really should,
    perhaps by abstracting over that variable.

    C.f. the treatment of dictionaries in GHC.HsToCore.Binds.decompseRuleLhs.

    For now, though, we simply behave badly, by failing in match_co.
    We really should never rely on matching the structure of a coercion
    (which is just a proof).
    -}

    ----------------------
    match :: RuleMatchEnv
          -> RuleSubst              -- Substitution applies to template only
          -> CoreExpr               -- Template
          -> CoreExpr               -- Target
          -> MCoercion
          -> Maybe RuleSubst

    -- Postcondition (TypeInv): if matching succeeds, then
    --                          typeof( subst(template) ) = typeof( target |> mco )
    --     But this is /not/ a pre-condition! The types of template and target
    --     may differ, see the (App e1 e2) case
    --
    -- Invariant (CoInv):   if mco :: ty ~ ty, then it is MRefl, not MCo co
    --                      See Note [Cancel reflexive casts]
    --
    -- See the notes with Unify.match, which matches types
    -- Everything is very similar for terms

    ------------------------ Ticks ---------------------
    -- We look through certain ticks. See Note [Tick annotations in RULE matching]
    match :: RuleMatchEnv
    -> RuleSubst
    -> CoreExpr
    -> CoreExpr
    -> MCoercion
    -> Maybe RuleSubst
    match RuleMatchEnv
    renv RuleSubst
    subst CoreExpr
    e1 (Tick CoreTickish
    t CoreExpr
    e2) MCoercion
    mco
      | CoreTickish -> Bool
    forall (pass :: TickishPass). GenTickish pass -> Bool
    tickishFloatable CoreTickish
    t
      = RuleMatchEnv
    -> RuleSubst
    -> CoreExpr
    -> CoreExpr
    -> MCoercion
    -> Maybe RuleSubst
    match RuleMatchEnv
    renv RuleSubst
    subst' CoreExpr
    e1 CoreExpr
    e2 MCoercion
    mco
      | Bool
    otherwise
      = Maybe RuleSubst
    forall a. Maybe a
    Nothing
      where
        subst' :: RuleSubst
    subst' = RuleSubst
    subst { rs_binds = rs_binds subst . mkTick t }

    match RuleMatchEnv
    renv RuleSubst
    subst e :: CoreExpr
    e@(Tick CoreTickish
    t CoreExpr
    e1) CoreExpr
    e2 MCoercion
    mco
      | CoreTickish -> Bool
    forall (pass :: TickishPass). GenTickish pass -> Bool
    tickishFloatable CoreTickish
    t  -- Ignore floatable ticks in rule template.
      =  RuleMatchEnv
    -> RuleSubst
    -> CoreExpr
    -> CoreExpr
    -> MCoercion
    -> Maybe RuleSubst
    match RuleMatchEnv
    renv RuleSubst
    subst CoreExpr
    e1 CoreExpr
    e2 MCoercion
    mco
      | Bool
    otherwise
      = String -> SDoc -> Maybe RuleSubst
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "Tick in rule" (CoreExpr -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr CoreExpr
    e)

    ------------------------ Types ---------------------
    match RuleMatchEnv
    renv RuleSubst
    subst (Type Kind
    ty1) (Type Kind
    ty2) MCoercion
    _mco
      = RuleMatchEnv -> RuleSubst -> Kind -> Kind -> Maybe RuleSubst
    match_ty RuleMatchEnv
    renv RuleSubst
    subst Kind
    ty1 Kind
    ty2

    ------------------------ Coercions ---------------------
    -- See Note [Coercion arguments] for why this isn't really right
    match RuleMatchEnv
    renv RuleSubst
    subst (Coercion Coercion
    co1) (Coercion Coercion
    co2) MCoercion
    MRefl
      = RuleMatchEnv
    -> RuleSubst -> Coercion -> Coercion -> Maybe RuleSubst
    match_co RuleMatchEnv
    renv RuleSubst
    subst Coercion
    co1 Coercion
    co2
      -- The MCo case corresponds to matching  co ~ (co2 |> co3)
      -- and I have no idea what to do there -- or even if it can occur
      -- Failing seems the simplest thing to do; it's certainly safe.

    ------------------------ Casts ---------------------
    -- See Note [Casts in the template]
    --     Note [Casts in the target]
    --     Note [Cancel reflexive casts]

    match RuleMatchEnv
    renv RuleSubst
    subst CoreExpr
    e1 (Cast CoreExpr
    e2 Coercion
    co2) MCoercion
    mco
      = RuleMatchEnv
    -> RuleSubst
    -> CoreExpr
    -> CoreExpr
    -> MCoercion
    -> Maybe RuleSubst
    match RuleMatchEnv
    renv RuleSubst
    subst CoreExpr
    e1 CoreExpr
    e2 (MCoercion -> MCoercion
    checkReflexiveMCo (Coercion -> MCoercion -> MCoercion
    mkTransMCoR Coercion
    co2 MCoercion
    mco))
        -- checkReflexiveMCo: cancel casts if possible
        -- This is important: see Note [Cancel reflexive casts]

    match RuleMatchEnv
    renv RuleSubst
    subst (Cast CoreExpr
    e1 Coercion
    co1) CoreExpr
    e2 MCoercion
    mco
      = RuleMatchEnv
    -> RuleSubst
    -> CoreExpr
    -> Coercion
    -> CoreExpr
    -> MCoercion
    -> Maybe RuleSubst
    matchTemplateCast RuleMatchEnv
    renv RuleSubst
    subst CoreExpr
    e1 Coercion
    co1 CoreExpr
    e2 MCoercion
    mco

    ------------------------ Literals ---------------------
    match RuleMatchEnv
    _ RuleSubst
    subst (Lit Literal
    lit1) (Lit Literal
    lit2) MCoercion
    mco
      | Literal
    lit1 Literal -> Literal -> Bool
    forall a. Eq a => a -> a -> Bool
    == Literal
    lit2
      = Bool -> SDoc -> Maybe RuleSubst -> Maybe RuleSubst
    forall a. HasCallStack => Bool -> SDoc -> a -> a
    assertPpr (MCoercion -> Bool
    isReflMCo MCoercion
    mco) (MCoercion -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr MCoercion
    mco) (Maybe RuleSubst -> Maybe RuleSubst)
    -> Maybe RuleSubst -> Maybe RuleSubst
    forall a b. (a -> b) -> a -> b
    $
        RuleSubst -> Maybe RuleSubst
    forall a. a -> Maybe a
    Just RuleSubst
    subst

    ------------------------ Variables ---------------------
    -- The Var case follows closely what happens in GHC.Core.Unify.match
    match RuleMatchEnv
    renv RuleSubst
    subst (Var Var
    v1) CoreExpr
    e2 MCoercion
    mco
      = RuleMatchEnv -> RuleSubst -> Var -> CoreExpr -> Maybe RuleSubst
    match_var RuleMatchEnv
    renv RuleSubst
    subst Var
    v1 (CoreExpr -> MCoercion -> CoreExpr
    mkCastMCo CoreExpr
    e2 MCoercion
    mco)

    match RuleMatchEnv
    renv RuleSubst
    subst CoreExpr
    e1 (Var Var
    v2) MCoercion
    mco  -- Note [Expanding variables]
      | Bool -> Bool
    not (RnEnv2 -> Var -> Bool
    inRnEnvR RnEnv2
    rn_env Var
    v2)      -- Note [Do not expand locally-bound variables]
      , Just CoreExpr
    e2' <- Unfolding -> Maybe CoreExpr
    expandUnfolding_maybe (RuleMatchEnv -> IdUnfoldingFun
    rv_unf RuleMatchEnv
    renv Var
    v2')
      = RuleMatchEnv
    -> RuleSubst
    -> CoreExpr
    -> CoreExpr
    -> MCoercion
    -> Maybe RuleSubst
    match (RuleMatchEnv
    renv { rv_lcl = nukeRnEnvR rn_env }) RuleSubst
    subst CoreExpr
    e1 CoreExpr
    e2' MCoercion
    mco
      where
        v2' :: Var
    v2'    = RnEnv2 -> Var -> Var
    lookupRnInScope RnEnv2
    rn_env Var
    v2
        rn_env :: RnEnv2
    rn_env = RuleMatchEnv -> RnEnv2
    rv_lcl RuleMatchEnv
    renv
            -- Notice that we look up v2 in the in-scope set
            -- See Note [Lookup in-scope]
            -- No need to apply any renaming first (hence no rnOccR)
            -- because of the not-inRnEnvR

    ------------------------ Applications ---------------------
    -- See Note [Matching higher order patterns]
    match renv :: RuleMatchEnv
    renv@(RV { rv_tmpls :: RuleMatchEnv -> VarSet
    rv_tmpls = VarSet
    tmpls, rv_lcl :: RuleMatchEnv -> RnEnv2
    rv_lcl = RnEnv2
    rn_env })
          RuleSubst
    subst  e1 :: CoreExpr
    e1@App{} CoreExpr
    e2
          MCoercion
    MRefl               -- Like the App case we insist on Refl here
                              -- See Note [Casts in the target]
      | (Var Var
    f, [CoreExpr]
    args) <- CoreExpr -> (CoreExpr, [CoreExpr])
    forall b. Expr b -> (Expr b, [Expr b])
    collectArgs CoreExpr
    e1
      , let f' :: Var
    f' = RnEnv2 -> Var -> Var
    rnOccL RnEnv2
    rn_env Var
    f   -- See similar rnOccL in match_var
      , Var
    f' Var -> VarSet -> Bool
    `elemVarSet` VarSet
    tmpls                     -- (HOP1)
      , Just [Var]
    vs2 <- (CoreExpr -> Maybe Var) -> [CoreExpr] -> Maybe [Var]
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> [a] -> f [b]
    traverse CoreExpr -> Maybe Var
    arg_as_lcl_var [CoreExpr]
    args  -- (HOP2), (HOP3)
      , [Var] -> Bool
    forall a. Eq a => [a] -> Bool
    hasNoDups [Var]
    vs2                             -- (HOP4)
      , Bool -> Bool
    not Bool
    can_decompose_app_instead
      = RuleMatchEnv -> RuleSubst -> Var -> CoreExpr -> Maybe RuleSubst
    match_tmpl_var RuleMatchEnv
    renv RuleSubst
    subst Var
    f' ([Var] -> CoreExpr -> CoreExpr
    mkCoreLams [Var]
    vs2 CoreExpr
    e2)
        -- match_tmpl_var checks (HOP5) and (HOP6)
      where
        arg_as_lcl_var :: CoreExpr -> Maybe Var
        arg_as_lcl_var :: CoreExpr -> Maybe Var
    arg_as_lcl_var (Var Var
    v)
          | Just Var
    v' <- RnEnv2 -> Var -> Maybe Var
    rnOccL_maybe RnEnv2
    rn_env Var
    v
          , Bool -> Bool
    not (Var
    v' Var -> VarSet -> Bool
    `elemVarSet` VarSet
    tmpls)  -- rnEnvL contains the template variables
          = Var -> Maybe Var
    forall a. a -> Maybe a
    Just (Var -> Var
    to_target Var
    v')          -- to_target: see (W1)
                                         --   in Note [Matching higher order patterns]
        arg_as_lcl_var CoreExpr
    _ = Maybe Var
    forall a. Maybe a
    Nothing

        can_decompose_app_instead :: Bool
    can_decompose_app_instead -- Template (e1 v), target (e2 v), and v # fvs(e2)
          = case (CoreExpr
    e1, CoreExpr
    e2) of      -- See (W2) in Note [Matching higher order patterns]
               (App CoreExpr
    _ (Var Var
    v1), App CoreExpr
    f2 (Var Var
    v2))
                 -> RnEnv2 -> Var -> Var
    rnOccL RnEnv2
    rn_env Var
    v1 Var -> Var -> Bool
    forall a. Eq a => a -> a -> Bool
    == RnEnv2 -> Var -> Var
    rnOccR RnEnv2
    rn_env Var
    v2
                    Bool -> Bool -> Bool
    && Bool -> Bool
    not (Var
    v2 Var -> VarSet -> Bool
    `elemVarSet` CoreExpr -> VarSet
    exprFreeVars CoreExpr
    f2)
               (CoreExpr, CoreExpr)
    _ -> Bool
    False

        ----------------
        -- to_target: see (W1) in Note [Matching higher order patterns]
        to_target :: Var -> Var   -- From canonical variable back to target-expr variable
        to_target :: Var -> Var
    to_target Var
    v = VarEnv Var -> Var -> Maybe Var
    forall a. VarEnv a -> Var -> Maybe a
    lookupVarEnv VarEnv Var
    rev_envR Var
    v Maybe Var -> Var -> Var
    forall a. Maybe a -> a -> a
    `orElse` Var
    v

        rev_envR :: VarEnv Var   -- Inverts rnEnvR: from canonical variable
                                 -- back to target-expr variable
        rev_envR :: VarEnv Var
    rev_envR = (Unique -> Var -> VarEnv Var -> VarEnv Var)
    -> VarEnv Var -> VarEnv Var -> VarEnv Var
    forall a r. (Unique -> a -> r -> r) -> r -> VarEnv a -> r
    nonDetStrictFoldVarEnv_Directly Unique -> Var -> VarEnv Var -> VarEnv Var
    add_one VarEnv Var
    forall a. VarEnv a
    emptyVarEnv (RnEnv2 -> VarEnv Var
    rnEnvR RnEnv2
    rn_env)
        add_one :: Unique -> Var -> VarEnv Var -> VarEnv Var
    add_one Unique
    uniq Var
    var VarEnv Var
    env = VarEnv Var -> Var -> Var -> VarEnv Var
    forall a. VarEnv a -> Var -> a -> VarEnv a
    extendVarEnv VarEnv Var
    env Var
    var (Var
    var Var -> Unique -> Var
    `setVarUnique` Unique
    uniq)

    {- Note [Matching higher order patterns]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Higher order patterns provide a limited form of higher order matching.
    See GHC Proposal #555
      https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0555-template-patterns.rst
    and #22465 for more details and related work.

    Consider the potential match:

       Template: forall f. foo (\x -> f x)
       Target:             foo (\x -> x*2 + x)

    The expression `x*2 + x` in the target is not literally an application of a
    function to the variable `x`, so the simple application rule does not apply.
    However, we can match them modulo beta equivalence with the substitution:

       [f :-> \x -> x*2 + x]

    The general problem of higher order matching is tricky to implement, but
    the subproblem which we call /higher order pattern matching/ is sufficient
    for the given example and much easier to implement.

    Design:

    We start with terminology.

    * /Template variables/. The forall'd variables are called the template
      variables. In the example match above, `f` is a template variable.

    * /Local binders/. The local binders of a rule are the variables bound
      inside the template. In the example match above, `x` is a local binder.
      Note that local binders can be term variables and type variables.

    A /higher order pattern/ (HOP) is a sub-expression of the template,
    of form (f x y z) where:

    * (HOP1) f is a template variable
    * (HOP2) x, y, z are local binders (like y in rule "wombat" above; see definitions).
    * (HOP3) The arguments x, y, z are term variables
    * (HOP4) The arguments x, y, z are distinct (no duplicates)

    Matching of higher order patterns (HOP-matching). A higher order pattern (f x y z)
    (in the template) matches any target expression e provided:

    * (HOP5) The target has the same type as the template
    * (HOP6) No local binder is free in e, other than x, y, z.

    If these two condition hold, the higher order pattern (f x y z) matches
    the target expression e, yielding the substitution [f :-> \x y z. e].
    Notice that this substitution is type preserving, and the RHS
    of the substitution has no free local binders.

    HOP matching is small enough to be done in-line in the `match` function.
    Two wrinkles:

    (W1) Consider the potential match:
            Template:    forall f. foo (\x -> f x)
            Target:                foo (\y -> (y, y))
         During matching we make `x` the canonical variable for the lambdas
         and then we see:
            Template:    f x       rnEnvL = []
            Target:      (y, y)    rnEnvR = [y :-> x]
         We could bind [f :-> \x. (x,x)], by applying rnEnvR substitution to the target
         expression.  But that is tiresome (a) because it involves a traversal, and
         (b) because rnEnvR is a VarEnv Var, and we don't have a substitution function
         for that.

         So instead, we invert rnEnvR, and apply it to the binders, to get
         [f :-> \y. (y,y)].  This is done by `to_target` in the HOP-matching case.
         It takes a little bit of thinking to be sure this will work right in the case
         of shadowing.  E.g.  Template (\x y. f x y)   Target  (\p p. p*p)
         Here rnEnvR will be just [p :-> y], so after inversion we'll get
              [f :-> \x p. p*p]
         but that is fine.

    (W2) This wrinkle concerns the overlp between the new HOP rule and the existing
         decompose-application rule.  See 3.1 of GHC Proposal #555 for a discussion.

         Consider potential match:
            Template: forall f.   foo (\x y. Just (f y x))
            Target:               foo (\p q. Just (h (1+q) p)))
         During matching we will encounter:
            Template:    f x y
            Target:      h (1+q) p    rnEnvR = [p:->x, q:->y]
         The rnEnvR renaming `[p:->x, q:->y]` is done by the matcher (today) on the fly,
         to make the bound variables of the template and target "line up".
         But now we can:
         * Either use the new HOP rule to succeed with
              [f :-> \x y. h (1+x) y]
         * Or use the existing decompose-application rule to match
              (f x) against (h (1+q)) and `y` against `p`.
           This will succeed with
              [f :-> \y. h (1+y)]

         Note that the result of the HOP rule will always be eta-equivalent to
         the result of the decompose-application rule.  But the proposal specifies
         that we should use the decompose-application rule because it involves
         less eta-expansion.

         But take care:
            Template: forall f.   foo (\x y. Just (f y x))
            Target:               foo (\p q. Just (h (p+q) p)))
         Then during matching we will encounter:
            Template:    f x y
            Target:      h (p+q) p      rnEnvR = [p:->x, q:->y]
         Now, we cannot use the decompose-application rule, because p is free in
         (h (p+q)). So, we can only use the new HOP rule.

    (W3) You might wonder if a HOP can have /type/ arguments, thus (in Core)
            RULE forall h.
                 f (\(MkT @b (d::Num b) (x::b)) -> h @b d x) = ...
         where the HOP is (h @b d x). In principle this might be possible, but
         it seems fragile; e.g. we would still need to insist that the (invisible)
         @b was a type variable.  And since `h` gets a polymoprhic type, that
         type would have to be declared by the programmer.

         Maybe one day.  But for now, we insist (in `arg_as_lcl_var`)that a HOP
         has only term-variable arguments.
    -}

    -- Note the match on MRefl!  We fail if there is a cast in the target
    --     (e1 e2) ~ (d1 d2) |> co
    -- See Note [Cancel reflexive casts]: in the Cast equations for 'match'
    -- we aggressively ensure that if MCo is reflective, it really is MRefl.
    match RuleMatchEnv
    renv RuleSubst
    subst (App CoreExpr
    f1 CoreExpr
    a1) (App CoreExpr
    f2 CoreExpr
    a2) MCoercion
    MRefl
      = do  { subst' <- RuleMatchEnv
    -> RuleSubst
    -> CoreExpr
    -> CoreExpr
    -> MCoercion
    -> Maybe RuleSubst
    match RuleMatchEnv
    renv RuleSubst
    subst CoreExpr
    f1 CoreExpr
    f2 MCoercion
    MRefl
            ; match renv subst' a1 a2 MRefl }

    ------------------------ Float lets ---------------------
    match RuleMatchEnv
    renv RuleSubst
    subst CoreExpr
    e1 (Let CoreBind
    bind CoreExpr
    e2) MCoercion
    mco
      | -- pprTrace "match:Let" (vcat [ppr bind, ppr $ okToFloat (rv_lcl renv) (bindFreeVars bind)]) $
        Bool -> Bool
    not (CoreBind -> Bool
    isJoinBind CoreBind
    bind) -- can't float join point out of argument position
      , RnEnv2 -> VarSet -> Bool
    okToFloat (RuleMatchEnv -> RnEnv2
    rv_lcl RuleMatchEnv
    renv) (CoreBind -> VarSet
    bindFreeVars CoreBind
    bind) -- See Note [Matching lets]
      = RuleMatchEnv
    -> RuleSubst
    -> CoreExpr
    -> CoreExpr
    -> MCoercion
    -> Maybe RuleSubst
    match (RuleMatchEnv
    renv { rv_fltR = flt_subst'
                    , rv_lcl  = rv_lcl renv `extendRnInScopeSetList` new_bndrs })
                    -- We are floating the let-binding out, as if it had enclosed
                    -- the entire target from Day 1.  So we must add its binders to
                    -- the in-scope set (#20200)
              (RuleSubst
    subst { rs_binds = rs_binds subst . Let bind'
                     , rs_bndrs = new_bndrs ++ rs_bndrs subst })
              CoreExpr
    e1 CoreExpr
    e2 MCoercion
    mco
      | Bool
    otherwise
      = Maybe RuleSubst
    forall a. Maybe a
    Nothing
      where
        in_scope :: InScopeSet
    in_scope  = RnEnv2 -> InScopeSet
    rnInScopeSet (RuleMatchEnv -> RnEnv2
    rv_lcl RuleMatchEnv
    renv) InScopeSet -> [Var] -> InScopeSet
    `extendInScopeSetList` RuleSubst -> [Var]
    rs_bndrs RuleSubst
    subst
                    -- in_scope: see (4) in Note [Matching lets]
        flt_subst :: Subst
    flt_subst = RuleMatchEnv -> Subst
    rv_fltR RuleMatchEnv
    renv Subst -> InScopeSet -> Subst
    `setInScope` InScopeSet
    in_scope
        (Subst
    flt_subst', CoreBind
    bind') = HasDebugCallStack => Subst -> CoreBind -> (Subst, CoreBind)
    Subst -> CoreBind -> (Subst, CoreBind)
    substBind Subst
    flt_subst CoreBind
    bind
        new_bndrs :: [Var]
    new_bndrs           = CoreBind -> [Var]
    forall b. Bind b -> [b]
    bindersOf CoreBind
    bind'

    ------------------------  Lambdas ---------------------
    match RuleMatchEnv
    renv RuleSubst
    subst (Lam Var
    x1 CoreExpr
    e1) CoreExpr
    e2 MCoercion
    mco
      | let casted_e2 :: CoreExpr
    casted_e2 = CoreExpr -> MCoercion -> CoreExpr
    mkCastMCo CoreExpr
    e2 MCoercion
    mco
            in_scope :: InScopeSet
    in_scope = InScopeSet -> VarSet -> InScopeSet
    extendInScopeSetSet (RnEnv2 -> InScopeSet
    rnInScopeSet (RuleMatchEnv -> RnEnv2
    rv_lcl RuleMatchEnv
    renv))
                                           (CoreExpr -> VarSet
    exprFreeVars CoreExpr
    casted_e2)
            in_scope_env :: InScopeEnv
    in_scope_env = InScopeSet -> IdUnfoldingFun -> InScopeEnv
    ISE InScopeSet
    in_scope (RuleMatchEnv -> IdUnfoldingFun
    rv_unf RuleMatchEnv
    renv)
            -- extendInScopeSetSet: The InScopeSet of rn_env is not necessarily
            -- a superset of the free vars of e2; it is only guaranteed a superset of
            -- applying the (rnEnvR rn_env) substitution to e2. But exprIsLambda_maybe
            -- wants an in-scope set that includes all the free vars of its argument.
            -- Hence adding adding (exprFreeVars casted_e2) to the in-scope set (#23630)
      , Just (Var
    x2, CoreExpr
    e2', [CoreTickish]
    ts) <- HasDebugCallStack =>
    InScopeEnv -> CoreExpr -> Maybe (Var, CoreExpr, [CoreTickish])
    InScopeEnv -> CoreExpr -> Maybe (Var, CoreExpr, [CoreTickish])
    exprIsLambda_maybe InScopeEnv
    in_scope_env CoreExpr
    casted_e2
        -- See Note [Lambdas in the template]
      = let renv' :: RuleMatchEnv
    renv'  = RuleMatchEnv -> Var -> Var -> RuleMatchEnv
    rnMatchBndr2 RuleMatchEnv
    renv Var
    x1 Var
    x2
            subst' :: RuleSubst
    subst' = RuleSubst
    subst { rs_binds = rs_binds subst . flip (foldr mkTick) ts }
        in  RuleMatchEnv
    -> RuleSubst
    -> CoreExpr
    -> CoreExpr
    -> MCoercion
    -> Maybe RuleSubst
    match RuleMatchEnv
    renv' RuleSubst
    subst' CoreExpr
    e1 CoreExpr
    e2' MCoercion
    MRefl

    match RuleMatchEnv
    renv RuleSubst
    subst CoreExpr
    e1 e2 :: CoreExpr
    e2@(Lam {}) MCoercion
    mco
      | Just (RuleMatchEnv
    renv', CoreExpr
    e2') <- RuleMatchEnv -> CoreExpr -> Maybe (RuleMatchEnv, CoreExpr)
    eta_reduce RuleMatchEnv
    renv CoreExpr
    e2  -- See Note [Eta reduction in the target]
      = RuleMatchEnv
    -> RuleSubst
    -> CoreExpr
    -> CoreExpr
    -> MCoercion
    -> Maybe RuleSubst
    match RuleMatchEnv
    renv' RuleSubst
    subst CoreExpr
    e1 CoreExpr
    e2' MCoercion
    mco

    {- Note [Lambdas in the template]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    If we match
       Template:   (\x. blah_template)
       Target:     (\y. blah_target)
    then we want to match inside the lambdas, using rv_lcl to match up
    x and y.

    But what about this?
       Template   (\x. (blah1 |> cv))
       Target     (\y. blah2) |> co

    This happens quite readily, because the Simplifier generally moves
    casts outside lambdas: see Note [Casts and lambdas] in
    GHC.Core.Opt.Simplify.Utils. So, tiresomely, we want to push `co`
    back inside, which is what `exprIsLambda_maybe` does.  But we've
    stripped off that cast, so now we need to put it back, hence mkCastMCo.

    Unlike the target, where we attempt eta-reduction, we do not attempt
    to eta-reduce the template, and may therefore fail on
      Template:   \x. f True x
      Target      f True

    It's not especially easy to deal with eta reducing the template,
    and never happens, because no one write eta-expanded left-hand-sides.
    -}

    ------------------------ Case expression ---------------------
    {- Disabled: see Note [Matching cases] below
    match renv (tv_subst, id_subst, binds) e1
          (Case scrut case_bndr ty [(con, alt_bndrs, rhs)])
      | exprOkForSpeculation scrut  -- See Note [Matching cases]
      , okToFloat rn_env bndrs (exprFreeVars scrut)
      = match (renv { me_env = rn_env' })
              (tv_subst, id_subst, binds . case_wrap)
              e1 rhs
      where
        rn_env   = me_env renv
        rn_env'  = extendRnInScopeList rn_env bndrs
        bndrs    = case_bndr : alt_bndrs
        case_wrap rhs' = Case scrut case_bndr ty [(con, alt_bndrs, rhs')]
    -}

    match RuleMatchEnv
    renv RuleSubst
    subst (Case CoreExpr
    e1 Var
    x1 Kind
    ty1 [Alt Var]
    alts1) (Case CoreExpr
    e2 Var
    x2 Kind
    ty2 [Alt Var]
    alts2) MCoercion
    mco
      = do  { subst1 <- RuleMatchEnv -> RuleSubst -> Kind -> Kind -> Maybe RuleSubst
    match_ty RuleMatchEnv
    renv RuleSubst
    subst Kind
    ty1 Kind
    ty2
            ; subst2 <- match renv subst1 e1 e2 MRefl
            ; let renv' = RuleMatchEnv -> Var -> Var -> RuleMatchEnv
    rnMatchBndr2 RuleMatchEnv
    renv Var
    x1 Var
    x2
            ; match_alts renv' subst2 alts1 alts2 mco   -- Alts are both sorted
            }

    -- Everything else fails
    match RuleMatchEnv
    _ RuleSubst
    _ CoreExpr
    _e1 CoreExpr
    _e2 MCoercion
    _mco = -- pprTrace "Failing at" ((text "e1:" <+> ppr _e1) $$ (text "e2:" <+> ppr _e2)) $
                             Maybe RuleSubst
    forall a. Maybe a
    Nothing

    -------------
    eta_reduce :: RuleMatchEnv -> CoreExpr -> Maybe (RuleMatchEnv, CoreExpr)
    -- See Note [Eta reduction in the target]
    eta_reduce :: RuleMatchEnv -> CoreExpr -> Maybe (RuleMatchEnv, CoreExpr)
    eta_reduce RuleMatchEnv
    renv e :: CoreExpr
    e@(Lam {})
      = RuleMatchEnv
    -> (CoreExpr -> CoreExpr)
    -> [Var]
    -> CoreExpr
    -> Maybe (RuleMatchEnv, CoreExpr)
    go RuleMatchEnv
    renv CoreExpr -> CoreExpr
    forall a. a -> a
    id [] CoreExpr
    e
      where
        go :: RuleMatchEnv -> BindWrapper -> [Var] -> CoreExpr
           -> Maybe (RuleMatchEnv, CoreExpr)
        go :: RuleMatchEnv
    -> (CoreExpr -> CoreExpr)
    -> [Var]
    -> CoreExpr
    -> Maybe (RuleMatchEnv, CoreExpr)
    go RuleMatchEnv
    renv CoreExpr -> CoreExpr
    bw [Var]
    vs (Let CoreBind
    b CoreExpr
    e) = RuleMatchEnv
    -> (CoreExpr -> CoreExpr)
    -> [Var]
    -> CoreExpr
    -> Maybe (RuleMatchEnv, CoreExpr)
    go RuleMatchEnv
    renv (CoreExpr -> CoreExpr
    bw (CoreExpr -> CoreExpr)
    -> (CoreExpr -> CoreExpr) -> CoreExpr -> CoreExpr
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CoreBind -> CoreExpr -> CoreExpr
    forall b. Bind b -> Expr b -> Expr b
    Let CoreBind
    b) [Var]
    vs CoreExpr
    e

        go RuleMatchEnv
    renv CoreExpr -> CoreExpr
    bw [Var]
    vs (Lam Var
    v CoreExpr
    e) = RuleMatchEnv
    -> (CoreExpr -> CoreExpr)
    -> [Var]
    -> CoreExpr
    -> Maybe (RuleMatchEnv, CoreExpr)
    go RuleMatchEnv
    renv' CoreExpr -> CoreExpr
    bw (Var
    v'Var -> [Var] -> [Var]
    forall a. a -> [a] -> [a]
    :[Var]
    vs) CoreExpr
    e
          where
             (RnEnv2
    rn_env', Var
    v') = RnEnv2 -> Var -> (RnEnv2, Var)
    rnBndrR (RuleMatchEnv -> RnEnv2
    rv_lcl RuleMatchEnv
    renv) Var
    v
             renv' :: RuleMatchEnv
    renv' = RuleMatchEnv
    renv { rv_lcl = rn_env' }

        go RuleMatchEnv
    renv CoreExpr -> CoreExpr
    bw (Var
    v:[Var]
    vs) (App CoreExpr
    f CoreExpr
    arg)
          | Var Var
    a <- CoreExpr
    arg, Var
    v Var -> Var -> Bool
    forall a. Eq a => a -> a -> Bool
    == RnEnv2 -> Var -> Var
    rnOccR (RuleMatchEnv -> RnEnv2
    rv_lcl RuleMatchEnv
    renv) Var
    a
          = RuleMatchEnv
    -> (CoreExpr -> CoreExpr)
    -> [Var]
    -> CoreExpr
    -> Maybe (RuleMatchEnv, CoreExpr)
    go RuleMatchEnv
    renv CoreExpr -> CoreExpr
    bw [Var]
    vs CoreExpr
    f

          | Type Kind
    ty <- CoreExpr
    arg, Just Var
    tv <- Kind -> Maybe Var
    getTyVar_maybe Kind
    ty
          , Var
    v Var -> Var -> Bool
    forall a. Eq a => a -> a -> Bool
    == RnEnv2 -> Var -> Var
    rnOccR (RuleMatchEnv -> RnEnv2
    rv_lcl RuleMatchEnv
    renv) Var
    tv
          = RuleMatchEnv
    -> (CoreExpr -> CoreExpr)
    -> [Var]
    -> CoreExpr
    -> Maybe (RuleMatchEnv, CoreExpr)
    go RuleMatchEnv
    renv CoreExpr -> CoreExpr
    bw [Var]
    vs CoreExpr
    f

        go RuleMatchEnv
    renv CoreExpr -> CoreExpr
    bw []    CoreExpr
    e = (RuleMatchEnv, CoreExpr) -> Maybe (RuleMatchEnv, CoreExpr)
    forall a. a -> Maybe a
    Just (RuleMatchEnv
    renv, CoreExpr -> CoreExpr
    bw CoreExpr
    e)
        go RuleMatchEnv
    _    CoreExpr -> CoreExpr
    _  (Var
    _:[Var]
    _) CoreExpr
    _ = Maybe (RuleMatchEnv, CoreExpr)
    forall a. Maybe a
    Nothing

    eta_reduce RuleMatchEnv
    _ CoreExpr
    _ = Maybe (RuleMatchEnv, CoreExpr)
    forall a. Maybe a
    Nothing

    {- Note [Eta reduction in the target]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Suppose we are faced with this (#19790)
       Template {x}  f x
       Target        (\a b c. let blah in f x a b c)

    You might wonder why we have an eta-expanded target (see first subtle
    point below), but regardless of how it came about, we'd like
    eta-expansion not to impede matching.

    So eta_reduce does on-the-fly eta-reduction of the target expression.
    Given (\a b c. let blah in e a b c), it returns (let blah in e).

    Subtle points:
    * Consider a target:  \x. f <expensive> x
      In the main eta-reducer we do not eta-reduce this, because doing so
      might reduce the arity of the expression (from 1 to zero, because of
      <expensive>).  But for rule-matching we /do/ want to match template
      (f a) against target (\x. f <expensive> x), with a := <expensive>

      This is a compelling reason for not relying on the Simplifier's
      eta-reducer.

    * The Lam case of eta_reduce renames as it goes. Consider
      (\x. \x. f x x).  We should not eta-reduce this.  As we go we rename
      the first x to x1, and the second to x2; then both argument x's are x2.

    * eta_reduce does /not/ need to check that the bindings 'blah'
      and expression 'e' don't mention a b c; but it /does/ extend the
      rv_lcl RnEnv2 (see rn_bndr in eta_reduce).
      * If 'blah' mentions the binders, the let-float rule won't
        fire; and
      * if 'e' mentions the binders we we'll also fail to match
        e.g. because of the exprFreeVars test in match_tmpl_var.

      Example: Template: {x}  f a         -- Some top-level 'a'
               Target:   (\a b. f a a b)  -- The \a shadows top level 'a'
      Then eta_reduce will /succeed/, with
          (rnEnvR = [a :-> a'], f a)
      The returned RnEnv will map [a :-> a'], where a' is fresh. (There is
      no need to rename 'b' because (in this example) it is not in scope.
      So it's as if we'd returned (f a') from eta_reduce; the renaming applied
      to the target is simply deferred.

    Note [Cancel reflexive casts]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Here is an example (from #19790) which we want to catch
       (f x) ~ (\a b. (f x |> co) a b) |> sym co
    where
       f :: Int -> Stream
       co :: Stream ~ T1 -> T2 -> T3

    when we eta-reduce (\a b. blah a b) to 'blah', we'll get
      (f x) ~ (f x) |> co |> sym co

    and we really want to spot that the co/sym-co cancels out.
    Hence
      * We keep an invariant that the MCoercion is always MRefl
        if the MCoercion is reflexive
      * We maintain this invariant via the call to checkReflexiveMCo
        in the Cast case of 'match'.
    -}

    -------------
    matchTemplateCast
        :: RuleMatchEnv -> RuleSubst
        -> CoreExpr -> Coercion
        -> CoreExpr -> MCoercion
        -> Maybe RuleSubst
    matchTemplateCast :: RuleMatchEnv
    -> RuleSubst
    -> CoreExpr
    -> Coercion
    -> CoreExpr
    -> MCoercion
    -> Maybe RuleSubst
    matchTemplateCast RuleMatchEnv
    renv RuleSubst
    subst CoreExpr
    e1 Coercion
    co1 CoreExpr
    e2 MCoercion
    mco
      | VarSet -> Bool
    isEmptyVarSet (VarSet -> Bool) -> VarSet -> Bool
    forall a b. (a -> b) -> a -> b
    $ FV -> VarSet
    fvVarSet (FV -> VarSet) -> FV -> VarSet
    forall a b. (a -> b) -> a -> b
    $
        (Var -> Bool) -> FV -> FV
    filterFV (Var -> VarSet -> Bool
    `elemVarSet` RuleMatchEnv -> VarSet
    rv_tmpls RuleMatchEnv
    renv) (FV -> FV) -> FV -> FV
    forall a b. (a -> b) -> a -> b
    $    -- Check that the coercion does not
        Coercion -> FV
    tyCoFVsOfCo Coercion
    substed_co                     -- mention any of the template variables
      = -- This is the good path
        -- See Note [Casts in the template]
        RuleMatchEnv
    -> RuleSubst
    -> CoreExpr
    -> CoreExpr
    -> MCoercion
    -> Maybe RuleSubst
    match RuleMatchEnv
    renv RuleSubst
    subst CoreExpr
    e1 CoreExpr
    e2 (MCoercion -> MCoercion
    checkReflexiveMCo (MCoercion -> Coercion -> MCoercion
    mkTransMCoL MCoercion
    mco (Coercion -> Coercion
    mkSymCo Coercion
    substed_co)))

      | Bool
    otherwise
      = -- This is the Deeply Suspicious Path
        do { let co2 :: Coercion
    co2 = case MCoercion
    mco of
                         MCoercion
    MRefl   -> Kind -> Coercion
    mkRepReflCo (HasDebugCallStack => CoreExpr -> Kind
    CoreExpr -> Kind
    exprType CoreExpr
    e2)
                         MCo Coercion
    co2 -> Coercion
    co2
           ; subst1 <- RuleMatchEnv
    -> RuleSubst -> Coercion -> Coercion -> Maybe RuleSubst
    match_co RuleMatchEnv
    renv RuleSubst
    subst Coercion
    co1 Coercion
    co2
             -- If match_co succeeds, then (exprType e1) = (exprType e2)
             -- Hence the MRefl in the next line
           ; match renv subst1 e1 e2 MRefl }
      where
        substed_co :: Coercion
    substed_co = HasDebugCallStack => Subst -> Coercion -> Coercion
    Subst -> Coercion -> Coercion
    substCo Subst
    current_subst Coercion
    co1

        current_subst :: Subst
        current_subst :: Subst
    current_subst = InScopeSet -> TvSubstEnv -> CvSubstEnv -> Subst
    mkTCvSubst (RnEnv2 -> InScopeSet
    rnInScopeSet (RuleMatchEnv -> RnEnv2
    rv_lcl RuleMatchEnv
    renv))
                                   (RuleSubst -> TvSubstEnv
    rs_tv_subst RuleSubst
    subst)
                                   CvSubstEnv
    emptyCvSubstEnv
           -- emptyCvSubstEnv: ugh!
           -- If there were any CoVar substitutions they would be in
           -- rs_id_subst; but we don't expect there to be any; see
           -- Note [Casts in the template]

    match_co :: RuleMatchEnv
             -> RuleSubst
             -> Coercion
             -> Coercion
             -> Maybe RuleSubst
    -- We only match if the template is a coercion variable or Refl:
    --   see Note [Casts in the template]
    -- Like 'match' it is /not/ guaranteed that
    --     coercionKind template  =  coercionKind target
    -- But if match_co succeeds, it /is/ guaranteed that
    --     coercionKind (subst template) = coercionKind target

    match_co :: RuleMatchEnv
    -> RuleSubst -> Coercion -> Coercion -> Maybe RuleSubst
    match_co RuleMatchEnv
    renv RuleSubst
    subst Coercion
    co1 Coercion
    co2
      | Just Var
    cv <- Coercion -> Maybe Var
    getCoVar_maybe Coercion
    co1
      = RuleMatchEnv -> RuleSubst -> Var -> CoreExpr -> Maybe RuleSubst
    match_var RuleMatchEnv
    renv RuleSubst
    subst Var
    cv (Coercion -> CoreExpr
    forall b. Coercion -> Expr b
    Coercion Coercion
    co2)

      | Just (Kind
    ty1, Role
    r1) <- Coercion -> Maybe (Kind, Role)
    isReflCo_maybe Coercion
    co1
      = do { (ty2, r2) <- Coercion -> Maybe (Kind, Role)
    isReflCo_maybe Coercion
    co2
           ; guard (r1 == r2)
           ; match_ty renv subst ty1 ty2 }

      | Bool
    debugIsOn
      = String -> SDoc -> Maybe RuleSubst -> Maybe RuleSubst
    forall a. String -> SDoc -> a -> a
    pprTrace String
    "match_co: needs more cases" (Coercion -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Coercion
    co1 SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ Coercion -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Coercion
    co2) Maybe RuleSubst
    forall a. Maybe a
    Nothing
        -- Currently just deals with CoVarCo and Refl

      | Bool
    otherwise
      = Maybe RuleSubst
    forall a. Maybe a
    Nothing

    -------------
    rnMatchBndr2 :: RuleMatchEnv -> Var -> Var -> RuleMatchEnv
    rnMatchBndr2 :: RuleMatchEnv -> Var -> Var -> RuleMatchEnv
    rnMatchBndr2 RuleMatchEnv
    renv Var
    x1 Var
    x2
      = RuleMatchEnv
    renv { rv_lcl  = rnBndr2 (rv_lcl renv) x1 x2
             , rv_fltR = delBndr (rv_fltR renv) x2 }

    ------------------------------------------
    match_alts :: RuleMatchEnv
               -> RuleSubst
               -> [CoreAlt]                 -- Template
               -> [CoreAlt] -> MCoercion    -- Target
               -> Maybe RuleSubst
    match_alts :: RuleMatchEnv
    -> RuleSubst
    -> [Alt Var]
    -> [Alt Var]
    -> MCoercion
    -> Maybe RuleSubst
    match_alts RuleMatchEnv
    _ RuleSubst
    subst [] [] MCoercion
    _
      = RuleSubst -> Maybe RuleSubst
    forall a. a -> Maybe a
    forall (m :: * -> *) a. Monad m => a -> m a
    return RuleSubst
    subst
    match_alts RuleMatchEnv
    renv RuleSubst
    subst (Alt AltCon
    c1 [Var]
    vs1 CoreExpr
    r1:[Alt Var]
    alts1) (Alt AltCon
    c2 [Var]
    vs2 CoreExpr
    r2:[Alt Var]
    alts2) MCoercion
    mco
      | AltCon
    c1 AltCon -> AltCon -> Bool
    forall a. Eq a => a -> a -> Bool
    == AltCon
    c2
      = do  { subst1 <- RuleMatchEnv
    -> RuleSubst
    -> CoreExpr
    -> CoreExpr
    -> MCoercion
    -> Maybe RuleSubst
    match RuleMatchEnv
    renv' RuleSubst
    subst CoreExpr
    r1 CoreExpr
    r2 MCoercion
    mco
            ; match_alts renv subst1 alts1 alts2 mco }
      where
        renv' :: RuleMatchEnv
    renv' = (RuleMatchEnv -> (Var, Var) -> RuleMatchEnv)
    -> RuleMatchEnv -> [(Var, Var)] -> RuleMatchEnv
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' RuleMatchEnv -> (Var, Var) -> RuleMatchEnv
    mb RuleMatchEnv
    renv ([Var]
    vs1 [Var] -> [Var] -> [(Var, Var)]
    forall a b. [a] -> [b] -> [(a, b)]
    `zip` [Var]
    vs2)
        mb :: RuleMatchEnv -> (Var, Var) -> RuleMatchEnv
    mb RuleMatchEnv
    renv (Var
    v1,Var
    v2) = RuleMatchEnv -> Var -> Var -> RuleMatchEnv
    rnMatchBndr2 RuleMatchEnv
    renv Var
    v1 Var
    v2

    match_alts RuleMatchEnv
    _ RuleSubst
    _ [Alt Var]
    _ [Alt Var]
    _ MCoercion
    _
      = Maybe RuleSubst
    forall a. Maybe a
    Nothing

    ------------------------------------------
    okToFloat :: RnEnv2 -> VarSet -> Bool
    okToFloat :: RnEnv2 -> VarSet -> Bool
    okToFloat RnEnv2
    rn_env VarSet
    bind_fvs
      = (Var -> Bool) -> VarSet -> Bool
    allVarSet Var -> Bool
    not_captured VarSet
    bind_fvs
      where
        not_captured :: Var -> Bool
    not_captured Var
    fv = Bool -> Bool
    not (RnEnv2 -> Var -> Bool
    inRnEnvR RnEnv2
    rn_env Var
    fv)

    ------------------------------------------
    match_var :: RuleMatchEnv
              -> RuleSubst
              -> Var        -- Template
              -> CoreExpr   -- Target
              -> Maybe RuleSubst
    match_var :: RuleMatchEnv -> RuleSubst -> Var -> CoreExpr -> Maybe RuleSubst
    match_var renv :: RuleMatchEnv
    renv@(RV { rv_tmpls :: RuleMatchEnv -> VarSet
    rv_tmpls = VarSet
    tmpls, rv_lcl :: RuleMatchEnv -> RnEnv2
    rv_lcl = RnEnv2
    rn_env, rv_fltR :: RuleMatchEnv -> Subst
    rv_fltR = Subst
    flt_env })
              RuleSubst
    subst Var
    v1 CoreExpr
    e2
      | Var
    v1' Var -> VarSet -> Bool
    `elemVarSet` VarSet
    tmpls
      = RuleMatchEnv -> RuleSubst -> Var -> CoreExpr -> Maybe RuleSubst
    match_tmpl_var RuleMatchEnv
    renv RuleSubst
    subst Var
    v1' CoreExpr
    e2

      | Bool
    otherwise   -- v1' is not a template variable; check for an exact match with e2
      = case CoreExpr
    e2 of  -- Remember, envR of rn_env is disjoint from rv_fltR
           Var Var
    v2 | Just Var
    v2' <- RnEnv2 -> Var -> Maybe Var
    rnOccR_maybe RnEnv2
    rn_env Var
    v2
                  -> -- v2 was bound by a nested lambda or case
                     if Var
    v1' Var -> Var -> Bool
    forall a. Eq a => a -> a -> Bool
    == Var
    v2' then RuleSubst -> Maybe RuleSubst
    forall a. a -> Maybe a
    Just RuleSubst
    subst
                                   else Maybe RuleSubst
    forall a. Maybe a
    Nothing

                  -- v2 is not bound nestedly; it is free
                  -- in the whole expression being matched
                  -- So it will be in the InScopeSet for flt_env (#20200)
                  | Var Var
    v2' <- HasDebugCallStack => Subst -> Var -> CoreExpr
    Subst -> Var -> CoreExpr
    lookupIdSubst Subst
    flt_env Var
    v2
                  , Var
    v1' Var -> Var -> Bool
    forall a. Eq a => a -> a -> Bool
    == Var
    v2'
                  -> RuleSubst -> Maybe RuleSubst
    forall a. a -> Maybe a
    Just RuleSubst
    subst
                  | Bool
    otherwise
                  -> Maybe RuleSubst
    forall a. Maybe a
    Nothing

           CoreExpr
    _ -> Maybe RuleSubst
    forall a. Maybe a
    Nothing

      where
        v1' :: Var
    v1' = RnEnv2 -> Var -> Var
    rnOccL RnEnv2
    rn_env Var
    v1
            -- If the template is
            --      forall x. f x (\x -> x) = ...
            -- Then the x inside the lambda isn't the
            -- template x, so we must rename first!

    ------------------------------------------
    match_tmpl_var :: RuleMatchEnv
                   -> RuleSubst
                   -> Var                -- Template
                   -> CoreExpr           -- Target
                   -> Maybe RuleSubst

    match_tmpl_var :: RuleMatchEnv -> RuleSubst -> Var -> CoreExpr -> Maybe RuleSubst
    match_tmpl_var renv :: RuleMatchEnv
    renv@(RV { rv_lcl :: RuleMatchEnv -> RnEnv2
    rv_lcl = RnEnv2
    rn_env, rv_fltR :: RuleMatchEnv -> Subst
    rv_fltR = Subst
    flt_env })
                   subst :: RuleSubst
    subst@(RS { rs_id_subst :: RuleSubst -> IdSubstEnv
    rs_id_subst = IdSubstEnv
    id_subst, rs_bndrs :: RuleSubst -> [Var]
    rs_bndrs = [Var]
    let_bndrs })
                   Var
    v1' CoreExpr
    e2
      -- anyInRnEnvR is lazy in the 2nd arg which allows us to avoid computing fvs
      -- if the right side of the env is empty.
      | RnEnv2 -> VarSet -> Bool
    anyInRnEnvR RnEnv2
    rn_env (CoreExpr -> VarSet
    exprFreeVars CoreExpr
    e2)
      = Maybe RuleSubst
    forall a. Maybe a
    Nothing     -- Skolem-escape failure
                    -- e.g. match forall a. (\x -> a) against (\y -> y)

      | Just CoreExpr
    e1' <- IdSubstEnv -> Var -> Maybe CoreExpr
    forall a. VarEnv a -> Var -> Maybe a
    lookupVarEnv IdSubstEnv
    id_subst Var
    v1'
      = if CoreExpr -> CoreExpr -> Bool
    eqCoreExpr CoreExpr
    e1' CoreExpr
    e2'
        then RuleSubst -> Maybe RuleSubst
    forall a. a -> Maybe a
    Just RuleSubst
    subst
        else Maybe RuleSubst
    forall a. Maybe a
    Nothing

      | Bool
    otherwise   -- See Note [Matching variable types]
      = do { subst' <- RuleMatchEnv -> RuleSubst -> Kind -> Kind -> Maybe RuleSubst
    match_ty RuleMatchEnv
    renv RuleSubst
    subst (Var -> Kind
    idType Var
    v1') (HasDebugCallStack => CoreExpr -> Kind
    CoreExpr -> Kind
    exprType CoreExpr
    e2)
           ; return (subst' { rs_id_subst = id_subst' }) }
      where
        -- e2' is the result of applying flt_env to e2
        e2' :: CoreExpr
    e2' | [Var] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Var]
    let_bndrs = CoreExpr
    e2
            | Bool
    otherwise = HasDebugCallStack => Subst -> CoreExpr -> CoreExpr
    Subst -> CoreExpr -> CoreExpr
    substExpr Subst
    flt_env CoreExpr
    e2

        id_subst' :: IdSubstEnv
    id_subst' = IdSubstEnv -> Var -> CoreExpr -> IdSubstEnv
    forall a. VarEnv a -> Var -> a -> VarEnv a
    extendVarEnv (RuleSubst -> IdSubstEnv
    rs_id_subst RuleSubst
    subst) Var
    v1' CoreExpr
    e2'
             -- No further renaming to do on e2',
             -- because no free var of e2' is in the rnEnvR of the envt

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

    match_ty :: RuleMatchEnv
             -> RuleSubst
             -> Type                -- Template
             -> Type                -- Target
             -> Maybe RuleSubst
    -- Matching Core types: use the matcher in GHC.Tc.Utils.TcType.
    -- Notice that we treat newtypes as opaque.  For example, suppose
    -- we have a specialised version of a function at a newtype, say
    --      newtype T = MkT Int
    -- We only want to replace (f T) with f', not (f Int).

    match_ty :: RuleMatchEnv -> RuleSubst -> Kind -> Kind -> Maybe RuleSubst
    match_ty (RV { rv_tmpls :: RuleMatchEnv -> VarSet
    rv_tmpls = VarSet
    tmpls, rv_lcl :: RuleMatchEnv -> RnEnv2
    rv_lcl = RnEnv2
    rn_env })
             subst :: RuleSubst
    subst@(RS { rs_tv_subst :: RuleSubst -> TvSubstEnv
    rs_tv_subst = TvSubstEnv
    tv_subst })
             Kind
    ty1 Kind
    ty2
      = do  { tv_subst' <- VarSet -> RnEnv2 -> TvSubstEnv -> Kind -> Kind -> Maybe TvSubstEnv
    Unify.ruleMatchTyKiX VarSet
    tmpls RnEnv2
    rn_env TvSubstEnv
    tv_subst Kind
    ty1 Kind
    ty2
                   -- NB: ruleMatchTyKiX applis tv_subst to ty1 only
                   --     and of course only binds 'tmpls'
            ; return (subst { rs_tv_subst = tv_subst' }) }

    {- Note [Matching variable types]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    When matching x ~ e, where 'x' is a template variable, we must check that
    x's type matches e's type, to establish (TypeInv).  For example
      forall (c::Char->Int) (x::Char).
         f (c x) = "RULE FIRED"
    We must not match on, say (f (pred (3::Int))).

    It's actually quite difficult to come up with an example that shows
    you need type matching, esp since matching is left-to-right, so type
    args get matched first.  But it's possible (e.g. simplrun008) and this
    is the Right Thing to do.

    An alternative would be to make (TypeInf) into a /pre-condition/.  It
    is threatened only by the App rule.  So when matching an application
    (e1 e2) ~ (d1 d2) would be to collect args of the application chain,
    match the types of the head, then match arg-by-arg.

    However that alternative seems a bit more complicated.  And by
    matching types at variables we do one match_ty for each template
    variable, rather than one for each application chain.  Usually there are
    fewer template variables, although for simple rules it could be the other
    way around.

    Note [Expanding variables]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~
    Here is another Very Important rule: if the term being matched is a
    variable, we expand it so long as its unfolding is "expandable". (Its
    occurrence information is not necessarily up to date, so we don't use
    it.)  By "expandable" we mean a WHNF or a "constructor-like" application.
    This is the key reason for "constructor-like" Ids.  If we have
         {-# NOINLINE [1] CONLIKE g #-}
         {-# RULE f (g x) = h x #-}
    then in the term
       let v = g 3 in ....(f v)....
    we want to make the rule fire, to replace (f v) with (h 3).

    Note [Do not expand locally-bound variables]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Do *not* expand locally-bound variables, else there's a worry that the
    unfolding might mention variables that are themselves renamed.
    Example
              case x of y { (p,q) -> ...y... }
    Don't expand 'y' to (p,q) because p,q might themselves have been
    renamed.  Essentially we only expand unfoldings that are "outside"
    the entire match.

    Hence, (a) the guard (not (isLocallyBoundR v2))
           (b) when we expand we nuke the renaming envt (nukeRnEnvR).

    Note [Tick annotations in RULE matching]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    We used to unconditionally look through ticks in both template and
    expression being matched. This is actually illegal for counting or
    cost-centre-scoped ticks, because we have no place to put them without
    changing entry counts and/or costs. So now we just fail the match in
    these cases.

    On the other hand, where we are allowed to insert new cost into the
    tick scope, we can float them upwards to the rule application site.

    Moreover, we may encounter ticks in the template of a rule. There are a few
    ways in which these may be introduced (e.g. #18162, #17619). Such ticks are
    ignored by the matcher. See Note [Simplifying rules] in
    GHC.Core.Opt.Simplify.Utils for details.

    cf Note [Tick annotations in call patterns] in GHC.Core.Opt.SpecConstr

    Note [Matching lets]
    ~~~~~~~~~~~~~~~~~~~~
    Matching a let-expression.  Consider
            RULE forall x.  f (g x) = <rhs>
    and target expression
            f (let { w=R } in g E))
    Then we'd like the rule to match, to generate
            let { w=R } in (\x. <rhs>) E
    In effect, we want to float the let-binding outward, to enable
    the match to happen.  This is the WHOLE REASON for accumulating
    bindings in the RuleSubst

    We can only do this if the free variables of R are not bound by the
    part of the target expression outside the let binding; e.g.
            f (\v. let w = v+1 in g E)
    Here we obviously cannot float the let-binding for w.  Hence the
    use of okToFloat.

    There are a couple of tricky points:
      (a) What if floating the binding captures a variable that is
          free in the entire expression?
            f (let v = x+1 in v) v
          --> NOT!
            let v = x+1 in f (x+1) v

      (b) What if the let shadows a local binding?
            f (\v -> (v, let v = x+1 in (v,v))
          --> NOT!
            let v = x+1 in f (\v -> (v, (v,v)))

      (c) What if two non-nested let bindings bind the same variable?
            f (let v = e1 in b1) (let v = e2 in b2)
          --> NOT!
            let v = e1 in let v = e2 in (f b2 b2)
          See testsuite test `T4814`.

    Our cunning plan is this:
      (1) Along with the growing substitution for template variables
          we maintain a growing set of floated let-bindings (rs_binds)
          plus the set of variables thus bound (rs_bndrs).

      (2) The RnEnv2 in the MatchEnv binds only the local binders
          in the term (lambdas, case), not the floated let-bndrs.

      (3) When we encounter a `let` in the term to be matched, in the Let
          case of `match`, we use `okToFloat` to check that it does not mention any
          locally bound (lambda, case) variables.  If so we fail.

      (4) In the Let case of `match`, we use GHC.Core.Subst.substBind to
          freshen the binding (which, remember (3), mentions no locally
          bound variables), in a lexically-scoped way (via rv_fltR in
          MatchEnv).

          The subtle point is that we want an in-scope set for this
          substitution that includes /two/ sets:
          * The in-scope variables at this point, so that we avoid using
            those local names for the floated binding; points (a) and (b) above.
          * All "earlier" floated bindings, so that we avoid using the
            same name for two different floated bindings; point (c) above.

          Because we have to compute the in-scope set here, the in-scope set
          stored in `rv_fltR` is always ignored; we leave it only because it's
          convenient to have `rv_fltR :: Subst` (with an always-ignored `InScopeSet`)
          rather than storing three separate substitutions.

      (5) We apply that freshening substitution, in a lexically-scoped
          way to the term, although lazily; this is the rv_fltR field.

    See #4814, which is an issue resulting from getting this wrong.

    Note [Matching cases]
    ~~~~~~~~~~~~~~~~~~~~~
    {- NOTE: This idea is currently disabled.  It really only works if
             the primops involved are OkForSpeculation, and, since
             they have side effects readIntOfAddr and touch are not.
             Maybe we'll get back to this later .  -}

    Consider
       f (case readIntOffAddr# p# i# realWorld# of { (# s#, n# #) ->
          case touch# fp s# of { _ ->
          I# n# } } )
    This happened in a tight loop generated by stream fusion that
    Roman encountered.  We'd like to treat this just like the let
    case, because the primops concerned are ok-for-speculation.
    That is, we'd like to behave as if it had been
       case readIntOffAddr# p# i# realWorld# of { (# s#, n# #) ->
       case touch# fp s# of { _ ->
       f (I# n# } } )

    Note [Lookup in-scope]
    ~~~~~~~~~~~~~~~~~~~~~~
    Consider this example
            foo :: Int -> Maybe Int -> Int
            foo 0 (Just n) = n
            foo m (Just n) = foo (m-n) (Just n)

    SpecConstr sees this fragment:

            case w_smT of wild_Xf [Just A] {
              Data.Maybe.Nothing -> lvl_smf;
              Data.Maybe.Just n_acT [Just S(L)] ->
                case n_acT of wild1_ams [Just A] { GHC.Base.I# y_amr [Just L] ->
                  $wfoo_smW (GHC.Prim.-# ds_Xmb y_amr) wild_Xf
                }};

    and correctly generates the rule

            RULES: "SC:$wfoo1" [0] __forall {y_amr [Just L] :: GHC.Prim.Int#
                                              sc_snn :: GHC.Prim.Int#}
              $wfoo_smW sc_snn (Data.Maybe.Just @ GHC.Base.Int (GHC.Base.I# y_amr))
              = $s$wfoo_sno y_amr sc_snn ;]

    BUT we must ensure that this rule matches in the original function!
    Note that the call to $wfoo is
                $wfoo_smW (GHC.Prim.-# ds_Xmb y_amr) wild_Xf

    During matching we expand wild_Xf to (Just n_acT).  But then we must also
    expand n_acT to (I# y_amr).  And we can only do that if we look up n_acT
    in the in-scope set, because in wild_Xf's unfolding it won't have an unfolding
    at all.

    That is why the 'lookupRnInScope' call in the (Var v2) case of 'match'
    is so important.

    ************************************************************************
    *                                                                      *
                       Rule-check the program
    *                                                                      *
    ************************************************************************

       We want to know what sites have rules that could have fired but didn't.
       This pass runs over the tree (without changing it) and reports such.
    -}

    -- | Report partial matches for rules beginning with the specified
    -- string for the purposes of error reporting
    ruleCheckProgram :: RuleOpts                    -- ^ Rule options
                     -> CompilerPhase               -- ^ Rule activation test
                     -> String                      -- ^ Rule pattern
                     -> (Id -> [CoreRule])          -- ^ Rules for an Id
                     -> CoreProgram                 -- ^ Bindings to check in
                     -> SDoc                        -- ^ Resulting check message
    ruleCheckProgram :: RuleOpts
    -> CompilerPhase
    -> String
    -> (Var -> [CoreRule])
    -> [CoreBind]
    -> SDoc
    ruleCheckProgram RuleOpts
    ropts CompilerPhase
    phase String
    rule_pat Var -> [CoreRule]
    rules [CoreBind]
    binds
      | Bag SDoc -> Bool
    forall a. Bag a -> Bool
    isEmptyBag Bag SDoc
    results
      = String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "Rule check results: no rule application sites"
      | Bool
    otherwise
      = [SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat [String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "Rule check results:",
              SDoc
    line,
              [SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat [ SDoc
    p SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ SDoc
    line | SDoc
    p <- Bag SDoc -> [SDoc]
    forall a. Bag a -> [a]
    bagToList Bag SDoc
    results ]
             ]
      where
        line :: SDoc
    line = String -> SDoc
    forall doc. IsLine doc => String -> doc
    text (Arity -> Char -> String
    forall a. Arity -> a -> [a]
    replicate Arity
    20 Char
    '-')
        env :: RuleCheckEnv
    env = RuleCheckEnv { rc_is_active :: Activation -> Bool
    rc_is_active = CompilerPhase -> Activation -> Bool
    isActive CompilerPhase
    phase
                           , rc_id_unf :: IdUnfoldingFun
    rc_id_unf    = IdUnfoldingFun
    idUnfolding     -- Not quite right
                                                            -- Should use activeUnfolding
                           , rc_pattern :: String
    rc_pattern   = String
    rule_pat
                           , rc_rules :: Var -> [CoreRule]
    rc_rules     = Var -> [CoreRule]
    rules
                           , rc_ropts :: RuleOpts
    rc_ropts     = RuleOpts
    ropts
                           , rc_in_scope :: InScopeSet
    rc_in_scope  = InScopeSet
    emptyInScopeSet }

        results :: Bag SDoc
    results = RuleCheckEnv -> [CoreBind] -> Bag SDoc
    go RuleCheckEnv
    env [CoreBind]
    binds

        go :: RuleCheckEnv -> [CoreBind] -> Bag SDoc
    go RuleCheckEnv
    _   []           = Bag SDoc
    forall a. Bag a
    emptyBag
        go RuleCheckEnv
    env (CoreBind
    bind:[CoreBind]
    binds) = let (RuleCheckEnv
    env', Bag SDoc
    ds) = RuleCheckEnv -> CoreBind -> (RuleCheckEnv, Bag SDoc)
    ruleCheckBind RuleCheckEnv
    env CoreBind
    bind
                              in Bag SDoc
    ds Bag SDoc -> Bag SDoc -> Bag SDoc
    forall a. Bag a -> Bag a -> Bag a
    `unionBags` RuleCheckEnv -> [CoreBind] -> Bag SDoc
    go RuleCheckEnv
    env' [CoreBind]
    binds

    data RuleCheckEnv = RuleCheckEnv
        { RuleCheckEnv -> Activation -> Bool
    rc_is_active :: Activation -> Bool
        , RuleCheckEnv -> IdUnfoldingFun
    rc_id_unf    :: IdUnfoldingFun
        , RuleCheckEnv -> String
    rc_pattern   :: String
        , RuleCheckEnv -> Var -> [CoreRule]
    rc_rules     :: Id -> [CoreRule]
        , RuleCheckEnv -> RuleOpts
    rc_ropts     :: RuleOpts
        , RuleCheckEnv -> InScopeSet
    rc_in_scope  :: InScopeSet }

    extendInScopeRC :: RuleCheckEnv -> Var -> RuleCheckEnv
    extendInScopeRC :: RuleCheckEnv -> Var -> RuleCheckEnv
    extendInScopeRC env :: RuleCheckEnv
    env@(RuleCheckEnv { rc_in_scope :: RuleCheckEnv -> InScopeSet
    rc_in_scope = InScopeSet
    in_scope }) Var
    v
      = RuleCheckEnv
    env { rc_in_scope = in_scope `extendInScopeSet` v }

    extendInScopeListRC :: RuleCheckEnv -> [Var] -> RuleCheckEnv
    extendInScopeListRC :: RuleCheckEnv -> [Var] -> RuleCheckEnv
    extendInScopeListRC env :: RuleCheckEnv
    env@(RuleCheckEnv { rc_in_scope :: RuleCheckEnv -> InScopeSet
    rc_in_scope = InScopeSet
    in_scope }) [Var]
    vs
      = RuleCheckEnv
    env { rc_in_scope = in_scope `extendInScopeSetList` vs }

    ruleCheckBind :: RuleCheckEnv -> CoreBind -> (RuleCheckEnv, Bag SDoc)
       -- The Bag returned has one SDoc for each call site found
    ruleCheckBind :: RuleCheckEnv -> CoreBind -> (RuleCheckEnv, Bag SDoc)
    ruleCheckBind RuleCheckEnv
    env (NonRec Var
    b CoreExpr
    r) = (RuleCheckEnv
    env RuleCheckEnv -> Var -> RuleCheckEnv
    `extendInScopeRC` Var
    b, RuleCheckEnv -> CoreExpr -> Bag SDoc
    ruleCheck RuleCheckEnv
    env CoreExpr
    r)
    ruleCheckBind RuleCheckEnv
    env (Rec [(Var, CoreExpr)]
    prs)    = (RuleCheckEnv
    env', [Bag SDoc] -> Bag SDoc
    forall a. [Bag a] -> Bag a
    unionManyBags ((CoreExpr -> Bag SDoc) -> [CoreExpr] -> [Bag SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map (RuleCheckEnv -> CoreExpr -> Bag SDoc
    ruleCheck RuleCheckEnv
    env') [CoreExpr]
    rhss))
                                   where
                                     ([Var]
    bs, [CoreExpr]
    rhss) = [(Var, CoreExpr)] -> ([Var], [CoreExpr])
    forall a b. [(a, b)] -> ([a], [b])
    unzip [(Var, CoreExpr)]
    prs
                                     env' :: RuleCheckEnv
    env' = RuleCheckEnv
    env RuleCheckEnv -> [Var] -> RuleCheckEnv
    `extendInScopeListRC` [Var]
    bs

    ruleCheck :: RuleCheckEnv -> CoreExpr -> Bag SDoc
    ruleCheck :: RuleCheckEnv -> CoreExpr -> Bag SDoc
    ruleCheck RuleCheckEnv
    _   (Var Var
    _)         = Bag SDoc
    forall a. Bag a
    emptyBag
    ruleCheck RuleCheckEnv
    _   (Lit Literal
    _)         = Bag SDoc
    forall a. Bag a
    emptyBag
    ruleCheck RuleCheckEnv
    _   (Type Kind
    _)        = Bag SDoc
    forall a. Bag a
    emptyBag
    ruleCheck RuleCheckEnv
    _   (Coercion Coercion
    _)    = Bag SDoc
    forall a. Bag a
    emptyBag
    ruleCheck RuleCheckEnv
    env (App CoreExpr
    f CoreExpr
    a)       = RuleCheckEnv -> CoreExpr -> [CoreExpr] -> Bag SDoc
    ruleCheckApp RuleCheckEnv
    env (CoreExpr -> CoreExpr -> CoreExpr
    forall b. Expr b -> Expr b -> Expr b
    App CoreExpr
    f CoreExpr
    a) []
    ruleCheck RuleCheckEnv
    env (Tick CoreTickish
    _ CoreExpr
    e)      = RuleCheckEnv -> CoreExpr -> Bag SDoc
    ruleCheck RuleCheckEnv
    env CoreExpr
    e
    ruleCheck RuleCheckEnv
    env (Cast CoreExpr
    e Coercion
    _)      = RuleCheckEnv -> CoreExpr -> Bag SDoc
    ruleCheck RuleCheckEnv
    env CoreExpr
    e
    ruleCheck RuleCheckEnv
    env (Let CoreBind
    bd CoreExpr
    e)      = let (RuleCheckEnv
    env', Bag SDoc
    ds) = RuleCheckEnv -> CoreBind -> (RuleCheckEnv, Bag SDoc)
    ruleCheckBind RuleCheckEnv
    env CoreBind
    bd
                                    in  Bag SDoc
    ds Bag SDoc -> Bag SDoc -> Bag SDoc
    forall a. Bag a -> Bag a -> Bag a
    `unionBags` RuleCheckEnv -> CoreExpr -> Bag SDoc
    ruleCheck RuleCheckEnv
    env' CoreExpr
    e
    ruleCheck RuleCheckEnv
    env (Lam Var
    b CoreExpr
    e)       = RuleCheckEnv -> CoreExpr -> Bag SDoc
    ruleCheck (RuleCheckEnv
    env RuleCheckEnv -> Var -> RuleCheckEnv
    `extendInScopeRC` Var
    b) CoreExpr
    e
    ruleCheck RuleCheckEnv
    env (Case CoreExpr
    e Var
    b Kind
    _ [Alt Var]
    as) = RuleCheckEnv -> CoreExpr -> Bag SDoc
    ruleCheck RuleCheckEnv
    env CoreExpr
    e Bag SDoc -> Bag SDoc -> Bag SDoc
    forall a. Bag a -> Bag a -> Bag a
    `unionBags`
                                    [Bag SDoc] -> Bag SDoc
    forall a. [Bag a] -> Bag a
    unionManyBags [RuleCheckEnv -> CoreExpr -> Bag SDoc
    ruleCheck (RuleCheckEnv
    env RuleCheckEnv -> [Var] -> RuleCheckEnv
    `extendInScopeListRC` (Var
    bVar -> [Var] -> [Var]
    forall a. a -> [a] -> [a]
    :[Var]
    bs)) CoreExpr
    r
                                                  | Alt AltCon
    _ [Var]
    bs CoreExpr
    r <- [Alt Var]
    as]

    ruleCheckApp :: RuleCheckEnv -> Expr CoreBndr -> [Arg CoreBndr] -> Bag SDoc
    ruleCheckApp :: RuleCheckEnv -> CoreExpr -> [CoreExpr] -> Bag SDoc
    ruleCheckApp RuleCheckEnv
    env (App CoreExpr
    f CoreExpr
    a) [CoreExpr]
    as = RuleCheckEnv -> CoreExpr -> Bag SDoc
    ruleCheck RuleCheckEnv
    env CoreExpr
    a Bag SDoc -> Bag SDoc -> Bag SDoc
    forall a. Bag a -> Bag a -> Bag a
    `unionBags` RuleCheckEnv -> CoreExpr -> [CoreExpr] -> Bag SDoc
    ruleCheckApp RuleCheckEnv
    env CoreExpr
    f (CoreExpr
    aCoreExpr -> [CoreExpr] -> [CoreExpr]
    forall a. a -> [a] -> [a]
    :[CoreExpr]
    as)
    ruleCheckApp RuleCheckEnv
    env (Var Var
    f) [CoreExpr]
    as   = RuleCheckEnv -> Var -> [CoreExpr] -> Bag SDoc
    ruleCheckFun RuleCheckEnv
    env Var
    f [CoreExpr]
    as
    ruleCheckApp RuleCheckEnv
    env CoreExpr
    other [CoreExpr]
    _      = RuleCheckEnv -> CoreExpr -> Bag SDoc
    ruleCheck RuleCheckEnv
    env CoreExpr
    other

    ruleCheckFun :: RuleCheckEnv -> Id -> [CoreExpr] -> Bag SDoc
    -- Produce a report for all rules matching the predicate
    -- saying why it doesn't match the specified application

    ruleCheckFun :: RuleCheckEnv -> Var -> [CoreExpr] -> Bag SDoc
    ruleCheckFun RuleCheckEnv
    env Var
    fn [CoreExpr]
    args
      | [CoreRule] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [CoreRule]
    name_match_rules = Bag SDoc
    forall a. Bag a
    emptyBag
      | Bool
    otherwise             = SDoc -> Bag SDoc
    forall a. a -> Bag a
    unitBag (RuleCheckEnv -> Var -> [CoreExpr] -> [CoreRule] -> SDoc
    ruleAppCheck_help RuleCheckEnv
    env Var
    fn [CoreExpr]
    args [CoreRule]
    name_match_rules)
      where
        name_match_rules :: [CoreRule]
    name_match_rules = (CoreRule -> Bool) -> [CoreRule] -> [CoreRule]
    forall a. (a -> Bool) -> [a] -> [a]
    filter CoreRule -> Bool
    match (RuleCheckEnv -> Var -> [CoreRule]
    rc_rules RuleCheckEnv
    env Var
    fn)
        match :: CoreRule -> Bool
    match CoreRule
    rule = RuleCheckEnv -> String
    rc_pattern RuleCheckEnv
    env String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf` RuleName -> String
    unpackFS (CoreRule -> RuleName
    ruleName CoreRule
    rule)

    ruleAppCheck_help :: RuleCheckEnv -> Id -> [CoreExpr] -> [CoreRule] -> SDoc
    ruleAppCheck_help :: RuleCheckEnv -> Var -> [CoreExpr] -> [CoreRule] -> SDoc
    ruleAppCheck_help RuleCheckEnv
    env Var
    fn [CoreExpr]
    args [CoreRule]
    rules
      =     -- The rules match the pattern, so we want to print something
        [SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat [String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "Expression:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> CoreExpr -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (CoreExpr -> [CoreExpr] -> CoreExpr
    forall b. Expr b -> [Expr b] -> Expr b
    mkApps (Var -> CoreExpr
    forall b. Var -> Expr b
    Var Var
    fn) [CoreExpr]
    args),
              [SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat ((CoreRule -> SDoc) -> [CoreRule] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map CoreRule -> SDoc
    check_rule [CoreRule]
    rules)]
      where
        in_scope :: InScopeSet
    in_scope = RuleCheckEnv -> InScopeSet
    rc_in_scope RuleCheckEnv
    env
        n_args :: Arity
    n_args   = [CoreExpr] -> Arity
    forall a. [a] -> Arity
    forall (t :: * -> *) a. Foldable t => t a -> Arity
    length [CoreExpr]
    args
        i_args :: [(CoreExpr, Arity)]
    i_args   = [CoreExpr]
    args [CoreExpr] -> [Arity] -> [(CoreExpr, Arity)]
    forall a b. [a] -> [b] -> [(a, b)]
    `zip` [Arity
    1::Int ..]
        rough_args :: [Maybe Name]
    rough_args = (CoreExpr -> Maybe Name) -> [CoreExpr] -> [Maybe Name]
    forall a b. (a -> b) -> [a] -> [b]
    map CoreExpr -> Maybe Name
    roughTopName [CoreExpr]
    args

        check_rule :: CoreRule -> SDoc
    check_rule CoreRule
    rule = CoreRule -> SDoc
    forall {doc}. IsLine doc => CoreRule -> doc
    rule_herald CoreRule
    rule SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> SDoc
    forall doc. IsLine doc => doc
    colon SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> RuleOpts -> CoreRule -> SDoc
    rule_info (RuleCheckEnv -> RuleOpts
    rc_ropts RuleCheckEnv
    env) CoreRule
    rule

        rule_herald :: CoreRule -> doc
    rule_herald (BuiltinRule { ru_name :: CoreRule -> RuleName
    ru_name = RuleName
    name })
            = String -> doc
    forall doc. IsLine doc => String -> doc
    text String
    "Builtin rule" doc -> doc -> doc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> doc -> doc
    forall doc. IsLine doc => doc -> doc
    doubleQuotes (RuleName -> doc
    forall doc. IsLine doc => RuleName -> doc
    ftext RuleName
    name)
        rule_herald (Rule { ru_name :: CoreRule -> RuleName
    ru_name = RuleName
    name })
            = String -> doc
    forall doc. IsLine doc => String -> doc
    text String
    "Rule" doc -> doc -> doc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> doc -> doc
    forall doc. IsLine doc => doc -> doc
    doubleQuotes (RuleName -> doc
    forall doc. IsLine doc => RuleName -> doc
    ftext RuleName
    name)

        rule_info :: RuleOpts -> CoreRule -> SDoc
    rule_info RuleOpts
    opts CoreRule
    rule
            | Just CoreExpr
    _ <- RuleOpts
    -> InScopeEnv
    -> (Activation -> Bool)
    -> Var
    -> [CoreExpr]
    -> [Maybe Name]
    -> CoreRule
    -> Maybe CoreExpr
    matchRule RuleOpts
    opts (InScopeSet -> IdUnfoldingFun -> InScopeEnv
    ISE InScopeSet
    emptyInScopeSet (RuleCheckEnv -> IdUnfoldingFun
    rc_id_unf RuleCheckEnv
    env))
                                  Activation -> Bool
    noBlackList Var
    fn [CoreExpr]
    args [Maybe Name]
    rough_args CoreRule
    rule
            = String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "matches (which is very peculiar!)"

        rule_info RuleOpts
    _ (BuiltinRule {}) = String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "does not match"

        rule_info RuleOpts
    _ (Rule { ru_act :: CoreRule -> Activation
    ru_act = Activation
    act,
                            ru_bndrs :: CoreRule -> [Var]
    ru_bndrs = [Var]
    rule_bndrs, ru_args :: CoreRule -> [CoreExpr]
    ru_args = [CoreExpr]
    rule_args})
            | Bool -> Bool
    not (RuleCheckEnv -> Activation -> Bool
    rc_is_active RuleCheckEnv
    env Activation
    act)  = String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "active only in later phase"
            | Arity
    n_args Arity -> Arity -> Bool
    forall a. Ord a => a -> a -> Bool
    < Arity
    n_rule_args        = String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "too few arguments"
            | Arity
    n_mismatches Arity -> Arity -> Bool
    forall a. Eq a => a -> a -> Bool
    == Arity
    n_rule_args = String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "no arguments match"
            | Arity
    n_mismatches Arity -> Arity -> Bool
    forall a. Eq a => a -> a -> Bool
    == Arity
    0           = String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "all arguments match (considered individually), but rule as a whole does not"
            | Bool
    otherwise                   = String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "arguments" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> [Arity] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [Arity]
    mismatches SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "do not match (1-indexing)"
            where
              n_rule_args :: Arity
    n_rule_args  = [CoreExpr] -> Arity
    forall a. [a] -> Arity
    forall (t :: * -> *) a. Foldable t => t a -> Arity
    length [CoreExpr]
    rule_args
              n_mismatches :: Arity
    n_mismatches = [Arity] -> Arity
    forall a. [a] -> Arity
    forall (t :: * -> *) a. Foldable t => t a -> Arity
    length [Arity]
    mismatches
              mismatches :: [Arity]
    mismatches   = [Arity
    i | (CoreExpr
    rule_arg, (CoreExpr
    arg,Arity
    i)) <- [CoreExpr]
    rule_args [CoreExpr]
    -> [(CoreExpr, Arity)] -> [(CoreExpr, (CoreExpr, Arity))]
    forall a b. [a] -> [b] -> [(a, b)]
    `zip` [(CoreExpr, Arity)]
    i_args,
                                  Bool -> Bool
    not (Maybe RuleSubst -> Bool
    forall a. Maybe a -> Bool
    isJust (CoreExpr -> CoreExpr -> Maybe RuleSubst
    match_fn CoreExpr
    rule_arg CoreExpr
    arg))]

              match_fn :: CoreExpr -> CoreExpr -> Maybe RuleSubst
    match_fn CoreExpr
    rule_arg CoreExpr
    arg = RuleMatchEnv
    -> RuleSubst
    -> CoreExpr
    -> CoreExpr
    -> MCoercion
    -> Maybe RuleSubst
    match RuleMatchEnv
    renv RuleSubst
    emptyRuleSubst CoreExpr
    rule_arg CoreExpr
    arg MCoercion
    MRefl
                    where
                      renv :: RuleMatchEnv
    renv = RV { rv_lcl :: RnEnv2
    rv_lcl   = InScopeSet -> RnEnv2
    mkRnEnv2 InScopeSet
    in_scope
                                , rv_tmpls :: VarSet
    rv_tmpls = [Var] -> VarSet
    mkVarSet [Var]
    rule_bndrs
                                , rv_fltR :: Subst
    rv_fltR  = InScopeSet -> Subst
    mkEmptySubst InScopeSet
    in_scope
                                , rv_unf :: IdUnfoldingFun
    rv_unf   = RuleCheckEnv -> IdUnfoldingFun
    rc_id_unf RuleCheckEnv
    env }