Unique.lhs 12.1 KB
Newer Older
1
%
Simon Marlow's avatar
Simon Marlow committed
2
% (c) The University of Glasgow 2006
3 4
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
5 6 7 8 9 10 11 12 13 14 15 16 17 18

@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).

\begin{code}
19
{-# LANGUAGE BangPatterns #-}
Ian Lynagh's avatar
Ian Lynagh committed
20 21 22 23 24 25 26 27

{-# OPTIONS -fno-warn-tabs #-}
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and
-- detab the module (please do the detabbing in a separate patch). See
--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
-- for details

28
module Unique (
batterseapower's avatar
batterseapower committed
29 30 31 32 33
        -- * Main data types
	Unique, Uniquable(..), 
	
	-- ** Constructors, desctructors and operations on 'Unique's
	hasKey,
34

35
	pprUnique, 
36 37

	mkUniqueGrimily,		-- Used in UniqSupply only!
38 39
        getKey, getKeyFastInt,		-- Used in Var, UniqFM, Name only!
        mkUnique, unpkUnique,           -- Used in BinIface only
40

41
	incrUnique,			-- Used for renumbering
42
	deriveUnique,			-- Ditto
43
	newTagUnique,			-- Used in CgCase
44
	initTyVarUnique,
45

batterseapower's avatar
batterseapower committed
46
	-- ** Making built-in uniques
batterseapower's avatar
batterseapower committed
47

48 49
	-- now all the built-in Uniques (and functions to make them)
	-- [the Oh-So-Wonderful Haskell module system wins again...]
50
	mkAlphaTyVarUnique,
51
	mkPrimOpIdUnique,
52 53 54
	mkTupleTyConUnique, mkTupleDataConUnique,
	mkPreludeMiscIdUnique, mkPreludeDataConUnique,
	mkPreludeTyConUnique, mkPreludeClassUnique,
chak's avatar
chak committed
55
	mkPArrDataConUnique,
56

batterseapower's avatar
batterseapower committed
57
    mkVarOccUnique, mkDataOccUnique, mkTvOccUnique, mkTcOccUnique,
58 59
        mkRegSingleUnique, mkRegPairUnique, mkRegClassUnique, mkRegSubUnique,

60
	mkBuiltinUnique,
61 62 63 64
	mkPseudoUniqueC,
	mkPseudoUniqueD,
	mkPseudoUniqueE,
	mkPseudoUniqueH
65 66
    ) where

67 68
#include "HsVersions.h"

Simon Marlow's avatar
Simon Marlow committed
69
import BasicTypes
70
import FastTypes
Simon Marlow's avatar
Simon Marlow committed
71
import FastString
72
import Outputable
73
-- import StaticFlags
74

75 76 77 78 79 80
#if defined(__GLASGOW_HASKELL__)
--just for implementing a fast [0,61) -> Char function
import GHC.Exts (indexCharOffAddr#, Char(..))
#else
import Data.Array
#endif
Simon Marlow's avatar
Simon Marlow committed
81
import Data.Char	( chr, ord )
82 83 84 85 86 87 88 89 90 91 92 93
\end{code}

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

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

\begin{code}
94
--why not newtype Int?
batterseapower's avatar
batterseapower committed
95 96 97 98

-- | 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
99
data Unique = MkUnique FastInt
100 101
\end{code}

102 103 104 105
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}
106
unpkUnique	:: Unique -> (Char, Int)	-- The reverse
107

108 109
mkUniqueGrimily :: Int -> Unique		-- A trap-door for UniqSupply
getKey		:: Unique -> Int		-- for Var
110
getKeyFastInt	:: Unique -> FastInt		-- for Var
111

112
incrUnique	:: Unique -> Unique
113
deriveUnique	:: Unique -> Int -> Unique
114
newTagUnique	:: Unique -> Char -> Unique
115 116 117 118
\end{code}


\begin{code}
119
mkUniqueGrimily x = MkUnique (iUnbox x)
120

121
{-# INLINE getKey #-}
122 123 124
getKey (MkUnique x) = iBox x
{-# INLINE getKeyFastInt #-}
getKeyFastInt (MkUnique x) = x
125

126
incrUnique (MkUnique i) = MkUnique (i +# _ILIT(1))
127 128 129

-- deriveUnique uses an 'X' tag so that it won't clash with
-- any of the uniques produced any other way
130
deriveUnique (MkUnique i) delta = mkUnique 'X' (iBox i + delta)
131

132 133 134
-- newTagUnique changes the "domain" of a unique to a different char
newTagUnique u c = mkUnique c i where (_,i) = unpkUnique u

135 136 137 138
-- 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

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

141 142 143
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
144 145
mkUnique c i
  = MkUnique (tag `bitOrFastInt` bits)
146
  where
147 148
    !tag  = fastOrd (cUnbox c) `shiftLFastInt` _ILIT(24)
    !bits = iUnbox i `bitAndFastInt` _ILIT(16777215){-``0x00ffffff''-}
149 150 151

unpkUnique (MkUnique u)
  = let
152 153 154 155
	-- as long as the Char may have its eighth bit set, we
	-- really do need the logical right-shift here!
	tag = cBox (fastChr (u `shiftRLFastInt` _ILIT(24)))
	i   = iBox (u `bitAndFastInt` _ILIT(16777215){-``0x00ffffff''-})
156 157 158 159
    in
    (tag, i)
\end{code}

160 161 162 163 164 165 166 167 168


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

\begin{code}
batterseapower's avatar
batterseapower committed
169
-- | Class of things that we can obtain a 'Unique' from
170
class Uniquable a where
171
    getUnique :: a -> Unique
172

173 174 175
hasKey		:: Uniquable a => a -> Unique -> Bool
x `hasKey` k	= getUnique x == k

176
instance Uniquable FastString where
177
 getUnique fs = mkUniqueGrimily (iBox (uniqueOfFS fs))
178 179

instance Uniquable Int where
180
 getUnique i = mkUniqueGrimily i
181 182 183

instance Uniquable n => Uniquable (IPName n) where
  getUnique (IPName n) = getUnique n
184 185 186
\end{code}


187 188 189 190 191 192 193 194 195 196 197
%************************************************************************
%*									*
\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).

\begin{code}
twanvl's avatar
twanvl committed
198
eqUnique, ltUnique, leUnique :: Unique -> Unique -> Bool
199 200 201 202
eqUnique (MkUnique u1) (MkUnique u2) = u1 ==# u2
ltUnique (MkUnique u1) (MkUnique u2) = u1 <#  u2
leUnique (MkUnique u1) (MkUnique u2) = u1 <=# u2

twanvl's avatar
twanvl committed
203
cmpUnique :: Unique -> Unique -> Ordering
204
cmpUnique (MkUnique u1) (MkUnique u2)
205
  = if u1 ==# u2 then EQ else if u1 <# u2 then LT else GT
206 207 208 209 210 211 212 213 214 215

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)
216
    compare a b = cmpUnique a b
217

218 219
-----------------
instance Uniquable Unique where
220
    getUnique u = u
221 222 223 224
\end{code}

We do sometimes make strings with @Uniques@ in them:
\begin{code}
225
pprUnique :: Unique -> SDoc
226
pprUnique uniq
227 228 229
--   | opt_SuppressUniques
--  = empty	-- Used exclusively to suppress uniques so you 
--  | otherwise	-- can compare output easily
230
  = case unpkUnique uniq of
231
      (tag, u) -> finish_ppr tag u (text (iToBase62 u))
232

233 234
#ifdef UNUSED
pprUnique10 :: Unique -> SDoc
235 236
pprUnique10 uniq	-- in base-10, dudes
  = case unpkUnique uniq of
sof's avatar
sof committed
237
      (tag, u) -> finish_ppr tag u (int u)
238
#endif
239

twanvl's avatar
twanvl committed
240 241
finish_ppr :: Char -> Int -> SDoc -> SDoc
finish_ppr 't' u _pp_u | u < 26
sof's avatar
sof committed
242 243 244
  =	-- Special case to make v common tyvars, t1, t2, ...
	-- come out as a, b, ... (shorter, easier to read)
    char (chr (ord 'a' + u))
twanvl's avatar
twanvl committed
245
finish_ppr tag _ pp_u = char tag <> pp_u
246

247
instance Outputable Unique where
248
    ppr u = pprUnique u
249

250 251
instance Show Unique where
    showsPrec p uniq = showsPrecSDoc p (pprUnique uniq)
252 253 254 255 256 257 258 259 260 261 262
\end{code}

%************************************************************************
%*									*
\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.
263

264
\begin{code}
265
iToBase62 :: Int -> String
266 267
iToBase62 n_
  = ASSERT(n_ >= 0) go (iUnbox n_) ""
268
  where
269 270
    go n cs | n <# _ILIT(62)
	     = case chooseChar62 n of { c -> c `seq` (c : cs) }
271
	     | otherwise
272 273 274 275 276 277 278 279 280 281
	     =	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
    {-# INLINE chooseChar62 #-}
#if defined(__GLASGOW_HASKELL__)
    --then FastInt == Int#
    chooseChar62 n = C# (indexCharOffAddr# chars62 n)
282
    !chars62 = "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"#
283 284 285 286 287
#else
    --Haskell98 arrays are portable
    chooseChar62 n = (!) chars62 n
    chars62 = listArray (0,61) "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
#endif
288 289 290 291 292 293 294 295
\end{code}

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

296
Allocation of unique supply characters:
297 298 299
	v,t,u : for renumbering value-, type- and usage- vars.
	B:   builtin
	C-E: pseudo uniques	(used in native-code generator)
300
	X:   uniques derived by deriveUnique
301
	_:   unifiable tyvars   (above)
302
	0-9: prelude things below
batterseapower's avatar
batterseapower committed
303 304
	     (no numbers left any more..)
	::   (prelude) parallel array data constructors
305

306 307 308 309 310 311 312 313 314
	other a-z: 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

315
\begin{code}
twanvl's avatar
twanvl committed
316 317 318
mkAlphaTyVarUnique     :: Int -> Unique
mkPreludeClassUnique   :: Int -> Unique
mkPreludeTyConUnique   :: Int -> Unique
batterseapower's avatar
batterseapower committed
319
mkTupleTyConUnique     :: TupleSort -> Int -> Unique
twanvl's avatar
twanvl committed
320
mkPreludeDataConUnique :: Int -> Unique
batterseapower's avatar
batterseapower committed
321
mkTupleDataConUnique   :: TupleSort -> Int -> Unique
twanvl's avatar
twanvl committed
322 323 324 325
mkPrimOpIdUnique       :: Int -> Unique
mkPreludeMiscIdUnique  :: Int -> Unique
mkPArrDataConUnique    :: Int -> Unique

326
mkAlphaTyVarUnique i            = mkUnique '1' i
327

twanvl's avatar
twanvl committed
328
mkPreludeClassUnique i          = mkUnique '2' i
329 330 331 332 333

-- Prelude type constructors occupy *three* slots.
-- The first is for the tycon itself; the latter two
-- are for the generic to/from Ids.  See TysWiredIn.mk_tc_gen_info.

334
mkPreludeTyConUnique i		= mkUnique '3' (3*i)
batterseapower's avatar
batterseapower committed
335 336
mkTupleTyConUnique BoxedTuple   a	= mkUnique '4' (3*a)
mkTupleTyConUnique UnboxedTuple a	= mkUnique '5' (3*a)
337
mkTupleTyConUnique ConstraintTuple a	= mkUnique 'k' (3*a)
338

339 340 341 342 343 344 345
-- 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).

mkPreludeDataConUnique i	= mkUnique '6' (2*i)	-- Must be alphabetic
batterseapower's avatar
batterseapower committed
346
mkTupleDataConUnique BoxedTuple   a = mkUnique '7' (2*a)	-- ditto (*may* be used in C labels)
347 348
mkTupleDataConUnique UnboxedTuple    a = mkUnique '8' (2*a)
mkTupleDataConUnique ConstraintTuple a = mkUnique 'h' (2*a)
349

batterseapower's avatar
batterseapower committed
350 351
mkPrimOpIdUnique op         = mkUnique '9' op
mkPreludeMiscIdUnique  i    = mkUnique '0' i
352

353
-- No numbers left anymore, so I pick something different for the character tag 
chak's avatar
chak committed
354 355
mkPArrDataConUnique a	        = mkUnique ':' (2*a)

sof's avatar
sof committed
356 357 358 359 360 361
-- The "tyvar uniques" print specially nicely: a, b, c, etc.
-- See pprUnique for details

initTyVarUnique :: Unique
initTyVarUnique = mkUnique 't' 0

362
mkPseudoUniqueC, mkPseudoUniqueD, mkPseudoUniqueE, mkPseudoUniqueH,
363
   mkBuiltinUnique :: Int -> Unique
364 365

mkBuiltinUnique i = mkUnique 'B' i
366 367 368 369
mkPseudoUniqueC i = mkUnique 'C' i -- used for getUnique on Regs
mkPseudoUniqueD i = mkUnique 'D' i -- used in NCG for getUnique on RealRegs
mkPseudoUniqueE i = mkUnique 'E' i -- used in NCG spiller to create spill VirtualRegs
mkPseudoUniqueH i = mkUnique 'H' i -- used in NCG spiller to create spill VirtualRegs
370 371 372 373 374 375 376 377 378 379 380 381 382

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

mkVarOccUnique, mkDataOccUnique, mkTvOccUnique, mkTcOccUnique :: FastString -> Unique
-- See Note [The Unique of an OccName] in OccName
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))
383 384
\end{code}