{- Note [Overview of known-key entities]

 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

 A "wired-in" entity:

   * Its Unique, OccName

   * Its defining module

   knowledge precisely reflects the code in the library.

 A "known-key" entity:

   * It is exported by base:GHC.KnownKeyNames

   * But that's all that GHC knows about it

   In particular, GHC does /not/ know in which module the entity is defined.

   to GHC. It's not hard.

 A "known-occ" entity:

   * It is exported by base:GHC.KnownKeyNames

   * But that's all that GHC knows about it

   In particular, GHC does /not/ know in which module the entity is defined,

   It is significantly easier to add a known-occ entity to GHC than a known-key

   entity, so we use known-occ entities whenever we can.

 When do we use each of these?

   "are you /the/ Typeable class?", not some other class that happens to be called

   "Typeable".  It checks this using

        cls `hasKnownKey` typeableClassKey

   where GHC.Builtin.KnownKeys.typeableClassKey is the statically chosen unique

   for `Typeable`.  See `GHC.Tc.Instance.Class.matchGlobalInst`

   class is suitable for stock deriving.

 To implement all this, here are the moving parts:

 * Each known-key name has a /statically-chosen/ unique, fixed in GHC.Builtin.KnownKeys.

   e.g. eqClassKey :: KnownKey

        eqClassKey = mkPreludeClassUnique 3

 * All the known-key names are gathered in one table:

       knownKeyTable

         = [ (mkTcOcc "Rational",     rationalTyConKey)

           , (mkTcOcc "Eq",           eqClassKey)

           ... etc ... ]

       knownKeyOccMap :: OccEnv KnownKey

       knownKeyOccMap = mkOccEnv knownKeyTable

   There is nothing special about this module except that GHC knows its

   name and can import it.

   In effect, the `mi_exports` of `GHC/KnownKeyNames.hi` tells GHC where each

   known-key name is defined.

   entities with the same OccName.

 * There are three flags that control the treatment of known-key names:

     -fexclude-known-key-define=wombat   See wrinkle (KKN2)

   Details in the following bullets.

     * GHC imports GHC.KnownKeyNames, i.e. looks for `GHC/KnownKeyNames.hi`

       so that it doesn't need to repeat the exercise.

 * Known-key name lookup (base case: KKNS_InScope)

   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

   GHC.KnownKeyNames has not yet been compiled!  Instead, we use whatever is in scope with

   the desired `OccName`, rather like `-XRebindableSyntax`.

   in `ghc-internal` or `base`:

     * We switch on -frebindable-known-key-names

   See also wrinkle (KKN1)

 * Defining known-key names

 Wrinkles

 (KKN2) The flag `-fdefines-known-key-names` is module-wide.  But what if that module

    happens to define an entity that /isn't/ a known-key entity, but /does/ share the

    So we compile GHC.Internal.Data.Foldable with

        -fexclude-known-key-define=toList

   because we (should) never look up a wired-in name via its key.  That is,

   `GHC.Iface.Load.lookupKnownKeyName` should never be called on the key of

   a wired-in name.

   Alternative: export all wired-in entities from GHC.KnownKeyNames.  But that

   would simply bloat the interface for no good reason.

 Note [Recipe for adding a known-occ name]

 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

 To make `wombat` into a known-occ name, you must ensure that:

 * In any module in `base` or `ghc-internal` (which are compiled with

   -frebindable-known-key-names), in which `wombat` is needed, you must ensure

 Note [Recipe for adding a known-key name]

 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

   entry for `wombat`

       (mkVarOcc "wombat", wombatKey)

 -}

 allKnownOccs :: OccSet

     -- Class Functor

     , (mkTcOcc "Functor",     functorClassKey)

     , (mkVarOcc "fmap",       fmapClassOpKey)

     -- Class Monad, MonadFix, MonadZip

     , (mkTcOcc "Monad",        monadClassKey)

     , (mkVarOcc "dataToTag#", dataToTagClassOpKey)

     -- Lists

     , (mkVarOcc "build",  buildIdKey)

     -- Records

   to make an ExactOcc RdrName for the thing.  We use the latter for

   known-key things, merely to avoid duplicating knowledge of the KnownOcc

 -}

 voidTyConOcc     = mkTcOcc "Void"

 rationalTyConOcc = mkTcOcc "Rational"

 fromStaticPtrClassOpOcc :: KnownOcc

 fromStaticPtrClassOpOcc = mkVarOcc "fromStaticPtr"

 enumFromThenToClassOpOcc = mkVarOcc "enumFromThenTo"

 -- Class Typeable, and functions for constructing `Typeable` dictionaries

 someTypeRepTyConOcc   = mkTcOcc   "SomeTypeRep"

 someTypeRepDataConOcc = mkDataOcc "SomeTypeRep"

 typeRepIdOcc          = mkVarOcc  "typeRep#"

 typeSymbolTypeRepOcc  = mkVarOcc  "typeSymbolTypeRep"

 typeCharTypeRepOcc    = mkVarOcc  "typeCharTypeRep"

 typeLitSymbolDataConOcc = mkDataOcc "TypeLitSymbol"

 typeLitNatDataConOcc    = mkDataOcc "TypeLitNat"

 typeLitCharDataConOcc   = mkDataOcc "TypeLitChar"

 trModuleTyConOcc     = mkTcOcc "Module"

 trModuleDataConOcc   = mkDataOcc "Module"

 trNameSDataConOcc    = mkDataOcc "TrNameS"

 trTyConDataConOcc    = mkDataOcc "TyCon"

 -- Typeable representation types

 kindRepTyConOcc           = mkTcOcc "KindRep"

 kindRepTyConAppDataConOcc = mkDataOcc "KindRepTyConApp"

 kindRepVarDataConOcc      = mkDataOcc "KindRepVar"

         -- We definitely don't want an Orig RdrName, because

         -- main might, in principle, be imported into module Main

 error_RDR :: RdrName

 error_RDR = knownVarOccRdrName "error"

 toDyn_RDR :: RdrName

 toDyn_RDR = knownVarOccRdrName "toDyn"

 compose_RDR = knownOccRdrName composeIdOcc

 appE_RDR, lift_RDR, liftTyped_RDR :: RdrName

 enumFrom_RDR, enumFromTo_RDR, enumFromThen_RDR, enumFromThenTo_RDR :: RdrName

 enumFrom_RDR       = knownOccRdrName enumFromClassOpOcc

 eqTag_RDR       = nameRdrName ordEQDataConName

 gtTag_RDR       = nameRdrName ordGTDataConName

     foldMap_RDR, null_RDR, all_RDR, traverse_RDR, mempty_RDR,

     mappend_RDR :: RdrName

 fmap_RDR           = knownKeyRdrName fmapClassOpKey

 pure_RDR           = knownKeyRdrName pureAClassOpKey

 ap_RDR             = knownKeyRdrName apAClassOpKey

 import GHC.Tc.Utils.TcType

 import GHC.Builtin.KnownKeys

 import GHC.Builtin.Types

 import GHC.Builtin.Types.Prim( alphaTyVar )

     -- Create an unzip function for the appropriate arity and element types and find "map"

     unzip_stuff' <- mkUnzipBind form from_bndrs_tys

     -- Generate the expressions to build the grouped list

     let -- First we apply the grouping function to the inner list

             -> CoreExpr         -- ^ List expression being folded acress

             -> DsM CoreExpr

 mkFoldrExpr elt_ty result_ty c n list = do

     return (Var foldr_id `App` Type elt_ty

            `App` Type result_ty

            `App` c

 import GHC.Types.TypeEnv

 import GHC.Types.Unique.DSet

 import GHC.Types.Unique.Map( listToUniqMap )

 import GHC.Types.SrcLoc

 import GHC.Types.TyThing

 import GHC.Types.PkgQual

                       cannotFindModule hsc_env kNOWN_KEY_NAMES fr }

        ; let kk_map :: UniqFM KnownKey Name

              kk_map  = listToUFM [ (getUnique nm, nm)

                                  | avail <- mi_exports iface

              occ_map :: OccEnv Name

              occ_map = mkOccEnv [ (nameOccName nm, nm)

                                 | avail <- mi_exports iface

           | used

           = acc

           | otherwise

           = UnusedNames (acc_ns `extendNameSet` n) acc_wcs acc_fs

           where

 warnUnusedImport rdr_env (L loc decl, used, unused, unused_wcs)

   -- Do not warn for 'import M()'

   | Just (Exactly, _) <- ideclImportList decl

   , null unused

   = return ()

   = return ()

   -- Do not warn about import X as Rebindable

   | Just (L _ mod) <- ideclAs decl

   , mod == rEBINDABLE_MOD_NAME

   = return ()

 check this by looking at the names that it brings into scope scope; if there are

 no ununused names, don't report.

 (UI1) We don't want to complain about `import M()`, because that is often used to bring

 Note [Printing minimal imports]

 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

   where

     data_cons = getPossibleDataCons tycon tycon_args

     -- See Note [EmptyDataDecls with Functor, Foldable, and Traversable]

     traverse_bind = mkRdrFunBindEC 2 (nlHsApp pure_Expr)

 nlHsCompose x y = compose_RDR `nlHsApps` [x, y]

 mkMethBinder :: SrcSpan -> RdrName -> LocatedN RdrName

 -- | Make a function binding. If no equations are given, produce a function

 -- with the given arity that produces a stock error.

 mkBindsRep :: DynFlags -> GenericKind -> SrcSpan -> DerivInstTys -> (LHsBinds GhcPs, [LSig GhcPs])

 mkBindsRep dflags gk loc dit@(DerivInstTys{dit_rep_tc = tycon}) = (binds, sigs)

       where

               ++

         -- See Note [Generics performance tricks]

         sigs = if     gopt Opt_InlineGenericsAggressively dflags

                   || (gopt Opt_InlineGenerics dflags && inlining_useful)

                else []

          where

            inlining_useful

                cons       = length datacons

                max_fields = maximum $ 0 :| map dataConSourceArity datacons

                      $ alwaysInlinePragma `setInlinePragmaActivation` activeAfter (Phase 1)

         -- The topmost M1 (the datatype metadata) has the exact same type

         from_matches  = [mkHsCaseAlt pat rhs | (pat,rhs) <- from_alts]

         to_matches    = [mkHsCaseAlt pat rhs | (pat,rhs) <- to_alts  ]

         loc''         = noAnnSrcSpan loc

         datacons      = tyConDataCons tycon

         (from01_RDR, to01_RDR) = case gk of

                                    Gen0 -> (from_RDR,  to_RDR)

                                    Gen1 -> (from1_RDR, to1_RDR)

 import GHC.Internal.Data.Functor.Const (Const(..))

 import GHC.Internal.Data.Typeable (Typeable)

 import GHC.Internal.Data.Data (Data)

 import GHC.Internal.Functor.ZipList (ZipList(..))

 -- $setup

 -- >>> import Prelude

 import GHC.Internal.Data.Data

 import GHC.Internal.TypeLits (KnownNat, natVal)

 import GHC.Internal.Read

 import GHC.Internal.Text.Read.Lex

 import qualified GHC.Internal.TH.Monad as TH

 import qualified GHC.Internal.TH.Lift as TH

 import           GHC.Internal.Data.Semigroup.Internal

 import           GHC.Internal.Control.Monad.Fix

 import           GHC.Internal.Data.Data

 import qualified GHC.Internal.List as List

 import qualified GHC.KnownKeyNames as Rebindable

     ( Eq(..), Ord(..)  -- With their methods

     , Show, Read

     , Functor, fmap, (<$)

     , Monad, (>>), (>>=), return, fail, guard, mfix, join

     , Alternative

     -- Misc

     , seq#

     -- Applicative

     , Ix, range, inRange, index, unsafeIndex, unsafeRangeSize

     -- Data

     , gfoldl, gunfold, toConstr, dataTypeOf, dataCast1, dataCast2

     , mkConstrTag, Constr, mkDataType, DataType, constrIndex

     , Generic(..), Generic1(..)

     , Datatype(..), Constructor(..), Selector(..)

     , U1(..), Par1(..), Rec1(..), K1(..), M1(..)

     -- DataToTag

     , DataToTag

     , Clause, clause

     ) where

 import GHC.Internal.Show

 import GHC.Internal.Read

 import GHC.Internal.Num

 import GHC.Internal.Data.Data

 import GHC.Internal.Data.String( fromString )

 import GHC.Internal.Data.Either( Either(..) )

 import GHC.Internal.Data.Traversable( Traversable, traverse )

 import GHC.Internal.Float( RealFloat )

 import GHC.Internal.IO( seq# )

 import GHC.Internal.Err( error )

 import GHC.Internal.Int( Int8(I8#), Int16(I16#), Int32(I32#), Int64(I64#) )

 import GHC.Internal.Word( Word8(W8#), Word16(W16#), Word32(W32#), Word64(W64#) )

 import GHC.Internal.Unsafe.Coerce( UnsafeEquality(..), unsafeEqualityProof )

 import GHC.Internal.Data.Typeable( gcast1, gcast2 )

 import GHC.Internal.Data.Typeable.Internal as TR

 import GHC.Internal.Bignum.BigNat

 import GHC.Internal.TH.Lift

 import GHC.Internal.TH.Monad

             go []     = z

             go (y:ys) = y `k` go ys

 -- | A list producer that can be fused with 'foldr'.

 -- This function is merely

 --

 import GHC.Internal.Ptr

 import GHC.Internal.Unsafe.Coerce

 import GHC.Internal.Stack (HasCallStack)

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

 -- Boxes

 -- is safe to break things.

 module GHC.Internal.TH.Lib where

 import GHC.Internal.TH.Monad

 #ifdef BOOTSTRAP_TH

 import Control.Applicative(liftA, Applicative(..))

 type FamilyResultSigQ    = Q FamilyResultSig

 type DerivStrategyQ      = Q DerivStrategy

 type TyVarBndrUnit       = TyVarBndr ()

 type TyVarBndrSpec       = TyVarBndr Specificity

 type TyVarBndrVis        = TyVarBndr BndrVis

 -- *   Injectivity annotation

 injectivityAnn :: Name -> [Name] -> InjectivityAnn

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

 -- *   Role

 import GHC.Internal.TH.Syntax

 import GHC.Internal.TH.Monad

 import qualified GHC.Internal.TH.Lib as Lib (litE)

     -- For known-key names

     -- See wrinkle (W4) of Note [Tracking dependencies on primitives]

 import GHC.Generics     ( Generic )

 #else

 -- Compiling with stage1 compiler

 import GHC.Internal.Base hiding( Type, Module )

 import GHC.Internal.Data.Traversable

 import GHC.Internal.Err (error)

 import GHC.Internal.IO.Unsafe

 import GHC.Internal.List (dropWhile, break, replicate, reverse, last)

 import GHC.Internal.Unicode

 #endif

 import GHC.Internal.ForeignSrcLang

 import GHC.Internal.LanguageExtensions