{-# LANGUAGE CPP #-}
module GHC.Builtin.Uniques
(
knownUniqueName
, mkSumTyConUnique
, mkSumDataConUnique
, mkTupleTyConUnique
, mkTupleDataConUnique
, mkCTupleTyConUnique
, mkCTupleDataConUnique
, mkCTupleSelIdUnique
, mkAlphaTyVarUnique
, mkPrimOpIdUnique, mkPrimOpWrapperUnique
, mkPreludeMiscIdUnique, mkPreludeDataConUnique
, mkPreludeTyConUnique, mkPreludeClassUnique
, mkCoVarUnique
, mkVarOccUnique, mkDataOccUnique, mkTvOccUnique, mkTcOccUnique
, mkRegSingleUnique, mkRegPairUnique, mkRegClassUnique, mkRegSubUnique
, mkCostCentreUnique
, mkBuiltinUnique
, mkPseudoUniqueD
, mkPseudoUniqueE
, mkPseudoUniqueH
, tyConRepNameUnique
, dataConWorkerUnique, dataConTyRepNameUnique
, initTyVarUnique
, initExitJoinUnique
) where
#include "HsVersions.h"
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.Misc
import GHC.Utils.Panic
import Data.Maybe
knownUniqueName :: Unique -> Maybe Name
knownUniqueName :: Unique -> Maybe Name
knownUniqueName Unique
u =
case Char
tag of
Char
'z' -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Int -> Name
getUnboxedSumName Int
n
Char
'4' -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Boxity -> Int -> Name
getTupleTyConName Boxity
Boxed Int
n
Char
'5' -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Boxity -> Int -> Name
getTupleTyConName Boxity
Unboxed Int
n
Char
'7' -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Boxity -> Int -> Name
getTupleDataConName Boxity
Boxed Int
n
Char
'8' -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Boxity -> Int -> Name
getTupleDataConName Boxity
Unboxed Int
n
Char
'j' -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Int -> Name
getCTupleSelIdName Int
n
Char
'k' -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Int -> Name
getCTupleTyConName Int
n
Char
'm' -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Int -> Name
getCTupleDataConName Int
n
Char
_ -> 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 =
ASSERT(arity < 0x3f)
Char -> Int -> Unique
mkUnique Char
'z' (Int
arity forall a. Bits a => a -> Int -> a
`shiftL` Int
8 forall a. Bits a => a -> a -> a
.|. Int
0xfc)
mkSumDataConUnique :: ConTagZ -> Arity -> Unique
mkSumDataConUnique :: Int -> Int -> Unique
mkSumDataConUnique Int
alt Int
arity
| Int
alt forall a. Ord a => a -> a -> Bool
>= Int
arity
= forall a. String -> a
panic (String
"mkSumDataConUnique: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
alt forall a. [a] -> [a] -> [a]
++ String
" >= " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
arity)
| Bool
otherwise
= Char -> Int -> Unique
mkUnique Char
'z' (Int
arity forall a. Bits a => a -> Int -> a
`shiftL` Int
8 forall a. Num a => a -> a -> a
+ Int
alt forall a. Bits a => a -> Int -> a
`shiftL` Int
2)
getUnboxedSumName :: Int -> Name
getUnboxedSumName :: Int -> Name
getUnboxedSumName Int
n
| Int
n forall a. Bits a => a -> a -> a
.&. Int
0xfc forall a. Eq a => a -> a -> Bool
== Int
0xfc
= case Int
tag of
Int
0x0 -> TyCon -> Name
tyConName forall a b. (a -> b) -> a -> b
$ Int -> TyCon
sumTyCon Int
arity
Int
0x1 -> TyCon -> Name
getRep forall a b. (a -> b) -> a -> b
$ Int -> TyCon
sumTyCon Int
arity
Int
_ -> forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"getUnboxedSumName: invalid tag" (forall a. Outputable a => a -> SDoc
ppr Int
tag)
| Int
tag forall a. Eq a => a -> a -> Bool
== Int
0x0
= DataCon -> Name
dataConName forall a b. (a -> b) -> a -> b
$ Int -> Int -> DataCon
sumDataCon (Int
alt forall a. Num a => a -> a -> a
+ Int
1) Int
arity
| Int
tag forall a. Eq a => a -> a -> Bool
== Int
0x1
= forall a. NamedThing a => a -> Name
getName forall a b. (a -> b) -> a -> b
$ DataCon -> Id
dataConWrapId forall a b. (a -> b) -> a -> b
$ Int -> Int -> DataCon
sumDataCon (Int
alt forall a. Num a => a -> a -> a
+ Int
1) Int
arity
| Int
tag forall a. Eq a => a -> a -> Bool
== Int
0x2
= TyCon -> Name
getRep forall a b. (a -> b) -> a -> b
$ DataCon -> TyCon
promoteDataCon forall a b. (a -> b) -> a -> b
$ Int -> Int -> DataCon
sumDataCon (Int
alt forall a. Num a => a -> a -> a
+ Int
1) Int
arity
| Bool
otherwise
= forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"getUnboxedSumName" (forall a. Outputable a => a -> SDoc
ppr Int
n)
where
arity :: Int
arity = Int
n forall a. Bits a => a -> Int -> a
`shiftR` Int
8
alt :: Int
alt = (Int
n forall a. Bits a => a -> a -> a
.&. Int
0xfc) forall a. Bits a => a -> Int -> a
`shiftR` Int
2
tag :: Int
tag = Int
0x3 forall a. Bits a => a -> a -> a
.&. Int
n
getRep :: TyCon -> Name
getRep TyCon
tycon =
forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"getUnboxedSumName(getRep)" (forall a. Outputable a => a -> SDoc
ppr TyCon
tycon))
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
2forall a. Num a => a -> a -> a
*Int
a)
mkCTupleDataConUnique :: Arity -> Unique
mkCTupleDataConUnique :: Int -> Unique
mkCTupleDataConUnique Int
a = Char -> Int -> Unique
mkUnique Char
'm' (Int
3forall 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 forall a. Ord a => a -> a -> Bool
>= Int
arity
= forall a. String -> a
panic (String
"mkCTupleSelIdUnique: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
sc_pos forall a. [a] -> [a] -> [a]
++ String
" >= " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
arity)
| Bool
otherwise
= Char -> Int -> Unique
mkUnique Char
'j' (Int
arity forall a. Bits a => a -> Int -> a
`shiftL` Int
cTupleSelIdArityBits forall a. Num a => a -> a -> a
+ Int
sc_pos)
getCTupleTyConName :: Int -> Name
getCTupleTyConName :: Int -> Name
getCTupleTyConName Int
n =
case Int
n 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 forall a b. (a -> b) -> a -> b
$ Int -> Name
cTupleTyConName Int
arity
(Int, Int)
_ -> forall a. String -> a
panic String
"getCTupleTyConName: impossible"
getCTupleDataConName :: Int -> Name
getCTupleDataConName :: Int -> Name
getCTupleDataConName Int
n =
case Int
n 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) -> forall a. NamedThing a => a -> Name
getName forall a b. (a -> b) -> a -> b
$ DataCon -> Id
dataConWrapId forall a b. (a -> b) -> a -> b
$ Int -> DataCon
cTupleDataCon Int
arity
(Int
arity, Int
2) -> Name -> Name
mkPrelTyConRepName forall a b. (a -> b) -> a -> b
$ Int -> Name
cTupleDataConName Int
arity
(Int, Int)
_ -> forall a. String -> a
panic String
"getCTupleDataConName: impossible"
getCTupleSelIdName :: Int -> Name
getCTupleSelIdName :: Int -> Name
getCTupleSelIdName Int
n = Int -> Int -> Name
cTupleSelIdName (Int
sc_pos forall a. Num a => a -> a -> a
+ Int
1) Int
arity
where
arity :: Int
arity = Int
n forall a. Bits a => a -> Int -> a
`shiftR` Int
cTupleSelIdArityBits
sc_pos :: Int
sc_pos = Int
n 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
3forall a. Num a => a -> a -> a
*Int
a)
mkTupleDataConUnique Boxity
Unboxed Int
a = Char -> Int -> Unique
mkUnique Char
'8' (Int
3forall 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
2forall a. Num a => a -> a -> a
*Int
a)
mkTupleTyConUnique Boxity
Unboxed Int
a = Char -> Int -> Unique
mkUnique Char
'5' (Int
2forall a. Num a => a -> a -> a
*Int
a)
getTupleTyConName :: Boxity -> Int -> Name
getTupleTyConName :: Boxity -> Int -> Name
getTupleTyConName Boxity
boxity Int
n =
case Int
n forall a. Integral a => a -> a -> (a, a)
`divMod` Int
2 of
(Int
arity, Int
0) -> TyCon -> Name
tyConName forall a b. (a -> b) -> a -> b
$ Boxity -> Int -> TyCon
tupleTyCon Boxity
boxity Int
arity
(Int
arity, Int
1) -> forall a. a -> Maybe a -> a
fromMaybe (forall a. String -> a
panic String
"getTupleTyConName")
forall a b. (a -> b) -> a -> b
$ TyCon -> Maybe Name
tyConRepName_maybe forall a b. (a -> b) -> a -> b
$ Boxity -> Int -> TyCon
tupleTyCon Boxity
boxity Int
arity
(Int, Int)
_ -> forall a. String -> a
panic String
"getTupleTyConName: impossible"
getTupleDataConName :: Boxity -> Int -> Name
getTupleDataConName :: Boxity -> Int -> Name
getTupleDataConName Boxity
boxity Int
n =
case Int
n forall a. Integral a => a -> a -> (a, a)
`divMod` Int
3 of
(Int
arity, Int
0) -> DataCon -> Name
dataConName forall a b. (a -> b) -> a -> b
$ Boxity -> Int -> DataCon
tupleDataCon Boxity
boxity Int
arity
(Int
arity, Int
1) -> Id -> Name
idName forall a b. (a -> b) -> a -> b
$ DataCon -> Id
dataConWorkId forall a b. (a -> b) -> a -> b
$ Boxity -> Int -> DataCon
tupleDataCon Boxity
boxity Int
arity
(Int
arity, Int
2) -> forall a. a -> Maybe a -> a
fromMaybe (forall a. String -> a
panic String
"getTupleDataCon")
forall a b. (a -> b) -> a -> b
$ TyCon -> Maybe Name
tyConRepName_maybe forall a b. (a -> b) -> a -> b
$ Boxity -> Int -> TyCon
promotedTupleDataCon Boxity
boxity Int
arity
(Int, Int)
_ -> forall a. String -> a
panic String
"getTupleDataConName: impossible"
mkAlphaTyVarUnique :: Int -> Unique
mkPreludeClassUnique :: Int -> Unique
mkPrimOpIdUnique :: Int -> Unique
mkPrimOpWrapperUnique :: Int -> Unique
mkPreludeMiscIdUnique :: Int -> Unique
mkCoVarUnique :: Int -> Unique
mkAlphaTyVarUnique :: Int -> Unique
mkAlphaTyVarUnique Int
i = Char -> Int -> Unique
mkUnique Char
'1' Int
i
mkCoVarUnique :: Int -> Unique
mkCoVarUnique Int
i = Char -> Int -> Unique
mkUnique Char
'g' 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
2forall a. Num a => a -> a -> a
*Int
op)
mkPrimOpWrapperUnique :: Int -> Unique
mkPrimOpWrapperUnique Int
op = Char -> Int -> Unique
mkUnique Char
'9' (Int
2forall a. Num a => a -> a -> a
*Int
opforall a. Num a => a -> a -> a
+Int
1)
mkPreludeMiscIdUnique :: Int -> Unique
mkPreludeMiscIdUnique Int
i = Char -> Int -> Unique
mkUnique Char
'0' Int
i
initTyVarUnique :: Unique
initTyVarUnique :: Unique
initTyVarUnique = Char -> Int -> Unique
mkUnique Char
't' Int
0
mkPseudoUniqueD, mkPseudoUniqueE, mkPseudoUniqueH,
mkBuiltinUnique :: Int -> Unique
mkBuiltinUnique :: Int -> Unique
mkBuiltinUnique Int
i = Char -> Int -> Unique
mkUnique Char
'B' Int
i
mkPseudoUniqueD :: Int -> Unique
mkPseudoUniqueD Int
i = Char -> Int -> Unique
mkUnique Char
'D' Int
i
mkPseudoUniqueE :: Int -> Unique
mkPseudoUniqueE Int
i = Char -> Int -> Unique
mkUnique Char
'E' Int
i
mkPseudoUniqueH :: Int -> Unique
mkPseudoUniqueH Int
i = Char -> Int -> Unique
mkUnique Char
'H' 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'
mkVarOccUnique, mkDataOccUnique, mkTvOccUnique, mkTcOccUnique :: FastString -> Unique
mkVarOccUnique :: FastString -> Unique
mkVarOccUnique FastString
fs = Char -> Int -> Unique
mkUnique Char
'i' (FastString -> Int
uniqueOfFS FastString
fs)
mkDataOccUnique :: FastString -> Unique
mkDataOccUnique FastString
fs = Char -> Int -> Unique
mkUnique Char
'd' (FastString -> Int
uniqueOfFS FastString
fs)
mkTvOccUnique :: FastString -> Unique
mkTvOccUnique FastString
fs = Char -> Int -> Unique
mkUnique Char
'v' (FastString -> Int
uniqueOfFS FastString
fs)
mkTcOccUnique :: FastString -> Unique
mkTcOccUnique FastString
fs = Char -> Int -> Unique
mkUnique Char
'c' (FastString -> Int
uniqueOfFS FastString
fs)
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
2forall a. Num a => a -> a -> a
*Int
i)
tyConRepNameUnique :: Unique -> Unique
tyConRepNameUnique :: Unique -> Unique
tyConRepNameUnique Unique
u = Unique -> Unique
incrUnique Unique
u
mkPreludeDataConUnique :: Arity -> Unique
mkPreludeDataConUnique :: Int -> Unique
mkPreludeDataConUnique Int
i = Char -> Int -> Unique
mkUnique Char
'6' (Int
3forall 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