12629ff91ad306f3d50cc8d0995514106e1d956d
[ghc.git] / compiler / basicTypes / Unique.hs
1 {-
2 (c) The University of Glasgow 2006
3 (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4
5
6 @Uniques@ are used to distinguish entities in the compiler (@Ids@,
7 @Classes@, etc.) from each other. Thus, @Uniques@ are the basic
8 comparison key in the compiler.
9
10 If there is any single operation that needs to be fast, it is @Unique@
11 comparison. Unsurprisingly, there is quite a bit of huff-and-puff
12 directed to that end.
13
14 Some of the other hair in this code is to be able to use a
15 ``splittable @UniqueSupply@'' if requested/possible (not standard
16 Haskell).
17 -}
18
19 {-# LANGUAGE CPP, BangPatterns, MagicHash #-}
20
21 module Unique (
22 -- * Main data types
23 Unique, Uniquable(..),
24
25 -- ** Constructors, desctructors and operations on 'Unique's
26 hasKey,
27
28 pprUnique,
29
30 mkUniqueGrimily, -- Used in UniqSupply only!
31 getKey, -- Used in Var, UniqFM, Name only!
32 mkUnique, unpkUnique, -- Used in BinIface only
33
34 incrUnique, -- Used for renumbering
35 deriveUnique, -- Ditto
36 newTagUnique, -- Used in CgCase
37 initTyVarUnique,
38
39 -- ** Making built-in uniques
40
41 -- now all the built-in Uniques (and functions to make them)
42 -- [the Oh-So-Wonderful Haskell module system wins again...]
43 mkAlphaTyVarUnique,
44 mkPrimOpIdUnique,
45 mkTupleTyConUnique, mkTupleDataConUnique,
46 mkCTupleTyConUnique,
47 mkPreludeMiscIdUnique, mkPreludeDataConUnique,
48 mkPreludeTyConUnique, mkPreludeClassUnique,
49 mkPArrDataConUnique,
50
51 mkVarOccUnique, mkDataOccUnique, mkTvOccUnique, mkTcOccUnique,
52 mkRegSingleUnique, mkRegPairUnique, mkRegClassUnique, mkRegSubUnique,
53 mkCostCentreUnique,
54
55 mkBuiltinUnique,
56 mkPseudoUniqueD,
57 mkPseudoUniqueE,
58 mkPseudoUniqueH
59 ) where
60
61 #include "HsVersions.h"
62
63 import BasicTypes
64 import FastString
65 import Outputable
66 import Util
67
68 -- just for implementing a fast [0,61) -> Char function
69 import GHC.Exts (indexCharOffAddr#, Char(..), Int(..))
70
71 import Data.Char ( chr, ord )
72 import Data.Bits
73
74 {-
75 ************************************************************************
76 * *
77 \subsection[Unique-type]{@Unique@ type and operations}
78 * *
79 ************************************************************************
80
81 The @Chars@ are ``tag letters'' that identify the @UniqueSupply@.
82 Fast comparison is everything on @Uniques@:
83 -}
84
85 --why not newtype Int?
86
87 -- | The type of unique identifiers that are used in many places in GHC
88 -- for fast ordering and equality tests. You should generate these with
89 -- the functions from the 'UniqSupply' module
90 data Unique = MkUnique {-# UNPACK #-} !Int
91
92 {-
93 Now come the functions which construct uniques from their pieces, and vice versa.
94 The stuff about unique *supplies* is handled further down this module.
95 -}
96
97 unpkUnique :: Unique -> (Char, Int) -- The reverse
98
99 mkUniqueGrimily :: Int -> Unique -- A trap-door for UniqSupply
100 getKey :: Unique -> Int -- for Var
101
102 incrUnique :: Unique -> Unique
103 deriveUnique :: Unique -> Int -> Unique
104 newTagUnique :: Unique -> Char -> Unique
105
106 mkUniqueGrimily = MkUnique
107
108 {-# INLINE getKey #-}
109 getKey (MkUnique x) = x
110
111 incrUnique (MkUnique i) = MkUnique (i + 1)
112
113 -- deriveUnique uses an 'X' tag so that it won't clash with
114 -- any of the uniques produced any other way
115 deriveUnique (MkUnique i) delta = mkUnique 'X' (i + delta)
116
117 -- newTagUnique changes the "domain" of a unique to a different char
118 newTagUnique u c = mkUnique c i where (_,i) = unpkUnique u
119
120 -- pop the Char in the top 8 bits of the Unique(Supply)
121
122 -- No 64-bit bugs here, as long as we have at least 32 bits. --JSM
123
124 -- and as long as the Char fits in 8 bits, which we assume anyway!
125
126 mkUnique :: Char -> Int -> Unique -- Builds a unique from pieces
127 -- NOT EXPORTED, so that we can see all the Chars that
128 -- are used in this one module
129 mkUnique c i
130 = MkUnique (tag .|. bits)
131 where
132 tag = ord c `shiftL` 24
133 bits = i .&. 16777215 {-``0x00ffffff''-}
134
135 unpkUnique (MkUnique u)
136 = let
137 -- as long as the Char may have its eighth bit set, we
138 -- really do need the logical right-shift here!
139 tag = chr (u `shiftR` 24)
140 i = u .&. 16777215 {-``0x00ffffff''-}
141 in
142 (tag, i)
143
144 {-
145 ************************************************************************
146 * *
147 \subsection[Uniquable-class]{The @Uniquable@ class}
148 * *
149 ************************************************************************
150 -}
151
152 -- | Class of things that we can obtain a 'Unique' from
153 class Uniquable a where
154 getUnique :: a -> Unique
155
156 hasKey :: Uniquable a => a -> Unique -> Bool
157 x `hasKey` k = getUnique x == k
158
159 instance Uniquable FastString where
160 getUnique fs = mkUniqueGrimily (uniqueOfFS fs)
161
162 instance Uniquable Int where
163 getUnique i = mkUniqueGrimily i
164
165 {-
166 ************************************************************************
167 * *
168 \subsection[Unique-instances]{Instance declarations for @Unique@}
169 * *
170 ************************************************************************
171
172 And the whole point (besides uniqueness) is fast equality. We don't
173 use `deriving' because we want {\em precise} control of ordering
174 (equality on @Uniques@ is v common).
175 -}
176
177 -- Note [Unique Determinism]
178 -- ~~~~~~~~~~~~~~~~~~~~~~~~~
179 -- The order of allocated @Uniques@ is not stable across rebuilds.
180 -- The main reason for that is that typechecking interface files pulls
181 -- @Uniques@ from @UniqSupply@ and the interface file for the module being
182 -- currently compiled can, but doesn't have to exist.
183 --
184 -- It gets more complicated if you take into account that the interface
185 -- files are loaded lazily and that building multiple files at once has to
186 -- work for any subset of interface files present. When you add parallelism
187 -- this makes @Uniques@ hopelessly random.
188 --
189 -- As such, to get deterministic builds, the order of the allocated
190 -- @Uniques@ should not affect the final result.
191 -- see also wiki/DeterministicBuilds
192
193 eqUnique, ltUnique, leUnique :: Unique -> Unique -> Bool
194 eqUnique (MkUnique u1) (MkUnique u2) = u1 == u2
195 ltUnique (MkUnique u1) (MkUnique u2) = u1 < u2
196 leUnique (MkUnique u1) (MkUnique u2) = u1 <= u2
197
198 cmpUnique :: Unique -> Unique -> Ordering
199 cmpUnique (MkUnique u1) (MkUnique u2)
200 = if u1 == u2 then EQ else if u1 < u2 then LT else GT
201
202 instance Eq Unique where
203 a == b = eqUnique a b
204 a /= b = not (eqUnique a b)
205
206 instance Ord Unique where
207 a < b = ltUnique a b
208 a <= b = leUnique a b
209 a > b = not (leUnique a b)
210 a >= b = not (ltUnique a b)
211 compare a b = cmpUnique a b
212
213 -----------------
214 instance Uniquable Unique where
215 getUnique u = u
216
217 -- We do sometimes make strings with @Uniques@ in them:
218
219 showUnique :: Unique -> String
220 showUnique uniq
221 = case unpkUnique uniq of
222 (tag, u) -> finish_show tag u (iToBase62 u)
223
224 finish_show :: Char -> Int -> String -> String
225 finish_show 't' u _pp_u | u < 26
226 = -- Special case to make v common tyvars, t1, t2, ...
227 -- come out as a, b, ... (shorter, easier to read)
228 [chr (ord 'a' + u)]
229 finish_show tag _ pp_u = tag : pp_u
230
231 pprUnique :: Unique -> SDoc
232 pprUnique u = text (showUnique u)
233
234 instance Outputable Unique where
235 ppr = pprUnique
236
237 instance Show Unique where
238 show uniq = showUnique uniq
239
240 {-
241 ************************************************************************
242 * *
243 \subsection[Utils-base62]{Base-62 numbers}
244 * *
245 ************************************************************************
246
247 A character-stingy way to read/write numbers (notably Uniques).
248 The ``62-its'' are \tr{[0-9a-zA-Z]}. We don't handle negative Ints.
249 Code stolen from Lennart.
250 -}
251
252 iToBase62 :: Int -> String
253 iToBase62 n_
254 = ASSERT(n_ >= 0) go n_ ""
255 where
256 go n cs | n < 62
257 = let !c = chooseChar62 n in c : cs
258 | otherwise
259 = go q (c : cs) where (q, r) = quotRem n 62
260 !c = chooseChar62 r
261
262 chooseChar62 :: Int -> Char
263 {-# INLINE chooseChar62 #-}
264 chooseChar62 (I# n) = C# (indexCharOffAddr# chars62 n)
265 chars62 = "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"#
266
267 {-
268 ************************************************************************
269 * *
270 \subsection[Uniques-prelude]{@Uniques@ for wired-in Prelude things}
271 * *
272 ************************************************************************
273
274 Allocation of unique supply characters:
275 v,t,u : for renumbering value-, type- and usage- vars.
276 B: builtin
277 C-E: pseudo uniques (used in native-code generator)
278 X: uniques derived by deriveUnique
279 _: unifiable tyvars (above)
280 0-9: prelude things below
281 (no numbers left any more..)
282 :: (prelude) parallel array data constructors
283
284 other a-z: lower case chars for unique supplies. Used so far:
285
286 d desugarer
287 f AbsC flattener
288 g SimplStg
289 n Native codegen
290 r Hsc name cache
291 s simplifier
292 -}
293
294 mkAlphaTyVarUnique :: Int -> Unique
295 mkPreludeClassUnique :: Int -> Unique
296 mkPreludeTyConUnique :: Int -> Unique
297 mkTupleTyConUnique :: Boxity -> Arity -> Unique
298 mkCTupleTyConUnique :: Arity -> Unique
299 mkPreludeDataConUnique :: Arity -> Unique
300 mkTupleDataConUnique :: Boxity -> Arity -> Unique
301 mkPrimOpIdUnique :: Int -> Unique
302 mkPreludeMiscIdUnique :: Int -> Unique
303 mkPArrDataConUnique :: Int -> Unique
304
305 mkAlphaTyVarUnique i = mkUnique '1' i
306 mkPreludeClassUnique i = mkUnique '2' i
307
308 -- Prelude type constructors occupy *three* slots.
309 -- The first is for the tycon itself; the latter two
310 -- are for the generic to/from Ids. See TysWiredIn.mk_tc_gen_info.
311
312 mkPreludeTyConUnique i = mkUnique '3' (3*i)
313 mkTupleTyConUnique Boxed a = mkUnique '4' (3*a)
314 mkTupleTyConUnique Unboxed a = mkUnique '5' (3*a)
315 mkCTupleTyConUnique a = mkUnique 'k' (3*a)
316
317 -- Data constructor keys occupy *two* slots. The first is used for the
318 -- data constructor itself and its wrapper function (the function that
319 -- evaluates arguments as necessary and calls the worker). The second is
320 -- used for the worker function (the function that builds the constructor
321 -- representation).
322
323 mkPreludeDataConUnique i = mkUnique '6' (2*i) -- Must be alphabetic
324 mkTupleDataConUnique Boxed a = mkUnique '7' (2*a) -- ditto (*may* be used in C labels)
325 mkTupleDataConUnique Unboxed a = mkUnique '8' (2*a)
326
327 mkPrimOpIdUnique op = mkUnique '9' op
328 mkPreludeMiscIdUnique i = mkUnique '0' i
329
330 -- No numbers left anymore, so I pick something different for the character tag
331 mkPArrDataConUnique a = mkUnique ':' (2*a)
332
333 -- The "tyvar uniques" print specially nicely: a, b, c, etc.
334 -- See pprUnique for details
335
336 initTyVarUnique :: Unique
337 initTyVarUnique = mkUnique 't' 0
338
339 mkPseudoUniqueD, mkPseudoUniqueE, mkPseudoUniqueH,
340 mkBuiltinUnique :: Int -> Unique
341
342 mkBuiltinUnique i = mkUnique 'B' i
343 mkPseudoUniqueD i = mkUnique 'D' i -- used in NCG for getUnique on RealRegs
344 mkPseudoUniqueE i = mkUnique 'E' i -- used in NCG spiller to create spill VirtualRegs
345 mkPseudoUniqueH i = mkUnique 'H' i -- used in NCG spiller to create spill VirtualRegs
346
347 mkRegSingleUnique, mkRegPairUnique, mkRegSubUnique, mkRegClassUnique :: Int -> Unique
348 mkRegSingleUnique = mkUnique 'R'
349 mkRegSubUnique = mkUnique 'S'
350 mkRegPairUnique = mkUnique 'P'
351 mkRegClassUnique = mkUnique 'L'
352
353 mkCostCentreUnique :: Int -> Unique
354 mkCostCentreUnique = mkUnique 'C'
355
356 mkVarOccUnique, mkDataOccUnique, mkTvOccUnique, mkTcOccUnique :: FastString -> Unique
357 -- See Note [The Unique of an OccName] in OccName
358 mkVarOccUnique fs = mkUnique 'i' (uniqueOfFS fs)
359 mkDataOccUnique fs = mkUnique 'd' (uniqueOfFS fs)
360 mkTvOccUnique fs = mkUnique 'v' (uniqueOfFS fs)
361 mkTcOccUnique fs = mkUnique 'c' (uniqueOfFS fs)