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

-}



-- | The @GHC.Builtin.Utils@ 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 GHC.Builtin.Utils (
        -- * 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,

        ghcPrimExports,
        ghcPrimDeclDocs,

        -- * Random other things
        maybeCharLikeCon, maybeIntLikeCon,

        -- * Class categories
        isNumericClass, isStandardClass

    ) where

import GHC.Prelude

import GHC.Builtin.Uniques
import GHC.Builtin.PrimOps
import GHC.Builtin.PrimOps.Ids
import GHC.Builtin.Types
import GHC.Builtin.Types.Literals ( typeNatTyCons )
import GHC.Builtin.Types.Prim
import GHC.Builtin.Names.TH ( templateHaskellNames )
import GHC.Builtin.Names

import GHC.Core.ConLike ( ConLike(..) )
import GHC.Core.DataCon
import GHC.Core.Class
import GHC.Core.TyCon

import GHC.Types.Avail
import GHC.Types.Id
import GHC.Types.Name
import GHC.Types.Name.Env
import GHC.Types.Id.Make
import GHC.Types.Unique.FM
import GHC.Types.Unique.Map
import GHC.Types.TyThing
import GHC.Types.Unique ( isValidKnownKeyUnique, pprUniqueAlways )

import GHC.Utils.Outputable
import GHC.Utils.Misc as Utils
import GHC.Utils.Panic
import GHC.Utils.Constants (debugIsOn)
import GHC.Hs.Doc
import GHC.Unit.Module.ModIface (IfaceExport)

import GHC.Data.List.SetOps

import Control.Applicative ((<|>))
import Data.List        ( find )
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 [Infinite families of known-key names])

* 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.

* GHC.Iface.Make 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 "GHC.Builtin.Names")
knownKeyNames :: [Name]
knownKeyNames :: [Name]
knownKeyNames
  | Bool
debugIsOn
  , Just SDoc
badNamesDoc <- [Name] -> Maybe SDoc
knownKeyNamesOkay [Name]
all_names
  = String -> SDoc -> [Name]
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"badAllKnownKeyNames" SDoc
badNamesDoc
  | Bool
otherwise
  = [Name]
all_names
  where
    all_names :: [Name]
all_names =
      [[Name]] -> [Name]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ (TyCon -> [Name]) -> [TyCon] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap TyCon -> [Name]
wired_tycon_kk_names [TyCon]
primTyCons
             , (TyCon -> [Name]) -> [TyCon] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap TyCon -> [Name]
wired_tycon_kk_names [TyCon]
wiredInTyCons
             , (TyCon -> [Name]) -> [TyCon] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap TyCon -> [Name]
wired_tycon_kk_names [TyCon]
typeNatTyCons
             , (Id -> Name) -> [Id] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map Id -> Name
idName [Id]
wiredInIds
             , (Id -> Name) -> [Id] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map Id -> Name
idName [Id]
allThePrimOpIds
             , (PrimOp -> Name) -> [PrimOp] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (Id -> Name
idName (Id -> Name) -> (PrimOp -> Id) -> PrimOp -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrimOp -> Id
primOpWrapperId) [PrimOp]
allThePrimOps
             , [Name]
basicKnownKeyNames
             , [Name]
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 :: TyCon -> [Name]
wired_tycon_kk_names TyCon
tc =
        TyCon -> Name
tyConName TyCon
tc Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
: (TyCon -> [Name]
rep_names TyCon
tc [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ [Name]
implicits)
      where implicits :: [Name]
implicits = (TyThing -> [Name]) -> [TyThing] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap TyThing -> [Name]
thing_kk_names (TyCon -> [TyThing]
implicitTyConThings TyCon
tc)

    wired_datacon_kk_names :: DataCon -> [Name]
    wired_datacon_kk_names :: DataCon -> [Name]
wired_datacon_kk_names DataCon
dc =
      DataCon -> Name
dataConName DataCon
dc Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
: TyCon -> [Name]
rep_names (DataCon -> TyCon
promoteDataCon DataCon
dc)

    thing_kk_names :: TyThing -> [Name]
    thing_kk_names :: TyThing -> [Name]
thing_kk_names (ATyCon TyCon
tc)                 = TyCon -> [Name]
wired_tycon_kk_names TyCon
tc
    thing_kk_names (AConLike (RealDataCon DataCon
dc)) = DataCon -> [Name]
wired_datacon_kk_names DataCon
dc
    thing_kk_names TyThing
thing                       = [TyThing -> Name
forall a. NamedThing a => a -> Name
getName TyThing
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 :: TyCon -> [Name]
rep_names TyCon
tc = case TyCon -> Maybe Name
tyConRepName_maybe TyCon
tc of
                        Just Name
n  -> [Name
n]
                        Maybe Name
Nothing -> []

-- | Check the known-key names list of consistency.
knownKeyNamesOkay :: [Name] -> Maybe SDoc
knownKeyNamesOkay :: [Name] -> Maybe SDoc
knownKeyNamesOkay [Name]
all_names
  | ns :: [Name]
ns@(Name
_:[Name]
_) <- (Name -> Bool) -> [Name] -> [Name]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Name -> Bool) -> Name -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Unique -> Bool
isValidKnownKeyUnique (Unique -> Bool) -> (Name -> Unique) -> Name -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Unique
forall a. Uniquable a => a -> Unique
getUnique) [Name]
all_names
  = SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just (SDoc -> Maybe SDoc) -> SDoc -> Maybe SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"    Out-of-range known-key uniques: " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<>
           SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
