*                                                                      *

 ********************************************************************* -}

 data XXExprGhcRn

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

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

                            -- Note [Record selectors in the AST]

 data XXExprGhcTc

   = WrapExpr        -- Type and evidence application and abstractions

       HsWrapper (HsExpr GhcTc)

   | ConLikeTc

       -- ^ A 'ConLike', either a data constructor or pattern synonym

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

                              -- Note [Record selectors in the AST]

 {- *********************************************************************

 *                                                                      *

             Pretty-printing expressions

   GhcRn -> ppr x

   GhcTc -> ppr x

     where

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

       pprCtxt :: HsCtxt -> SDoc

       pprCtxt (FunAppCtxt (FunAppCtxtExpr _ e) _) = ppr_builder "<FunAppCtxt>:"  (ppr e)

       pprCtxt _ = ppr_builder "<MiscHsCtxt>:" empty

 instance Outputable XXExprGhcTc where

   ppr (WrapExpr co_fn e)

     = pprHsWrapper co_fn (\_parens -> pprExpr e)

   ppr (ConLikeTc con) = pprPrefixOcc con

    -- Used in error messages generated by

 ppr_infix_expr _ = Nothing

 ppr_infix_expr_rn :: XXExprGhcRn -> Maybe SDoc

 ppr_infix_expr_rn (HsRecSelRn f)            = Just (pprInfixOcc f)

 ppr_infix_expr_tc :: XXExprGhcTc -> Maybe SDoc

 ppr_infix_expr_tc (WrapExpr _ e)    = ppr_infix_expr e

 ppr_infix_expr_tc (ConLikeTc con)            = Just (pprInfixOcc (conLikeName con))

 ppr_infix_expr_tc (HsTick {})                = Nothing

 ppr_infix_expr_tc (HsBinTick {})             = Nothing

     go_x_tc :: XXExprGhcTc -> Bool

     go_x_tc (WrapExpr _ e)                   = hsExprNeedsParens prec e

     go_x_tc (ConLikeTc {})                   = False

     go_x_tc (HsTick _ (L _ e))               = hsExprNeedsParens prec e

     go_x_tc (HsBinTick _ _ (L _ e))          = hsExprNeedsParens prec e

     go_x_tc (HsRecSelTc{})                   = False

     go_x_rn :: XXExprGhcRn -> Bool

     go_x_rn (HsRecSelRn{})               = False

     hsExpandedNeedsParens :: HsCtxt -> Bool

   where

     go_x_tc :: XXExprGhcTc -> Bool

     go_x_tc (WrapExpr _ e)            = isAtomicHsExpr e

     go_x_tc (ConLikeTc {})            = True

     go_x_tc (HsTick {})               = False

     go_x_tc (HsBinTick {})            = False

     go_x_tc (HsRecSelTc{})            = True

     go_x_rn :: XXExprGhcRn -> Bool

     go_x_rn (HsRecSelRn{})              = True

     isAtomicExpandedThingRn :: HsCtxt -> Bool

 deriving instance Data XXExprGhcRn

 deriving instance Data a => Data (WithUserRdr a)

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

 hsExprType (HsForAll x _ _) = dataConCantHappen x

 hsExprType (HsFunArr x _ _ _) = dataConCantHappen x

 hsExprType (XExpr (WrapExpr wrap e)) = hsWrapperType wrap $ hsExprType e

 hsExprType (XExpr (ConLikeTc con)) = conLikeType con

 hsExprType (XExpr (HsTick _ e)) = lhsExprType e

 hsExprType (XExpr (HsBinTick _ _ e)) = lhsExprType e

 --     needs to see source types

 import GHC.Tc.Utils.TcType

 import GHC.Tc.Types.Evidence

 import GHC.Tc.Utils.Monad

 import GHC.Tc.Instance.Class (lookupHasFieldLabel)

       WrapExpr {}   -> dsApp e

       ConLikeTc {}  -> dsApp e

       -- Hpc Support

       HsTick tickish e -> do

     -- we have to compare the wrappers

     exp (XExpr (WrapExpr h e)) (XExpr (WrapExpr h' e')) =

       wrap h h' && exp e e'

     exp (HsVar _ i) (HsVar _ i') = i == i'

     exp (HsIPVar _ i) (HsIPVar _ i') =

       -- the instance for IPName derives using the id, so follow the HsVar case

   | ExprCtxt e <- o

   = do { rebindable_on <- lift $ xoptM LangExt.RebindableSyntax

        ; if rebindable_on  -- See Note [Quotation and rebindable syntax]

          else repE e }

   | otherwise

   = notHandled (ThExpressionForm e)

   d <- getDensity

   case d of

     TickForBreakPoints | isGoodBreakExpr e0 -> tick_it

                        -> dont_tick_it

                        | otherwise -> tick_it

     TickCallSites      | isCallSite e0      -> tick_it

 -- General heuristic: expressions which are calls (do not denote

 -- values) are good break points.

 isGoodBreakExpr :: HsExpr GhcTc -> Bool

 isGoodBreakExpr e = isCallSite e

 isCallSite :: HsExpr GhcTc -> Bool

 isCallSite HsApp{}     = True

 isCallSite HsAppType{} = True

 isCallSite HsCase{}    = True

 -- NB: OpApp, SectionL, SectionR are all expanded out

 isCallSite _           = False

 addTickHsExpr (XExpr (WrapExpr w e)) =

         liftM (XExpr . WrapExpr w) $

               (addTickHsExpr e)        -- Explicitly no tick on inside

 addTickHsExpr e@(XExpr (ConLikeTc {})) = return e

   -- We used to do a freeVar on a pat-syn builder, but actually

                     ListComp -> Just $ BinBox QualBinBox

                     _        -> Nothing

   -- We always want statements to get a tick, so we can step over each one.

   -- To avoid duplicates we blacklist SrcSpans we already inserted here.

   StmtErrCtxt _ (L pos _) -> do_tick_black pos

   _                    -> skip

   where

     do_tick_black pos = do

       d <- getDensity

       case d of

          TickForBreakPoints -> tick_it_black pos

          _                  -> skip

     tick_it_black pos =

                              (withBlackListed (locA pos) $

 addTickTupArg :: HsTupArg GhcTc -> TM (HsTupArg GhcTc)

 addTickTupArg (Present x e)  = do { e' <- addTickLHsExpr e

         RecordCon con_expr _ _ -> computeType con_expr

         ExprWithTySig _ e _ -> computeLType e

         HsPragE _ _ e -> computeLType e

           | ExprCtxt (HsGetField{}) <- thing -- for record-dot-syntax

         XExpr (HsTick _ e) -> computeLType e

         XExpr (HsBinTick _ _ e) -> computeLType e

         e -> Just (hsExprType e)

           WrapExpr w a

             -> [ toHie $ L mspan a

                , toHie (L mspan w) ]

           ConLikeTc con

             -> [ toHie $ C Use $ L mspan $ conLikeName con ]

           HsTick _ expr

         genSimpleFunBind, genFunBind,

         genHsLamDoExp, genHsCaseAltDoExp, genSimpleMatch, genHsLet,

         mkRnSyntaxExpr,

         newLocalBndrRn, newLocalBndrsRn,

 import GHC.Hs

 import GHC.Types.Name.Reader

 import GHC.Tc.Errors.Types

 import GHC.Tc.Utils.Monad

 import GHC.Types.Name

 import GHC.Types.Name.Set

   = wrapGenSpan $

     Match { m_ext = noExtField, m_ctxt = ctxt, m_pats = noLocA pats

           , m_grhss = unguardedGRHSs generatedSrcSpan rhs noAnn }

                                     , ppr arg

                                     , ppr arg_no])

        ; setSrcSpanA arg_loc $

        }

   | otherwise

   = do { traceTc "addArgCtxt" (vcat [text "generated Head"

        ; addLExprCtxt (locA arg_loc) arg $

           thing_inside

        }

 {- *********************************************************************

       | otherwise = not_in_scope

       where occ = occName rdr

             not_in_scope = failWith $ TcRnNotInScope NotInScope rdr

       -- Use the original, user-written expression (before expansion).

       -- Example. Say we have   vfun :: forall a -> blah

       --          and the call  vfun (Maybe [1,2,3])

               -> Scaled TcRhoType  -- Deeply skolemised

               -> TcM (HsExprArg 'TcpInst)

 -- quickLookArg1 implements the "QL Argument" judgement in Fig 5 of the paper

   = addArgCtxt pos (fun, fun_lspan) larg $ -- Context needed for constraints

                            -- generated by calls in arg

        -- Step 1: get the type of the head of the argument

          -- tcCollectingUsage: the use of an Id at the head generates usage-info

          -- See the call to `tcEmitBindingUsage` in `check_local_id`.  So we must

          -- capture and save it in the `EValArgQL`.  See (QLA6) in

              <- captureConstraints $

                 tcInstFun do_ql True ds_flag_arg (arg_orig, rn_fun_arg, fun_lspan_arg) tc_fun_arg_head fun_sigma_arg_head rn_args

                 -- We must capture type-class and equality constraints here, but

                 -- value arguments]

        ; traceTc "quickLookArg 2" $

                            , eaql_res_rho  = app_res_rho }) }}}

 mk_origin :: SrcSpan       -- SrcSpan of the argument

           -> HsExpr GhcRn  -- The head of the expression application chain

           -> TcM CtOrigin

 import GHC.Prelude

 import GHC.Rename.Env   ( irrefutableConLikeRn )

 import GHC.Tc.Utils.Monad

 --   so that they can be typechecked.

 --   See Note [Expanding HsDo with XXExprGhcRn] below for `HsDo` specific commentary

 --   and Note [Handling overloaded and rebindable constructs] for high level commentary

 expandDoStmts doFlav stmts = expand_do_stmts doFlav stmts

 -- | The main work horse for expanding do block statements into applications of binds and thens

   | otherwise

   = pprPanic "expand_do_stmts: The impossible happened, missing bind operator from renamer" (text "stmt" <+> ppr  stmt)

 -- See Note [BodyStmt] in Language.Haskell.Syntax.Expr

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

 --              stmts ~~> stmts'

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

 To disabmiguate desugaring (`HsExpr GhcTc -> Core.Expr`) we use the phrase expansion

 (`HsExpr GhcRn -> HsExpr GhcRn`)

 See Part 2. of Note [Doing XXExprGhcRn in the Renamer vs Typechecker] in `GHC.Rename.Expr`

 Historical note START

       ‹ExpandedThingRn do { e1; e2; e3 }›                        -- Original Do Expression

                                                                  -- Expanded Do Expression

           (‹ExpandedThingRn e1›                                  -- Original Statement

                       (‹ExpandedThingRn e2›

   * Whenever the typechecker steps through an `ExpandedThingRn`,

     we push the original statement in the error context, set the error location to the

 mkExpandedPatRn :: LPat GhcRn -> HsExpr GhcRn -> HsExpr GhcRn

 import GHC.Tc.Gen.App

 import GHC.Tc.Gen.Head

 import GHC.Tc.Gen.Bind        ( tcLocalBinds )

 import GHC.Tc.Gen.HsType

 import GHC.Tc.Gen.Arrow

 import Control.Monad

 import qualified Data.List.NonEmpty as NE

 {-

 ************************************************************************

 *                                                                      *

 tcCheckMonoExpr   expr res_ty = tcMonoLExpr  expr (mkCheckExpType res_ty)

 tcCheckMonoExprNC expr res_ty = tcMonoLExprNC expr (mkCheckExpType res_ty)

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

 tcMonoLExpr, tcMonoLExprNC

     :: LHsExpr GhcRn     -- Expression to type check

     -> TcM (LHsExpr GhcTc)

 tcMonoLExpr (L loc expr) res_ty

          do  { expr' <- tcExpr expr res_ty

              ; return (L loc expr') }

 tcExpr e@(HsAppType {})          res_ty = tcApp e res_ty

 tcExpr e@(ExprWithTySig {})      res_ty = tcApp e res_ty

 -- Typecheck an occurrence of an unbound Id

 --

        ; res_ty <- readExpType res_ty

        ; return (HsMultiIf res_ty alts') }

   = tcDoStmts do_or_lc stmts res_ty

 tcExpr (HsProc x pat cmd) res_ty

         ; (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.

 Example: record updates.  The typechecker looks like this:

 with something like

 and we then typecheck the latter.

 See also Note [Handling overloaded and rebindable constructs]

                                        , xrn_expanded = ee } ))

   where `ee` is the expansion of the user written thing `ue`

      TcLclCtxt { tcl_loc      :: RealSrcSpan

                , tcl_err_ctxt :: [ErrCtxt]

                , ... }

   Note `tcl_loc` always points to a real place in the source code,

   hence `RealSrcSpan`.

   The `tcl_err_ctxt` is a stack of contexts, each saying something

 * Now, when

   gets a located expression, it does 2 things:

     * Calls `addLExprCtxt` to perform error context management

     * Calls `tcExpr` to typecheck the expression.

 -}

    = mkExpandedTc o <$> -- necessary for hpc ticks

          -- Need to call tcExpr and not tcApp

          -- as e can be let statement which tcApp cannot gracefully handle

 {-

 ************************************************************************

     field_strs = conLikeImplBangs con_like

     fl `elemField` flds = any (\ fl' -> flSelector fl == fl') flds

 import GHC.Hs

 import GHC.Hs.Syn.Type

 import GHC.Tc.Gen.HsType

 import GHC.Tc.Gen.Bind( chooseInferredQuantifiers )

 import GHC.Tc.Gen.Sig( tcUserTypeSig, tcInstSig )

       ExprWithTySig _ e hs_ty     -> Just <$> with_get_ds (tcExprWithSig e hs_ty)

       HsOverLit _ lit             -> Just <$> with_get_ds (tcInferOverLit lit)

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

                                               -- We do not want to instantiate the type of the head as there may be

                                               -- visible type applications in the argument.

                                               -- c.f. T19167

                                               )

       _                           -> return Nothing

 import GHC.Prelude

 import {-# SOURCE #-}   GHC.Tc.Gen.Expr( tcSyntaxOp, tcInferRho, tcInferRhoFRRNC

                                        , tcCheckMonoExpr, tcCheckMonoExprNC

                                        , tcCheckPolyExpr, tcPolyLExpr )