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

\section[Foreign]{Foreign calls}
-}

{-# LANGUAGE DeriveDataTypeable #-}

module ForeignCall (
        ForeignCall(..), isSafeForeignCall,
        Safety(..), playSafe, playInterruptible,

        CExportSpec(..), CLabelString, isCLabelString, pprCLabelString,
        CCallSpec(..),
        CCallTarget(..), isDynamicTarget,
        CCallConv(..), defaultCCallConv, ccallConvToInt, ccallConvAttribute,

        Header(..), CType(..),
    ) where

import GhcPrelude

import FastString
import Binary
import Outputable
import Module
import BasicTypes ( SourceText, pprWithSourceText )

import Data.Char
import Data.Data

{-
************************************************************************
*                                                                      *
\subsubsection{Data types}
*                                                                      *
************************************************************************
-}

newtype ForeignCall = CCall CCallSpec
  deriving Eq

isSafeForeignCall :: ForeignCall -> Bool
isSafeForeignCall (CCall (CCallSpec _ _ safe)) = playSafe safe

-- We may need more clues to distinguish foreign calls
-- but this simple printer will do for now
instance Outputable ForeignCall where
  ppr (CCall cc)  = ppr cc

data Safety
  = PlaySafe            -- Might invoke Haskell GC, or do a call back, or
                        -- switch threads, etc.  So make sure things are
                        -- tidy before the call. Additionally, in the threaded
                        -- RTS we arrange for the external call to be executed
                        -- by a separate OS thread, i.e., _concurrently_ to the
                        -- execution of other Haskell threads.

  | PlayInterruptible   -- Like PlaySafe, but additionally
                        -- the worker thread running this foreign call may
                        -- be unceremoniously killed, so it must be scheduled
                        -- on an unbound thread.

  | PlayRisky           -- None of the above can happen; the call will return
                        -- without interacting with the runtime system at all
  deriving ( Eq, Show, Data )
        -- Show used just for Show Lex.Token, I think

instance Outputable Safety where
  ppr PlaySafe = text "safe"
  ppr PlayInterruptible = text "interruptible"
  ppr PlayRisky = text "unsafe"

playSafe :: Safety -> Bool
playSafe PlaySafe = True
playSafe PlayInterruptible = True
playSafe PlayRisky = False

playInterruptible :: Safety -> Bool
playInterruptible PlayInterruptible = True
playInterruptible _ = False

{-
************************************************************************
*                                                                      *
\subsubsection{Calling C}
*                                                                      *
************************************************************************
-}

data CExportSpec
  = CExportStatic               -- foreign export ccall foo :: ty
        SourceText              -- of the CLabelString.
                                -- See note [Pragma source text] in BasicTypes
        CLabelString            -- C Name of exported function
        CCallConv
  deriving Data

data CCallSpec
  =  CCallSpec  CCallTarget     -- What to call
                CCallConv       -- Calling convention to use.
                Safety
  deriving( Eq )

-- The call target:

-- | How to call a particular function in C-land.
data CCallTarget
  -- An "unboxed" ccall# to named function in a particular package.
  = StaticTarget
        SourceText                -- of the CLabelString.
                                  -- See note [Pragma source text] in BasicTypes
        CLabelString                    -- C-land name of label.

        (Maybe UnitId)              -- What package the function is in.
                                        -- If Nothing, then it's taken to be in the current package.
                                        -- Note: This information is only used for PrimCalls on Windows.
                                        --       See CLabel.labelDynamic and CoreToStg.coreToStgApp
                                        --       for the difference in representation between PrimCalls
                                        --       and ForeignCalls. If the CCallTarget is representing
                                        --       a regular ForeignCall then it's safe to set this to Nothing.

  -- The first argument of the import is the name of a function pointer (an Addr#).
  --    Used when importing a label as "foreign import ccall "dynamic" ..."
        Bool                            -- True => really a function
                                        -- False => a value; only
                                        -- allowed in CAPI imports
  | DynamicTarget

  deriving( Eq, Data )

isDynamicTarget :: CCallTarget -> Bool
isDynamicTarget DynamicTarget = True
isDynamicTarget _             = False

{-
Stuff to do with calling convention:

ccall:          Caller allocates parameters, *and* deallocates them.

stdcall:        Caller allocates parameters, callee deallocates.
                Function name has @N after it, where N is number of arg bytes
                e.g.  _Foo@8. This convention is x86 (win32) specific.

See: http://www.programmersheaven.com/2/Calling-conventions
-}

-- any changes here should be replicated in  the CallConv type in template haskell
data CCallConv = CCallConv | CApiConv | StdCallConv | PrimCallConv | JavaScriptCallConv
  deriving (Eq, Data)

instance Outputable CCallConv where
  ppr StdCallConv = text "stdcall"
  ppr CCallConv   = text "ccall"
  ppr CApiConv    = text "capi"
  ppr PrimCallConv = text "prim"
  ppr JavaScriptCallConv = text "javascript"

defaultCCallConv :: CCallConv
defaultCCallConv = CCallConv

ccallConvToInt :: CCallConv -> Int
ccallConvToInt StdCallConv = 0
ccallConvToInt CCallConv   = 1
ccallConvToInt CApiConv    = panic "ccallConvToInt CApiConv"
ccallConvToInt (PrimCallConv {}) = panic "ccallConvToInt PrimCallConv"
ccallConvToInt JavaScriptCallConv = panic "ccallConvToInt JavaScriptCallConv"

{-
Generate the gcc attribute corresponding to the given
calling convention (used by PprAbsC):
-}

ccallConvAttribute :: CCallConv -> SDoc
ccallConvAttribute StdCallConv       = text "__attribute__((__stdcall__))"
ccallConvAttribute CCallConv         = empty
ccallConvAttribute CApiConv          = empty
ccallConvAttribute (PrimCallConv {}) = panic "ccallConvAttribute PrimCallConv"
ccallConvAttribute JavaScriptCallConv = panic "ccallConvAttribute JavaScriptCallConv"

type CLabelString = FastString          -- A C label, completely unencoded

pprCLabelString :: CLabelString -> SDoc
pprCLabelString lbl = ftext lbl

isCLabelString :: CLabelString -> Bool  -- Checks to see if this is a valid C label
isCLabelString lbl
  = all ok (unpackFS lbl)
  where
    ok c = isAlphaNum c || c == '_' || c == '.'
        -- The '.' appears in e.g. "foo.so" in the
        -- module part of a ExtName.  Maybe it should be separate

-- Printing into C files:

instance Outputable CExportSpec where
  ppr (CExportStatic _ str _) = pprCLabelString str

instance Outputable CCallSpec where
  ppr (CCallSpec fun cconv safety)
    = hcat [ whenPprDebug callconv, ppr_fun fun ]
    where
      callconv = text "{-" <> ppr cconv <> text "-}"

      gc_suf | playSafe safety = text "_GC"
             | otherwise       = empty

      ppr_fun (StaticTarget st _fn mPkgId isFun)
        = text (if isFun then "__pkg_ccall"
                         else "__pkg_ccall_value")
       <> gc_suf
       <+> (case mPkgId of
            Nothing -> empty
            Just pkgId -> ppr pkgId)
       <+> (pprWithSourceText st empty)

      ppr_fun DynamicTarget
        = text "__dyn_ccall" <> gc_suf <+> text "\"\""

-- The filename for a C header file
-- Note [Pragma source text] in BasicTypes
data Header = Header SourceText FastString
    deriving (Eq, Data)

instance Outputable Header where
    ppr (Header st h) = pprWithSourceText st (doubleQuotes $ ppr h)

-- | A C type, used in CAPI FFI calls
--
--  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'{-\# CTYPE'@,
--        'ApiAnnotation.AnnHeader','ApiAnnotation.AnnVal',
--        'ApiAnnotation.AnnClose' @'\#-}'@,

-- For details on above see note [Api annotations] in ApiAnnotation
data CType = CType SourceText -- Note [Pragma source text] in BasicTypes
                   (Maybe Header) -- header to include for this type
                   (SourceText,FastString) -- the type itself
    deriving (Eq, Data)

instance Outputable CType where
    ppr (CType stp mh (stct,ct))
      = pprWithSourceText stp (text "{-# CTYPE") <+> hDoc
        <+> pprWithSourceText stct (doubleQuotes (ftext ct)) <+> text "#-}"
        where hDoc = case mh of
                     Nothing -> empty
                     Just h -> ppr h

{-
************************************************************************
*                                                                      *
\subsubsection{Misc}
*                                                                      *
************************************************************************
-}

instance Binary ForeignCall where
    put_ bh (CCall aa) = put_ bh aa
    get bh = do aa <- get bh; return (CCall aa)

instance Binary Safety where
    put_ bh PlaySafe = do
            putByte bh 0
    put_ bh PlayInterruptible = do
            putByte bh 1
    put_ bh PlayRisky = do
            putByte bh 2
    get bh = do
            h <- getByte bh
            case h of
              0 -> do return PlaySafe
              1 -> do return PlayInterruptible
              _ -> do return PlayRisky

instance Binary CExportSpec where
    put_ bh (CExportStatic ss aa ab) = do
            put_ bh ss
            put_ bh aa
            put_ bh ab
    get bh = do
          ss <- get bh
          aa <- get bh
          ab <- get bh
          return (CExportStatic ss aa ab)

instance Binary CCallSpec where
    put_ bh (CCallSpec aa ab ac) = do
            put_ bh aa
            put_ bh ab
            put_ bh ac
    get bh = do
          aa <- get bh
          ab <- get bh
          ac <- get bh
          return (CCallSpec aa ab ac)

instance Binary CCallTarget where
    put_ bh (StaticTarget ss aa ab ac) = do
            putByte bh 0
            put_ bh ss
            put_ bh aa
            put_ bh ab
            put_ bh ac
    put_ bh DynamicTarget = do
            putByte bh 1
    get bh = do
            h <- getByte bh
            case h of
              0 -> do ss <- get bh
                      aa <- get bh
                      ab <- get bh
                      ac <- get bh
                      return (StaticTarget ss aa ab ac)
              _ -> do return DynamicTarget

instance Binary CCallConv where
    put_ bh CCallConv = do
            putByte bh 0
    put_ bh StdCallConv = do
            putByte bh 1
    put_ bh PrimCallConv = do
            putByte bh 2
    put_ bh CApiConv = do
            putByte bh 3
    put_ bh JavaScriptCallConv = do
            putByte bh 4
    get bh = do
            h <- getByte bh
            case h of
              0 -> do return CCallConv
              1 -> do return StdCallConv
              2 -> do return PrimCallConv
              3 -> do return CApiConv
              _ -> do return JavaScriptCallConv

instance Binary CType where
    put_ bh (CType s mh fs) = do put_ bh s
                                 put_ bh mh
                                 put_ bh fs
    get bh = do s  <- get bh
                mh <- get bh
                fs <- get bh
                return (CType s mh fs)

instance Binary Header where
    put_ bh (Header s h) = put_ bh s >> put_ bh h
    get bh = do s <- get bh
                h <- get bh
                return (Header s h)


{-# LANGUAGE CPP #-}

-- | This is where we define a mapping from Uniques to their associated
-- known-key Names for things associated with tuples and sums. We use this
-- mapping while deserializing known-key Names in interface file symbol tables,
-- which are encoded as their Unique. See Note [Symbol table representation of
-- names] for details.
--

module KnownUniques
    ( -- * Looking up known-key names
      knownUniqueName

      -- * Getting the 'Unique's of 'Name's
      -- ** Anonymous sums
    , mkSumTyConUnique
    , mkSumDataConUnique
      -- ** Tuples
      -- *** Vanilla
    , mkTupleTyConUnique
    , mkTupleDataConUnique
      -- *** Constraint
    , mkCTupleTyConUnique
    , mkCTupleDataConUnique
    ) where

#include "HsVersions.h"

import GhcPrelude

import TysWiredIn
import TyCon
import DataCon
import Id
import BasicTypes
import Outputable
import Unique
import Name
import Util

import Data.Bits
import Data.Maybe

-- | Get the 'Name' associated with a known-key 'Unique'.
knownUniqueName :: Unique -> Maybe Name
knownUniqueName u =
    case tag of
      'z' -> Just $ getUnboxedSumName n
      '4' -> Just $ getTupleTyConName Boxed n
      '5' -> Just $ getTupleTyConName Unboxed n
      '7' -> Just $ getTupleDataConName Boxed n
      '8' -> Just $ getTupleDataConName Unboxed n
      'k' -> Just $ getCTupleTyConName n
      'm' -> Just $ getCTupleDataConUnique n
      _   -> Nothing
  where
    (tag, n) = unpkUnique u

--------------------------------------------------
-- Anonymous sums
--
-- Sum arities start from 2. The encoding is a bit funny: we break up the
-- integral part into bitfields for the arity, an alternative index (which is
-- taken to be 0xff in the case of the TyCon), and, in the case of a datacon, a
-- tag (used to identify the sum's TypeRep binding).
--
-- This layout is chosen to remain compatible with the usual unique allocation
-- for wired-in data constructors described in Unique.hs
--
-- TyCon for sum of arity k:
--   00000000 kkkkkkkk 11111100

-- TypeRep of TyCon for sum of arity k:
--   00000000 kkkkkkkk 11111101
--
-- DataCon for sum of arity k and alternative n (zero-based):
--   00000000 kkkkkkkk nnnnnn00
--
-- TypeRep for sum DataCon of arity k and alternative n (zero-based):
--   00000000 kkkkkkkk nnnnnn10

mkSumTyConUnique :: Arity -> Unique
mkSumTyConUnique arity =
    ASSERT(arity < 0x3f) -- 0x3f since we only have 6 bits to encode the
                         -- alternative
    mkUnique 'z' (arity `shiftL` 8 .|. 0xfc)

mkSumDataConUnique :: ConTagZ -> Arity -> Unique
mkSumDataConUnique alt arity
  | alt >= arity
  = panic ("mkSumDataConUnique: " ++ show alt ++ " >= " ++ show arity)
  | otherwise
  = mkUnique 'z' (arity `shiftL` 8 + alt `shiftL` 2) {- skip the tycon -}

getUnboxedSumName :: Int -> Name
getUnboxedSumName n
  | n .&. 0xfc == 0xfc
  = case tag of
      0x0 -> tyConName $ sumTyCon arity
      0x1 -> getRep $ sumTyCon arity
      _   -> pprPanic "getUnboxedSumName: invalid tag" (ppr tag)
  | tag == 0x0
  = dataConName $ sumDataCon (alt + 1) arity
  | tag == 0x1
  = getName $ dataConWrapId $ sumDataCon (alt + 1) arity
  | tag == 0x2
  = getRep $ promoteDataCon $ sumDataCon (alt + 1) arity
  | otherwise
  = pprPanic "getUnboxedSumName" (ppr n)
  where
    arity = n `shiftR` 8
    alt = (n .&. 0xfc) `shiftR` 2
    tag = 0x3 .&. n
    getRep tycon =
        fromMaybe (pprPanic "getUnboxedSumName(getRep)" (ppr tycon))
        $ tyConRepName_maybe tycon

-- Note [Uniques for tuple type and data constructors]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
--
-- Wired-in type constructor keys occupy *two* slots:
--    * u: the TyCon itself
--    * u+1: the TyConRepName of the TyCon
--
-- Wired-in tuple data constructor keys occupy *three* slots:
--    * u: the DataCon itself
--    * u+1: its worker Id
--    * u+2: the TyConRepName of the promoted TyCon

--------------------------------------------------
-- Constraint tuples

mkCTupleTyConUnique :: Arity -> Unique
mkCTupleTyConUnique a = mkUnique 'k' (2*a)

mkCTupleDataConUnique :: Arity -> Unique
mkCTupleDataConUnique a = mkUnique 'm' (3*a)

getCTupleTyConName :: Int -> Name
getCTupleTyConName n =
    case n `divMod` 2 of
      (arity, 0) -> cTupleTyConName arity
      (arity, 1) -> mkPrelTyConRepName $ cTupleTyConName arity
      _          -> panic "getCTupleTyConName: impossible"

getCTupleDataConUnique :: Int -> Name
getCTupleDataConUnique n =
    case n `divMod` 3 of
      (arity,  0) -> cTupleDataConName arity
      (_arity, 1) -> panic "getCTupleDataConName: no worker"
      (arity,  2) -> mkPrelTyConRepName $ cTupleDataConName arity
      _           -> panic "getCTupleDataConName: impossible"

--------------------------------------------------
-- Normal tuples

mkTupleDataConUnique :: Boxity -> Arity -> Unique
mkTupleDataConUnique Boxed          a = mkUnique '7' (3*a)    -- may be used in C labels
mkTupleDataConUnique Unboxed        a = mkUnique '8' (3*a)

mkTupleTyConUnique :: Boxity -> Arity -> Unique
mkTupleTyConUnique Boxed           a  = mkUnique '4' (2*a)
mkTupleTyConUnique Unboxed         a  = mkUnique '5' (2*a)

getTupleTyConName :: Boxity -> Int -> Name
getTupleTyConName boxity n =
    case n `divMod` 2 of
      (arity, 0) -> tyConName $ tupleTyCon boxity arity
      (arity, 1) -> fromMaybe (panic "getTupleTyConName")
                    $ tyConRepName_maybe $ tupleTyCon boxity arity
      _          -> panic "getTupleTyConName: impossible"

getTupleDataConName :: Boxity -> Int -> Name
getTupleDataConName boxity n =
    case n `divMod` 3 of
      (arity, 0) -> dataConName $ tupleDataCon boxity arity
      (arity, 1) -> idName $ dataConWorkId $ tupleDataCon boxity arity
      (arity, 2) -> fromMaybe (panic "getTupleDataCon")
                    $ tyConRepName_maybe $ promotedTupleDataCon boxity arity
      _          -> panic "getTupleDataConName: impossible"


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

-}

{-# LANGUAGE CPP #-}

-- | The @PrelInfo@ interface to the compiler's prelude knowledge.
--
-- This module serves as the central gathering point for names which the
-- compiler knows something about. This includes functions for,
--
--  * discerning whether a 'Name' is known-key
--
--  * given a 'Unique', looking up its corresponding known-key 'Name'
--
-- See Note [Known-key names] and Note [About wired-in things] for information
-- about the two types of prelude things in GHC.
--
module PrelInfo (
        -- * Known-key names
        isKnownKeyName,
        lookupKnownKeyName,
        lookupKnownNameInfo,

        -- ** Internal use
        -- | 'knownKeyNames' is exported to seed the original name cache only;
        -- if you find yourself wanting to look at it you might consider using
        -- 'lookupKnownKeyName' or 'isKnownKeyName'.
        knownKeyNames,

        -- * Miscellaneous
        wiredInIds, ghcPrimIds,
        primOpRules, builtinRules,

        ghcPrimExports,
        primOpId,

        -- * Random other things
        maybeCharLikeCon, maybeIntLikeCon,

        -- * Class categories
        isNumericClass, isStandardClass

    ) where

#include "HsVersions.h"

import GhcPrelude

import KnownUniques
import Unique           ( isValidKnownKeyUnique )

import ConLike          ( ConLike(..) )
import THNames          ( templateHaskellNames )
import PrelNames
import PrelRules
import Avail
import PrimOp
import DataCon
import Id
import Name
import NameEnv
import MkId
import Outputable
import TysPrim
import TysWiredIn
import HscTypes
import Class
import TyCon
import UniqFM
import Util
import TcTypeNats ( typeNatTyCons )

import Control.Applicative ((<|>))
import Data.List        ( intercalate )
import Data.Array
import Data.Maybe

{-
************************************************************************
*                                                                      *
\subsection[builtinNameInfo]{Lookup built-in names}
*                                                                      *
************************************************************************

Note [About wired-in things]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~
* Wired-in things are Ids\/TyCons that are completely known to the compiler.
  They are global values in GHC, (e.g.  listTyCon :: TyCon).

* A wired in Name contains the thing itself inside the Name:
        see Name.wiredInNameTyThing_maybe
  (E.g. listTyConName contains listTyCon.

* The name cache is initialised with (the names of) all wired-in things
  (except tuples and sums; see Note [Known-])

* The type environment itself contains no wired in things. The type
  checker sees if the Name is wired in before looking up the name in
  the type environment.

* MkIface prunes out wired-in things before putting them in an interface file.
  So interface files never contain wired-in things.
-}

-- | This list is used to ensure that when you say "Prelude.map" in your source
-- code, or in an interface file, you get a Name with the correct known key (See
-- Note [Known-key names] in PrelNames)
knownKeyNames :: [Name]
knownKeyNames
  | debugIsOn
  , Just badNamesStr <- knownKeyNamesOkay all_names
  = panic ("badAllKnownKeyNames:\n" ++ badNamesStr)
       -- NB: We can't use ppr here, because this is sometimes evaluated in a
       -- context where there are no DynFlags available, leading to a cryptic
       -- "<<details unavailable>>" error. (This seems to happen only in the
       -- stage 2 compiler, for reasons I [Richard] have no clue of.)
  | otherwise
  = all_names
  where
    all_names =
      concat [ wired_tycon_kk_names funTyCon
             , concatMap wired_tycon_kk_names primTyCons

             , concatMap wired_tycon_kk_names wiredInTyCons
               -- Does not include tuples

             , concatMap wired_tycon_kk_names typeNatTyCons

             , map idName wiredInIds
             , map (idName . primOpId) allThePrimOps
             , basicKnownKeyNames
             , templateHaskellNames
             ]
    -- All of the names associated with a wired-in TyCon.
    -- This includes the TyCon itself, its DataCons and promoted TyCons.
    wired_tycon_kk_names :: TyCon -> [Name]
    wired_tycon_kk_names tc =
        tyConName tc : (rep_names tc ++ implicits)
      where implicits = concatMap thing_kk_names (implicitTyConThings tc)

    wired_datacon_kk_names :: DataCon -> [Name]
    wired_datacon_kk_names dc =
      dataConName dc : rep_names (promoteDataCon dc)

    thing_kk_names :: TyThing -> [Name]
    thing_kk_names (ATyCon tc)                 = wired_tycon_kk_names tc
    thing_kk_names (AConLike (RealDataCon dc)) = wired_datacon_kk_names dc
    thing_kk_names thing                       = [getName thing]

    -- The TyConRepName for a known-key TyCon has a known key,
    -- but isn't itself an implicit thing.  Yurgh.
    -- NB: if any of the wired-in TyCons had record fields, the record
    --     field names would be in a similar situation.  Ditto class ops.
    --     But it happens that there aren't any
    rep_names tc = case tyConRepName_maybe tc of
                        Just n  -> [n]
                        Nothing -> []

-- | Check the known-key names list of consistency.
knownKeyNamesOkay :: [Name] -> Maybe String
knownKeyNamesOkay all_names
  | ns@(_:_) <- filter (not . isValidKnownKeyUnique . getUnique) all_names
  = Just $ "    Out-of-range known-key uniques: ["
        ++ intercalate ", " (map (occNameString . nameOccName) ns) ++
         "]"
  | null badNamesPairs
  = Nothing
  | otherwise
  = Just badNamesStr
  where
    namesEnv      = foldl' (\m n -> extendNameEnv_Acc (:) singleton m n n)
                           emptyUFM all_names
    badNamesEnv   = filterNameEnv (\ns -> ns `lengthExceeds` 1) namesEnv
    badNamesPairs = nonDetUFMToList badNamesEnv
      -- It's OK to use nonDetUFMToList here because the ordering only affects
      -- the message when we get a panic
    badNamesStrs  = map pairToStr badNamesPairs
    badNamesStr   = unlines badNamesStrs

    pairToStr (uniq, ns) = "        " ++
                           show uniq ++
                           ": [" ++
                           intercalate ", " (map (occNameString . nameOccName) ns) ++
                           "]"

-- | Given a 'Unique' lookup its associated 'Name' if it corresponds to a
-- known-key thing.
lookupKnownKeyName :: Unique -> Maybe Name
lookupKnownKeyName u =
    knownUniqueName u <|> lookupUFM knownKeysMap u

-- | Is a 'Name' known-key?
isKnownKeyName :: Name -> Bool
isKnownKeyName n =
    isJust (knownUniqueName $ nameUnique n) || elemUFM n knownKeysMap

knownKeysMap :: UniqFM Name
knownKeysMap = listToUFM [ (nameUnique n, n) | n <- knownKeyNames ]

-- | Given a 'Unique' lookup any associated arbitrary SDoc's to be displayed by
-- GHCi's ':info' command.
lookupKnownNameInfo :: Name -> SDoc
lookupKnownNameInfo name = case lookupNameEnv knownNamesInfo name of
    -- If we do find a doc, we add comment delimeters to make the output
    -- of ':info' valid Haskell.
    Nothing  -> empty
    Just doc -> vcat [text "{-", doc, text "-}"]

-- A map from Uniques to SDocs, used in GHCi's ':info' command. (#12390)
knownNamesInfo :: NameEnv SDoc
knownNamesInfo = unitNameEnv coercibleTyConName $
    vcat [ text "Coercible is a special constraint with custom solving rules."
         , text "It is not a class."
         , text "Please see section 9.14.4 of the user's guide for details." ]

{-
We let a lot of "non-standard" values be visible, so that we can make
sense of them in interface pragmas. It's cool, though they all have
"non-standard" names, so they won't get past the parser in user code.

************************************************************************
*                                                                      *
                PrimOpIds
*                                                                      *
************************************************************************
-}

primOpIds :: Array Int Id
-- A cache of the PrimOp Ids, indexed by PrimOp tag
primOpIds = array (1,maxPrimOpTag) [ (primOpTag op, mkPrimOpId op)
                                   | op <- allThePrimOps ]

primOpId :: PrimOp -> Id
primOpId op = primOpIds ! primOpTag op

{-
************************************************************************
*                                                                      *
            Export lists for pseudo-modules (GHC.Prim)
*                                                                      *
************************************************************************

GHC.Prim "exports" all the primops and primitive types, some
wired-in Ids.
-}

ghcPrimExports :: [IfaceExport]
ghcPrimExports
 = map (avail . idName) ghcPrimIds ++
   map (avail . idName . primOpId) allThePrimOps ++
   [ AvailTC n [n] []
   | tc <- funTyCon : exposedPrimTyCons, let n = tyConName tc  ]

{-
************************************************************************
*                                                                      *
            Built-in keys
*                                                                      *
************************************************************************

ToDo: make it do the ``like'' part properly (as in 0.26 and before).
-}

maybeCharLikeCon, maybeIntLikeCon :: DataCon -> Bool
maybeCharLikeCon con = con `hasKey` charDataConKey
maybeIntLikeCon  con = con `hasKey` intDataConKey

{-
************************************************************************
*                                                                      *
            Class predicates
*                                                                      *
************************************************************************
-}

isNumericClass, isStandardClass :: Class -> Bool

isNumericClass     clas = classKey clas `is_elem` numericClassKeys
isStandardClass    clas = classKey clas `is_elem` standardClassKeys

is_elem :: Eq a => a -> [a] -> Bool
is_elem = isIn "is_X_Class"