%
% (c) The University of Glasgow 2006
% (c) The GRASP/AQUA Project, Glasgow University, 19921998
%
@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 huffandpuff
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).
\begin{code}
module Unique (
Unique, Uniquable(..),
hasKey,
pprUnique,
mkUniqueGrimily,
getKey, getKeyFastInt,
incrUnique,
deriveUnique,
newTagUnique,
initTyVarUnique,
isTupleKey,
mkAlphaTyVarUnique,
mkPrimOpIdUnique,
mkTupleTyConUnique, mkTupleDataConUnique,
mkPreludeMiscIdUnique, mkPreludeDataConUnique,
mkPreludeTyConUnique, mkPreludeClassUnique,
mkPArrDataConUnique,
mkVarOccUnique, mkDataOccUnique, mkTvOccUnique, mkTcOccUnique,
mkRegSingleUnique, mkRegPairUnique, mkRegClassUnique, mkRegSubUnique,
mkBuiltinUnique,
mkPseudoUniqueC,
mkPseudoUniqueD,
mkPseudoUniqueE,
mkPseudoUniqueH
) where
#include "HsVersions.h"
import BasicTypes
import FastTypes
import FastString
import Outputable
#if defined(__GLASGOW_HASKELL__)
import GHC.Exts (indexCharOffAddr#, Char(..))
#else
import Data.Array
#endif
import Data.Char ( chr, ord )
\end{code}
%************************************************************************
%* *
\subsection[Uniquetype]{@Unique@ type and operations}
%* *
%************************************************************************
The @Chars@ are ``tag letters'' that identify the @UniqueSupply@.
Fast comparison is everything on @Uniques@:
\begin{code}
data Unique = MkUnique FastInt
\end{code}
Now come the functions which construct uniques from their pieces, and vice versa.
The stuff about unique *supplies* is handled further down this module.
\begin{code}
unpkUnique :: Unique -> (Char, Int)
mkUniqueGrimily :: Int -> Unique
getKey :: Unique -> Int
getKeyFastInt :: Unique -> FastInt
incrUnique :: Unique -> Unique
deriveUnique :: Unique -> Int -> Unique
newTagUnique :: Unique -> Char -> Unique
isTupleKey :: Unique -> Bool
\end{code}
\begin{code}
mkUniqueGrimily x = MkUnique (iUnbox x)
getKey (MkUnique x) = iBox x
getKeyFastInt (MkUnique x) = x
incrUnique (MkUnique i) = MkUnique (i +# _ILIT(1))
deriveUnique (MkUnique i) delta = mkUnique 'X' (iBox i + delta)
newTagUnique u c = mkUnique c i where (_,i) = unpkUnique u
mkUnique :: Char -> Int -> Unique
mkUnique c i
= MkUnique (tag `bitOrFastInt` bits)
where
!tag = fastOrd (cUnbox c) `shiftLFastInt` _ILIT(24)
!bits = iUnbox i `bitAndFastInt` _ILIT(16777215)
unpkUnique (MkUnique u)
= let
tag = cBox (fastChr (u `shiftRLFastInt` _ILIT(24)))
i = iBox (u `bitAndFastInt` _ILIT(16777215))
in
(tag, i)
\end{code}
%************************************************************************
%* *
\subsection[Uniquableclass]{The @Uniquable@ class}
%* *
%************************************************************************
\begin{code}
class Uniquable a where
getUnique :: a -> Unique
hasKey :: Uniquable a => a -> Unique -> Bool
x `hasKey` k = getUnique x == k
instance Uniquable FastString where
getUnique fs = mkUniqueGrimily (iBox (uniqueOfFS fs))
instance Uniquable Int where
getUnique i = mkUniqueGrimily i
\end{code}
%************************************************************************
%* *
\subsection[Uniqueinstances]{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).
\begin{code}
eqUnique, ltUnique, leUnique :: Unique -> Unique -> Bool
eqUnique (MkUnique u1) (MkUnique u2) = u1 ==# u2
ltUnique (MkUnique u1) (MkUnique u2) = u1 <# u2
leUnique (MkUnique u1) (MkUnique u2) = u1 <=# u2
cmpUnique :: Unique -> Unique -> Ordering
cmpUnique (MkUnique u1) (MkUnique u2)
= if u1 ==# u2 then EQ else if u1 <# u2 then LT else GT
instance Eq Unique where
a == b = eqUnique a b
a /= b = not (eqUnique a b)
instance Ord Unique where
a < b = ltUnique a b
a <= b = leUnique a b
a > b = not (leUnique a b)
a >= b = not (ltUnique a b)
compare a b = cmpUnique a b
instance Uniquable Unique where
getUnique u = u
\end{code}
We do sometimes make strings with @Uniques@ in them:
\begin{code}
pprUnique :: Unique -> SDoc
pprUnique uniq
= case unpkUnique uniq of
(tag, u) -> finish_ppr tag u (text (iToBase62 u))
#ifdef UNUSED
pprUnique10 :: Unique -> SDoc
pprUnique10 uniq
= case unpkUnique uniq of
(tag, u) -> finish_ppr tag u (int u)
#endif
finish_ppr :: Char -> Int -> SDoc -> SDoc
finish_ppr 't' u _pp_u | u < 26
=
char (chr (ord 'a' + u))
finish_ppr tag _ pp_u = char tag <> pp_u
instance Outputable Unique where
ppr u = pprUnique u
instance Show Unique where
showsPrec p uniq = showsPrecSDoc p (pprUnique uniq)
\end{code}
%************************************************************************
%* *
\subsection[Utilsbase62]{Base62 numbers}
%* *
%************************************************************************
A characterstingy way to read/write numbers (notably Uniques).
The ``62its'' are \tr{[09azAZ]}. We don't handle negative Ints.
Code stolen from Lennart.
\begin{code}
iToBase62 :: Int -> String
iToBase62 n_
= ASSERT(n_ >= 0) go (iUnbox n_) ""
where
go n cs | n <# _ILIT(62)
= case chooseChar62 n of { c -> c `seq` (c : cs) }
| otherwise
= case (quotRem (iBox n) 62) of { (q_, r_) ->
case iUnbox q_ of { q -> case iUnbox r_ of { r ->
case (chooseChar62 r) of { c -> c `seq`
(go q (c : cs)) }}}}
chooseChar62 :: FastInt -> Char
#if defined(__GLASGOW_HASKELL__)
chooseChar62 n = C# (indexCharOffAddr# chars62 n)
!chars62 = "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"#
#else
chooseChar62 n = (!) chars62 n
chars62 = listArray (0,61) "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
#endif
\end{code}
%************************************************************************
%* *
\subsection[Uniquesprelude]{@Uniques@ for wiredin Prelude things}
%* *
%************************************************************************
Allocation of unique supply characters:
v,t,u : for renumbering value, type and usage vars.
B: builtin
CE: pseudo uniques (used in nativecode generator)
X: uniques derived by deriveUnique
_: unifiable tyvars (above)
09: prelude things below
(no numbers left any more..)
:: (prelude) parallel array data constructors
other az: lower case chars for unique supplies. Used so far:
d desugarer
f AbsC flattener
g SimplStg
n Native codegen
r Hsc name cache
s simplifier
\begin{code}
mkAlphaTyVarUnique :: Int -> Unique
mkPreludeClassUnique :: Int -> Unique
mkPreludeTyConUnique :: Int -> Unique
mkTupleTyConUnique :: Boxity -> Int -> Unique
mkPreludeDataConUnique :: Int -> Unique
mkTupleDataConUnique :: Boxity -> Int -> Unique
mkPrimOpIdUnique :: Int -> Unique
mkPreludeMiscIdUnique :: Int -> Unique
mkPArrDataConUnique :: Int -> Unique
mkAlphaTyVarUnique i = mkUnique '1' i
mkPreludeClassUnique i = mkUnique '2' i
mkPreludeTyConUnique i = mkUnique '3' (3*i)
mkTupleTyConUnique Boxed a = mkUnique '4' (3*a)
mkTupleTyConUnique Unboxed a = mkUnique '5' (3*a)
mkPreludeDataConUnique i = mkUnique '6' (2*i)
mkTupleDataConUnique Boxed a = mkUnique '7' (2*a)
mkTupleDataConUnique Unboxed a = mkUnique '8' (2*a)
isTupleKey u = case unpkUnique u of
(tag,_) -> tag == '4' || tag == '5' || tag == '7' || tag == '8'
mkPrimOpIdUnique op = mkUnique '9' op
mkPreludeMiscIdUnique i = mkUnique '0' i
mkPArrDataConUnique a = mkUnique ':' (2*a)
initTyVarUnique :: Unique
initTyVarUnique = mkUnique 't' 0
mkPseudoUniqueC, mkPseudoUniqueD, mkPseudoUniqueE, mkPseudoUniqueH,
mkBuiltinUnique :: Int -> Unique
mkBuiltinUnique i = mkUnique 'B' i
mkPseudoUniqueC i = mkUnique 'C' i
mkPseudoUniqueD i = mkUnique 'D' i
mkPseudoUniqueE i = mkUnique 'E' i
mkPseudoUniqueH i = mkUnique 'H' i
mkRegSingleUnique, mkRegPairUnique, mkRegSubUnique, mkRegClassUnique :: Int -> Unique
mkRegSingleUnique = mkUnique 'R'
mkRegSubUnique = mkUnique 'S'
mkRegPairUnique = mkUnique 'P'
mkRegClassUnique = mkUnique 'L'
mkVarOccUnique, mkDataOccUnique, mkTvOccUnique, mkTcOccUnique :: FastString -> Unique
mkVarOccUnique fs = mkUnique 'i' (iBox (uniqueOfFS fs))
mkDataOccUnique fs = mkUnique 'd' (iBox (uniqueOfFS fs))
mkTvOccUnique fs = mkUnique 'v' (iBox (uniqueOfFS fs))
mkTcOccUnique fs = mkUnique 'c' (iBox (uniqueOfFS fs))
\end{code}