{-
(c) The University of Glasgow 2006
(c) The GRASP/AQUA Project, Glasgow University, 1992-1998


@Uniques@ are used to distinguish entities in the compiler (@Ids@,
@Classes@, etc.) from each other.  Thus, @Uniques@ are the basic
comparison key in the compiler.

If there is any single operation that needs to be fast, it is @Unique@

comparison.  Unsurprisingly, there is quite a bit of huff-and-puff
directed to that end.

Some of the other hair in this code is to be able to use a
``splittable @UniqueSupply@'' if requested/possible (not standard
Haskell).
-}

{-# LANGUAGE CPP, BangPatterns, MagicHash #-}

module Unique (
        -- * Main data types
        Unique, Uniquable(..),
        uNIQUE_BITS,

        -- ** Constructors, destructors and operations on 'Unique's
        hasKey,

        pprUniqueAlways,

        mkUniqueGrimily,                -- Used in UniqSupply only!
        getKey,                         -- Used in Var, UniqFM, Name only!
        mkUnique, unpkUnique,           -- Used in BinIface only
        eqUnique, ltUnique,

        deriveUnique,                   -- Ditto
        newTagUnique,                   -- Used in CgCase
        initTyVarUnique,
        initExitJoinUnique,
        nonDetCmpUnique,
        isValidKnownKeyUnique,          -- Used in PrelInfo.knownKeyNamesOkay

        -- ** Making built-in uniques

        -- now all the built-in Uniques (and functions to make them)
        -- [the Oh-So-Wonderful Haskell module system wins again...]
        mkAlphaTyVarUnique,
        mkPrimOpIdUnique, mkPrimOpWrapperUnique,
        mkPreludeMiscIdUnique, mkPreludeDataConUnique,
        mkPreludeTyConUnique, mkPreludeClassUnique,
        mkCoVarUnique,

        mkVarOccUnique, mkDataOccUnique, mkTvOccUnique, mkTcOccUnique,
        mkRegSingleUnique, mkRegPairUnique, mkRegClassUnique, mkRegSubUnique,
        mkCostCentreUnique,

        mkBuiltinUnique,
        mkPseudoUniqueD,
        mkPseudoUniqueE,
        mkPseudoUniqueH,

        -- ** Deriving uniques
        -- *** From TyCon name uniques
        tyConRepNameUnique,
        -- *** From DataCon name uniques
        dataConWorkerUnique, dataConTyRepNameUnique
    ) where

#include "HsVersions.h"
#include "Unique.h"

import GhcPrelude

import BasicTypes
import FastString
import Outputable
import Util

-- just for implementing a fast [0,61) -> Char function
import GHC.Exts (indexCharOffAddr#, Char(..), Int(..))

import Data.Char        ( chr, ord )
import Data.Bits

{-
************************************************************************
*                                                                      *
\subsection[Unique-type]{@Unique@ type and operations}
*                                                                      *
************************************************************************

The @Chars@ are ``tag letters'' that identify the @UniqueSupply@.
Fast comparison is everything on @Uniques@:
-}

-- | Unique identifier.
--
-- The type of unique identifiers that are used in many places in GHC
-- for fast ordering and equality tests. You should generate these with
-- the functions from the 'UniqSupply' module
--
-- These are sometimes also referred to as \"keys\" in comments in GHC.
newtype Unique = MkUnique Int

{-# INLINE uNIQUE_BITS #-}
uNIQUE_BITS :: Int
uNIQUE_BITS :: Int
uNIQUE_BITS = Int -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize (0 :: Int) Int -> Int -> Int
forall a. Num a => a -> a -> a
- UNIQUE_TAG_BITS

{-
Now come the functions which construct uniques from their pieces, and vice versa.
The stuff about unique *supplies* is handled further down this module.
-}

unpkUnique      :: Unique -> (Char, Int)        -- The reverse

mkUniqueGrimily :: Int -> Unique                -- A trap-door for UniqSupply
getKey          :: Unique -> Int                -- for Var

incrUnique   :: Unique -> Unique
stepUnique   :: Unique -> Int -> Unique
deriveUnique :: Unique -> Int -> Unique
newTagUnique :: Unique -> Char -> Unique

mkUniqueGrimily :: Int -> Unique
mkUniqueGrimily = Int -> Unique
MkUnique

{-# INLINE getKey #-}
getKey :: Unique -> Int
getKey (MkUnique x :: Int
x) = Int
x

incrUnique :: Unique -> Unique
incrUnique (MkUnique i :: Int
i) = Int -> Unique
MkUnique (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1)
stepUnique :: Unique -> Int -> Unique
stepUnique (MkUnique i :: Int
i) n :: Int
n = Int -> Unique
MkUnique (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n)

-- deriveUnique uses an 'X' tag so that it won't clash with
-- any of the uniques produced any other way
-- SPJ says: this looks terribly smelly to me!
deriveUnique :: Unique -> Int -> Unique
deriveUnique (MkUnique i :: Int
i) delta :: Int
delta = Char -> Int -> Unique
mkUnique 'X' (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
delta)

-- newTagUnique changes the "domain" of a unique to a different char
newTagUnique :: Unique -> Char -> Unique
newTagUnique u :: Unique
u c :: Char
c = Char -> Int -> Unique
mkUnique Char
c Int
i where (_,i :: Int
i) = Unique -> (Char, Int)
unpkUnique Unique
u

-- | How many bits are devoted to the unique index (as opposed to the class
-- character).
uniqueMask :: Int
uniqueMask :: Int
uniqueMask = (1 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
uNIQUE_BITS) Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1

-- pop the Char in the top 8 bits of the Unique(Supply)

-- No 64-bit bugs here, as long as we have at least 32 bits. --JSM

-- and as long as the Char fits in 8 bits, which we assume anyway!

mkUnique :: Char -> Int -> Unique       -- Builds a unique from pieces
-- NOT EXPORTED, so that we can see all the Chars that
--               are used in this one module
mkUnique :: Char -> Int -> Unique
mkUnique c :: Char
c i :: Int
i
  = Int -> Unique
MkUnique (Int
tag Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
bits)
  where
    tag :: Int
tag  = Char -> Int
ord Char
c Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
uNIQUE_BITS
    bits :: Int
bits = Int
i Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
uniqueMask

unpkUnique :: Unique -> (Char, Int)
unpkUnique (MkUnique u :: Int
u)
  = let
        -- as long as the Char may have its eighth bit set, we
        -- really do need the logical right-shift here!
        tag :: Char
tag = Int -> Char
chr (Int
u Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
uNIQUE_BITS)
        i :: Int
i   = Int
u Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
uniqueMask
    in
    (Char
tag, Int
i)

-- | The interface file symbol-table encoding assumes that known-key uniques fit
-- in 30-bits; verify this.
--
-- See Note [Symbol table representation of names] in BinIface for details.
isValidKnownKeyUnique :: Unique -> Bool
isValidKnownKeyUnique :: Unique -> Bool
isValidKnownKeyUnique u :: Unique
u =
    case Unique -> (Char, Int)
unpkUnique Unique
u of
      (c :: Char
c, x :: Int
x) -> Char -> Int
ord Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0xff Bool -> Bool -> Bool
&& Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= (1 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` 22)

{-
************************************************************************
*                                                                      *
\subsection[Uniquable-class]{The @Uniquable@ class}
*                                                                      *
************************************************************************
-}

-- | Class of things that we can obtain a 'Unique' from
class Uniquable a where
    getUnique :: a -> Unique

hasKey          :: Uniquable a => a -> Unique -> Bool
x :: a
x hasKey :: a -> Unique -> Bool
`hasKey` k :: Unique
k    = a -> Unique
forall a. Uniquable a => a -> Unique
getUnique a
x Unique -> Unique -> Bool
forall a. Eq a => a -> a -> Bool
== Unique
k

instance Uniquable FastString where
 getUnique :: FastString -> Unique
getUnique fs :: FastString
fs = Int -> Unique
mkUniqueGrimily (FastString -> Int
uniqueOfFS FastString
fs)

instance Uniquable Int where
 getUnique :: Int -> Unique
getUnique i :: Int
i = Int -> Unique
mkUniqueGrimily Int
i

{-
************************************************************************
*                                                                      *
\subsection[Unique-instances]{Instance declarations for @Unique@}
*                                                                      *
************************************************************************

And the whole point (besides uniqueness) is fast equality.  We don't
use `deriving' because we want {\em precise} control of ordering
(equality on @Uniques@ is v common).
-}

-- Note [Unique Determinism]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~
-- The order of allocated @Uniques@ is not stable across rebuilds.
-- The main reason for that is that typechecking interface files pulls
-- @Uniques@ from @UniqSupply@ and the interface file for the module being
-- currently compiled can, but doesn't have to exist.
--
-- It gets more complicated if you take into account that the interface
-- files are loaded lazily and that building multiple files at once has to
-- work for any subset of interface files present. When you add parallelism
-- this makes @Uniques@ hopelessly random.
--
-- As such, to get deterministic builds, the order of the allocated
-- @Uniques@ should not affect the final result.
-- see also wiki/DeterministicBuilds
--
-- Note [Unique Determinism and code generation]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-- The goal of the deterministic builds (wiki/DeterministicBuilds, #4012)
-- is to get ABI compatible binaries given the same inputs and environment.
-- The motivation behind that is that if the ABI doesn't change the
-- binaries can be safely reused.
-- Note that this is weaker than bit-for-bit identical binaries and getting
-- bit-for-bit identical binaries is not a goal for now.
-- This means that we don't care about nondeterminism that happens after
-- the interface files are created, in particular we don't care about
-- register allocation and code generation.
-- To track progress on bit-for-bit determinism see #12262.

eqUnique :: Unique -> Unique -> Bool
eqUnique :: Unique -> Unique -> Bool
eqUnique (MkUnique u1 :: Int
u1) (MkUnique u2 :: Int
u2) = Int
u1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
u2

ltUnique :: Unique -> Unique -> Bool
ltUnique :: Unique -> Unique -> Bool
ltUnique (MkUnique u1 :: Int
u1) (MkUnique u2 :: Int
u2) = Int
u1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
u2

-- Provided here to make it explicit at the call-site that it can
-- introduce non-determinism.
-- See Note [Unique Determinism]
-- See Note [No Ord for Unique]
nonDetCmpUnique :: Unique -> Unique -> Ordering
nonDetCmpUnique :: Unique -> Unique -> Ordering
nonDetCmpUnique (MkUnique u1 :: Int
u1) (MkUnique u2 :: Int
u2)
  = if Int
u1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
u2 then Ordering
EQ else if Int
u1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
u2 then Ordering
LT else Ordering
GT

{-
Note [No Ord for Unique]
~~~~~~~~~~~~~~~~~~~~~~~~~~
As explained in Note [Unique Determinism] the relative order of Uniques
is nondeterministic. To prevent from accidental use the Ord Unique
instance has been removed.
This makes it easier to maintain deterministic builds, but comes with some
drawbacks.
The biggest drawback is that Maps keyed by Uniques can't directly be used.
The alternatives are:

  1) Use UniqFM or UniqDFM, see Note [Deterministic UniqFM] to decide which
  2) Create a newtype wrapper based on Unique ordering where nondeterminism
     is controlled. See Module.ModuleEnv
  3) Change the algorithm to use nonDetCmpUnique and document why it's still
     deterministic
  4) Use TrieMap as done in CmmCommonBlockElim.groupByLabel
-}

instance Eq Unique where
    a :: Unique
a == :: Unique -> Unique -> Bool
== b :: Unique
b = Unique -> Unique -> Bool
eqUnique Unique
a Unique
b
    a :: Unique
a /= :: Unique -> Unique -> Bool
/= b :: Unique
b = Bool -> Bool
not (Unique -> Unique -> Bool
eqUnique Unique
a Unique
b)

instance Uniquable Unique where
    getUnique :: Unique -> Unique
getUnique u :: Unique
u = Unique
u

-- We do sometimes make strings with @Uniques@ in them:

showUnique :: Unique -> String
showUnique :: Unique -> String
showUnique uniq :: Unique
uniq
  = case Unique -> (Char, Int)
unpkUnique Unique
uniq of
      (tag :: Char
tag, u :: Int
u) -> Char -> Int -> String -> String
finish_show Char
tag Int
u (Int -> String
iToBase62 Int
u)

finish_show :: Char -> Int -> String -> String
finish_show :: Char -> Int -> String -> String
finish_show 't' u :: Int
u _pp_u :: String
_pp_u | Int
u Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 26
  = -- Special case to make v common tyvars, t1, t2, ...
    -- come out as a, b, ... (shorter, easier to read)
    [Int -> Char
chr (Char -> Int
ord 'a' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
u)]
finish_show tag :: Char
tag _ pp_u :: String
pp_u = Char
tag Char -> String -> String
forall a. a -> [a] -> [a]
: String
pp_u

pprUniqueAlways :: Unique -> SDoc
-- The "always" means regardless of -dsuppress-uniques
-- It replaces the old pprUnique to remind callers that
-- they should consider whether they want to consult
-- Opt_SuppressUniques
pprUniqueAlways :: Unique -> SDoc
pprUniqueAlways u :: Unique
u
  = String -> SDoc
text (Unique -> String
showUnique Unique
u)

instance Outputable Unique where
    ppr :: Unique -> SDoc
ppr = Unique -> SDoc
pprUniqueAlways

instance Show Unique where
    show :: Unique -> String
show uniq :: Unique
uniq = Unique -> String
showUnique Unique
uniq

{-
************************************************************************
*                                                                      *
\subsection[Utils-base62]{Base-62 numbers}
*                                                                      *
************************************************************************

A character-stingy way to read/write numbers (notably Uniques).
The ``62-its'' are \tr{[0-9a-zA-Z]}.  We don't handle negative Ints.
Code stolen from Lennart.
-}

iToBase62 :: Int -> String
iToBase62 :: Int -> String
iToBase62 n_ :: Int
n_
  = ASSERT(n_ >= 0) go n_ ""
  where
    go :: Int -> String -> String
go n :: Int
n cs :: String
cs | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 62
            = let !c :: Char
c = Int -> Char
chooseChar62 Int
n in Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String
cs
            | Bool
otherwise
            = Int -> String -> String
go Int
q (Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String
cs) where (!Int
q, r :: Int
r) = Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
quotRem Int
n 62
                                  !c :: Char
c = Int -> Char
chooseChar62 Int
r

    chooseChar62 :: Int -> Char
    {-# INLINE chooseChar62 #-}
    chooseChar62 :: Int -> Char
chooseChar62 (I# n :: Int#
n) = Char# -> Char
C# (Addr# -> Int# -> Char#
indexCharOffAddr# Addr#
chars62 Int#
n)
    chars62 :: Addr#
chars62 = "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"#

{-
************************************************************************
*                                                                      *
\subsection[Uniques-prelude]{@Uniques@ for wired-in Prelude things}
*                                                                      *
************************************************************************

Allocation of unique supply characters:
        v,t,u : for renumbering value-, type- and usage- vars.
        B:   builtin
        C-E: pseudo uniques     (used in native-code generator)
        X:   uniques derived by deriveUnique
        _:   unifiable tyvars   (above)
        0-9: prelude things below
             (no numbers left any more..)
        ::   (prelude) parallel array data constructors

        other a-z: lower case chars for unique supplies.  Used so far:

        d       desugarer
        f       AbsC flattener
        g       SimplStg
        k       constraint tuple tycons
        m       constraint tuple datacons
        n       Native codegen
        r       Hsc name cache
        s       simplifier
        z       anonymous sums
-}

mkAlphaTyVarUnique     :: Int -> Unique
mkPreludeClassUnique   :: Int -> Unique
mkPreludeTyConUnique   :: Int -> Unique
mkPreludeDataConUnique :: Arity -> Unique
mkPrimOpIdUnique       :: Int -> Unique
-- See Note [Primop wrappers] in PrimOp.hs.
mkPrimOpWrapperUnique  :: Int -> Unique
mkPreludeMiscIdUnique  :: Int -> Unique
mkCoVarUnique          :: Int -> Unique

mkAlphaTyVarUnique :: Int -> Unique
mkAlphaTyVarUnique   i :: Int
i = Char -> Int -> Unique
mkUnique '1' Int
i
mkCoVarUnique :: Int -> Unique
mkCoVarUnique        i :: Int
i = Char -> Int -> Unique
mkUnique 'g' Int
i
mkPreludeClassUnique :: Int -> Unique
mkPreludeClassUnique i :: Int
i = Char -> Int -> Unique
mkUnique '2' Int
i

--------------------------------------------------
-- Wired-in type constructor keys occupy *two* slots:
--    * u: the TyCon itself
--    * u+1: the TyConRepName of the TyCon
mkPreludeTyConUnique :: Int -> Unique
mkPreludeTyConUnique i :: Int
i                = Char -> Int -> Unique
mkUnique '3' (2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
i)

tyConRepNameUnique :: Unique -> Unique
tyConRepNameUnique :: Unique -> Unique
tyConRepNameUnique  u :: Unique
u = Unique -> Unique
incrUnique Unique
u

-- Data constructor keys occupy *two* slots.  The first is used for the
-- data constructor itself and its wrapper function (the function that
-- evaluates arguments as necessary and calls the worker). The second is
-- used for the worker function (the function that builds the constructor
-- representation).

--------------------------------------------------
-- Wired-in data constructor keys occupy *three* slots:
--    * u: the DataCon itself
--    * u+1: its worker Id
--    * u+2: the TyConRepName of the promoted TyCon
-- Prelude data constructors are too simple to need wrappers.

mkPreludeDataConUnique :: Int -> Unique
mkPreludeDataConUnique i :: Int
i              = Char -> Int -> Unique
mkUnique '6' (3Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
i)    -- Must be alphabetic

--------------------------------------------------
dataConTyRepNameUnique, dataConWorkerUnique :: Unique -> Unique
dataConWorkerUnique :: Unique -> Unique
dataConWorkerUnique  u :: Unique
u = Unique -> Unique
incrUnique Unique
u
dataConTyRepNameUnique :: Unique -> Unique
dataConTyRepNameUnique u :: Unique
u = Unique -> Int -> Unique
stepUnique Unique
u 2

--------------------------------------------------
mkPrimOpIdUnique :: Int -> Unique
mkPrimOpIdUnique op :: Int
op         = Char -> Int -> Unique
mkUnique '9' (2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
op)
mkPrimOpWrapperUnique :: Int -> Unique
mkPrimOpWrapperUnique op :: Int
op    = Char -> Int -> Unique
mkUnique '9' (2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
opInt -> Int -> Int
forall a. Num a => a -> a -> a
+1)
mkPreludeMiscIdUnique :: Int -> Unique
mkPreludeMiscIdUnique  i :: Int
i    = Char -> Int -> Unique
mkUnique '0' Int
i

-- The "tyvar uniques" print specially nicely: a, b, c, etc.
-- See pprUnique for details

initTyVarUnique :: Unique
initTyVarUnique :: Unique
initTyVarUnique = Char -> Int -> Unique
mkUnique 't' 0

mkPseudoUniqueD, mkPseudoUniqueE, mkPseudoUniqueH,
   mkBuiltinUnique :: Int -> Unique

mkBuiltinUnique :: Int -> Unique
mkBuiltinUnique i :: Int
i = Char -> Int -> Unique
mkUnique 'B' Int
i
mkPseudoUniqueD :: Int -> Unique
mkPseudoUniqueD i :: Int
i = Char -> Int -> Unique
mkUnique 'D' Int
i -- used in NCG for getUnique on RealRegs
mkPseudoUniqueE :: Int -> Unique
mkPseudoUniqueE i :: Int
i = Char -> Int -> Unique
mkUnique 'E' Int
i -- used in NCG spiller to create spill VirtualRegs
mkPseudoUniqueH :: Int -> Unique
mkPseudoUniqueH i :: Int
i = Char -> Int -> Unique
mkUnique 'H' Int
i -- used in NCG spiller to create spill VirtualRegs

mkRegSingleUnique, mkRegPairUnique, mkRegSubUnique, mkRegClassUnique :: Int -> Unique
mkRegSingleUnique :: Int -> Unique
mkRegSingleUnique = Char -> Int -> Unique
mkUnique 'R'
mkRegSubUnique :: Int -> Unique
mkRegSubUnique    = Char -> Int -> Unique
mkUnique 'S'
mkRegPairUnique :: Int -> Unique
mkRegPairUnique   = Char -> Int -> Unique
mkUnique 'P'
mkRegClassUnique :: Int -> Unique
mkRegClassUnique  = Char -> Int -> Unique
mkUnique 'L'

mkCostCentreUnique :: Int -> Unique
mkCostCentreUnique :: Int -> Unique
mkCostCentreUnique = Char -> Int -> Unique
mkUnique 'C'

mkVarOccUnique, mkDataOccUnique, mkTvOccUnique, mkTcOccUnique :: FastString -> Unique
-- See Note [The Unique of an OccName] in OccName
mkVarOccUnique :: FastString -> Unique
mkVarOccUnique  fs :: FastString
fs = Char -> Int -> Unique
mkUnique 'i' (FastString -> Int
uniqueOfFS FastString
fs)
mkDataOccUnique :: FastString -> Unique
mkDataOccUnique fs :: FastString
fs = Char -> Int -> Unique
mkUnique 'd' (FastString -> Int
uniqueOfFS FastString
fs)
mkTvOccUnique :: FastString -> Unique
mkTvOccUnique   fs :: FastString
fs = Char -> Int -> Unique
mkUnique 'v' (FastString -> Int
uniqueOfFS FastString
fs)
mkTcOccUnique :: FastString -> Unique
mkTcOccUnique   fs :: FastString
fs = Char -> Int -> Unique
mkUnique 'c' (FastString -> Int
uniqueOfFS FastString
fs)

initExitJoinUnique :: Unique
initExitJoinUnique :: Unique
initExitJoinUnique = Char -> Int -> Unique
mkUnique 's' 0