{-# 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' -> 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 =
    ASSERT(arity < 0x3f) 
                         
    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. 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. 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. 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. 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)
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. 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. 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. 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. 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
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
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
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 :: Arity -> 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