testsuite: Assert that testsuite ways are known
[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
12 comparison. Unsurprisingly, there is quite a bit of huff-and-puff
13 directed to that end.
14
15 Some of the other hair in this code is to be able to use a
16 ``splittable @UniqueSupply@'' if requested/possible (not standard
17 Haskell).
18 -}
19
20 {-# LANGUAGE CPP, BangPatterns, MagicHash #-}
21
22 module Unique (
23 -- * Main data types
24 Unique, Uniquable(..),
25 uNIQUE_BITS,
26
27 -- ** Constructors, destructors and operations on 'Unique's
28 hasKey,
29
30 pprUniqueAlways,
31
32 mkUniqueGrimily, -- Used in UniqSupply only!
33 getKey, -- Used in Var, UniqFM, Name only!
34 mkUnique, unpkUnique, -- Used in BinIface only
35 eqUnique, ltUnique,
36
37 deriveUnique, -- Ditto
38 newTagUnique, -- Used in CgCase
39 initTyVarUnique,
40 initExitJoinUnique,
41 nonDetCmpUnique,
42 isValidKnownKeyUnique, -- Used in PrelInfo.knownKeyNamesOkay
43
44 -- ** Making built-in uniques
45
46 -- now all the built-in Uniques (and functions to make them)
47 -- [the Oh-So-Wonderful Haskell module system wins again...]
48 mkAlphaTyVarUnique,
49 mkPrimOpIdUnique, mkPrimOpWrapperUnique,
50 mkPreludeMiscIdUnique, mkPreludeDataConUnique,
51 mkPreludeTyConUnique, mkPreludeClassUnique,
52 mkCoVarUnique,
53
54 mkVarOccUnique, mkDataOccUnique, mkTvOccUnique, mkTcOccUnique,
55 mkRegSingleUnique, mkRegPairUnique, mkRegClassUnique, mkRegSubUnique,
56 mkCostCentreUnique,
57
58 mkBuiltinUnique,
59 mkPseudoUniqueD,
60 mkPseudoUniqueE,
61 mkPseudoUniqueH,
62
63 -- ** Deriving uniques
64 -- *** From TyCon name uniques
65 tyConRepNameUnique,
66 -- *** From DataCon name uniques
67 dataConWorkerUnique, dataConTyRepNameUnique
68 ) where
69
70 #include "HsVersions.h"
71 #include "Unique.h"
72
73 import GhcPrelude
74
75 import BasicTypes
76 import FastString
77 import Outputable
78 import Util
79
80 -- just for implementing a fast [0,61) -> Char function
81 import GHC.Exts (indexCharOffAddr#, Char(..), Int(..))
82
83 import Data.Char ( chr, ord )
84 import Data.Bits
85
86 {-
87 ************************************************************************
88 * *
89 \subsection[Unique-type]{@Unique@ type and operations}
90 * *
91 ************************************************************************
92
93 The @Chars@ are ``tag letters'' that identify the @UniqueSupply@.
94 Fast comparison is everything on @Uniques@:
95 -}
96
97 -- | Unique identifier.
98 --
99 -- The type of unique identifiers that are used in many places in GHC
100 -- for fast ordering and equality tests. You should generate these with
101 -- the functions from the 'UniqSupply' module
102 --
103 -- These are sometimes also referred to as \"keys\" in comments in GHC.
104 newtype Unique = MkUnique Int
105
106 {-# INLINE uNIQUE_BITS #-}
107 uNIQUE_BITS :: Int
108 uNIQUE_BITS = finiteBitSize (0 :: Int) - UNIQUE_TAG_BITS
109
110 {-
111 Now come the functions which construct uniques from their pieces, and vice versa.
112 The stuff about unique *supplies* is handled further down this module.
113 -}
114
115 unpkUnique :: Unique -> (Char, Int) -- The reverse
116
117 mkUniqueGrimily :: Int -> Unique -- A trap-door for UniqSupply
118 getKey :: Unique -> Int -- for Var
119
120 incrUnique :: Unique -> Unique
121 stepUnique :: Unique -> Int -> Unique
122 deriveUnique :: Unique -> Int -> Unique
123 newTagUnique :: Unique -> Char -> Unique
124
125 mkUniqueGrimily = MkUnique
126
127 {-# INLINE getKey #-}
128 getKey (MkUnique x) = x
129
130 incrUnique (MkUnique i) = MkUnique (i + 1)
131 stepUnique (MkUnique i) n = MkUnique (i + n)
132
133 -- deriveUnique uses an 'X' tag so that it won't clash with
134 -- any of the uniques produced any other way
135 -- SPJ says: this looks terribly smelly to me!
136 deriveUnique (MkUnique i) delta = mkUnique 'X' (i + delta)
137
138 -- newTagUnique changes the "domain" of a unique to a different char
139 newTagUnique u c = mkUnique c i where (_,i) = unpkUnique u
140
141 -- | How many bits are devoted to the unique index (as opposed to the class
142 -- character).
143 uniqueMask :: Int
144 uniqueMask = (1 `shiftL` uNIQUE_BITS) - 1
145
146 -- pop the Char in the top 8 bits of the Unique(Supply)
147
148 -- No 64-bit bugs here, as long as we have at least 32 bits. --JSM
149
150 -- and as long as the Char fits in 8 bits, which we assume anyway!
151
152 mkUnique :: Char -> Int -> Unique -- Builds a unique from pieces
153 -- NOT EXPORTED, so that we can see all the Chars that
154 -- are used in this one module
155 mkUnique c i
156 = MkUnique (tag .|. bits)
157 where
158 tag = ord c `shiftL` uNIQUE_BITS
159 bits = i .&. uniqueMask
160
161 unpkUnique (MkUnique u)
162 = let
163 -- as long as the Char may have its eighth bit set, we
164 -- really do need the logical right-shift here!
165 tag = chr (u `shiftR` uNIQUE_BITS)
166 i = u .&. uniqueMask
167 in
168 (tag, i)
169
170 -- | The interface file symbol-table encoding assumes that known-key uniques fit
171 -- in 30-bits; verify this.
172 --
173 -- See Note [Symbol table representation of names] in BinIface for details.
174 isValidKnownKeyUnique :: Unique -> Bool
175 isValidKnownKeyUnique u =
176 case unpkUnique u of
177 (c, x) -> ord c < 0xff && x <= (1 `shiftL` 22)
178
179 {-
180 ************************************************************************
181 * *
182 \subsection[Uniquable-class]{The @Uniquable@ class}
183 * *
184 ************************************************************************
185 -}
186
187 -- | Class of things that we can obtain a 'Unique' from
188 class Uniquable a where
189 getUnique :: a -> Unique
190
191 hasKey :: Uniquable a => a -> Unique -> Bool
192 x `hasKey` k = getUnique x == k
193
194 instance Uniquable FastString where
195 getUnique fs = mkUniqueGrimily (uniqueOfFS fs)
196
197 instance Uniquable Int where
198 getUnique i = mkUniqueGrimily i
199
200 {-
201 ************************************************************************
202 * *
203 \subsection[Unique-instances]{Instance declarations for @Unique@}
204 * *
205 ************************************************************************
206
207 And the whole point (besides uniqueness) is fast equality. We don't
208 use `deriving' because we want {\em precise} control of ordering
209 (equality on @Uniques@ is v common).
210 -}
211
212 -- Note [Unique Determinism]
213 -- ~~~~~~~~~~~~~~~~~~~~~~~~~
214 -- The order of allocated @Uniques@ is not stable across rebuilds.
215 -- The main reason for that is that typechecking interface files pulls
216 -- @Uniques@ from @UniqSupply@ and the interface file for the module being
217 -- currently compiled can, but doesn't have to exist.
218 --
219 -- It gets more complicated if you take into account that the interface
220 -- files are loaded lazily and that building multiple files at once has to
221 -- work for any subset of interface files present. When you add parallelism
222 -- this makes @Uniques@ hopelessly random.
223 --
224 -- As such, to get deterministic builds, the order of the allocated
225 -- @Uniques@ should not affect the final result.
226 -- see also wiki/deterministic-builds
227 --
228 -- Note [Unique Determinism and code generation]
229 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
230 -- The goal of the deterministic builds (wiki/deterministic-builds, #4012)
231 -- is to get ABI compatible binaries given the same inputs and environment.
232 -- The motivation behind that is that if the ABI doesn't change the
233 -- binaries can be safely reused.
234 -- Note that this is weaker than bit-for-bit identical binaries and getting
235 -- bit-for-bit identical binaries is not a goal for now.
236 -- This means that we don't care about nondeterminism that happens after
237 -- the interface files are created, in particular we don't care about
238 -- register allocation and code generation.
239 -- To track progress on bit-for-bit determinism see #12262.
240
241 eqUnique :: Unique -> Unique -> Bool
242 eqUnique (MkUnique u1) (MkUnique u2) = u1 == u2
243
244 ltUnique :: Unique -> Unique -> Bool
245 ltUnique (MkUnique u1) (MkUnique u2) = u1 < u2
246
247 -- Provided here to make it explicit at the call-site that it can
248 -- introduce non-determinism.
249 -- See Note [Unique Determinism]
250 -- See Note [No Ord for Unique]
251 nonDetCmpUnique :: Unique -> Unique -> Ordering
252 nonDetCmpUnique (MkUnique u1) (MkUnique u2)
253 = if u1 == u2 then EQ else if u1 < u2 then LT else GT
254
255 {-
256 Note [No Ord for Unique]
257 ~~~~~~~~~~~~~~~~~~~~~~~~~~
258 As explained in Note [Unique Determinism] the relative order of Uniques
259 is nondeterministic. To prevent from accidental use the Ord Unique
260 instance has been removed.
261 This makes it easier to maintain deterministic builds, but comes with some
262 drawbacks.
263 The biggest drawback is that Maps keyed by Uniques can't directly be used.
264 The alternatives are:
265
266 1) Use UniqFM or UniqDFM, see Note [Deterministic UniqFM] to decide which
267 2) Create a newtype wrapper based on Unique ordering where nondeterminism
268 is controlled. See Module.ModuleEnv
269 3) Change the algorithm to use nonDetCmpUnique and document why it's still
270 deterministic
271 4) Use TrieMap as done in CmmCommonBlockElim.groupByLabel
272 -}
273
274 instance Eq Unique where
275 a == b = eqUnique a b
276 a /= b = not (eqUnique a b)
277
278 instance Uniquable Unique where
279 getUnique u = u
280
281 -- We do sometimes make strings with @Uniques@ in them:
282
283 showUnique :: Unique -> String
284 showUnique uniq
285 = case unpkUnique uniq of
286 (tag, u) -> finish_show tag u (iToBase62 u)
287
288 finish_show :: Char -> Int -> String -> String
289 finish_show 't' u _pp_u | u < 26
290 = -- Special case to make v common tyvars, t1, t2, ...
291 -- come out as a, b, ... (shorter, easier to read)
292 [chr (ord 'a' + u)]
293 finish_show tag _ pp_u = tag : pp_u
294
295 pprUniqueAlways :: Unique -> SDoc
296 -- The "always" means regardless of -dsuppress-uniques
297 -- It replaces the old pprUnique to remind callers that
298 -- they should consider whether they want to consult
299 -- Opt_SuppressUniques
300 pprUniqueAlways u
301 = text (showUnique u)
302
303 instance Outputable Unique where
304 ppr = pprUniqueAlways
305
306 instance Show Unique where
307 show uniq = showUnique uniq
308
309 {-
310 ************************************************************************
311 * *
312 \subsection[Utils-base62]{Base-62 numbers}
313 * *
314 ************************************************************************
315
316 A character-stingy way to read/write numbers (notably Uniques).
317 The ``62-its'' are \tr{[0-9a-zA-Z]}. We don't handle negative Ints.
318 Code stolen from Lennart.
319 -}
320
321 iToBase62 :: Int -> String
322 iToBase62 n_
323 = ASSERT(n_ >= 0) go n_ ""
324 where
325 go n cs | n < 62
326 = let !c = chooseChar62 n in c : cs
327 | otherwise
328 = go q (c : cs) where (!q, r) = quotRem n 62
329 !c = chooseChar62 r
330
331 chooseChar62 :: Int -> Char
332 {-# INLINE chooseChar62 #-}
333 chooseChar62 (I# n) = C# (indexCharOffAddr# chars62 n)
334 chars62 = "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"#
335
336 {-
337 ************************************************************************
338 * *
339 \subsection[Uniques-prelude]{@Uniques@ for wired-in Prelude things}
340 * *
341 ************************************************************************
342
343 Allocation of unique supply characters:
344 v,t,u : for renumbering value-, type- and usage- vars.
345 B: builtin
346 C-E: pseudo uniques (used in native-code generator)
347 X: uniques derived by deriveUnique
348 _: unifiable tyvars (above)
349 0-9: prelude things below
350 (no numbers left any more..)
351 :: (prelude) parallel array data constructors
352
353 other a-z: lower case chars for unique supplies. Used so far:
354
355 d desugarer
356 f AbsC flattener
357 g SimplStg
358 k constraint tuple tycons
359 m constraint tuple datacons
360 n Native codegen
361 r Hsc name cache
362 s simplifier
363 z anonymous sums
364 -}
365
366 mkAlphaTyVarUnique :: Int -> Unique
367 mkPreludeClassUnique :: Int -> Unique
368 mkPreludeTyConUnique :: Int -> Unique
369 mkPreludeDataConUnique :: Arity -> Unique
370 mkPrimOpIdUnique :: Int -> Unique
371 -- See Note [Primop wrappers] in PrimOp.hs.
372 mkPrimOpWrapperUnique :: Int -> Unique
373 mkPreludeMiscIdUnique :: Int -> Unique
374 mkCoVarUnique :: Int -> Unique
375
376 mkAlphaTyVarUnique i = mkUnique '1' i
377 mkCoVarUnique i = mkUnique 'g' i
378 mkPreludeClassUnique i = mkUnique '2' i
379
380 --------------------------------------------------
381 -- Wired-in type constructor keys occupy *two* slots:
382 -- * u: the TyCon itself
383 -- * u+1: the TyConRepName of the TyCon
384 mkPreludeTyConUnique i = mkUnique '3' (2*i)
385
386 tyConRepNameUnique :: Unique -> Unique
387 tyConRepNameUnique u = incrUnique u
388
389 -- Data constructor keys occupy *two* slots. The first is used for the
390 -- data constructor itself and its wrapper function (the function that
391 -- evaluates arguments as necessary and calls the worker). The second is
392 -- used for the worker function (the function that builds the constructor
393 -- representation).
394
395 --------------------------------------------------
396 -- Wired-in data constructor keys occupy *three* slots:
397 -- * u: the DataCon itself
398 -- * u+1: its worker Id
399 -- * u+2: the TyConRepName of the promoted TyCon
400 -- Prelude data constructors are too simple to need wrappers.
401
402 mkPreludeDataConUnique i = mkUnique '6' (3*i) -- Must be alphabetic
403
404 --------------------------------------------------
405 dataConTyRepNameUnique, dataConWorkerUnique :: Unique -> Unique
406 dataConWorkerUnique u = incrUnique u
407 dataConTyRepNameUnique u = stepUnique u 2
408
409 --------------------------------------------------
410 mkPrimOpIdUnique op = mkUnique '9' (2*op)
411 mkPrimOpWrapperUnique op = mkUnique '9' (2*op+1)
412 mkPreludeMiscIdUnique i = mkUnique '0' i
413
414 -- The "tyvar uniques" print specially nicely: a, b, c, etc.
415 -- See pprUnique for details
416
417 initTyVarUnique :: Unique
418 initTyVarUnique = mkUnique 't' 0
419
420 mkPseudoUniqueD, mkPseudoUniqueE, mkPseudoUniqueH,
421 mkBuiltinUnique :: Int -> Unique
422
423 mkBuiltinUnique i = mkUnique 'B' i
424 mkPseudoUniqueD i = mkUnique 'D' i -- used in NCG for getUnique on RealRegs
425 mkPseudoUniqueE i = mkUnique 'E' i -- used in NCG spiller to create spill VirtualRegs
426 mkPseudoUniqueH i = mkUnique 'H' i -- used in NCG spiller to create spill VirtualRegs
427
428 mkRegSingleUnique, mkRegPairUnique, mkRegSubUnique, mkRegClassUnique :: Int -> Unique
429 mkRegSingleUnique = mkUnique 'R'
430 mkRegSubUnique = mkUnique 'S'
431 mkRegPairUnique = mkUnique 'P'
432 mkRegClassUnique = mkUnique 'L'
433
434 mkCostCentreUnique :: Int -> Unique
435 mkCostCentreUnique = mkUnique 'C'
436
437 mkVarOccUnique, mkDataOccUnique, mkTvOccUnique, mkTcOccUnique :: FastString -> Unique
438 -- See Note [The Unique of an OccName] in OccName
439 mkVarOccUnique fs = mkUnique 'i' (uniqueOfFS fs)
440 mkDataOccUnique fs = mkUnique 'd' (uniqueOfFS fs)
441 mkTvOccUnique fs = mkUnique 'v' (uniqueOfFS fs)
442 mkTcOccUnique fs = mkUnique 'c' (uniqueOfFS fs)
443
444 initExitJoinUnique :: Unique
445 initExitJoinUnique = mkUnique 's' 0