    {-# LANGUAGE CPP          #-}
    {-# LANGUAGE TypeFamilies #-}

    {-# OPTIONS_GHC -Wno-incomplete-uni-patterns   #-}
    {-# OPTIONS_GHC -Wno-incomplete-record-updates #-}

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

    Desugaring expressions.
    -}

    module GHC.HsToCore.Expr
       ( dsExpr, dsLExpr, dsLExprNoLP, dsLocalBinds
       , dsValBinds, dsLit, dsSyntaxExpr
       )
    where

    #include "HsVersions.h"

    import GHC.Prelude

    import GHC.HsToCore.Match
    import GHC.HsToCore.Match.Literal
    import GHC.HsToCore.Binds
    import GHC.HsToCore.GuardedRHSs
    import GHC.HsToCore.ListComp
    import GHC.HsToCore.Utils
    import GHC.HsToCore.Arrows
    import GHC.HsToCore.Monad
    import GHC.HsToCore.Pmc ( addTyCs, pmcGRHSs )
    import GHC.Types.SourceText
    import GHC.Types.Name
    import GHC.Types.Name.Env
    import GHC.Core.FamInstEnv( topNormaliseType )
    import GHC.HsToCore.Quote
    import GHC.Hs

    -- NB: The desugarer, which straddles the source and Core worlds, sometimes
    --     needs to see source types
    import GHC.Tc.Utils.TcType
    import GHC.Tc.Types.Evidence
    import GHC.Tc.Utils.Monad
    import GHC.Core.Type
    import GHC.Core.Multiplicity
    import GHC.Core.Coercion( Coercion )
    import GHC.Core
    import GHC.Core.Utils
    import GHC.Core.Make

    import GHC.Driver.Session
    import GHC.Types.CostCentre
    import GHC.Types.Id
    import GHC.Types.Id.Make
    import GHC.Types.Var.Env
    import GHC.Unit.Module
    import GHC.Core.ConLike
    import GHC.Core.DataCon
    import GHC.Core.TyCo.Ppr( pprWithTYPE )
    import GHC.Builtin.Types
    import GHC.Builtin.Names
    import GHC.Types.Basic
    import GHC.Data.Maybe
    import GHC.Types.SrcLoc
    import GHC.Types.Tickish
    import GHC.Utils.Misc
    import GHC.Data.Bag
    import GHC.Utils.Outputable as Outputable
    import GHC.Utils.Panic
    import GHC.Core.PatSyn
    import Control.Monad
    import Data.Void( absurd )

    {-
    ************************************************************************
    *                                                                      *
                    dsLocalBinds, dsValBinds
    *                                                                      *
    ************************************************************************
    -}

    dsLocalBinds :: HsLocalBinds GhcTc -> CoreExpr -> DsM CoreExpr
    dsLocalBinds :: HsLocalBinds GhcTc -> CoreExpr -> DsM CoreExpr
    dsLocalBinds (EmptyLocalBinds XEmptyLocalBinds GhcTc GhcTc
    _)  CoreExpr
    body = CoreExpr -> DsM CoreExpr
    forall (m :: * -> *) a. Monad m => a -> m a
    return CoreExpr
    body
    dsLocalBinds b :: HsLocalBinds GhcTc
    b@(HsValBinds XHsValBinds GhcTc GhcTc
    _ HsValBindsLR GhcTc GhcTc
    binds) CoreExpr
    body = SrcSpan -> DsM CoreExpr -> DsM CoreExpr
    forall a. SrcSpan -> DsM a -> DsM a
    putSrcSpanDs (HsLocalBinds GhcTc -> SrcSpan
    forall (p :: Pass).
    Data (HsLocalBinds (GhcPass p)) =>
    HsLocalBinds (GhcPass p) -> SrcSpan
    spanHsLocaLBinds HsLocalBinds GhcTc
    b) (DsM CoreExpr -> DsM CoreExpr) -> DsM CoreExpr -> DsM CoreExpr
    forall a b. (a -> b) -> a -> b
    $
                                               HsValBindsLR GhcTc GhcTc -> CoreExpr -> DsM CoreExpr
    dsValBinds HsValBindsLR GhcTc GhcTc
    binds CoreExpr
    body
    dsLocalBinds (HsIPBinds XHsIPBinds GhcTc GhcTc
    _ HsIPBinds GhcTc
    binds)  CoreExpr
    body = HsIPBinds GhcTc -> CoreExpr -> DsM CoreExpr
    dsIPBinds  HsIPBinds GhcTc
    binds CoreExpr
    body

    -------------------------
    -- caller sets location
    dsValBinds :: HsValBinds GhcTc -> CoreExpr -> DsM CoreExpr
    dsValBinds :: HsValBindsLR GhcTc GhcTc -> CoreExpr -> DsM CoreExpr
    dsValBinds (XValBindsLR (NValBinds [(RecFlag, LHsBinds GhcTc)]
    binds [LSig GhcRn]
    _)) CoreExpr
    body
      = ((RecFlag, Bag (GenLocated SrcSpanAnnA (HsBind GhcTc)))
     -> CoreExpr -> DsM CoreExpr)
    -> CoreExpr
    -> [(RecFlag, Bag (GenLocated SrcSpanAnnA (HsBind GhcTc)))]
    -> DsM CoreExpr
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> b -> m b) -> b -> t a -> m b
    foldrM (RecFlag, Bag (GenLocated SrcSpanAnnA (HsBind GhcTc)))
    -> CoreExpr -> DsM CoreExpr
    (RecFlag, LHsBinds GhcTc) -> CoreExpr -> DsM CoreExpr
    ds_val_bind CoreExpr
    body [(RecFlag, Bag (GenLocated SrcSpanAnnA (HsBind GhcTc)))]
    [(RecFlag, LHsBinds GhcTc)]
    binds
    dsValBinds (ValBinds {})       CoreExpr
    _    = String -> DsM CoreExpr
    forall a. String -> a
    panic String
    "dsValBinds ValBindsIn"

    -------------------------
    dsIPBinds :: HsIPBinds GhcTc -> CoreExpr -> DsM CoreExpr
    dsIPBinds :: HsIPBinds GhcTc -> CoreExpr -> DsM CoreExpr
    dsIPBinds (IPBinds XIPBinds GhcTc
    ev_binds [LIPBind GhcTc]
    ip_binds) CoreExpr
    body
      = do  { [CoreBind]
    ds_binds <- TcEvBinds -> DsM [CoreBind]
    dsTcEvBinds XIPBinds GhcTc
    TcEvBinds
    ev_binds
            ; let inner :: CoreExpr
    inner = [CoreBind] -> CoreExpr -> CoreExpr
    mkCoreLets [CoreBind]
    ds_binds CoreExpr
    body
                    -- The dict bindings may not be in
                    -- dependency order; hence Rec
            ; (GenLocated SrcSpanAnnA (IPBind GhcTc) -> CoreExpr -> DsM CoreExpr)
    -> CoreExpr
    -> [GenLocated SrcSpanAnnA (IPBind GhcTc)]
    -> DsM CoreExpr
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> b -> m b) -> b -> t a -> m b
    foldrM GenLocated SrcSpanAnnA (IPBind GhcTc) -> CoreExpr -> DsM CoreExpr
    LIPBind GhcTc -> CoreExpr -> DsM CoreExpr
    ds_ip_bind CoreExpr
    inner [GenLocated SrcSpanAnnA (IPBind GhcTc)]
    [LIPBind GhcTc]
    ip_binds }
      where
        ds_ip_bind :: LIPBind GhcTc -> CoreExpr -> DsM CoreExpr
        ds_ip_bind :: LIPBind GhcTc -> CoreExpr -> DsM CoreExpr
    ds_ip_bind (L SrcSpanAnnA
    _ (IPBind XCIPBind GhcTc
    _ ~(Right IdP GhcTc
    n) LHsExpr GhcTc
    e)) CoreExpr
    body
          = do CoreExpr
    e' <- LHsExpr GhcTc -> DsM CoreExpr
    dsLExpr LHsExpr GhcTc
    e
               CoreExpr -> DsM CoreExpr
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CoreBind -> CoreExpr -> CoreExpr
    forall b. Bind b -> Expr b -> Expr b
    Let (Id -> CoreExpr -> CoreBind
    forall b. b -> Expr b -> Bind b
    NonRec Id
    IdP GhcTc
    n CoreExpr
    e') CoreExpr
    body)

    -------------------------
    -- caller sets location
    ds_val_bind :: (RecFlag, LHsBinds GhcTc) -> CoreExpr -> DsM CoreExpr
    -- Special case for bindings which bind unlifted variables
    -- We need to do a case right away, rather than building
    -- a tuple and doing selections.
    -- Silently ignore INLINE and SPECIALISE pragmas...
    ds_val_bind :: (RecFlag, LHsBinds GhcTc) -> CoreExpr -> DsM CoreExpr
    ds_val_bind (RecFlag
    NonRecursive, LHsBinds GhcTc
    hsbinds) CoreExpr
    body
      | [L SrcSpanAnnA
    loc HsBind GhcTc
    bind] <- Bag (GenLocated SrcSpanAnnA (HsBind GhcTc))
    -> [GenLocated SrcSpanAnnA (HsBind GhcTc)]
    forall a. Bag a -> [a]
    bagToList Bag (GenLocated SrcSpanAnnA (HsBind GhcTc))
    LHsBinds GhcTc
    hsbinds
            -- Non-recursive, non-overloaded bindings only come in ones
            -- ToDo: in some bizarre case it's conceivable that there
            --       could be dict binds in the 'binds'.  (See the notes
            --       below.  Then pattern-match would fail.  Urk.)
      , HsBind GhcTc -> Bool
    isUnliftedHsBind HsBind GhcTc
    bind
      = SrcSpan -> DsM CoreExpr -> DsM CoreExpr
    forall a. SrcSpan -> DsM a -> DsM a
    putSrcSpanDs (SrcSpanAnnA -> SrcSpan
    forall a. SrcSpanAnn' a -> SrcSpan
    locA SrcSpanAnnA
    loc) (DsM CoreExpr -> DsM CoreExpr) -> DsM CoreExpr -> DsM CoreExpr
    forall a b. (a -> b) -> a -> b
    $
         -- see Note [Strict binds checks] in GHC.HsToCore.Binds
        if HsBind GhcTc -> Bool
    forall {idL} {idR}. HsBindLR idL idR -> Bool
    is_polymorphic HsBind GhcTc
    bind
        then SDoc -> DsM CoreExpr
    errDsCoreExpr (HsBind GhcTc -> SDoc
    forall {a}. Outputable a => a -> SDoc
    poly_bind_err HsBind GhcTc
    bind)
                -- data Ptr a = Ptr Addr#
                -- f x = let p@(Ptr y) = ... in ...
                -- Here the binding for 'p' is polymorphic, but does
                -- not mix with an unlifted binding for 'y'.  You should
                -- use a bang pattern.  #6078.

        else do { Bool
    -> IOEnv (Env DsGblEnv DsLclEnv) ()
    -> IOEnv (Env DsGblEnv DsLclEnv) ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (HsBind GhcTc -> Bool
    forall (p :: Pass). HsBind (GhcPass p) -> Bool
    looksLazyPatBind HsBind GhcTc
    bind) (IOEnv (Env DsGblEnv DsLclEnv) ()
     -> IOEnv (Env DsGblEnv DsLclEnv) ())
    -> IOEnv (Env DsGblEnv DsLclEnv) ()
    -> IOEnv (Env DsGblEnv DsLclEnv) ()
    forall a b. (a -> b) -> a -> b
    $
                  WarningFlag -> SDoc -> IOEnv (Env DsGblEnv DsLclEnv) ()
    warnIfSetDs WarningFlag
    Opt_WarnUnbangedStrictPatterns (HsBind GhcTc -> SDoc
    forall {a}. Outputable a => a -> SDoc
    unlifted_must_be_bang HsBind GhcTc
    bind)
            -- Complain about a binding that looks lazy
            --    e.g.    let I# y = x in ...
            -- Remember, in checkStrictBinds we are going to do strict
            -- matching, so (for software engineering reasons) we insist
            -- that the strictness is manifest on each binding
            -- However, lone (unboxed) variables are ok

                ; HsBind GhcTc -> CoreExpr -> DsM CoreExpr
    dsUnliftedBind HsBind GhcTc
    bind CoreExpr
    body }
      where
        is_polymorphic :: HsBindLR idL idR -> Bool
    is_polymorphic (AbsBinds { abs_tvs :: forall idL idR. HsBindLR idL idR -> [Id]
    abs_tvs = [Id]
    tvs, abs_ev_vars :: forall idL idR. HsBindLR idL idR -> [Id]
    abs_ev_vars = [Id]
    evs })
                         = Bool -> Bool
    not ([Id] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Id]
    tvs Bool -> Bool -> Bool
    && [Id] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Id]
    evs)
        is_polymorphic HsBindLR idL idR
    _ = Bool
    False

        unlifted_must_be_bang :: a -> SDoc
    unlifted_must_be_bang a
    bind
          = SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "Pattern bindings containing unlifted types should use" SDoc -> SDoc -> SDoc
    $$
                  String -> SDoc
    text String
    "an outermost bang pattern:")
               Int
    2 (a -> SDoc
    forall {a}. Outputable a => a -> SDoc
    ppr a
    bind)

        poly_bind_err :: a -> SDoc
    poly_bind_err a
    bind
          = SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "You can't mix polymorphic and unlifted bindings:")
               Int
    2 (a -> SDoc
    forall {a}. Outputable a => a -> SDoc
    ppr a
    bind) SDoc -> SDoc -> SDoc
    $$
            String -> SDoc
    text String
    "Probable fix: add a type signature"

    ds_val_bind (RecFlag
    is_rec, LHsBinds GhcTc
    binds) CoreExpr
    _body
      | (GenLocated SrcSpanAnnA (HsBind GhcTc) -> Bool)
    -> Bag (GenLocated SrcSpanAnnA (HsBind GhcTc)) -> Bool
    forall a. (a -> Bool) -> Bag a -> Bool
    anyBag (HsBind GhcTc -> Bool
    isUnliftedHsBind (HsBind GhcTc -> Bool)
    -> (GenLocated SrcSpanAnnA (HsBind GhcTc) -> HsBind GhcTc)
    -> GenLocated SrcSpanAnnA (HsBind GhcTc)
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . GenLocated SrcSpanAnnA (HsBind GhcTc) -> HsBind GhcTc
    forall l e. GenLocated l e -> e
    unLoc) Bag (GenLocated SrcSpanAnnA (HsBind GhcTc))
    LHsBinds GhcTc
    binds  -- see Note [Strict binds checks] in GHC.HsToCore.Binds
      = ASSERT( isRec is_rec )
        SDoc -> DsM CoreExpr
    errDsCoreExpr (SDoc -> DsM CoreExpr) -> SDoc -> DsM CoreExpr
    forall a b. (a -> b) -> a -> b
    $
        SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "Recursive bindings for unlifted types aren't allowed:")
           Int
    2 ([SDoc] -> SDoc
    vcat ((GenLocated SrcSpanAnnA (HsBind GhcTc) -> SDoc)
    -> [GenLocated SrcSpanAnnA (HsBind GhcTc)] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map GenLocated SrcSpanAnnA (HsBind GhcTc) -> SDoc
    forall {a}. Outputable a => a -> SDoc
    ppr (Bag (GenLocated SrcSpanAnnA (HsBind GhcTc))
    -> [GenLocated SrcSpanAnnA (HsBind GhcTc)]
    forall a. Bag a -> [a]
    bagToList Bag (GenLocated SrcSpanAnnA (HsBind GhcTc))
    LHsBinds GhcTc
    binds)))

    -- Ordinary case for bindings; none should be unlifted
    ds_val_bind (RecFlag
    is_rec, LHsBinds GhcTc
    binds) CoreExpr
    body
      = do  { MASSERT( isRec is_rec || isSingletonBag binds )
                   -- we should never produce a non-recursive list of multiple binds

            ; ([Id]
    force_vars,[(Id, CoreExpr)]
    prs) <- LHsBinds GhcTc -> DsM ([Id], [(Id, CoreExpr)])
    dsLHsBinds LHsBinds GhcTc
    binds
            ; let body' :: CoreExpr
    body' = (Id -> CoreExpr -> CoreExpr) -> CoreExpr -> [Id] -> CoreExpr
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr Id -> CoreExpr -> CoreExpr
    seqVar CoreExpr
    body [Id]
    force_vars
            ; ASSERT2( not (any (isUnliftedType . idType . fst) prs), ppr is_rec $$ ppr binds )
              case [(Id, CoreExpr)]
    prs of
                [] -> CoreExpr -> DsM CoreExpr
    forall (m :: * -> *) a. Monad m => a -> m a
    return CoreExpr
    body
                [(Id, CoreExpr)]
    _  -> CoreExpr -> DsM CoreExpr
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CoreBind -> CoreExpr -> CoreExpr
    forall b. Bind b -> Expr b -> Expr b
    Let ([(Id, CoreExpr)] -> CoreBind
    forall b. [(b, Expr b)] -> Bind b
    Rec [(Id, CoreExpr)]
    prs) CoreExpr
    body') }
            -- Use a Rec regardless of is_rec.
            -- Why? Because it allows the binds to be all
            -- mixed up, which is what happens in one rare case
            -- Namely, for an AbsBind with no tyvars and no dicts,
            --         but which does have dictionary bindings.
            -- See notes with GHC.Tc.Solver.inferLoop [NO TYVARS]
            -- It turned out that wrapping a Rec here was the easiest solution
            --
            -- NB The previous case dealt with unlifted bindings, so we
            --    only have to deal with lifted ones now; so Rec is ok

    ------------------
    dsUnliftedBind :: HsBind GhcTc -> CoreExpr -> DsM CoreExpr
    dsUnliftedBind :: HsBind GhcTc -> CoreExpr -> DsM CoreExpr
    dsUnliftedBind (AbsBinds { abs_tvs :: forall idL idR. HsBindLR idL idR -> [Id]
    abs_tvs = [], abs_ev_vars :: forall idL idR. HsBindLR idL idR -> [Id]
    abs_ev_vars = []
                   , abs_exports :: forall idL idR. HsBindLR idL idR -> [ABExport idL]
    abs_exports = [ABExport GhcTc]
    exports
                   , abs_ev_binds :: forall idL idR. HsBindLR idL idR -> [TcEvBinds]
    abs_ev_binds = [TcEvBinds]
    ev_binds
                   , abs_binds :: forall idL idR. HsBindLR idL idR -> LHsBinds idL
    abs_binds = LHsBinds GhcTc
    lbinds }) CoreExpr
    body
      = do { let body1 :: CoreExpr
    body1 = (ABExport GhcTc -> CoreExpr -> CoreExpr)
    -> CoreExpr -> [ABExport GhcTc] -> CoreExpr
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr ABExport GhcTc -> CoreExpr -> CoreExpr
    forall {p}. (IdP p ~ Id) => ABExport p -> CoreExpr -> CoreExpr
    bind_export CoreExpr
    body [ABExport GhcTc]
    exports
                 bind_export :: ABExport p -> CoreExpr -> CoreExpr
    bind_export ABExport p
    export CoreExpr
    b = Id -> CoreExpr -> CoreExpr -> CoreExpr
    bindNonRec (ABExport p -> IdP p
    forall p. ABExport p -> IdP p
    abe_poly ABExport p
    export) (Id -> CoreExpr
    forall b. Id -> Expr b
    Var (ABExport p -> IdP p
    forall p. ABExport p -> IdP p
    abe_mono ABExport p
    export)) CoreExpr
    b
           ; CoreExpr
    body2 <- (CoreExpr -> GenLocated SrcSpanAnnA (HsBind GhcTc) -> DsM CoreExpr)
    -> CoreExpr
    -> Bag (GenLocated SrcSpanAnnA (HsBind GhcTc))
    -> DsM CoreExpr
    forall (t :: * -> *) (m :: * -> *) b a.
    (Foldable t, Monad m) =>
    (b -> a -> m b) -> b -> t a -> m b
    foldlM (\CoreExpr
    body GenLocated SrcSpanAnnA (HsBind GhcTc)
    lbind -> HsBind GhcTc -> CoreExpr -> DsM CoreExpr
    dsUnliftedBind (GenLocated SrcSpanAnnA (HsBind GhcTc) -> HsBind GhcTc
    forall l e. GenLocated l e -> e
    unLoc GenLocated SrcSpanAnnA (HsBind GhcTc)
    lbind) CoreExpr
    body)
                                CoreExpr
    body1 Bag (GenLocated SrcSpanAnnA (HsBind GhcTc))
    LHsBinds GhcTc
    lbinds
           ; [CoreBind]
    ds_binds <- [TcEvBinds] -> DsM [CoreBind]
    dsTcEvBinds_s [TcEvBinds]
    ev_binds
           ; CoreExpr -> DsM CoreExpr
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([CoreBind] -> CoreExpr -> CoreExpr
    mkCoreLets [CoreBind]
    ds_binds CoreExpr
    body2) }

    dsUnliftedBind (FunBind { fun_id :: forall idL idR. HsBindLR idL idR -> LIdP idL
    fun_id = L SrcSpanAnnN
    l Id
    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 = XFunBind GhcTc GhcTc
    co_fn
                            , fun_tick :: forall idL idR. HsBindLR idL idR -> [CoreTickish]
    fun_tick = [CoreTickish]
    tick }) CoreExpr
    body
                   -- Can't be a bang pattern (that looks like a PatBind)
                   -- so must be simply unboxed
      = do { ([Id]
    args, CoreExpr
    rhs) <- HsMatchContext GhcRn
    -> Maybe (LHsExpr GhcTc)
    -> MatchGroup GhcTc (LHsExpr GhcTc)
    -> DsM ([Id], CoreExpr)
    matchWrapper (LIdP GhcRn -> HsMatchContext GhcRn
    forall p. LIdP p -> HsMatchContext p
    mkPrefixFunRhs (SrcSpanAnnN -> Name -> GenLocated SrcSpanAnnN Name
    forall l e. l -> e -> GenLocated l e
    L SrcSpanAnnN
    l (Name -> GenLocated SrcSpanAnnN Name)
    -> Name -> GenLocated SrcSpanAnnN Name
    forall a b. (a -> b) -> a -> b
    $ Id -> Name
    idName Id
    fun))
                                         Maybe (LHsExpr GhcTc)
    forall a. Maybe a
    Nothing MatchGroup GhcTc (LHsExpr GhcTc)
    matches
           ; MASSERT( null args ) -- Functions aren't lifted
           ; MASSERT( isIdHsWrapper co_fn )
           ; let rhs' :: CoreExpr
    rhs' = [CoreTickish] -> CoreExpr -> CoreExpr
    mkOptTickBox [CoreTickish]
    tick CoreExpr
    rhs
           ; CoreExpr -> DsM CoreExpr
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Id -> CoreExpr -> CoreExpr -> CoreExpr
    bindNonRec Id
    fun CoreExpr
    rhs' CoreExpr
    body) }

    dsUnliftedBind (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 = XPatBind GhcTc GhcTc
    ty }) CoreExpr
    body
      =     -- let C x# y# = rhs in body
            -- ==> case rhs of C x# y# -> body
        do { NonEmpty Nablas
    match_nablas <- HsMatchContext GhcRn
    -> GRHSs GhcTc (LHsExpr GhcTc) -> DsM (NonEmpty Nablas)
    pmcGRHSs HsMatchContext GhcRn
    forall p. HsMatchContext p
    PatBindGuards GRHSs GhcTc (LHsExpr GhcTc)
    grhss
           ; CoreExpr
    rhs          <- GRHSs GhcTc (LHsExpr GhcTc)
    -> Type -> NonEmpty Nablas -> DsM CoreExpr
    dsGuarded GRHSs GhcTc (LHsExpr GhcTc)
    grhss Type
    XPatBind GhcTc GhcTc
    ty NonEmpty Nablas
    match_nablas
           ; let upat :: Pat GhcTc
    upat = GenLocated SrcSpanAnnA (Pat GhcTc) -> Pat GhcTc
    forall l e. GenLocated l e -> e
    unLoc GenLocated SrcSpanAnnA (Pat GhcTc)
    LPat GhcTc
    pat
                 eqn :: EquationInfo
    eqn = EqnInfo { eqn_pats :: [Pat GhcTc]
    eqn_pats = [Pat GhcTc
    upat],
                                 eqn_orig :: Origin
    eqn_orig = Origin
    FromSource,
                                 eqn_rhs :: MatchResult CoreExpr
    eqn_rhs = CoreExpr -> MatchResult CoreExpr
    cantFailMatchResult CoreExpr
    body }
           ; Id
    var    <- Type -> Pat GhcTc -> DsM Id
    selectMatchVar Type
    Many Pat GhcTc
    upat
                        -- `var` will end up in a let binder, so the multiplicity
                        -- doesn't matter.
           ; CoreExpr
    result <- HsMatchContext GhcRn
    -> [Id] -> [EquationInfo] -> Type -> DsM CoreExpr
    matchEquations HsMatchContext GhcRn
    forall p. HsMatchContext p
    PatBindRhs [Id
    var] [EquationInfo
    eqn] (CoreExpr -> Type
    exprType CoreExpr
    body)
           ; CoreExpr -> DsM CoreExpr
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Id -> CoreExpr -> CoreExpr -> CoreExpr
    bindNonRec Id
    var CoreExpr
    rhs CoreExpr
    result) }

    dsUnliftedBind HsBind GhcTc
    bind CoreExpr
    body = String -> SDoc -> DsM CoreExpr
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "dsLet: unlifted" (HsBind GhcTc -> SDoc
    forall {a}. Outputable a => a -> SDoc
    ppr HsBind GhcTc
    bind SDoc -> SDoc -> SDoc
    $$ CoreExpr -> SDoc
    forall {a}. Outputable a => a -> SDoc
    ppr CoreExpr
    body)

    {-
    ************************************************************************
    *                                                                      *
    *              Variables, constructors, literals                       *
    *                                                                      *
    ************************************************************************
    -}

    -- | Replace the body of the function with this block to test the hsExprType
    -- function in GHC.Tc.Utils.Zonk:
    -- putSrcSpanDs loc $ do
    --   { core_expr <- dsExpr e
    --   ; MASSERT2( exprType core_expr `eqType` hsExprType e
    --             , ppr e <+> dcolon <+> ppr (hsExprType e) $$
    --                 ppr core_expr <+> dcolon <+> ppr (exprType core_expr) )
    --   ; return core_expr }
    dsLExpr :: LHsExpr GhcTc -> DsM CoreExpr
    dsLExpr :: LHsExpr GhcTc -> DsM CoreExpr
    dsLExpr (L SrcSpanAnnA
    loc HsExpr GhcTc
    e) =
      SrcSpanAnnA -> DsM CoreExpr -> DsM CoreExpr
    forall ann a. SrcSpanAnn' ann -> DsM a -> DsM a
    putSrcSpanDsA SrcSpanAnnA
    loc (DsM CoreExpr -> DsM CoreExpr) -> DsM CoreExpr -> DsM CoreExpr
    forall a b. (a -> b) -> a -> b
    $ HsExpr GhcTc -> DsM CoreExpr
    dsExpr HsExpr GhcTc
    e

    -- | Variant of 'dsLExpr' that ensures that the result is not levity
    -- polymorphic. This should be used when the resulting expression will
    -- be an argument to some other function.
    -- See Note [Levity polymorphism checking] in "GHC.HsToCore.Monad"
    -- See Note [Levity polymorphism invariants] in "GHC.Core"
    dsLExprNoLP :: LHsExpr GhcTc -> DsM CoreExpr
    dsLExprNoLP :: LHsExpr GhcTc -> DsM CoreExpr
    dsLExprNoLP (L SrcSpanAnnA
    loc HsExpr GhcTc
    e)
      = SrcSpanAnnA -> DsM CoreExpr -> DsM CoreExpr
    forall ann a. SrcSpanAnn' ann -> DsM a -> DsM a
    putSrcSpanDsA SrcSpanAnnA
    loc (DsM CoreExpr -> DsM CoreExpr) -> DsM CoreExpr -> DsM CoreExpr
    forall a b. (a -> b) -> a -> b
    $
        do { CoreExpr
    e' <- HsExpr GhcTc -> DsM CoreExpr
    dsExpr HsExpr GhcTc
    e
           ; CoreExpr -> SDoc -> IOEnv (Env DsGblEnv DsLclEnv) ()
    dsNoLevPolyExpr CoreExpr
    e' (String -> SDoc
    text String
    "In the type of expression:" SDoc -> SDoc -> SDoc
    <+> HsExpr GhcTc -> SDoc
    forall {a}. Outputable a => a -> SDoc
    ppr HsExpr GhcTc
    e)
           ; CoreExpr -> DsM CoreExpr
    forall (m :: * -> *) a. Monad m => a -> m a
    return CoreExpr
    e' }

    dsExpr :: HsExpr GhcTc -> DsM CoreExpr
    dsExpr :: HsExpr GhcTc -> DsM CoreExpr
    dsExpr (HsVar    XVar GhcTc
    _ (L SrcSpanAnnN
    _ Id
    id))           = Id -> DsM CoreExpr
    dsHsVar Id
    id
    dsExpr (HsRecFld XRecFld GhcTc
    _ (Unambiguous XUnambiguous GhcTc
    id LocatedN RdrName
    _)) = Id -> DsM CoreExpr
    dsHsVar Id
    XUnambiguous GhcTc
    id
    dsExpr (HsRecFld XRecFld GhcTc
    _ (Ambiguous   XAmbiguous GhcTc
    id LocatedN RdrName
    _)) = Id -> DsM CoreExpr
    dsHsVar Id
    XAmbiguous GhcTc
    id
    dsExpr (HsUnboundVar (HER IORef EvTerm
    ref Type
    _ Unique
    _) OccName
    _)  = EvTerm -> DsM CoreExpr
    dsEvTerm (EvTerm -> DsM CoreExpr)
    -> IOEnv (Env DsGblEnv DsLclEnv) EvTerm -> DsM CoreExpr
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< IORef EvTerm -> IOEnv (Env DsGblEnv DsLclEnv) EvTerm
    forall a env. IORef a -> IOEnv env a
    readMutVar IORef EvTerm
    ref
            -- See Note [Holes] in GHC.Tc.Types.Constraint

    dsExpr (HsPar XPar GhcTc
    _ LHsExpr GhcTc
    e)            = LHsExpr GhcTc -> DsM CoreExpr
    dsLExpr LHsExpr GhcTc
    e
    dsExpr (ExprWithTySig XExprWithTySig GhcTc
    _ LHsExpr GhcTc
    e LHsSigWcType (NoGhcTc GhcTc)
    _)  = LHsExpr GhcTc -> DsM CoreExpr
    dsLExpr LHsExpr GhcTc
    e

    dsExpr (HsConLikeOut XConLikeOut GhcTc
    _ ConLike
    con)   = ConLike -> DsM CoreExpr
    dsConLike ConLike
    con
    dsExpr (HsIPVar {})           = String -> DsM CoreExpr
    forall a. String -> a
    panic String
    "dsExpr: HsIPVar"

    dsExpr (HsGetField XGetField GhcTc
    x LHsExpr GhcTc
    _ Located (HsFieldLabel GhcTc)
    _)     = Void -> DsM CoreExpr
    forall a. Void -> a
    absurd Void
    XGetField GhcTc
    x
    dsExpr (HsProjection XProjection GhcTc
    x NonEmpty (Located (HsFieldLabel GhcTc))
    _)     = Void -> DsM CoreExpr
    forall a. Void -> a
    absurd Void
    XProjection GhcTc
    x

    dsExpr (HsLit XLitE GhcTc
    _ HsLit GhcTc
    lit)
      = do { HsLit GhcTc -> IOEnv (Env DsGblEnv DsLclEnv) ()
    warnAboutOverflowedLit HsLit GhcTc
    lit
           ; HsLit GhcRn -> DsM CoreExpr
    dsLit (HsLit GhcTc -> HsLit GhcRn
    forall (p1 :: Pass) (p2 :: Pass).
    HsLit (GhcPass p1) -> HsLit (GhcPass p2)
    convertLit HsLit GhcTc
    lit) }

    dsExpr (HsOverLit XOverLitE GhcTc
    _ HsOverLit GhcTc
    lit)
      = do { HsOverLit GhcTc -> IOEnv (Env DsGblEnv DsLclEnv) ()
    warnAboutOverflowedOverLit HsOverLit GhcTc
    lit
           ; HsOverLit GhcTc -> DsM CoreExpr
    dsOverLit HsOverLit GhcTc
    lit }

    dsExpr e :: HsExpr GhcTc
    e@(XExpr XXExpr GhcTc
    expansion)
      = case XXExpr GhcTc
    expansion of
          ExpansionExpr (HsExpanded HsExpr GhcRn
    _ HsExpr GhcTc
    b) -> HsExpr GhcTc -> DsM CoreExpr
    dsExpr HsExpr GhcTc
    b
          WrapExpr {}                    -> HsExpr GhcTc -> DsM CoreExpr
    dsHsWrapped HsExpr GhcTc
    e

    dsExpr (NegApp XNegApp GhcTc
    _ (L SrcSpanAnnA
    loc
                        (HsOverLit XOverLitE GhcTc
    _ lit :: HsOverLit GhcTc
    lit@(OverLit { ol_val :: forall p. HsOverLit p -> OverLitVal
    ol_val = HsIntegral IntegralLit
    i})))
                    SyntaxExpr GhcTc
    neg_expr)
      = do { CoreExpr
    expr' <- SrcSpanAnnA -> DsM CoreExpr -> DsM CoreExpr
    forall ann a. SrcSpanAnn' ann -> DsM a -> DsM a
    putSrcSpanDsA SrcSpanAnnA
    loc (DsM CoreExpr -> DsM CoreExpr) -> DsM CoreExpr -> DsM CoreExpr
    forall a b. (a -> b) -> a -> b
    $ do
              { HsOverLit GhcTc -> IOEnv (Env DsGblEnv DsLclEnv) ()
    warnAboutOverflowedOverLit
                  (HsOverLit GhcTc
    lit { ol_val :: OverLitVal
    ol_val = IntegralLit -> OverLitVal
    HsIntegral (IntegralLit -> IntegralLit
    negateIntegralLit IntegralLit
    i) })
              ; HsOverLit GhcTc -> DsM CoreExpr
    dsOverLit HsOverLit GhcTc
    lit }
           ; SyntaxExpr GhcTc -> [CoreExpr] -> DsM CoreExpr
    dsSyntaxExpr SyntaxExpr GhcTc
    neg_expr [CoreExpr
    expr'] }

    dsExpr (NegApp XNegApp GhcTc
    _ LHsExpr GhcTc
    expr SyntaxExpr GhcTc
    neg_expr)
      = do { CoreExpr
    expr' <- LHsExpr GhcTc -> DsM CoreExpr
    dsLExpr LHsExpr GhcTc
    expr
           ; SyntaxExpr GhcTc -> [CoreExpr] -> DsM CoreExpr
    dsSyntaxExpr SyntaxExpr GhcTc
    neg_expr [CoreExpr
    expr'] }

    dsExpr (HsLam XLam GhcTc
    _ MatchGroup GhcTc (LHsExpr GhcTc)
    a_Match)
      = ([Id] -> CoreExpr -> CoreExpr) -> ([Id], CoreExpr) -> CoreExpr
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry [Id] -> CoreExpr -> CoreExpr
    forall b. [b] -> Expr b -> Expr b
    mkLams (([Id], CoreExpr) -> CoreExpr)
    -> DsM ([Id], CoreExpr) -> DsM CoreExpr
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> HsMatchContext GhcRn
    -> Maybe (LHsExpr GhcTc)
    -> MatchGroup GhcTc (LHsExpr GhcTc)
    -> DsM ([Id], CoreExpr)
    matchWrapper HsMatchContext GhcRn
    forall p. HsMatchContext p
    LambdaExpr Maybe (LHsExpr GhcTc)
    forall a. Maybe a
    Nothing MatchGroup GhcTc (LHsExpr GhcTc)
    a_Match

    dsExpr (HsLamCase XLamCase GhcTc
    _ MatchGroup GhcTc (LHsExpr GhcTc)
    matches)
      = do { ([Id
    discrim_var], CoreExpr
    matching_code) <- HsMatchContext GhcRn
    -> Maybe (LHsExpr GhcTc)
    -> MatchGroup GhcTc (LHsExpr GhcTc)
    -> DsM ([Id], CoreExpr)
    matchWrapper HsMatchContext GhcRn
    forall p. HsMatchContext p
    CaseAlt Maybe (LHsExpr GhcTc)
    forall a. Maybe a
    Nothing MatchGroup GhcTc (LHsExpr GhcTc)
    matches
           ; CoreExpr -> DsM CoreExpr
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CoreExpr -> DsM CoreExpr) -> CoreExpr -> DsM CoreExpr
    forall a b. (a -> b) -> a -> b
    $ Id -> CoreExpr -> CoreExpr
    forall b. b -> Expr b -> Expr b
    Lam Id
    discrim_var CoreExpr
    matching_code }

    dsExpr e :: HsExpr GhcTc
    e@(HsApp XApp GhcTc
    _ LHsExpr GhcTc
    fun LHsExpr GhcTc
    arg)
      = do { CoreExpr
    fun' <- LHsExpr GhcTc -> DsM CoreExpr
    dsLExpr LHsExpr GhcTc
    fun
           ; DsM CoreExpr -> (CoreExpr -> CoreExpr) -> DsM CoreExpr
    forall a. DsM a -> (a -> CoreExpr) -> DsM CoreExpr
    dsWhenNoErrs (LHsExpr GhcTc -> DsM CoreExpr
    dsLExprNoLP LHsExpr GhcTc
    arg)
                          (\CoreExpr
    arg' -> SDoc -> CoreExpr -> CoreExpr -> CoreExpr
    mkCoreAppDs (String -> SDoc
    text String
    "HsApp" SDoc -> SDoc -> SDoc
    <+> HsExpr GhcTc -> SDoc
    forall {a}. Outputable a => a -> SDoc
    ppr HsExpr GhcTc
    e) CoreExpr
    fun' CoreExpr
    arg') }

    dsExpr e :: HsExpr GhcTc
    e@(HsAppType {}) = HsExpr GhcTc -> DsM CoreExpr
    dsHsWrapped HsExpr GhcTc
    e

    {-
    Note [Desugaring vars]
    ~~~~~~~~~~~~~~~~~~~~~~
    In one situation we can get a *coercion* variable in a HsVar, namely
    the support method for an equality superclass:
       class (a~b) => C a b where ...
       instance (blah) => C (T a) (T b) where ..
    Then we get
       $dfCT :: forall ab. blah => C (T a) (T b)
       $dfCT ab blah = MkC ($c$p1C a blah) ($cop a blah)

       $c$p1C :: forall ab. blah => (T a ~ T b)
       $c$p1C ab blah = let ...; g :: T a ~ T b = ... } in g

    That 'g' in the 'in' part is an evidence variable, and when
    converting to core it must become a CO.
    -}

    dsExpr (ExplicitTuple XExplicitTuple GhcTc
    _ [HsTupArg GhcTc]
    tup_args Boxity
    boxity)
      = do { let go :: ([Id], [CoreExpr])
    -> HsTupArg GhcTc
    -> IOEnv (Env DsGblEnv DsLclEnv) ([Id], [CoreExpr])
    go ([Id]
    lam_vars, [CoreExpr]
    args) (Missing (Scaled Type
    mult Type
    ty))
                        -- For every missing expression, we need
                        -- another lambda in the desugaring.
                   = do { Id
    lam_var <- Type -> Type -> DsM Id
    newSysLocalDsNoLP Type
    mult Type
    ty
                        ; ([Id], [CoreExpr])
    -> IOEnv (Env DsGblEnv DsLclEnv) ([Id], [CoreExpr])
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Id
    lam_var Id -> [Id] -> [Id]
    forall a. a -> [a] -> [a]
    : [Id]
    lam_vars, Id -> CoreExpr
    forall b. Id -> Expr b
    Var Id
    lam_var CoreExpr -> [CoreExpr] -> [CoreExpr]
    forall a. a -> [a] -> [a]
    : [CoreExpr]
    args) }
                 go ([Id]
    lam_vars, [CoreExpr]
    args) (Present XPresent GhcTc
    _ LHsExpr GhcTc
    expr)
                        -- Expressions that are present don't generate
                        -- lambdas, just arguments.
                   = do { CoreExpr
    core_expr <- LHsExpr GhcTc -> DsM CoreExpr
    dsLExprNoLP LHsExpr GhcTc
    expr
                        ; ([Id], [CoreExpr])
    -> IOEnv (Env DsGblEnv DsLclEnv) ([Id], [CoreExpr])
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Id]
    lam_vars, CoreExpr
    core_expr CoreExpr -> [CoreExpr] -> [CoreExpr]
    forall a. a -> [a] -> [a]
    : [CoreExpr]
    args) }

           ; IOEnv (Env DsGblEnv DsLclEnv) ([Id], [CoreExpr])
    -> (([Id], [CoreExpr]) -> CoreExpr) -> DsM CoreExpr
    forall a. DsM a -> (a -> CoreExpr) -> DsM CoreExpr
    dsWhenNoErrs ((([Id], [CoreExpr])
     -> HsTupArg GhcTc
     -> IOEnv (Env DsGblEnv DsLclEnv) ([Id], [CoreExpr]))
    -> ([Id], [CoreExpr])
    -> [HsTupArg GhcTc]
    -> IOEnv (Env DsGblEnv DsLclEnv) ([Id], [CoreExpr])
    forall (t :: * -> *) (m :: * -> *) b a.
    (Foldable t, Monad m) =>
    (b -> a -> m b) -> b -> t a -> m b
    foldM ([Id], [CoreExpr])
    -> HsTupArg GhcTc
    -> IOEnv (Env DsGblEnv DsLclEnv) ([Id], [CoreExpr])
    go ([], []) ([HsTupArg GhcTc] -> [HsTupArg GhcTc]
    forall a. [a] -> [a]
    reverse [HsTupArg GhcTc]
    tup_args))
                    -- The reverse is because foldM goes left-to-right
                          (\([Id]
    lam_vars, [CoreExpr]
    args) ->
                            [Id] -> CoreExpr -> CoreExpr
    mkCoreLams [Id]
    lam_vars (CoreExpr -> CoreExpr) -> CoreExpr -> CoreExpr
    forall a b. (a -> b) -> a -> b
    $
                              Boxity -> [CoreExpr] -> CoreExpr
    mkCoreTupBoxity Boxity
    boxity [CoreExpr]
    args) }
                            -- See Note [Don't flatten tuples from HsSyn] in GHC.Core.Make

    dsExpr (ExplicitSum XExplicitSum GhcTc
    types Int
    alt Int
    arity LHsExpr GhcTc
    expr)
      = DsM CoreExpr -> (CoreExpr -> CoreExpr) -> DsM CoreExpr
    forall a. DsM a -> (a -> CoreExpr) -> DsM CoreExpr
    dsWhenNoErrs (LHsExpr GhcTc -> DsM CoreExpr
    dsLExprNoLP LHsExpr GhcTc
    expr) (Int -> Int -> [Type] -> CoreExpr -> CoreExpr
    mkCoreUbxSum Int
    arity Int
    alt [Type]
    XExplicitSum GhcTc
    types)

    dsExpr (HsPragE XPragE GhcTc
    _ HsPragE GhcTc
    prag LHsExpr GhcTc
    expr) =
      HsPragE GhcTc -> LHsExpr GhcTc -> DsM CoreExpr
    ds_prag_expr HsPragE GhcTc
    prag LHsExpr GhcTc
    expr

    dsExpr (HsCase XCase GhcTc
    _ LHsExpr GhcTc
    discrim MatchGroup GhcTc (LHsExpr GhcTc)
    matches)
      = do { CoreExpr
    core_discrim <- LHsExpr GhcTc -> DsM CoreExpr
    dsLExpr LHsExpr GhcTc
    discrim
           ; ([Id
    discrim_var], CoreExpr
    matching_code) <- HsMatchContext GhcRn
    -> Maybe (LHsExpr GhcTc)
    -> MatchGroup GhcTc (LHsExpr GhcTc)
    -> DsM ([Id], CoreExpr)
    matchWrapper HsMatchContext GhcRn
    forall p. HsMatchContext p
    CaseAlt (GenLocated SrcSpanAnnA (HsExpr GhcTc)
    -> Maybe (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    forall a. a -> Maybe a
    Just GenLocated SrcSpanAnnA (HsExpr GhcTc)
    LHsExpr GhcTc
    discrim) MatchGroup GhcTc (LHsExpr GhcTc)
    matches
           ; CoreExpr -> DsM CoreExpr
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Id -> CoreExpr -> CoreExpr -> CoreExpr
    bindNonRec Id
    discrim_var CoreExpr
    core_discrim CoreExpr
    matching_code) }

    -- Pepe: The binds are in scope in the body but NOT in the binding group
    --       This is to avoid silliness in breakpoints
    dsExpr (HsLet XLet GhcTc
    _ HsLocalBinds GhcTc
    binds LHsExpr GhcTc
    body) = do
        CoreExpr
    body' <- LHsExpr GhcTc -> DsM CoreExpr
    dsLExpr LHsExpr GhcTc
    body
        HsLocalBinds GhcTc -> CoreExpr -> DsM CoreExpr
    dsLocalBinds HsLocalBinds GhcTc
    binds CoreExpr
    body'

    -- We need the `ListComp' form to use `deListComp' (rather than the "do" form)
    -- because the interpretation of `stmts' depends on what sort of thing it is.
    --
    dsExpr (HsDo XDo GhcTc
    res_ty HsStmtContext (HsDoRn GhcTc)
    ListComp (L SrcSpanAnnL
    _ [GenLocated
       SrcSpanAnnA
       (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
    stmts)) = [ExprLStmt GhcTc] -> Type -> DsM CoreExpr
    dsListComp [GenLocated
       SrcSpanAnnA
       (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
    [ExprLStmt GhcTc]
    stmts Type
    XDo GhcTc
    res_ty
    dsExpr (HsDo XDo GhcTc
    _ ctx :: HsStmtContext (HsDoRn GhcTc)
    ctx@DoExpr{}      (L SrcSpanAnnL
    _ [GenLocated
       SrcSpanAnnA
       (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
    stmts)) = HsStmtContext GhcRn -> [ExprLStmt GhcTc] -> DsM CoreExpr
    dsDo HsStmtContext GhcRn
    HsStmtContext (HsDoRn GhcTc)
    ctx [GenLocated
       SrcSpanAnnA
       (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
    [ExprLStmt GhcTc]
    stmts
    dsExpr (HsDo XDo GhcTc
    _ ctx :: HsStmtContext (HsDoRn GhcTc)
    ctx@HsStmtContext (HsDoRn GhcTc)
    GhciStmtCtxt  (L SrcSpanAnnL
    _ [GenLocated
       SrcSpanAnnA
       (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
    stmts)) = HsStmtContext GhcRn -> [ExprLStmt GhcTc] -> DsM CoreExpr
    dsDo HsStmtContext GhcRn
    HsStmtContext (HsDoRn GhcTc)
    ctx [GenLocated
       SrcSpanAnnA
       (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
    [ExprLStmt GhcTc]
    stmts
    dsExpr (HsDo XDo GhcTc
    _ ctx :: HsStmtContext (HsDoRn GhcTc)
    ctx@MDoExpr{}     (L SrcSpanAnnL
    _ [GenLocated
       SrcSpanAnnA
       (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
    stmts)) = HsStmtContext GhcRn -> [ExprLStmt GhcTc] -> DsM CoreExpr
    dsDo HsStmtContext GhcRn
    HsStmtContext (HsDoRn GhcTc)
    ctx [GenLocated
       SrcSpanAnnA
       (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
    [ExprLStmt GhcTc]
    stmts
    dsExpr (HsDo XDo GhcTc
    _ HsStmtContext (HsDoRn GhcTc)
    MonadComp     (L SrcSpanAnnL
    _ [GenLocated
       SrcSpanAnnA
       (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
    stmts)) = [ExprLStmt GhcTc] -> DsM CoreExpr
    dsMonadComp [GenLocated
       SrcSpanAnnA
       (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
    [ExprLStmt GhcTc]
    stmts

    dsExpr (HsIf XIf GhcTc
    _ LHsExpr GhcTc
    guard_expr LHsExpr GhcTc
    then_expr LHsExpr GhcTc
    else_expr)
      = do { CoreExpr
    pred <- LHsExpr GhcTc -> DsM CoreExpr
    dsLExpr LHsExpr GhcTc
    guard_expr
           ; CoreExpr
    b1 <- LHsExpr GhcTc -> DsM CoreExpr
    dsLExpr LHsExpr GhcTc
    then_expr
           ; CoreExpr
    b2 <- LHsExpr GhcTc -> DsM CoreExpr
    dsLExpr LHsExpr GhcTc
    else_expr
           ; CoreExpr -> DsM CoreExpr
    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 -> CoreExpr
    mkIfThenElse CoreExpr
    pred CoreExpr
    b1 CoreExpr
    b2 }

    dsExpr (HsMultiIf XMultiIf GhcTc
    res_ty [LGRHS GhcTc (LHsExpr GhcTc)]
    alts)
      | [GenLocated
       SrcSpan (GRHS GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
    -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [GenLocated
       SrcSpan (GRHS GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
    [LGRHS GhcTc (LHsExpr GhcTc)]
    alts
      = DsM CoreExpr
    mkErrorExpr

      | Bool
    otherwise
      = do { let grhss :: GRHSs GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    grhss = XCGRHSs GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    -> [LGRHS GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))]
    -> HsLocalBinds GhcTc
    -> GRHSs GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    forall p body.
    XCGRHSs p body -> [LGRHS p body] -> HsLocalBinds p -> GRHSs p body
    GRHSs EpAnnComments
    XCGRHSs GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    emptyComments  [LGRHS GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))]
    [LGRHS GhcTc (LHsExpr GhcTc)]
    alts HsLocalBinds GhcTc
    forall (a :: Pass) (b :: Pass).
    HsLocalBindsLR (GhcPass a) (GhcPass b)
    emptyLocalBinds
           ; NonEmpty Nablas
    rhss_nablas  <- HsMatchContext GhcRn
    -> GRHSs GhcTc (LHsExpr GhcTc) -> DsM (NonEmpty Nablas)
    pmcGRHSs HsMatchContext GhcRn
    forall p. HsMatchContext p
    IfAlt GRHSs GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    GRHSs GhcTc (LHsExpr GhcTc)
    grhss
           ; MatchResult CoreExpr
    match_result <- HsMatchContext GhcRn
    -> GRHSs GhcTc (LHsExpr GhcTc)
    -> Type
    -> NonEmpty Nablas
    -> DsM (MatchResult CoreExpr)
    dsGRHSs HsMatchContext GhcRn
    forall p. HsMatchContext p
    IfAlt GRHSs GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    GRHSs GhcTc (LHsExpr GhcTc)
    grhss Type
    XMultiIf GhcTc
    res_ty NonEmpty Nablas
    rhss_nablas
           ; CoreExpr
    error_expr   <- DsM CoreExpr
    mkErrorExpr
           ; MatchResult CoreExpr -> CoreExpr -> DsM CoreExpr
    extractMatchResult MatchResult CoreExpr
    match_result CoreExpr
    error_expr }
      where
        mkErrorExpr :: DsM CoreExpr
    mkErrorExpr = Id -> Type -> SDoc -> DsM CoreExpr
    mkErrorAppDs Id
    nON_EXHAUSTIVE_GUARDS_ERROR_ID Type
    XMultiIf GhcTc
    res_ty
                                   (String -> SDoc
    text String
    "multi-way if")

    {-
    \noindent
    \underline{\bf Various data construction things}
                 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    -}

    dsExpr (ExplicitList XExplicitList GhcTc
    elt_ty [LHsExpr GhcTc]
    xs) = Type -> [LHsExpr GhcTc] -> DsM CoreExpr
    dsExplicitList Type
    XExplicitList GhcTc
    elt_ty [LHsExpr GhcTc]
    xs

    dsExpr (ArithSeq XArithSeq GhcTc
    expr Maybe (SyntaxExpr GhcTc)
    witness ArithSeqInfo GhcTc
    seq)
      = case Maybe (SyntaxExpr GhcTc)
    witness of
         Maybe (SyntaxExpr GhcTc)
    Nothing -> HsExpr GhcTc -> ArithSeqInfo GhcTc -> DsM CoreExpr
    dsArithSeq XArithSeq GhcTc
    HsExpr GhcTc
    expr ArithSeqInfo GhcTc
    seq
         Just SyntaxExpr GhcTc
    fl -> do { CoreExpr
    newArithSeq <- HsExpr GhcTc -> ArithSeqInfo GhcTc -> DsM CoreExpr
    dsArithSeq XArithSeq GhcTc
    HsExpr GhcTc
    expr ArithSeqInfo GhcTc
    seq
                       ; SyntaxExpr GhcTc -> [CoreExpr] -> DsM CoreExpr
    dsSyntaxExpr SyntaxExpr GhcTc
    fl [CoreExpr
    newArithSeq] }

    {-
    Static Pointers
    ~~~~~~~~~~~~~~~

    See Note [Grand plan for static forms] in GHC.Iface.Tidy.StaticPtrTable for an overview.

        g = ... static f ...
    ==>
        g = ... makeStatic loc f ...
    -}

    dsExpr (HsStatic XStatic GhcTc
    _ expr :: LHsExpr GhcTc
    expr@(L SrcSpanAnnA
    loc HsExpr GhcTc
    _)) = do
        CoreExpr
    expr_ds <- LHsExpr GhcTc -> DsM CoreExpr
    dsLExprNoLP LHsExpr GhcTc
    expr
        let ty :: Type
    ty = CoreExpr -> Type
    exprType CoreExpr
    expr_ds
        Id
    makeStaticId <- Name -> DsM Id
    dsLookupGlobalId Name
    makeStaticName

        DynFlags
    dflags <- IOEnv (Env DsGblEnv DsLclEnv) DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
        let platform :: Platform
    platform = DynFlags -> Platform
    targetPlatform DynFlags
    dflags
        let (Int
    line, Int
    col) = case SrcSpanAnnA -> SrcSpan
    forall a. SrcSpanAnn' a -> SrcSpan
    locA SrcSpanAnnA
    loc of
               RealSrcSpan RealSrcSpan
    r Maybe BufSpan
    _ ->
                                ( RealSrcLoc -> Int
    srcLocLine (RealSrcLoc -> Int) -> RealSrcLoc -> Int
    forall a b. (a -> b) -> a -> b
    $ RealSrcSpan -> RealSrcLoc
    realSrcSpanStart RealSrcSpan
    r
                                , RealSrcLoc -> Int
    srcLocCol  (RealSrcLoc -> Int) -> RealSrcLoc -> Int
    forall a b. (a -> b) -> a -> b
    $ RealSrcSpan -> RealSrcLoc
    realSrcSpanStart RealSrcSpan
    r
                                )
               SrcSpan
    _             -> (Int
    0, Int
    0)
            srcLoc :: CoreExpr
    srcLoc = DataCon -> [CoreExpr] -> CoreExpr
    mkCoreConApps (Boxity -> Int -> DataCon
    tupleDataCon Boxity
    Boxed Int
    2)
                         [ Type -> CoreExpr
    forall b. Type -> Expr b
    Type Type
    intTy              , Type -> CoreExpr
    forall b. Type -> Expr b
    Type Type
    intTy
                         , Platform -> Int -> CoreExpr
    mkIntExprInt Platform
    platform Int
    line, Platform -> Int -> CoreExpr
    mkIntExprInt Platform
    platform Int
    col
                         ]

        SrcSpanAnnA -> DsM CoreExpr -> DsM CoreExpr
    forall ann a. SrcSpanAnn' ann -> DsM a -> DsM a
    putSrcSpanDsA SrcSpanAnnA
    loc (DsM CoreExpr -> DsM CoreExpr) -> DsM CoreExpr -> DsM CoreExpr
    forall a b. (a -> b) -> a -> b
    $ CoreExpr -> DsM CoreExpr
    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
    mkCoreApps (Id -> CoreExpr
    forall b. Id -> Expr b
    Var Id
    makeStaticId) [ Type -> CoreExpr
    forall b. Type -> Expr b
    Type Type
    ty, CoreExpr
    srcLoc, CoreExpr
    expr_ds ]

    {-
    \noindent
    \underline{\bf Record construction and update}
                 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    For record construction we do this (assuming T has three arguments)
    \begin{verbatim}
            T { op2 = e }
    ==>
            let err = /\a -> recConErr a
            T (recConErr t1 "M.hs/230/op1")
              e
              (recConErr t1 "M.hs/230/op3")
    \end{verbatim}
    @recConErr@ then converts its argument string into a proper message
    before printing it as
    \begin{verbatim}
            M.hs, line 230: missing field op1 was evaluated
    \end{verbatim}

    We also handle @C{}@ as valid construction syntax for an unlabelled
    constructor @C@, setting all of @C@'s fields to bottom.
    -}

    dsExpr (RecordCon { rcon_con :: forall p. HsExpr p -> XRec p (ConLikeP p)
    rcon_con  = L SrcSpanAnnN
    _ ConLike
    con_like
                      , rcon_flds :: forall p. HsExpr p -> HsRecordBinds p
    rcon_flds = HsRecordBinds GhcTc
    rbinds
                      , rcon_ext :: forall p. HsExpr p -> XRecordCon p
    rcon_ext  = XRecordCon GhcTc
    con_expr })
      = do { CoreExpr
    con_expr' <- HsExpr GhcTc -> DsM CoreExpr
    dsExpr XRecordCon GhcTc
    HsExpr GhcTc
    con_expr
           ; let
                 ([Scaled Type]
    arg_tys, Type
    _) = Type -> ([Scaled Type], Type)
    tcSplitFunTys (CoreExpr -> Type
    exprType CoreExpr
    con_expr')
                 -- A newtype in the corner should be opaque;
                 -- hence TcType.tcSplitFunTys

                 mk_arg :: (Type, FieldLabel) -> DsM CoreExpr
    mk_arg (Type
    arg_ty, FieldLabel
    fl)
                   = case [LHsRecField GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))]
    -> Name -> [GenLocated SrcSpanAnnA (HsExpr GhcTc)]
    forall arg. [LHsRecField GhcTc arg] -> Name -> [arg]
    findField (HsRecFields GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    -> [LHsRecField GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))]
    forall p arg. HsRecFields p arg -> [LHsRecField p arg]
    rec_flds HsRecFields GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    HsRecordBinds GhcTc
    rbinds) (FieldLabel -> Name
    flSelector FieldLabel
    fl) of
                       (GenLocated SrcSpanAnnA (HsExpr GhcTc)
    rhs:[GenLocated SrcSpanAnnA (HsExpr GhcTc)]
    rhss) -> ASSERT( null rhss )
                                     LHsExpr GhcTc -> DsM CoreExpr
    dsLExprNoLP GenLocated SrcSpanAnnA (HsExpr GhcTc)
    LHsExpr GhcTc
    rhs
                       []         -> Id -> Type -> SDoc -> DsM CoreExpr
    mkErrorAppDs Id
    rEC_CON_ERROR_ID Type
    arg_ty (FieldLabelString -> SDoc
    forall {a}. Outputable a => a -> SDoc
    ppr (FieldLabel -> FieldLabelString
    flLabel FieldLabel
    fl))
                 unlabelled_bottom :: Type -> DsM CoreExpr
    unlabelled_bottom Type
    arg_ty = Id -> Type -> SDoc -> DsM CoreExpr
    mkErrorAppDs Id
    rEC_CON_ERROR_ID Type
    arg_ty SDoc
    Outputable.empty

                 labels :: [FieldLabel]
    labels = ConLike -> [FieldLabel]
    conLikeFieldLabels ConLike
    con_like

           ; [CoreExpr]
    con_args <- if [FieldLabel] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [FieldLabel]
    labels
                         then (Type -> DsM CoreExpr)
    -> [Type] -> IOEnv (Env DsGblEnv DsLclEnv) [CoreExpr]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM Type -> DsM CoreExpr
    unlabelled_bottom ((Scaled Type -> Type) -> [Scaled Type] -> [Type]
    forall a b. (a -> b) -> [a] -> [b]
    map Scaled Type -> Type
    forall a. Scaled a -> a
    scaledThing [Scaled Type]
    arg_tys)
                         else ((Type, FieldLabel) -> DsM CoreExpr)
    -> [(Type, FieldLabel)] -> IOEnv (Env DsGblEnv DsLclEnv) [CoreExpr]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (Type, FieldLabel) -> DsM CoreExpr
    mk_arg (String -> [Type] -> [FieldLabel] -> [(Type, FieldLabel)]
    forall a b. String -> [a] -> [b] -> [(a, b)]
    zipEqual String
    "dsExpr:RecordCon" ((Scaled Type -> Type) -> [Scaled Type] -> [Type]
    forall a b. (a -> b) -> [a] -> [b]
    map Scaled Type -> Type
    forall a. Scaled a -> a
    scaledThing [Scaled Type]
    arg_tys) [FieldLabel]
    labels)

           ; CoreExpr -> DsM CoreExpr
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CoreExpr -> [CoreExpr] -> CoreExpr
    mkCoreApps CoreExpr
    con_expr' [CoreExpr]
    con_args) }

    {-
    Record update is a little harder. Suppose we have the decl:
    \begin{verbatim}
            data T = T1 {op1, op2, op3 :: Int}
                   | T2 {op4, op2 :: Int}
                   | T3
    \end{verbatim}
    Then we translate as follows:
    \begin{verbatim}
            r { op2 = e }
    ===>
            let op2 = e in
            case r of
              T1 op1 _ op3 -> T1 op1 op2 op3
              T2 op4 _     -> T2 op4 op2
              other        -> recUpdError "M.hs/230"
    \end{verbatim}
    It's important that we use the constructor Ids for @T1@, @T2@ etc on the
    RHSs, and do not generate a Core constructor application directly, because the constructor
    might do some argument-evaluation first; and may have to throw away some
    dictionaries.

    Note [Update for GADTs]
    ~~~~~~~~~~~~~~~~~~~~~~~
    Consider
       data T a b where
         MkT :: { foo :: a } -> T a Int

       upd :: T s t -> s -> T s t
       upd z y = z { foo = y}

    We need to get this:
       $WMkT :: a -> T a Int
       MkT   :: (b ~# Int) => a -> T a b

       upd = /\s t. \(z::T s t) (y::s) ->
             case z of
                MkT (co :: t ~# Int) _ -> $WMkT @s y |> T (Refl s) (Sym co)

    Note the final cast
       T (Refl s) (Sym co) :: T s Int ~ T s t
    which uses co, bound by the GADT match.  This is the wrap_co coercion
    in wrapped_rhs. How do we produce it?

    * Start with raw materials
        tc, the tycon:                                       T
        univ_tvs, the universally quantified tyvars of MkT:  a,b
      NB: these are in 1-1 correspondence with the tyvars of tc

    * Form univ_cos, a coercion for each of tc's args: (Refl s) (Sym co)
      We replaced
         a  by  (Refl s)    since 's' instantiates 'a'
         b  by  (Sym co)   since 'b' is in the data-con's EqSpec

    * Then form the coercion T (Refl s) (Sym co)

    It gets more complicated when data families are involved (#18809).
    Consider
        data family F x
        data instance F (a,b) where
          MkF :: { foo :: Int } -> F (Int,b)

        bar :: F (s,t) -> Int -> F (s,t)
        bar z y = z { foo = y}

    We have
        data R:FPair a b where
          MkF :: { foo :: Int } -> R:FPair Int b

        $WMkF :: Int -> F (Int,b)
        MkF :: forall a b. (a ~# Int) => Int -> R:FPair a b

        bar :: F (s,t) -> Int -> F (s,t)
        bar = /\s t. \(z::F (s,t)) \(y::Int) ->
             case z |> co1 of
                MkF (co2::s ~# Int) _ -> $WMkF @t y |> co3

    (Side note: here (z |> co1) is built by typechecking the scrutinee, so
    we ignore it here.  In general the scrutinee is an arbitrary expression.)

    The question is: what is co3, the cast for the RHS?
          co3 :: F (Int,t) ~ F (s,t)
    Again, we can construct it using co2, bound by the GADT match.
    We do /exactly/ the same as the non-family case up to building
    univ_cos.  But that gives us
         rep_tc:   R:FPair
         univ_cos: (Sym co2)   (Refl t)
    But then we use mkTcFamilyTyConAppCo to "lift" this to the coercion
    we want, namely
         F (Sym co2, Refl t) :: F (Int,t) ~ F (s,t)

    -}

    dsExpr RecordUpd { rupd_flds :: forall p. HsExpr p -> Either [LHsRecUpdField p] [LHsRecUpdProj p]
    rupd_flds = Right [LHsRecUpdProj GhcTc]
    _} =
      -- Not possible due to elimination in the renamer. See Note
      -- [Handling overloaded and rebindable constructs]
      String -> DsM CoreExpr
    forall a. String -> a
    panic String
    "The impossible happened"
    dsExpr expr :: HsExpr GhcTc
    expr@(RecordUpd { rupd_expr :: forall p. HsExpr p -> LHsExpr p
    rupd_expr = LHsExpr GhcTc
    record_expr, rupd_flds :: forall p. HsExpr p -> Either [LHsRecUpdField p] [LHsRecUpdProj p]
    rupd_flds = Left [LHsRecUpdField GhcTc]
    fields
                           , rupd_ext :: forall p. HsExpr p -> XRecordUpd p
    rupd_ext = RecordUpdTc
                               { rupd_cons :: RecordUpdTc -> [ConLike]
    rupd_cons = [ConLike]
    cons_to_upd
                               , rupd_in_tys :: RecordUpdTc -> [Type]
    rupd_in_tys = [Type]
    in_inst_tys
                               , rupd_out_tys :: RecordUpdTc -> [Type]
    rupd_out_tys = [Type]
    out_inst_tys
                               , rupd_wrap :: RecordUpdTc -> HsWrapper
    rupd_wrap = HsWrapper
    dict_req_wrap }} )
      | [GenLocated
       SrcSpanAnnA
       (HsRecField'
          (AmbiguousFieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
    -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [GenLocated
       SrcSpanAnnA
       (HsRecField'
          (AmbiguousFieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
    [LHsRecUpdField GhcTc]
    fields
      = LHsExpr GhcTc -> DsM CoreExpr
    dsLExpr LHsExpr GhcTc
    record_expr
      | Bool
    otherwise
      = ASSERT2( notNull cons_to_upd, ppr expr )

        do  { CoreExpr
    record_expr' <- LHsExpr GhcTc -> DsM CoreExpr
    dsLExpr LHsExpr GhcTc
    record_expr
            ; [(Name, Id, CoreExpr)]
    field_binds' <- (GenLocated
       SrcSpanAnnA
       (HsRecField'
          (AmbiguousFieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
     -> IOEnv (Env DsGblEnv DsLclEnv) (Name, Id, CoreExpr))
    -> [GenLocated
          SrcSpanAnnA
          (HsRecField'
             (AmbiguousFieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
    -> IOEnv (Env DsGblEnv DsLclEnv) [(Name, Id, CoreExpr)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM GenLocated
      SrcSpanAnnA
      (HsRecField'
         (AmbiguousFieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
    -> IOEnv (Env DsGblEnv DsLclEnv) (Name, Id, CoreExpr)
    LHsRecUpdField GhcTc
    -> IOEnv (Env DsGblEnv DsLclEnv) (Name, Id, CoreExpr)
    ds_field [GenLocated
       SrcSpanAnnA
       (HsRecField'
          (AmbiguousFieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
    [LHsRecUpdField GhcTc]
    fields
            ; let upd_fld_env :: NameEnv Id -- Maps field name to the LocalId of the field binding
                  upd_fld_env :: NameEnv Id
    upd_fld_env = [(Name, Id)] -> NameEnv Id
    forall a. [(Name, a)] -> NameEnv a
    mkNameEnv [(Name
    f,Id
    l) | (Name
    f,Id
    l,CoreExpr
    _) <- [(Name, Id, CoreExpr)]
    field_binds']

            -- It's important to generate the match with matchWrapper,
            -- and the right hand sides with applications of the wrapper Id
            -- so that everything works when we are doing fancy unboxing on the
            -- constructor arguments.
            ; [GenLocated
       SrcSpanAnnA (Match GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
    alts <- (ConLike
     -> IOEnv
          (Env DsGblEnv DsLclEnv)
          (GenLocated
             SrcSpanAnnA (Match GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))))
    -> [ConLike]
    -> IOEnv
         (Env DsGblEnv DsLclEnv)
         [GenLocated
            SrcSpanAnnA (Match GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (NameEnv Id
    -> ConLike
    -> IOEnv
         (Env DsGblEnv DsLclEnv)
         (GenLocated
            SrcSpanAnnA (Match GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))))
    mk_alt NameEnv Id
    upd_fld_env) [ConLike]
    cons_to_upd
            ; ([Id
    discrim_var], CoreExpr
    matching_code)
                    <- HsMatchContext GhcRn
    -> Maybe (LHsExpr GhcTc)
    -> MatchGroup GhcTc (LHsExpr GhcTc)
    -> DsM ([Id], CoreExpr)
    matchWrapper HsMatchContext GhcRn
    forall p. HsMatchContext p
    RecUpd (GenLocated SrcSpanAnnA (HsExpr GhcTc)
    -> Maybe (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    forall a. a -> Maybe a
    Just GenLocated SrcSpanAnnA (HsExpr GhcTc)
    LHsExpr GhcTc
    record_expr) -- See Note [Scrutinee in Record updates]
                                          (MG { mg_alts :: XRec GhcTc [LMatch GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))]
    mg_alts = [GenLocated
       SrcSpanAnnA (Match GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
    -> LocatedAn
         AnnList
         [GenLocated
            SrcSpanAnnA (Match GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
    forall a an. a -> LocatedAn an a
    noLocA [GenLocated
       SrcSpanAnnA (Match GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
    alts
                                              , mg_ext :: XMG GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    mg_ext = [Scaled Type] -> Type -> MatchGroupTc
    MatchGroupTc [Type -> Scaled Type
    forall a. a -> Scaled a
    unrestricted Type
    in_ty] Type
    out_ty
                                              , mg_origin :: Origin
    mg_origin = Origin
    FromSource
                                              })
                                         -- FromSource is not strictly right, but we
                                         -- want incomplete pattern-match warnings

            ; CoreExpr -> DsM CoreExpr
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([(Name, Id, CoreExpr)] -> CoreExpr -> CoreExpr
    forall {a}. [(a, Id, CoreExpr)] -> CoreExpr -> CoreExpr
    add_field_binds [(Name, Id, CoreExpr)]
    field_binds' (CoreExpr -> CoreExpr) -> CoreExpr -> CoreExpr
    forall a b. (a -> b) -> a -> b
    $
                      Id -> CoreExpr -> CoreExpr -> CoreExpr
    bindNonRec Id
    discrim_var CoreExpr
    record_expr' CoreExpr
    matching_code) }
      where
        ds_field :: LHsRecUpdField GhcTc -> DsM (Name, Id, CoreExpr)
          -- Clone the Id in the HsRecField, because its Name is that
          -- of the record selector, and we must not make that a local binder
          -- else we shadow other uses of the record selector
          -- Hence 'lcl_id'.  Cf #2735
        ds_field :: LHsRecUpdField GhcTc
    -> IOEnv (Env DsGblEnv DsLclEnv) (Name, Id, CoreExpr)
    ds_field (L SrcSpanAnnA
    _ HsRecField'
      (AmbiguousFieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    rec_field)
          = do { CoreExpr
    rhs <- LHsExpr GhcTc -> DsM CoreExpr
    dsLExpr (HsRecField'
      (AmbiguousFieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    -> GenLocated SrcSpanAnnA (HsExpr GhcTc)
    forall id arg. HsRecField' id arg -> arg
    hsRecFieldArg HsRecField'
      (AmbiguousFieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    rec_field)
               ; let fld_id :: Id
    fld_id = GenLocated SrcSpan Id -> Id
    forall l e. GenLocated l e -> e
    unLoc (HsRecField'
      (AmbiguousFieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    -> GenLocated SrcSpan Id
    forall arg.
    HsRecField' (AmbiguousFieldOcc GhcTc) arg -> GenLocated SrcSpan Id
    hsRecUpdFieldId HsRecField'
      (AmbiguousFieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    rec_field)
               ; Id
    lcl_id <- Type -> Type -> DsM Id
    newSysLocalDs (Id -> Type
    idMult Id
    fld_id) (Id -> Type
    idType Id
    fld_id)
               ; (Name, Id, CoreExpr)
    -> IOEnv (Env DsGblEnv DsLclEnv) (Name, Id, CoreExpr)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Id -> Name
    idName Id
    fld_id, Id
    lcl_id, CoreExpr
    rhs) }

        add_field_binds :: [(a, Id, CoreExpr)] -> CoreExpr -> CoreExpr
    add_field_binds [] CoreExpr
    expr = CoreExpr
    expr
        add_field_binds ((a
    _,Id
    b,CoreExpr
    r):[(a, Id, CoreExpr)]
    bs) CoreExpr
    expr = Id -> CoreExpr -> CoreExpr -> CoreExpr
    bindNonRec Id
    b CoreExpr
    r ([(a, Id, CoreExpr)] -> CoreExpr -> CoreExpr
    add_field_binds [(a, Id, CoreExpr)]
    bs CoreExpr
    expr)

            -- Awkwardly, for families, the match goes
            -- from instance type to family type
        (Type
    in_ty, Type
    out_ty) =
          case ([ConLike] -> ConLike
    forall a. [a] -> a
    head [ConLike]
    cons_to_upd) of
            RealDataCon DataCon
    data_con ->
              let tycon :: TyCon
    tycon = DataCon -> TyCon
    dataConTyCon DataCon
    data_con in
              (TyCon -> [Type] -> Type
    mkTyConApp TyCon
    tycon [Type]
    in_inst_tys, TyCon -> [Type] -> Type
    mkFamilyTyConApp TyCon
    tycon [Type]
    out_inst_tys)
            PatSynCon PatSyn
    pat_syn ->
              ( PatSyn -> [Type] -> Type
    patSynInstResTy PatSyn
    pat_syn [Type]
    in_inst_tys
              , PatSyn -> [Type] -> Type
    patSynInstResTy PatSyn
    pat_syn [Type]
    out_inst_tys)
        mk_alt :: NameEnv Id
    -> ConLike
    -> IOEnv
         (Env DsGblEnv DsLclEnv)
         (GenLocated
            SrcSpanAnnA (Match GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))))
    mk_alt NameEnv Id
    upd_fld_env ConLike
    con
          = do { let ([Id]
    univ_tvs, [Id]
    ex_tvs, [EqSpec]
    eq_spec,
                      [Type]
    prov_theta, [Type]
    _req_theta, [Scaled Type]
    arg_tys, Type
    _) = ConLike
    -> ([Id], [Id], [EqSpec], [Type], [Type], [Scaled Type], Type)
    conLikeFullSig ConLike
    con
                     arg_tys' :: [Scaled Type]
    arg_tys' = (Scaled Type -> Scaled Type) -> [Scaled Type] -> [Scaled Type]
    forall a b. (a -> b) -> [a] -> [b]
    map (Type -> Scaled Type -> Scaled Type
    forall a. Type -> Scaled a -> Scaled a
    scaleScaled Type
    Many) [Scaled Type]
    arg_tys
                       -- Record updates consume the source record with multiplicity
                       -- Many. Therefore all the fields need to be scaled thus.
                     user_tvs :: [Id]
    user_tvs  = [VarBndr Id Specificity] -> [Id]
    forall tv argf. [VarBndr tv argf] -> [tv]
    binderVars ([VarBndr Id Specificity] -> [Id])
    -> [VarBndr Id Specificity] -> [Id]
    forall a b. (a -> b) -> a -> b
    $ ConLike -> [VarBndr Id Specificity]
    conLikeUserTyVarBinders ConLike
    con

                     in_subst :: TCvSubst
                     in_subst :: TCvSubst
    in_subst  = TCvSubst -> [Id] -> TCvSubst
    extendTCvInScopeList ([Id] -> [Type] -> TCvSubst
    HasDebugCallStack => [Id] -> [Type] -> TCvSubst
    zipTvSubst [Id]
    univ_tvs [Type]
    in_inst_tys) [Id]
    ex_tvs
                       -- The in_subst clones the universally quantified type
                       -- variables. It will be used to substitute into types that
                       -- contain existentials, however, so make sure to extend the
                       -- in-scope set with ex_tvs (#20278).

                     out_tv_env :: TvSubstEnv
                     out_tv_env :: TvSubstEnv
    out_tv_env = [Id] -> [Type] -> TvSubstEnv
    HasDebugCallStack => [Id] -> [Type] -> TvSubstEnv
    zipTyEnv [Id]
    univ_tvs [Type]
    out_inst_tys

                    -- I'm not bothering to clone the ex_tvs
               ; [Id]
    eqs_vars   <- (Type -> DsM Id) -> [Type] -> IOEnv (Env DsGblEnv DsLclEnv) [Id]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM Type -> DsM Id
    newPredVarDs (HasCallStack => TCvSubst -> [Type] -> [Type]
    TCvSubst -> [Type] -> [Type]
    substTheta TCvSubst
    in_subst ([EqSpec] -> [Type]
    eqSpecPreds [EqSpec]
    eq_spec))
               ; [Id]
    theta_vars <- (Type -> DsM Id) -> [Type] -> IOEnv (Env DsGblEnv DsLclEnv) [Id]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM Type -> DsM Id
    newPredVarDs (HasCallStack => TCvSubst -> [Type] -> [Type]
    TCvSubst -> [Type] -> [Type]
    substTheta TCvSubst
    in_subst [Type]
    prov_theta)
               ; [Id]
    arg_ids    <- [Scaled Type] -> IOEnv (Env DsGblEnv DsLclEnv) [Id]
    newSysLocalsDs (TCvSubst -> [Scaled Type] -> [Scaled Type]
    substScaledTysUnchecked TCvSubst
    in_subst [Scaled Type]
    arg_tys')
               ; let field_labels :: [FieldLabel]
    field_labels = ConLike -> [FieldLabel]
    conLikeFieldLabels ConLike
    con
                     val_args :: [GenLocated SrcSpanAnnA (HsExpr GhcTc)]
    val_args = String
    -> (FieldLabel -> Id -> GenLocated SrcSpanAnnA (HsExpr GhcTc))
    -> [FieldLabel]
    -> [Id]
    -> [GenLocated SrcSpanAnnA (HsExpr GhcTc)]
    forall a b c. String -> (a -> b -> c) -> [a] -> [b] -> [c]
    zipWithEqual String
    "dsExpr:RecordUpd" FieldLabel -> Id -> GenLocated SrcSpanAnnA (HsExpr GhcTc)
    FieldLabel -> Id -> LHsExpr GhcTc
    mk_val_arg
                                             [FieldLabel]
    field_labels [Id]
    arg_ids
                     mk_val_arg :: FieldLabel -> Id -> LHsExpr GhcTc
    mk_val_arg FieldLabel
    fl Id
    pat_arg_id
                         = IdP GhcTc -> LHsExpr GhcTc
    forall (p :: Pass) a.
    IsSrcSpanAnn p a =>
    IdP (GhcPass p) -> LHsExpr (GhcPass p)
    nlHsVar (NameEnv Id -> Name -> Maybe Id
    forall a. NameEnv a -> Name -> Maybe a
    lookupNameEnv NameEnv Id
    upd_fld_env (FieldLabel -> Name
    flSelector FieldLabel
    fl) Maybe Id -> Id -> Id
    forall a. Maybe a -> a -> a
    `orElse` Id
    pat_arg_id)

                     inst_con :: GenLocated SrcSpanAnnA (HsExpr GhcTc)
    inst_con = HsExpr GhcTc -> GenLocated SrcSpanAnnA (HsExpr GhcTc)
    forall a an. a -> LocatedAn an a
    noLocA (HsExpr GhcTc -> GenLocated SrcSpanAnnA (HsExpr GhcTc))
    -> HsExpr GhcTc -> GenLocated SrcSpanAnnA (HsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $ HsWrapper -> HsExpr GhcTc -> HsExpr GhcTc
    mkHsWrap HsWrapper
    wrap (XConLikeOut GhcTc -> ConLike -> HsExpr GhcTc
    forall p. XConLikeOut p -> ConLike -> HsExpr p
    HsConLikeOut NoExtField
    XConLikeOut GhcTc
    noExtField ConLike
    con)
                            -- Reconstruct with the WrapId so that unpacking happens
                     wrap :: HsWrapper
    wrap = [Id] -> HsWrapper
    mkWpEvVarApps [Id]
    theta_vars                                HsWrapper -> HsWrapper -> HsWrapper
    <.>
                            HsWrapper
    dict_req_wrap                                           HsWrapper -> HsWrapper -> HsWrapper
    <.>
                            [Type] -> HsWrapper
    mkWpTyApps    [ TvSubstEnv -> Id -> Maybe Type
    forall a. VarEnv a -> Id -> Maybe a
    lookupVarEnv TvSubstEnv
    out_tv_env Id
    tv
                                              Maybe Type -> Type -> Type
    forall a. Maybe a -> a -> a
    `orElse` Id -> Type
    mkTyVarTy Id
    tv
                                          | Id
    tv <- [Id]
    user_tvs ]
                              -- Be sure to use user_tvs (which may be ordered
                              -- differently than `univ_tvs ++ ex_tvs) above.
                              -- See Note [DataCon user type variable binders]
                              -- in GHC.Core.DataCon.
                     rhs :: GenLocated SrcSpanAnnA (HsExpr GhcTc)
    rhs = (GenLocated SrcSpanAnnA (HsExpr GhcTc)
     -> GenLocated SrcSpanAnnA (HsExpr GhcTc)
     -> GenLocated SrcSpanAnnA (HsExpr GhcTc))
    -> GenLocated SrcSpanAnnA (HsExpr GhcTc)
    -> [GenLocated SrcSpanAnnA (HsExpr GhcTc)]
    -> GenLocated SrcSpanAnnA (HsExpr GhcTc)
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' (\GenLocated SrcSpanAnnA (HsExpr GhcTc)
    a GenLocated SrcSpanAnnA (HsExpr GhcTc)
    b -> LHsExpr GhcTc -> LHsExpr GhcTc -> LHsExpr GhcTc
    forall (id :: Pass).
    IsPass id =>
    LHsExpr (GhcPass id)
    -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
    nlHsApp GenLocated SrcSpanAnnA (HsExpr GhcTc)
    LHsExpr GhcTc
    a GenLocated SrcSpanAnnA (HsExpr GhcTc)
    LHsExpr GhcTc
    b) GenLocated SrcSpanAnnA (HsExpr GhcTc)
    inst_con [GenLocated SrcSpanAnnA (HsExpr GhcTc)]
    val_args

                            -- Tediously wrap the application in a cast
                            -- Note [Update for GADTs]
                     wrapped_rhs :: GenLocated SrcSpanAnnA (HsExpr GhcTc)
    wrapped_rhs =
                      case ConLike
    con of
                        RealDataCon DataCon
    data_con
                          | [EqSpec] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [EqSpec]
    eq_spec -> GenLocated SrcSpanAnnA (HsExpr GhcTc)
    rhs
                          | Bool
    otherwise    -> HsWrapper -> LHsExpr GhcTc -> LHsExpr GhcTc
    mkLHsWrap (TcCoercionN -> HsWrapper
    mkWpCastN TcCoercionN
    wrap_co) GenLocated SrcSpanAnnA (HsExpr GhcTc)
    LHsExpr GhcTc
    rhs
                                         -- This wrap is the punchline: Note [Update for GADTs]
                          where
                            rep_tc :: TyCon
    rep_tc   = DataCon -> TyCon
    dataConTyCon DataCon
    data_con
                            wrap_co :: TcCoercionN
    wrap_co  = TyCon -> [TcCoercionN] -> TcCoercionN
    mkTcFamilyTyConAppCo TyCon
    rep_tc [TcCoercionN]
    univ_cos
                            univ_cos :: [TcCoercionN]
    univ_cos = String
    -> (Id -> Type -> TcCoercionN) -> [Id] -> [Type] -> [TcCoercionN]
    forall a b c. String -> (a -> b -> c) -> [a] -> [b] -> [c]
    zipWithEqual String
    "dsExpr:upd" Id -> Type -> TcCoercionN
    mk_univ_co [Id]
    univ_tvs [Type]
    out_inst_tys

                            mk_univ_co :: TyVar   -- Universal tyvar from the DataCon
                                       -> Type    -- Corresponding instantiating type
                                       -> Coercion
                            mk_univ_co :: Id -> Type -> TcCoercionN
    mk_univ_co Id
    univ_tv Type
    inst_ty
                              = case VarEnv TcCoercionN -> Id -> Maybe TcCoercionN
    forall a. VarEnv a -> Id -> Maybe a
    lookupVarEnv VarEnv TcCoercionN
    eq_spec_env Id
    univ_tv of
                                   Just TcCoercionN
    co -> TcCoercionN
    co
                                   Maybe TcCoercionN
    Nothing -> Type -> TcCoercionN
    mkTcNomReflCo Type
    inst_ty

                            eq_spec_env :: VarEnv Coercion
                            eq_spec_env :: VarEnv TcCoercionN
    eq_spec_env = [(Id, TcCoercionN)] -> VarEnv TcCoercionN
    forall a. [(Id, a)] -> VarEnv a
    mkVarEnv [ (EqSpec -> Id
    eqSpecTyVar EqSpec
    spec, TcCoercionN -> TcCoercionN
    mkTcSymCo (Id -> TcCoercionN
    mkTcCoVarCo Id
    eqs_var))
                                                   | (EqSpec
    spec,Id
    eqs_var) <- String -> [EqSpec] -> [Id] -> [(EqSpec, Id)]
    forall a b. String -> [a] -> [b] -> [(a, b)]
    zipEqual String
    "dsExpr:upd2" [EqSpec]
    eq_spec [Id]
    eqs_vars ]

                        -- eq_spec is always null for a PatSynCon
                        PatSynCon PatSyn
    _ -> GenLocated SrcSpanAnnA (HsExpr GhcTc)
    rhs

                     req_wrap :: HsWrapper
    req_wrap = HsWrapper
    dict_req_wrap HsWrapper -> HsWrapper -> HsWrapper
    <.> [Type] -> HsWrapper
    mkWpTyApps [Type]
    in_inst_tys

                     pat :: GenLocated SrcSpanAnnA (Pat GhcTc)
    pat = Pat GhcTc -> GenLocated SrcSpanAnnA (Pat GhcTc)
    forall a an. a -> LocatedAn an a
    noLocA (Pat GhcTc -> GenLocated SrcSpanAnnA (Pat GhcTc))
    -> Pat GhcTc -> GenLocated SrcSpanAnnA (Pat GhcTc)
    forall a b. (a -> b) -> a -> b
    $ ConPat { pat_con :: XRec GhcTc (ConLikeP GhcTc)
    pat_con = ConLike -> GenLocated SrcSpanAnnN ConLike
    forall a an. a -> LocatedAn an a
    noLocA ConLike
    con
                                           , pat_args :: HsConPatDetails GhcTc
    pat_args = [HsPatSigType (NoGhcTc GhcTc)]
    -> [LPat GhcTc] -> HsConPatDetails GhcTc
    forall tyarg arg rec.
    [tyarg] -> [arg] -> HsConDetails tyarg arg rec
    PrefixCon [] ([LPat GhcTc] -> HsConPatDetails GhcTc)
    -> [LPat GhcTc] -> HsConPatDetails GhcTc
    forall a b. (a -> b) -> a -> b
    $ (Id -> LPat GhcTc) -> [Id] -> [LPat GhcTc]
    forall a b. (a -> b) -> [a] -> [b]
    map Id -> LPat GhcTc
    forall (p :: Pass) a.
    IsSrcSpanAnn p a =>
    IdP (GhcPass p) -> LPat (GhcPass p)
    nlVarPat [Id]
    arg_ids
                                           , pat_con_ext :: XConPat GhcTc
    pat_con_ext = ConPatTc
                                             { cpt_tvs :: [Id]
    cpt_tvs = [Id]
    ex_tvs
                                             , cpt_dicts :: [Id]
    cpt_dicts = [Id]
    eqs_vars [Id] -> [Id] -> [Id]
    forall a. [a] -> [a] -> [a]
    ++ [Id]
    theta_vars
                                             , cpt_binds :: TcEvBinds
    cpt_binds = TcEvBinds
    emptyTcEvBinds
                                             , cpt_arg_tys :: [Type]
    cpt_arg_tys = [Type]
    in_inst_tys
                                             , cpt_wrap :: HsWrapper
    cpt_wrap = HsWrapper
    req_wrap
                                             }
                                           }
               ; GenLocated
      SrcSpanAnnA (Match GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
    -> IOEnv
         (Env DsGblEnv DsLclEnv)
         (GenLocated
            SrcSpanAnnA (Match GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (HsMatchContext (NoGhcTc GhcTc)
    -> [LPat GhcTc]
    -> GenLocated SrcSpanAnnA (HsExpr GhcTc)
    -> LMatch GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    forall (p :: Pass) (body :: * -> *).
    (Anno (Match (GhcPass p) (LocatedA (body (GhcPass p))))
     ~ SrcSpanAnnA,
     Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p)))) ~ SrcSpan) =>
    HsMatchContext (NoGhcTc (GhcPass p))
    -> [LPat (GhcPass p)]
    -> LocatedA (body (GhcPass p))
    -> LMatch (GhcPass p) (LocatedA (body (GhcPass p)))
    mkSimpleMatch HsMatchContext (NoGhcTc GhcTc)
    forall p. HsMatchContext p
    RecUpd [GenLocated SrcSpanAnnA (Pat GhcTc)
    LPat GhcTc
    pat] GenLocated SrcSpanAnnA (HsExpr GhcTc)
    wrapped_rhs) }

    {- Note [Scrutinee in Record updates]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Consider #17783:

      data PartialRec = No
                      | Yes { a :: Int, b :: Bool }
      update No = No
      update r@(Yes {}) = r { b = False }

    In the context of pattern-match checking, the occurrence of @r@ in
    @r { b = False }@ is to be treated as if it was a scrutinee, as can be seen by
    the following desugaring:

      r { b = False } ==> case r of Yes a b -> Yes a False

    Thus, we pass @r@ as the scrutinee expression to @matchWrapper@ above.
    -}

    -- Here is where we desugar the Template Haskell brackets and escapes

    -- Template Haskell stuff

    dsExpr (HsRnBracketOut XRnBracketOut GhcTc
    _ HsBracket (HsBracketRn GhcTc)
    _ [PendingRnSplice' GhcTc]
    _)  = String -> DsM CoreExpr
    forall a. String -> a
    panic String
    "dsExpr HsRnBracketOut"
    dsExpr (HsTcBracketOut XTcBracketOut GhcTc
    _ Maybe QuoteWrapper
    hs_wrapper HsBracket (HsBracketRn GhcTc)
    x [PendingTcSplice' GhcTc]
    ps) = Maybe QuoteWrapper
    -> HsBracket GhcRn -> [PendingTcSplice] -> DsM CoreExpr
    dsBracket Maybe QuoteWrapper
    hs_wrapper HsBracket GhcRn
    HsBracket (HsBracketRn GhcTc)
    x [PendingTcSplice' GhcTc]
    [PendingTcSplice]
    ps
    dsExpr (HsSpliceE XSpliceE GhcTc
    _ HsSplice GhcTc
    s)         = String -> SDoc -> DsM CoreExpr
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "dsExpr:splice" (HsSplice GhcTc -> SDoc
    forall {a}. Outputable a => a -> SDoc
    ppr HsSplice GhcTc
    s)

    -- Arrow notation extension
    dsExpr (HsProc XProc GhcTc
    _ LPat GhcTc
    pat LHsCmdTop GhcTc
    cmd) = LPat GhcTc -> LHsCmdTop GhcTc -> DsM CoreExpr
    dsProcExpr LPat GhcTc
    pat LHsCmdTop GhcTc
    cmd

    -- Hpc Support

    dsExpr (HsTick XTick GhcTc
    _ CoreTickish
    tickish LHsExpr GhcTc
    e) = do
      CoreExpr
    e' <- LHsExpr GhcTc -> DsM CoreExpr
    dsLExpr LHsExpr GhcTc
    e
      CoreExpr -> DsM CoreExpr
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CoreTickish -> CoreExpr -> CoreExpr
    forall b. CoreTickish -> Expr b -> Expr b
    Tick CoreTickish
    tickish CoreExpr
    e')

    -- There is a problem here. The then and else branches
    -- have no free variables, so they are open to lifting.
    -- We need someway of stopping this.
    -- This will make no difference to binary coverage
    -- (did you go here: YES or NO), but will effect accurate
    -- tick counting.

    dsExpr (HsBinTick XBinTick GhcTc
    _ Int
    ixT Int
    ixF LHsExpr GhcTc
    e) = do
      CoreExpr
    e2 <- LHsExpr GhcTc -> DsM CoreExpr
    dsLExpr LHsExpr GhcTc
    e
      do { ASSERT(exprType e2 `eqType` boolTy)
           Int -> Int -> CoreExpr -> DsM CoreExpr
    mkBinaryTickBox Int
    ixT Int
    ixF CoreExpr
    e2
         }

    -- HsSyn constructs that just shouldn't be here, because
    -- the renamer removed them.  See GHC.Rename.Expr.
    -- Note [Handling overloaded and rebindable constructs]
    dsExpr (HsOverLabel XOverLabel GhcTc
    x FieldLabelString
    _) = Void -> DsM CoreExpr
    forall a. Void -> a
    absurd Void
    XOverLabel GhcTc
    x
    dsExpr (OpApp XOpApp GhcTc
    x LHsExpr GhcTc
    _ LHsExpr GhcTc
    _ LHsExpr GhcTc
    _)   = Void -> DsM CoreExpr
    forall a. Void -> a
    absurd Void
    XOpApp GhcTc
    x
    dsExpr (SectionL XSectionL GhcTc
    x LHsExpr GhcTc
    _ LHsExpr GhcTc
    _)  = Void -> DsM CoreExpr
    forall a. Void -> a
    absurd Void
    XSectionL GhcTc
    x
    dsExpr (SectionR XSectionR GhcTc
    x LHsExpr GhcTc
    _ LHsExpr GhcTc
    _)  = Void -> DsM CoreExpr
    forall a. Void -> a
    absurd Void
    XSectionR GhcTc
    x

    -- HsSyn constructs that just shouldn't be here:
    dsExpr (HsBracket   {}) = String -> DsM CoreExpr
    forall a. String -> a
    panic String
    "dsExpr:HsBracket"
    dsExpr (HsDo        {}) = String -> DsM CoreExpr
    forall a. String -> a
    panic String
    "dsExpr:HsDo"

    ds_prag_expr :: HsPragE GhcTc -> LHsExpr GhcTc -> DsM CoreExpr
    ds_prag_expr :: HsPragE GhcTc -> LHsExpr GhcTc -> DsM CoreExpr
    ds_prag_expr (HsPragSCC XSCC GhcTc
    _ SourceText
    _ StringLiteral
    cc) LHsExpr GhcTc
    expr = do
        DynFlags
    dflags <- IOEnv (Env DsGblEnv DsLclEnv) DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
        if DynFlags -> Bool
    sccProfilingEnabled DynFlags
    dflags
          then do
            Module
    mod_name <- IOEnv (Env DsGblEnv DsLclEnv) Module
    forall (m :: * -> *). HasModule m => m Module
    getModule
            Bool
    count <- GeneralFlag -> TcRnIf DsGblEnv DsLclEnv Bool
    forall gbl lcl. GeneralFlag -> TcRnIf gbl lcl Bool
    goptM GeneralFlag
    Opt_ProfCountEntries
            let nm :: FieldLabelString
    nm = StringLiteral -> FieldLabelString
    sl_fs StringLiteral
    cc
            CCFlavour
    flavour <- CostCentreIndex -> CCFlavour
    ExprCC (CostCentreIndex -> CCFlavour)
    -> IOEnv (Env DsGblEnv DsLclEnv) CostCentreIndex
    -> IOEnv (Env DsGblEnv DsLclEnv) CCFlavour
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> FieldLabelString -> IOEnv (Env DsGblEnv DsLclEnv) CostCentreIndex
    getCCIndexDsM FieldLabelString
    nm
            CoreTickish -> CoreExpr -> CoreExpr
    forall b. CoreTickish -> Expr b -> Expr b
    Tick (CostCentre -> Bool -> Bool -> CoreTickish
    forall (pass :: TickishPass).
    CostCentre -> Bool -> Bool -> GenTickish pass
    ProfNote (FieldLabelString -> Module -> SrcSpan -> CCFlavour -> CostCentre
    mkUserCC FieldLabelString
    nm Module
    mod_name (GenLocated SrcSpanAnnA (HsExpr GhcTc) -> SrcSpan
    forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
    getLocA GenLocated SrcSpanAnnA (HsExpr GhcTc)
    LHsExpr GhcTc
    expr) CCFlavour
    flavour) Bool
    count Bool
    True)
                   (CoreExpr -> CoreExpr) -> DsM CoreExpr -> DsM CoreExpr
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> LHsExpr GhcTc -> DsM CoreExpr
    dsLExpr LHsExpr GhcTc
    expr
          else LHsExpr GhcTc -> DsM CoreExpr
    dsLExpr LHsExpr GhcTc
    expr

    ------------------------------
    dsSyntaxExpr :: SyntaxExpr GhcTc -> [CoreExpr] -> DsM CoreExpr
    dsSyntaxExpr :: SyntaxExpr GhcTc -> [CoreExpr] -> DsM CoreExpr
    dsSyntaxExpr (SyntaxExprTc { syn_expr :: SyntaxExprTc -> HsExpr GhcTc
    syn_expr      = HsExpr GhcTc
    expr
                               , syn_arg_wraps :: SyntaxExprTc -> [HsWrapper]
    syn_arg_wraps = [HsWrapper]
    arg_wraps
                               , syn_res_wrap :: SyntaxExprTc -> HsWrapper
    syn_res_wrap  = HsWrapper
    res_wrap })
                 [CoreExpr]
    arg_exprs
      = do { CoreExpr
    fun            <- HsExpr GhcTc -> DsM CoreExpr
    dsExpr HsExpr GhcTc
    expr
           ; [CoreExpr -> CoreExpr]
    core_arg_wraps <- (HsWrapper -> IOEnv (Env DsGblEnv DsLclEnv) (CoreExpr -> CoreExpr))
    -> [HsWrapper]
    -> IOEnv (Env DsGblEnv DsLclEnv) [CoreExpr -> CoreExpr]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM HsWrapper -> IOEnv (Env DsGblEnv DsLclEnv) (CoreExpr -> CoreExpr)
    dsHsWrapper [HsWrapper]
    arg_wraps
           ; CoreExpr -> CoreExpr
    core_res_wrap  <- HsWrapper -> IOEnv (Env DsGblEnv DsLclEnv) (CoreExpr -> CoreExpr)
    dsHsWrapper HsWrapper
    res_wrap
           ; let wrapped_args :: [CoreExpr]
    wrapped_args = String
    -> ((CoreExpr -> CoreExpr) -> CoreExpr -> CoreExpr)
    -> [CoreExpr -> CoreExpr]
    -> [CoreExpr]
    -> [CoreExpr]
    forall a b c. String -> (a -> b -> c) -> [a] -> [b] -> [c]
    zipWithEqual String
    "dsSyntaxExpr" (CoreExpr -> CoreExpr) -> CoreExpr -> CoreExpr
    forall a b. (a -> b) -> a -> b
    ($) [CoreExpr -> CoreExpr]
    core_arg_wraps [CoreExpr]
    arg_exprs
           ; IOEnv (Env DsGblEnv DsLclEnv) ()
    -> (() -> CoreExpr) -> DsM CoreExpr
    forall a. DsM a -> (a -> CoreExpr) -> DsM CoreExpr
    dsWhenNoErrs ((CoreExpr -> SDoc -> IOEnv (Env DsGblEnv DsLclEnv) ())
    -> [CoreExpr] -> [SDoc] -> IOEnv (Env DsGblEnv DsLclEnv) ()
    forall (m :: * -> *) a b c.
    Applicative m =>
    (a -> b -> m c) -> [a] -> [b] -> m ()
    zipWithM_ CoreExpr -> SDoc -> IOEnv (Env DsGblEnv DsLclEnv) ()
    dsNoLevPolyExpr [CoreExpr]
    wrapped_args [ Int -> SDoc
    mk_doc Int
    n | Int
    n <- [Int
    1..] ])
                          (\()
    _ -> CoreExpr -> CoreExpr
    core_res_wrap (CoreExpr -> [CoreExpr] -> CoreExpr
    mkCoreApps CoreExpr
    fun [CoreExpr]
    wrapped_args)) }
                          -- Use mkCoreApps instead of mkApps:
                          -- unboxed types are possible with RebindableSyntax (#19883)
      where
        mk_doc :: Int -> SDoc
    mk_doc Int
    n = String -> SDoc
    text String
    "In the" SDoc -> SDoc -> SDoc
    <+> Int -> SDoc
    speakNth Int
    n SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "argument of" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (HsExpr GhcTc -> SDoc
    forall {a}. Outputable a => a -> SDoc
    ppr HsExpr GhcTc
    expr)
    dsSyntaxExpr SyntaxExpr GhcTc
    SyntaxExprTc
    NoSyntaxExprTc [CoreExpr]
    _ = String -> DsM CoreExpr
    forall a. String -> a
    panic String
    "dsSyntaxExpr"

    findField :: [LHsRecField GhcTc arg] -> Name -> [arg]
    findField :: forall arg. [LHsRecField GhcTc arg] -> Name -> [arg]
    findField [LHsRecField GhcTc arg]
    rbinds Name
    sel
      = [HsRecField' (FieldOcc GhcTc) arg -> arg
    forall id arg. HsRecField' id arg -> arg
    hsRecFieldArg HsRecField' (FieldOcc GhcTc) arg
    fld | L SrcSpanAnnA
    _ HsRecField' (FieldOcc GhcTc) arg
    fld <- [GenLocated SrcSpanAnnA (HsRecField' (FieldOcc GhcTc) arg)]
    [LHsRecField GhcTc arg]
    rbinds
                           , Name
    sel Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    == Id -> Name
    idName (GenLocated SrcSpan Id -> Id
    forall l e. GenLocated l e -> e
    unLoc (GenLocated SrcSpan Id -> Id) -> GenLocated SrcSpan Id -> Id
    forall a b. (a -> b) -> a -> b
    $ HsRecField' (FieldOcc GhcTc) arg -> GenLocated SrcSpan Id
    forall arg. HsRecField GhcTc arg -> GenLocated SrcSpan Id
    hsRecFieldId HsRecField' (FieldOcc GhcTc) arg
    fld) ]

    {-
    %--------------------------------------------------------------------

    Note [Desugaring explicit lists]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Explicit lists are desugared in a cleverer way to prevent some
    fruitless allocations.  Essentially, whenever we see a list literal
    [x_1, ..., x_n] we generate the corresponding expression in terms of
    build:

    Explicit lists (literals) are desugared to allow build/foldr fusion when
    beneficial. This is a bit of a trade-off,

     * build/foldr fusion can generate far larger code than the corresponding
       cons-chain (e.g. see #11707)

     * even when it doesn't produce more code, build can still fail to fuse,
       requiring that the simplifier do more work to bring the expression
       back into cons-chain form; this costs compile time

     * when it works, fusion can be a significant win. Allocations are reduced
       by up to 25% in some nofib programs. Specifically,

            Program           Size    Allocs   Runtime  CompTime
            rewrite          +0.0%    -26.3%      0.02     -1.8%
               ansi          -0.3%    -13.8%      0.00     +0.0%
               lift          +0.0%     -8.7%      0.00     -2.3%

    At the moment we use a simple heuristic to determine whether build will be
    fruitful: for small lists we assume the benefits of fusion will be worthwhile;
    for long lists we assume that the benefits will be outweighted by the cost of
    code duplication. This magic length threshold is @maxBuildLength@. Also, fusion
    won't work at all if rewrite rules are disabled, so we don't use the build-based
    desugaring in this case.

    We used to have a more complex heuristic which would try to break the list into
    "static" and "dynamic" parts and only build-desugar the dynamic part.
    Unfortunately, determining "static-ness" reliably is a bit tricky and the
    heuristic at times produced surprising behavior (see #11710) so it was dropped.
    -}

    {- | The longest list length which we will desugar using @build@.

    This is essentially a magic number and its setting is unfortunate rather
    arbitrary. The idea here, as mentioned in Note [Desugaring explicit lists],
    is to avoid deforesting large static data into large(r) code. Ideally we'd
    want a smaller threshold with larger consumers and vice-versa, but we have no
    way of knowing what will be consuming our list in the desugaring impossible to
    set generally correctly.

    The effect of reducing this number will be that 'build' fusion is applied
    less often. From a runtime performance perspective, applying 'build' more
    liberally on "moderately" sized lists should rarely hurt and will often it can
    only expose further optimization opportunities; if no fusion is possible it will
    eventually get rule-rewritten back to a list). We do, however, pay in compile
    time.
    -}
    maxBuildLength :: Int
    maxBuildLength :: Int
    maxBuildLength = Int
    32

    dsExplicitList :: Type -> [LHsExpr GhcTc]
                   -> DsM CoreExpr
    -- See Note [Desugaring explicit lists]
    dsExplicitList :: Type -> [LHsExpr GhcTc] -> DsM CoreExpr
    dsExplicitList Type
    elt_ty [LHsExpr GhcTc]
    xs
      = do { DynFlags
    dflags <- IOEnv (Env DsGblEnv DsLclEnv) DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
           ; [CoreExpr]
    xs' <- (GenLocated SrcSpanAnnA (HsExpr GhcTc) -> DsM CoreExpr)
    -> [GenLocated SrcSpanAnnA (HsExpr GhcTc)]
    -> IOEnv (Env DsGblEnv DsLclEnv) [CoreExpr]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM GenLocated SrcSpanAnnA (HsExpr GhcTc) -> DsM CoreExpr
    LHsExpr GhcTc -> DsM CoreExpr
    dsLExprNoLP [GenLocated SrcSpanAnnA (HsExpr GhcTc)]
    [LHsExpr GhcTc]
    xs
           ; if [CoreExpr]
    xs' [CoreExpr] -> Int -> Bool
    forall a. [a] -> Int -> Bool
    `lengthExceeds` Int
    maxBuildLength
                    -- Don't generate builds if the list is very long.
             Bool -> Bool -> Bool
    || [CoreExpr] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [CoreExpr]
    xs'
                    -- Don't generate builds when the [] constructor will do
             Bool -> Bool -> Bool
    || Bool -> Bool
    not (GeneralFlag -> DynFlags -> Bool
    gopt GeneralFlag
    Opt_EnableRewriteRules DynFlags
    dflags)  -- Rewrite rules off
                    -- Don't generate a build if there are no rules to eliminate it!
                    -- See Note [Desugaring RULE left hand sides] in GHC.HsToCore
             then CoreExpr -> DsM CoreExpr
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CoreExpr -> DsM CoreExpr) -> CoreExpr -> DsM CoreExpr
    forall a b. (a -> b) -> a -> b
    $ Type -> [CoreExpr] -> CoreExpr
    mkListExpr Type
    elt_ty [CoreExpr]
    xs'
             else Type -> ((Id, Type) -> (Id, Type) -> DsM CoreExpr) -> DsM CoreExpr
    forall (m :: * -> *).
    (MonadFail m, MonadThings m, MonadUnique m) =>
    Type -> ((Id, Type) -> (Id, Type) -> m CoreExpr) -> m CoreExpr
    mkBuildExpr Type
    elt_ty ([CoreExpr] -> (Id, Type) -> (Id, Type) -> DsM CoreExpr
    forall {m :: * -> *} {t :: * -> *} {b} {b} {b}.
    (Monad m, Foldable t) =>
    t (Arg b) -> (Id, b) -> (Id, b) -> m (Arg b)
    mk_build_list [CoreExpr]
    xs') }
      where
        mk_build_list :: t (Arg b) -> (Id, b) -> (Id, b) -> m (Arg b)
    mk_build_list t (Arg b)
    xs' (Id
    cons, b
    _) (Id
    nil, b
    _)
          = Arg b -> m (Arg b)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((Arg b -> Arg b -> Arg b) -> Arg b -> t (Arg b) -> Arg b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (Arg b -> Arg b -> Arg b
    forall b. Expr b -> Expr b -> Expr b
    App (Arg b -> Arg b -> Arg b)
    -> (Arg b -> Arg b) -> Arg b -> Arg b -> Arg b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Arg b -> Arg b -> Arg b
    forall b. Expr b -> Expr b -> Expr b
    App (Id -> Arg b
    forall b. Id -> Expr b
    Var Id
    cons)) (Id -> Arg b
    forall b. Id -> Expr b
    Var Id
    nil) t (Arg b)
    xs')

    dsArithSeq :: PostTcExpr -> (ArithSeqInfo GhcTc) -> DsM CoreExpr
    dsArithSeq :: HsExpr GhcTc -> ArithSeqInfo GhcTc -> DsM CoreExpr
    dsArithSeq HsExpr GhcTc
    expr (From LHsExpr GhcTc
    from)
      = CoreExpr -> CoreExpr -> CoreExpr
    forall b. Expr b -> Expr b -> Expr b
    App (CoreExpr -> CoreExpr -> CoreExpr)
    -> DsM CoreExpr
    -> IOEnv (Env DsGblEnv DsLclEnv) (CoreExpr -> CoreExpr)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> HsExpr GhcTc -> DsM CoreExpr
    dsExpr HsExpr GhcTc
    expr IOEnv (Env DsGblEnv DsLclEnv) (CoreExpr -> CoreExpr)
    -> DsM CoreExpr -> DsM CoreExpr
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> LHsExpr GhcTc -> DsM CoreExpr
    dsLExprNoLP LHsExpr GhcTc
    from
    dsArithSeq HsExpr GhcTc
    expr (FromTo LHsExpr GhcTc
    from LHsExpr GhcTc
    to)
      = do FamInstEnvs
    fam_envs <- DsM FamInstEnvs
    dsGetFamInstEnvs
           DynFlags
    dflags <- IOEnv (Env DsGblEnv DsLclEnv) DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
           FamInstEnvs
    -> DynFlags
    -> LHsExpr GhcTc
    -> Maybe (LHsExpr GhcTc)
    -> LHsExpr GhcTc
    -> IOEnv (Env DsGblEnv DsLclEnv) ()
    warnAboutEmptyEnumerations FamInstEnvs
    fam_envs DynFlags
    dflags LHsExpr GhcTc
    from Maybe (LHsExpr GhcTc)
    forall a. Maybe a
    Nothing LHsExpr GhcTc
    to
           CoreExpr
    expr' <- HsExpr GhcTc -> DsM CoreExpr
    dsExpr HsExpr GhcTc
    expr
           CoreExpr
    from' <- LHsExpr GhcTc -> DsM CoreExpr
    dsLExprNoLP LHsExpr GhcTc
    from
           CoreExpr
    to'   <- LHsExpr GhcTc -> DsM CoreExpr
    dsLExprNoLP LHsExpr GhcTc
    to
           CoreExpr -> DsM CoreExpr
    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
    expr' [CoreExpr
    from', CoreExpr
    to']
    dsArithSeq HsExpr GhcTc
    expr (FromThen LHsExpr GhcTc
    from LHsExpr GhcTc
    thn)
      = CoreExpr -> [CoreExpr] -> CoreExpr
    forall b. Expr b -> [Expr b] -> Expr b
    mkApps (CoreExpr -> [CoreExpr] -> CoreExpr)
    -> DsM CoreExpr
    -> IOEnv (Env DsGblEnv DsLclEnv) ([CoreExpr] -> CoreExpr)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> HsExpr GhcTc -> DsM CoreExpr
    dsExpr HsExpr GhcTc
    expr IOEnv (Env DsGblEnv DsLclEnv) ([CoreExpr] -> CoreExpr)
    -> IOEnv (Env DsGblEnv DsLclEnv) [CoreExpr] -> DsM CoreExpr
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> (GenLocated SrcSpanAnnA (HsExpr GhcTc) -> DsM CoreExpr)
    -> [GenLocated SrcSpanAnnA (HsExpr GhcTc)]
    -> IOEnv (Env DsGblEnv DsLclEnv) [CoreExpr]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM GenLocated SrcSpanAnnA (HsExpr GhcTc) -> DsM CoreExpr
    LHsExpr GhcTc -> DsM CoreExpr
    dsLExprNoLP [GenLocated SrcSpanAnnA (HsExpr GhcTc)
    LHsExpr GhcTc
    from, GenLocated SrcSpanAnnA (HsExpr GhcTc)
    LHsExpr GhcTc
    thn]
    dsArithSeq HsExpr GhcTc
    expr (FromThenTo LHsExpr GhcTc
    from LHsExpr GhcTc
    thn LHsExpr GhcTc
    to)
      = do FamInstEnvs
    fam_envs <- DsM FamInstEnvs
    dsGetFamInstEnvs
           DynFlags
    dflags <- IOEnv (Env DsGblEnv DsLclEnv) DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
           FamInstEnvs
    -> DynFlags
    -> LHsExpr GhcTc
    -> Maybe (LHsExpr GhcTc)
    -> LHsExpr GhcTc
    -> IOEnv (Env DsGblEnv DsLclEnv) ()
    warnAboutEmptyEnumerations FamInstEnvs
    fam_envs DynFlags
    dflags LHsExpr GhcTc
    from (GenLocated SrcSpanAnnA (HsExpr GhcTc)
    -> Maybe (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    forall a. a -> Maybe a
    Just GenLocated SrcSpanAnnA (HsExpr GhcTc)
    LHsExpr GhcTc
    thn) LHsExpr GhcTc
    to
           CoreExpr
    expr' <- HsExpr GhcTc -> DsM CoreExpr
    dsExpr HsExpr GhcTc
    expr
           CoreExpr
    from' <- LHsExpr GhcTc -> DsM CoreExpr
    dsLExprNoLP LHsExpr GhcTc
    from
           CoreExpr
    thn'  <- LHsExpr GhcTc -> DsM CoreExpr
    dsLExprNoLP LHsExpr GhcTc
    thn
           CoreExpr
    to'   <- LHsExpr GhcTc -> DsM CoreExpr
    dsLExprNoLP LHsExpr GhcTc
    to
           CoreExpr -> DsM CoreExpr
    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
    expr' [CoreExpr
    from', CoreExpr
    thn', CoreExpr
    to']

    {-
    Desugar 'do' and 'mdo' expressions (NOT list comprehensions, they're
    handled in GHC.HsToCore.ListComp).  Basically does the translation given in the
    Haskell 98 report:
    -}

    dsDo :: HsStmtContext GhcRn -> [ExprLStmt GhcTc] -> DsM CoreExpr
    dsDo :: HsStmtContext GhcRn -> [ExprLStmt GhcTc] -> DsM CoreExpr
    dsDo HsStmtContext GhcRn
    ctx [ExprLStmt GhcTc]
    stmts
      = [GenLocated
       SrcSpanAnnA
       (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
    -> DsM CoreExpr
    goL [GenLocated
       SrcSpanAnnA
       (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
    [ExprLStmt GhcTc]
    stmts
      where
        goL :: [GenLocated
       SrcSpanAnnA
       (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
    -> DsM CoreExpr
    goL [] = String -> DsM CoreExpr
    forall a. String -> a
    panic String
    "dsDo"
        goL ((L SrcSpanAnnA
    loc StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    stmt):[GenLocated
       SrcSpanAnnA
       (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
    lstmts) = SrcSpanAnnA -> DsM CoreExpr -> DsM CoreExpr
    forall ann a. SrcSpanAnn' ann -> DsM a -> DsM a
    putSrcSpanDsA SrcSpanAnnA
    loc (SrcSpanAnnA
    -> StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    -> [GenLocated
          SrcSpanAnnA
          (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
    -> DsM CoreExpr
    go SrcSpanAnnA
    loc StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    stmt [GenLocated
       SrcSpanAnnA
       (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
    lstmts)

        go :: SrcSpanAnnA
    -> StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    -> [GenLocated
          SrcSpanAnnA
          (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
    -> DsM CoreExpr
    go SrcSpanAnnA
    _ (LastStmt XLastStmt GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    _ GenLocated SrcSpanAnnA (HsExpr GhcTc)
    body Maybe Bool
    _ SyntaxExpr GhcTc
    _) [GenLocated
       SrcSpanAnnA
       (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
    stmts
          = ASSERT( null stmts ) dsLExpr body
            -- The 'return' op isn't used for 'do' expressions

        go SrcSpanAnnA
    _ (BodyStmt XBodyStmt GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    _ GenLocated SrcSpanAnnA (HsExpr GhcTc)
    rhs SyntaxExpr GhcTc
    then_expr SyntaxExpr GhcTc
    _) [GenLocated
       SrcSpanAnnA
       (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
    stmts
          = do { CoreExpr
    rhs2 <- LHsExpr GhcTc -> DsM CoreExpr
    dsLExpr GenLocated SrcSpanAnnA (HsExpr GhcTc)
    LHsExpr GhcTc
    rhs
               ; LHsExpr GhcTc -> Type -> IOEnv (Env DsGblEnv DsLclEnv) ()
    warnDiscardedDoBindings GenLocated SrcSpanAnnA (HsExpr GhcTc)
    LHsExpr GhcTc
    rhs (CoreExpr -> Type
    exprType CoreExpr
    rhs2)
               ; CoreExpr
    rest <- [GenLocated
       SrcSpanAnnA
       (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
    -> DsM CoreExpr
    goL [GenLocated
       SrcSpanAnnA
       (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
    stmts
               ; SyntaxExpr GhcTc -> [CoreExpr] -> DsM CoreExpr
    dsSyntaxExpr SyntaxExpr GhcTc
    then_expr [CoreExpr
    rhs2, CoreExpr
    rest] }

        go SrcSpanAnnA
    _ (LetStmt XLetStmt GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    _ HsLocalBinds GhcTc
    binds) [GenLocated
       SrcSpanAnnA
       (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
    stmts
          = do { CoreExpr
    rest <- [GenLocated
       SrcSpanAnnA
       (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
    -> DsM CoreExpr
    goL [GenLocated
       SrcSpanAnnA
       (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
    stmts
               ; HsLocalBinds GhcTc -> CoreExpr -> DsM CoreExpr
    dsLocalBinds HsLocalBinds GhcTc
    binds CoreExpr
    rest }

        go SrcSpanAnnA
    _ (BindStmt XBindStmt GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    xbs LPat GhcTc
    pat GenLocated SrcSpanAnnA (HsExpr GhcTc)
    rhs) [GenLocated
       SrcSpanAnnA
       (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
    stmts
          = do  { CoreExpr
    body     <- [GenLocated
       SrcSpanAnnA
       (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
    -> DsM CoreExpr
    goL [GenLocated
       SrcSpanAnnA
       (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
    stmts
                ; CoreExpr
    rhs'     <- LHsExpr GhcTc -> DsM CoreExpr
    dsLExpr GenLocated SrcSpanAnnA (HsExpr GhcTc)
    LHsExpr GhcTc
    rhs
                ; Id
    var   <- Type -> LPat GhcTc -> DsM Id
    selectSimpleMatchVarL (XBindStmtTc -> Type
    xbstc_boundResultMult XBindStmt GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    XBindStmtTc
    xbs) LPat GhcTc
    pat
                ; MatchResult CoreExpr
    match <- Id
    -> Maybe CoreExpr
    -> HsMatchContext GhcRn
    -> LPat GhcTc
    -> Type
    -> MatchResult CoreExpr
    -> DsM (MatchResult CoreExpr)
    matchSinglePatVar Id
    var Maybe CoreExpr
    forall a. Maybe a
    Nothing (HsStmtContext GhcRn -> HsMatchContext GhcRn
    forall p. HsStmtContext p -> HsMatchContext p
    StmtCtxt HsStmtContext GhcRn
    ctx) LPat GhcTc
    pat
                             (XBindStmtTc -> Type
    xbstc_boundResultType XBindStmt GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    XBindStmtTc
    xbs) (CoreExpr -> MatchResult CoreExpr
    cantFailMatchResult CoreExpr
    body)
                ; CoreExpr
    match_code <- HsStmtContext GhcRn
    -> LPat GhcTc
    -> MatchResult CoreExpr
    -> Maybe (SyntaxExpr GhcTc)
    -> DsM CoreExpr
    dsHandleMonadicFailure HsStmtContext GhcRn
    ctx LPat GhcTc
    pat MatchResult CoreExpr
    match (XBindStmtTc -> Maybe (SyntaxExpr GhcTc)
    xbstc_failOp XBindStmt GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    XBindStmtTc
    xbs)
                ; SyntaxExpr GhcTc -> [CoreExpr] -> DsM CoreExpr
    dsSyntaxExpr (XBindStmtTc -> SyntaxExpr GhcTc
    xbstc_bindOp XBindStmt GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    XBindStmtTc
    xbs) [CoreExpr
    rhs', Id -> CoreExpr -> CoreExpr
    forall b. b -> Expr b -> Expr b
    Lam Id
    var CoreExpr
    match_code] }

        go SrcSpanAnnA
    _ (ApplicativeStmt XApplicativeStmt
      GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    body_ty [(SyntaxExpr GhcTc, ApplicativeArg GhcTc)]
    args Maybe (SyntaxExpr GhcTc)
    mb_join) [GenLocated
       SrcSpanAnnA
       (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
    stmts
          = do {
                 let
                   ([(GenLocated SrcSpanAnnA (Pat GhcTc), Maybe SyntaxExprTc)]
    pats, [DsM CoreExpr]
    rhss) = [((GenLocated SrcSpanAnnA (Pat GhcTc), Maybe SyntaxExprTc),
      DsM CoreExpr)]
    -> ([(GenLocated SrcSpanAnnA (Pat GhcTc), Maybe SyntaxExprTc)],
        [DsM CoreExpr])
    forall a b. [(a, b)] -> ([a], [b])
    unzip (((SyntaxExprTc, ApplicativeArg GhcTc)
     -> ((GenLocated SrcSpanAnnA (Pat GhcTc), Maybe SyntaxExprTc),
         DsM CoreExpr))
    -> [(SyntaxExprTc, ApplicativeArg GhcTc)]
    -> [((GenLocated SrcSpanAnnA (Pat GhcTc), Maybe SyntaxExprTc),
         DsM CoreExpr)]
    forall a b. (a -> b) -> [a] -> [b]
    map (ApplicativeArg GhcTc
    -> ((GenLocated SrcSpanAnnA (Pat GhcTc), Maybe SyntaxExprTc),
        DsM CoreExpr)
    do_arg (ApplicativeArg GhcTc
     -> ((GenLocated SrcSpanAnnA (Pat GhcTc), Maybe SyntaxExprTc),
         DsM CoreExpr))
    -> ((SyntaxExprTc, ApplicativeArg GhcTc) -> ApplicativeArg GhcTc)
    -> (SyntaxExprTc, ApplicativeArg GhcTc)
    -> ((GenLocated SrcSpanAnnA (Pat GhcTc), Maybe SyntaxExprTc),
        DsM CoreExpr)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (SyntaxExprTc, ApplicativeArg GhcTc) -> ApplicativeArg GhcTc
    forall a b. (a, b) -> b
    snd) [(SyntaxExpr GhcTc, ApplicativeArg GhcTc)]
    [(SyntaxExprTc, ApplicativeArg GhcTc)]
    args)

                   do_arg :: ApplicativeArg GhcTc
    -> ((GenLocated SrcSpanAnnA (Pat GhcTc), Maybe SyntaxExprTc),
        DsM CoreExpr)
    do_arg (ApplicativeArgOne XApplicativeArgOne GhcTc
    fail_op LPat GhcTc
    pat LHsExpr GhcTc
    expr Bool
    _) =
                     ((GenLocated SrcSpanAnnA (Pat GhcTc)
    LPat GhcTc
    pat, Maybe SyntaxExprTc
    XApplicativeArgOne GhcTc
    fail_op), LHsExpr GhcTc -> DsM CoreExpr
    dsLExpr LHsExpr GhcTc
    expr)
                   do_arg (ApplicativeArgMany XApplicativeArgMany GhcTc
    _ [ExprLStmt GhcTc]
    stmts HsExpr GhcTc
    ret LPat GhcTc
    pat HsStmtContext (ApplicativeArgStmCtxPass GhcTc)
    _) =
                     ((GenLocated SrcSpanAnnA (Pat GhcTc)
    LPat GhcTc
    pat, Maybe SyntaxExprTc
    forall a. Maybe a
    Nothing), HsStmtContext GhcRn -> [ExprLStmt GhcTc] -> DsM CoreExpr
    dsDo HsStmtContext GhcRn
    ctx ([GenLocated
       SrcSpanAnnA
       (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
    [ExprLStmt GhcTc]
    stmts [GenLocated
       SrcSpanAnnA
       (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
    -> [GenLocated
          SrcSpanAnnA
          (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
    -> [GenLocated
          SrcSpanAnnA
          (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
    forall a. [a] -> [a] -> [a]
    ++ [StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    -> GenLocated
         SrcSpanAnnA
         (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
    forall a an. a -> LocatedAn an a
    noLocA (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
     -> GenLocated
          SrcSpanAnnA
          (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))))
    -> StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    -> GenLocated
         SrcSpanAnnA
         (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
    forall a b. (a -> b) -> a -> b
    $ GenLocated SrcSpanAnnA (HsExpr GhcTc)
    -> StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    forall (idR :: Pass) (bodyR :: * -> *) (idL :: Pass).
    IsPass idR =>
    LocatedA (bodyR (GhcPass idR))
    -> StmtLR
         (GhcPass idL) (GhcPass idR) (LocatedA (bodyR (GhcPass idR)))
    mkLastStmt (HsExpr GhcTc -> GenLocated SrcSpanAnnA (HsExpr GhcTc)
    forall a an. a -> LocatedAn an a
    noLocA HsExpr GhcTc
    ret)]))

               ; [CoreExpr]
    rhss' <- [DsM CoreExpr] -> IOEnv (Env DsGblEnv DsLclEnv) [CoreExpr]
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    sequence [DsM CoreExpr]
    rhss

               ; CoreExpr
    body' <- LHsExpr GhcTc -> DsM CoreExpr
    dsLExpr (LHsExpr GhcTc -> DsM CoreExpr) -> LHsExpr GhcTc -> DsM CoreExpr
    forall a b. (a -> b) -> a -> b
    $ HsExpr GhcTc -> GenLocated SrcSpanAnnA (HsExpr GhcTc)
    forall a an. a -> LocatedAn an a
    noLocA (HsExpr GhcTc -> GenLocated SrcSpanAnnA (HsExpr GhcTc))
    -> HsExpr GhcTc -> GenLocated SrcSpanAnnA (HsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $ XDo GhcTc
    -> HsStmtContext (HsDoRn GhcTc)
    -> XRec GhcTc [ExprLStmt GhcTc]
    -> HsExpr GhcTc
    forall p.
    XDo p
    -> HsStmtContext (HsDoRn p) -> XRec p [ExprLStmt p] -> HsExpr p
    HsDo XApplicativeStmt
      GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    XDo GhcTc
    body_ty HsStmtContext GhcRn
    HsStmtContext (HsDoRn GhcTc)
    ctx ([GenLocated
       SrcSpanAnnA
       (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
    -> GenLocated
         SrcSpanAnnL
         [GenLocated
            SrcSpanAnnA
            (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
    forall a an. a -> LocatedAn an a
    noLocA [GenLocated
       SrcSpanAnnA
       (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
    stmts)

               ; let match_args :: (GenLocated SrcSpanAnnA (Pat GhcTc), Maybe SyntaxExprTc)
    -> ([Id], CoreExpr) -> DsM ([Id], CoreExpr)
    match_args (GenLocated SrcSpanAnnA (Pat GhcTc)
    pat, Maybe SyntaxExprTc
    fail_op) ([Id]
    vs,CoreExpr
    body)
                       = do { Id
    var   <- Type -> LPat GhcTc -> DsM Id
    selectSimpleMatchVarL Type
    Many GenLocated SrcSpanAnnA (Pat GhcTc)
    LPat GhcTc
    pat
                            ; MatchResult CoreExpr
    match <- Id
    -> Maybe CoreExpr
    -> HsMatchContext GhcRn
    -> LPat GhcTc
    -> Type
    -> MatchResult CoreExpr
    -> DsM (MatchResult CoreExpr)
    matchSinglePatVar Id
    var Maybe CoreExpr
    forall a. Maybe a
    Nothing (HsStmtContext GhcRn -> HsMatchContext GhcRn
    forall p. HsStmtContext p -> HsMatchContext p
    StmtCtxt HsStmtContext GhcRn
    ctx) GenLocated SrcSpanAnnA (Pat GhcTc)
    LPat GhcTc
    pat
                                       Type
    XApplicativeStmt
      GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    body_ty (CoreExpr -> MatchResult CoreExpr
    cantFailMatchResult CoreExpr
    body)
                            ; CoreExpr
    match_code <- HsStmtContext GhcRn
    -> LPat GhcTc
    -> MatchResult CoreExpr
    -> Maybe (SyntaxExpr GhcTc)
    -> DsM CoreExpr
    dsHandleMonadicFailure HsStmtContext GhcRn
    ctx GenLocated SrcSpanAnnA (Pat GhcTc)
    LPat GhcTc
    pat MatchResult CoreExpr
    match Maybe (SyntaxExpr GhcTc)
    Maybe SyntaxExprTc
    fail_op
                            ; ([Id], CoreExpr) -> DsM ([Id], CoreExpr)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Id
    varId -> [Id] -> [Id]
    forall a. a -> [a] -> [a]
    :[Id]
    vs, CoreExpr
    match_code)
                            }

               ; ([Id]
    vars, CoreExpr
    body) <- ((GenLocated SrcSpanAnnA (Pat GhcTc), Maybe SyntaxExprTc)
     -> ([Id], CoreExpr) -> DsM ([Id], CoreExpr))
    -> ([Id], CoreExpr)
    -> [(GenLocated SrcSpanAnnA (Pat GhcTc), Maybe SyntaxExprTc)]
    -> DsM ([Id], CoreExpr)
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> b -> m b) -> b -> t a -> m b
    foldrM (GenLocated SrcSpanAnnA (Pat GhcTc), Maybe SyntaxExprTc)
    -> ([Id], CoreExpr) -> DsM ([Id], CoreExpr)
    match_args ([],CoreExpr
    body') [(GenLocated SrcSpanAnnA (Pat GhcTc), Maybe SyntaxExprTc)]
    pats
               ; let fun' :: CoreExpr
    fun' = [Id] -> CoreExpr -> CoreExpr
    forall b. [b] -> Expr b -> Expr b
    mkLams [Id]
    vars CoreExpr
    body
               ; let mk_ap_call :: CoreExpr -> (SyntaxExprTc, CoreExpr) -> DsM CoreExpr
    mk_ap_call CoreExpr
    l (SyntaxExprTc
    op,CoreExpr
    r) = SyntaxExpr GhcTc -> [CoreExpr] -> DsM CoreExpr
    dsSyntaxExpr SyntaxExpr GhcTc
    SyntaxExprTc
    op [CoreExpr
    l,CoreExpr
    r]
               ; CoreExpr
    expr <- (CoreExpr -> (SyntaxExprTc, CoreExpr) -> DsM CoreExpr)
    -> CoreExpr -> [(SyntaxExprTc, CoreExpr)] -> DsM CoreExpr
    forall (t :: * -> *) (m :: * -> *) b a.
    (Foldable t, Monad m) =>
    (b -> a -> m b) -> b -> t a -> m b
    foldlM CoreExpr -> (SyntaxExprTc, CoreExpr) -> DsM CoreExpr
    mk_ap_call CoreExpr
    fun' ([SyntaxExprTc] -> [CoreExpr] -> [(SyntaxExprTc, CoreExpr)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip (((SyntaxExprTc, ApplicativeArg GhcTc) -> SyntaxExprTc)
    -> [(SyntaxExprTc, ApplicativeArg GhcTc)] -> [SyntaxExprTc]
    forall a b. (a -> b) -> [a] -> [b]
    map (SyntaxExprTc, ApplicativeArg GhcTc) -> SyntaxExprTc
    forall a b. (a, b) -> a
    fst [(SyntaxExpr GhcTc, ApplicativeArg GhcTc)]
    [(SyntaxExprTc, ApplicativeArg GhcTc)]
    args) [CoreExpr]
    rhss')
               ; case Maybe (SyntaxExpr GhcTc)
    mb_join of
                   Maybe (SyntaxExpr GhcTc)
    Nothing -> CoreExpr -> DsM CoreExpr
    forall (m :: * -> *) a. Monad m => a -> m a
    return CoreExpr
    expr
                   Just SyntaxExpr GhcTc
    join_op -> SyntaxExpr GhcTc -> [CoreExpr] -> DsM CoreExpr
    dsSyntaxExpr SyntaxExpr GhcTc
    join_op [CoreExpr
    expr] }

        go SrcSpanAnnA
    loc (RecStmt { recS_stmts :: forall idL idR body.
    StmtLR idL idR body -> XRec idR [LStmtLR idL idR body]
    recS_stmts = L SrcSpanAnnL
    _ [GenLocated
       SrcSpanAnnA
       (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
    rec_stmts, recS_later_ids :: forall idL idR body. StmtLR idL idR body -> [IdP idR]
    recS_later_ids = [IdP GhcTc]
    later_ids
                        , recS_rec_ids :: forall idL idR body. StmtLR idL idR body -> [IdP idR]
    recS_rec_ids = [IdP GhcTc]
    rec_ids, recS_ret_fn :: forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
    recS_ret_fn = SyntaxExpr GhcTc
    return_op
                        , recS_mfix_fn :: forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
    recS_mfix_fn = SyntaxExpr GhcTc
    mfix_op, recS_bind_fn :: forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
    recS_bind_fn = SyntaxExpr GhcTc
    bind_op
                        , recS_ext :: forall idL idR body. StmtLR idL idR body -> XRecStmt idL idR body
    recS_ext = RecStmtTc
                            { recS_bind_ty :: RecStmtTc -> Type
    recS_bind_ty = Type
    bind_ty
                            , recS_rec_rets :: RecStmtTc -> [HsExpr GhcTc]
    recS_rec_rets = [HsExpr GhcTc]
    rec_rets
                            , recS_ret_ty :: RecStmtTc -> Type
    recS_ret_ty = Type
    body_ty} }) [GenLocated
       SrcSpanAnnA
       (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
    stmts
          = [GenLocated
       SrcSpanAnnA
       (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
    -> DsM CoreExpr
    goL (GenLocated
      SrcSpanAnnA
      (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
    new_bind_stmt GenLocated
      SrcSpanAnnA
      (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
    -> [GenLocated
          SrcSpanAnnA
          (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
    -> [GenLocated
          SrcSpanAnnA
          (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
    forall a. a -> [a] -> [a]
    : [GenLocated
       SrcSpanAnnA
       (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
    stmts)  -- rec_ids can be empty; eg  rec { print 'x' }
          where
            new_bind_stmt :: GenLocated
      SrcSpanAnnA
      (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
    new_bind_stmt = SrcSpanAnnA
    -> StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    -> GenLocated
         SrcSpanAnnA
         (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
    forall l e. l -> e -> GenLocated l e
    L SrcSpanAnnA
    loc (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
     -> GenLocated
          SrcSpanAnnA
          (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))))
    -> StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    -> GenLocated
         SrcSpanAnnA
         (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
    forall a b. (a -> b) -> a -> b
    $ XBindStmt GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    -> LPat GhcTc
    -> GenLocated SrcSpanAnnA (HsExpr GhcTc)
    -> StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    forall idL idR body.
    XBindStmt idL idR body -> LPat idL -> body -> StmtLR idL idR body
    BindStmt
              XBindStmtTc
                { xbstc_bindOp :: SyntaxExpr GhcTc
    xbstc_bindOp = SyntaxExpr GhcTc
    bind_op
                , xbstc_boundResultType :: Type
    xbstc_boundResultType = Type
    bind_ty
                , xbstc_boundResultMult :: Type
    xbstc_boundResultMult = Type
    Many
                , xbstc_failOp :: Maybe (SyntaxExpr GhcTc)
    xbstc_failOp = Maybe (SyntaxExpr GhcTc)
    forall a. Maybe a
    Nothing -- Tuple cannot fail
                }
              ([LPat GhcTc] -> LPat GhcTc
    mkBigLHsPatTupId [GenLocated SrcSpanAnnA (Pat GhcTc)]
    [LPat GhcTc]
    later_pats)
              GenLocated SrcSpanAnnA (HsExpr GhcTc)
    LHsExpr GhcTc
    mfix_app

            tup_ids :: [Id]
    tup_ids      = [Id]
    [IdP GhcTc]
    rec_ids [Id] -> [Id] -> [Id]
    forall a. [a] -> [a] -> [a]
    ++ (Id -> Bool) -> [Id] -> [Id]
    forall a. (a -> Bool) -> [a] -> [a]
    filterOut (IdP GhcTc -> [IdP GhcTc] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [IdP GhcTc]
    rec_ids) [Id]
    [IdP GhcTc]
    later_ids
            tup_ty :: Type
    tup_ty       = [Type] -> Type
    mkBigCoreTupTy ((Id -> Type) -> [Id] -> [Type]
    forall a b. (a -> b) -> [a] -> [b]
    map Id -> Type
    idType [Id]
    tup_ids) -- Deals with singleton case
            rec_tup_pats :: [GenLocated SrcSpanAnnA (Pat GhcTc)]
    rec_tup_pats = (Id -> GenLocated SrcSpanAnnA (Pat GhcTc))
    -> [Id] -> [GenLocated SrcSpanAnnA (Pat GhcTc)]
    forall a b. (a -> b) -> [a] -> [b]
    map Id -> GenLocated SrcSpanAnnA (Pat GhcTc)
    forall (p :: Pass) a.
    IsSrcSpanAnn p a =>
    IdP (GhcPass p) -> LPat (GhcPass p)
    nlVarPat [Id]
    tup_ids
            later_pats :: [GenLocated SrcSpanAnnA (Pat GhcTc)]
    later_pats   = [GenLocated SrcSpanAnnA (Pat GhcTc)]
    rec_tup_pats
            rets :: [GenLocated SrcSpanAnnA (HsExpr GhcTc)]
    rets         = (HsExpr GhcTc -> GenLocated SrcSpanAnnA (HsExpr GhcTc))
    -> [HsExpr GhcTc] -> [GenLocated SrcSpanAnnA (HsExpr GhcTc)]
    forall a b. (a -> b) -> [a] -> [b]
    map HsExpr GhcTc -> GenLocated SrcSpanAnnA (HsExpr GhcTc)
    forall a an. a -> LocatedAn an a
    noLocA [HsExpr GhcTc]
    rec_rets
            mfix_app :: LHsExpr GhcTc
    mfix_app     = SyntaxExprTc -> [LHsExpr GhcTc] -> LHsExpr GhcTc
    nlHsSyntaxApps SyntaxExpr GhcTc
    SyntaxExprTc
    mfix_op [GenLocated SrcSpanAnnA (HsExpr GhcTc)
    LHsExpr GhcTc
    mfix_arg]
            mfix_arg :: GenLocated SrcSpanAnnA (HsExpr GhcTc)
    mfix_arg     = HsExpr GhcTc -> GenLocated SrcSpanAnnA (HsExpr GhcTc)
    forall a an. a -> LocatedAn an a
    noLocA (HsExpr GhcTc -> GenLocated SrcSpanAnnA (HsExpr GhcTc))
    -> HsExpr GhcTc -> GenLocated SrcSpanAnnA (HsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $ XLam GhcTc -> MatchGroup GhcTc (LHsExpr GhcTc) -> HsExpr GhcTc
    forall p. XLam p -> MatchGroup p (LHsExpr p) -> HsExpr p
    HsLam NoExtField
    XLam GhcTc
    noExtField
                               (MG { mg_alts :: XRec GhcTc [LMatch GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))]
    mg_alts = [LMatch GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))]
    -> LocatedAn
         AnnList [LMatch GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))]
    forall a an. a -> LocatedAn an a
    noLocA [HsMatchContext (NoGhcTc GhcTc)
    -> [LPat GhcTc]
    -> GenLocated SrcSpanAnnA (HsExpr GhcTc)
    -> LMatch GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    forall (p :: Pass) (body :: * -> *).
    (Anno (Match (GhcPass p) (LocatedA (body (GhcPass p))))
     ~ SrcSpanAnnA,
     Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p)))) ~ SrcSpan) =>
    HsMatchContext (NoGhcTc (GhcPass p))
    -> [LPat (GhcPass p)]
    -> LocatedA (body (GhcPass p))
    -> LMatch (GhcPass p) (LocatedA (body (GhcPass p)))
    mkSimpleMatch
                                                        HsMatchContext (NoGhcTc GhcTc)
    forall p. HsMatchContext p
    LambdaExpr
                                                        [GenLocated SrcSpanAnnA (Pat GhcTc)
    LPat GhcTc
    mfix_pat] GenLocated SrcSpanAnnA (HsExpr GhcTc)
    body]
                                   , mg_ext :: XMG GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    mg_ext = [Scaled Type] -> Type -> MatchGroupTc
    MatchGroupTc [Type -> Scaled Type
    forall a. a -> Scaled a
    unrestricted Type
    tup_ty] Type
    body_ty
                                   , mg_origin :: Origin
    mg_origin = Origin
    Generated })
            mfix_pat :: GenLocated SrcSpanAnnA (Pat GhcTc)
    mfix_pat     = Pat GhcTc -> GenLocated SrcSpanAnnA (Pat GhcTc)
    forall a an. a -> LocatedAn an a
    noLocA (Pat GhcTc -> GenLocated SrcSpanAnnA (Pat GhcTc))
    -> Pat GhcTc -> GenLocated SrcSpanAnnA (Pat GhcTc)
    forall a b. (a -> b) -> a -> b
    $ XLazyPat GhcTc -> LPat GhcTc -> Pat GhcTc
    forall p. XLazyPat p -> LPat p -> Pat p
    LazyPat NoExtField
    XLazyPat GhcTc
    noExtField (LPat GhcTc -> Pat GhcTc) -> LPat GhcTc -> Pat GhcTc
    forall a b. (a -> b) -> a -> b
    $ [LPat GhcTc] -> LPat GhcTc
    mkBigLHsPatTupId [GenLocated SrcSpanAnnA (Pat GhcTc)]
    [LPat GhcTc]
    rec_tup_pats
            body :: GenLocated SrcSpanAnnA (HsExpr GhcTc)
    body         = HsExpr GhcTc -> GenLocated SrcSpanAnnA (HsExpr GhcTc)
    forall a an. a -> LocatedAn an a
    noLocA (HsExpr GhcTc -> GenLocated SrcSpanAnnA (HsExpr GhcTc))
    -> HsExpr GhcTc -> GenLocated SrcSpanAnnA (HsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $ XDo GhcTc
    -> HsStmtContext (HsDoRn GhcTc)
    -> XRec GhcTc [ExprLStmt GhcTc]
    -> HsExpr GhcTc
    forall p.
    XDo p
    -> HsStmtContext (HsDoRn p) -> XRec p [ExprLStmt p] -> HsExpr p
    HsDo Type
    XDo GhcTc
    body_ty
                                    HsStmtContext GhcRn
    HsStmtContext (HsDoRn GhcTc)
    ctx ([GenLocated
       SrcSpanAnnA
       (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
    -> GenLocated
         SrcSpanAnnL
         [GenLocated
            SrcSpanAnnA
            (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
    forall a an. a -> LocatedAn an a
    noLocA ([GenLocated
       SrcSpanAnnA
       (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
    rec_stmts [GenLocated
       SrcSpanAnnA
       (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
    -> [GenLocated
          SrcSpanAnnA
          (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
    -> [GenLocated
          SrcSpanAnnA
          (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
    forall a. [a] -> [a] -> [a]
    ++ [GenLocated
      SrcSpanAnnA
      (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
    ret_stmt]))
            ret_app :: LHsExpr GhcTc
    ret_app      = SyntaxExprTc -> [LHsExpr GhcTc] -> LHsExpr GhcTc
    nlHsSyntaxApps SyntaxExpr GhcTc
    SyntaxExprTc
    return_op [[LHsExpr GhcTc] -> LHsExpr GhcTc
    mkBigLHsTupId [GenLocated SrcSpanAnnA (HsExpr GhcTc)]
    [LHsExpr GhcTc]
    rets]
            ret_stmt :: GenLocated
      SrcSpanAnnA
      (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
    ret_stmt     = StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    -> GenLocated
         SrcSpanAnnA
         (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
    forall a an. a -> LocatedAn an a
    noLocA (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
     -> GenLocated
          SrcSpanAnnA
          (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))))
    -> StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    -> GenLocated
         SrcSpanAnnA
         (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
    forall a b. (a -> b) -> a -> b
    $ GenLocated SrcSpanAnnA (HsExpr GhcTc)
    -> StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    forall (idR :: Pass) (bodyR :: * -> *) (idL :: Pass).
    IsPass idR =>
    LocatedA (bodyR (GhcPass idR))
    -> StmtLR
         (GhcPass idL) (GhcPass idR) (LocatedA (bodyR (GhcPass idR)))
    mkLastStmt GenLocated SrcSpanAnnA (HsExpr GhcTc)
    LHsExpr GhcTc
    ret_app
                         -- This LastStmt will be desugared with dsDo,
                         -- which ignores the return_op in the LastStmt,
                         -- so we must apply the return_op explicitly

        go SrcSpanAnnA
    _ (ParStmt   {}) [GenLocated
       SrcSpanAnnA
       (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
    _ = String -> DsM CoreExpr
    forall a. String -> a
    panic String
    "dsDo ParStmt"
        go SrcSpanAnnA
    _ (TransStmt {}) [GenLocated
       SrcSpanAnnA
       (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
    _ = String -> DsM CoreExpr
    forall a. String -> a
    panic String
    "dsDo TransStmt"

    {-
    ************************************************************************
    *                                                                      *
       Desugaring Variables
    *                                                                      *
    ************************************************************************
    -}

    dsHsVar :: Id -> DsM CoreExpr
    dsHsVar :: Id -> DsM CoreExpr
    dsHsVar Id
    var
      = do { SDoc -> Id -> Type -> IOEnv (Env DsGblEnv DsLclEnv) ()
    checkLevPolyFunction (Id -> SDoc
    forall {a}. Outputable a => a -> SDoc
    ppr Id
    var) Id
    var (Id -> Type
    idType Id
    var)
           ; CoreExpr -> DsM CoreExpr
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Id -> CoreExpr
    forall b. Id -> Expr b
    varToCoreExpr Id
    var) }   -- See Note [Desugaring vars]

    dsConLike :: ConLike -> DsM CoreExpr
    dsConLike :: ConLike -> DsM CoreExpr
    dsConLike (RealDataCon DataCon
    dc) = Id -> DsM CoreExpr
    dsHsVar (DataCon -> Id
    dataConWrapId DataCon
    dc)
    dsConLike (PatSynCon PatSyn
    ps)
      | Just (Name
    builder_name, Type
    _, Bool
    add_void) <- PatSyn -> Maybe (Name, Type, Bool)
    patSynBuilder PatSyn
    ps
      = do { Id
    builder_id <- Name -> DsM Id
    dsLookupGlobalId Name
    builder_name
           ; CoreExpr -> DsM CoreExpr
    forall (m :: * -> *) a. Monad m => a -> m a
    return (if Bool
    add_void
                     then SDoc -> CoreExpr -> CoreExpr -> CoreExpr
    mkCoreApp (String -> SDoc
    text String
    "dsConLike" SDoc -> SDoc -> SDoc
    <+> PatSyn -> SDoc
    forall {a}. Outputable a => a -> SDoc
    ppr PatSyn
    ps)
                                    (Id -> CoreExpr
    forall b. Id -> Expr b
    Var Id
    builder_id) (Id -> CoreExpr
    forall b. Id -> Expr b
    Var Id
    voidPrimId)
                     else Id -> CoreExpr
    forall b. Id -> Expr b
    Var Id
    builder_id) }
      | Bool
    otherwise
      = String -> SDoc -> DsM CoreExpr
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "dsConLike" (PatSyn -> SDoc
    forall {a}. Outputable a => a -> SDoc
    ppr PatSyn
    ps)

    {-
    ************************************************************************
    *                                                                      *
    \subsection{Errors and contexts}
    *                                                                      *
    ************************************************************************
    -}

    -- Warn about certain types of values discarded in monadic bindings (#3263)
    warnDiscardedDoBindings :: LHsExpr GhcTc -> Type -> DsM ()
    warnDiscardedDoBindings :: LHsExpr GhcTc -> Type -> IOEnv (Env DsGblEnv DsLclEnv) ()
    warnDiscardedDoBindings LHsExpr GhcTc
    rhs Type
    rhs_ty
      | Just (Type
    m_ty, Type
    elt_ty) <- Type -> Maybe (Type, Type)
    tcSplitAppTy_maybe Type
    rhs_ty
      = do { Bool
    warn_unused <- WarningFlag -> TcRnIf DsGblEnv DsLclEnv Bool
    forall gbl lcl. WarningFlag -> TcRnIf gbl lcl Bool
    woptM WarningFlag
    Opt_WarnUnusedDoBind
           ; Bool
    warn_wrong <- WarningFlag -> TcRnIf DsGblEnv DsLclEnv Bool
    forall gbl lcl. WarningFlag -> TcRnIf gbl lcl Bool
    woptM WarningFlag
    Opt_WarnWrongDoBind
           ; Bool
    -> IOEnv (Env DsGblEnv DsLclEnv) ()
    -> IOEnv (Env DsGblEnv DsLclEnv) ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Bool
    warn_unused Bool -> Bool -> Bool
    || Bool
    warn_wrong) (IOEnv (Env DsGblEnv DsLclEnv) ()
     -> IOEnv (Env DsGblEnv DsLclEnv) ())
    -> IOEnv (Env DsGblEnv DsLclEnv) ()
    -> IOEnv (Env DsGblEnv DsLclEnv) ()
    forall a b. (a -> b) -> a -> b
    $
        do { FamInstEnvs
    fam_inst_envs <- DsM FamInstEnvs
    dsGetFamInstEnvs
           ; let norm_elt_ty :: Type
    norm_elt_ty = FamInstEnvs -> Type -> Type
    topNormaliseType FamInstEnvs
    fam_inst_envs Type
    elt_ty

               -- Warn about discarding non-() things in 'monadic' binding
           ; if Bool
    warn_unused Bool -> Bool -> Bool
    && Bool -> Bool
    not (Type -> Bool
    isUnitTy Type
    norm_elt_ty)
             then WarnReason -> SDoc -> IOEnv (Env DsGblEnv DsLclEnv) ()
    warnDs (WarningFlag -> WarnReason
    Reason WarningFlag
    Opt_WarnUnusedDoBind)
                         (LHsExpr GhcTc -> Type -> SDoc
    badMonadBind LHsExpr GhcTc
    rhs Type
    elt_ty)
             else

               -- Warn about discarding m a things in 'monadic' binding of the same type,
               -- but only if we didn't already warn due to Opt_WarnUnusedDoBind
               Bool
    -> IOEnv (Env DsGblEnv DsLclEnv) ()
    -> IOEnv (Env DsGblEnv DsLclEnv) ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    warn_wrong (IOEnv (Env DsGblEnv DsLclEnv) ()
     -> IOEnv (Env DsGblEnv DsLclEnv) ())
    -> IOEnv (Env DsGblEnv DsLclEnv) ()
    -> IOEnv (Env DsGblEnv DsLclEnv) ()
    forall a b. (a -> b) -> a -> b
    $
                    case Type -> Maybe (Type, Type)
    tcSplitAppTy_maybe Type
    norm_elt_ty of
                          Just (Type
    elt_m_ty, Type
    _)
                             | Type
    m_ty Type -> Type -> Bool
    `eqType` FamInstEnvs -> Type -> Type
    topNormaliseType FamInstEnvs
    fam_inst_envs Type
    elt_m_ty
                             -> WarnReason -> SDoc -> IOEnv (Env DsGblEnv DsLclEnv) ()
    warnDs (WarningFlag -> WarnReason
    Reason WarningFlag
    Opt_WarnWrongDoBind)
                                       (LHsExpr GhcTc -> Type -> SDoc
    badMonadBind LHsExpr GhcTc
    rhs Type
    elt_ty)
                          Maybe (Type, Type)
    _ -> () -> IOEnv (Env DsGblEnv DsLclEnv) ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return () } }

      | Bool
    otherwise   -- RHS does have type of form (m ty), which is weird
      = () -> IOEnv (Env DsGblEnv DsLclEnv) ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()   -- but at least this warning is irrelevant

    badMonadBind :: LHsExpr GhcTc -> Type -> SDoc
    badMonadBind :: LHsExpr GhcTc -> Type -> SDoc
    badMonadBind LHsExpr GhcTc
    rhs Type
    elt_ty
      = [SDoc] -> SDoc
    vcat [ SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "A do-notation statement discarded a result of type")
                  Int
    2 (SDoc -> SDoc
    quotes (Type -> SDoc
    forall {a}. Outputable a => a -> SDoc
    ppr Type
    elt_ty))
             , SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "Suppress this warning by saying")
                  Int
    2 (SDoc -> SDoc
    quotes (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $ String -> SDoc
    text String
    "_ <-" SDoc -> SDoc -> SDoc
    <+> GenLocated SrcSpanAnnA (HsExpr GhcTc) -> SDoc
    forall {a}. Outputable a => a -> SDoc
    ppr GenLocated SrcSpanAnnA (HsExpr GhcTc)
    LHsExpr GhcTc
    rhs)
             ]

    {-
    ************************************************************************
    *                                                                      *
                Levity polymorphism checks
    *                                                                      *
    ************************************************************************

    Note [Checking for levity-polymorphic functions]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    We cannot have levity polymorphic function arguments. See
    Note [Levity polymorphism invariants] in GHC.Core. That is
    checked by dsLExprNoLP.

    But what about
      const True (unsafeCoerce# :: forall r1 r2 (a :: TYPE r1) (b :: TYPE r2). a -> b)

    Since `unsafeCoerce#` has no binding, it has a compulsory unfolding.
    But that compulsory unfolding is a levity-polymorphic lambda, which
    is no good.  So we want to reject this.  On the other hand
      const True (unsafeCoerce# @LiftedRep @UnliftedRep)
    is absolutely fine.

    We have to collect all the type-instantiation and *then* check.  That
    is what dsHsWrapped does.  Because we might have an HsVar without a
    wrapper, we check in dsHsVar as well. typecheck/should_fail/T17021
    triggers this case.

    Note that if `f :: forall r (a :: Type r). blah`, then
       const True f
    is absolutely fine.  Here `f` is a function, represented by a
    pointer, and we can pass it to `const` (or anything else).  (See
    #12708 for an example.)  It's only the Id.hasNoBinding functions
    that are a problem.

    Interestingly, this approach does not look to see whether the Id in
    question will be eta expanded. The logic is this:
      * Either the Id in question is saturated or not.
      * If it is, then it surely can't have levity polymorphic arguments.
        If its wrapped type contains levity polymorphic arguments, reject.
      * If it's not, then it can't be eta expanded with levity polymorphic
        argument. If its wrapped type contains levity polymorphic arguments, reject.
    So, either way, we're good to reject.

    -}

    ------------------------------
    dsHsWrapped :: HsExpr GhcTc -> DsM CoreExpr
    -- Looks for a function 'f' wrapped in type applications (HsAppType)
    -- or wrappers (HsWrap), and checks that any hasNoBinding function
    -- is not levity polymorphic, *after* instantiation with those wrappers
    dsHsWrapped :: HsExpr GhcTc -> DsM CoreExpr
    dsHsWrapped HsExpr GhcTc
    orig_hs_expr
      = (CoreExpr -> CoreExpr) -> HsExpr GhcTc -> DsM CoreExpr
    go CoreExpr -> CoreExpr
    forall a. a -> a
    id HsExpr GhcTc
    orig_hs_expr
      where
        go :: (CoreExpr -> CoreExpr) -> HsExpr GhcTc -> DsM CoreExpr
    go CoreExpr -> CoreExpr
    wrap (XExpr (WrapExpr (HsWrap HsWrapper
    co_fn HsExpr GhcTc
    hs_e)))
           = do { CoreExpr -> CoreExpr
    wrap' <- HsWrapper -> IOEnv (Env DsGblEnv DsLclEnv) (CoreExpr -> CoreExpr)
    dsHsWrapper HsWrapper
    co_fn
                ; Origin -> Bag Id -> DsM CoreExpr -> DsM CoreExpr
    forall a. Origin -> Bag Id -> DsM a -> DsM a
    addTyCs Origin
    FromSource (HsWrapper -> Bag Id
    hsWrapDictBinders HsWrapper
    co_fn) (DsM CoreExpr -> DsM CoreExpr) -> DsM CoreExpr -> DsM CoreExpr
    forall a b. (a -> b) -> a -> b
    $
                  (CoreExpr -> CoreExpr) -> HsExpr GhcTc -> DsM CoreExpr
    go (CoreExpr -> CoreExpr
    wrap (CoreExpr -> CoreExpr)
    -> (CoreExpr -> CoreExpr) -> CoreExpr -> CoreExpr
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CoreExpr -> CoreExpr
    wrap') HsExpr GhcTc
    hs_e }
        go CoreExpr -> CoreExpr
    wrap (HsConLikeOut XConLikeOut GhcTc
    _ (RealDataCon DataCon
    dc))
          = (CoreExpr -> CoreExpr) -> Id -> DsM CoreExpr
    go_head CoreExpr -> CoreExpr
    wrap (DataCon -> Id
    dataConWrapId DataCon
    dc)
        go CoreExpr -> CoreExpr
    wrap (HsAppType XAppTypeE GhcTc
    ty LHsExpr GhcTc
    hs_e LHsWcType (NoGhcTc GhcTc)
    _) = (CoreExpr -> CoreExpr)
    -> GenLocated SrcSpanAnnA (HsExpr GhcTc) -> DsM CoreExpr
    go_l (CoreExpr -> CoreExpr
    wrap (CoreExpr -> CoreExpr)
    -> (CoreExpr -> CoreExpr) -> CoreExpr -> CoreExpr
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (\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
    XAppTypeE GhcTc
    ty))) GenLocated SrcSpanAnnA (HsExpr GhcTc)
    LHsExpr GhcTc
    hs_e
        go CoreExpr -> CoreExpr
    wrap (HsPar XPar GhcTc
    _ LHsExpr GhcTc
    hs_e)        = (CoreExpr -> CoreExpr)
    -> GenLocated SrcSpanAnnA (HsExpr GhcTc) -> DsM CoreExpr
    go_l CoreExpr -> CoreExpr
    wrap GenLocated SrcSpanAnnA (HsExpr GhcTc)
    LHsExpr GhcTc
    hs_e
        go CoreExpr -> CoreExpr
    wrap (HsVar XVar GhcTc
    _ (L SrcSpanAnnN
    _ Id
    var))   = (CoreExpr -> CoreExpr) -> Id -> DsM CoreExpr
    go_head CoreExpr -> CoreExpr
    wrap Id
    var
        go CoreExpr -> CoreExpr
    wrap HsExpr GhcTc
    hs_e                  = do { CoreExpr
    e <- HsExpr GhcTc -> DsM CoreExpr
    dsExpr HsExpr GhcTc
    hs_e; CoreExpr -> DsM CoreExpr
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CoreExpr -> CoreExpr
    wrap CoreExpr
    e) }

        go_l :: (CoreExpr -> CoreExpr)
    -> GenLocated SrcSpanAnnA (HsExpr GhcTc) -> DsM CoreExpr
    go_l CoreExpr -> CoreExpr
    wrap (L SrcSpanAnnA
    _ HsExpr GhcTc
    hs_e) = (CoreExpr -> CoreExpr) -> HsExpr GhcTc -> DsM CoreExpr
    go CoreExpr -> CoreExpr
    wrap HsExpr GhcTc
    hs_e

        go_head :: (CoreExpr -> CoreExpr) -> Id -> DsM CoreExpr
    go_head CoreExpr -> CoreExpr
    wrap Id
    var
          = do { let wrapped_e :: CoreExpr
    wrapped_e  = CoreExpr -> CoreExpr
    wrap (Id -> CoreExpr
    forall b. Id -> Expr b
    Var Id
    var)
                     wrapped_ty :: Type
    wrapped_ty = CoreExpr -> Type
    exprType CoreExpr
    wrapped_e

               ; SDoc -> Id -> Type -> IOEnv (Env DsGblEnv DsLclEnv) ()
    checkLevPolyFunction (HsExpr GhcTc -> SDoc
    forall {a}. Outputable a => a -> SDoc
    ppr HsExpr GhcTc
    orig_hs_expr) Id
    var Type
    wrapped_ty
                 -- See Note [Checking for levity-polymorphic functions]
                 -- Pass orig_hs_expr, so that the user can see entire
                 -- expression with -fprint-typechecker-elaboration

               ; DynFlags
    dflags <- IOEnv (Env DsGblEnv DsLclEnv) DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
               ; DynFlags -> Id -> Type -> IOEnv (Env DsGblEnv DsLclEnv) ()
    warnAboutIdentities DynFlags
    dflags Id
    var Type
    wrapped_ty

               ; CoreExpr -> DsM CoreExpr
    forall (m :: * -> *) a. Monad m => a -> m a
    return CoreExpr
    wrapped_e }

    -- | Takes a (pretty-printed) expression, a function, and its
    -- instantiated type.  If the function is a hasNoBinding op, and the
    -- type has levity-polymorphic arguments, issue an error.
    -- Note [Checking for levity-polymorphic functions]
    checkLevPolyFunction :: SDoc -> Id -> Type -> DsM ()
    checkLevPolyFunction :: SDoc -> Id -> Type -> IOEnv (Env DsGblEnv DsLclEnv) ()
    checkLevPolyFunction SDoc
    pp_hs_expr Id
    var Type
    ty
      | let bad_tys :: [Type]
    bad_tys = Id -> Type -> [Type]
    isBadLevPolyFunction Id
    var Type
    ty
      , Bool -> Bool
    not ([Type] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Type]
    bad_tys)
      = SDoc -> IOEnv (Env DsGblEnv DsLclEnv) ()
    errDs (SDoc -> IOEnv (Env DsGblEnv DsLclEnv) ())
    -> SDoc -> IOEnv (Env DsGblEnv DsLclEnv) ()
    forall a b. (a -> b) -> a -> b
    $ [SDoc] -> SDoc
    vcat
        [ SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "Cannot use function with levity-polymorphic arguments:")
             Int
    2 (SDoc
    pp_hs_expr SDoc -> SDoc -> SDoc
    <+> SDoc
    dcolon SDoc -> SDoc -> SDoc
    <+> Type -> SDoc
    pprWithTYPE Type
    ty)
        , (SDocContext -> Bool) -> SDoc -> SDoc
    ppUnlessOption SDocContext -> Bool
    sdocPrintTypecheckerElaboration (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $ [SDoc] -> SDoc
    vcat
            [ String -> SDoc
    text String
    "(Note that levity-polymorphic primops such as 'coerce' and unboxed tuples"
            , String -> SDoc
    text String
    "are eta-expanded internally because they must occur fully saturated."
            , String -> SDoc
    text String
    "Use -fprint-typechecker-elaboration to display the full expression.)"
            ]
        , SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "Levity-polymorphic arguments:")
             Int
    2 (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $ [SDoc] -> SDoc
    vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
    forall a b. (a -> b) -> a -> b
    $ (Type -> SDoc) -> [Type] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map
               (\Type
    t -> Type -> SDoc
    pprWithTYPE Type
    t SDoc -> SDoc -> SDoc
    <+> SDoc
    dcolon SDoc -> SDoc -> SDoc
    <+> Type -> SDoc
    pprWithTYPE (HasDebugCallStack => Type -> Type
    Type -> Type
    typeKind Type
    t))
               [Type]
    bad_tys
        ]

    checkLevPolyFunction SDoc
    _ Id
    _ Type
    _ = () -> IOEnv (Env DsGblEnv DsLclEnv) ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    -- | Is this a hasNoBinding Id with a levity-polymorphic type?
    -- Returns the arguments that are levity polymorphic if they are bad;
    -- or an empty list otherwise
    -- Note [Checking for levity-polymorphic functions]
    isBadLevPolyFunction :: Id -> Type -> [Type]
    isBadLevPolyFunction :: Id -> Type -> [Type]
    isBadLevPolyFunction Id
    id Type
    ty
      | Id -> Bool
    hasNoBinding Id
    id
      = (Type -> Bool) -> [Type] -> [Type]
    forall a. (a -> Bool) -> [a] -> [a]
    filter Type -> Bool
    isTypeLevPoly [Type]
    arg_tys
      | Bool
    otherwise
      = []
      where
        ([TyCoBinder]
    binders, Type
    _) = Type -> ([TyCoBinder], Type)
    splitPiTys Type
    ty
        arg_tys :: [Type]
    arg_tys      = (TyCoBinder -> Maybe Type) -> [TyCoBinder] -> [Type]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe TyCoBinder -> Maybe Type
    binderRelevantType_maybe [TyCoBinder]
    binders