    {-# LANGUAGE TypeFamilies #-}
    {-# LANGUAGE ViewPatterns #-}

    {-# OPTIONS_GHC -Wno-incomplete-uni-patterns   #-}
    {-# LANGUAGE LambdaCase #-}

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

    Desugaring expressions.
    -}

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

    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
    import GHC.HsToCore.Errors.Types
    import GHC.Types.SourceText
    import GHC.Types.Name hiding (varName)
    import GHC.Core.FamInstEnv( topNormaliseType )
    import GHC.HsToCore.Quote
    import GHC.HsToCore.Ticks (stripTicksTopHsExpr)
    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.TyCo.Rep
    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.Info
    import GHC.Types.Id.Make
    import GHC.Unit.Module
    import GHC.Core.ConLike
    import GHC.Core.DataCon
    import GHC.Builtin.Types
    import GHC.Builtin.Names
    import GHC.Types.Basic
    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 GHC.Types.Error

    {-
    ************************************************************************
    *                                                                      *
                    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 a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    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). 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
      = do { dflags <- IOEnv (Env DsGblEnv DsLclEnv) DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
           ; foldrM (ds_val_bind dflags) body binds }
    dsValBinds (ValBinds {})       CoreExpr
    _    = String -> DsM CoreExpr
    forall a. HasCallStack => 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  { TcEvBinds -> ([CoreBind] -> DsM CoreExpr) -> DsM CoreExpr
    forall a. TcEvBinds -> ([CoreBind] -> DsM a) -> DsM a
    dsTcEvBinds XIPBinds GhcTc
    TcEvBinds
    ev_binds (([CoreBind] -> DsM CoreExpr) -> DsM CoreExpr)
    -> ([CoreBind] -> DsM CoreExpr) -> DsM CoreExpr
    forall a b. (a -> b) -> a -> b
    $ \ [CoreBind]
    ds_binds -> do
            { 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 LIPBind GhcTc -> CoreExpr -> DsM CoreExpr
    GenLocated SrcSpanAnnA (IPBind GhcTc) -> CoreExpr -> DsM CoreExpr
    ds_ip_bind CoreExpr
    inner [LIPBind GhcTc]
    [GenLocated SrcSpanAnnA (IPBind 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
    n XRec GhcTc HsIPName
    _ LHsExpr GhcTc
    e)) CoreExpr
    body
          = do e' <- LHsExpr GhcTc -> DsM CoreExpr
    dsLExpr LHsExpr GhcTc
    e
               return (Let (NonRec n e') body)

    -------------------------
    -- caller sets location
    ds_val_bind :: DynFlags -> (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 :: DynFlags -> (RecFlag, LHsBinds GhcTc) -> CoreExpr -> DsM CoreExpr
    ds_val_bind DynFlags
    _ (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 LHsBinds GhcTc
    Bag (GenLocated SrcSpanAnnA (HsBind 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. HasLoc a => 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}.
    (XXHsBindsLR idL idR ~ AbsBinds) =>
    HsBindLR idL idR -> Bool
    is_polymorphic HsBind GhcTc
    bind
        then DsMessage -> DsM CoreExpr
    errDsCoreExpr (HsBind GhcTc -> DsMessage
    DsCannotMixPolyAndUnliftedBindings 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
    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
    $
                  DsMessage -> IOEnv (Env DsGblEnv DsLclEnv) ()
    diagnosticDs (HsBind GhcTc -> DsMessage
    DsUnbangedStrictPatterns 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 (XHsBindsLR (AbsBinds { abs_tvs :: AbsBinds -> [Id]
    abs_tvs = [Id]
    tvs, abs_ev_vars :: AbsBinds -> [Id]
    abs_ev_vars = [Id]
    evs }))
                         = Bool -> Bool
    not ([Id] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Id]
    tvs Bool -> Bool -> Bool
    && [Id] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Id]
    evs)
        is_polymorphic HsBindLR idL idR
    _ = Bool
    False

    ds_val_bind DynFlags
    _ (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) LHsBinds GhcTc
    Bag (GenLocated SrcSpanAnnA (HsBind GhcTc))
    binds  -- see Note [Strict binds checks] in GHC.HsToCore.Binds
      = Bool -> (DsMessage -> DsM CoreExpr) -> DsMessage -> DsM CoreExpr
    forall a. HasCallStack => Bool -> a -> a
    assert (RecFlag -> Bool
    isRec RecFlag
    is_rec )
        DsMessage -> DsM CoreExpr
    errDsCoreExpr (DsMessage -> DsM CoreExpr) -> DsMessage -> DsM CoreExpr
    forall a b. (a -> b) -> a -> b
    $ [LHsBindLR GhcTc GhcTc] -> DsMessage
    DsRecBindsNotAllowedForUnliftedTys (Bag (GenLocated SrcSpanAnnA (HsBind GhcTc))
    -> [GenLocated SrcSpanAnnA (HsBind GhcTc)]
    forall a. Bag a -> [a]
    bagToList LHsBinds GhcTc
    Bag (GenLocated SrcSpanAnnA (HsBind GhcTc))
    binds)

    -- Special case: a non-recursive PatBind. No dancing about with lets and seqs,
    -- we make a case immediately. Very important for linear types: let !pat can be
    -- linear, but selectors as used in the general case aren't. So the general case
    -- would transform a linear definition into a non-linear one. See Wrinkle 2
    -- Note [Desugar Strict binds] in GHC.HsToCore.Binds.
    ds_val_bind DynFlags
    dflags (RecFlag
    NonRecursive, LHsBinds GhcTc
    hsbinds) CoreExpr
    body
      | [L SrcSpanAnnA
    _loc (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_mult :: forall idL idR. HsBindLR idL idR -> HsMultAnn idL
    pat_mult = HsMultAnn GhcTc
    mult_ann
                         , pat_ext :: forall idL idR. HsBindLR idL idR -> XPatBind idL idR
    pat_ext = (Type
    ty, ([CoreTickish]
    rhs_tick, [[CoreTickish]]
    _var_ticks))})] <- Bag (GenLocated SrcSpanAnnA (HsBind GhcTc))
    -> [GenLocated SrcSpanAnnA (HsBind GhcTc)]
    forall a. Bag a -> [a]
    bagToList LHsBinds GhcTc
    Bag (GenLocated SrcSpanAnnA (HsBind GhcTc))
    hsbinds
            -- Non-recursive, non-overloaded bindings only come in ones
      , LPat GhcTc
    pat' <- DynFlags -> LPat GhcTc -> LPat GhcTc
    decideBangHood DynFlags
    dflags LPat GhcTc
    pat
      , LPat GhcTc -> Bool
    forall (p :: Pass). LPat (GhcPass p) -> Bool
    isBangedLPat LPat GhcTc
    pat'
      = do { rhss_nablas <- HsMatchContextRn
    -> GRHSs GhcTc (LHsExpr GhcTc) -> DsM (NonEmpty Nablas)
    pmcGRHSs HsMatchContextRn
    HsMatchContext (GenLocated SrcSpanAnnN Name)
    forall fn. HsMatchContext fn
    PatBindGuards GRHSs GhcTc (LHsExpr GhcTc)
    grhss
            ; rhs_expr <- dsGuarded grhss ty rhss_nablas
            ; let rhs' = [CoreTickish] -> CoreExpr -> CoreExpr
    mkOptTickBox [CoreTickish]
    rhs_tick CoreExpr
    rhs_expr
            ; let body_ty = HasDebugCallStack => CoreExpr -> Type
    CoreExpr -> Type
    exprType CoreExpr
    body
            ; let mult = HsMultAnn GhcTc -> Type
    getTcMultAnn HsMultAnn GhcTc
    mult_ann
            ; error_expr <- mkErrorAppDs pAT_ERROR_ID body_ty (ppr pat')
            ; matchSimply rhs' PatBindRhs mult pat' body error_expr }
        -- This is the one place where matchSimply is given a non-ManyTy
        -- multiplicity argument.
        --
        -- In this form, there isn't a natural place for the var_ticks. In
        -- mkSelectorBinds, the ticks are around the selector function but there
        -- aren't any selection functions as we make a single pattern-match. Is this a
        -- problem?

    -- Ordinary case for bindings; none should be unlifted
    ds_val_bind DynFlags
    _ (RecFlag
    is_rec, LHsBinds GhcTc
    binds) CoreExpr
    body
      = do  { Bool -> IOEnv (Env DsGblEnv DsLclEnv) ()
    forall (m :: * -> *). (HasCallStack, Applicative m) => Bool -> m ()
    massert (RecFlag -> Bool
    isRec RecFlag
    is_rec Bool -> Bool -> Bool
    || Bag (GenLocated SrcSpanAnnA (HsBind GhcTc)) -> Bool
    forall a. Bag a -> Bool
    isSingletonBag LHsBinds GhcTc
    Bag (GenLocated SrcSpanAnnA (HsBind GhcTc))
    binds)
                   -- we should never produce a non-recursive list of multiple binds

            ; (force_vars,prs) <- LHsBinds GhcTc -> DsM ([Id], [(Id, CoreExpr)])
    dsLHsBinds LHsBinds GhcTc
    binds
            ; let body' = (Id -> CoreExpr -> CoreExpr) -> CoreExpr -> [Id] -> CoreExpr
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr Id -> CoreExpr -> CoreExpr
    seqVar CoreExpr
    body [Id]
    force_vars
            ; assertPpr (not (any (isUnliftedType . idType . fst) prs)) (ppr is_rec $$ ppr binds) $
              -- NB: bindings have a fixed RuntimeRep, so it's OK to call isUnliftedType
              case prs of
                [] -> CoreExpr -> DsM CoreExpr
    forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return CoreExpr
    body
                [(Id, CoreExpr)]
    _  -> CoreExpr -> DsM CoreExpr
    forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([CoreBind] -> CoreExpr -> CoreExpr
    forall b. [Bind b] -> Expr b -> Expr b
    mkLets (RecFlag -> [(Id, CoreExpr)] -> [CoreBind]
    forall b. RecFlag -> [(b, Expr b)] -> [Bind b]
    mk_binds RecFlag
    is_rec [(Id, CoreExpr)]
    prs) CoreExpr
    body') }
                -- We can make a non-recursive let because we make sure to return
                -- the bindings in dependency order in dsLHsBinds,
                -- see Note [Return non-recursive bindings in dependency order] in
                -- GHC.HsToCore.Binds

    -- | Helper function. You can use the result of 'mk_binds' with 'mkLets' for
    -- instance.
    --
    --   * @'mk_binds' 'Recursive' binds@ makes a single mutually-recursive
    --     bindings with all the rhs/lhs pairs in @binds@
    --   * @'mk_binds' 'NonRecursive' binds@ makes one non-recursive binding
    --     for each rhs/lhs pairs in @binds@
    mk_binds :: RecFlag -> [(b, (Expr b))] -> [Bind b]
    mk_binds :: forall b. RecFlag -> [(b, Expr b)] -> [Bind b]
    mk_binds RecFlag
    Recursive [(b, Expr b)]
    binds = [[(b, Expr b)] -> Bind b
    forall b. [(b, Expr b)] -> Bind b
    Rec [(b, Expr b)]
    binds]
    mk_binds RecFlag
    NonRecursive [(b, Expr b)]
    binds = ((b, Expr b) -> Bind b) -> [(b, Expr b)] -> [Bind b]
    forall a b. (a -> b) -> [a] -> [b]
    map ((b -> Expr b -> Bind b) -> (b, Expr b) -> Bind b
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry b -> Expr b -> Bind b
    forall b. b -> Expr b -> Bind b
    NonRec) [(b, Expr b)]
    binds

    ------------------
    dsUnliftedBind :: HsBind GhcTc -> CoreExpr -> DsM CoreExpr
    dsUnliftedBind :: HsBind GhcTc -> CoreExpr -> DsM CoreExpr
    dsUnliftedBind (XHsBindsLR (AbsBinds { abs_tvs :: AbsBinds -> [Id]
    abs_tvs = [], abs_ev_vars :: AbsBinds -> [Id]
    abs_ev_vars = []
                                         , abs_exports :: AbsBinds -> [ABExport]
    abs_exports = [ABExport]
    exports
                                         , abs_ev_binds :: AbsBinds -> [TcEvBinds]
    abs_ev_binds = [TcEvBinds]
    ev_binds
                                         , abs_binds :: AbsBinds -> LHsBinds GhcTc
    abs_binds = LHsBinds GhcTc
    lbinds })) CoreExpr
    body
      = do { let body1 :: CoreExpr
    body1 = (ABExport -> CoreExpr -> CoreExpr)
    -> CoreExpr -> [ABExport] -> CoreExpr
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr ABExport -> CoreExpr -> CoreExpr
    bind_export CoreExpr
    body [ABExport]
    exports
                 bind_export :: ABExport -> CoreExpr -> CoreExpr
    bind_export ABExport
    export CoreExpr
    b = HasDebugCallStack => Id -> CoreExpr -> CoreExpr -> CoreExpr
    Id -> CoreExpr -> CoreExpr -> CoreExpr
    bindNonRec (ABExport -> Id
    abe_poly ABExport
    export) (Id -> CoreExpr
    forall b. Id -> Expr b
    Var (ABExport -> Id
    abe_mono ABExport
    export)) CoreExpr
    b
           ; 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 LHsBinds GhcTc
    Bag (GenLocated SrcSpanAnnA (HsBind GhcTc))
    lbinds
           ; dsTcEvBinds_s ev_binds $ \ [CoreBind]
    ds_binds -> do
           { CoreExpr -> DsM CoreExpr
    forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    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 = (HsWrapper
    co_fn, [CoreTickish]
    tick)
                            }) CoreExpr
    body
                   -- Can't be a bang pattern (that looks like a PatBind)
                   -- so must be simply unboxed
      = do { (args, rhs) <- HsMatchContextRn
    -> Maybe [LHsExpr GhcTc]
    -> MatchGroup GhcTc (LHsExpr GhcTc)
    -> DsM ([Id], CoreExpr)
    matchWrapper (GenLocated SrcSpanAnnN Name
    -> HsMatchContext (GenLocated SrcSpanAnnN Name)
    forall fn. fn -> HsMatchContext fn
    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]
    Maybe [LocatedA (HsExpr GhcTc)]
    forall a. Maybe a
    Nothing MatchGroup GhcTc (LHsExpr GhcTc)
    matches
           ; massert (null args) -- Functions aren't unlifted
           ; dsHsWrapper co_fn $ \CoreExpr -> CoreExpr
    core_wrap -> do -- Can be non-identity (#21516)
           { let rhs' :: CoreExpr
    rhs' = CoreExpr -> CoreExpr
    core_wrap ([CoreTickish] -> CoreExpr -> CoreExpr
    mkOptTickBox [CoreTickish]
    tick CoreExpr
    rhs)
           ; CoreExpr -> DsM CoreExpr
    forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (HasDebugCallStack => Id -> CoreExpr -> CoreExpr -> CoreExpr
    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 = (Type
    ty, ([CoreTickish], [[CoreTickish]])
    _) }) CoreExpr
    body
      =     -- let C x# y# = rhs in body
            -- ==> case rhs of C x# y# -> body
        do { match_nablas <- HsMatchContextRn
    -> GRHSs GhcTc (LHsExpr GhcTc) -> DsM (NonEmpty Nablas)
    pmcGRHSs HsMatchContextRn
    HsMatchContext (GenLocated SrcSpanAnnN Name)
    forall fn. HsMatchContext fn
    PatBindGuards GRHSs GhcTc (LHsExpr GhcTc)
    grhss
           ; rhs          <- dsGuarded grhss ty match_nablas
           ; let eqn = EqnMatch { eqn_pat :: LPat GhcTc
    eqn_pat = LPat GhcTc
    pat, eqn_rest :: EquationInfo
    eqn_rest = MatchResult CoreExpr -> EquationInfo
    EqnDone (CoreExpr -> MatchResult CoreExpr
    cantFailMatchResult CoreExpr
    body) }
           ; var    <- selectMatchVar ManyTy (unLoc pat)
                        -- `var` will end up in a let binder, so the multiplicity
                        -- doesn't matter.
           ; result <- matchEquations PatBindRhs [var] [eqn] (exprType body)
           ; return (bindNonRec var rhs 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
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ CoreExpr -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr CoreExpr
    body)

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

    -- | Desugar a located typechecked expression.
    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. EpAnn 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

    -- | Desugar a typechecked expression.
    dsExpr :: HsExpr GhcTc -> DsM CoreExpr
    dsExpr :: HsExpr GhcTc -> DsM CoreExpr
    dsExpr (HsVar    XVar GhcTc
    _ (L SrcSpanAnnN
    _ Id
    id))           = Id -> DsM CoreExpr
    dsHsVar Id
    id

    {- Record selectors are warned about if they are not
    present in all of the parent data type's constructor,
    or always in case of pattern synonym record selectors
    (regulated by a flag). However, this only produces
    a warning if it's not a part of a record selector
    application. For example:

            data T = T1 | T2 {s :: Bool}
            f x = s x -- the warning from this case will be supressed

    See the `HsApp` case for where it is filtered out
    -}
    dsExpr (HsRecSel XRecSel GhcTc
    _ (FieldOcc XCFieldOcc GhcTc
    id XRec GhcTc RdrName
    _))
      = do { let name :: Name
    name = Id -> Name
    forall a. NamedThing a => a -> Name
    getName XCFieldOcc GhcTc
    Id
    id
                 RecSelId {sel_cons :: IdDetails -> ([ConLike], [ConLike])
    sel_cons = ([ConLike]
    _, [ConLike]
    cons_wo_field)}
                      = Id -> IdDetails
    idDetails XCFieldOcc GhcTc
    Id
    id
           ; cons_trimmed <- [ConLike] -> DsM [ConLike]
    trim_cons [ConLike]
    cons_wo_field
           ; unless (null cons_wo_field) $ diagnosticDs
                 $ DsIncompleteRecordSelector name cons_trimmed (cons_trimmed /= cons_wo_field)
                     -- This only produces a warning if it's not a part of a
                     -- record selector application (e.g. `s a` where `s` is a selector)
                     -- See the `HsApp` case for where it is filtered out
           ; dsHsVar id }
      where
        trim_cons :: [ConLike] -> DsM [ConLike]
        trim_cons :: [ConLike] -> DsM [ConLike]
    trim_cons [ConLike]
    cons_wo_field = do
          dflags <- IOEnv (Env DsGblEnv DsLclEnv) DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
          let maxConstructors = DynFlags -> Int
    maxUncoveredPatterns DynFlags
    dflags
          return $ take maxConstructors cons_wo_field

    dsExpr (HsUnboundVar (HER IORef EvTerm
    ref Type
    _ Unique
    _) RdrName
    _)  = 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 (HsIPVar XIPVar GhcTc
    x HsIPName
    _)          = DataConCantHappen -> DsM CoreExpr
    forall a. DataConCantHappen -> a
    dataConCantHappen XIPVar GhcTc
    DataConCantHappen
    x

    dsExpr (HsGetField XGetField GhcTc
    x LHsExpr GhcTc
    _ XRec GhcTc (DotFieldOcc GhcTc)
    _)     = DataConCantHappen -> DsM CoreExpr
    forall a. DataConCantHappen -> a
    dataConCantHappen XGetField GhcTc
    DataConCantHappen
    x
    dsExpr (HsProjection XProjection GhcTc
    x NonEmpty (XRec GhcTc (DotFieldOcc GhcTc))
    _)     = DataConCantHappen -> DsM CoreExpr
    forall a. DataConCantHappen -> a
    dataConCantHappen XProjection GhcTc
    DataConCantHappen
    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
    ext_expr_tc)
      = case XXExpr GhcTc
    ext_expr_tc of
          ExpandedThingTc HsThingRn
    o HsExpr GhcTc
    e
            | OrigStmt (L SrcSpanAnnA
    loc StmtLR GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    _) <- HsThingRn
    o
            -> SrcSpanAnnA -> DsM CoreExpr -> DsM CoreExpr
    forall ann a. EpAnn 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
            | Bool
    otherwise -> HsExpr GhcTc -> DsM CoreExpr
    dsExpr HsExpr GhcTc
    e
          WrapExpr {}                    -> HsExpr GhcTc -> DsM CoreExpr
    dsHsWrapped HsExpr GhcTc
    e
          ConLikeTc ConLike
    con [Id]
    tvs [Scaled Type]
    tys          -> ConLike -> [Id] -> [Scaled Type] -> DsM CoreExpr
    dsConLike ConLike
    con [Id]
    tvs [Scaled Type]
    tys
          -- Hpc Support
          HsTick CoreTickish
    tickish LHsExpr GhcTc
    e -> do
            e' <- LHsExpr GhcTc -> DsM CoreExpr
    dsLExpr LHsExpr GhcTc
    e
            return (Tick tickish 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.

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

    -- Strip ticks due to #21701, need to be invariant about warnings we produce whether
    -- this is enabled or not.
    dsExpr (NegApp XNegApp GhcTc
    _ (L SrcSpanAnnA
    loc
                        (HsExpr GhcTc -> ([CoreTickish], HsExpr GhcTc)
    stripTicksTopHsExpr -> ([CoreTickish]
    ts, (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 { expr' <- SrcSpanAnnA -> DsM CoreExpr -> DsM CoreExpr
    forall ann a. EpAnn 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
                    -- See Note [Checking "negative literals"]
                  (HsOverLit GhcTc
    lit { ol_val = HsIntegral (negateIntegralLit i) })
              ; HsOverLit GhcTc -> DsM CoreExpr
    dsOverLit HsOverLit GhcTc
    lit }
           ;
           ; dsSyntaxExpr neg_expr [mkTicks ts expr'] }

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

    dsExpr (HsLam XLam GhcTc
    _ HsLamVariant
    variant 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
    mkCoreLams (([Id], CoreExpr) -> CoreExpr)
    -> DsM ([Id], CoreExpr) -> DsM CoreExpr
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> HsMatchContextRn
    -> Maybe [LHsExpr GhcTc]
    -> MatchGroup GhcTc (LHsExpr GhcTc)
    -> DsM ([Id], CoreExpr)
    matchWrapper (HsLamVariant -> HsMatchContext (GenLocated SrcSpanAnnN Name)
    forall fn. HsLamVariant -> HsMatchContext fn
    LamAlt HsLamVariant
    variant) Maybe [LHsExpr GhcTc]
    Maybe [LocatedA (HsExpr GhcTc)]
    forall a. Maybe a
    Nothing MatchGroup GhcTc (LHsExpr GhcTc)
    a_Match

    dsExpr e :: HsExpr GhcTc
    e@(HsApp XApp GhcTc
    _ LHsExpr GhcTc
    fun LHsExpr GhcTc
    arg)
             -- We want to have a special case that uses the PMC information to filter
             -- out some of the incomplete record selectors warnings and not trigger
             -- the warning emitted during the desugaring of dsExpr(HsRecSel)
             -- See Note [Detecting incomplete record selectors] in GHC.HsToCore.Pmc
      = do { (msgs, fun') <- DsM CoreExpr -> DsM (Messages DsMessage, CoreExpr)
    forall a. DsM a -> DsM (Messages DsMessage, a)
    captureMessagesDs (DsM CoreExpr -> DsM (Messages DsMessage, CoreExpr))
    -> DsM CoreExpr -> DsM (Messages DsMessage, CoreExpr)
    forall a b. (a -> b) -> a -> b
    $ LHsExpr GhcTc -> DsM CoreExpr
    dsLExpr LHsExpr GhcTc
    fun
                 -- Make sure to filter out the generic incomplete record selector warning
                 -- if it's a raw record selector
           ; arg' <- dsLExpr arg
           ; case getIdFromTrivialExpr_maybe fun' of
               Just Id
    fun_id | Id -> Bool
    isRecordSelector Id
    fun_id
                 -> do { let msgs' :: Messages DsMessage
    msgs' = (MsgEnvelope DsMessage -> Bool)
    -> Messages DsMessage -> Messages DsMessage
    forall e. (MsgEnvelope e -> Bool) -> Messages e -> Messages e
    filterMessages MsgEnvelope DsMessage -> Bool
    is_incomplete_rec_sel_msg Messages DsMessage
    msgs
                       ; Messages DsMessage -> IOEnv (Env DsGblEnv DsLclEnv) ()
    addMessagesDs Messages DsMessage
    msgs'
                       ; Id -> CoreExpr -> IOEnv (Env DsGblEnv DsLclEnv) ()
    pmcRecSel Id
    fun_id CoreExpr
    arg' }
               Maybe Id
    _ -> Messages DsMessage -> IOEnv (Env DsGblEnv DsLclEnv) ()
    addMessagesDs Messages DsMessage
    msgs
           ; warnUnusedBindValue fun arg (exprType arg')
           ; return $ mkCoreAppDs (text "HsApp" <+> ppr e) fun' arg' }
      where
        is_incomplete_rec_sel_msg :: MsgEnvelope DsMessage -> Bool
        is_incomplete_rec_sel_msg :: MsgEnvelope DsMessage -> Bool
    is_incomplete_rec_sel_msg (MsgEnvelope {errMsgDiagnostic :: forall e. MsgEnvelope e -> e
    errMsgDiagnostic = DsIncompleteRecordSelector{}})
                                    = Bool
    False
        is_incomplete_rec_sel_msg MsgEnvelope DsMessage
    _ = Bool
    True

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

    {-
    Note [Checking "negative literals"]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

    As observed in #13257 it's desirable to warn about overflowing negative literals
    in some situations where the user thinks they are writing a negative literal (ie -1)
    but without `-XNegativeLiterals` enabled.

    This catches cases such as (-1 :: Word8) which overflow, because (negate 1 == 255) but
    which we desugar to `negate (fromIntegral 1)`.

    Notice it's crucial we still desugar to the correct (negate (fromIntegral ...)) despite
    performing the negation in order to check whether the application of negate will overflow.
    For a user written Integer instance we can't predict the interaction of negate and fromIntegral.

    Also note that this works for detecting the right result for `-128 :: Int8`.. which is
    in-range for Int8 but the correct result is achieved via two overflows.

    negate (fromIntegral 128 :: Int8)
    = negate (-128 :: Int8)
    = -128 :: Int8

    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 { lam_var <- Type -> Type -> DsM Id
    newSysLocalDs Type
    mult Type
    ty
                        ; return (lam_var : lam_vars, Var lam_var : args) }
                 go ([Id]
    lam_vars, [CoreExpr]
    args) (Present XPresent GhcTc
    _ LHsExpr GhcTc
    expr)
                        -- Expressions that are present don't generate
                        -- lambdas, just arguments.
                   = do { core_expr <- LHsExpr GhcTc -> DsM CoreExpr
    dsLExpr LHsExpr GhcTc
    expr
                        ; return (lam_vars, core_expr : args) }

           ; (lam_vars, args) <- (([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
           ; return $ mkCoreLams lam_vars (mkCoreTupBoxity boxity 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)
      = Int -> Int -> [Type] -> CoreExpr -> CoreExpr
    mkCoreUnboxedSum Int
    arity Int
    alt [Type]
    XExplicitSum GhcTc
    types (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

    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 (HsEmbTy XEmbTy GhcTc
    x LHsWcType (NoGhcTc GhcTc)
    _) = DataConCantHappen -> DsM CoreExpr
    forall a. DataConCantHappen -> a
    dataConCantHappen XEmbTy GhcTc
    DataConCantHappen
    x

    dsExpr (HsCase XCase GhcTc
    ctxt LHsExpr GhcTc
    discrim MatchGroup GhcTc (LHsExpr GhcTc)
    matches)
      = do { core_discrim <- LHsExpr GhcTc -> DsM CoreExpr
    dsLExpr LHsExpr GhcTc
    discrim
           ; ([discrim_var], matching_code) <- matchWrapper ctxt (Just [discrim]) matches
           ; return (bindNonRec discrim_var core_discrim 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
        body' <- LHsExpr GhcTc -> DsM CoreExpr
    dsLExpr LHsExpr GhcTc
    body
        dsLocalBinds binds 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 HsDoFlavour
    ListComp (L SrcSpanAnnL
    _ [GenLocated
       SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
    stmts)) = [ExprLStmt GhcTc] -> Type -> DsM CoreExpr
    dsListComp [ExprLStmt GhcTc]
    [GenLocated
       SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
    stmts XDo GhcTc
    Type
    res_ty
    dsExpr (HsDo XDo GhcTc
    _ ctx :: HsDoFlavour
    ctx@DoExpr{}      (L SrcSpanAnnL
    _ [GenLocated
       SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
    stmts)) = HsDoFlavour -> [ExprLStmt GhcTc] -> DsM CoreExpr
    dsDo HsDoFlavour
    ctx [ExprLStmt GhcTc]
    [GenLocated
       SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
    stmts
    dsExpr (HsDo XDo GhcTc
    _ ctx :: HsDoFlavour
    ctx@HsDoFlavour
    GhciStmtCtxt  (L SrcSpanAnnL
    _ [GenLocated
       SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
    stmts)) = HsDoFlavour -> [ExprLStmt GhcTc] -> DsM CoreExpr
    dsDo HsDoFlavour
    ctx [ExprLStmt GhcTc]
    [GenLocated
       SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
    stmts
    dsExpr (HsDo XDo GhcTc
    _ ctx :: HsDoFlavour
    ctx@MDoExpr{}     (L SrcSpanAnnL
    _ [GenLocated
       SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
    stmts)) = HsDoFlavour -> [ExprLStmt GhcTc] -> DsM CoreExpr
    dsDo HsDoFlavour
    ctx [ExprLStmt GhcTc]
    [GenLocated
       SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
    stmts
    dsExpr (HsDo XDo GhcTc
    _ HsDoFlavour
    MonadComp     (L SrcSpanAnnL
    _ [GenLocated
       SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
    stmts)) = [ExprLStmt GhcTc] -> DsM CoreExpr
    dsMonadComp [ExprLStmt GhcTc]
    [GenLocated
       SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
    stmts

    dsExpr (HsIf XIf GhcTc
    _ LHsExpr GhcTc
    guard_expr LHsExpr GhcTc
    then_expr LHsExpr GhcTc
    else_expr)
      = do { pred <- LHsExpr GhcTc -> DsM CoreExpr
    dsLExpr LHsExpr GhcTc
    guard_expr
           ; b1 <- dsLExpr then_expr
           ; b2 <- dsLExpr else_expr
           ; return $ mkIfThenElse pred b1 b2 }

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

      | Bool
    otherwise
      = do { let grhss :: GRHSs GhcTc (LocatedA (HsExpr GhcTc))
    grhss = XCGRHSs GhcTc (LocatedA (HsExpr GhcTc))
    -> [LGRHS GhcTc (LocatedA (HsExpr GhcTc))]
    -> HsLocalBinds GhcTc
    -> GRHSs GhcTc (LocatedA (HsExpr GhcTc))
    forall p body.
    XCGRHSs p body -> [LGRHS p body] -> HsLocalBinds p -> GRHSs p body
    GRHSs XCGRHSs GhcTc (LocatedA (HsExpr GhcTc))
    EpAnnComments
    emptyComments  [LGRHS GhcTc (LHsExpr GhcTc)]
    [LGRHS GhcTc (LocatedA (HsExpr GhcTc))]
    alts HsLocalBinds GhcTc
    forall (a :: Pass) (b :: Pass).
    HsLocalBindsLR (GhcPass a) (GhcPass b)
    emptyLocalBinds
           ; rhss_nablas  <- HsMatchContextRn
    -> GRHSs GhcTc (LHsExpr GhcTc) -> DsM (NonEmpty Nablas)
    pmcGRHSs HsMatchContextRn
    HsMatchContext (GenLocated SrcSpanAnnN Name)
    forall fn. HsMatchContext fn
    IfAlt GRHSs GhcTc (LHsExpr GhcTc)
    GRHSs GhcTc (LocatedA (HsExpr GhcTc))
    grhss
           ; match_result <- dsGRHSs IfAlt grhss res_ty rhss_nablas
           ; error_expr   <- mkErrorExpr
           ; extractMatchResult match_result error_expr }
      where
        mkErrorExpr :: DsM CoreExpr
    mkErrorExpr = Id -> Type -> SDoc -> DsM CoreExpr
    mkErrorAppDs Id
    nON_EXHAUSTIVE_GUARDS_ERROR_ID XMultiIf GhcTc
    Type
    res_ty
                                   (String -> SDoc
    forall doc. IsLine doc => String -> doc
    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 XExplicitList GhcTc
    Type
    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 { newArithSeq <- HsExpr GhcTc -> ArithSeqInfo GhcTc -> DsM CoreExpr
    dsArithSeq XArithSeq GhcTc
    HsExpr GhcTc
    expr ArithSeqInfo GhcTc
    seq
                       ; dsSyntaxExpr fl [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 (NameSet
    _, Type
    whole_ty) expr :: LHsExpr GhcTc
    expr@(L SrcSpanAnnA
    loc HsExpr GhcTc
    _)) = do
        expr_ds <- LHsExpr GhcTc -> DsM CoreExpr
    dsLExpr LHsExpr GhcTc
    expr
        let (_, [ty]) = splitTyConApp whole_ty
        makeStaticId <- dsLookupGlobalId makeStaticName

        dflags <- getDynFlags
        let platform = DynFlags -> Platform
    targetPlatform DynFlags
    dflags
        let (line, col) = case locA 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 = 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
                         ]

        putSrcSpanDsA loc $ return $
          mkCoreApps (Var makeStaticId) [ Type ty, srcLoc, 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 -> recConError a
            T (recConError t1 "M.hs/230/op1")
              e
              (recConError t1 "M.hs/230/op3")
    \end{verbatim}
    @recConError@ 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 { con_expr' <- HsExpr GhcTc -> DsM CoreExpr
    dsExpr XRecordCon GhcTc
    HsExpr GhcTc
    con_expr
           ; let
                 (arg_tys, _) = tcSplitFunTys (exprType con_expr')
                 -- A newtype in the corner should be opaque;
                 -- hence TcType.tcSplitFunTys

                 mk_arg (Type
    arg_ty, FieldLabel
    fl)
                   = case [LHsRecField GhcTc (LocatedA (HsExpr GhcTc))]
    -> Name -> [LocatedA (HsExpr GhcTc)]
    forall arg. [LHsRecField GhcTc arg] -> Name -> [arg]
    findField (HsRecFields GhcTc (LocatedA (HsExpr GhcTc))
    -> [LHsRecField GhcTc (LocatedA (HsExpr GhcTc))]
    forall p arg. HsRecFields p arg -> [LHsRecField p arg]
    rec_flds HsRecordBinds GhcTc
    HsRecFields GhcTc (LocatedA (HsExpr GhcTc))
    rbinds) (FieldLabel -> Name
    flSelector FieldLabel
    fl) of
                       (LocatedA (HsExpr GhcTc)
    rhs:[LocatedA (HsExpr GhcTc)]
    rhss) -> Bool
    -> (LocatedA (HsExpr GhcTc) -> DsM CoreExpr)
    -> LocatedA (HsExpr GhcTc)
    -> DsM CoreExpr
    forall a. HasCallStack => Bool -> a -> a
    assert ([LocatedA (HsExpr GhcTc)] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [LocatedA (HsExpr GhcTc)]
    rhss)
                                     LHsExpr GhcTc -> DsM CoreExpr
    LocatedA (HsExpr GhcTc) -> DsM CoreExpr
    dsLExpr LocatedA (HsExpr 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
    arg_ty = Id -> Type -> SDoc -> DsM CoreExpr
    mkErrorAppDs Id
    rEC_CON_ERROR_ID Type
    arg_ty SDoc
    forall doc. IsOutput doc => doc
    Outputable.empty

                 labels = ConLike -> [FieldLabel]
    conLikeFieldLabels ConLike
    con_like

           ; con_args <- if null labels
                         then mapM unlabelled_bottom (map scaledThing arg_tys)
                         else mapM mk_arg (zipEqual "dsExpr:RecordCon" (map scaledThing arg_tys) labels)

           ; return (mkCoreApps con_expr' con_args) }

    dsExpr (RecordUpd XRecordUpd GhcTc
    x LHsExpr GhcTc
    _ LHsRecUpdFields GhcTc
    _) = DataConCantHappen -> DsM CoreExpr
    forall a. DataConCantHappen -> a
    dataConCantHappen XRecordUpd GhcTc
    DataConCantHappen
    x

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

    -- Template Haskell stuff
    -- See Note [The life cycle of a TH quotation]

    dsExpr (HsTypedBracket   XTypedBracket GhcTc
    bracket_tc LHsExpr GhcTc
    _) = HsBracketTc -> DsM CoreExpr
    dsBracket XTypedBracket GhcTc
    HsBracketTc
    bracket_tc
    dsExpr (HsUntypedBracket XUntypedBracket GhcTc
    bracket_tc HsQuote GhcTc
    _) = HsBracketTc -> DsM CoreExpr
    dsBracket XUntypedBracket GhcTc
    HsBracketTc
    bracket_tc
    dsExpr (HsTypedSplice   XTypedSplice GhcTc
    _   LHsExpr GhcTc
    s) = String -> SDoc -> DsM CoreExpr
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "dsExpr:typed splice" (Maybe Name -> LHsExpr GhcTc -> SDoc
    forall (p :: Pass).
    OutputableBndrId p =>
    Maybe Name -> LHsExpr (GhcPass p) -> SDoc
    pprTypedSplice Maybe Name
    forall a. Maybe a
    Nothing LHsExpr GhcTc
    s)
    dsExpr (HsUntypedSplice XUntypedSplice GhcTc
    ext HsUntypedSplice GhcTc
    _) = DataConCantHappen -> DsM CoreExpr
    forall a. DataConCantHappen -> a
    dataConCantHappen XUntypedSplice GhcTc
    DataConCantHappen
    ext

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

    -- 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 SourceText
    _ FastString
    _) = DataConCantHappen -> DsM CoreExpr
    forall a. DataConCantHappen -> a
    dataConCantHappen XOverLabel GhcTc
    DataConCantHappen
    x
    dsExpr (OpApp XOpApp GhcTc
    x LHsExpr GhcTc
    _ LHsExpr GhcTc
    _ LHsExpr GhcTc
    _)     = DataConCantHappen -> DsM CoreExpr
    forall a. DataConCantHappen -> a
    dataConCantHappen XOpApp GhcTc
    DataConCantHappen
    x
    dsExpr (SectionL XSectionL GhcTc
    x LHsExpr GhcTc
    _ LHsExpr GhcTc
    _)    = DataConCantHappen -> DsM CoreExpr
    forall a. DataConCantHappen -> a
    dataConCantHappen XSectionL GhcTc
    DataConCantHappen
    x
    dsExpr (SectionR XSectionR GhcTc
    x LHsExpr GhcTc
    _ LHsExpr GhcTc
    _)    = DataConCantHappen -> DsM CoreExpr
    forall a. DataConCantHappen -> a
    dataConCantHappen XSectionR GhcTc
    DataConCantHappen
    x

    ds_prag_expr :: HsPragE GhcTc -> LHsExpr GhcTc -> DsM CoreExpr
    ds_prag_expr :: HsPragE GhcTc -> LHsExpr GhcTc -> DsM CoreExpr
    ds_prag_expr (HsPragSCC XSCC GhcTc
    _ StringLiteral
    cc) LHsExpr GhcTc
    expr = do
        dflags <- IOEnv (Env DsGblEnv DsLclEnv) DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
        if sccProfilingEnabled dflags && gopt Opt_ProfManualCcs dflags
          then do
            mod_name <- getModule
            count <- goptM Opt_ProfCountEntries
            let nm = StringLiteral -> FastString
    sl_fs StringLiteral
    cc
            flavour <- mkExprCCFlavour <$> getCCIndexDsM nm
            Tick (ProfNote (mkUserCC nm mod_name (getLocA expr) flavour) count True)
                   <$> dsLExpr expr
          else dsLExpr 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 { fun            <- HsExpr GhcTc -> DsM CoreExpr
    dsExpr HsExpr GhcTc
    expr
           ; dsHsWrappers arg_wraps $ \[CoreExpr -> CoreExpr]
    core_arg_wraps -> do
           { HsWrapper
    -> ((CoreExpr -> CoreExpr) -> DsM CoreExpr) -> DsM CoreExpr
    forall a. HsWrapper -> ((CoreExpr -> CoreExpr) -> DsM a) -> DsM a
    dsHsWrapper HsWrapper
    res_wrap (((CoreExpr -> CoreExpr) -> DsM CoreExpr) -> DsM CoreExpr)
    -> ((CoreExpr -> CoreExpr) -> DsM CoreExpr) -> DsM CoreExpr
    forall a b. (a -> b) -> a -> b
    $ \CoreExpr -> CoreExpr
    core_res_wrap -> do
           { let wrapped_args :: [CoreExpr]
    wrapped_args = String
    -> ((CoreExpr -> CoreExpr) -> CoreExpr -> CoreExpr)
    -> [CoreExpr -> CoreExpr]
    -> [CoreExpr]
    -> [CoreExpr]
    forall a b c.
    HasDebugCallStack =>
    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
           ; CoreExpr -> DsM CoreExpr
    forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CoreExpr -> DsM CoreExpr) -> CoreExpr -> DsM CoreExpr
    forall a b. (a -> b) -> a -> b
    $ CoreExpr -> CoreExpr
    core_res_wrap (CoreExpr -> [CoreExpr] -> CoreExpr
    mkCoreApps CoreExpr
    fun [CoreExpr]
    wrapped_args) } } }
    dsSyntaxExpr SyntaxExpr GhcTc
    SyntaxExprTc
    NoSyntaxExprTc [CoreExpr]
    _ = String -> DsM CoreExpr
    forall a. HasCallStack => 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
      = [HsFieldBind (GenLocated SrcSpanAnnA (FieldOcc GhcTc)) arg -> arg
    forall lhs rhs. HsFieldBind lhs rhs -> rhs
    hfbRHS HsFieldBind (GenLocated SrcSpanAnnA (FieldOcc GhcTc)) arg
    fld | L SrcSpanAnnA
    _ HsFieldBind (GenLocated SrcSpanAnnA (FieldOcc GhcTc)) arg
    fld <- [LHsRecField GhcTc arg]
    [GenLocated
       SrcSpanAnnA
       (HsFieldBind (GenLocated SrcSpanAnnA (FieldOcc GhcTc)) arg)]
    rbinds
                    , Name
    sel Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    == Id -> Name
    idName (HsRecField GhcTc arg -> Id
    forall arg. HsRecField GhcTc arg -> Id
    hsRecFieldId HsRecField GhcTc arg
    HsFieldBind (GenLocated SrcSpanAnnA (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 outweighed 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 { dflags <- IOEnv (Env DsGblEnv DsLclEnv) DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
           ; xs' <- mapM dsLExpr xs
           ; if xs' `lengthExceeds` maxBuildLength
                    -- Don't generate builds if the list is very long.
             || null xs'
                    -- Don't generate builds when the [] constructor will do
             || not (gopt Opt_EnableRewriteRules 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 return $ mkListExpr elt_ty xs'
             else mkBuildExpr elt_ty (mk_build_list 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 a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((Arg b -> Arg b -> Arg b) -> Arg b -> t (Arg b) -> Arg b
    forall a b. (a -> b -> b) -> b -> t a -> 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 a b.
    IOEnv (Env DsGblEnv DsLclEnv) (a -> b)
    -> IOEnv (Env DsGblEnv DsLclEnv) a
    -> IOEnv (Env DsGblEnv DsLclEnv) b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> LHsExpr GhcTc -> DsM CoreExpr
    dsLExpr LHsExpr GhcTc
    from
    dsArithSeq HsExpr GhcTc
    expr (FromTo LHsExpr GhcTc
    from LHsExpr GhcTc
    to)
      = do fam_envs <- DsM FamInstEnvs
    dsGetFamInstEnvs
           dflags <- getDynFlags
           warnAboutEmptyEnumerations fam_envs dflags from Nothing to
           expr' <- dsExpr expr
           from' <- dsLExpr from
           to'   <- dsLExpr to
           return $ mkApps expr' [from', 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 a b.
    IOEnv (Env DsGblEnv DsLclEnv) (a -> b)
    -> IOEnv (Env DsGblEnv DsLclEnv) a
    -> IOEnv (Env DsGblEnv DsLclEnv) b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> (LocatedA (HsExpr GhcTc) -> DsM CoreExpr)
    -> [LocatedA (HsExpr GhcTc)]
    -> IOEnv (Env DsGblEnv DsLclEnv) [CoreExpr]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM LHsExpr GhcTc -> DsM CoreExpr
    LocatedA (HsExpr GhcTc) -> DsM CoreExpr
    dsLExpr [LHsExpr GhcTc
    LocatedA (HsExpr GhcTc)
    from, LHsExpr GhcTc
    LocatedA (HsExpr GhcTc)
    thn]
    dsArithSeq HsExpr GhcTc
    expr (FromThenTo LHsExpr GhcTc
    from LHsExpr GhcTc
    thn LHsExpr GhcTc
    to)
      = do fam_envs <- DsM FamInstEnvs
    dsGetFamInstEnvs
           dflags <- getDynFlags
           warnAboutEmptyEnumerations fam_envs dflags from (Just thn) to
           expr' <- dsExpr expr
           from' <- dsLExpr from
           thn'  <- dsLExpr thn
           to'   <- dsLExpr to
           return $ mkApps expr' [from', thn', 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 :: HsDoFlavour -> [ExprLStmt GhcTc] -> DsM CoreExpr
    dsDo :: HsDoFlavour -> [ExprLStmt GhcTc] -> DsM CoreExpr
    dsDo HsDoFlavour
    ctx [ExprLStmt GhcTc]
    stmts
      = [GenLocated
       SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
    -> DsM CoreExpr
    goL [ExprLStmt GhcTc]
    [GenLocated
       SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
    stmts
      where
        goL :: [GenLocated
       SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
    -> DsM CoreExpr
    goL [] = String -> DsM CoreExpr
    forall a. HasCallStack => String -> a
    panic String
    "dsDo"
        goL ((L SrcSpanAnnA
    loc StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc))
    stmt):[GenLocated
       SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
    lstmts) = SrcSpanAnnA -> DsM CoreExpr -> DsM CoreExpr
    forall ann a. EpAnn ann -> DsM a -> DsM a
    putSrcSpanDsA SrcSpanAnnA
    loc (SrcSpanAnnA
    -> StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc))
    -> [GenLocated
          SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
    -> DsM CoreExpr
    go SrcSpanAnnA
    loc StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc))
    stmt [GenLocated
       SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
    lstmts)

        go :: SrcSpanAnnA
    -> StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc))
    -> [GenLocated
          SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
    -> DsM CoreExpr
    go SrcSpanAnnA
    _ (LastStmt XLastStmt GhcTc GhcTc (LocatedA (HsExpr GhcTc))
    _ LocatedA (HsExpr GhcTc)
    body Maybe Bool
    _ SyntaxExpr GhcTc
    _) [GenLocated
       SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
    stmts
          = Bool
    -> (LocatedA (HsExpr GhcTc) -> DsM CoreExpr)
    -> LocatedA (HsExpr GhcTc)
    -> DsM CoreExpr
    forall a. HasCallStack => Bool -> a -> a
    assert ([GenLocated
       SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
    -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [GenLocated
       SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
    stmts ) LHsExpr GhcTc -> DsM CoreExpr
    LocatedA (HsExpr GhcTc) -> DsM CoreExpr
    dsLExpr LocatedA (HsExpr GhcTc)
    body
            -- The 'return' op isn't used for 'do' expressions

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

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

        go SrcSpanAnnA
    _ (BindStmt XBindStmt GhcTc GhcTc (LocatedA (HsExpr GhcTc))
    xbs LPat GhcTc
    pat LocatedA (HsExpr GhcTc)
    rhs) [GenLocated
       SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
    stmts
          = do  { var   <- Type -> LPat GhcTc -> DsM Id
    selectSimpleMatchVarL (XBindStmtTc -> Type
    xbstc_boundResultMult XBindStmt GhcTc GhcTc (LocatedA (HsExpr GhcTc))
    XBindStmtTc
    xbs) LPat GhcTc
    pat
                ; rhs'  <- dsLExpr rhs
                ; match <- matchSinglePatVar var Nothing (StmtCtxt (HsDoStmt ctx)) pat
                                     (xbstc_boundResultType xbs) (MR_Infallible $ goL stmts)
                -- NB: "goL stmts" needs to happen inside matchSinglePatVar, and not
                -- before it, so that long-distance information is properly threaded.
                -- See Note [Long-distance information in do notation].
                ; match_code <- dsHandleMonadicFailure ctx pat match (xbstc_failOp xbs)
                ; dsSyntaxExpr (xbstc_bindOp xbs) [rhs', Lam var match_code] }

        go SrcSpanAnnA
    _ (ApplicativeStmt XApplicativeStmt GhcTc GhcTc (LocatedA (HsExpr GhcTc))
    body_ty [(SyntaxExpr GhcTc, ApplicativeArg GhcTc)]
    args Maybe (SyntaxExpr GhcTc)
    mb_join) [GenLocated
       SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (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
    _) =
                     ((LPat GhcTc
    GenLocated SrcSpanAnnA (Pat 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 HsDoFlavour
    _) =
                     ((LPat GhcTc
    GenLocated SrcSpanAnnA (Pat GhcTc)
    pat, Maybe SyntaxExprTc
    forall a. Maybe a
    Nothing), HsDoFlavour -> [ExprLStmt GhcTc] -> DsM CoreExpr
    dsDo HsDoFlavour
    ctx ([ExprLStmt GhcTc]
    [GenLocated
       SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
    stmts [GenLocated
       SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
    -> [GenLocated
          SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
    -> [GenLocated
          SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
    forall a. [a] -> [a] -> [a]
    ++ [StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc))
    -> GenLocated
         SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))
    forall e a. HasAnnotation e => a -> GenLocated e a
    noLocA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc))
     -> GenLocated
          SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc))))
    -> StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc))
    -> GenLocated
         SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))
    forall a b. (a -> b) -> a -> b
    $ LocatedA (HsExpr GhcTc)
    -> StmtLR GhcTc GhcTc (LocatedA (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 -> LocatedA (HsExpr GhcTc)
    forall e a. HasAnnotation e => a -> GenLocated e a
    noLocA HsExpr GhcTc
    ret)]))

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

               ; body' <- dsLExpr $ noLocA $ HsDo body_ty ctx (noLocA stmts)

               ; let match_args (GenLocated SrcSpanAnnA (Pat GhcTc)
    pat, Maybe SyntaxExprTc
    fail_op) ([Id]
    vs,CoreExpr
    body)
                       = SrcSpan -> DsM ([Id], CoreExpr) -> DsM ([Id], CoreExpr)
    forall a. SrcSpan -> DsM a -> DsM a
    putSrcSpanDs (GenLocated SrcSpanAnnA (Pat GhcTc) -> SrcSpan
    forall a e. HasLoc a => GenLocated a e -> SrcSpan
    getLocA GenLocated SrcSpanAnnA (Pat GhcTc)
    pat) (DsM ([Id], CoreExpr) -> DsM ([Id], CoreExpr))
    -> DsM ([Id], CoreExpr) -> DsM ([Id], CoreExpr)
    forall a b. (a -> b) -> a -> b
    $
                         do { var   <- Type -> LPat GhcTc -> DsM Id
    selectSimpleMatchVarL Type
    ManyTy LPat GhcTc
    GenLocated SrcSpanAnnA (Pat GhcTc)
    pat
                            ; match <- matchSinglePatVar var Nothing (StmtCtxt (HsDoStmt ctx)) pat
                                       body_ty (cantFailMatchResult body)
                            ; match_code <- dsHandleMonadicFailure ctx pat match fail_op
                            ; return (var:vs, match_code)
                            }

               ; (vars, body) <- foldrM match_args ([],body') pats
               ; let fun' = [Id] -> CoreExpr -> CoreExpr
    forall b. [b] -> Expr b -> Expr b
    mkLams [Id]
    vars CoreExpr
    body
               ; let mk_ap_call CoreExpr
    l (SyntaxExprTc
    op,CoreExpr
    r) = SyntaxExpr GhcTc -> [CoreExpr] -> DsM CoreExpr
    dsSyntaxExpr SyntaxExpr GhcTc
    SyntaxExprTc
    op [CoreExpr
    l,CoreExpr
    r]
               ; expr <- foldlM mk_ap_call fun' (zip (map fst args) rhss')
               ; case mb_join of
                   Maybe (SyntaxExpr GhcTc)
    Nothing -> CoreExpr -> DsM CoreExpr
    forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    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 (LocatedA (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 (LocatedA (HsExpr GhcTc)))]
    stmts
          = [GenLocated
       SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
    -> DsM CoreExpr
    goL (GenLocated
      SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))
    new_bind_stmt GenLocated
      SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))
    -> [GenLocated
          SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
    -> [GenLocated
          SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
    forall a. a -> [a] -> [a]
    : [GenLocated
       SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
    stmts)  -- rec_ids can be empty; eg  rec { print 'x' }
          where
            new_bind_stmt :: GenLocated
      SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))
    new_bind_stmt = SrcSpanAnnA
    -> StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc))
    -> GenLocated
         SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))
    forall l e. l -> e -> GenLocated l e
    L SrcSpanAnnA
    loc (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc))
     -> GenLocated
          SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc))))
    -> StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc))
    -> GenLocated
         SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))
    forall a b. (a -> b) -> a -> b
    $ XBindStmt GhcTc GhcTc (LocatedA (HsExpr GhcTc))
    -> LPat GhcTc
    -> LocatedA (HsExpr GhcTc)
    -> StmtLR GhcTc GhcTc (LocatedA (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
    ManyTy
                , xbstc_failOp :: Maybe (SyntaxExpr GhcTc)
    xbstc_failOp          = Maybe (SyntaxExpr GhcTc)
    Maybe SyntaxExprTc
    forall a. Maybe a
    Nothing -- Tuple cannot fail
                }
              ([LPat GhcTc] -> LPat GhcTc
    mkBigLHsPatTupId [LPat GhcTc]
    [GenLocated SrcSpanAnnA (Pat GhcTc)]
    later_pats)
              LHsExpr GhcTc
    LocatedA (HsExpr GhcTc)
    mfix_app

            tup_ids :: [Id]
    tup_ids      = [IdP GhcTc]
    [Id]
    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 a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [IdP GhcTc]
    rec_ids) [IdP GhcTc]
    [Id]
    later_ids
            tup_ty :: Type
    tup_ty       = [Type] -> Type
    HasDebugCallStack => [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 IdP GhcTc -> LPat GhcTc
    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 :: [LocatedA (HsExpr GhcTc)]
    rets         = (HsExpr GhcTc -> LocatedA (HsExpr GhcTc))
    -> [HsExpr GhcTc] -> [LocatedA (HsExpr GhcTc)]
    forall a b. (a -> b) -> [a] -> [b]
    map HsExpr GhcTc -> LocatedA (HsExpr GhcTc)
    forall e a. HasAnnotation e => a -> GenLocated e a
    noLocA [HsExpr GhcTc]
    rec_rets
            mfix_app :: LHsExpr GhcTc
    mfix_app     = SyntaxExprTc -> [LHsExpr GhcTc] -> LHsExpr GhcTc
    nlHsSyntaxApps SyntaxExpr GhcTc
    SyntaxExprTc
    mfix_op [LHsExpr GhcTc
    LocatedA (HsExpr GhcTc)
    mfix_arg]
            match_group :: MatchGroupTc
    match_group  = [Scaled Type] -> Type -> Origin -> MatchGroupTc
    MatchGroupTc [Type -> Scaled Type
    forall a. a -> Scaled a
    unrestricted Type
    tup_ty] Type
    body_ty (GenReason -> DoPmc -> Origin
    Generated GenReason
    OtherExpansion DoPmc
    SkipPmc)
            mfix_arg :: LocatedA (HsExpr GhcTc)
    mfix_arg     = HsExpr GhcTc -> LocatedA (HsExpr GhcTc)
    forall e a. HasAnnotation e => a -> GenLocated e a
    noLocA (HsExpr GhcTc -> LocatedA (HsExpr GhcTc))
    -> HsExpr GhcTc -> LocatedA (HsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $ XLam GhcTc
    -> HsLamVariant -> MatchGroup GhcTc (LHsExpr GhcTc) -> HsExpr GhcTc
    forall p.
    XLam p -> HsLamVariant -> MatchGroup p (LHsExpr p) -> HsExpr p
    HsLam XLam GhcTc
    forall a. NoAnn a => a
    noAnn HsLamVariant
    LamSingle
                               (MG { mg_alts :: XRec GhcTc [LMatch GhcTc (LocatedA (HsExpr GhcTc))]
    mg_alts = [LMatch GhcTc (LocatedA (HsExpr GhcTc))]
    -> GenLocated SrcSpanAnnL [LMatch GhcTc (LocatedA (HsExpr GhcTc))]
    forall e a. HasAnnotation e => a -> GenLocated e a
    noLocA [HsMatchContext (LIdP (NoGhcTc GhcTc))
    -> [LPat GhcTc]
    -> LocatedA (HsExpr GhcTc)
    -> LMatch GhcTc (LocatedA (HsExpr GhcTc))
    forall (p :: Pass) (body :: * -> *).
    (Anno (Match (GhcPass p) (LocatedA (body (GhcPass p))))
     ~ SrcSpanAnnA,
     Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p))))
     ~ EpAnn NoEpAnns) =>
    HsMatchContext (LIdP (NoGhcTc (GhcPass p)))
    -> [LPat (GhcPass p)]
    -> LocatedA (body (GhcPass p))
    -> LMatch (GhcPass p) (LocatedA (body (GhcPass p)))
    mkSimpleMatch
                                                        (HsLamVariant -> HsMatchContext (GenLocated SrcSpanAnnN Name)
    forall fn. HsLamVariant -> HsMatchContext fn
    LamAlt HsLamVariant
    LamSingle)
                                                        [LPat GhcTc
    GenLocated SrcSpanAnnA (Pat GhcTc)
    mfix_pat] LocatedA (HsExpr GhcTc)
    body]
                                   , mg_ext :: XMG GhcTc (LocatedA (HsExpr GhcTc))
    mg_ext = XMG GhcTc (LocatedA (HsExpr GhcTc))
    MatchGroupTc
    match_group
                                   })
            mfix_pat :: GenLocated SrcSpanAnnA (Pat GhcTc)
    mfix_pat     = Pat GhcTc -> GenLocated SrcSpanAnnA (Pat GhcTc)
    forall e a. HasAnnotation e => a -> GenLocated e 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 XLazyPat GhcTc
    NoExtField
    noExtField (LPat GhcTc -> Pat GhcTc) -> LPat GhcTc -> Pat GhcTc
    forall a b. (a -> b) -> a -> b
    $ [LPat GhcTc] -> LPat GhcTc
    mkBigLHsPatTupId [LPat GhcTc]
    [GenLocated SrcSpanAnnA (Pat GhcTc)]
    rec_tup_pats
            body :: LocatedA (HsExpr GhcTc)
    body         = HsExpr GhcTc -> LocatedA (HsExpr GhcTc)
    forall e a. HasAnnotation e => a -> GenLocated e a
    noLocA (HsExpr GhcTc -> LocatedA (HsExpr GhcTc))
    -> HsExpr GhcTc -> LocatedA (HsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $ XDo GhcTc
    -> HsDoFlavour -> XRec GhcTc [ExprLStmt GhcTc] -> HsExpr GhcTc
    forall p. XDo p -> HsDoFlavour -> XRec p [ExprLStmt p] -> HsExpr p
    HsDo XDo GhcTc
    Type
    body_ty
                                    HsDoFlavour
    ctx ([GenLocated
       SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
    -> GenLocated
         SrcSpanAnnL
         [GenLocated
            SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
    forall e a. HasAnnotation e => a -> GenLocated e a
    noLocA ([GenLocated
       SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
    rec_stmts [GenLocated
       SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
    -> [GenLocated
          SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
    -> [GenLocated
          SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
    forall a. [a] -> [a] -> [a]
    ++ [GenLocated
      SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (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 [LHsExpr GhcTc]
    [LocatedA (HsExpr GhcTc)]
    rets]
            ret_stmt :: GenLocated
      SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))
    ret_stmt     = StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc))
    -> GenLocated
         SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))
    forall e a. HasAnnotation e => a -> GenLocated e a
    noLocA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc))
     -> GenLocated
          SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc))))
    -> StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc))
    -> GenLocated
         SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))
    forall a b. (a -> b) -> a -> b
    $ LocatedA (HsExpr GhcTc)
    -> StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc))
    forall (idR :: Pass) (bodyR :: * -> *) (idL :: Pass).
    IsPass idR =>
    LocatedA (bodyR (GhcPass idR))
    -> StmtLR
         (GhcPass idL) (GhcPass idR) (LocatedA (bodyR (GhcPass idR)))
    mkLastStmt LHsExpr GhcTc
    LocatedA (HsExpr 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 (LocatedA (HsExpr GhcTc)))]
    _ = String -> DsM CoreExpr
    forall a. HasCallStack => String -> a
    panic String
    "dsDo ParStmt"
        go SrcSpanAnnA
    _ (TransStmt {}) [GenLocated
       SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (HsExpr GhcTc)))]
    _ = String -> DsM CoreExpr
    forall a. HasCallStack => String -> a
    panic String
    "dsDo TransStmt"

    {- Note [Long-distance information in do notation]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Consider T21360:

      data Foo = A Int | B

      swooble :: Foo -> Maybe Foo
      swooble foo = do
        bar@A{} <- Just foo
        return $ case bar of { A _ -> A 9 }

    The pattern-match checker **should not** complain that the case statement
    is incomplete, because we know that 'bar' is headed by the constructor 'A',
    due to the pattern match in the line above. However, we need to ensure that we
    propagate this long-distance information; failing to do so lead to #21360.

    To do this, we use "matchSinglePatVar" to handle the first pattern match

      bar@A{} <- Just foo

    "matchSinglePatVar" then threads through the long-distance information to the
    desugaring of the remaining statements by using updPmNablasMatchResult.
    This avoids any spurious pattern-match warnings when handling the case
    statement on the last line.

    Other places that requires from the same treatment:

      - monad comprehensions, e.g.

         blorble :: Foo -> Maybe Foo
         blorble foo = [ case bar of { A _ -> A 9 } | bar@A{} <- Just foo ]

         See GHC.HsToCore.ListComp.dsMcBindStmt. Also tested in T21360.

      - guards, e.g.

          giddy :: Maybe Char -> Char
          giddy x
            | y@(Just _) <- x
            , let z = case y of { Just w -> w }
            = z

        We don't want any inexhaustive pattern match warnings for the case statement,
        because we already know 'y' is of the form "Just ...".
        See test case T21360b.

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

    dsHsVar :: Id -> DsM CoreExpr
    -- We could just call dsHsUnwrapped; but this is a short-cut
    -- for the very common case of a variable with no wrapper.
    dsHsVar :: Id -> DsM CoreExpr
    dsHsVar Id
    var
      = CoreExpr -> DsM CoreExpr
    forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Id -> CoreExpr
    forall b. Id -> Expr b
    varToCoreExpr Id
    var) -- See Note [Desugaring vars]

    dsHsConLike :: ConLike -> DsM CoreExpr
    dsHsConLike :: ConLike -> DsM CoreExpr
    dsHsConLike (RealDataCon DataCon
    dc)
      = CoreExpr -> DsM CoreExpr
    forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Id -> CoreExpr
    forall b. Id -> Expr b
    varToCoreExpr (DataCon -> Id
    dataConWrapId DataCon
    dc))
    dsHsConLike (PatSynCon PatSyn
    ps)
      | Just (Name
    builder_name, Type
    _, Bool
    add_void) <- PatSyn -> Maybe (Name, Type, Bool)
    patSynBuilder PatSyn
    ps
      = do { builder_id <- Name -> DsM Id
    dsLookupGlobalId Name
    builder_name
           ; return (if add_void
                     then mkCoreApp (text "dsConLike" <+> ppr ps)
                                    (Var builder_id) unboxedUnitExpr
                     else Var 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)

    -- | This function desugars 'ConLikeTc': it eta-expands
    -- data constructors to make linear types work.
    --
    -- See Note [Typechecking data constructors] in GHC.Tc.Gen.Head
    dsConLike :: ConLike -> [TcTyVar] -> [Scaled Type] -> DsM CoreExpr
    dsConLike :: ConLike -> [Id] -> [Scaled Type] -> DsM CoreExpr
    dsConLike ConLike
    con [Id]
    tvs [Scaled Type]
    tys
      = do { ds_con <- ConLike -> DsM CoreExpr
    dsHsConLike ConLike
    con
           ; ids    <- newSysLocalsDs tys
               -- NB: these 'Id's may be representation-polymorphic;
               -- see Wrinkle [Representation-polymorphic lambda] in
               -- Note [Typechecking data constructors] in GHC.Tc.Gen.Head.
           ; return (mkLams tvs $
                     mkLams ids $
                     ds_con `mkTyApps` mkTyVarTys tvs
                            `mkVarApps` ids) }

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

    -- Warn about certain types of values discarded in monadic bindings (#3263)
    warnUnusedBindValue :: LHsExpr GhcTc -> LHsExpr GhcTc -> Type -> DsM ()
    warnUnusedBindValue :: LHsExpr GhcTc
    -> LHsExpr GhcTc -> Type -> IOEnv (Env DsGblEnv DsLclEnv) ()
    warnUnusedBindValue LHsExpr GhcTc
    fun arg :: LHsExpr GhcTc
    arg@(L SrcSpanAnnA
    loc HsExpr GhcTc
    _) Type
    arg_ty
      | Just (SrcSpan
    l, Id
    f) <- LHsExpr GhcTc -> Maybe (SrcSpan, Id)
    fish_var LHsExpr GhcTc
    fun
      , Id
    f Id -> Unique -> Bool
    forall a. Uniquable a => a -> Unique -> Bool
    `hasKey` Unique
    thenMClassOpKey    -- it is a (>>)
      = Bool
    -> IOEnv (Env DsGblEnv DsLclEnv) ()
    -> IOEnv (Env DsGblEnv DsLclEnv) ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (SrcSpan -> Bool
    isGeneratedSrcSpan SrcSpan
    l) (IOEnv (Env DsGblEnv DsLclEnv) ()
     -> IOEnv (Env DsGblEnv DsLclEnv) ())
    -> IOEnv (Env DsGblEnv DsLclEnv) ()
    -> IOEnv (Env DsGblEnv DsLclEnv) ()
    forall a b. (a -> b) -> a -> b
    $ -- it is compiler generated (>>)
             SrcSpan
    -> IOEnv (Env DsGblEnv DsLclEnv) ()
    -> IOEnv (Env DsGblEnv DsLclEnv) ()
    forall a. SrcSpan -> DsM a -> DsM a
    putSrcSpanDs (SrcSpanAnnA -> SrcSpan
    forall a. HasLoc a => a -> SrcSpan
    locA SrcSpanAnnA
    loc) (IOEnv (Env DsGblEnv DsLclEnv) ()
     -> IOEnv (Env DsGblEnv DsLclEnv) ())
    -> IOEnv (Env DsGblEnv DsLclEnv) ()
    -> IOEnv (Env DsGblEnv DsLclEnv) ()
    forall a b. (a -> b) -> a -> b
    $ LHsExpr GhcTc -> Type -> IOEnv (Env DsGblEnv DsLclEnv) ()
    warnDiscardedDoBindings LHsExpr GhcTc
    arg Type
    arg_ty
      where
        -- Retrieve the location info and the head of the application
        -- It is important that we /do not/ look through HsApp to avoid
        -- generating duplicate warnings
        -- See Part 2. of Note [Expanding HsDo with XXExprGhcRn]
        fish_var :: LHsExpr GhcTc -> Maybe (SrcSpan , Id)
        fish_var :: LHsExpr GhcTc -> Maybe (SrcSpan, Id)
    fish_var (L SrcSpanAnnA
    l (HsVar XVar GhcTc
    _ LIdP GhcTc
    id)) = (SrcSpan, Id) -> Maybe (SrcSpan, Id)
    forall a. a -> Maybe a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SrcSpanAnnA -> SrcSpan
    forall a. HasLoc a => a -> SrcSpan
    locA SrcSpanAnnA
    l, GenLocated SrcSpanAnnN Id -> Id
    forall l e. GenLocated l e -> e
    unLoc LIdP GhcTc
    GenLocated SrcSpanAnnN Id
    id)
        fish_var (L SrcSpanAnnA
    _ (HsAppType XAppTypeE GhcTc
    _ LHsExpr GhcTc
    e LHsWcType (NoGhcTc GhcTc)
    _)) = LHsExpr GhcTc -> Maybe (SrcSpan, Id)
    fish_var LHsExpr GhcTc
    e
        fish_var (L SrcSpanAnnA
    l (XExpr (WrapExpr (HsWrap HsWrapper
    _ HsExpr GhcTc
    e)))) = do (l, e') <- LHsExpr GhcTc -> Maybe (SrcSpan, Id)
    fish_var (SrcSpanAnnA -> HsExpr GhcTc -> LocatedA (HsExpr GhcTc)
    forall l e. l -> e -> GenLocated l e
    L SrcSpanAnnA
    l HsExpr GhcTc
    e)
                                                            return (l, e')
        fish_var (L SrcSpanAnnA
    l (XExpr (ExpandedThingTc HsThingRn
    _ HsExpr GhcTc
    e))) = LHsExpr GhcTc -> Maybe (SrcSpan, Id)
    fish_var (SrcSpanAnnA -> HsExpr GhcTc -> LocatedA (HsExpr GhcTc)
    forall l e. l -> e -> GenLocated l e
    L SrcSpanAnnA
    l HsExpr GhcTc
    e)
        fish_var LHsExpr GhcTc
    _ = Maybe (SrcSpan, Id)
    forall a. Maybe a
    Nothing

    warnUnusedBindValue LHsExpr GhcTc
    _ LHsExpr GhcTc
    _ Type
    _  = () -> IOEnv (Env DsGblEnv DsLclEnv) ()
    forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    -- 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 { warn_unused <- WarningFlag -> TcRnIf DsGblEnv DsLclEnv Bool
    forall gbl lcl. WarningFlag -> TcRnIf gbl lcl Bool
    woptM WarningFlag
    Opt_WarnUnusedDoBind
           ; warn_wrong <- woptM Opt_WarnWrongDoBind
           ; when (warn_unused || warn_wrong) $
        do { fam_inst_envs <- dsGetFamInstEnvs
           ; let norm_elt_ty = FamInstEnvs -> Type -> Type
    topNormaliseType FamInstEnvs
    fam_inst_envs Type
    elt_ty

               -- Warn about discarding non-() things in 'monadic' binding
           ; if warn_unused && not (isUnitTy norm_elt_ty)
             then diagnosticDs (DsUnusedDoBind rhs 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
               when warn_wrong $
                    case tcSplitAppTy_maybe 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
                             -> DsMessage -> IOEnv (Env DsGblEnv DsLclEnv) ()
    diagnosticDs (LHsExpr GhcTc -> Type -> DsMessage
    DsWrongDoBind LHsExpr GhcTc
    rhs Type
    elt_ty)
                          Maybe (Type, Type)
    _ -> () -> IOEnv (Env DsGblEnv DsLclEnv) ()
    forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    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 a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()   -- but at least this warning is irrelevant

    {-
    ************************************************************************
    *                                                                      *
                dsHsWrapped
    *                                                                      *
    ************************************************************************
    -}

    ------------------------------
    dsHsWrapped :: HsExpr GhcTc -> DsM CoreExpr
    dsHsWrapped :: HsExpr GhcTc -> DsM CoreExpr
    dsHsWrapped HsExpr GhcTc
    orig_hs_expr
      = HsWrapper -> HsExpr GhcTc -> DsM CoreExpr
    go HsWrapper
    idHsWrapper HsExpr GhcTc
    orig_hs_expr
      where
        go :: HsWrapper -> HsExpr GhcTc -> DsM CoreExpr
    go HsWrapper
    wrap (HsPar XPar GhcTc
    _ (L SrcSpanAnnA
    _ HsExpr GhcTc
    hs_e))
           = HsWrapper -> HsExpr GhcTc -> DsM CoreExpr
    go HsWrapper
    wrap HsExpr GhcTc
    hs_e
        go HsWrapper
    wrap1 (XExpr (WrapExpr (HsWrap HsWrapper
    wrap2 HsExpr GhcTc
    hs_e)))
           = HsWrapper -> HsExpr GhcTc -> DsM CoreExpr
    go (HsWrapper
    wrap1 HsWrapper -> HsWrapper -> HsWrapper
    <.> HsWrapper
    wrap2) HsExpr GhcTc
    hs_e
        go HsWrapper
    wrap (HsAppType XAppTypeE GhcTc
    ty (L SrcSpanAnnA
    _ HsExpr GhcTc
    hs_e) LHsWcType (NoGhcTc GhcTc)
    _)
           = HsWrapper -> HsExpr GhcTc -> DsM CoreExpr
    go (HsWrapper
    wrap HsWrapper -> HsWrapper -> HsWrapper
    <.> Type -> HsWrapper
    WpTyApp XAppTypeE GhcTc
    Type
    ty) HsExpr GhcTc
    hs_e

        go HsWrapper
    wrap (HsVar XVar GhcTc
    _ (L SrcSpanAnnN
    _ Id
    var))
          = do { HsWrapper
    -> ((CoreExpr -> CoreExpr) -> DsM CoreExpr) -> DsM CoreExpr
    forall a. HsWrapper -> ((CoreExpr -> CoreExpr) -> DsM a) -> DsM a
    dsHsWrapper HsWrapper
    wrap (((CoreExpr -> CoreExpr) -> DsM CoreExpr) -> DsM CoreExpr)
    -> ((CoreExpr -> CoreExpr) -> DsM CoreExpr) -> DsM CoreExpr
    forall a b. (a -> b) -> a -> b
    $ \CoreExpr -> CoreExpr
    wrap' -> do
               { let expr :: CoreExpr
    expr = CoreExpr -> CoreExpr
    wrap' (Id -> CoreExpr
    forall b. Id -> Expr b
    varToCoreExpr Id
    var)
                     ty :: Type
    ty   = HasDebugCallStack => CoreExpr -> Type
    CoreExpr -> Type
    exprType CoreExpr
    expr
               ; dflags <- IOEnv (Env DsGblEnv DsLclEnv) DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
               ; warnAboutIdentities dflags var ty
               ; return expr } }

        go HsWrapper
    wrap HsExpr GhcTc
    hs_e
           = do { HsWrapper
    -> ((CoreExpr -> CoreExpr) -> DsM CoreExpr) -> DsM CoreExpr
    forall a. HsWrapper -> ((CoreExpr -> CoreExpr) -> DsM a) -> DsM a
    dsHsWrapper HsWrapper
    wrap (((CoreExpr -> CoreExpr) -> DsM CoreExpr) -> DsM CoreExpr)
    -> ((CoreExpr -> CoreExpr) -> DsM CoreExpr) -> DsM CoreExpr
    forall a b. (a -> b) -> a -> b
    $ \CoreExpr -> CoreExpr
    wrap' -> do
                { Origin -> Bag Id -> DsM CoreExpr -> DsM CoreExpr
    forall a. Origin -> Bag Id -> DsM a -> DsM a
    addTyCs Origin
    FromSource (HsWrapper -> Bag Id
    hsWrapDictBinders HsWrapper
    wrap) (DsM CoreExpr -> DsM CoreExpr) -> DsM CoreExpr -> DsM CoreExpr
    forall a b. (a -> b) -> a -> b
    $
                  do { e <- HsExpr GhcTc -> DsM CoreExpr
    dsExpr HsExpr GhcTc
    hs_e
                     ; return (wrap' e) } } }