import GHC.Builtin.Modules

 import GHC.Builtin.Uniques

 import GHC.Unit.Types

 knownKeyTable :: [(OccName, KnownKey)]

 knownKeyTable

     , (mkTcOcc "Show",         showClassKey)

     , (mkTcOcc "Foldable",     foldableClassKey)

     , (mkTcOcc "Traversable",  traversableClassKey)

     , (mkTcOcc "Data",         dataClassKey)

     , (mkTcOcc "Ix",           ixClassKey)

     , (mkTcOcc "Alternative",  alternativeClassKey)

     , (mkTcOcc "Typeable",     typeableClassKey)

     , (mkTcOcc "Num",               numClassKey)

     , (mkTcOcc "Integral",          integralClassKey)

     , (mkTcOcc "Real",              realClassKey)

     , (mkVarOcc "toRational",       toRationalClassOpKey)

     , (mkVarOcc "realToFrac",       realToFracIdKey)

     -- Class Monad, MonadFix, MonadZip

     , (mkTcOcc "Monad",        monadClassKey)

     , (thenMClassOpOcc,        thenMClassOpKey)

     , (mkTcOcc "Monoid",       monoidClassKey)

     , (sappendClassOpOcc,      sappendClassOpKey)

     , (mappendClassOpOcc,      mappendClassOpKey)

     -- Class IsString

     , (mkTcOcc "IsString",    isStringClassKey)

     -- DataToTag

     , (mkTcOcc "DataToTag",   dataToTagClassKey)

     -- Lists

     , (mkVarOcc "build",  buildIdKey)

 fromLabelClassOpKey :: KnownKey

 fromLabelClassOpKey = mkPreludeMiscIdUnique 160

 -- Arrow notation

 arrAIdKey, composeAIdKey, firstAIdKey, appAIdKey, choiceAIdKey,

     loopAIdKey :: KnownKey

 fmap_RDR           = knownOccRdrName fmapClassOpOcc

 pure_RDR           = knownKeyRdrName pureAClassOpKey

 ap_RDR             = knownOccRdrName apAClassOpOcc

 mappend_RDR        = knownKeyRdrName mappendClassOpKey

 replace_RDR        = knownVarOccRdrName "<$"

 liftA2_RDR         = knownVarOccRdrName "liftA2"

 foldable_foldr_RDR = knownVarOccRdrName "foldr"

 minusInt_RDR, tagToEnum_RDR, dataToTag_RDR :: RdrName

 minusInt_RDR  = primOpRdrName IntSubOp

 tagToEnum_RDR = primOpRdrName TagToEnumOp

 -- Generics (constructors and functions)

 u1DataCon_RDR, par1DataCon_RDR, rec1DataCon_RDR,

 import GHC.Prelude ()

 import GHC.Unit.Types

 import GHC.Types.Name.Occurrence

 import GHC.Types.Unique ( Unique )

 import GHC.Builtin.Uniques

 import Language.Haskell.Syntax.Module.Name

 thKnownOccs :: [KnownOcc]

 thKnownOccs

   = [ qTyConOcc, nameTyConOcc, fieldExpTyConOcc, patTyConOcc

     , litPOcc, varPOcc, tupPOcc, unboxedTupPOcc, unboxedSumPOcc, conPOcc

     , infixPOcc, tildePOcc, bangPOcc, asPOcc, wildPOcc, recPOcc, listPOcc

     , sigPOcc, viewPOcc, typePOcc, invisPOcc, orPOcc

     , varEOcc, conEOcc, litEOcc, appEOcc, appTypeEOcc, infixEOcc, infixAppOcc

     , sectionLOcc, sectionROcc, lamEOcc, lamCaseEOcc, lamCasesEOcc, tupEOcc

     , unboxedTupEOcc, unboxedSumEOcc, condEOcc, multiIfEOcc, letEOcc

     , tySynEqnTyConOcc, roleTyConOcc, derivClauseTyConOcc, kindTyConOcc

     , tyVarBndrUnitTyConOcc, tyVarBndrSpecTyConOcc, tyVarBndrVisTyConOcc

     , derivStrategyTyConOcc

     ]

 templateHaskellNames :: [Name]

 -- Should stay in sync with the import list of GHC.HsToCore.Quote

 templateHaskellNames = [

     mkNameName, mkNameG_vName, mkNameG_dName, mkNameG_tcName, mkNameG_fldName,

     mkNameLName,

     mkNameSName, mkNameQName,

     mkModNameName,

     unTypeName, unTypeCodeName,

     -- Cxt

     cxtName,

     -- DerivClause

     derivClauseName,

     -- Quasiquoting

     quoteDecName, quoteTypeName, quoteExpName, quotePatName]

 qqFld = mk_known_key_name (fieldName (fsLit "QuasiQuoter")) qqLib

 -------------------- TH.Syntax -----------------------

 qTyConOcc, nameTyConOcc, fieldExpTyConOcc, patTyConOcc,

     fieldPatTyConOcc, expTyConOcc, decTyConOcc, typeTyConOcc,

 modNameTyConOcc       = mkTcOcc "ModName"

 quasiQuoterTyConOcc   = mkTcOcc "QuasiQuoter"

     mkNameName, mkNameG_vName, mkNameG_fldName, mkNameG_dName, mkNameG_tcName,

     mkNameLName, mkNameSName, unTypeName, unTypeCodeName,

     mkModNameName, mkNameQName :: Name

 newNameName    = thMonadFun (fsLit "newName")   newNameIdKey

 mkNameName     = thFun (fsLit "mkName")     mkNameIdKey

 mkNameG_vName  = thFun (fsLit "mkNameG_v")  mkNameG_vIdKey

 invisPOcc      = mkVarOcc "invisP"

 -- type FieldPat = ...

 -- data Exp = ...

 varEOcc, conEOcc, litEOcc, appEOcc, appTypeEOcc, infixEOcc, infixAppOcc,

 fieldExpOcc = mkVarOcc "fieldExp"

 -- data Body = ...

 -- data Guard = ...

 -- data Stmt = ...

 -- data Dec = ...

 funDOcc, valDOcc, dataDOcc, newtypeDOcc, typeDataDOcc, tySynDOcc, classDOcc,

 forallVisEIdKey        = mkPreludeMiscIdUnique 803

 constrainedEIdKey      = mkPreludeMiscIdUnique 804

 -- data Guard = ...

 normalGEIdKey, patGEIdKey :: Unique

 normalGEIdKey     = mkPreludeMiscIdUnique 310

 patGEIdKey        = mkPreludeMiscIdUnique 311

 -- data Dec = ...

 funDIdKey, valDIdKey, dataDIdKey, newtypeDIdKey, tySynDIdKey, classDIdKey,

     instanceWithOverlapDIdKey, instanceDIdKey, sigDIdKey, forImpDIdKey,

       | otherwise

       = Nothing

     -- See Note [Detecting overloaded literals with -XRebindableSyntax]

     is_rebound_name :: Id -> KnownOcc -> Bool

     is_rebound_name x ko = getOccFS (idName x) == occNameFS ko

       let quote_var = Var quote_var_raw

       -- Get the superclass selector to select the Monad dictionary, going

       -- to be used to construct the monadWrapper.

       monad_tc <- dsLookupKnownKeyTyCon monadClassKey

       let cls = expectJust $ tyConClass_maybe quote_tc

           monad_cls = expectJust $ tyConClass_maybe monad_tc

    rep_fld :: LHsRecField GhcRn (LPat GhcRn) -> MetaM (Core (M (TH.Name, TH.Pat)))

    rep_fld (L _ fld) = do { MkC v <- lookupOcc (hsRecFieldSel fld)

                           ; MkC p <- repLP (hfbRHS fld)

 repP (NPat _ (L _ l) Nothing _) = do { a <- repOverloadedLiteral l

                                      ; repPlit a }

 repP (ViewPat _ e p) = do { e' <- repLE e; p' <- repLP p; repPview e' p' }

   NotM (M _) = TypeError ('Text ("rep2_nw must not produce something of overloaded type"))

   NotM _other = (() :: Constraint)

 rep2 :: Name -> [CoreExpr] -> MetaM (Core (M a))

 rep2_nw :: NotM a => Name -> [CoreExpr] -> MetaM (Core a)

 rep2_nwDsM :: NotM a => Name -> [CoreExpr] -> DsM (Core a)

 rep2 = rep2X lift (asks quoteWrapper)

 rep2_nw n xs = lift (rep2_nwDsM n xs)

 rep2_nwDsM = rep2X id (return id)

   ; return (MkC $ (foldl' App (wrap (Var rep_id)) xs)) }

 krep2       ::           KnownOcc -> [CoreExpr] -> MetaM (Core (M a))

 krep2_nw    :: NotM a => KnownOcc -> [CoreExpr] -> MetaM (Core a)

 krep2_nwDsM :: NotM a => KnownOcc -> [CoreExpr] -> DsM (Core a)

 krep2  = krep2X lift (asks quoteWrapper)

 krep2_nw n xs = lift (krep2_nwDsM n xs)

 krep2_nwDsM   = krep2X id (return id)

 ------------ Right hand sides (guarded expressions) ----

 repGuarded :: Core [M (TH.Guard, TH.Exp)] -> MetaM (Core (M TH.Body))

 repNormal :: Core (M TH.Exp) -> MetaM (Core (M TH.Body))

 ------------ Guards ----

 repLNormalGE :: LHsExpr GhcRn -> LHsExpr GhcRn

                       repNormalGE g' e'

 repNormalGE :: Core (M TH.Exp) -> Core (M TH.Exp) -> MetaM (Core (M (TH.Guard, TH.Exp)))

 repPatGE :: Core [(M TH.Stmt)] -> Core (M TH.Exp) -> MetaM (Core (M (TH.Guard, TH.Exp)))

 ------------- Stmts -------------------

 repBindSt :: Core (M TH.Pat) -> Core (M TH.Exp) -> MetaM (Core (M TH.Stmt))

 repLetSt :: Core [(M TH.Dec)] -> MetaM (Core (M TH.Stmt))

 repNoBindSt :: Core (M TH.Exp) -> MetaM (Core (M TH.Stmt))

 repParSt :: Core [[(M TH.Stmt)]] -> MetaM (Core (M TH.Stmt))

 repRecSt :: Core [(M TH.Stmt)] -> MetaM (Core (M TH.Stmt))

 -------------- Range (Arithmetic sequences) -----------

 repFrom :: Core (M TH.Exp) -> MetaM (Core (M TH.Exp))

 repBindM :: Type -> Type        -- a and b

          -> Core (M a) -> Core (a -> M b) -> MetaM (Core (M b))

 repBindM ty_a ty_b (MkC x) (MkC y)

 repSequenceM :: Type -> Core [M a] -> MetaM (Core (M [a]))

 repSequenceM ty_a (MkC list)

 repUnboundVar :: Core TH.Name -> MetaM (Core (M TH.Exp))

 repUnboundVar (MkC name) = krep2 unboundVarEOcc [name]

        ; return (CST tbl') }

   where

      do_one (std_occ, user_nm_expr)

             ; if | HsVar _ (L _ (WithUserRdr _ user_nm)) <- user_nm_expr

                  , idName std_id == user_nm

                  ->  -- Use the standard operation

 -- Domain is only the arrow operations

 arity_map = mkOccEnv

    [ (arrAIdOcc,     3)  -- result used as an argument in, e.g., do_premap

    , (appAIdOcc,     2)  -- result used as an argument in, e.g., dsCmd/HsCmdArrApp/HsHigherOrderApp

    , (choiceAIdOcc,  5)  -- result used as an argument in, e.g., HsCmdIf

    , (loopAIdOcc,    4)  -- result used as an argument in, e.g., HsCmdIf

 -- | For a type 'm', emit the constraint 'Quote m'.

 emitQuoteWanted :: Type -> TcM EvVar

 emitQuoteWanted m_var =  do

         emitWantedEvVar BracketOrigin $

           mkTyConApp quote_con [m_var]

 -}

 newKnownOccMethod

   -> KnownOcc              -- ^ name of the method

   -> [TcRhoType]           -- ^ types with which to instantiate the class

   -> TcM (HsExpr GhcTc)

        ; finish_nkko origin id ty_args }

 newKnownKeyMethod  -- Same as newKnownOccMethod, but with a KnownKey

 newKnownKeyMethod origin key ty_args

   = do { id <- tcLookupKnownKeyId key

        ; finish_nkko origin id ty_args }

 finish_nkko origin id ty_args

   = do { let ty = piResultTys (idType id) ty_args

              (theta, _caller_knows_this) = tcSplitPhiTy ty

     , integerComplement, integerBit#, integerTestBit#, integerShiftL#, integerShiftR#

     -- Template Haskell

     , Q, DecsQ, ExpQ, TypeQ, PatQ

     , Name, Decs, TH.Type, FunDep

     , Pred, Code, InjectivityAnn, Overlap, ModName, QuasiQuoter

     , Kind, TyVarBndrUnit, TyVarBndrSpec, TyVarBndrVis, DerivStrategy

     , sequenceQ, newName, mkName, mkNameG_v, mkNameG_d, mkNameG_tc, mkNameG_fld, mkNameL

     , mkNameQ, mkNameS, mkModName, unType, unTypeCode, unsafeCodeCoerce

     , FieldPat, fieldPat

     , Match, match

     , Clause, clause

     ) where

 import GHC.Internal.Base hiding( foldr )

 {-# LANGUAGE FlexibleInstances #-}

 {-# OPTIONS_GHC -fno-warn-inline-rule-shadowing #-}

 -- | This module gives the definition of the 'Lift' class.

 --

 -- This is an internal module.