{-# LANGUAGE CPP #-}
module GHC.Builtin.Utils (
isKnownKeyName,
lookupKnownKeyName,
lookupKnownNameInfo,
knownKeyNames,
wiredInIds, ghcPrimIds,
primOpRules, builtinRules,
ghcPrimExports,
ghcPrimDeclDocs,
primOpId,
maybeCharLikeCon, maybeIntLikeCon,
isNumericClass, isStandardClass
) where
#include "HsVersions.h"
import GHC.Prelude
import GHC.Builtin.Uniques
import GHC.Types.Unique ( isValidKnownKeyUnique )
import GHC.Core.ConLike ( ConLike(..) )
import GHC.Builtin.Names.TH ( templateHaskellNames )
import GHC.Builtin.Names
import GHC.Core.Opt.ConstantFold
import GHC.Types.Avail
import GHC.Builtin.PrimOps
import GHC.Core.DataCon
import GHC.Types.Basic
import GHC.Types.Id
import GHC.Types.Name
import GHC.Types.Name.Env
import GHC.Types.Id.Make
import GHC.Utils.Outputable
import GHC.Builtin.Types.Prim
import GHC.Builtin.Types
import GHC.Driver.Types
import GHC.Core.Class
import GHC.Core.TyCon
import GHC.Types.Unique.FM
import GHC.Utils.Misc
import GHC.Builtin.Types.Literals ( typeNatTyCons )
import GHC.Hs.Doc
import Control.Applicative ((<|>))
import Data.List ( intercalate , find )
import Data.Array
import Data.Maybe
import qualified Data.Map as Map
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)
| Bool
otherwise
= [Name]
all_names
where
all_names :: [Name]
all_names =
TupleSort -> Int -> Name
tupleTyConName TupleSort
BoxedTuple Int
1 Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
: Boxity -> Int -> Name
tupleDataConName Boxity
Boxed Int
1 Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
:
[[Name]] -> [Name]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
External instance of the constraint type Foldable []
concat [ TyCon -> [Name]
wired_tycon_kk_names TyCon
funTyCon
, (TyCon -> [Name]) -> [TyCon] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
External instance of the constraint type Foldable []
concatMap TyCon -> [Name]
wired_tycon_kk_names [TyCon]
primTyCons
, (TyCon -> [Name]) -> [TyCon] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
External instance of the constraint type Foldable []
concatMap TyCon -> [Name]
wired_tycon_kk_names [TyCon]
wiredInTyCons
, (TyCon -> [Name]) -> [TyCon] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
External instance of the constraint type Foldable []
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
]
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]
External instance of the constraint type Foldable []
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
External instance of the constraint type NamedThing TyThing
getName TyThing
thing]
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 -> []
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
External instance of the constraint type Uniquable Name
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
External instance of the constraint type Foldable []
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
External instance of the constraint type Foldable []
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]
singleton NameEnv [Name]
m Name
n Name
n)
NameEnv [Name]
forall elt. UniqFM 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 elt. UniqFM elt -> [(Unique, elt)]
nonDetUFMToList NameEnv [Name]
badNamesEnv
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
External instance of the constraint type Show Unique
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
Evidence bound by a type signature of the constraint type Show a
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
"]"
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
External instance of the constraint type Alternative Maybe
<|> UniqFM Name -> Unique -> Maybe Name
forall key elt. Uniquable key => UniqFM elt -> key -> Maybe elt
External instance of the constraint type Uniquable Unique
lookupUFM UniqFM Name
knownKeysMap Unique
u
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 -> Bool
forall key elt. Uniquable key => key -> UniqFM elt -> Bool
External instance of the constraint type Uniquable Name
elemUFM Name
n UniqFM Name
knownKeysMap
knownKeysMap :: UniqFM Name
knownKeysMap :: UniqFM Name
knownKeysMap = [(Unique, Name)] -> UniqFM Name
forall key elt. Uniquable key => [(key, elt)] -> UniqFM elt
External instance of the constraint type Uniquable Unique
listToUFM [ (Name -> Unique
nameUnique Name
n, Name
n) | Name
n <- [Name]
knownKeyNames ]
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
Maybe SDoc
Nothing -> SDoc
empty
Just SDoc
doc -> [SDoc] -> SDoc
vcat [String -> SDoc
text String
"{-", SDoc
doc, String -> SDoc
text String
"-}"]
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." ]
primOpIds :: Array Int Id
primOpIds :: Array Int Id
primOpIds = (Int, Int) -> [(Int, Id)] -> Array Int Id
forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
External instance of the constraint type Ix Int
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
External instance of the constraint type Ix Int
! PrimOp -> Int
primOpTag PrimOp
op
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
funTyCon TyCon -> [TyCon] -> [TyCon]
forall a. a -> [a] -> [a]
: [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
External instance of the constraint type Ord Name
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
funTyCon TyCon -> [TyCon] -> [TyCon]
forall a. a -> [a] -> [a]
: [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
External instance of the constraint type Foldable []
find ((String
nameStr String -> String -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type forall a. Eq a => Eq [a]
External instance of the constraint type Eq Char
==) (String -> Bool) -> (Name -> String) -> Name -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> String
forall a. NamedThing a => a -> String
External instance of the constraint type NamedThing Name
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
maybeCharLikeCon, maybeIntLikeCon :: DataCon -> Bool
maybeCharLikeCon :: DataCon -> Bool
maybeCharLikeCon DataCon
con = DataCon
con DataCon -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
External instance of the constraint type Uniquable DataCon
`hasKey` Unique
charDataConKey
maybeIntLikeCon :: DataCon -> Bool
maybeIntLikeCon DataCon
con = DataCon
con DataCon -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
External instance of the constraint type Uniquable DataCon
`hasKey` Unique
intDataConKey
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
External instance of the constraint type Eq Unique
`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
External instance of the constraint type Eq Unique
`is_elem` [Unique]
standardClassKeys
is_elem :: Eq a => a -> [a] -> Bool
is_elem :: a -> [a] -> Bool
is_elem = String -> a -> [a] -> Bool
forall a. Eq a => String -> a -> [a] -> Bool
Evidence bound by a type signature of the constraint type Eq a
isIn String
"is_X_Class"