{-# LANGUAGE CPP #-}

-- | This is where we define a mapping from Uniques to their associated
-- known-key Names for things associated with tuples and sums. We use this
-- mapping while deserializing known-key Names in interface file symbol tables,
-- which are encoded as their Unique. See Note [Symbol table representation of
-- names] for details.
--

module KnownUniques
    ( -- * Looking up known-key names
      knownUniqueName

      -- * Getting the 'Unique's of 'Name's
      -- ** Anonymous sums
    , mkSumTyConUnique
    , mkSumDataConUnique
      -- ** Tuples
      -- *** Vanilla
    , mkTupleTyConUnique
    , mkTupleDataConUnique
      -- *** Constraint
    , mkCTupleTyConUnique
    , mkCTupleDataConUnique
    ) where

#include "HsVersions.h"

import GhcPrelude

import TysWiredIn
import TyCon
import DataCon
import Id
import BasicTypes
import Outputable
import Unique
import Name
import Util

import Data.Bits
import Data.Maybe

-- | Get the 'Name' associated with a known-key 'Unique'.
knownUniqueName :: Unique -> Maybe Name
knownUniqueName :: Unique -> Maybe Name
knownUniqueName u :: Unique
u =
    case Char
tag of
      '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
      '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
      '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
      '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
      '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
      '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
      '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
getCTupleDataConUnique Int
n
      _   -> Maybe Name
forall a. Maybe a
Nothing
  where
    (tag :: Char
tag, n :: Int
n) = Unique -> (Char, Int)
unpkUnique Unique
u

--------------------------------------------------
-- Anonymous sums
--
-- Sum arities start from 2. The encoding is a bit funny: we break up the
-- integral part into bitfields for the arity, an alternative index (which is
-- taken to be 0xff in the case of the TyCon), and, in the case of a datacon, a
-- tag (used to identify the sum's TypeRep binding).
--
-- This layout is chosen to remain compatible with the usual unique allocation
-- for wired-in data constructors described in Unique.hs
--
-- TyCon for sum of arity k:
--   00000000 kkkkkkkk 11111100

-- TypeRep of TyCon for sum of arity k:
--   00000000 kkkkkkkk 11111101
--
-- DataCon for sum of arity k and alternative n (zero-based):
--   00000000 kkkkkkkk nnnnnn00
--
-- TypeRep for sum DataCon of arity k and alternative n (zero-based):
--   00000000 kkkkkkkk nnnnnn10

mkSumTyConUnique :: Arity -> Unique
mkSumTyConUnique :: Int -> Unique
mkSumTyConUnique arity :: Int
arity =
    ASSERT(arity < 0x3f) -- 0x3f since we only have 6 bits to encode the
                         -- alternative
    Char -> Int -> Unique
mkUnique 'z' (Int
arity Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` 8 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. 0xfc)

mkSumDataConUnique :: ConTagZ -> Arity -> Unique
mkSumDataConUnique :: Int -> Int -> Unique
mkSumDataConUnique alt :: Int
alt arity :: Int
arity
  | Int
alt Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
arity
  = String -> Unique
forall a. String -> a
panic ("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
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
arity)
  | Bool
otherwise
  = Char -> Int -> Unique
mkUnique 'z' (Int
arity Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` 8 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
alt Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` 2) {- skip the tycon -}

getUnboxedSumName :: Int -> Name
getUnboxedSumName :: Int -> Name
getUnboxedSumName n :: Int
n
  | Int
n Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. 0xfc Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0xfc
  = case Int
tag of
      0x0 -> TyCon -> Name
tyConName (TyCon -> Name) -> TyCon -> Name
forall a b. (a -> b) -> a -> b
$ Int -> TyCon
sumTyCon Int
arity
      0x1 -> TyCon -> Name
getRep (TyCon -> Name) -> TyCon -> Name
forall a b. (a -> b) -> a -> b
$ Int -> TyCon
sumTyCon Int
arity
      _   -> String -> SDoc -> Name
forall a. HasCallStack => String -> SDoc -> a
pprPanic "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
== 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
+ 1) Int
arity
  | Int
tag Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 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
+ 1) Int
arity
  | Int
tag Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 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
+ 1) Int
arity
  | Bool
otherwise
  = String -> SDoc -> Name
forall a. HasCallStack => String -> SDoc -> a
pprPanic "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` 8
    alt :: Int
alt = (Int
n Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. 0xfc) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` 2
    tag :: Int
tag = 0x3 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
n
    getRep :: TyCon -> Name
getRep tycon :: TyCon
tycon =
        Name -> Maybe Name -> Name
forall a. a -> Maybe a -> a
fromMaybe (String -> SDoc -> Name
forall a. HasCallStack => String -> SDoc -> a
pprPanic "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

-- Note [Uniques for tuple type and data constructors]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
--
-- Wired-in type constructor keys occupy *two* slots:
--    * u: the TyCon itself
--    * u+1: the TyConRepName of the TyCon
--
-- Wired-in tuple data constructor keys occupy *three* slots:
--    * u: the DataCon itself
--    * u+1: its worker Id
--    * u+2: the TyConRepName of the promoted TyCon

--------------------------------------------------
-- Constraint tuples

mkCTupleTyConUnique :: Arity -> Unique
mkCTupleTyConUnique :: Int -> Unique
mkCTupleTyConUnique a :: Int
a = Char -> Int -> Unique
mkUnique 'k' (2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
a)

mkCTupleDataConUnique :: Arity -> Unique
mkCTupleDataConUnique :: Int -> Unique
mkCTupleDataConUnique a :: Int
a = Char -> Int -> Unique
mkUnique 'm' (3Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
a)

getCTupleTyConName :: Int -> Name
getCTupleTyConName :: Int -> Name
getCTupleTyConName n :: Int
n =
    case Int
n Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` 2 of
      (arity :: Int
arity, 0) -> Int -> Name
cTupleTyConName Int
arity
      (arity :: Int
arity, 1) -> Name -> Name
mkPrelTyConRepName (Name -> Name) -> Name -> Name
forall a b. (a -> b) -> a -> b
$ Int -> Name
cTupleTyConName Int
arity
      _          -> String -> Name
forall a. String -> a
panic "getCTupleTyConName: impossible"

getCTupleDataConUnique :: Int -> Name
getCTupleDataConUnique :: Int -> Name
getCTupleDataConUnique n :: Int
n =
    case Int
n Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` 3 of
      (arity :: Int
arity,  0) -> Int -> Name
cTupleDataConName Int
arity
      (_arity :: Int
_arity, 1) -> String -> Name
forall a. String -> a
panic "getCTupleDataConName: no worker"
      (arity :: Int
arity,  2) -> Name -> Name
mkPrelTyConRepName (Name -> Name) -> Name -> Name
forall a b. (a -> b) -> a -> b
$ Int -> Name
cTupleDataConName Int
arity
      _           -> String -> Name
forall a. String -> a
panic "getCTupleDataConName: impossible"

--------------------------------------------------
-- Normal tuples

mkTupleDataConUnique :: Boxity -> Arity -> Unique
mkTupleDataConUnique :: Boxity -> Int -> Unique
mkTupleDataConUnique Boxed          a :: Int
a = Char -> Int -> Unique
mkUnique '7' (3Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
a)    -- may be used in C labels
mkTupleDataConUnique Unboxed        a :: Int
a = Char -> Int -> Unique
mkUnique '8' (3Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
a)

mkTupleTyConUnique :: Boxity -> Arity -> Unique
mkTupleTyConUnique :: Boxity -> Int -> Unique
mkTupleTyConUnique Boxed           a :: Int
a  = Char -> Int -> Unique
mkUnique '4' (2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
a)
mkTupleTyConUnique Unboxed         a :: Int
a  = Char -> Int -> Unique
mkUnique '5' (2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
a)

getTupleTyConName :: Boxity -> Int -> Name
getTupleTyConName :: Boxity -> Int -> Name
getTupleTyConName boxity :: Boxity
boxity n :: Int
n =
    case Int
n Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` 2 of
      (arity :: Int
arity, 0) -> TyCon -> Name
tyConName (TyCon -> Name) -> TyCon -> Name
forall a b. (a -> b) -> a -> b
$ Boxity -> Int -> TyCon
tupleTyCon Boxity
boxity Int
arity
      (arity :: Int
arity, 1) -> Name -> Maybe Name -> Name
forall a. a -> Maybe a -> a
fromMaybe (String -> Name
forall a. String -> a
panic "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
      _          -> String -> Name
forall a. String -> a
panic "getTupleTyConName: impossible"

getTupleDataConName :: Boxity -> Int -> Name
getTupleDataConName :: Boxity -> Int -> Name
getTupleDataConName boxity :: Boxity
boxity n :: Int
n =
    case Int
n Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` 3 of
      (arity :: Int
arity, 0) -> DataCon -> Name
dataConName (DataCon -> Name) -> DataCon -> Name
forall a b. (a -> b) -> a -> b
$ Boxity -> Int -> DataCon
tupleDataCon Boxity
boxity Int
arity
      (arity :: Int
arity, 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
      (arity :: Int
arity, 2) -> Name -> Maybe Name -> Name
forall a. a -> Maybe a -> a
fromMaybe (String -> Name
forall a. String -> a
panic "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
      _          -> String -> Name
forall a. String -> a
panic "getTupleDataConName: impossible"