content: {-# 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 Eta.Prelude.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 Eta.Prelude.TysWiredIn
  import Eta.Types.TyCon
  import Eta.BasicTypes.DataCon
  import Eta.BasicTypes.Id
  import Eta.BasicTypes.BasicTypes
  import Eta.Utils.Outputable
  import Eta.BasicTypes.Unique
  import Eta.BasicTypes.Name
  import Eta.Utils.Util
  import Data.Bits
  -- import Data.Maybe
  
  -- | Get the 'Name' associated with a known-key 'Unique'.
  knownUniqueName :: Unique -> Maybe Name
  knownUniqueName u =
      case tag of
        --'z' -> Just $ getUnboxedSumName n
        '4' -> Just $ getTupleTyConName BoxedTuple n
        '5' -> Just $ getTupleTyConName UnboxedTuple n
        '7' -> Just $ getTupleDataConName BoxedTuple n
        '8' -> Just $ getTupleDataConName UnboxedTuple n
        'k' -> Just $ getTupleTyConName ConstraintTuple n
        'm' -> Just $ getTupleDataConName ConstraintTuple n
        _   -> Nothing
    where
      (tag, n) = unpkUnique 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 arity =
      ASSERT(arity < 0x3f) -- 0x3f since we only have 6 bits to encode the
                           -- alternative
      mkUnique 'z' (arity `shiftL` 8 .|. 0xfc)
  
  mkSumDataConUnique :: ConTagZ -> Arity -> Unique
  mkSumDataConUnique alt arity
    | alt >= arity
    = panic ("mkSumDataConUnique: " ++ show alt ++ " >= " ++ show arity)
    | otherwise
    = mkUnique 'z' (arity `shiftL` 8 + alt `shiftL` 2) {- skip the tycon -}
  
  -- getUnboxedSumName :: Int -> Name
  -- getUnboxedSumName n
  --   | n .&. 0xfc == 0xfc
  --   = case tag of
  --       0x0 -> tyConName $ sumTyCon arity
  --       0x1 -> getRep $ sumTyCon arity
  --       _   -> pprPanic "getUnboxedSumName: invalid tag" (ppr tag)
  --   | tag == 0x0
  --   = dataConName $ sumDataCon (alt + 1) arity
  --   | tag == 0x1
  --   = getName $ dataConWrapId $ sumDataCon (alt + 1) arity
  --   | tag == 0x2
  --   = getRep $ promoteDataCon $ sumDataCon (alt + 1) arity
  --   | otherwise
  --   = pprPanic "getUnboxedSumName" (ppr n)
  --   where
  --     arity = n `shiftR` 8
  --     alt = (n .&. 0xfc) `shiftR` 2
  --     tag = 0x3 .&. n
  --     getRep tycon =
  --         fromMaybe (pprPanic "getUnboxedSumName(getRep)" (ppr tycon))
  --         $ tyConRepName_maybe 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 a = mkUnique 'k' (2*a)
  
  mkCTupleDataConUnique :: Arity -> Unique
  mkCTupleDataConUnique a = mkUnique 'm' (3*a)
  
  -- getCTupleTyConName :: Int -> Name
  -- getCTupleTyConName n =
  --     case n `divMod` 2 of
  --       (arity, 0) -> tyConName $ tupleTyCon boxity arity
  --       (arity, 1) -> mkPrelTyConRepName $ cTupleTyConName arity
  --       _          -> panic "getCTupleTyConName: impossible"
  --
  -- getCTupleDataConUnique :: Int -> Name
  -- getCTupleDataConUnique n =
  --     case n `divMod` 3 of
  --       (arity,  0) -> cTupleDataConName arity
  --       (_arity, 1) -> panic "getCTupleDataConName: no worker"
  --       (arity,  2) -> mkPrelTyConRepName $ cTupleDataConName arity
  --       _           -> panic "getCTupleDataConName: impossible"
  
  --------------------------------------------------
  -- Normal tuples
  
  mkTupleDataConUnique :: TupleSort -> Arity -> Unique
  mkTupleDataConUnique BoxedTuple          a = mkUnique '7' (3*a)    -- may be used in C labels
  mkTupleDataConUnique UnboxedTuple        a = mkUnique '8' (3*a)
  mkTupleDataConUnique ConstraintTuple     a = mkCTupleDataConUnique a
  
  mkTupleTyConUnique :: TupleSort -> Arity -> Unique
  mkTupleTyConUnique BoxedTuple          a  = mkUnique '4' (2*a)
  mkTupleTyConUnique UnboxedTuple        a  = mkUnique '5' (2*a)
  mkTupleTyConUnique ConstraintTuple     a  = mkCTupleTyConUnique a
  
  getTupleTyConName :: TupleSort -> Int -> Name
  getTupleTyConName sort n =
      case n `divMod` 2 of
        (arity, 0) -> tyConName $ tupleTyCon sort arity
        (_arity, 1) -> panic "getTupleTyConName not handled!"
        --                  fromMaybe (panic "getTupleTyConName")
        --               $ tyConRepName_maybe $ tupleTyCon boxity arity
        _          -> panic "getTupleTyConName: impossible"
  
  getTupleDataConName :: TupleSort -> Int -> Name
  getTupleDataConName sort n =
      case n `divMod` 3 of
        (arity, 0) -> dataConName $ tupleCon sort arity
        (arity, 1) -> idName $ dataConWorkId $ tupleCon sort arity
        (_arity, 2) -> panic "getTupleDataConName not handled!"
        -- fromMaybe (panic "getTupleDataCon")
        --               $ tyConRepName_maybe $ promotedTupleDataCon boxity arity
        _          -> panic "getTupleDataConName: impossible"
  