Unique.lhs 9.15 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
19

@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}
module Unique (
20
	Unique, Uniquable(..), hasKey,
21

22
	pprUnique, 
23
24
25

	mkUnique,			-- Used in UniqSupply
	mkUniqueGrimily,		-- Used in UniqSupply only!
26
	getKey, getKey#,		-- Used in Var, UniqFM, Name only!
27

28
	incrUnique,			-- Used for renumbering
29
	deriveUnique,			-- Ditto
30
	newTagUnique,			-- Used in CgCase
31
	initTyVarUnique,
32

33
	isTupleKey, 
34

35
36
	-- now all the built-in Uniques (and functions to make them)
	-- [the Oh-So-Wonderful Haskell module system wins again...]
37
	mkAlphaTyVarUnique,
38
	mkPrimOpIdUnique,
39
40
41
	mkTupleTyConUnique, mkTupleDataConUnique,
	mkPreludeMiscIdUnique, mkPreludeDataConUnique,
	mkPreludeTyConUnique, mkPreludeClassUnique,
chak's avatar
chak committed
42
	mkPArrDataConUnique,
43

44
	mkBuiltinUnique,
45
46
47
48
	mkPseudoUniqueC,
	mkPseudoUniqueD,
	mkPseudoUniqueE,
	mkPseudoUniqueH
49
50
    ) where

51
52
#include "HsVersions.h"

Simon Marlow's avatar
Simon Marlow committed
53
54
55
import BasicTypes
import PackageConfig
import FastString
56
import Outputable
57
import FastTypes
58

Simon Marlow's avatar
Simon Marlow committed
59
60
import GHC.Exts
import Data.Char	( chr, ord )
61
62
63
64
65
66
67
68
69
70
71
72
73
\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}
data Unique = MkUnique Int#
74
75
\end{code}

76
77
78
79
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}
80
81
mkUnique	:: Char -> Int -> Unique	-- Builds a unique from pieces
unpkUnique	:: Unique -> (Char, Int)	-- The reverse
82

83
84
85
mkUniqueGrimily :: Int -> Unique		-- A trap-door for UniqSupply
getKey		:: Unique -> Int		-- for Var
getKey#		:: Unique -> Int#		-- for Var
86

87
incrUnique	:: Unique -> Unique
88
deriveUnique	:: Unique -> Int -> Unique
89
newTagUnique	:: Unique -> Char -> Unique
90
91

isTupleKey	:: Unique -> Bool
92
93
94
95
\end{code}


