    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE TypeFamilies #-}

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

    Pattern-matching bindings (HsBinds and MonoBinds)

    Handles @HsBinds@; those at the top level require different handling,
    in that the @Rec@/@NonRec@/etc structure is thrown away (whereas at
    lower levels it is preserved with @let@/@letrec@s).
    -}

    module GHC.HsToCore.Binds
       ( dsTopLHsBinds, dsLHsBinds, decomposeRuleLhs, dsSpec
       , dsHsWrapper, dsEvTerm, dsTcEvBinds, dsTcEvBinds_s, dsEvBinds
       , dsWarnOrphanRule
       )
    where

    import GHC.Prelude

    import GHC.Driver.Session
    import GHC.Driver.Config
    import qualified GHC.LanguageExtensions as LangExt
    import GHC.Unit.Module

    import {-# SOURCE #-}   GHC.HsToCore.Expr  ( dsLExpr )
    import {-# SOURCE #-}   GHC.HsToCore.Match ( matchWrapper )

    import GHC.HsToCore.Monad
    import GHC.HsToCore.Errors.Types
    import GHC.HsToCore.GuardedRHSs
    import GHC.HsToCore.Utils
    import GHC.HsToCore.Pmc ( addTyCs, pmcGRHSs )

    import GHC.Hs             -- lots of things
    import GHC.Core           -- lots of things
    import GHC.Core.SimpleOpt    ( simpleOptExpr )
    import GHC.Core.Opt.OccurAnal ( occurAnalyseExpr )
    import GHC.Core.Make
    import GHC.Core.Utils
    import GHC.Core.Opt.Arity     ( etaExpand )
    import GHC.Core.Unfold.Make
    import GHC.Core.FVs
    import GHC.Core.Predicate
    import GHC.Core.TyCon
    import GHC.Core.Type
    import GHC.Core.Coercion
    import GHC.Core.Multiplicity
    import GHC.Core.Rules
    import GHC.Core.TyCo.Compare( eqType )

    import GHC.Builtin.Names
    import GHC.Builtin.Types ( naturalTy, typeSymbolKind, charTy )

    import GHC.Tc.Types.Evidence

    import GHC.Types.Id
    import GHC.Types.Name
    import GHC.Types.Var.Set
    import GHC.Types.Var.Env
    import GHC.Types.Var( EvVar )
    import GHC.Types.SrcLoc
    import GHC.Types.Basic
    import GHC.Types.Unique.Set( nonDetEltsUniqSet )

    import GHC.Data.Maybe
    import GHC.Data.OrdList
    import GHC.Data.Graph.Directed
    import GHC.Data.Bag

    import GHC.Utils.Constants (debugIsOn)
    import GHC.Utils.Misc
    import GHC.Utils.Monad
    import GHC.Utils.Outputable
    import GHC.Utils.Panic
    import GHC.Utils.Panic.Plain

    import Control.Monad

    {-**********************************************************************
    *                                                                      *
               Desugaring a MonoBinds
    *                                                                      *
    **********************************************************************-}

    -- | Desugar top level binds, strict binds are treated like normal
    -- binds since there is no good time to force before first usage.
    dsTopLHsBinds :: LHsBinds GhcTc -> DsM (OrdList (Id,CoreExpr))
    dsTopLHsBinds :: LHsBinds GhcTc -> DsM (OrdList (EvVar, CoreExpr))
    dsTopLHsBinds LHsBinds GhcTc
    binds
         -- see Note [Strict binds checks]
      | Bool -> Bool
    not (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)) -> Bool
    forall a. Bag a -> Bool
    isEmptyBag Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
    unlifted_binds) Bool -> Bool -> Bool
    || Bool -> Bool
    not (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)) -> Bool
    forall a. Bag a -> Bool
    isEmptyBag Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
    bang_binds)
      = do { (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)
     -> IOEnv (Env DsGblEnv DsLclEnv) ())
    -> Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
    -> IOEnv (Env DsGblEnv DsLclEnv) ()
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> Bag a -> m ()
    mapBagM_ (BindsType
    -> GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)
    -> IOEnv (Env DsGblEnv DsLclEnv) ()
    forall {a}.
    BindsType
    -> GenLocated (SrcSpanAnn' a) (HsBindLR GhcTc GhcTc)
    -> IOEnv (Env DsGblEnv DsLclEnv) ()
    top_level_err BindsType
    UnliftedTypeBinds) Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
    unlifted_binds
           ; (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)
     -> IOEnv (Env DsGblEnv DsLclEnv) ())
    -> Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
    -> IOEnv (Env DsGblEnv DsLclEnv) ()
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> Bag a -> m ()
    mapBagM_ (BindsType
    -> GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)
    -> IOEnv (Env DsGblEnv DsLclEnv) ()
    forall {a}.
    BindsType
    -> GenLocated (SrcSpanAnn' a) (HsBindLR GhcTc GhcTc)
    -> IOEnv (Env DsGblEnv DsLclEnv) ()
    top_level_err BindsType
    StrictBinds)       Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
    bang_binds
           ; OrdList (EvVar, CoreExpr) -> DsM (OrdList (EvVar, CoreExpr))
    forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return OrdList (EvVar, CoreExpr)
    forall a. OrdList a
    nilOL }

      | Bool
    otherwise
      = do { ([EvVar]
    force_vars, [(EvVar, CoreExpr)]
    prs) <- LHsBinds GhcTc -> DsM ([EvVar], [(EvVar, CoreExpr)])
    dsLHsBinds LHsBinds GhcTc
    binds
           ; Bool
    -> IOEnv (Env DsGblEnv DsLclEnv) ()
    -> IOEnv (Env DsGblEnv DsLclEnv) ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    debugIsOn (IOEnv (Env DsGblEnv DsLclEnv) ()
     -> IOEnv (Env DsGblEnv DsLclEnv) ())
    -> IOEnv (Env DsGblEnv DsLclEnv) ()
    -> IOEnv (Env DsGblEnv DsLclEnv) ()
    forall a b. (a -> b) -> a -> b
    $
             do { Bool
    xstrict <- Extension -> TcRnIf DsGblEnv DsLclEnv Bool
    forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
    xoptM Extension
    LangExt.Strict
                ; Bool -> SDoc -> IOEnv (Env DsGblEnv DsLclEnv) ()
    forall (m :: * -> *).
    (HasCallStack, Applicative m) =>
    Bool -> SDoc -> m ()
    massertPpr ([EvVar] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [EvVar]
    force_vars Bool -> Bool -> Bool
    || Bool
    xstrict) (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)) -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr LHsBinds GhcTc
    Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
    binds SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ [EvVar] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [EvVar]
    force_vars) }
                  -- with -XStrict, even top-level vars are listed as force vars.

           ; OrdList (EvVar, CoreExpr) -> DsM (OrdList (EvVar, CoreExpr))
    forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([(EvVar, CoreExpr)] -> OrdList (EvVar, CoreExpr)
    forall a. [a] -> OrdList a
    toOL [(EvVar, CoreExpr)]
    prs) }

      where
        unlifted_binds :: Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
    unlifted_binds = (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc) -> Bool)
    -> Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
    -> Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
    forall a. (a -> Bool) -> Bag a -> Bag a
    filterBag (HsBindLR GhcTc GhcTc -> Bool
    isUnliftedHsBind (HsBindLR GhcTc GhcTc -> Bool)
    -> (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)
        -> HsBindLR GhcTc GhcTc)
    -> GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)
    -> HsBindLR GhcTc GhcTc
    forall l e. GenLocated l e -> e
    unLoc) LHsBinds GhcTc
    Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
    binds
        bang_binds :: Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
    bang_binds     = (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc) -> Bool)
    -> Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
    -> Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
    forall a. (a -> Bool) -> Bag a -> Bag a
    filterBag (HsBindLR GhcTc GhcTc -> Bool
    isBangedHsBind   (HsBindLR GhcTc GhcTc -> Bool)
    -> (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)
        -> HsBindLR GhcTc GhcTc)
    -> GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)
    -> HsBindLR GhcTc GhcTc
    forall l e. GenLocated l e -> e
    unLoc) LHsBinds GhcTc
    Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
    binds

        top_level_err :: BindsType
    -> GenLocated (SrcSpanAnn' a) (HsBindLR GhcTc GhcTc)
    -> IOEnv (Env DsGblEnv DsLclEnv) ()
    top_level_err BindsType
    bindsType (L SrcSpanAnn' a
    loc HsBindLR GhcTc GhcTc
    bind)
          = SrcSpan
    -> IOEnv (Env DsGblEnv DsLclEnv) ()
    -> IOEnv (Env DsGblEnv DsLclEnv) ()
    forall a. SrcSpan -> DsM a -> DsM a
    putSrcSpanDs (SrcSpanAnn' a -> SrcSpan
    forall a. SrcSpanAnn' a -> SrcSpan
    locA SrcSpanAnn' a
    loc) (IOEnv (Env DsGblEnv DsLclEnv) ()
     -> IOEnv (Env DsGblEnv DsLclEnv) ())
    -> IOEnv (Env DsGblEnv DsLclEnv) ()
    -> IOEnv (Env DsGblEnv DsLclEnv) ()
    forall a b. (a -> b) -> a -> b
    $
            DsMessage -> IOEnv (Env DsGblEnv DsLclEnv) ()
    diagnosticDs (BindsType -> HsBindLR GhcTc GhcTc -> DsMessage
    DsTopLevelBindsNotAllowed BindsType
    bindsType HsBindLR GhcTc GhcTc
    bind)

    -- | Desugar all other kind of bindings, Ids of strict binds are returned to
    -- later be forced in the binding group body, see Note [Desugar Strict binds]
    dsLHsBinds :: LHsBinds GhcTc -> DsM ([Id], [(Id,CoreExpr)])
    dsLHsBinds :: LHsBinds GhcTc -> DsM ([EvVar], [(EvVar, CoreExpr)])
    dsLHsBinds LHsBinds GhcTc
    binds
      = do { Bag ([EvVar], [(EvVar, CoreExpr)])
    ds_bs <- (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)
     -> DsM ([EvVar], [(EvVar, CoreExpr)]))
    -> Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
    -> IOEnv
         (Env DsGblEnv DsLclEnv) (Bag ([EvVar], [(EvVar, CoreExpr)]))
    forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Bag a -> m (Bag b)
    mapBagM LHsBind GhcTc -> DsM ([EvVar], [(EvVar, CoreExpr)])
    GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)
    -> DsM ([EvVar], [(EvVar, CoreExpr)])
    dsLHsBind LHsBinds GhcTc
    Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
    binds
           ; ([EvVar], [(EvVar, CoreExpr)])
    -> DsM ([EvVar], [(EvVar, CoreExpr)])
    forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((([EvVar], [(EvVar, CoreExpr)])
     -> ([EvVar], [(EvVar, CoreExpr)])
     -> ([EvVar], [(EvVar, CoreExpr)]))
    -> (([EvVar], [(EvVar, CoreExpr)])
        -> ([EvVar], [(EvVar, CoreExpr)]))
    -> ([EvVar], [(EvVar, CoreExpr)])
    -> Bag ([EvVar], [(EvVar, CoreExpr)])
    -> ([EvVar], [(EvVar, CoreExpr)])
    forall r a. (r -> r -> r) -> (a -> r) -> r -> Bag a -> r
    foldBag (\([EvVar]
    a, [(EvVar, CoreExpr)]
    a') ([EvVar]
    b, [(EvVar, CoreExpr)]
    b') -> ([EvVar]
    a [EvVar] -> [EvVar] -> [EvVar]
    forall a. [a] -> [a] -> [a]
    ++ [EvVar]
    b, [(EvVar, CoreExpr)]
    a' [(EvVar, CoreExpr)] -> [(EvVar, CoreExpr)] -> [(EvVar, CoreExpr)]
    forall a. [a] -> [a] -> [a]
    ++ [(EvVar, CoreExpr)]
    b'))
                             ([EvVar], [(EvVar, CoreExpr)]) -> ([EvVar], [(EvVar, CoreExpr)])
    forall a. a -> a
    id ([], []) Bag ([EvVar], [(EvVar, CoreExpr)])
    ds_bs) }

    ------------------------
    dsLHsBind :: LHsBind GhcTc
              -> DsM ([Id], [(Id,CoreExpr)])
    dsLHsBind :: LHsBind GhcTc -> DsM ([EvVar], [(EvVar, CoreExpr)])
    dsLHsBind (L SrcSpanAnnA
    loc HsBindLR GhcTc GhcTc
    bind) = do DynFlags
    dflags <- IOEnv (Env DsGblEnv DsLclEnv) DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
                                SrcSpan
    -> DsM ([EvVar], [(EvVar, CoreExpr)])
    -> DsM ([EvVar], [(EvVar, CoreExpr)])
    forall a. SrcSpan -> DsM a -> DsM a
    putSrcSpanDs (SrcSpanAnnA -> SrcSpan
    forall a. SrcSpanAnn' a -> SrcSpan
    locA SrcSpanAnnA
    loc) (DsM ([EvVar], [(EvVar, CoreExpr)])
     -> DsM ([EvVar], [(EvVar, CoreExpr)]))
    -> DsM ([EvVar], [(EvVar, CoreExpr)])
    -> DsM ([EvVar], [(EvVar, CoreExpr)])
    forall a b. (a -> b) -> a -> b
    $ DynFlags
    -> HsBindLR GhcTc GhcTc -> DsM ([EvVar], [(EvVar, CoreExpr)])
    dsHsBind DynFlags
    dflags HsBindLR GhcTc GhcTc
    bind

    -- | Desugar a single binding (or group of recursive binds).
    dsHsBind :: DynFlags
             -> HsBind GhcTc
             -> DsM ([Id], [(Id,CoreExpr)])
             -- ^ The Ids of strict binds, to be forced in the body of the
             -- binding group see Note [Desugar Strict binds] and all
             -- bindings and their desugared right hand sides.

    dsHsBind :: DynFlags
    -> HsBindLR GhcTc GhcTc -> DsM ([EvVar], [(EvVar, CoreExpr)])
    dsHsBind DynFlags
    dflags (VarBind { var_id :: forall idL idR. HsBindLR idL idR -> IdP idL
    var_id = IdP GhcTc
    var
                             , var_rhs :: forall idL idR. HsBindLR idL idR -> LHsExpr idR
    var_rhs = LHsExpr GhcTc
    expr })
      = do  { CoreExpr
    core_expr <- LHsExpr GhcTc -> DsM CoreExpr
    dsLExpr LHsExpr GhcTc
    expr
                    -- Dictionary bindings are always VarBinds,
                    -- so we only need do this here
            ; let core_bind :: (EvVar, CoreExpr)
    core_bind@(EvVar
    id,CoreExpr
    _) = DynFlags -> EvVar -> Bool -> Arity -> CoreExpr -> (EvVar, CoreExpr)
    makeCorePair DynFlags
    dflags IdP GhcTc
    EvVar
    var Bool
    False Arity
    0 CoreExpr
    core_expr
                  force_var :: [EvVar]
    force_var = if Extension -> DynFlags -> Bool
    xopt Extension
    LangExt.Strict DynFlags
    dflags
                              then [EvVar
    id]
                              else []
            ; ([EvVar], [(EvVar, CoreExpr)])
    -> DsM ([EvVar], [(EvVar, CoreExpr)])
    forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([EvVar]
    force_var, [(EvVar, CoreExpr)
    core_bind]) }

    dsHsBind DynFlags
    dflags b :: HsBindLR GhcTc GhcTc
    b@(FunBind { fun_id :: forall idL idR. HsBindLR idL idR -> LIdP idL
    fun_id = L SrcSpanAnnN
    loc EvVar
    fun
                               , fun_matches :: forall idL idR. HsBindLR idL idR -> MatchGroup idR (LHsExpr idR)
    fun_matches = MatchGroup GhcTc (LHsExpr GhcTc)
    matches
                               , fun_ext :: forall idL idR. HsBindLR idL idR -> XFunBind idL idR
    fun_ext = (HsWrapper
    co_fn, [CoreTickish]
    tick)
                               })
     = do   { ([EvVar]
    args, CoreExpr
    body) <- Origin
    -> Bag EvVar -> DsM ([EvVar], CoreExpr) -> DsM ([EvVar], CoreExpr)
    forall a. Origin -> Bag EvVar -> DsM a -> DsM a
    addTyCs Origin
    FromSource (HsWrapper -> Bag EvVar
    hsWrapDictBinders HsWrapper
    co_fn) (DsM ([EvVar], CoreExpr) -> DsM ([EvVar], CoreExpr))
    -> DsM ([EvVar], CoreExpr) -> DsM ([EvVar], CoreExpr)
    forall a b. (a -> b) -> a -> b
    $
                              -- FromSource might not be accurate (we don't have any
                              -- origin annotations for things in this module), but at
                              -- worst we do superfluous calls to the pattern match
                              -- oracle.
                              -- addTyCs: Add type evidence to the refinement type
                              --            predicate of the coverage checker
                              -- See Note [Long-distance information] in "GHC.HsToCore.Pmc"
                              HsMatchContext GhcRn
    -> Maybe [LHsExpr GhcTc]
    -> MatchGroup GhcTc (LHsExpr GhcTc)
    -> DsM ([EvVar], CoreExpr)
    matchWrapper (LIdP (NoGhcTc GhcRn) -> HsMatchContext GhcRn
    forall p. LIdP (NoGhcTc p) -> HsMatchContext p
    mkPrefixFunRhs (SrcSpanAnnN -> Name -> GenLocated SrcSpanAnnN Name
    forall l e. l -> e -> GenLocated l e
    L SrcSpanAnnN
    loc (EvVar -> Name
    idName EvVar
    fun))) Maybe [LHsExpr GhcTc]
    Maybe [GenLocated SrcSpanAnnA (HsExpr GhcTc)]
    forall a. Maybe a
    Nothing MatchGroup GhcTc (LHsExpr GhcTc)
    matches

            ; CoreExpr -> CoreExpr
    core_wrap <- HsWrapper -> DsM (CoreExpr -> CoreExpr)
    dsHsWrapper HsWrapper
    co_fn
            ; let body' :: CoreExpr
    body' = [CoreTickish] -> CoreExpr -> CoreExpr
    mkOptTickBox [CoreTickish]
    tick CoreExpr
    body
                  rhs :: CoreExpr
    rhs   = CoreExpr -> CoreExpr
    core_wrap ([EvVar] -> CoreExpr -> CoreExpr
    forall b. [b] -> Expr b -> Expr b
    mkLams [EvVar]
    args CoreExpr
    body')
                  core_binds :: (EvVar, CoreExpr)
    core_binds@(EvVar
    id,CoreExpr
    _) = DynFlags -> EvVar -> Bool -> Arity -> CoreExpr -> (EvVar, CoreExpr)
    makeCorePair DynFlags
    dflags EvVar
    fun Bool
    False Arity
    0 CoreExpr
    rhs
                  force_var :: [EvVar]
    force_var
                      -- Bindings are strict when -XStrict is enabled
                    | Extension -> DynFlags -> Bool
    xopt Extension
    LangExt.Strict DynFlags
    dflags
                    , MatchGroup GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)) -> Arity
    forall (id :: Pass) body. MatchGroup (GhcPass id) body -> Arity
    matchGroupArity MatchGroup GhcTc (LHsExpr GhcTc)
    MatchGroup GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    matches Arity -> Arity -> Bool
    forall a. Eq a => a -> a -> Bool
    == Arity
    0 -- no need to force lambdas
                    = [EvVar
    id]
                    | HsBindLR GhcTc GhcTc -> Bool
    isBangedHsBind HsBindLR GhcTc GhcTc
    b
                    = [EvVar
    id]
                    | Bool
    otherwise
                    = []
            ; --pprTrace "dsHsBind" (vcat [ ppr fun <+> ppr (idInlinePragma fun)
              --                          , ppr (mg_alts matches)
              --                          , ppr args, ppr core_binds, ppr body']) $
              ([EvVar], [(EvVar, CoreExpr)])
    -> DsM ([EvVar], [(EvVar, CoreExpr)])
    forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([EvVar]
    force_var, [(EvVar, CoreExpr)
    core_binds]) }

    dsHsBind DynFlags
    dflags (PatBind { pat_lhs :: forall idL idR. HsBindLR idL idR -> LPat idL
    pat_lhs = LPat GhcTc
    pat, pat_rhs :: forall idL idR. HsBindLR idL idR -> GRHSs idR (LHsExpr idR)
    pat_rhs = GRHSs GhcTc (LHsExpr GhcTc)
    grhss
                             , pat_ext :: forall idL idR. HsBindLR idL idR -> XPatBind idL idR
    pat_ext = (Type
    ty, ([CoreTickish]
    rhs_tick, [[CoreTickish]]
    var_ticks))
                             })
      = do  { NonEmpty Nablas
    rhss_nablas <- HsMatchContext GhcRn
    -> GRHSs GhcTc (LHsExpr GhcTc) -> DsM (NonEmpty Nablas)
    pmcGRHSs HsMatchContext GhcRn
    forall p. HsMatchContext p
    PatBindGuards GRHSs GhcTc (LHsExpr GhcTc)
    grhss
            ; CoreExpr
    body_expr <- GRHSs GhcTc (LHsExpr GhcTc)
    -> Type -> NonEmpty Nablas -> DsM CoreExpr
    dsGuarded GRHSs GhcTc (LHsExpr GhcTc)
    grhss Type
    ty NonEmpty Nablas
    rhss_nablas
            ; let body' :: CoreExpr
    body' = [CoreTickish] -> CoreExpr -> CoreExpr
    mkOptTickBox [CoreTickish]
    rhs_tick CoreExpr
    body_expr
                  pat' :: LPat GhcTc
    pat'  = DynFlags -> LPat GhcTc -> LPat GhcTc
    decideBangHood DynFlags
    dflags LPat GhcTc
    pat
            ; (EvVar
    force_var,[(EvVar, CoreExpr)]
    sel_binds) <- [[CoreTickish]]
    -> LPat GhcTc -> CoreExpr -> DsM (EvVar, [(EvVar, CoreExpr)])
    mkSelectorBinds [[CoreTickish]]
    var_ticks LPat GhcTc
    pat CoreExpr
    body'
              -- We silently ignore inline pragmas; no makeCorePair
              -- Not so cool, but really doesn't matter
            ; let force_var' :: [EvVar]
    force_var' = if LPat GhcTc -> Bool
    forall (p :: Pass). LPat (GhcPass p) -> Bool
    isBangedLPat LPat GhcTc
    pat'
                               then [EvVar
    force_var]
                               else []
            ; ([EvVar], [(EvVar, CoreExpr)])
    -> DsM ([EvVar], [(EvVar, CoreExpr)])
    forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([EvVar]
    force_var', [(EvVar, CoreExpr)]
    sel_binds) }

    dsHsBind
      DynFlags
    dflags
      (XHsBindsLR (AbsBinds { abs_tvs :: AbsBinds -> [EvVar]
    abs_tvs = [EvVar]
    tyvars, abs_ev_vars :: AbsBinds -> [EvVar]
    abs_ev_vars = [EvVar]
    dicts
                            , abs_exports :: AbsBinds -> [ABExport]
    abs_exports = [ABExport]
    exports
                            , abs_ev_binds :: AbsBinds -> [TcEvBinds]
    abs_ev_binds = [TcEvBinds]
    ev_binds
                            , abs_binds :: AbsBinds -> LHsBinds GhcTc
    abs_binds = LHsBinds GhcTc
    binds, abs_sig :: AbsBinds -> Bool
    abs_sig = Bool
    has_sig }))
      = do { ([EvVar], [(EvVar, CoreExpr)])
    ds_binds <- Origin
    -> Bag EvVar
    -> DsM ([EvVar], [(EvVar, CoreExpr)])
    -> DsM ([EvVar], [(EvVar, CoreExpr)])
    forall a. Origin -> Bag EvVar -> DsM a -> DsM a
    addTyCs Origin
    FromSource ([EvVar] -> Bag EvVar
    forall a. [a] -> Bag a
    listToBag [EvVar]
    dicts) (DsM ([EvVar], [(EvVar, CoreExpr)])
     -> DsM ([EvVar], [(EvVar, CoreExpr)]))
    -> DsM ([EvVar], [(EvVar, CoreExpr)])
    -> DsM ([EvVar], [(EvVar, CoreExpr)])
    forall a b. (a -> b) -> a -> b
    $
                         LHsBinds GhcTc -> DsM ([EvVar], [(EvVar, CoreExpr)])
    dsLHsBinds LHsBinds GhcTc
    binds
                 -- addTyCs: push type constraints deeper
                 --            for inner pattern match check
                 -- See Check, Note [Long-distance information]

           ; [CoreBind]
    ds_ev_binds <- [TcEvBinds] -> DsM [CoreBind]
    dsTcEvBinds_s [TcEvBinds]
    ev_binds

           -- dsAbsBinds does the hard work
           ; DynFlags
    -> [EvVar]
    -> [EvVar]
    -> [ABExport]
    -> [CoreBind]
    -> ([EvVar], [(EvVar, CoreExpr)])
    -> Bool
    -> DsM ([EvVar], [(EvVar, CoreExpr)])
    dsAbsBinds DynFlags
    dflags [EvVar]
    tyvars [EvVar]
    dicts [ABExport]
    exports [CoreBind]
    ds_ev_binds ([EvVar], [(EvVar, CoreExpr)])
    ds_binds Bool
    has_sig }

    dsHsBind DynFlags
    _ (PatSynBind{}) = String -> DsM ([EvVar], [(EvVar, CoreExpr)])
    forall a. HasCallStack => String -> a
    panic String
    "dsHsBind: PatSynBind"

    -----------------------
    dsAbsBinds :: DynFlags
               -> [TyVar] -> [EvVar] -> [ABExport]
               -> [CoreBind]                -- Desugared evidence bindings
               -> ([Id], [(Id,CoreExpr)])   -- Desugared value bindings
               -> Bool                      -- Single binding with signature
               -> DsM ([Id], [(Id,CoreExpr)])

    dsAbsBinds :: DynFlags
    -> [EvVar]
    -> [EvVar]
    -> [ABExport]
    -> [CoreBind]
    -> ([EvVar], [(EvVar, CoreExpr)])
    -> Bool
    -> DsM ([EvVar], [(EvVar, CoreExpr)])
    dsAbsBinds DynFlags
    dflags [EvVar]
    tyvars [EvVar]
    dicts [ABExport]
    exports
               [CoreBind]
    ds_ev_binds ([EvVar]
    force_vars, [(EvVar, CoreExpr)]
    bind_prs) Bool
    has_sig

        -- A very important common case: one exported variable
        -- Non-recursive bindings come through this way
        -- So do self-recursive bindings
        --    gbl_id = wrap (/\tvs \dicts. let ev_binds
        --                                 letrec bind_prs
        --                                 in lcl_id)
      | [ABExport
    export] <- [ABExport]
    exports
      , ABE { abe_poly :: ABExport -> EvVar
    abe_poly = EvVar
    global_id, abe_mono :: ABExport -> EvVar
    abe_mono = EvVar
    local_id
            , abe_wrap :: ABExport -> HsWrapper
    abe_wrap = HsWrapper
    wrap, abe_prags :: ABExport -> TcSpecPrags
    abe_prags = TcSpecPrags
    prags } <- ABExport
    export
      , Just [EvVar]
    force_vars' <- case [EvVar]
    force_vars of
                               []                  -> [EvVar] -> Maybe [EvVar]
    forall a. a -> Maybe a
    Just []
                               [EvVar
    v] | EvVar
    v EvVar -> EvVar -> Bool
    forall a. Eq a => a -> a -> Bool
    == EvVar
    local_id -> [EvVar] -> Maybe [EvVar]
    forall a. a -> Maybe a
    Just [EvVar
    global_id]
                               [EvVar]
    _                   -> Maybe [EvVar]
    forall a. Maybe a
    Nothing
           -- If there is a variable to force, it's just the
           -- single variable we are binding here
      = do { CoreExpr -> CoreExpr
    core_wrap <- HsWrapper -> DsM (CoreExpr -> CoreExpr)
    dsHsWrapper HsWrapper
    wrap -- Usually the identity

           ; let rhs :: CoreExpr
    rhs = CoreExpr -> CoreExpr
    core_wrap (CoreExpr -> CoreExpr) -> CoreExpr -> CoreExpr
    forall a b. (a -> b) -> a -> b
    $
                       [EvVar] -> CoreExpr -> CoreExpr
    forall b. [b] -> Expr b -> Expr b
    mkLams [EvVar]
    tyvars (CoreExpr -> CoreExpr) -> CoreExpr -> CoreExpr
    forall a b. (a -> b) -> a -> b
    $ [EvVar] -> CoreExpr -> CoreExpr
    forall b. [b] -> Expr b -> Expr b
    mkLams [EvVar]
    dicts (CoreExpr -> CoreExpr) -> CoreExpr -> CoreExpr
    forall a b. (a -> b) -> a -> b
    $
                       [CoreBind] -> CoreExpr -> CoreExpr
    mkCoreLets [CoreBind]
    ds_ev_binds (CoreExpr -> CoreExpr) -> CoreExpr -> CoreExpr
    forall a b. (a -> b) -> a -> b
    $
                       CoreExpr
    body

                 body :: CoreExpr
    body | Bool
    has_sig
                      , [(EvVar
    _, CoreExpr
    lrhs)] <- [(EvVar, CoreExpr)]
    bind_prs
                      = CoreExpr
    lrhs
                      | Bool
    otherwise
                      = [(EvVar, CoreExpr)] -> CoreExpr -> CoreExpr
    forall b. [(b, Expr b)] -> Expr b -> Expr b
    mkLetRec [(EvVar, CoreExpr)]
    bind_prs (EvVar -> CoreExpr
    forall b. EvVar -> Expr b
    Var EvVar
    local_id)

           ; (OrdList (EvVar, CoreExpr)
    spec_binds, [CoreRule]
    rules) <- CoreExpr
    -> TcSpecPrags -> DsM (OrdList (EvVar, CoreExpr), [CoreRule])
    dsSpecs CoreExpr
    rhs TcSpecPrags
    prags

           ; let global_id' :: EvVar
    global_id' = EvVar -> [CoreRule] -> EvVar
    addIdSpecialisations EvVar
    global_id [CoreRule]
    rules
                 main_bind :: (EvVar, CoreExpr)
    main_bind  = DynFlags -> EvVar -> Bool -> Arity -> CoreExpr -> (EvVar, CoreExpr)
    makeCorePair DynFlags
    dflags EvVar
    global_id'
                                           (TcSpecPrags -> Bool
    isDefaultMethod TcSpecPrags
    prags)
                                           ([EvVar] -> Arity
    dictArity [EvVar]
    dicts) CoreExpr
    rhs

           ; ([EvVar], [(EvVar, CoreExpr)])
    -> DsM ([EvVar], [(EvVar, CoreExpr)])
    forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([EvVar]
    force_vars', (EvVar, CoreExpr)
    main_bind (EvVar, CoreExpr) -> [(EvVar, CoreExpr)] -> [(EvVar, CoreExpr)]
    forall a. a -> [a] -> [a]
    : OrdList (EvVar, CoreExpr) -> [(EvVar, CoreExpr)]
    forall a. OrdList a -> [a]
    fromOL OrdList (EvVar, CoreExpr)
    spec_binds) }

        -- Another common case: no tyvars, no dicts
        -- In this case we can have a much simpler desugaring
        --    lcl_id{inl-prag} = rhs  -- Auxiliary binds
        --    gbl_id = lcl_id |> co   -- Main binds
      | [EvVar] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [EvVar]
    tyvars, [EvVar] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [EvVar]
    dicts
      = do { let mk_main :: ABExport -> DsM (Id, CoreExpr)
                 mk_main :: ABExport -> DsM (EvVar, CoreExpr)
    mk_main (ABE { abe_poly :: ABExport -> EvVar
    abe_poly = EvVar
    gbl_id, abe_mono :: ABExport -> EvVar
    abe_mono = EvVar
    lcl_id
                              , abe_wrap :: ABExport -> HsWrapper
    abe_wrap = HsWrapper
    wrap })
                         -- No SpecPrags (no dicts)
                         -- Can't be a default method (default methods are singletons)
                   = do { CoreExpr -> CoreExpr
    core_wrap <- HsWrapper -> DsM (CoreExpr -> CoreExpr)
    dsHsWrapper HsWrapper
    wrap
                        ; (EvVar, CoreExpr) -> DsM (EvVar, CoreExpr)
    forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ( EvVar
    gbl_id EvVar -> InlinePragma -> EvVar
    `setInlinePragma` InlinePragma
    defaultInlinePragma
                                 , CoreExpr -> CoreExpr
    core_wrap (EvVar -> CoreExpr
    forall b. EvVar -> Expr b
    Var EvVar
    lcl_id)) }

           ; [(EvVar, CoreExpr)]
    main_prs <- (ABExport -> DsM (EvVar, CoreExpr))
    -> [ABExport] -> IOEnv (Env DsGblEnv DsLclEnv) [(EvVar, CoreExpr)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM ABExport -> DsM (EvVar, CoreExpr)
    mk_main [ABExport]
    exports
           ; ([EvVar], [(EvVar, CoreExpr)])
    -> DsM ([EvVar], [(EvVar, CoreExpr)])
    forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([EvVar]
    force_vars, [CoreBind] -> [(EvVar, CoreExpr)]
    forall b. [Bind b] -> [(b, Expr b)]
    flattenBinds [CoreBind]
    ds_ev_binds
                                  [(EvVar, CoreExpr)] -> [(EvVar, CoreExpr)] -> [(EvVar, CoreExpr)]
    forall a. [a] -> [a] -> [a]
    ++ [(EvVar, CoreExpr)] -> [(EvVar, CoreExpr)]
    mk_aux_binds [(EvVar, CoreExpr)]
    bind_prs [(EvVar, CoreExpr)] -> [(EvVar, CoreExpr)] -> [(EvVar, CoreExpr)]
    forall a. [a] -> [a] -> [a]
    ++ [(EvVar, CoreExpr)]
    main_prs ) }

        -- The general case
        -- See Note [Desugaring AbsBinds]
      | Bool
    otherwise
      = do { let aux_binds :: CoreBind
    aux_binds = [(EvVar, CoreExpr)] -> CoreBind
    forall b. [(b, Expr b)] -> Bind b
    Rec ([(EvVar, CoreExpr)] -> [(EvVar, CoreExpr)]
    mk_aux_binds [(EvVar, CoreExpr)]
    bind_prs)
                    -- Monomorphic recursion possible, hence Rec

                 new_force_vars :: [EvVar]
    new_force_vars = [EvVar] -> [EvVar]
    forall {t :: * -> *}. Foldable t => t EvVar -> [EvVar]
    get_new_force_vars [EvVar]
    force_vars
                 locals :: [EvVar]
    locals       = (ABExport -> EvVar) -> [ABExport] -> [EvVar]
    forall a b. (a -> b) -> [a] -> [b]
    map ABExport -> EvVar
    abe_mono [ABExport]
    exports
                 all_locals :: [EvVar]
    all_locals   = [EvVar]
    locals [EvVar] -> [EvVar] -> [EvVar]
    forall a. [a] -> [a] -> [a]
    ++ [EvVar]
    new_force_vars
                 tup_expr :: CoreExpr
    tup_expr     = [EvVar] -> CoreExpr
    mkBigCoreVarTup [EvVar]
    all_locals
                 tup_ty :: Type
    tup_ty       = (() :: Constraint) => CoreExpr -> Type
    CoreExpr -> Type
    exprType CoreExpr
    tup_expr
           ; let poly_tup_rhs :: CoreExpr
    poly_tup_rhs = [EvVar] -> CoreExpr -> CoreExpr
    forall b. [b] -> Expr b -> Expr b
    mkLams [EvVar]
    tyvars (CoreExpr -> CoreExpr) -> CoreExpr -> CoreExpr
    forall a b. (a -> b) -> a -> b
    $ [EvVar] -> CoreExpr -> CoreExpr
    forall b. [b] -> Expr b -> Expr b
    mkLams [EvVar]
    dicts (CoreExpr -> CoreExpr) -> CoreExpr -> CoreExpr
    forall a b. (a -> b) -> a -> b
    $
                                [CoreBind] -> CoreExpr -> CoreExpr
    mkCoreLets [CoreBind]
    ds_ev_binds (CoreExpr -> CoreExpr) -> CoreExpr -> CoreExpr
    forall a b. (a -> b) -> a -> b
    $
                                CoreBind -> CoreExpr -> CoreExpr
    forall b. Bind b -> Expr b -> Expr b
    mkLet CoreBind
    aux_binds (CoreExpr -> CoreExpr) -> CoreExpr -> CoreExpr
    forall a b. (a -> b) -> a -> b
    $
                                CoreExpr
    tup_expr

           ; EvVar
    poly_tup_id <- Type -> Type -> DsM EvVar
    newSysLocalDs Type
    ManyTy ((() :: Constraint) => CoreExpr -> Type
    CoreExpr -> Type
    exprType CoreExpr
    poly_tup_rhs)

            -- Find corresponding global or make up a new one: sometimes
            -- we need to make new export to desugar strict binds, see
            -- Note [Desugar Strict binds]
           ; ([EvVar]
    exported_force_vars, [ABExport]
    extra_exports) <- [EvVar] -> DsM ([EvVar], [ABExport])
    get_exports [EvVar]
    force_vars

           ; let mk_bind :: ABExport -> IOEnv (Env DsGblEnv DsLclEnv) [(EvVar, CoreExpr)]
    mk_bind (ABE { abe_wrap :: ABExport -> HsWrapper
    abe_wrap = HsWrapper
    wrap
                              , abe_poly :: ABExport -> EvVar
    abe_poly = EvVar
    global
                              , abe_mono :: ABExport -> EvVar
    abe_mono = EvVar
    local, abe_prags :: ABExport -> TcSpecPrags
    abe_prags = TcSpecPrags
    spec_prags })
                              -- See Note [AbsBinds wrappers] in "GHC.Hs.Binds"
                    = do { EvVar
    tup_id  <- Type -> Type -> DsM EvVar
    newSysLocalDs Type
    ManyTy Type
    tup_ty
                         ; CoreExpr -> CoreExpr
    core_wrap <- HsWrapper -> DsM (CoreExpr -> CoreExpr)
    dsHsWrapper HsWrapper
    wrap
                         ; let rhs :: CoreExpr
    rhs = CoreExpr -> CoreExpr
    core_wrap (CoreExpr -> CoreExpr) -> CoreExpr -> CoreExpr
    forall a b. (a -> b) -> a -> b
    $ [EvVar] -> CoreExpr -> CoreExpr
    forall b. [b] -> Expr b -> Expr b
    mkLams [EvVar]
    tyvars (CoreExpr -> CoreExpr) -> CoreExpr -> CoreExpr
    forall a b. (a -> b) -> a -> b
    $ [EvVar] -> CoreExpr -> CoreExpr
    forall b. [b] -> Expr b -> Expr b
    mkLams [EvVar]
    dicts (CoreExpr -> CoreExpr) -> CoreExpr -> CoreExpr
    forall a b. (a -> b) -> a -> b
    $
                                     [EvVar] -> EvVar -> EvVar -> CoreExpr -> CoreExpr
    mkBigTupleSelector [EvVar]
    all_locals EvVar
    local EvVar
    tup_id (CoreExpr -> CoreExpr) -> CoreExpr -> CoreExpr
    forall a b. (a -> b) -> a -> b
    $
                                     CoreExpr -> [EvVar] -> CoreExpr
    forall b. Expr b -> [EvVar] -> Expr b
    mkVarApps (EvVar -> CoreExpr
    forall b. EvVar -> Expr b
    Var EvVar
    poly_tup_id) ([EvVar]
    tyvars [EvVar] -> [EvVar] -> [EvVar]
    forall a. [a] -> [a] -> [a]
    ++ [EvVar]
    dicts)
                               rhs_for_spec :: CoreExpr
    rhs_for_spec = CoreBind -> CoreExpr -> CoreExpr
    forall b. Bind b -> Expr b -> Expr b
    Let (EvVar -> CoreExpr -> CoreBind
    forall b. b -> Expr b -> Bind b
    NonRec EvVar
    poly_tup_id CoreExpr
    poly_tup_rhs) CoreExpr
    rhs
                         ; (OrdList (EvVar, CoreExpr)
    spec_binds, [CoreRule]
    rules) <- CoreExpr
    -> TcSpecPrags -> DsM (OrdList (EvVar, CoreExpr), [CoreRule])
    dsSpecs CoreExpr
    rhs_for_spec TcSpecPrags
    spec_prags
                         ; let global' :: EvVar
    global' = (EvVar
    global EvVar -> InlinePragma -> EvVar
    `setInlinePragma` InlinePragma
    defaultInlinePragma)
                                                 EvVar -> [CoreRule] -> EvVar
    `addIdSpecialisations` [CoreRule]
    rules
                               -- Kill the INLINE pragma because it applies to
                               -- the user written (local) function.  The global
                               -- Id is just the selector.  Hmm.
                         ; [(EvVar, CoreExpr)]
    -> IOEnv (Env DsGblEnv DsLclEnv) [(EvVar, CoreExpr)]
    forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((EvVar
    global', CoreExpr
    rhs) (EvVar, CoreExpr) -> [(EvVar, CoreExpr)] -> [(EvVar, CoreExpr)]
    forall a. a -> [a] -> [a]
    : OrdList (EvVar, CoreExpr) -> [(EvVar, CoreExpr)]
    forall a. OrdList a -> [a]
    fromOL OrdList (EvVar, CoreExpr)
    spec_binds) }

           ; [[(EvVar, CoreExpr)]]
    export_binds_s <- (ABExport -> IOEnv (Env DsGblEnv DsLclEnv) [(EvVar, CoreExpr)])
    -> [ABExport]
    -> IOEnv (Env DsGblEnv DsLclEnv) [[(EvVar, CoreExpr)]]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM ABExport -> IOEnv (Env DsGblEnv DsLclEnv) [(EvVar, CoreExpr)]
    mk_bind ([ABExport]
    exports [ABExport] -> [ABExport] -> [ABExport]
    forall a. [a] -> [a] -> [a]
    ++ [ABExport]
    extra_exports)

           ; ([EvVar], [(EvVar, CoreExpr)])
    -> DsM ([EvVar], [(EvVar, CoreExpr)])
    forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ( [EvVar]
    exported_force_vars
                    , (EvVar
    poly_tup_id, CoreExpr
    poly_tup_rhs) (EvVar, CoreExpr) -> [(EvVar, CoreExpr)] -> [(EvVar, CoreExpr)]
    forall a. a -> [a] -> [a]
    :
                       [[(EvVar, CoreExpr)]] -> [(EvVar, CoreExpr)]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[(EvVar, CoreExpr)]]
    export_binds_s) }
      where
        mk_aux_binds :: [(Id,CoreExpr)] -> [(Id,CoreExpr)]
        mk_aux_binds :: [(EvVar, CoreExpr)] -> [(EvVar, CoreExpr)]
    mk_aux_binds [(EvVar, CoreExpr)]
    bind_prs = [ DynFlags -> EvVar -> Bool -> Arity -> CoreExpr -> (EvVar, CoreExpr)
    makeCorePair DynFlags
    dflags EvVar
    lcl_w_inline Bool
    False Arity
    0 CoreExpr
    rhs
                                | (EvVar
    lcl_id, CoreExpr
    rhs) <- [(EvVar, CoreExpr)]
    bind_prs
                                , let lcl_w_inline :: EvVar
    lcl_w_inline = VarEnv EvVar -> EvVar -> Maybe EvVar
    forall a. VarEnv a -> EvVar -> Maybe a
    lookupVarEnv VarEnv EvVar
    inline_env EvVar
    lcl_id
                                                     Maybe EvVar -> EvVar -> EvVar
    forall a. Maybe a -> a -> a
    `orElse` EvVar
    lcl_id ]

        inline_env :: IdEnv Id -- Maps a monomorphic local Id to one with
                               -- the inline pragma from the source
                               -- The type checker put the inline pragma
                               -- on the *global* Id, so we need to transfer it
        inline_env :: VarEnv EvVar
    inline_env
          = [(EvVar, EvVar)] -> VarEnv EvVar
    forall a. [(EvVar, a)] -> VarEnv a
    mkVarEnv [ (EvVar
    lcl_id, EvVar -> InlinePragma -> EvVar
    setInlinePragma EvVar
    lcl_id InlinePragma
    prag)
                     | ABE { abe_mono :: ABExport -> EvVar
    abe_mono = EvVar
    lcl_id, abe_poly :: ABExport -> EvVar
    abe_poly = EvVar
    gbl_id } <- [ABExport]
    exports
                     , let prag :: InlinePragma
    prag = EvVar -> InlinePragma
    idInlinePragma EvVar
    gbl_id ]

        global_env :: IdEnv Id -- Maps local Id to its global exported Id
        global_env :: VarEnv EvVar
    global_env =
          [(EvVar, EvVar)] -> VarEnv EvVar
    forall a. [(EvVar, a)] -> VarEnv a
    mkVarEnv [ (EvVar
    local, EvVar
    global)
                   | ABE { abe_mono :: ABExport -> EvVar
    abe_mono = EvVar
    local, abe_poly :: ABExport -> EvVar
    abe_poly = EvVar
    global } <- [ABExport]
    exports
                   ]

        -- find variables that are not exported
        get_new_force_vars :: t EvVar -> [EvVar]
    get_new_force_vars t EvVar
    lcls =
          (EvVar -> [EvVar] -> [EvVar]) -> [EvVar] -> t EvVar -> [EvVar]
    forall a b. (a -> b -> b) -> b -> t a -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (\EvVar
    lcl [EvVar]
    acc -> case VarEnv EvVar -> EvVar -> Maybe EvVar
    forall a. VarEnv a -> EvVar -> Maybe a
    lookupVarEnv VarEnv EvVar
    global_env EvVar
    lcl of
                               Just EvVar
    _ -> [EvVar]
    acc
                               Maybe EvVar
    Nothing -> EvVar
    lclEvVar -> [EvVar] -> [EvVar]
    forall a. a -> [a] -> [a]
    :[EvVar]
    acc)
                [] t EvVar
    lcls

        -- find exports or make up new exports for force variables
        get_exports :: [Id] -> DsM ([Id], [ABExport])
        get_exports :: [EvVar] -> DsM ([EvVar], [ABExport])
    get_exports [EvVar]
    lcls =
          (([EvVar], [ABExport]) -> EvVar -> DsM ([EvVar], [ABExport]))
    -> ([EvVar], [ABExport]) -> [EvVar] -> DsM ([EvVar], [ABExport])
    forall (t :: * -> *) (m :: * -> *) b a.
    (Foldable t, Monad m) =>
    (b -> a -> m b) -> b -> t a -> m b
    foldM (\([EvVar]
    glbls, [ABExport]
    exports) EvVar
    lcl ->
                  case VarEnv EvVar -> EvVar -> Maybe EvVar
    forall a. VarEnv a -> EvVar -> Maybe a
    lookupVarEnv VarEnv EvVar
    global_env EvVar
    lcl of
                    Just EvVar
    glbl -> ([EvVar], [ABExport]) -> DsM ([EvVar], [ABExport])
    forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (EvVar
    glblEvVar -> [EvVar] -> [EvVar]
    forall a. a -> [a] -> [a]
    :[EvVar]
    glbls, [ABExport]
    exports)
                    Maybe EvVar
    Nothing   -> do ABExport
    export <- EvVar -> IOEnv (Env DsGblEnv DsLclEnv) ABExport
    mk_export EvVar
    lcl
                                    let glbl :: EvVar
    glbl = ABExport -> EvVar
    abe_poly ABExport
    export
                                    ([EvVar], [ABExport]) -> DsM ([EvVar], [ABExport])
    forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (EvVar
    glblEvVar -> [EvVar] -> [EvVar]
    forall a. a -> [a] -> [a]
    :[EvVar]
    glbls, ABExport
    exportABExport -> [ABExport] -> [ABExport]
    forall a. a -> [a] -> [a]
    :[ABExport]
    exports))
                ([],[]) [EvVar]
    lcls

        mk_export :: EvVar -> IOEnv (Env DsGblEnv DsLclEnv) ABExport
    mk_export EvVar
    local =
          do EvVar
    global <- Type -> Type -> DsM EvVar
    newSysLocalDs Type
    ManyTy
                         ((() :: Constraint) => CoreExpr -> Type
    CoreExpr -> Type
    exprType ([EvVar] -> CoreExpr -> CoreExpr
    forall b. [b] -> Expr b -> Expr b
    mkLams [EvVar]
    tyvars ([EvVar] -> CoreExpr -> CoreExpr
    forall b. [b] -> Expr b -> Expr b
    mkLams [EvVar]
    dicts (EvVar -> CoreExpr
    forall b. EvVar -> Expr b
    Var EvVar
    local))))
             ABExport -> IOEnv (Env DsGblEnv DsLclEnv) ABExport
    forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ABE { abe_poly :: EvVar
    abe_poly  = EvVar
    global
                         , abe_mono :: EvVar
    abe_mono  = EvVar
    local
                         , abe_wrap :: HsWrapper
    abe_wrap  = HsWrapper
    WpHole
                         , abe_prags :: TcSpecPrags
    abe_prags = [LTcSpecPrag] -> TcSpecPrags
    SpecPrags [] })

    -- | This is where we apply INLINE and INLINABLE pragmas. All we need to
    -- do is to attach the unfolding information to the Id.
    --
    -- Other decisions about whether to inline are made in
    -- `calcUnfoldingGuidance` but the decision about whether to then expose
    -- the unfolding in the interface file is made in `GHC.Iface.Tidy.addExternal`
    -- using this information.
    ------------------------
    makeCorePair :: DynFlags -> Id -> Bool -> Arity -> CoreExpr
                 -> (Id, CoreExpr)
    makeCorePair :: DynFlags -> EvVar -> Bool -> Arity -> CoreExpr -> (EvVar, CoreExpr)
    makeCorePair DynFlags
    dflags EvVar
    gbl_id Bool
    is_default_method Arity
    dict_arity CoreExpr
    rhs
      | Bool
    is_default_method    -- Default methods are *always* inlined
                             -- See Note [INLINE and default methods] in GHC.Tc.TyCl.Instance
      = (EvVar
    gbl_id EvVar -> Unfolding -> EvVar
    `setIdUnfolding` SimpleOpts -> CoreExpr -> Unfolding
    mkCompulsoryUnfolding' SimpleOpts
    simpl_opts CoreExpr
    rhs, CoreExpr
    rhs)

      | Bool
    otherwise
      = case InlinePragma -> InlineSpec
    inlinePragmaSpec InlinePragma
    inline_prag of
              InlineSpec
    NoUserInlinePrag -> (EvVar
    gbl_id, CoreExpr
    rhs)
              NoInline  {}     -> (EvVar
    gbl_id, CoreExpr
    rhs)
              Opaque    {}     -> (EvVar
    gbl_id, CoreExpr
    rhs)
              Inlinable {}     -> (EvVar
    gbl_id EvVar -> Unfolding -> EvVar
    `setIdUnfolding` Unfolding
    inlinable_unf, CoreExpr
    rhs)
              Inline    {}     -> (EvVar, CoreExpr)
    inline_pair
      where
        simpl_opts :: SimpleOpts
    simpl_opts    = DynFlags -> SimpleOpts
    initSimpleOpts DynFlags
    dflags
        inline_prag :: InlinePragma
    inline_prag   = EvVar -> InlinePragma
    idInlinePragma EvVar
    gbl_id
        inlinable_unf :: Unfolding
    inlinable_unf = SimpleOpts -> UnfoldingSource -> CoreExpr -> Unfolding
    mkInlinableUnfolding SimpleOpts
    simpl_opts UnfoldingSource
    StableUserSrc CoreExpr
    rhs
        inline_pair :: (EvVar, CoreExpr)
    inline_pair
           | Just Arity
    arity <- InlinePragma -> Maybe Arity
    inlinePragmaSat InlinePragma
    inline_prag
            -- Add an Unfolding for an INLINE (but not for NOINLINE)
            -- And eta-expand the RHS; see Note [Eta-expanding INLINE things]
           , let real_arity :: Arity
    real_arity = Arity
    dict_arity Arity -> Arity -> Arity
    forall a. Num a => a -> a -> a
    + Arity
    arity
            -- NB: The arity passed to mkInlineUnfoldingWithArity
            --     must take account of the dictionaries
           = ( EvVar
    gbl_id EvVar -> Unfolding -> EvVar
    `setIdUnfolding` SimpleOpts -> UnfoldingSource -> Arity -> CoreExpr -> Unfolding
    mkInlineUnfoldingWithArity SimpleOpts
    simpl_opts UnfoldingSource
    StableUserSrc Arity
    real_arity CoreExpr
    rhs
             , Arity -> CoreExpr -> CoreExpr
    etaExpand Arity
    real_arity CoreExpr
    rhs)

           | Bool
    otherwise
           = String -> SDoc -> (EvVar, CoreExpr) -> (EvVar, CoreExpr)
    forall a. String -> SDoc -> a -> a
    pprTrace String
    "makeCorePair: arity missing" (EvVar -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr EvVar
    gbl_id) ((EvVar, CoreExpr) -> (EvVar, CoreExpr))
    -> (EvVar, CoreExpr) -> (EvVar, CoreExpr)
    forall a b. (a -> b) -> a -> b
    $
             (EvVar
    gbl_id EvVar -> Unfolding -> EvVar
    `setIdUnfolding` SimpleOpts -> UnfoldingSource -> CoreExpr -> Unfolding
    mkInlineUnfoldingNoArity SimpleOpts
    simpl_opts UnfoldingSource
    StableUserSrc CoreExpr
    rhs, CoreExpr
    rhs)

    dictArity :: [Var] -> Arity
    -- Don't count coercion variables in arity
    dictArity :: [EvVar] -> Arity
    dictArity [EvVar]
    dicts = (EvVar -> Bool) -> [EvVar] -> Arity
    forall a. (a -> Bool) -> [a] -> Arity
    count EvVar -> Bool
    isId [EvVar]
    dicts

    {-
    Note [Desugaring AbsBinds]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~
    In the general AbsBinds case we desugar the binding to this:

           tup a (d:Num a) = let fm = ...gm...
                                 gm = ...fm...
                             in (fm,gm)
           f a d = case tup a d of { (fm,gm) -> fm }
           g a d = case tup a d of { (fm,gm) -> fm }

    Note [Rules and inlining]
    ~~~~~~~~~~~~~~~~~~~~~~~~~
    Common special case: no type or dictionary abstraction
    This is a bit less trivial than you might suppose
    The naive way would be to desugar to something like
            f_lcl = ...f_lcl...     -- The "binds" from AbsBinds
            M.f = f_lcl             -- Generated from "exports"
    But we don't want that, because if M.f isn't exported,
    it'll be inlined unconditionally at every call site (its rhs is
    trivial).  That would be ok unless it has RULES, which would
    thereby be completely lost.  Bad, bad, bad.

    Instead we want to generate
            M.f = ...f_lcl...
            f_lcl = M.f
    Now all is cool. The RULES are attached to M.f (by SimplCore),
    and f_lcl is rapidly inlined away.

    This does not happen in the same way to polymorphic binds,
    because they desugar to
            M.f = /\a. let f_lcl = ...f_lcl... in f_lcl
    Although I'm a bit worried about whether full laziness might
    float the f_lcl binding out and then inline M.f at its call site

    Note [Specialising in no-dict case]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Even if there are no tyvars or dicts, we may have specialisation pragmas.
    Class methods can generate
          AbsBinds [] [] [( ... spec-prag]
             { AbsBinds [tvs] [dicts] ...blah }
    So the overloading is in the nested AbsBinds. A good example is in GHC.Float:

      class  (Real a, Fractional a) => RealFrac a  where
        round :: (Integral b) => a -> b

      instance  RealFrac Float  where
        {-# SPECIALIZE round :: Float -> Int #-}

    The top-level AbsBinds for $cround has no tyvars or dicts (because the
    instance does not).  But the method is locally overloaded!

    Note [Abstracting over tyvars only]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    When abstracting over type variable only (not dictionaries), we don't really need to
    built a tuple and select from it, as we do in the general case. Instead we can take

            AbsBinds [a,b] [ ([a,b], fg, fl, _),
                             ([b],   gg, gl, _) ]
                    { fl = e1
                      gl = e2
                       h = e3 }

    and desugar it to

            fg = /\ab. let B in e1
            gg = /\b. let a = () in let B in S(e2)
            h  = /\ab. let B in e3

    where B is the *non-recursive* binding
            fl = fg a b
            gl = gg b
            h  = h a b    -- See (b); note shadowing!

    Notice (a) g has a different number of type variables to f, so we must
                 use the mkArbitraryType thing to fill in the gaps.
                 We use a type-let to do that.

             (b) The local variable h isn't in the exports, and rather than
                 clone a fresh copy we simply replace h by (h a b), where
                 the two h's have different types!  Shadowing happens here,
                 which looks confusing but works fine.

             (c) The result is *still* quadratic-sized if there are a lot of
                 small bindings.  So if there are more than some small
                 number (10), we filter the binding set B by the free
                 variables of the particular RHS.  Tiresome.

    Why got to this trouble?  It's a common case, and it removes the
    quadratic-sized tuple desugaring.  Less clutter, hopefully faster
    compilation, especially in a case where there are a *lot* of
    bindings.

    Note [Eta-expanding INLINE things]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Consider
       foo :: Eq a => a -> a
       {-# INLINE foo #-}
       foo x = ...

    If (foo d) ever gets floated out as a common sub-expression (which can
    happen as a result of method sharing), there's a danger that we never
    get to do the inlining, which is a Terribly Bad thing given that the
    user said "inline"!

    To avoid this we preemptively eta-expand the definition, so that foo
    has the arity with which it is declared in the source code.  In this
    example it has arity 2 (one for the Eq and one for x). Doing this
    should mean that (foo d) is a PAP and we don't share it.

    Note [Nested arities]
    ~~~~~~~~~~~~~~~~~~~~~
    For reasons that are not entirely clear, method bindings come out looking like
    this:

      AbsBinds [] [] [$cfromT <= [] fromT]
        $cfromT [InlPrag=INLINE] :: T Bool -> Bool
        { AbsBinds [] [] [fromT <= [] fromT_1]
            fromT :: T Bool -> Bool
            { fromT_1 ((TBool b)) = not b } } }

    Note the nested AbsBind.  The arity for the unfolding on $cfromT should be
    gotten from the binding for fromT_1.

    It might be better to have just one level of AbsBinds, but that requires more
    thought!

    Note [Desugar Strict binds]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~
    See https://gitlab.haskell.org/ghc/ghc/wikis/strict-pragma

    Desugaring strict variable bindings looks as follows (core below ==>)

      let !x = rhs
      in  body
    ==>
      let x = rhs
      in x `seq` body -- seq the variable

    and if it is a pattern binding the desugaring looks like

      let !pat = rhs
      in body
    ==>
      let x = rhs -- bind the rhs to a new variable
          pat = x
      in x `seq` body -- seq the new variable

    if there is no variable in the pattern desugaring looks like

      let False = rhs
      in body
    ==>
      let x = case rhs of {False -> (); _ -> error "Match failed"}
      in x `seq` body

    In order to force the Ids in the binding group they are passed around
    in the dsHsBind family of functions, and later seq'ed in GHC.HsToCore.Expr.ds_val_bind.

    Consider a recursive group like this

      letrec
         f : g = rhs[f,g]
      in <body>

    Without `Strict`, we get a translation like this:

      let t = /\a. letrec tm = rhs[fm,gm]
                          fm = case t of fm:_ -> fm
                          gm = case t of _:gm -> gm
                    in
                    (fm,gm)

      in let f = /\a. case t a of (fm,_) -> fm
      in let g = /\a. case t a of (_,gm) -> gm
      in <body>

    Here `tm` is the monomorphic binding for `rhs`.

    With `Strict`, we want to force `tm`, but NOT `fm` or `gm`.
    Alas, `tm` isn't in scope in the `in <body>` part.

    The simplest thing is to return it in the polymorphic
    tuple `t`, thus:

      let t = /\a. letrec tm = rhs[fm,gm]
                          fm = case t of fm:_ -> fm
                          gm = case t of _:gm -> gm
                    in
                    (tm, fm, gm)

      in let f = /\a. case t a of (_,fm,_) -> fm
      in let g = /\a. case t a of (_,_,gm) -> gm
      in let tm = /\a. case t a of (tm,_,_) -> tm
      in tm `seq` <body>

    See https://gitlab.haskell.org/ghc/ghc/wikis/strict-pragma for a more
    detailed explanation of the desugaring of strict bindings.

    Note [Strict binds checks]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~
    There are several checks around properly formed strict bindings. They
    all link to this Note. These checks must be here in the desugarer because
    we cannot know whether or not a type is unlifted until after zonking, due
    to representation polymorphism. These checks all used to be handled in the
    typechecker in checkStrictBinds (before Jan '17).

    We define an "unlifted bind" to be any bind that binds an unlifted id. Note that

      x :: Char
      (# True, x #) = blah

    is *not* an unlifted bind. Unlifted binds are detected by GHC.Hs.Utils.isUnliftedHsBind.

    Define a "banged bind" to have a top-level bang. Detected by GHC.Hs.Pat.isBangedHsBind.
    Define a "strict bind" to be either an unlifted bind or a banged bind.

    The restrictions are:
      1. Strict binds may not be top-level. Checked in dsTopLHsBinds.

      2. Unlifted binds must also be banged. (There is no trouble to compile an unbanged
         unlifted bind, but an unbanged bind looks lazy, and we don't want users to be
         surprised by the strictness of an unlifted bind.) Checked in first clause
         of GHC.HsToCore.Expr.ds_val_bind.

      3. Unlifted binds may not have polymorphism (#6078). (That is, no quantified type
         variables or constraints.) Checked in first clause
         of GHC.HsToCore.Expr.ds_val_bind.

      4. Unlifted binds may not be recursive. Checked in second clause of ds_val_bind.

    -}

    ------------------------
    dsSpecs :: CoreExpr     -- Its rhs
            -> TcSpecPrags
            -> DsM ( OrdList (Id,CoreExpr)  -- Binding for specialised Ids
                   , [CoreRule] )           -- Rules for the Global Ids
    -- See Note [Handling SPECIALISE pragmas] in GHC.Tc.Gen.Bind
    dsSpecs :: CoreExpr
    -> TcSpecPrags -> DsM (OrdList (EvVar, CoreExpr), [CoreRule])
    dsSpecs CoreExpr
    _ TcSpecPrags
    IsDefaultMethod = (OrdList (EvVar, CoreExpr), [CoreRule])
    -> DsM (OrdList (EvVar, CoreExpr), [CoreRule])
    forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (OrdList (EvVar, CoreExpr)
    forall a. OrdList a
    nilOL, [])
    dsSpecs CoreExpr
    poly_rhs (SpecPrags [LTcSpecPrag]
    sps)
      = do { [(OrdList (EvVar, CoreExpr), CoreRule)]
    pairs <- (LTcSpecPrag
     -> IOEnv
          (Env DsGblEnv DsLclEnv)
          (Maybe (OrdList (EvVar, CoreExpr), CoreRule)))
    -> [LTcSpecPrag]
    -> IOEnv
         (Env DsGblEnv DsLclEnv) [(OrdList (EvVar, CoreExpr), CoreRule)]
    forall (m :: * -> *) a b.
    Applicative m =>
    (a -> m (Maybe b)) -> [a] -> m [b]
    mapMaybeM (Maybe CoreExpr
    -> LTcSpecPrag
    -> IOEnv
         (Env DsGblEnv DsLclEnv)
         (Maybe (OrdList (EvVar, CoreExpr), CoreRule))
    dsSpec (CoreExpr -> Maybe CoreExpr
    forall a. a -> Maybe a
    Just CoreExpr
    poly_rhs)) [LTcSpecPrag]
    sps
           ; let ([OrdList (EvVar, CoreExpr)]
    spec_binds_s, [CoreRule]
    rules) = [(OrdList (EvVar, CoreExpr), CoreRule)]
    -> ([OrdList (EvVar, CoreExpr)], [CoreRule])
    forall a b. [(a, b)] -> ([a], [b])
    unzip [(OrdList (EvVar, CoreExpr), CoreRule)]
    pairs
           ; (OrdList (EvVar, CoreExpr), [CoreRule])
    -> DsM (OrdList (EvVar, CoreExpr), [CoreRule])
    forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([OrdList (EvVar, CoreExpr)] -> OrdList (EvVar, CoreExpr)
    forall a. [OrdList a] -> OrdList a
    concatOL [OrdList (EvVar, CoreExpr)]
    spec_binds_s, [CoreRule]
    rules) }

    dsSpec :: Maybe CoreExpr        -- Just rhs => RULE is for a local binding
                                    -- Nothing => RULE is for an imported Id
                                    --            rhs is in the Id's unfolding
           -> Located TcSpecPrag
           -> DsM (Maybe (OrdList (Id,CoreExpr), CoreRule))
    dsSpec :: Maybe CoreExpr
    -> LTcSpecPrag
    -> IOEnv
         (Env DsGblEnv DsLclEnv)
         (Maybe (OrdList (EvVar, CoreExpr), CoreRule))
    dsSpec Maybe CoreExpr
    mb_poly_rhs (L SrcSpan
    loc (SpecPrag EvVar
    poly_id HsWrapper
    spec_co InlinePragma
    spec_inl))
      | Maybe Class -> Bool
    forall a. Maybe a -> Bool
    isJust (EvVar -> Maybe Class
    isClassOpId_maybe EvVar
    poly_id)
      = SrcSpan
    -> IOEnv
         (Env DsGblEnv DsLclEnv)
         (Maybe (OrdList (EvVar, CoreExpr), CoreRule))
    -> IOEnv
         (Env DsGblEnv DsLclEnv)
         (Maybe (OrdList (EvVar, CoreExpr), CoreRule))
    forall a. SrcSpan -> DsM a -> DsM a
    putSrcSpanDs SrcSpan
    loc (IOEnv
       (Env DsGblEnv DsLclEnv)
       (Maybe (OrdList (EvVar, CoreExpr), CoreRule))
     -> IOEnv
          (Env DsGblEnv DsLclEnv)
          (Maybe (OrdList (EvVar, CoreExpr), CoreRule)))
    -> IOEnv
         (Env DsGblEnv DsLclEnv)
         (Maybe (OrdList (EvVar, CoreExpr), CoreRule))
    -> IOEnv
         (Env DsGblEnv DsLclEnv)
         (Maybe (OrdList (EvVar, CoreExpr), CoreRule))
    forall a b. (a -> b) -> a -> b
    $
        do { DsMessage -> IOEnv (Env DsGblEnv DsLclEnv) ()
    diagnosticDs (EvVar -> DsMessage
    DsUselessSpecialiseForClassMethodSelector EvVar
    poly_id)
           ; Maybe (OrdList (EvVar, CoreExpr), CoreRule)
    -> IOEnv
         (Env DsGblEnv DsLclEnv)
         (Maybe (OrdList (EvVar, CoreExpr), CoreRule))
    forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe (OrdList (EvVar, CoreExpr), CoreRule)
    forall a. Maybe a
    Nothing  }  -- There is no point in trying to specialise a class op
                                -- Moreover, classops don't (currently) have an inl_sat arity set
                                -- (it would be Just 0) and that in turn makes makeCorePair bleat

      | Bool
    no_act_spec Bool -> Bool -> Bool
    && Activation -> Bool
    isNeverActive Activation
    rule_act
      = SrcSpan
    -> IOEnv
         (Env DsGblEnv DsLclEnv)
         (Maybe (OrdList (EvVar, CoreExpr), CoreRule))
    -> IOEnv
         (Env DsGblEnv DsLclEnv)
         (Maybe (OrdList (EvVar, CoreExpr), CoreRule))
    forall a. SrcSpan -> DsM a -> DsM a
    putSrcSpanDs SrcSpan
    loc (IOEnv
       (Env DsGblEnv DsLclEnv)
       (Maybe (OrdList (EvVar, CoreExpr), CoreRule))
     -> IOEnv
          (Env DsGblEnv DsLclEnv)
          (Maybe (OrdList (EvVar, CoreExpr), CoreRule)))
    -> IOEnv
         (Env DsGblEnv DsLclEnv)
         (Maybe (OrdList (EvVar, CoreExpr), CoreRule))
    -> IOEnv
         (Env DsGblEnv DsLclEnv)
         (Maybe (OrdList (EvVar, CoreExpr), CoreRule))
    forall a b. (a -> b) -> a -> b
    $
        do { DsMessage -> IOEnv (Env DsGblEnv DsLclEnv) ()
    diagnosticDs (EvVar -> DsMessage
    DsUselessSpecialiseForNoInlineFunction EvVar
    poly_id)
           ; Maybe (OrdList (EvVar, CoreExpr), CoreRule)
    -> IOEnv
         (Env DsGblEnv DsLclEnv)
         (Maybe (OrdList (EvVar, CoreExpr), CoreRule))
    forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe (OrdList (EvVar, CoreExpr), CoreRule)
    forall a. Maybe a
    Nothing  }  -- Function is NOINLINE, and the specialisation inherits that
                                -- See Note [Activation pragmas for SPECIALISE]

      | Bool
    otherwise
      = SrcSpan
    -> IOEnv
         (Env DsGblEnv DsLclEnv)
         (Maybe (OrdList (EvVar, CoreExpr), CoreRule))
    -> IOEnv
         (Env DsGblEnv DsLclEnv)
         (Maybe (OrdList (EvVar, CoreExpr), CoreRule))
    forall a. SrcSpan -> DsM a -> DsM a
    putSrcSpanDs SrcSpan
    loc (IOEnv
       (Env DsGblEnv DsLclEnv)
       (Maybe (OrdList (EvVar, CoreExpr), CoreRule))
     -> IOEnv
          (Env DsGblEnv DsLclEnv)
          (Maybe (OrdList (EvVar, CoreExpr), CoreRule)))
    -> IOEnv
         (Env DsGblEnv DsLclEnv)
         (Maybe (OrdList (EvVar, CoreExpr), CoreRule))
    -> IOEnv
         (Env DsGblEnv DsLclEnv)
         (Maybe (OrdList (EvVar, CoreExpr), CoreRule))
    forall a b. (a -> b) -> a -> b
    $
        do { Unique
    uniq <- TcRnIf DsGblEnv DsLclEnv Unique
    forall gbl lcl. TcRnIf gbl lcl Unique
    newUnique
           ; let poly_name :: Name
    poly_name = EvVar -> Name
    idName EvVar
    poly_id
                 spec_occ :: OccName
    spec_occ  = OccName -> OccName
    mkSpecOcc (Name -> OccName
    forall a. NamedThing a => a -> OccName
    getOccName Name
    poly_name)
                 spec_name :: Name
    spec_name = Unique -> OccName -> SrcSpan -> Name
    mkInternalName Unique
    uniq OccName
    spec_occ (Name -> SrcSpan
    forall a. NamedThing a => a -> SrcSpan
    getSrcSpan Name
    poly_name)
                 ([EvVar]
    spec_bndrs, HsWrapper
    spec_app) = HsWrapper -> ([EvVar], HsWrapper)
    collectHsWrapBinders HsWrapper
    spec_co
                   -- spec_co looks like
                   --         \spec_bndrs. [] spec_args
                   -- perhaps with the body of the lambda wrapped in some WpLets
                   -- E.g. /\a \(d:Eq a). let d2 = $df d in [] (Maybe a) d2

           ; CoreExpr -> CoreExpr
    core_app <- HsWrapper -> DsM (CoreExpr -> CoreExpr)
    dsHsWrapper HsWrapper
    spec_app

           ; let ds_lhs :: CoreExpr
    ds_lhs  = CoreExpr -> CoreExpr
    core_app (EvVar -> CoreExpr
    forall b. EvVar -> Expr b
    Var EvVar
    poly_id)
                 spec_ty :: Type
    spec_ty = [EvVar] -> Type -> Type
    mkLamTypes [EvVar]
    spec_bndrs ((() :: Constraint) => CoreExpr -> Type
    CoreExpr -> Type
    exprType CoreExpr
    ds_lhs)
           ; -- pprTrace "dsRule" (vcat [ text "Id:" <+> ppr poly_id
             --                         , text "spec_co:" <+> ppr spec_co
             --                         , text "ds_rhs:" <+> ppr ds_lhs ]) $
             DynFlags
    dflags <- IOEnv (Env DsGblEnv DsLclEnv) DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
           ; case DynFlags
    -> [EvVar]
    -> CoreExpr
    -> VarSet
    -> Either DsMessage ([EvVar], EvVar, [CoreExpr])
    decomposeRuleLhs DynFlags
    dflags [EvVar]
    spec_bndrs CoreExpr
    ds_lhs ([EvVar] -> VarSet
    mkVarSet [EvVar]
    spec_bndrs) of {
               Left DsMessage
    msg -> do { DsMessage -> IOEnv (Env DsGblEnv DsLclEnv) ()
    diagnosticDs DsMessage
    msg; Maybe (OrdList (EvVar, CoreExpr), CoreRule)
    -> IOEnv
         (Env DsGblEnv DsLclEnv)
         (Maybe (OrdList (EvVar, CoreExpr), CoreRule))
    forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe (OrdList (EvVar, CoreExpr), CoreRule)
    forall a. Maybe a
    Nothing } ;
               Right ([EvVar]
    rule_bndrs, EvVar
    _fn, [CoreExpr]
    rule_lhs_args) -> do

           { Module
    this_mod <- IOEnv (Env DsGblEnv DsLclEnv) Module
    forall (m :: * -> *). HasModule m => m Module
    getModule
           ; let fn_unf :: Unfolding
    fn_unf    = EvVar -> Unfolding
    realIdUnfolding EvVar
    poly_id
                 simpl_opts :: SimpleOpts
    simpl_opts = DynFlags -> SimpleOpts
    initSimpleOpts DynFlags
    dflags
                 spec_unf :: Unfolding
    spec_unf   = SimpleOpts
    -> [EvVar]
    -> (CoreExpr -> CoreExpr)
    -> [CoreExpr]
    -> Unfolding
    -> Unfolding
    specUnfolding SimpleOpts
    simpl_opts [EvVar]
    spec_bndrs CoreExpr -> CoreExpr
    core_app [CoreExpr]
    rule_lhs_args Unfolding
    fn_unf
                 spec_id :: EvVar
    spec_id    = (() :: Constraint) => Name -> Type -> Type -> EvVar
    Name -> Type -> Type -> EvVar
    mkLocalId Name
    spec_name Type
    ManyTy Type
    spec_ty -- Specialised binding is toplevel, hence Many.
                                EvVar -> InlinePragma -> EvVar
    `setInlinePragma` InlinePragma
    inl_prag
                                EvVar -> Unfolding -> EvVar
    `setIdUnfolding`  Unfolding
    spec_unf

                 rule :: CoreRule
    rule = DynFlags
    -> Module
    -> Bool
    -> Activation
    -> SDoc
    -> EvVar
    -> [EvVar]
    -> [CoreExpr]
    -> CoreExpr
    -> CoreRule
    mkSpecRule DynFlags
    dflags Module
    this_mod Bool
    False Activation
    rule_act (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "USPEC")
                                   EvVar
    poly_id [EvVar]
    rule_bndrs [CoreExpr]
    rule_lhs_args
                                   (CoreExpr -> [EvVar] -> CoreExpr
    forall b. Expr b -> [EvVar] -> Expr b
    mkVarApps (EvVar -> CoreExpr
    forall b. EvVar -> Expr b
    Var EvVar
    spec_id) [EvVar]
    spec_bndrs)
                 spec_rhs :: CoreExpr
    spec_rhs = [EvVar] -> CoreExpr -> CoreExpr
    forall b. [b] -> Expr b -> Expr b
    mkLams [EvVar]
    spec_bndrs (CoreExpr -> CoreExpr
    core_app CoreExpr
    poly_rhs)

           ; CoreRule -> IOEnv (Env DsGblEnv DsLclEnv) ()
    dsWarnOrphanRule CoreRule
    rule

           ; Maybe (OrdList (EvVar, CoreExpr), CoreRule)
    -> IOEnv
         (Env DsGblEnv DsLclEnv)
         (Maybe (OrdList (EvVar, CoreExpr), CoreRule))
    forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((OrdList (EvVar, CoreExpr), CoreRule)
    -> Maybe (OrdList (EvVar, CoreExpr), CoreRule)
    forall a. a -> Maybe a
    Just ((EvVar, CoreExpr) -> OrdList (EvVar, CoreExpr)
    forall a. a -> OrdList a
    unitOL (EvVar
    spec_id, CoreExpr
    spec_rhs), CoreRule
    rule))
                -- NB: do *not* use makeCorePair on (spec_id,spec_rhs), because
                --     makeCorePair overwrites the unfolding, which we have
                --     just created using specUnfolding
           } } }
      where
        is_local_id :: Bool
    is_local_id = Maybe CoreExpr -> Bool
    forall a. Maybe a -> Bool
    isJust Maybe CoreExpr
    mb_poly_rhs
        poly_rhs :: CoreExpr
    poly_rhs | Just CoreExpr
    rhs <-  Maybe CoreExpr
    mb_poly_rhs
                 = CoreExpr
    rhs          -- Local Id; this is its rhs
                 | Just CoreExpr
    unfolding <- Unfolding -> Maybe CoreExpr
    maybeUnfoldingTemplate (EvVar -> Unfolding
    realIdUnfolding EvVar
    poly_id)
                 = CoreExpr
    unfolding    -- Imported Id; this is its unfolding
                                -- Use realIdUnfolding so we get the unfolding
                                -- even when it is a loop breaker.
                                -- We want to specialise recursive functions!
                 | Bool
    otherwise = String -> SDoc -> CoreExpr
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "dsImpSpecs" (EvVar -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr EvVar
    poly_id)
                                -- The type checker has checked that it *has* an unfolding

        id_inl :: InlinePragma
    id_inl = EvVar -> InlinePragma
    idInlinePragma EvVar
    poly_id

        -- See Note [Activation pragmas for SPECIALISE]
        inl_prag :: InlinePragma
    inl_prag | Bool -> Bool
    not (InlinePragma -> Bool
    isDefaultInlinePragma InlinePragma
    spec_inl)    = InlinePragma
    spec_inl
                 | Bool -> Bool
    not Bool
    is_local_id  -- See Note [Specialising imported functions]
                                     -- in OccurAnal
                 , OccInfo -> Bool
    isStrongLoopBreaker (EvVar -> OccInfo
    idOccInfo EvVar
    poly_id) = InlinePragma
    neverInlinePragma
                 | Bool
    otherwise                               = InlinePragma
    id_inl
         -- Get the INLINE pragma from SPECIALISE declaration, or,
         -- failing that, from the original Id

        spec_prag_act :: Activation
    spec_prag_act = InlinePragma -> Activation
    inlinePragmaActivation InlinePragma
    spec_inl

        -- See Note [Activation pragmas for SPECIALISE]
        -- no_act_spec is True if the user didn't write an explicit
        -- phase specification in the SPECIALISE pragma
        no_act_spec :: Bool
    no_act_spec = case InlinePragma -> InlineSpec
    inlinePragmaSpec InlinePragma
    spec_inl of
                        NoInline SourceText
    _   -> Activation -> Bool
    isNeverActive  Activation
    spec_prag_act
                        Opaque SourceText
    _     -> Activation -> Bool
    isNeverActive  Activation
    spec_prag_act
                        InlineSpec
    _            -> Activation -> Bool
    isAlwaysActive Activation
    spec_prag_act
        rule_act :: Activation
    rule_act | Bool
    no_act_spec = InlinePragma -> Activation
    inlinePragmaActivation InlinePragma
    id_inl   -- Inherit
                 | Bool
    otherwise   = Activation
    spec_prag_act                   -- Specified by user

    dsWarnOrphanRule :: CoreRule -> DsM ()
    dsWarnOrphanRule :: CoreRule -> IOEnv (Env DsGblEnv DsLclEnv) ()
    dsWarnOrphanRule CoreRule
    rule
      = Bool
    -> IOEnv (Env DsGblEnv DsLclEnv) ()
    -> IOEnv (Env DsGblEnv DsLclEnv) ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (IsOrphan -> Bool
    isOrphan (CoreRule -> IsOrphan
    ru_orphan CoreRule
    rule)) (IOEnv (Env DsGblEnv DsLclEnv) ()
     -> IOEnv (Env DsGblEnv DsLclEnv) ())
    -> IOEnv (Env DsGblEnv DsLclEnv) ()
    -> IOEnv (Env DsGblEnv DsLclEnv) ()
    forall a b. (a -> b) -> a -> b
    $
        DsMessage -> IOEnv (Env DsGblEnv DsLclEnv) ()
    diagnosticDs (CoreRule -> DsMessage
    DsOrphanRule CoreRule
    rule)

    {- Note [SPECIALISE on INLINE functions]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    We used to warn that using SPECIALISE for a function marked INLINE
    would be a no-op; but it isn't!  Especially with worker/wrapper split
    we might have
       {-# INLINE f #-}
       f :: Ord a => Int -> a -> ...
       f d x y = case x of I# x' -> $wf d x' y

    We might want to specialise 'f' so that we in turn specialise '$wf'.
    We can't even /name/ '$wf' in the source code, so we can't specialise
    it even if we wanted to.  #10721 is a case in point.

    Note [Activation pragmas for SPECIALISE]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    From a user SPECIALISE pragma for f, we generate
      a) A top-level binding    spec_fn = rhs
      b) A RULE                 f dOrd = spec_fn

    We need two pragma-like things:

    * spec_fn's inline pragma: inherited from f's inline pragma (ignoring
                               activation on SPEC), unless overridden by SPEC INLINE

    * Activation of RULE: from SPECIALISE pragma (if activation given)
                          otherwise from f's inline pragma

    This is not obvious (see #5237)!

    Examples      Rule activation   Inline prag on spec'd fn
    ---------------------------------------------------------------------
    SPEC [n] f :: ty            [n]   Always, or NOINLINE [n]
                                      copy f's prag

    NOINLINE f
    SPEC [n] f :: ty            [n]   NOINLINE
                                      copy f's prag

    NOINLINE [k] f
    SPEC [n] f :: ty            [n]   NOINLINE [k]
                                      copy f's prag

    INLINE [k] f
    SPEC [n] f :: ty            [n]   INLINE [k]
                                      copy f's prag

    SPEC INLINE [n] f :: ty     [n]   INLINE [n]
                                      (ignore INLINE prag on f,
                                      same activation for rule and spec'd fn)

    NOINLINE [k] f
    SPEC f :: ty                [n]   INLINE [k]

    ************************************************************************
    *                                                                      *
    \subsection{Adding inline pragmas}
    *                                                                      *
    ************************************************************************
    -}

    decomposeRuleLhs :: DynFlags -> [Var] -> CoreExpr
                     -> VarSet   -- Free vars of the RHS
                     -> Either DsMessage ([Var], Id, [CoreExpr])
    -- (decomposeRuleLhs bndrs lhs) takes apart the LHS of a RULE,
    -- The 'bndrs' are the quantified binders of the rules, but decomposeRuleLhs
    -- may add some extra dictionary binders (see Note [Free dictionaries on rule LHS])
    --
    -- Returns an error message if the LHS isn't of the expected shape
    -- Note [Decomposing the left-hand side of a RULE]
    decomposeRuleLhs :: DynFlags
    -> [EvVar]
    -> CoreExpr
    -> VarSet
    -> Either DsMessage ([EvVar], EvVar, [CoreExpr])
    decomposeRuleLhs DynFlags
    dflags [EvVar]
    orig_bndrs CoreExpr
    orig_lhs VarSet
    rhs_fvs
      | Var EvVar
    funId <- CoreExpr
    fun2
      , Just DataCon
    con <- EvVar -> Maybe DataCon
    isDataConId_maybe EvVar
    funId
      = DsMessage -> Either DsMessage ([EvVar], EvVar, [CoreExpr])
    forall a b. a -> Either a b
    Left (DataCon -> DsMessage
    DsRuleIgnoredDueToConstructor DataCon
    con) -- See Note [No RULES on datacons]

      | Bool
    otherwise = case CoreExpr -> [CoreExpr] -> Maybe (EvVar, [CoreExpr])
    decompose CoreExpr
    fun2 [CoreExpr]
    args2 of
            Maybe (EvVar, [CoreExpr])
    Nothing -> DsMessage -> Either DsMessage ([EvVar], EvVar, [CoreExpr])
    forall a b. a -> Either a b
    Left (CoreExpr -> CoreExpr -> DsMessage
    DsRuleLhsTooComplicated CoreExpr
    orig_lhs CoreExpr
    lhs2)
            Just (EvVar
    fn_id, [CoreExpr]
    args)
              | Bool -> Bool
    not ([EvVar] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [EvVar]
    unbound) ->
                -- Check for things unbound on LHS
                -- See Note [Unused spec binders]
                -- pprTrace "decomposeRuleLhs 1" (vcat [ text "orig_bndrs:" <+> ppr orig_bndrs
                --                                     , text "orig_lhs:" <+> ppr orig_lhs
                --                                     , text "lhs_fvs:" <+> ppr lhs_fvs
                --                                     , text "rhs_fvs:" <+> ppr rhs_fvs
                --                                     , text "unbound:" <+> ppr unbound
                --                                     ]) $
                DsMessage -> Either DsMessage ([EvVar], EvVar, [CoreExpr])
    forall a b. a -> Either a b
    Left ([EvVar] -> [EvVar] -> CoreExpr -> CoreExpr -> DsMessage
    DsRuleBindersNotBound [EvVar]
    unbound [EvVar]
    orig_bndrs CoreExpr
    orig_lhs CoreExpr
    lhs2)
              | Bool
    otherwise ->
                -- pprTrace "decomposeRuleLhs 2" (vcat [ text "orig_bndrs:" <+> ppr orig_bndrs
                --                                    , text "orig_lhs:" <+> ppr orig_lhs
                --                                    , text "lhs1:"     <+> ppr lhs1
                --                                    , text "extra_bndrs:" <+> ppr extra_bndrs
                --                                    , text "fn_id:" <+> ppr fn_id
                --                                    , text "args:"   <+> ppr args
                --                                    , text "args fvs:" <+> ppr (exprsFreeVarsList args)
                --                                    ]) $
                ([EvVar], EvVar, [CoreExpr])
    -> Either DsMessage ([EvVar], EvVar, [CoreExpr])
    forall a b. b -> Either a b
    Right ([EvVar]
    trimmed_bndrs [EvVar] -> [EvVar] -> [EvVar]
    forall a. [a] -> [a] -> [a]
    ++ [EvVar]
    extra_bndrs, EvVar
    fn_id, [CoreExpr]
    args)

              where -- See Note [Variables unbound on the LHS]
                    lhs_fvs :: VarSet
    lhs_fvs = [CoreExpr] -> VarSet
    exprsFreeVars [CoreExpr]
    args
                    all_fvs :: VarSet
    all_fvs       = VarSet
    lhs_fvs VarSet -> VarSet -> VarSet
    `unionVarSet` VarSet
    rhs_fvs
                    trimmed_bndrs :: [EvVar]
    trimmed_bndrs = (EvVar -> Bool) -> [EvVar] -> [EvVar]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (EvVar -> VarSet -> Bool
    `elemVarSet` VarSet
    all_fvs) [EvVar]
    orig_bndrs
                    unbound :: [EvVar]
    unbound       = (EvVar -> Bool) -> [EvVar] -> [EvVar]
    forall a. (a -> Bool) -> [a] -> [a]
    filterOut (EvVar -> VarSet -> Bool
    `elemVarSet` VarSet
    lhs_fvs) [EvVar]
    trimmed_bndrs
                        -- Needed on RHS but not bound on LHS

                    -- Add extra tyvar binders: Note [Free tyvars on rule LHS]
                    -- and extra dict binders: Note [Free dictionaries on rule LHS]
                    extra_bndrs :: [EvVar]
    extra_bndrs = [EvVar] -> [EvVar]
    scopedSort [EvVar]
    extra_tvs [EvVar] -> [EvVar] -> [EvVar]
    forall a. [a] -> [a] -> [a]
    ++ [EvVar]
    extra_dicts
                      where
                        extra_tvs :: [EvVar]
    extra_tvs   = [ EvVar
    v | EvVar
    v <- [EvVar]
    extra_vars, EvVar -> Bool
    isTyVar EvVar
    v ]
                    extra_dicts :: [EvVar]
    extra_dicts =
                      [ (() :: Constraint) => Name -> Type -> Type -> EvVar
    Name -> Type -> Type -> EvVar
    mkLocalId (Name -> Name
    localiseName (EvVar -> Name
    idName EvVar
    d)) Type
    ManyTy (EvVar -> Type
    idType EvVar
    d)
                      | EvVar
    d <- [EvVar]
    extra_vars, EvVar -> Bool
    isDictId EvVar
    d ]
                    extra_vars :: [EvVar]
    extra_vars  =
                      [ EvVar
    v
                      | EvVar
    v <- [CoreExpr] -> [EvVar]
    exprsFreeVarsList [CoreExpr]
    args
                      , Bool -> Bool
    not (EvVar
    v EvVar -> VarSet -> Bool
    `elemVarSet` VarSet
    orig_bndr_set)
                      , Bool -> Bool
    not (EvVar
    v EvVar -> EvVar -> Bool
    forall a. Eq a => a -> a -> Bool
    == EvVar
    fn_id) ]
                        -- fn_id: do not quantify over the function itself, which may
                        -- itself be a dictionary (in pathological cases, #10251)

     where
       simpl_opts :: SimpleOpts
    simpl_opts    = DynFlags -> SimpleOpts
    initSimpleOpts DynFlags
    dflags
       orig_bndr_set :: VarSet
    orig_bndr_set = [EvVar] -> VarSet
    mkVarSet [EvVar]
    orig_bndrs

       lhs1 :: CoreExpr
    lhs1         = CoreExpr -> CoreExpr
    drop_dicts CoreExpr
    orig_lhs
       lhs2 :: CoreExpr
    lhs2         = (() :: Constraint) => SimpleOpts -> CoreExpr -> CoreExpr
    SimpleOpts -> CoreExpr -> CoreExpr
    simpleOptExpr SimpleOpts
    simpl_opts CoreExpr
    lhs1  -- See Note [Simplify rule LHS]
       (CoreExpr
    fun2,[CoreExpr]
    args2) = CoreExpr -> (CoreExpr, [CoreExpr])
    forall b. Expr b -> (Expr b, [Expr b])
    collectArgs CoreExpr
    lhs2

       decompose :: CoreExpr -> [CoreExpr] -> Maybe (EvVar, [CoreExpr])
    decompose (Var EvVar
    fn_id) [CoreExpr]
    args
          | Bool -> Bool
    not (EvVar
    fn_id EvVar -> VarSet -> Bool
    `elemVarSet` VarSet
    orig_bndr_set)
          = (EvVar, [CoreExpr]) -> Maybe (EvVar, [CoreExpr])
    forall a. a -> Maybe a
    Just (EvVar
    fn_id, [CoreExpr]
    args)

       decompose CoreExpr
    _ [CoreExpr]
    _ = Maybe (EvVar, [CoreExpr])
    forall a. Maybe a
    Nothing

       drop_dicts :: CoreExpr -> CoreExpr
       drop_dicts :: CoreExpr -> CoreExpr
    drop_dicts CoreExpr
    e
           = VarSet -> [(EvVar, CoreExpr)] -> CoreExpr -> CoreExpr
    wrap_lets VarSet
    needed [(EvVar, CoreExpr)]
    bnds CoreExpr
    body
         where
           needed :: VarSet
    needed = VarSet
    orig_bndr_set VarSet -> VarSet -> VarSet
    `minusVarSet` CoreExpr -> VarSet
    exprFreeVars CoreExpr
    body
           ([(EvVar, CoreExpr)]
    bnds, CoreExpr
    body) = CoreExpr -> ([(EvVar, CoreExpr)], CoreExpr)
    split_lets (CoreExpr -> CoreExpr
    occurAnalyseExpr CoreExpr
    e)
               -- The occurAnalyseExpr drops dead bindings which is
               -- crucial to ensure that every binding is used later;
               -- which in turn makes wrap_lets work right

       split_lets :: CoreExpr -> ([(DictId,CoreExpr)], CoreExpr)
       split_lets :: CoreExpr -> ([(EvVar, CoreExpr)], CoreExpr)
    split_lets (Let (NonRec EvVar
    d CoreExpr
    r) CoreExpr
    body)
         | EvVar -> Bool
    isDictId EvVar
    d
         = ((EvVar
    d,CoreExpr
    r)(EvVar, CoreExpr) -> [(EvVar, CoreExpr)] -> [(EvVar, CoreExpr)]
    forall a. a -> [a] -> [a]
    :[(EvVar, CoreExpr)]
    bs, CoreExpr
    body')
         where ([(EvVar, CoreExpr)]
    bs, CoreExpr
    body') = CoreExpr -> ([(EvVar, CoreExpr)], CoreExpr)
    split_lets CoreExpr
    body

        -- handle "unlifted lets" too, needed for "map/coerce"
       split_lets (Case CoreExpr
    r EvVar
    d Type
    _ [Alt AltCon
    DEFAULT [EvVar]
    _ CoreExpr
    body])
         | EvVar -> Bool
    isCoVar EvVar
    d
         = ((EvVar
    d,CoreExpr
    r)(EvVar, CoreExpr) -> [(EvVar, CoreExpr)] -> [(EvVar, CoreExpr)]
    forall a. a -> [a] -> [a]
    :[(EvVar, CoreExpr)]
    bs, CoreExpr
    body')
         where ([(EvVar, CoreExpr)]
    bs, CoreExpr
    body') = CoreExpr -> ([(EvVar, CoreExpr)], CoreExpr)
    split_lets CoreExpr
    body

       split_lets CoreExpr
    e = ([], CoreExpr
    e)

       wrap_lets :: VarSet -> [(DictId,CoreExpr)] -> CoreExpr -> CoreExpr
       wrap_lets :: VarSet -> [(EvVar, CoreExpr)] -> CoreExpr -> CoreExpr
    wrap_lets VarSet
    _ [] CoreExpr
    body = CoreExpr
    body
       wrap_lets VarSet
    needed ((EvVar
    d, CoreExpr
    r) : [(EvVar, CoreExpr)]
    bs) CoreExpr
    body
         | VarSet
    rhs_fvs VarSet -> VarSet -> Bool
    `intersectsVarSet` VarSet
    needed = CoreBind -> CoreExpr -> CoreExpr
    mkCoreLet (EvVar -> CoreExpr -> CoreBind
    forall b. b -> Expr b -> Bind b
    NonRec EvVar
    d CoreExpr
    r) (VarSet -> [(EvVar, CoreExpr)] -> CoreExpr -> CoreExpr
    wrap_lets VarSet
    needed' [(EvVar, CoreExpr)]
    bs CoreExpr
    body)
         | Bool
    otherwise                         = VarSet -> [(EvVar, CoreExpr)] -> CoreExpr -> CoreExpr
    wrap_lets VarSet
    needed [(EvVar, CoreExpr)]
    bs CoreExpr
    body
         where
           rhs_fvs :: VarSet
    rhs_fvs = CoreExpr -> VarSet
    exprFreeVars CoreExpr
    r
           needed' :: VarSet
    needed' = (VarSet
    needed VarSet -> VarSet -> VarSet
    `minusVarSet` VarSet
    rhs_fvs) VarSet -> EvVar -> VarSet
    `extendVarSet` EvVar
    d

    {-
    Note [Variables unbound on the LHS]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    We obviously want to complain about
       RULE   forall x. f True = not x
    because the forall'd variable `x` is not bound on the LHS.

    It can be a bit delicate when dictionaries are involved.
    Consider #22471
      {-# RULES "foo" forall (f :: forall a. [a] -> Int).
                      foo (\xs. 1 + f xs) = 2 + foo f #-}

    We get two dicts on the LHS, one from `1` and one from `+`.
    For reasons described in Note [The SimplifyRule Plan] in
    GHC.Tc.Gen.Rule, we quantify separately over those dictionaries:
       forall f (d1::Num Int) (d2 :: Num Int).
       foo (\xs. (+) d1 (fromInteger d2 1) xs) = ...

    Now the desugarer shortcircuits (fromInteger d2 1) to (I# 1); so d2 is
    not mentioned at all (on LHS or RHS)! We don't want to complain about
    and unbound d2.  Hence the trimmed_bndrs.

    Note [Decomposing the left-hand side of a RULE]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    There are several things going on here.
    * drop_dicts: see Note [Drop dictionary bindings on rule LHS]
    * simpleOptExpr: see Note [Simplify rule LHS]
    * extra_dict_bndrs: see Note [Free dictionaries on rule LHS]

    Note [Free tyvars on rule LHS]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Consider
      data T a = C

      foo :: T a -> Int
      foo C = 1

      {-# RULES "myrule"  foo C = 1 #-}

    After type checking the LHS becomes (foo alpha (C alpha)), where alpha
    is an unbound meta-tyvar.  The zonker in GHC.Tc.Utils.Zonk is careful not to
    turn the free alpha into Any (as it usually does).  Instead it turns it
    into a TyVar 'a'.  See Note [Zonking the LHS of a RULE] in "GHC.Tc.Utils.Zonk".

    Now we must quantify over that 'a'.  It's /really/ inconvenient to do that
    in the zonker, because the HsExpr data type is very large.  But it's /easy/
    to do it here in the desugarer.

    Moreover, we have to do something rather similar for dictionaries;
    see Note [Free dictionaries on rule LHS].   So that's why we look for
    type variables free on the LHS, and quantify over them.

    This relies on there not being any in-scope tyvars, which is true for
    user-defined RULEs, which are always top-level.

    Note [Free dictionaries on rule LHS]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    When the LHS of a specialisation rule, (/\as\ds. f es) has a free dict,
    which is presumably in scope at the function definition site, we can quantify
    over it too.  *Any* dict with that type will do.

    So for example when you have
            f :: Eq a => a -> a
            f = <rhs>
            ... SPECIALISE f :: Int -> Int ...

    Then we get the SpecPrag
            SpecPrag (f Int dInt)

    And from that we want the rule

            RULE forall dInt. f Int dInt = f_spec
            f_spec = let f = <rhs> in f Int dInt

    But be careful!  That dInt might be GHC.Base.$fOrdInt, which is an External
    Name, and you can't bind them in a lambda or forall without getting things
    confused.   Likewise it might have a stable unfolding or something, which would be
    utterly bogus. So we really make a fresh Id, with the same unique and type
    as the old one, but with an Internal name and no IdInfo.

    Note [Drop dictionary bindings on rule LHS]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    drop_dicts drops dictionary bindings on the LHS where possible.
       E.g.  let d:Eq [Int] = $fEqList $fEqInt in f d
         --> f d
       Reasoning here is that there is only one d:Eq [Int], and so we can
       quantify over it. That makes 'd' free in the LHS, but that is later
       picked up by extra_dict_bndrs (see Note [Unused spec binders]).

       NB 1: We can only drop the binding if the RHS doesn't bind
             one of the orig_bndrs, which we assume occur on RHS.
             Example
                f :: (Eq a) => b -> a -> a
                {-# SPECIALISE f :: Eq a => b -> [a] -> [a] #-}
             Here we want to end up with
                RULE forall d:Eq a.  f ($dfEqList d) = f_spec d
             Of course, the ($dfEqlist d) in the pattern makes it less likely
             to match, but there is no other way to get d:Eq a

       NB 2: We do drop_dicts *before* simplOptEpxr, so that we expect all
             the evidence bindings to be wrapped around the outside of the
             LHS.  (After simplOptExpr they'll usually have been inlined.)
             dsHsWrapper does dependency analysis, so that civilised ones
             will be simple NonRec bindings.  We don't handle recursive
             dictionaries!

        NB3: In the common case of a non-overloaded, but perhaps-polymorphic
             specialisation, we don't need to bind *any* dictionaries for use
             in the RHS. For example (#8331)
                 {-# SPECIALIZE INLINE useAbstractMonad :: ReaderST s Int #-}
                 useAbstractMonad :: MonadAbstractIOST m => m Int
             Here, deriving (MonadAbstractIOST (ReaderST s)) is a lot of code
             but the RHS uses no dictionaries, so we want to end up with
                 RULE forall s (d :: MonadAbstractIOST (ReaderT s)).
                    useAbstractMonad (ReaderT s) d = $suseAbstractMonad s

       #8848 is a good example of where there are some interesting
       dictionary bindings to discard.

    The drop_dicts algorithm is based on these observations:

      * Given (let d = rhs in e) where d is a DictId,
        matching 'e' will bind e's free variables.

      * So we want to keep the binding if one of the needed variables (for
        which we need a binding) is in fv(rhs) but not already in fv(e).

      * The "needed variables" are simply the orig_bndrs.  Consider
           f :: (Eq a, Show b) => a -> b -> String
           ... SPECIALISE f :: (Show b) => Int -> b -> String ...
        Then orig_bndrs includes the *quantified* dictionaries of the type
        namely (dsb::Show b), but not the one for Eq Int

    So we work inside out, applying the above criterion at each step.

    Note [Simplify rule LHS]
    ~~~~~~~~~~~~~~~~~~~~~~~~
    simplOptExpr occurrence-analyses and simplifies the LHS:

       (a) Inline any remaining dictionary bindings (which hopefully
           occur just once)

       (b) Substitute trivial lets, so that they don't get in the way.
           Note that we substitute the function too; we might
           have this as a LHS:  let f71 = M.f Int in f71

       (c) Do eta reduction.  To see why, consider the fold/build rule,
           which without simplification looked like:
              fold k z (build (/\a. g a))  ==>  ...
           This doesn't match unless you do eta reduction on the build argument.
           Similarly for a LHS like
             augment g (build h)
           we do not want to get
             augment (\a. g a) (build h)
           otherwise we don't match when given an argument like
              augment (\a. h a a) (build h)

    Note [Unused spec binders]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~
    Consider
            f :: a -> a
            ... SPECIALISE f :: Eq a => a -> a ...
    It's true that this *is* a more specialised type, but the rule
    we get is something like this:
            f_spec d = f
            RULE: f = f_spec d
    Note that the rule is bogus, because it mentions a 'd' that is
    not bound on the LHS!  But it's a silly specialisation anyway, because
    the constraint is unused.  We could bind 'd' to (error "unused")
    but it seems better to reject the program because it's almost certainly
    a mistake.  That's what the isDeadBinder call detects.

    Note [No RULES on datacons]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~

    Previously, `RULES` like

        "JustNothing" forall x . Just x = Nothing

    were allowed. Simon Peyton Jones says this seems to have been a
    mistake, that such rules have never been supported intentionally,
    and that he doesn't know if they can break in horrible ways.
    Furthermore, Ben Gamari and Reid Barton are considering trying to
    detect the presence of "static data" that the simplifier doesn't
    need to traverse at all. Such rules do not play well with that.
    So for now, we ban them altogether as requested by #13290. See also #7398.

    ************************************************************************
    *                                                                      *
                    Desugaring evidence
    *                                                                      *
    ************************************************************************

    Note [Desugaring WpFun]
    ~~~~~~~~~~~~~~~~~~~~~~~
    See comments on WpFun in GHC.Tc.Types.Evidence for what WpFun means.
    Roughly:

      (WpFun w_arg w_res)[ e ] = \x. w_res[ e w_arg[x] ]

    This eta-expansion risk duplicating work, if `e` is not in HNF.
    At one stage I thought we could avoid that by desugaring to
          let f = e in \x. w_res[ f w_arg[x] ]
    But that /fundamentally/ doesn't work, because `w_res` may bind
    evidence that is used in `e`.

    This question arose when thinking about deep subsumption; see
    https://github.com/ghc-proposals/ghc-proposals/pull/287#issuecomment-1125419649).
    -}

    dsHsWrapper :: HsWrapper -> DsM (CoreExpr -> CoreExpr)
    dsHsWrapper :: HsWrapper -> DsM (CoreExpr -> CoreExpr)
    dsHsWrapper HsWrapper
    WpHole            = (CoreExpr -> CoreExpr) -> DsM (CoreExpr -> CoreExpr)
    forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((CoreExpr -> CoreExpr) -> DsM (CoreExpr -> CoreExpr))
    -> (CoreExpr -> CoreExpr) -> DsM (CoreExpr -> CoreExpr)
    forall a b. (a -> b) -> a -> b
    $ \CoreExpr
    e -> CoreExpr
    e
    dsHsWrapper (WpTyApp Type
    ty)      = (CoreExpr -> CoreExpr) -> DsM (CoreExpr -> CoreExpr)
    forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((CoreExpr -> CoreExpr) -> DsM (CoreExpr -> CoreExpr))
    -> (CoreExpr -> CoreExpr) -> DsM (CoreExpr -> CoreExpr)
    forall a b. (a -> b) -> a -> b
    $ \CoreExpr
    e -> CoreExpr -> CoreExpr -> CoreExpr
    forall b. Expr b -> Expr b -> Expr b
    App CoreExpr
    e (Type -> CoreExpr
    forall b. Type -> Expr b
    Type Type
    ty)
    dsHsWrapper (WpEvLam EvVar
    ev)      = (CoreExpr -> CoreExpr) -> DsM (CoreExpr -> CoreExpr)
    forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((CoreExpr -> CoreExpr) -> DsM (CoreExpr -> CoreExpr))
    -> (CoreExpr -> CoreExpr) -> DsM (CoreExpr -> CoreExpr)
    forall a b. (a -> b) -> a -> b
    $ EvVar -> CoreExpr -> CoreExpr
    forall b. b -> Expr b -> Expr b
    Lam EvVar
    ev
    dsHsWrapper (WpTyLam EvVar
    tv)      = (CoreExpr -> CoreExpr) -> DsM (CoreExpr -> CoreExpr)
    forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((CoreExpr -> CoreExpr) -> DsM (CoreExpr -> CoreExpr))
    -> (CoreExpr -> CoreExpr) -> DsM (CoreExpr -> CoreExpr)
    forall a b. (a -> b) -> a -> b
    $ EvVar -> CoreExpr -> CoreExpr
    forall b. b -> Expr b -> Expr b
    Lam EvVar
    tv
    dsHsWrapper (WpLet TcEvBinds
    ev_binds)  = do { [CoreBind]
    bs <- TcEvBinds -> DsM [CoreBind]
    dsTcEvBinds TcEvBinds
    ev_binds
                                       ; (CoreExpr -> CoreExpr) -> DsM (CoreExpr -> CoreExpr)
    forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([CoreBind] -> CoreExpr -> CoreExpr
    mkCoreLets [CoreBind]
    bs) }
    dsHsWrapper (WpCompose HsWrapper
    c1 HsWrapper
    c2) = do { CoreExpr -> CoreExpr
    w1 <- HsWrapper -> DsM (CoreExpr -> CoreExpr)
    dsHsWrapper HsWrapper
    c1
                                       ; CoreExpr -> CoreExpr
    w2 <- HsWrapper -> DsM (CoreExpr -> CoreExpr)
    dsHsWrapper HsWrapper
    c2
                                       ; (CoreExpr -> CoreExpr) -> DsM (CoreExpr -> CoreExpr)
    forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CoreExpr -> CoreExpr
    w1 (CoreExpr -> CoreExpr)
    -> (CoreExpr -> CoreExpr) -> CoreExpr -> CoreExpr
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CoreExpr -> CoreExpr
    w2) }
    dsHsWrapper (WpFun HsWrapper
    c1 HsWrapper
    c2 (Scaled Type
    w Type
    t1))  -- See Note [Desugaring WpFun]
                                  = do { EvVar
    x <- Type -> Type -> DsM EvVar
    newSysLocalDs Type
    w Type
    t1
                                       ; CoreExpr -> CoreExpr
    w1 <- HsWrapper -> DsM (CoreExpr -> CoreExpr)
    dsHsWrapper HsWrapper
    c1
                                       ; CoreExpr -> CoreExpr
    w2 <- HsWrapper -> DsM (CoreExpr -> CoreExpr)
    dsHsWrapper HsWrapper
    c2
                                       ; let app :: CoreExpr -> CoreExpr -> CoreExpr
    app CoreExpr
    f CoreExpr
    a = SDoc -> CoreExpr -> CoreExpr -> CoreExpr
    mkCoreAppDs (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "dsHsWrapper") CoreExpr
    f CoreExpr
    a
                                             arg :: CoreExpr
    arg     = CoreExpr -> CoreExpr
    w1 (EvVar -> CoreExpr
    forall b. EvVar -> Expr b
    Var EvVar
    x)
                                       ; (CoreExpr -> CoreExpr) -> DsM (CoreExpr -> CoreExpr)
    forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (\CoreExpr
    e -> (EvVar -> CoreExpr -> CoreExpr
    forall b. b -> Expr b -> Expr b
    Lam EvVar
    x (CoreExpr -> CoreExpr
    w2 (CoreExpr -> CoreExpr -> CoreExpr
    app CoreExpr
    e CoreExpr
    arg)))) }
    dsHsWrapper (WpCast TcCoercionR
    co)       = Bool -> DsM (CoreExpr -> CoreExpr) -> DsM (CoreExpr -> CoreExpr)
    forall a. HasCallStack => Bool -> a -> a
    assert (TcCoercionR -> Role
    coercionRole TcCoercionR
    co Role -> Role -> Bool
    forall a. Eq a => a -> a -> Bool
    == Role
    Representational) (DsM (CoreExpr -> CoreExpr) -> DsM (CoreExpr -> CoreExpr))
    -> DsM (CoreExpr -> CoreExpr) -> DsM (CoreExpr -> CoreExpr)
    forall a b. (a -> b) -> a -> b
    $
                                    (CoreExpr -> CoreExpr) -> DsM (CoreExpr -> CoreExpr)
    forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((CoreExpr -> CoreExpr) -> DsM (CoreExpr -> CoreExpr))
    -> (CoreExpr -> CoreExpr) -> DsM (CoreExpr -> CoreExpr)
    forall a b. (a -> b) -> a -> b
    $ \CoreExpr
    e -> CoreExpr -> TcCoercionR -> CoreExpr
    mkCastDs CoreExpr
    e TcCoercionR
    co
    dsHsWrapper (WpEvApp EvTerm
    tm)      = do { CoreExpr
    core_tm <- EvTerm -> DsM CoreExpr
    dsEvTerm EvTerm
    tm
                                       ; (CoreExpr -> CoreExpr) -> DsM (CoreExpr -> CoreExpr)
    forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (\CoreExpr
    e -> CoreExpr -> CoreExpr -> CoreExpr
    forall b. Expr b -> Expr b -> Expr b
    App CoreExpr
    e CoreExpr
    core_tm) }
      -- See Note [Wrapper returned from tcSubMult] in GHC.Tc.Utils.Unify.
    dsHsWrapper (WpMultCoercion TcCoercionR
    co) = do { Bool
    -> IOEnv (Env DsGblEnv DsLclEnv) ()
    -> IOEnv (Env DsGblEnv DsLclEnv) ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Bool -> Bool
    not (TcCoercionR -> Bool
    isReflexiveCo TcCoercionR
    co)) (IOEnv (Env DsGblEnv DsLclEnv) ()
     -> IOEnv (Env DsGblEnv DsLclEnv) ())
    -> IOEnv (Env DsGblEnv DsLclEnv) ()
    -> IOEnv (Env DsGblEnv DsLclEnv) ()
    forall a b. (a -> b) -> a -> b
    $
                                             DsMessage -> IOEnv (Env DsGblEnv DsLclEnv) ()
    diagnosticDs DsMessage
    DsMultiplicityCoercionsNotSupported
                                         ; (CoreExpr -> CoreExpr) -> DsM (CoreExpr -> CoreExpr)
    forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((CoreExpr -> CoreExpr) -> DsM (CoreExpr -> CoreExpr))
    -> (CoreExpr -> CoreExpr) -> DsM (CoreExpr -> CoreExpr)
    forall a b. (a -> b) -> a -> b
    $ \CoreExpr
    e -> CoreExpr
    e }
    --------------------------------------
    dsTcEvBinds_s :: [TcEvBinds] -> DsM [CoreBind]
    dsTcEvBinds_s :: [TcEvBinds] -> DsM [CoreBind]
    dsTcEvBinds_s []       = [CoreBind] -> DsM [CoreBind]
    forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
    dsTcEvBinds_s (TcEvBinds
    b:[TcEvBinds]
    rest) = Bool -> DsM [CoreBind] -> DsM [CoreBind]
    forall a. HasCallStack => Bool -> a -> a
    assert ([TcEvBinds] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [TcEvBinds]
    rest) (DsM [CoreBind] -> DsM [CoreBind])
    -> DsM [CoreBind] -> DsM [CoreBind]
    forall a b. (a -> b) -> a -> b
    $  -- Zonker ensures null
                             TcEvBinds -> DsM [CoreBind]
    dsTcEvBinds TcEvBinds
    b

    dsTcEvBinds :: TcEvBinds -> DsM [CoreBind]
    dsTcEvBinds :: TcEvBinds -> DsM [CoreBind]
    dsTcEvBinds (TcEvBinds {}) = String -> DsM [CoreBind]
    forall a. HasCallStack => String -> a
    panic String
    "dsEvBinds"    -- Zonker has got rid of this
    dsTcEvBinds (EvBinds Bag EvBind
    bs)   = Bag EvBind -> DsM [CoreBind]
    dsEvBinds Bag EvBind
    bs

    dsEvBinds :: Bag EvBind -> DsM [CoreBind]
    dsEvBinds :: Bag EvBind -> DsM [CoreBind]
    dsEvBinds Bag EvBind
    bs
      = do { Bag (EvVar, CoreExpr)
    ds_bs <- (EvBind -> DsM (EvVar, CoreExpr))
    -> Bag EvBind
    -> IOEnv (Env DsGblEnv DsLclEnv) (Bag (EvVar, CoreExpr))
    forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Bag a -> m (Bag b)
    mapBagM EvBind -> DsM (EvVar, CoreExpr)
    dsEvBind Bag EvBind
    bs
           ; [CoreBind] -> DsM [CoreBind]
    forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bag (EvVar, CoreExpr) -> [CoreBind]
    mk_ev_binds Bag (EvVar, CoreExpr)
    ds_bs) }

    mk_ev_binds :: Bag (Id,CoreExpr) -> [CoreBind]
    -- We do SCC analysis of the evidence bindings, /after/ desugaring
    -- them. This is convenient: it means we can use the GHC.Core
    -- free-variable functions rather than having to do accurate free vars
    -- for EvTerm.
    mk_ev_binds :: Bag (EvVar, CoreExpr) -> [CoreBind]
    mk_ev_binds Bag (EvVar, CoreExpr)
    ds_binds
      = (SCC (EvVar, CoreExpr) -> CoreBind)
    -> [SCC (EvVar, CoreExpr)] -> [CoreBind]
    forall a b. (a -> b) -> [a] -> [b]
    map SCC (EvVar, CoreExpr) -> CoreBind
    forall {b}. SCC (b, Expr b) -> Bind b
    ds_scc ([Node EvVar (EvVar, CoreExpr)] -> [SCC (EvVar, CoreExpr)]
    forall key payload.
    Uniquable key =>
    [Node key payload] -> [SCC payload]
    stronglyConnCompFromEdgedVerticesUniq [Node EvVar (EvVar, CoreExpr)]
    edges)
      where
        edges :: [ Node EvVar (EvVar,CoreExpr) ]
        edges :: [Node EvVar (EvVar, CoreExpr)]
    edges = ((EvVar, CoreExpr)
     -> [Node EvVar (EvVar, CoreExpr)]
     -> [Node EvVar (EvVar, CoreExpr)])
    -> [Node EvVar (EvVar, CoreExpr)]
    -> Bag (EvVar, CoreExpr)
    -> [Node EvVar (EvVar, CoreExpr)]
    forall a b. (a -> b -> b) -> b -> Bag a -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr ((:) (Node EvVar (EvVar, CoreExpr)
     -> [Node EvVar (EvVar, CoreExpr)]
     -> [Node EvVar (EvVar, CoreExpr)])
    -> ((EvVar, CoreExpr) -> Node EvVar (EvVar, CoreExpr))
    -> (EvVar, CoreExpr)
    -> [Node EvVar (EvVar, CoreExpr)]
    -> [Node EvVar (EvVar, CoreExpr)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (EvVar, CoreExpr) -> Node EvVar (EvVar, CoreExpr)
    mk_node) [] Bag (EvVar, CoreExpr)
    ds_binds

        mk_node :: (Id, CoreExpr) -> Node EvVar (EvVar,CoreExpr)
        mk_node :: (EvVar, CoreExpr) -> Node EvVar (EvVar, CoreExpr)
    mk_node b :: (EvVar, CoreExpr)
    b@(EvVar
    var, CoreExpr
    rhs)
          = DigraphNode { node_payload :: (EvVar, CoreExpr)
    node_payload = (EvVar, CoreExpr)
    b
                        , node_key :: EvVar
    node_key = EvVar
    var
                        , node_dependencies :: [EvVar]
    node_dependencies = VarSet -> [EvVar]
    forall elt. UniqSet elt -> [elt]
    nonDetEltsUniqSet (VarSet -> [EvVar]) -> VarSet -> [EvVar]
    forall a b. (a -> b) -> a -> b
    $
                                              CoreExpr -> VarSet
    exprFreeVars CoreExpr
    rhs VarSet -> VarSet -> VarSet
    `unionVarSet`
                                              Type -> VarSet
    coVarsOfType (EvVar -> Type
    varType EvVar
    var) }
          -- It's OK to use nonDetEltsUniqSet here as stronglyConnCompFromEdgedVertices
          -- is still deterministic even if the edges are in nondeterministic order
          -- as explained in Note [Deterministic SCC] in GHC.Data.Graph.Directed.

        ds_scc :: SCC (b, Expr b) -> Bind b
    ds_scc (AcyclicSCC (b
    v,Expr b
    r)) = b -> Expr b -> Bind b
    forall b. b -> Expr b -> Bind b
    NonRec b
    v Expr b
    r
        ds_scc (CyclicSCC [(b, Expr b)]
    prs)    = [(b, Expr b)] -> Bind b
    forall b. [(b, Expr b)] -> Bind b
    Rec [(b, Expr b)]
    prs

    dsEvBind :: EvBind -> DsM (Id, CoreExpr)
    dsEvBind :: EvBind -> DsM (EvVar, CoreExpr)
    dsEvBind (EvBind { eb_lhs :: EvBind -> EvVar
    eb_lhs = EvVar
    v, eb_rhs :: EvBind -> EvTerm
    eb_rhs = EvTerm
    r}) = (CoreExpr -> (EvVar, CoreExpr))
    -> DsM CoreExpr -> DsM (EvVar, CoreExpr)
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM ((,) EvVar
    v) (EvTerm -> DsM CoreExpr
    dsEvTerm EvTerm
    r)

    {-**********************************************************************
    *                                                                      *
               Desugaring EvTerms
    *                                                                      *
    **********************************************************************-}

    dsEvTerm :: EvTerm -> DsM CoreExpr
    dsEvTerm :: EvTerm -> DsM CoreExpr
    dsEvTerm (EvExpr CoreExpr
    e)          = CoreExpr -> DsM CoreExpr
    forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return CoreExpr
    e
    dsEvTerm (EvTypeable Type
    ty EvTypeable
    ev)  = Type -> EvTypeable -> DsM CoreExpr
    dsEvTypeable Type
    ty EvTypeable
    ev
    dsEvTerm (EvFun { et_tvs :: EvTerm -> [EvVar]
    et_tvs = [EvVar]
    tvs, et_given :: EvTerm -> [EvVar]
    et_given = [EvVar]
    given
                    , et_binds :: EvTerm -> TcEvBinds
    et_binds = TcEvBinds
    ev_binds, et_body :: EvTerm -> EvVar
    et_body = EvVar
    wanted_id })
      = do { [CoreBind]
    ds_ev_binds <- TcEvBinds -> DsM [CoreBind]
    dsTcEvBinds TcEvBinds
    ev_binds
           ; CoreExpr -> DsM CoreExpr
    forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CoreExpr -> DsM CoreExpr) -> CoreExpr -> DsM CoreExpr
    forall a b. (a -> b) -> a -> b
    $ ([EvVar] -> CoreExpr -> CoreExpr
    forall b. [b] -> Expr b -> Expr b
    mkLams ([EvVar]
    tvs [EvVar] -> [EvVar] -> [EvVar]
    forall a. [a] -> [a] -> [a]
    ++ [EvVar]
    given) (CoreExpr -> CoreExpr) -> CoreExpr -> CoreExpr
    forall a b. (a -> b) -> a -> b
    $
                       [CoreBind] -> CoreExpr -> CoreExpr
    mkCoreLets [CoreBind]
    ds_ev_binds (CoreExpr -> CoreExpr) -> CoreExpr -> CoreExpr
    forall a b. (a -> b) -> a -> b
    $
                       EvVar -> CoreExpr
    forall b. EvVar -> Expr b
    Var EvVar
    wanted_id) }

    {-**********************************************************************
    *                                                                      *
               Desugaring Typeable dictionaries
    *                                                                      *
    **********************************************************************-}

    dsEvTypeable :: Type -> EvTypeable -> DsM CoreExpr
    -- Return a CoreExpr :: Typeable ty
    -- This code is tightly coupled to the representation
    -- of TypeRep, in base library Data.Typeable.Internal
    dsEvTypeable :: Type -> EvTypeable -> DsM CoreExpr
    dsEvTypeable Type
    ty EvTypeable
    ev
      = do { TyCon
    tyCl <- Name -> DsM TyCon
    dsLookupTyCon Name
    typeableClassName    -- Typeable
           ; let kind :: Type
    kind = (() :: Constraint) => Type -> Type
    Type -> Type
    typeKind Type
    ty
                 typeable_data_con :: DataCon
    typeable_data_con = TyCon -> DataCon
    tyConSingleDataCon TyCon
    tyCl  -- "Data constructor"
                                                        -- for Typeable

           ; CoreExpr
    rep_expr <- Type -> EvTypeable -> DsM CoreExpr
    ds_ev_typeable Type
    ty EvTypeable
    ev           -- :: TypeRep a

           -- Package up the method as `Typeable` dictionary
           ; CoreExpr -> DsM CoreExpr
    forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CoreExpr -> DsM CoreExpr) -> CoreExpr -> DsM CoreExpr
    forall a b. (a -> b) -> a -> b
    $ DataCon -> [CoreExpr] -> CoreExpr
    forall b. DataCon -> [Arg b] -> Arg b
    mkConApp DataCon
    typeable_data_con [Type -> CoreExpr
    forall b. Type -> Expr b
    Type Type
    kind, Type -> CoreExpr
    forall b. Type -> Expr b
    Type Type
    ty, CoreExpr
    rep_expr] }

    type TypeRepExpr = CoreExpr

    -- | Returns a @CoreExpr :: TypeRep ty@
    ds_ev_typeable :: Type -> EvTypeable -> DsM CoreExpr
    ds_ev_typeable :: Type -> EvTypeable -> DsM CoreExpr
    ds_ev_typeable Type
    ty (EvTypeableTyCon TyCon
    tc [EvTerm]
    kind_ev)
      = do { EvVar
    mkTrCon <- Name -> DsM EvVar
    dsLookupGlobalId Name
    mkTrConName
                        -- mkTrCon :: forall k (a :: k). TyCon -> TypeRep k -> TypeRep a
           ; TyCon
    someTypeRepTyCon <- Name -> DsM TyCon
    dsLookupTyCon Name
    someTypeRepTyConName
           ; DataCon
    someTypeRepDataCon <- Name -> DsM DataCon
    dsLookupDataCon Name
    someTypeRepDataConName
                        -- SomeTypeRep :: forall k (a :: k). TypeRep a -> SomeTypeRep

           ; CoreExpr
    tc_rep <- TyCon -> DsM CoreExpr
    tyConRep TyCon
    tc                      -- :: TyCon
           ; let ks :: [Type]
    ks = HasCallStack => Type -> [Type]
    Type -> [Type]
    tyConAppArgs Type
    ty
                 -- Construct a SomeTypeRep
                 toSomeTypeRep :: Type -> EvTerm -> DsM CoreExpr
                 toSomeTypeRep :: Type -> EvTerm -> DsM CoreExpr
    toSomeTypeRep Type
    t EvTerm
    ev = do
                     CoreExpr
    rep <- EvTerm -> Type -> DsM CoreExpr
    getRep EvTerm
    ev Type
    t
                     CoreExpr -> DsM CoreExpr
    forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CoreExpr -> DsM CoreExpr) -> CoreExpr -> DsM CoreExpr
    forall a b. (a -> b) -> a -> b
    $ DataCon -> [CoreExpr] -> CoreExpr
    mkCoreConApps DataCon
    someTypeRepDataCon [Type -> CoreExpr
    forall b. Type -> Expr b
    Type ((() :: Constraint) => Type -> Type
    Type -> Type
    typeKind Type
    t), Type -> CoreExpr
    forall b. Type -> Expr b
    Type Type
    t, CoreExpr
    rep]
           ; [CoreExpr]
    kind_arg_reps <- [DsM CoreExpr] -> IOEnv (Env DsGblEnv DsLclEnv) [CoreExpr]
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    forall (m :: * -> *) a. Monad m => [m a] -> m [a]
    sequence ([DsM CoreExpr] -> IOEnv (Env DsGblEnv DsLclEnv) [CoreExpr])
    -> [DsM CoreExpr] -> IOEnv (Env DsGblEnv DsLclEnv) [CoreExpr]
    forall a b. (a -> b) -> a -> b
    $ (Type -> EvTerm -> DsM CoreExpr)
    -> [Type] -> [EvTerm] -> [DsM CoreExpr]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith Type -> EvTerm -> DsM CoreExpr
    toSomeTypeRep [Type]
    ks [EvTerm]
    kind_ev   -- :: TypeRep t
           ; let -- :: [SomeTypeRep]
                 kind_args :: CoreExpr
    kind_args = Type -> [CoreExpr] -> CoreExpr
    mkListExpr (TyCon -> Type
    mkTyConTy TyCon
    someTypeRepTyCon) [CoreExpr]
    kind_arg_reps

             -- Note that we use the kind of the type, not the TyCon from which it
             -- is constructed since the latter may be kind polymorphic whereas the
             -- former we know is not (we checked in the solver).
           ; let expr :: CoreExpr
    expr = CoreExpr -> [CoreExpr] -> CoreExpr
    forall b. Expr b -> [Expr b] -> Expr b
    mkApps (EvVar -> CoreExpr
    forall b. EvVar -> Expr b
    Var EvVar
    mkTrCon) [ Type -> CoreExpr
    forall b. Type -> Expr b
    Type ((() :: Constraint) => Type -> Type
    Type -> Type
    typeKind Type
    ty)
                                             , Type -> CoreExpr
    forall b. Type -> Expr b
    Type Type
    ty
                                             , CoreExpr
    tc_rep
                                             , CoreExpr
    kind_args ]
           -- ; pprRuntimeTrace "Trace mkTrTyCon" (ppr expr) expr
           ; CoreExpr -> DsM CoreExpr
    forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return CoreExpr
    expr
           }

    ds_ev_typeable Type
    ty (EvTypeableTyApp EvTerm
    ev1 EvTerm
    ev2)
      | Just (Type
    t1,Type
    t2) <- Type -> Maybe (Type, Type)
    splitAppTy_maybe Type
    ty
      = do { CoreExpr
    e1  <- EvTerm -> Type -> DsM CoreExpr
    getRep EvTerm
    ev1 Type
    t1
           ; CoreExpr
    e2  <- EvTerm -> Type -> DsM CoreExpr
    getRep EvTerm
    ev2 Type
    t2
           ; EvVar
    mkTrApp <- Name -> DsM EvVar
    dsLookupGlobalId Name
    mkTrAppName
                        -- mkTrApp :: forall k1 k2 (a :: k1 -> k2) (b :: k1).
                        --            TypeRep a -> TypeRep b -> TypeRep (a b)
           ; let (Type
    _, Type
    k1, Type
    k2) = Type -> (Type, Type, Type)
    splitFunTy ((() :: Constraint) => Type -> Type
    Type -> Type
    typeKind Type
    t1)  -- drop the multiplicity,
                                                         -- since it's a kind
           ; let expr :: CoreExpr
    expr =  CoreExpr -> [CoreExpr] -> CoreExpr
    forall b. Expr b -> [Expr b] -> Expr b
    mkApps (CoreExpr -> [Type] -> CoreExpr
    forall b. Expr b -> [Type] -> Expr b
    mkTyApps (EvVar -> CoreExpr
    forall b. EvVar -> Expr b
    Var EvVar
    mkTrApp) [ Type
    k1, Type
    k2, Type
    t1, Type
    t2 ])
                                [ CoreExpr
    e1, CoreExpr
    e2 ]
           -- ; pprRuntimeTrace "Trace mkTrApp" (ppr expr) expr
           ; CoreExpr -> DsM CoreExpr
    forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return CoreExpr
    expr
           }

    ds_ev_typeable Type
    ty (EvTypeableTrFun EvTerm
    evm EvTerm
    ev1 EvTerm
    ev2)
      | Just (FunTyFlag
    _af,Type
    m,Type
    t1,Type
    t2) <- Type -> Maybe (FunTyFlag, Type, Type, Type)
    splitFunTy_maybe Type
    ty
      = do { CoreExpr
    e1 <- EvTerm -> Type -> DsM CoreExpr
    getRep EvTerm
    ev1 Type
    t1
           ; CoreExpr
    e2 <- EvTerm -> Type -> DsM CoreExpr
    getRep EvTerm
    ev2 Type
    t2
           ; CoreExpr
    em <- EvTerm -> Type -> DsM CoreExpr
    getRep EvTerm
    evm Type
    m
           ; EvVar
    mkTrFun <- Name -> DsM EvVar
    dsLookupGlobalId Name
    mkTrFunName
                        -- mkTrFun :: forall (m :: Multiplicity) r1 r2 (a :: TYPE r1) (b :: TYPE r2).
                        --            TypeRep m -> TypeRep a -> TypeRep b -> TypeRep (a % m -> b)
           ; let r1 :: Type
    r1 = (() :: Constraint) => Type -> Type
    Type -> Type
    getRuntimeRep Type
    t1
                 r2 :: Type
    r2 = (() :: Constraint) => Type -> Type
    Type -> Type
    getRuntimeRep Type
    t2
           ; CoreExpr -> DsM CoreExpr
    forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CoreExpr -> DsM CoreExpr) -> CoreExpr -> DsM CoreExpr
    forall a b. (a -> b) -> a -> b
    $ CoreExpr -> [CoreExpr] -> CoreExpr
    forall b. Expr b -> [Expr b] -> Expr b
    mkApps (CoreExpr -> [Type] -> CoreExpr
    forall b. Expr b -> [Type] -> Expr b
    mkTyApps (EvVar -> CoreExpr
    forall b. EvVar -> Expr b
    Var EvVar
    mkTrFun) [Type
    m, Type
    r1, Type
    r2, Type
    t1, Type
    t2])
                             [ CoreExpr
    em, CoreExpr
    e1, CoreExpr
    e2 ]
           }

    ds_ev_typeable Type
    ty (EvTypeableTyLit EvTerm
    ev)
      = -- See Note [Typeable for Nat and Symbol] in GHC.Tc.Solver.Interact
        do { EvVar
    fun  <- Name -> DsM EvVar
    dsLookupGlobalId Name
    tr_fun
           ; CoreExpr
    dict <- EvTerm -> DsM CoreExpr
    dsEvTerm EvTerm
    ev       -- Of type KnownNat/KnownSymbol
           ; CoreExpr -> DsM CoreExpr
    forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CoreExpr -> [CoreExpr] -> CoreExpr
    forall b. Expr b -> [Expr b] -> Expr b
    mkApps (CoreExpr -> [Type] -> CoreExpr
    forall b. Expr b -> [Type] -> Expr b
    mkTyApps (EvVar -> CoreExpr
    forall b. EvVar -> Expr b
    Var EvVar
    fun) [Type
    ty]) [ CoreExpr
    dict ]) }
      where
        ty_kind :: Type
    ty_kind = (() :: Constraint) => Type -> Type
    Type -> Type
    typeKind Type
    ty

        -- tr_fun is the Name of
        --       typeNatTypeRep    :: KnownNat    a => TypeRep a
        -- of    typeSymbolTypeRep :: KnownSymbol a => TypeRep a
        tr_fun :: Name
    tr_fun | Type
    ty_kind Type -> Type -> Bool
    `eqType` Type
    naturalTy      = Name
    typeNatTypeRepName
               | Type
    ty_kind Type -> Type -> Bool
    `eqType` Type
    typeSymbolKind = Name
    typeSymbolTypeRepName
               | Type
    ty_kind Type -> Type -> Bool
    `eqType` Type
    charTy         = Name
    typeCharTypeRepName
               | Bool
    otherwise = String -> Name
    forall a. HasCallStack => String -> a
    panic String
    "dsEvTypeable: unknown type lit kind"

    ds_ev_typeable Type
    ty EvTypeable
    ev
      = String -> SDoc -> DsM CoreExpr
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "dsEvTypeable" (Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    ty SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ EvTypeable -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr EvTypeable
    ev)

    getRep :: EvTerm          -- ^ EvTerm for @Typeable ty@
           -> Type            -- ^ The type @ty@
           -> DsM TypeRepExpr -- ^ Return @CoreExpr :: TypeRep ty@
                              -- namely @typeRep# dict@
    -- Remember that
    --   typeRep# :: forall k (a::k). Typeable k a -> TypeRep a
    getRep :: EvTerm -> Type -> DsM CoreExpr
    getRep EvTerm
    ev Type
    ty
      = do { CoreExpr
    typeable_expr <- EvTerm -> DsM CoreExpr
    dsEvTerm EvTerm
    ev
           ; EvVar
    typeRepId     <- Name -> DsM EvVar
    dsLookupGlobalId Name
    typeRepIdName
           ; let ty_args :: [Type]
    ty_args = [(() :: Constraint) => Type -> Type
    Type -> Type
    typeKind Type
    ty, Type
    ty]
           ; CoreExpr -> DsM CoreExpr
    forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CoreExpr -> [CoreExpr] -> CoreExpr
    forall b. Expr b -> [Expr b] -> Expr b
    mkApps (CoreExpr -> [Type] -> CoreExpr
    forall b. Expr b -> [Type] -> Expr b
    mkTyApps (EvVar -> CoreExpr
    forall b. EvVar -> Expr b
    Var EvVar
    typeRepId) [Type]
    ty_args) [ CoreExpr
    typeable_expr ]) }

    tyConRep :: TyCon -> DsM CoreExpr
    -- Returns CoreExpr :: TyCon
    tyConRep :: TyCon -> DsM CoreExpr
    tyConRep TyCon
    tc
      | Just Name
    tc_rep_nm <- TyCon -> Maybe Name
    tyConRepName_maybe TyCon
    tc
      = do { EvVar
    tc_rep_id <- Name -> DsM EvVar
    dsLookupGlobalId Name
    tc_rep_nm
           ; CoreExpr -> DsM CoreExpr
    forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (EvVar -> CoreExpr
    forall b. EvVar -> Expr b
    Var EvVar
    tc_rep_id) }
      | Bool
    otherwise
      = String -> SDoc -> DsM CoreExpr
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "tyConRep" (TyCon -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TyCon
    tc)