{-# LANGUAGE CPP #-}
module GHC.Builtin.Uniques (knownUniqueName) where

import GHC.Prelude

import GHC.Builtin.Types
import GHC.Core.TyCon
import GHC.Core.DataCon
import GHC.Types.Id
import GHC.Types.Name
import GHC.Types.Basic
import GHC.Types.Unique

import GHC.Utils.Outputable
import GHC.Utils.Panic
#if __GLASGOW_HASKELL__ == 908
import GHC.Utils.Panic.Plain (assert)
#endif

import Data.Maybe
import GHC.Utils.Word64 (word64ToInt)

#if __GLASGOW_HASKELL__ == 908 || __GLASGOW_HASKELL__ == 910 || __GLASGOW_HASKELL__ == 912
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, Word64
n') = Unique -> (Char, Word64)
unpkUnique Unique
u
    -- Known unique names are guaranteed to fit in Int, so we don't need the whole Word64.
    n :: Int
n = Bool -> Int -> Int
forall a. HasCallStack => Bool -> a -> a
assert (Unique -> Bool
isValidKnownKeyUnique Unique
u) (HasCallStack => Word64 -> Int
Word64 -> Int
word64ToInt Word64
n')

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

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

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"
#endif