\begin{code}
96
mkUniqueGrimily (I# x) = MkUnique x
97

98
{-# INLINE getKey #-}
99
100
101
getKey (MkUnique x) = I# x
{-# INLINE getKey# #-}
getKey# (MkUnique x) = x
102

103
104
105
106
107
incrUnique (MkUnique i) = MkUnique (i +# 1#)

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

109
110
111
-- newTagUnique changes the "domain" of a unique to a different char
newTagUnique u c = mkUnique c i where (_,i) = unpkUnique u

112
113
114
115
116
117
118
119
-- 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

w2i x = word2Int# x
i2w x = int2Word# x
i2w_s x = (x::Int#)

120
mkUnique (C# c) (I# i)
121
122
  = MkUnique (w2i (tag `or#` bits))
  where
123
    tag  = i2w (ord# c) `uncheckedShiftL#` i2w_s 24#
124
    bits = i2w i `and#` (i2w 16777215#){-``0x00ffffff''-}
125
126
127

unpkUnique (MkUnique u)
  = let
128
	tag = C# (chr# (w2i ((i2w u) `uncheckedShiftRL#` (i2w_s 24#))))
129
	i   = I# (w2i ((i2w u) `and#` (i2w 16777215#){-``0x00ffffff''-}))
130
131
132
133
    in
    (tag, i)
\end{code}

134
135
136
137
138
139
140
141
142
143


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

\begin{code}
class Uniquable a where
144
    getUnique :: a -> Unique
145

146
147
148
hasKey		:: Uniquable a => a -> Unique -> Bool
x `hasKey` k	= getUnique x == k

149
instance Uniquable FastString where
150
 getUnique fs = mkUniqueGrimily (I# (uniqueOfFS fs))
151

152
153
154
instance Uniquable PackageId where
 getUnique pid = getUnique (packageIdFS pid)

155
instance Uniquable Int where
156
 getUnique i = mkUniqueGrimily i
157
158
159
\end{code}


160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
%************************************************************************
%*									*
\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}
eqUnique (MkUnique u1) (MkUnique u2) = u1 ==# u2
ltUnique (MkUnique u1) (MkUnique u2) = u1 <#  u2
leUnique (MkUnique u1) (MkUnique u2) = u1 <=# u2

cmpUnique (MkUnique u1) (MkUnique u2)
176
  = if u1 ==# u2 then EQ else if u1 <# u2 then LT else GT
177
178
179
180
181
182
183
184
185
186

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)
187
    compare a b = cmpUnique a b
188

189
190
-----------------
instance Uniquable Unique where
191
    getUnique u = u
192
193
194
195
\end{code}

We do sometimes make strings with @Uniques@ in them:
\begin{code}
196
pprUnique :: Unique -> SDoc
197
198
pprUnique uniq
  = case unpkUnique uniq of
199
      (tag, u) -> finish_ppr tag u (text (iToBase62 u))
200

201
202
#ifdef UNUSED
pprUnique10 :: Unique -> SDoc
203
204
pprUnique10 uniq	-- in base-10, dudes
  = case unpkUnique uniq of
sof's avatar
sof committed
205
      (tag, u) -> finish_ppr tag u (int u)
206
#endif
207

sof's avatar
sof committed
208
209
210
211
212
finish_ppr 't' u pp_u | u < 26
  =	-- Special case to make v common tyvars, t1, t2, ...
	-- come out as a, b, ... (shorter, easier to read)
    char (chr (ord 'a' + u))
finish_ppr tag u pp_u = char tag <> pp_u
213

214
instance Outputable Unique where
215
    ppr u = pprUnique u
216

217
218
instance Show Unique where
    showsPrec p uniq = showsPrecSDoc p (pprUnique uniq)
219
220
221
222
223
224
225
226
227
228
229
\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.
230

231
\begin{code}
232
233
234
iToBase62 :: Int -> String
iToBase62 n@(I# n#) 
  = ASSERT(n >= 0) go n# ""
235
  where
236
237
238
239
240
241
242
243
    go n# cs | n# <# 62# 
	     = case (indexCharOffAddr# chars62# n#) of { c# -> C# c# : cs }
	     | otherwise
	     =	case (quotRem (I# n#) 62)	     of { (I# q#, I# r#) ->
		case (indexCharOffAddr# chars62# r#) of { c#  ->
		go q# (C# c# : cs) }}

    chars62# = "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"#
244
245
246
247
248
249
250
251
\end{code}

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

252
Allocation of unique supply characters:
253
254
255
	v,t,u : for renumbering value-, type- and usage- vars.
	B:   builtin
	C-E: pseudo uniques	(used in native-code generator)
256
	X:   uniques derived by deriveUnique
257
	_:   unifiable tyvars   (above)
258
	0-9: prelude things below
259

260
261
262
263
264
265
266
267
268
269
	other a-z: lower case chars for unique supplies.  Used so far:

	d	desugarer
	f	AbsC flattener
	g	SimplStg
	l	ndpFlatten
	n	Native codegen
	r	Hsc name cache
	s	simplifier

270
\begin{code}
271
mkAlphaTyVarUnique i            = mkUnique '1' i
272
273

mkPreludeClassUnique i		= mkUnique '2' i
274
275
276
277
278

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

279
mkPreludeTyConUnique i		= mkUnique '3' (3*i)
280
281
mkTupleTyConUnique Boxed   a	= mkUnique '4' (3*a)
mkTupleTyConUnique Unboxed a	= mkUnique '5' (3*a)
282

283
284
285
286
287
288
289
-- 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
290
291
mkTupleDataConUnique Boxed a	= mkUnique '7' (2*a)	-- ditto (*may* be used in C labels)
mkTupleDataConUnique Unboxed a	= mkUnique '8' (2*a)
292
293
294
295
296

-- This one is used for a tiresome reason
-- to improve a consistency-checking error check in the renamer
isTupleKey u = case unpkUnique u of
		(tag,_) -> tag == '4' || tag == '5' || tag == '7' || tag == '8'
297

298
299
mkPrimOpIdUnique op		= mkUnique '9' op
mkPreludeMiscIdUnique i		= mkUnique '0' i
300

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

sof's avatar
sof committed
305
306
307
308
309
310
-- The "tyvar uniques" print specially nicely: a, b, c, etc.
-- See pprUnique for details

initTyVarUnique :: Unique
initTyVarUnique = mkUnique 't' 0

311
mkPseudoUniqueC, mkPseudoUniqueD, mkPseudoUniqueE, mkPseudoUniqueH,
312
   mkBuiltinUnique :: Int -> Unique
313
314

mkBuiltinUnique i = mkUnique 'B' i
315
316
317
318
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
319
320
\end{code}