= OrigExpr (HsExpr GhcRn)                -- ^ The source, user written, expression

   | OrigStmt (ExprLStmt GhcRn) HsDoFlavour -- ^ which kind of do-block did this statement come from

   | OrigPat  (Pat GhcRn)                   -- ^ Used for failable patterns that trigger MonadFail constraints

 data XXExprGhcRn

   = ExpandedThingRn { xrn_orig     :: SrcCodeOrigin   -- The original source thing to be used for error messages

                     , xrn_expanded :: HsExpr GhcRn    -- The compiler generated, expanded thing

                     }

   | HsRecSelRn  (FieldOcc GhcRn)   -- ^ Variable pointing to record selector

                            -- See Note [Non-overloaded record field selectors] and

                            -- Note [Record selectors in the AST]

 -- | Build an expression using the extension constructor `XExpr`,

 --   and the two components of the expansion: original expression and

 --   expanded expressions.

 mkExpandedStmt oStmt flav eExpr = XExpr (ExpandedThingRn { xrn_orig = OrigStmt oStmt flav

                                                          , xrn_expanded = eExpr })

 data XXExprGhcTc

   = WrapExpr        -- Type and evidence application and abstractions

       HsWrapper (HsExpr GhcTc)

         OrigExpr x    -> ppr_builder "<OrigExpr>:" x

         OrigStmt x _  -> ppr_builder "<OrigStmt>:" x

         OrigPat  x    -> ppr_builder "<OrigPat>:" x

     where ppr_builder prefix x = ifPprDebug (braces (text prefix <+> parens (ppr x))) (ppr x)

 instance Outputable XXExprGhcRn where

   ppr (ExpandedThingRn o e) = ifPprDebug (braces $ vcat [ppr o, text ";;" , ppr e]) (ppr o)

   ppr (HsRecSelRn f)        = pprPrefixOcc f

 instance Outputable XXExprGhcTc where

 ppr_infix_expr_rn :: XXExprGhcRn -> Maybe SDoc

 ppr_infix_expr_rn (ExpandedThingRn thing _) = ppr_infix_hs_expansion thing

 ppr_infix_expr_rn (HsRecSelRn f)            = Just (pprInfixOcc f)

 ppr_infix_expr_tc :: XXExprGhcTc -> Maybe SDoc

     go_x_rn :: XXExprGhcRn -> Bool

     go_x_rn (ExpandedThingRn thing _ )   = hsExpandedNeedsParens thing

     go_x_rn (HsRecSelRn{})               = False

     hsExpandedNeedsParens :: SrcCodeOrigin -> Bool

     go_x_rn :: XXExprGhcRn -> Bool

     go_x_rn (ExpandedThingRn thing _)   = isAtomicExpandedThingRn thing

     go_x_rn (HsRecSelRn{})              = True

     isAtomicExpandedThingRn :: SrcCodeOrigin -> Bool

          else repE e }

   | otherwise

   = notHandled (ThExpressionForm e)

 repE (XExpr (HsRecSelRn (FieldOcc _ (L _ x)))) = repE (mkHsVar (noLocA x))

 repE e@(HsPragE _ (HsPragSCC {}) _) = notHandled (ThCostCentres e)

 repE e@(HsTypedBracket{})   = notHandled (ThExpressionForm e)

                                     , text "arg: " <+> ppr (arg, arg_no)

                                     , text "arg_loc:" <+> ppr arg_loc

                                     , text "fun:" <+> ppr fun

                                     ])

        ; if in_generated_code

          then updCtxtForArg (locA arg_loc) arg $

       do setSrcSpan l $

            addExprCtxt e $

            thing_inside

     updCtxtForArg (UnhelpfulSpan {}) _ thing_inside = -- See 2.ii above

            thing_inside

 -- See `checkLastStmt` and `Syntax.Expr.StmtLR.LastStmt`

    | NoSyntaxExprRn <- ret_expr

    -- Last statement is just body if we are not in ListComp context. See Syntax.Expr.LastStmt

    | SyntaxExprRn ret <- ret_expr  -- We have unfortunately lost the location on the return function :(

    --

    --               return e  ~~> return e

    -- to make T18324 work

    = do let expansion = L body_loc (genHsApp ret body)

 expand_do_stmts doFlavour (stmt@(L loc (LetStmt _ bs)) : lstmts) =

 -- See  Note [Expanding HsDo with XXExprGhcRn] Equation (3) below

 --      e ; stmts ~~> (>>) e stmts'

   do expand_stmts_expr <- expand_do_stmts doFlavour lstmts

      let expansion = genHsExpApps then_op  -- (>>)

                      , expand_stmts_expr ]

      return $ L loc (mkExpandedStmt stmt doFlavour expansion)

 import GHC.Tc.Utils.Instantiate

 import GHC.Tc.Utils.Env

 import GHC.Tc.Types.Origin

 import GHC.Tc.Types.Evidence

 import GHC.Tc.Errors.Types hiding (HoleError)

         ; (ds_expr, ds_res_ty, err_msg)

             <- expandRecordUpd record_expr possible_parents rbnds res_ty

           do { -- Typecheck the expanded expression.

                expr' <- tcExpr ds_expr (Check ds_res_ty)

                -- NB: it's important to use ds_res_ty and not res_ty here.

 -- Here we get rid of it and add the finalizers to the global environment.

 -- See Note [Delaying modFinalizers in untyped splices] in GHC.Rename.Splice.

 tcExpr (HsTypedSplice ext splice)   res_ty = tcTypedSplice ext splice res_ty

 tcExpr e@(HsUntypedBracket ps body) res_ty = tcUntypedBracket e body ps res_ty

 tcExpr (HsUntypedSplice splice _)   res_ty

 -}

 tcXExpr :: XXExprGhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)

 tcXExpr (ExpandedThingRn o e) res_ty

      -- e is the expanded expression of o, so we need to set the error ctxt to generated

      -- see Note [Error Context Stack] in `GHC.Tc.Type.LclEnv`

         mkExpandedTc o <$> -- necessary for hpc ticks

 import GHC.Tc.Utils.Env

 import GHC.Tc.Utils.TcMType

 import GHC.Tc.Types.Origin

 import GHC.Tc.Types.Constraint( WantedConstraints )

 import GHC.Tc.Utils.TcType as TcType

 import GHC.Tc.Types.Evidence

                     -- and its hard to say exactly what that is

                : EWrap (EExpand e)

                : args )

       -- look through PopErrCtxt (cf. T17594f) we do not want to lose the opportunity of calling tcEValArgQL

       -- unlike HsPar, it is okay to forget about the PopErrCtxts as it does not persist over in GhcTc land

     case fun of

       HsVar _ nm                  -> Just <$> tcInferId nm

       XExpr (HsRecSelRn f)        -> Just <$> tcInferRecSelId f

       ExprWithTySig _ e hs_ty     -> Just <$> tcExprWithSig e hs_ty

       HsOverLit _ lit             -> Just <$> tcInferOverLit lit

       _                           -> return Nothing

 import GHC.Tc.Utils.Concrete ( hasFixedRuntimeRep_syntactic )

 import GHC.Tc.Utils.Unify

 import GHC.Tc.Types.Origin

 import GHC.Tc.Types.Evidence

 import GHC.Rename.Env ( irrefutableConLikeTc )

                   ; return (HsDo res_ty doExpr (L l stmts')) }

           else do { expanded_expr <- expandDoStmts doExpr stmts -- Do expansion on the fly

                   ; let orig = HsDo noExtField doExpr ss

                   }

         }

 {-# LANGUAGE UndecidableInstances #-}

 module GHC.Tc.Types.ErrCtxt

   , UserSigType(..), FunAppCtxtFunArg(..)

   , TyConInstFlavour(..)

   )

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

 -- | Additional context to include in an error message, e.g.

 -- "In the type signature ...", "In the ambiguity check for ...", etc.

              -- Monadic so that we have a chance

              -- to deal with bound type variables just before error

              -- message construction

              -- Bool:  True <=> this is a landmark context; do not

              --                 discard it when trimming for display

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

 -- Error message contexts

 srcCodeOriginErrCtxMsg (OrigExpr e) = ExprCtxt e

 srcCodeOriginErrCtxMsg (OrigStmt s f) = StmtErrCtxt (HsDoStmt f) (unLoc s)

 srcCodeOriginErrCtxMsg (OrigPat  p) = PatCtxt p

   , setLclEnvSrcCodeOrigin

   , setLclCtxtSrcCodeOrigin

   , lclEnvInGeneratedCode

   , addLclEnvErrCtxt

 import GHC.Prelude

 import GHC.Tc.Utils.TcType ( TcLevel )

 import GHC.Tc.Errors.Types ( TcRnMessage )

 -- | Get the original source code

 get_src_code_origin :: ErrCtxtStack -> Maybe SrcCodeOrigin

                    -- we are in generated code, due to the expansion of the original syntax origSrcCode

 get_src_code_origin _ = Nothing

                    -- we are in user code, so blame the expression in hand

 data TcLclCtxt

   = TcLclCtxt {

         tcl_loc         :: RealSrcSpan,     -- Source span

         tcl_err_ctxt    :: ErrCtxtStack,    -- See Note [Error Context Stack]

         tcl_tclvl       :: TcLevel,

         tcl_bndrs       :: TcBinderStack,   -- Used for reporting relevant bindings,

 setLclEnvErrCtxt ctxt = modifyLclCtxt (\env -> env { tcl_err_ctxt = ctxt })

 addLclEnvErrCtxt :: ErrCtxt -> TcLclEnv -> TcLclEnv

                                              then env -- no op if we are in generated code

                                              else env { tcl_err_ctxt =  ec : (tcl_err_ctxt env) })

 getLclEnvSrcCodeOrigin :: TcLclEnv -> Maybe SrcCodeOrigin

 getLclEnvSrcCodeOrigin = get_src_code_origin . tcl_err_ctxt . tcl_lcl_ctxt

 -- See Note [ErrCtxt Stack Manipulation]

   | otherwise

 lclCtxtInGeneratedCode :: TcLclCtxt -> Bool

 lclEnvInGeneratedCode :: TcLclEnv -> Bool

 lclEnvInGeneratedCode =  lclCtxtInGeneratedCode . tcl_lcl_ctxt

 exprCtOrigin e@(RecordUpd{})      = ExpansionOrigin (OrigExpr e)

 exprCtOrigin e@(HsGetField{})     = ExpansionOrigin (OrigExpr e)

 exprCtOrigin (XExpr (ExpandedThingRn o _)) = ExpansionOrigin o

 exprCtOrigin (XExpr (HsRecSelRn f))  = OccurrenceOfRecSel (foExt f)

         OrigExpr (ExplicitList{}) -> text "an overloaded list"

         OrigExpr (HsIf{}) -> text "an if-then-else expression"

         OrigExpr e -> text "the expression" <+> (ppr e)

 pprCtOrigin (GivenSCOrigin sk d blk)

   = vcat [ ctoHerald <+> pprSkolInfo sk

 ppr_br (ExpansionOrigin (OrigExpr e)) = text "an expression" <+> ppr e

 ppr_br (ExpansionOrigin (OrigStmt{})) = text "a do statement"

 ppr_br (ExpansionOrigin (OrigPat{})) = text "a do statement"

 ppr_br (ExpectedTySyntax o _) = ppr_br o

 ppr_br (ExpectedFunTySyntaxOp{}) = text "a rebindable syntax operator"

 ppr_br (ExpectedFunTyViewPat{}) = text "a view pattern"

   -- * Error management

   getSrcCodeOrigin,

   getSrcSpanM, setSrcSpan, setSrcSpanA, addLocM,

   wrapLocM, wrapLocFstM, wrapLocFstMA, wrapLocSndM, wrapLocSndMA, wrapLocM_,

   wrapLocMA_,wrapLocMA,

   getErrsVar, setErrsVar,

   -- * Context management for the type checker

   getErrCtxt, setErrCtxt, addErrCtxt, addErrCtxtM, addLandmarkErrCtxt,

   addLandmarkErrCtxtM, popErrCtxt, getCtLocM, setCtLocM, mkCtLocEnv,

   -- * Diagnostic message generation (type checker)

                 tcl_lcl_ctxt   = TcLclCtxt {

                 tcl_loc        = loc,

                 -- tcl_loc should be over-ridden very soon!

                 tcl_err_ctxt   = [],

                 tcl_rdr        = emptyLocalRdrEnv,

                 tcl_th_ctxt    = topLevel,

 setSrcSpan :: SrcSpan -> TcRn a -> TcRn a

 -- See Note [Error contexts in generated code]

 setSrcSpan (RealSrcSpan loc _) thing_inside

 setSrcSpan (UnhelpfulSpan _) thing_inside

 getSrcCodeOrigin :: TcRn (Maybe SrcCodeOrigin)

 getSrcCodeOrigin =

 --

 -- See Note [Error contexts in generated code]

 -- See Note [Error Context Stack]

 setSrcSpanA :: EpAnn ann -> TcRn a -> TcRn a

 setSrcSpanA l = setSrcSpan (locA l)

 {-# INLINE addErrCtxt #-}   -- Note [Inlining addErrCtxt]

 addErrCtxt msg = addErrCtxtM (\env -> return (env, msg))

 -- | Add a message to the error context. This message may do tidying.

 --   NB. No op in generated code

 --   See Note [Rebindable syntax and XXExprGhcRn] in GHC.Hs.Expr

 addErrCtxtM :: (TidyEnv -> ZonkM (TidyEnv, ErrCtxtMsg)) -> TcM a -> TcM a

 {-# INLINE addErrCtxtM #-}  -- Note [Inlining addErrCtxt]

 -- | Add a fixed landmark message to the error context. A landmark

 -- message is always sure to be reported, even if there is a lot of

 -- and tidying.

 addLandmarkErrCtxtM :: (TidyEnv -> ZonkM (TidyEnv, ErrCtxtMsg)) -> TcM a -> TcM a

 {-# INLINE addLandmarkErrCtxtM #-}  -- Note [Inlining addErrCtxt]

 -- | NB. no op in generated code

 -- See Note [Rebindable syntax and XXExprGhcRn] in GHC.Hs.Expr

  where

    go :: Bool -> Int -> TidyEnv -> [ErrCtxt] -> TcM [ErrCtxtMsg]

    go _ _ _   [] = return []

      = do { (env', msg) <- liftZonkM $ ctxt env

           ; return (msg : rest) }

      | otherwise

      = go dbg n env ctxts

      | n < mAX_CONTEXTS -- Too verbose || dbg

           ; return (msg : rest) }

      | otherwise

      = go dbg n env ctxts