module GHC.Builtin.Uniques
(
knownUniqueName
, mkSumTyConUnique, mkSumDataConUnique
, mkTupleTyConUnique
, mkTupleDataConUnique
, isTupleTyConUnique
, mkCTupleTyConUnique
, mkCTupleDataConUnique
, mkCTupleSelIdUnique
, mkAlphaTyVarUnique
, mkPrimOpIdUnique, mkPrimOpWrapperUnique
, mkPreludeMiscIdUnique, mkPreludeDataConUnique
, mkPreludeTyConUnique, mkPreludeClassUnique
, mkRegSingleUnique, mkRegPairUnique, mkRegClassUnique, mkRegSubUnique
, mkCostCentreUnique
, varNSUnique, dataNSUnique, tvNSUnique, tcNSUnique
, mkFldNSUnique, isFldNSUnique
, mkBuiltinUnique
, mkPseudoUniqueE
, tyConRepNameUnique
, dataConWorkerUnique, dataConTyRepNameUnique
, initExitJoinUnique
, mkBoxingTyConUnique, boxingDataConUnique
) where
import GHC.Prelude
import {-# SOURCE #-} GHC.Builtin.Types
import {-# SOURCE #-} GHC.Core.TyCon
import {-# SOURCE #-} GHC.Core.DataCon
import {-# SOURCE #-} GHC.Types.Id
import {-# SOURCE #-} GHC.Types.Name
import GHC.Types.Basic
import GHC.Types.Unique
import GHC.Data.FastString
import GHC.Utils.Outputable
import GHC.Utils.Panic
import Data.Maybe
knownUniqueName :: Unique -> Maybe Name
knownUniqueName :: Unique -> Maybe Name
knownUniqueName Unique
u =
case Char
tag of
Char
'z' -> Name -> Maybe Name
forall a. a -> Maybe a
Just (Name -> Maybe Name) -> Name -> Maybe Name
forall a b. (a -> b) -> a -> b
$ Int -> Name
getUnboxedSumName Int
n
Char
'4' -> Name -> Maybe Name
forall a. a -> Maybe a
Just (Name -> Maybe Name) -> Name -> Maybe Name
forall a b. (a -> b) -> a -> b
$ Boxity -> Int -> Name
getTupleTyConName Boxity
Boxed Int
n
Char
'5' -> Name -> Maybe Name
forall a. a -> Maybe a
Just (Name -> Maybe Name) -> Name -> Maybe Name
forall a b. (a -> b) -> a -> b
$ Boxity -> Int -> Name
getTupleTyConName Boxity
Unboxed Int
n
Char
'7' -> Name -> Maybe Name
forall a. a -> Maybe a
Just (Name -> Maybe Name) -> Name -> Maybe Name
forall a b. (a -> b) -> a -> b
$ Boxity -> Int -> Name
getTupleDataConName Boxity
Boxed Int
n
Char
'8' -> Name -> Maybe Name
forall a. a -> Maybe a
Just (Name -> Maybe Name) -> Name -> Maybe Name
forall a b. (a -> b) -> a -> b
$ Boxity -> Int -> Name
getTupleDataConName Boxity
Unboxed Int
n
Char
'j' -> Name -> Maybe Name
forall a. a -> Maybe a
Just (Name -> Maybe Name) -> Name -> Maybe Name
forall a b. (a -> b) -> a -> b
$ Int -> Name
getCTupleSelIdName Int
n
Char
'k' -> Name -> Maybe Name
forall a. a -> Maybe a
Just (Name -> Maybe Name) -> Name -> Maybe Name
forall a b. (a -> b) -> a -> b
$ Int -> Name
getCTupleTyConName Int
n
Char
'm' -> Name -> Maybe Name
forall a. a -> Maybe a
Just (Name -> Maybe Name) -> Name -> Maybe Name
forall a b. (a -> b) -> a -> b
$ Int -> Name
getCTupleDataConName Int
n
Char
_ -> Maybe Name
forall a. Maybe a
Nothing
where
(Char
tag, Int
n) = Unique -> (Char, Int)
unpkUnique Unique
u
mkSumTyConUnique :: Arity -> Unique
mkSumTyConUnique :: Int -> Unique
mkSumTyConUnique Int
arity =
Bool -> SDoc -> Unique -> Unique
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr (Int
arity Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0x3f) (Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int
arity) (Unique -> Unique) -> Unique -> Unique
forall a b. (a -> b) -> a -> b
$
Char -> Int -> Unique
mkUnique Char
'z' (Int
arity Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
8 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
0xfc)
mkSumDataConUnique :: ConTagZ -> Arity -> Unique
mkSumDataConUnique :: Int -> Int -> Unique
mkSumDataConUnique Int
alt Int
arity
| Int
alt Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
arity
= String -> Unique
forall a. HasCallStack => String -> a
panic (String
"mkSumDataConUnique: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
alt String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" >= " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
arity)
| Bool
otherwise
= Char -> Int -> Unique
mkUnique Char
'z' (Int
arity Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
alt Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
2)
getUnboxedSumName :: Int -> Name
getUnboxedSumName :: Int -> Name
getUnboxedSumName Int
n
| Int
n Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0xfc Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0xfc
= case Int
tag of
Int
0x0 -> TyCon -> Name
tyConName (TyCon -> Name) -> TyCon -> Name
forall a b. (a -> b) -> a -> b
$ Int -> TyCon
sumTyCon Int
arity
Int
0x1 -> TyCon -> Name
getRep (TyCon -> Name) -> TyCon -> Name
forall a b. (a -> b) -> a -> b
$ Int -> TyCon
sumTyCon Int
arity
Int
_ -> String -> SDoc -> Name
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"getUnboxedSumName: invalid tag" (Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int
tag)
| Int
tag Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0x0
= DataCon -> Name
dataConName (DataCon -> Name) -> DataCon -> Name
forall a b. (a -> b) -> a -> b
$ Int -> Int -> DataCon
sumDataCon (Int
alt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
arity
| Int
tag Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0x1
= Id -> Name
forall a. NamedThing a => a -> Name
getName (Id -> Name) -> Id -> Name
forall a b. (a -> b) -> a -> b
$ DataCon -> Id
dataConWrapId (DataCon -> Id) -> DataCon -> Id
forall a b. (a -> b) -> a -> b
$ Int -> Int -> DataCon
sumDataCon (Int
alt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
arity
| Int
tag Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0x2
= TyCon -> Name
getRep (TyCon -> Name) -> TyCon -> Name
forall a b. (a -> b) -> a -> b
$ DataCon -> TyCon
promoteDataCon (DataCon -> TyCon) -> DataCon -> TyCon
forall a b. (a -> b) -> a -> b
$ Int -> Int -> DataCon
sumDataCon (Int
alt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
arity
| Bool
otherwise
= String -> SDoc -> Name
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"getUnboxedSumName" (Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int
n)
where
arity :: Int
arity = Int
n Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
8
alt :: Int
alt = (Int
n Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0xfc) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
2
tag :: Int
tag = Int
0x3 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
n
getRep :: TyCon -> Name
getRep TyCon
tycon =
Name -> Maybe Name -> Name
forall a. a -> Maybe a -> a
fromMaybe (String -> SDoc -> Name
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"getUnboxedSumName(getRep)" (TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
tycon))
(Maybe Name -> Name) -> Maybe Name -> Name
forall a b. (a -> b) -> a -> b
$ TyCon -> Maybe Name
tyConRepName_maybe TyCon
tycon
mkCTupleTyConUnique :: Arity -> Unique
mkCTupleTyConUnique :: Int -> Unique
mkCTupleTyConUnique Int
a = Char -> Int -> Unique
mkUnique Char
'k' (Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
a)
mkCTupleDataConUnique :: Arity -> Unique
mkCTupleDataConUnique :: Int -> Unique
mkCTupleDataConUnique Int
a = Char -> Int -> Unique
mkUnique Char
'm' (Int
3Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
a)
mkCTupleSelIdUnique :: ConTagZ -> Arity -> Unique
mkCTupleSelIdUnique :: Int -> Int -> Unique
mkCTupleSelIdUnique Int
sc_pos Int
arity
| Int
sc_pos Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
arity
= String -> Unique
forall a. HasCallStack => String -> a
panic (String
"mkCTupleSelIdUnique: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
sc_pos String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" >= " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
arity)
| Bool
otherwise
= Char -> Int -> Unique
mkUnique Char
'j' (Int
arity Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
cTupleSelIdArityBits Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sc_pos)
getCTupleTyConName :: Int -> Name
getCTupleTyConName :: Int -> Name
getCTupleTyConName Int
n =
case Int
n Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int
2 of
(Int
arity, Int
0) -> Int -> Name
cTupleTyConName Int
arity
(Int
arity, Int
1) -> Name -> Name
mkPrelTyConRepName (Name -> Name) -> Name -> Name
forall a b. (a -> b) -> a -> b
$ Int -> Name
cTupleTyConName Int
arity
(Int, Int)
_ -> String -> Name
forall a. HasCallStack => String -> a
panic String
"getCTupleTyConName: impossible"
getCTupleDataConName :: Int -> Name
getCTupleDataConName :: Int -> Name
getCTupleDataConName Int
n =
case Int
n Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int
3 of
(Int
arity, Int
0) -> Int -> Name
cTupleDataConName Int
arity
(Int
arity, Int
1) -> Id -> Name
forall a. NamedThing a => a -> Name
getName (Id -> Name) -> Id -> Name
forall a b. (a -> b) -> a -> b
$ DataCon -> Id
dataConWrapId (DataCon -> Id) -> DataCon -> Id
forall a b. (a -> b) -> a -> b
$ Int -> DataCon
cTupleDataCon Int
arity
(Int
arity, Int
2) -> Name -> Name
mkPrelTyConRepName (Name -> Name) -> Name -> Name
forall a b. (a -> b) -> a -> b
$ Int -> Name
cTupleDataConName Int
arity
(Int, Int)
_ -> String -> Name
forall a. HasCallStack => String -> a
panic String
"getCTupleDataConName: impossible"
getCTupleSelIdName :: Int -> Name
getCTupleSelIdName :: Int -> Name
getCTupleSelIdName Int
n = Int -> Int -> Name
cTupleSelIdName (Int
sc_pos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
arity
where
arity :: Int
arity = Int
n Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
cTupleSelIdArityBits
sc_pos :: Int
sc_pos = Int
n Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
cTupleSelIdPosBitmask
cTupleSelIdArityBits :: Int
cTupleSelIdArityBits :: Int
cTupleSelIdArityBits = Int
8
cTupleSelIdPosBitmask :: Int
cTupleSelIdPosBitmask :: Int
cTupleSelIdPosBitmask = Int
0xff
mkTupleDataConUnique :: Boxity -> Arity -> Unique
mkTupleDataConUnique :: Boxity -> Int -> Unique
mkTupleDataConUnique Boxity
Boxed Int
a = Char -> Int -> Unique
mkUnique Char
'7' (Int
3Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
a)
mkTupleDataConUnique Boxity
Unboxed Int
a = Char -> Int -> Unique
mkUnique Char
'8' (Int
3Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
a)
mkTupleTyConUnique :: Boxity -> Arity -> Unique
mkTupleTyConUnique :: Boxity -> Int -> Unique
mkTupleTyConUnique Boxity
Boxed Int
a = Char -> Int -> Unique
mkUnique Char
'4' (Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
a)
mkTupleTyConUnique Boxity
Unboxed Int
a = Char -> Int -> Unique
mkUnique Char
'5' (Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
a)
isTupleTyConUnique :: Unique -> Maybe (Boxity, Arity)
isTupleTyConUnique :: Unique -> Maybe (Boxity, Int)
isTupleTyConUnique Unique
u =
case (Char
tag, Int
i) of
(Char
'4', Int
0) -> (Boxity, Int) -> Maybe (Boxity, Int)
forall a. a -> Maybe a
Just (Boxity
Boxed, Int
arity)
(Char
'5', Int
0) -> (Boxity, Int) -> Maybe (Boxity, Int)
forall a. a -> Maybe a
Just (Boxity
Unboxed, Int
arity)
(Char, Int)
_ -> Maybe (Boxity, Int)
forall a. Maybe a
Nothing
where
(Char
tag, Int
n) = Unique -> (Char, Int)
unpkUnique Unique
u
(Int
arity, Int
i) = Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
quotRem Int
n Int
2
getTupleTyConName :: Boxity -> Int -> Name
getTupleTyConName :: Boxity -> Int -> Name
getTupleTyConName Boxity
boxity Int
n =
case Int
n Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int
2 of
(Int
arity, Int
0) -> TyCon -> Name
tyConName (TyCon -> Name) -> TyCon -> Name
forall a b. (a -> b) -> a -> b
$ Boxity -> Int -> TyCon
tupleTyCon Boxity
boxity Int
arity
(Int
arity, Int
1) -> Name -> Maybe Name -> Name
forall a. a -> Maybe a -> a
fromMaybe (String -> Name
forall a. HasCallStack => String -> a
panic String
"getTupleTyConName")
(Maybe Name -> Name) -> Maybe Name -> Name
forall a b. (a -> b) -> a -> b
$ TyCon -> Maybe Name
tyConRepName_maybe (TyCon -> Maybe Name) -> TyCon -> Maybe Name
forall a b. (a -> b) -> a -> b
$ Boxity -> Int -> TyCon
tupleTyCon Boxity
boxity Int
arity
(Int, Int)
_ -> String -> Name
forall a. HasCallStack => String -> a
panic String
"getTupleTyConName: impossible"
getTupleDataConName :: Boxity -> Int -> Name
getTupleDataConName :: Boxity -> Int -> Name
getTupleDataConName Boxity
boxity Int
n =
case Int
n Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int
3 of
(Int
arity, Int
0) -> DataCon -> Name
dataConName (DataCon -> Name) -> DataCon -> Name
forall a b. (a -> b) -> a -> b
$ Boxity -> Int -> DataCon
tupleDataCon Boxity
boxity Int
arity
(Int
arity, Int
1) -> Id -> Name
idName (Id -> Name) -> Id -> Name
forall a b. (a -> b) -> a -> b
$ DataCon -> Id
dataConWorkId (DataCon -> Id) -> DataCon -> Id
forall a b. (a -> b) -> a -> b
$ Boxity -> Int -> DataCon
tupleDataCon Boxity
boxity Int
arity
(Int
arity, Int
2) -> Name -> Maybe Name -> Name
forall a. a -> Maybe a -> a
fromMaybe (String -> Name
forall a. HasCallStack => String -> a
panic String
"getTupleDataCon")
(Maybe Name -> Name) -> Maybe Name -> Name
forall a b. (a -> b) -> a -> b
$ TyCon -> Maybe Name
tyConRepName_maybe (TyCon -> Maybe Name) -> TyCon -> Maybe Name
forall a b. (a -> b) -> a -> b
$ Boxity -> Int -> TyCon
promotedTupleDataCon Boxity
boxity Int
arity
(Int, Int)
_ -> String -> Name
forall a. HasCallStack => String -> a
panic String
"getTupleDataConName: impossible"
mkAlphaTyVarUnique :: Int -> Unique
mkPreludeClassUnique :: Int -> Unique
mkPrimOpIdUnique :: Int -> Unique
mkPrimOpWrapperUnique :: Int -> Unique
mkPreludeMiscIdUnique :: Int -> Unique
mkAlphaTyVarUnique :: Int -> Unique
mkAlphaTyVarUnique Int
i = Char -> Int -> Unique
mkUnique Char
'1' Int
i
mkPreludeClassUnique :: Int -> Unique
mkPreludeClassUnique Int
i = Char -> Int -> Unique
mkUnique Char
'2' Int
i
mkPrimOpIdUnique :: Int -> Unique
mkPrimOpIdUnique Int
op = Char -> Int -> Unique
mkUnique Char
'9' (Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
op)
mkPrimOpWrapperUnique :: Int -> Unique
mkPrimOpWrapperUnique Int
op = Char -> Int -> Unique
mkUnique Char
'9' (Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
opInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
mkPreludeMiscIdUnique :: Int -> Unique
mkPreludeMiscIdUnique Int
i = Char -> Int -> Unique
mkUnique Char
'0' Int
i
mkPseudoUniqueE, mkBuiltinUnique :: Int -> Unique
mkBuiltinUnique :: Int -> Unique
mkBuiltinUnique Int
i = Char -> Int -> Unique
mkUnique Char
'B' Int
i
mkPseudoUniqueE :: Int -> Unique
mkPseudoUniqueE Int
i = Char -> Int -> Unique
mkUnique Char
'E' Int
i
mkRegSingleUnique, mkRegPairUnique, mkRegSubUnique, mkRegClassUnique :: Int -> Unique
mkRegSingleUnique :: Int -> Unique
mkRegSingleUnique = Char -> Int -> Unique
mkUnique Char
'R'
mkRegSubUnique :: Int -> Unique
mkRegSubUnique = Char -> Int -> Unique
mkUnique Char
'S'
mkRegPairUnique :: Int -> Unique
mkRegPairUnique = Char -> Int -> Unique
mkUnique Char
'P'
mkRegClassUnique :: Int -> Unique
mkRegClassUnique = Char -> Int -> Unique
mkUnique Char
'L'
mkCostCentreUnique :: Int -> Unique
mkCostCentreUnique :: Int -> Unique
mkCostCentreUnique = Char -> Int -> Unique
mkUnique Char
'C'
varNSUnique, dataNSUnique, tvNSUnique, tcNSUnique :: Unique
varNSUnique :: Unique
varNSUnique = Char -> Int -> Unique
mkUnique Char
'i' Int
0
dataNSUnique :: Unique
dataNSUnique = Char -> Int -> Unique
mkUnique Char
'd' Int
0
tvNSUnique :: Unique
tvNSUnique = Char -> Int -> Unique
mkUnique Char
'v' Int
0
tcNSUnique :: Unique
tcNSUnique = Char -> Int -> Unique
mkUnique Char
'c' Int
0
mkFldNSUnique :: FastString -> Unique
mkFldNSUnique :: FastString -> Unique
mkFldNSUnique FastString
fs = Char -> Int -> Unique
mkUnique Char
'f' (FastString -> Int
uniqueOfFS FastString
fs)
isFldNSUnique :: Unique -> Bool
isFldNSUnique :: Unique -> Bool
isFldNSUnique Unique
uniq = case Unique -> (Char, Int)
unpkUnique Unique
uniq of
(Char
tag, Int
_) -> Char
tag Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'f'
initExitJoinUnique :: Unique
initExitJoinUnique :: Unique
initExitJoinUnique = Char -> Int -> Unique
mkUnique Char
's' Int
0
mkPreludeTyConUnique :: Int -> Unique
mkPreludeTyConUnique :: Int -> Unique
mkPreludeTyConUnique Int
i = Char -> Int -> Unique
mkUnique Char
'3' (Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
i)
tyConRepNameUnique :: Unique -> Unique
tyConRepNameUnique :: Unique -> Unique
tyConRepNameUnique Unique
u = Unique -> Unique
incrUnique Unique
u
mkPreludeDataConUnique :: Int -> Unique
mkPreludeDataConUnique :: Int -> Unique
mkPreludeDataConUnique Int
i = Char -> Int -> Unique
mkUnique Char
'6' (Int
3Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
i)
dataConTyRepNameUnique, dataConWorkerUnique :: Unique -> Unique
dataConWorkerUnique :: Unique -> Unique
dataConWorkerUnique Unique
u = Unique -> Unique
incrUnique Unique
u
dataConTyRepNameUnique :: Unique -> Unique
dataConTyRepNameUnique Unique
u = Unique -> Int -> Unique
stepUnique Unique
u Int
2
mkBoxingTyConUnique :: Int -> Unique
mkBoxingTyConUnique :: Int -> Unique
mkBoxingTyConUnique Int
i = Char -> Int -> Unique
mkUnique Char
'b' (Int
5Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
i)
boxingDataConUnique :: Unique -> Unique
boxingDataConUnique :: Unique -> Unique
boxingDataConUnique Unique
u = Unique -> Int -> Unique
stepUnique Unique
u Int
2