brackets ((Name -> SDoc) -> [Name] -> SDoc
forall a. (a -> SDoc) -> [a] -> SDoc
pprWithCommas (OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr (OccName -> SDoc) -> (Name -> OccName) -> Name -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> OccName
nameOccName) [Name]
ns)
  | [(Unique, [Name])] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Unique, [Name])]
badNamesPairs
  = Maybe SDoc
forall a. Maybe a
Nothing
  | Bool
otherwise
  = SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just SDoc
badNamesDoc
  where
    namesEnv :: NameEnv [Name]
namesEnv      = (NameEnv [Name] -> Name -> NameEnv [Name])
-> NameEnv [Name] -> [Name] -> NameEnv [Name]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\NameEnv [Name]
m Name
n -> (Name -> [Name] -> [Name])
-> (Name -> [Name])
-> NameEnv [Name]
-> Name
-> Name
-> NameEnv [Name]
forall a b.
(a -> b -> b) -> (a -> b) -> NameEnv b -> Name -> a -> NameEnv b
extendNameEnv_Acc (:) Name -> [Name]
forall a. a -> [a]
Utils.singleton NameEnv [Name]
m Name
n Name
n)
                           NameEnv [Name]
forall {k} (key :: k) elt. UniqFM key elt
emptyUFM [Name]
all_names
    badNamesEnv :: NameEnv [Name]
badNamesEnv   = ([Name] -> Bool) -> NameEnv [Name] -> NameEnv [Name]
forall elt. (elt -> Bool) -> NameEnv elt -> NameEnv elt
filterNameEnv (\[Name]
ns -> [Name]
ns [Name] -> Int -> Bool
forall a. [a] -> Int -> Bool
`lengthExceeds` Int
1) NameEnv [Name]
namesEnv
    badNamesPairs :: [(Unique, [Name])]
badNamesPairs = NameEnv [Name] -> [(Unique, [Name])]
forall {k} (key :: k) elt. UniqFM key elt -> [(Unique, elt)]
nonDetUFMToList NameEnv [Name]
badNamesEnv
      -- It's OK to use nonDetUFMToList here because the ordering only affects
      -- the message when we get a panic
    badNamesDoc :: SDoc
    badNamesDoc :: SDoc
