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

-}

{-# LANGUAGE CPP #-}

-- | 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,
        primOpRules, builtinRules,

        ghcPrimExports,
        ghcPrimDeclDocs,
        primOpId,

        -- * Random other things
        maybeCharLikeCon, maybeIntLikeCon,

        -- * Class categories
        isNumericClass, isStandardClass

    ) where

#include "HsVersions.h"

import GHC.Prelude

import GHC.Builtin.Uniques
import GHC.Builtin.PrimOps
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.Opt.ConstantFold
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.TyThing
import GHC.Types.Unique ( isValidKnownKeyUnique )

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

import Control.Applicative ((<|>))
import Data.List        ( intercalate , find )
import Data.Array
import Data.Maybe
import qualified Data.Map as Map

{-
************************************************************************
*                                                                      *
\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 String
badNamesStr <- [Name] -> Maybe String
knownKeyNamesOkay [Name]
all_names
  = String -> [Name]
forall a. String -> a
panic (String
"badAllKnownKeyNames:\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
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.)
  | 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
             , (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
primOpId) [PrimOp]
allThePrimOps
             , (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 String
knownKeyNamesOkay :: [Name] -> Maybe String
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
  = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String
"    Out-of-range known-key uniques: ["
        String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((Name -> String) -> [Name] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (OccName -> String
occNameString (OccName -> String) -> (Name -> OccName) -> Name -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> OccName
nameOccName) [Name]
ns) String -> String -> String
forall a. [a] -> [a] -> [a]
++
         String
"]"
  | [(Unique, [Name])] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Unique, [Name])]
badNamesPairs
  = Maybe String
forall a. Maybe a
Nothing
  | Bool
otherwise
  = String -> Maybe String
forall a. a -> Maybe a
Just String
badNamesStr
  where
    namesEnv :: NameEnv [Name]
namesEnv      = (NameEnv [Name] -> Name -> NameEnv [Name])
-> NameEnv [Name] -> [Name] -> NameEnv [Name]
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 key 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 key 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
    badNamesStrs :: [String]
badNamesStrs  = ((Unique, [Name]) -> String) -> [(Unique, [Name])] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Unique, [Name]) -> String
forall {a}. Show a => (a, [Name]) -> String
pairToStr [(Unique, [Name])]
badNamesPairs
    badNamesStr :: String
badNamesStr   = [String] -> String
unlines [String]
badNamesStrs

    pairToStr :: (a, [Name]) -> String
pairToStr (a
uniq, [Name]
ns) = String
"        " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                           a -> String
forall a. Show a => a -> String
show a
uniq String -> String -> String
forall a. [a] -> [a] -> [a]
++
                           String
": [" String -> String -> String
forall a. [a] -> [a] -> [a]
++
                           String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((Name -> String) -> [Name] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (OccName -> String
occNameString (OccName -> String) -> (Name -> OccName) -> Name -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> OccName
nameOccName) [Name]
ns) String -> String -> String
forall a. [a] -> [a] -> [a]
++
                           String
"]"

-- | 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 (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> UniqFM Name Name -> Unique -> Maybe Name
forall key 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
empty
    Just SDoc
doc -> [SDoc] -> SDoc
vcat [String -> SDoc
text String
"{-", SDoc
doc, String -> SDoc
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
vcat [ String -> SDoc
text String
"Coercible is a special constraint with custom solving rules."
         , String -> SDoc
text String
"It is not a class."
         , String -> SDoc
text String
"Please see section `The Coercible constraint`"
         , String -> SDoc
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.

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

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

primOpId :: PrimOp -> Id
primOpId :: PrimOp -> Id
primOpId PrimOp
op = Array Int Id
primOpIds Array Int Id -> Int -> Id
forall i e. Ix i => Array i e -> i -> e
! PrimOp -> Int
primOpTag PrimOp
op

{-
************************************************************************
*                                                                      *
            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]
++
   (PrimOp -> IfaceExport) -> [PrimOp] -> [IfaceExport]
forall a b. (a -> b) -> [a] -> [b]
map (Name -> IfaceExport
avail (Name -> IfaceExport) -> (PrimOp -> Name) -> PrimOp -> IfaceExport
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Id -> Name
idName (Id -> Name) -> (PrimOp -> Id) -> PrimOp -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrimOp -> Id
primOpId) [PrimOp]
allThePrimOps [IfaceExport] -> [IfaceExport] -> [IfaceExport]
forall a. [a] -> [a] -> [a]
++
   [ Name -> [Name] -> [FieldLabel] -> IfaceExport
availTC Name
n [Name
n] []
   | TyCon
tc <- [TyCon]
exposedPrimTyCons, let n :: Name
n = TyCon -> Name
tyConName TyCon
tc  ]

ghcPrimDeclDocs :: DeclDocMap
ghcPrimDeclDocs :: DeclDocMap
ghcPrimDeclDocs = Map Name HsDocString -> DeclDocMap
DeclDocMap (Map Name HsDocString -> DeclDocMap)
-> Map Name HsDocString -> DeclDocMap
forall a b. (a -> b) -> a -> b
$ [(Name, HsDocString)] -> Map Name HsDocString
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Name, HsDocString)] -> Map Name HsDocString)
-> [(Name, HsDocString)] -> Map Name HsDocString
forall a b. (a -> b) -> a -> b
$ ((String, String) -> Maybe (Name, HsDocString))
-> [(String, String)] -> [(Name, HsDocString)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (String, String) -> Maybe (Name, HsDocString)
findName [(String, String)]
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]
++
            (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
primOpId) [PrimOp]
allThePrimOps [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, HsDocString)
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, HsDocString) -> Maybe (Name, HsDocString)
forall a. a -> Maybe a
Just (Name
name, String -> HsDocString
mkHsDocString String
doc)
      | Bool
otherwise = Maybe (Name, HsDocString)
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"