badNamesDoc  = [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ ((Unique, [Name]) -> SDoc) -> [(Unique, [Name])] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (Unique, [Name]) -> SDoc
pairToDoc [(Unique, [Name])]
badNamesPairs

    pairToDoc :: (Unique, [Name]) -> SDoc
    pairToDoc :: (Unique, [Name]) -> SDoc
pairToDoc (Unique
uniq, [Name]
ns) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"        " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<>
                           Unique -> SDoc
forall doc. IsLine doc => Unique -> doc
pprUniqueAlways Unique
uniq SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<>
                           String -> SDoc
forall doc. IsLine doc => String -> doc
text String
": " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<>
                           SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
brackets ((Name -> SDoc) -> [Name] -> SDoc
forall a. (a -> SDoc) -> [a] -> SDoc
pprWithCommas (OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr (OccName -> SDoc) -> (Name -> OccName) -> Name -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> OccName
nameOccName) [Name]
ns)

-- | Given a 'Unique' lookup its associated 'Name' if it corresponds to a
-- known-key thing.
lookupKnownKeyName :: Unique -> Maybe Name
lookupKnownKeyName :: Unique -> Maybe Name
lookupKnownKeyName Unique
u =
    Unique -> Maybe Name
knownUniqueName Unique
u Maybe Name -> Maybe Name -> Maybe Name
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> UniqFM Name Name -> Unique -> Maybe Name
forall {k} (key :: k) elt. UniqFM key elt -> Unique -> Maybe elt
lookupUFM_Directly UniqFM Name Name
knownKeysMap Unique
u

-- | Is a 'Name' known-key?
isKnownKeyName :: Name -> Bool
isKnownKeyName :: Name -> Bool
isKnownKeyName Name
n =
    Maybe Name -> Bool
forall a. Maybe a -> Bool
isJust (Unique -> Maybe Name
knownUniqueName (Unique -> Maybe Name) -> Unique -> Maybe Name
forall a b. (a -> b) -> a -> b
$ Name -> Unique
nameUnique Name
n) Bool -> Bool -> Bool
|| Name -> UniqFM Name Name -> Bool
forall key elt. Uniquable key => key -> UniqFM key elt -> Bool
elemUFM Name
n UniqFM Name Name
knownKeysMap

-- | Maps 'Unique's to known-key names.
--
-- The type is @UniqFM Name Name@ to denote that the 'Unique's used
-- in the domain are 'Unique's associated with 'Name's (as opposed
-- to some other namespace of 'Unique's).
knownKeysMap :: UniqFM Name Name
knownKeysMap :: UniqFM Name Name
knownKeysMap = [Name] -> UniqFM Name Name
forall key. Uniquable key => [key] -> UniqFM key key
listToIdentityUFM [Name]
knownKeyNames

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

-- A map from Uniques to SDocs, used in GHCi's ':info' command. (#12390)
knownNamesInfo :: NameEnv SDoc
knownNamesInfo :: NameEnv SDoc
knownNamesInfo = Name -> SDoc -> NameEnv SDoc
forall a. Name -> a -> NameEnv a
unitNameEnv Name
coercibleTyConName (SDoc -> NameEnv SDoc) -> SDoc -> NameEnv SDoc
forall a b. (a -> b) -> a -> b
$
    [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Coercible is a special constraint with custom solving rules."
         , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"It is not a class."
         , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Please see section `The Coercible constraint`"
         , String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"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.
-}

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

ghcPrimExports :: [IfaceExport]
ghcPrimExports :: [IfaceExport]
ghcPrimExports
 = (Id -> IfaceExport) -> [Id] -> [IfaceExport]
forall a b. (a -> b) -> [a] -> [b]
map (Name -> IfaceExport
Avail (Name -> IfaceExport) -> (Id -> Name) -> Id -> IfaceExport
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Id -> Name
idName) [Id]
ghcPrimIds [IfaceExport] -> [IfaceExport] -> [IfaceExport]
forall a. [a] -> [a] -> [a]
++
   (Id -> IfaceExport) -> [Id] -> [IfaceExport]
forall a b. (a -> b) -> [a] -> [b]
map (Name -> IfaceExport
Avail (Name -> IfaceExport) -> (Id -> Name) -> Id -> IfaceExport
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Id -> Name
idName) [Id]
allThePrimOpIds [IfaceExport] -> [IfaceExport] -> [IfaceExport]
forall a. [a] -> [a] -> [a]
++
   [ Name -> [Name] -> IfaceExport
AvailTC Name
n [Name
n]
   | TyCon
tc <- [TyCon]
exposedPrimTyCons, let n :: Name
n = TyCon -> Name
tyConName TyCon
tc ]

ghcPrimDeclDocs :: Docs
ghcPrimDeclDocs :: Docs
ghcPrimDeclDocs = Docs
emptyDocs { docs_decls = listToUniqMap $ mapMaybe findName primOpDocs }
  where
    names :: [Name]
names = (Id -> Name) -> [Id] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map Id -> Name
idName [Id]
ghcPrimIds [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++
            (Id -> Name) -> [Id] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map Id -> Name
idName [Id]
allThePrimOpIds [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++
            (TyCon -> Name) -> [TyCon] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map TyCon -> Name
tyConName [TyCon]
exposedPrimTyCons
    findName :: (String, String)
-> Maybe (Name, [WithHsDocIdentifiers HsDocString pass])
findName (String
nameStr, String
doc)
      | Just Name
name <- (Name -> Bool) -> [Name] -> Maybe Name
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((String
nameStr String -> String -> Bool
forall a. Eq a => a -> a -> Bool
==) (String -> Bool) -> (Name -> String) -> Name -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> String
forall a. NamedThing a => a -> String
getOccString) [Name]
names
      = (Name, [WithHsDocIdentifiers HsDocString pass])
-> Maybe (Name, [WithHsDocIdentifiers HsDocString pass])
forall a. a -> Maybe a
Just (Name
name, [HsDocString
-> [Located (IdP pass)] -> WithHsDocIdentifiers HsDocString pass
forall a pass.
a -> [Located (IdP pass)] -> WithHsDocIdentifiers a pass
WithHsDocIdentifiers (String -> HsDocString
mkGeneratedHsDocString String
doc) []])
      | Bool
otherwise = Maybe (Name, [WithHsDocIdentifiers HsDocString pass])
forall a. Maybe a
Nothing

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

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

maybeCharLikeCon, maybeIntLikeCon :: DataCon -> Bool
maybeCharLikeCon :: DataCon -> Bool
maybeCharLikeCon DataCon
con = DataCon
con DataCon -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
charDataConKey
maybeIntLikeCon :: DataCon -> Bool
maybeIntLikeCon  DataCon
con = DataCon
con DataCon -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
intDataConKey

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

isNumericClass, isStandardClass :: Class -> Bool

isNumericClass :: Class -> Bool
isNumericClass     Class
clas = Class -> Unique
classKey Class
clas Unique -> [Unique] -> Bool
forall a. Eq a => a -> [a] -> Bool
`is_elem` [Unique]
numericClassKeys
isStandardClass :: Class -> Bool
isStandardClass    Class
clas = Class -> Unique
classKey Class
clas Unique -> [Unique] -> Bool
forall a. Eq a => a -> [a] -> Bool
`is_elem` [Unique]
standardClassKeys

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