Unique.hs 15.2 KB
Newer Older
Austin Seipp's avatar
Austin Seipp committed
1 2 3 4
{-
(c) The University of Glasgow 2006
(c) The GRASP/AQUA Project, Glasgow University, 1992-1998

5 6 7 8 9 10

@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@
11

12 13 14 15 16 17
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).
Austin Seipp's avatar
Austin Seipp committed
18
-}
19

20
{-# LANGUAGE CPP, BangPatterns, MagicHash #-}
Ian Lynagh's avatar
Ian Lynagh committed
21

22
module Unique (
batterseapower's avatar
batterseapower committed
23
        -- * Main data types
Ian Lynagh's avatar
Ian Lynagh committed
24
        Unique, Uniquable(..),
25
        uNIQUE_BITS,
Ian Lynagh's avatar
Ian Lynagh committed
26

Rik Steenkamp's avatar
Rik Steenkamp committed
27
        -- ** Constructors, destructors and operations on 'Unique's
28
        hasKey,
29

30
        pprUniqueAlways,
31

Ian Lynagh's avatar
Ian Lynagh committed
32
        mkUniqueGrimily,                -- Used in UniqSupply only!
33
        getKey,                         -- Used in Var, UniqFM, Name only!
34
        mkUnique, unpkUnique,           -- Used in GHC.Iface.Binary only
35
        eqUnique, ltUnique,
Ben Gamari's avatar
Ben Gamari committed
36
        incrUnique,
37

Ian Lynagh's avatar
Ian Lynagh committed
38 39
        newTagUnique,                   -- Used in CgCase
        initTyVarUnique,
40
        initExitJoinUnique,
41
        nonDetCmpUnique,
42
        isValidKnownKeyUnique,          -- Used in PrelInfo.knownKeyNamesOkay
43

Ian Lynagh's avatar
Ian Lynagh committed
44
        -- ** Making built-in uniques
batterseapower's avatar
batterseapower committed
45

Ian Lynagh's avatar
Ian Lynagh committed
46 47 48
        -- now all the built-in Uniques (and functions to make them)
        -- [the Oh-So-Wonderful Haskell module system wins again...]
        mkAlphaTyVarUnique,
49
        mkPrimOpIdUnique, mkPrimOpWrapperUnique,
Ian Lynagh's avatar
Ian Lynagh committed
50 51
        mkPreludeMiscIdUnique, mkPreludeDataConUnique,
        mkPreludeTyConUnique, mkPreludeClassUnique,
52
        mkCoVarUnique,
53

54
        mkVarOccUnique, mkDataOccUnique, mkTvOccUnique, mkTcOccUnique,
55
        mkRegSingleUnique, mkRegPairUnique, mkRegClassUnique, mkRegSubUnique,
56
        mkCostCentreUnique,
57

Ian Lynagh's avatar
Ian Lynagh committed
58
        mkBuiltinUnique,
59
        mkPseudoUniqueD,
Ian Lynagh's avatar
Ian Lynagh committed
60
        mkPseudoUniqueE,
61 62 63 64 65 66
        mkPseudoUniqueH,

        -- ** Deriving uniques
        -- *** From TyCon name uniques
        tyConRepNameUnique,
        -- *** From DataCon name uniques
Ben Gamari's avatar
Ben Gamari committed
67 68 69 70 71 72
        dataConWorkerUnique, dataConTyRepNameUnique,

        -- ** Local uniques
        -- | These are exposed exclusively for use by 'VarEnv.uniqAway', which
        -- has rather peculiar needs. See Note [Local uniques].
        mkLocalUnique, minLocalUnique, maxLocalUnique
73 74
    ) where

75
#include "HsVersions.h"
76
#include "Unique.h"
77

78 79
import GhcPrelude

Simon Marlow's avatar
Simon Marlow committed
80 81
import BasicTypes
import FastString
82
import Outputable
83
import Util
84

85 86
-- just for implementing a fast [0,61) -> Char function
import GHC.Exts (indexCharOffAddr#, Char(..), Int(..))
87

Ian Lynagh's avatar
Ian Lynagh committed
88
import Data.Char        ( chr, ord )
89
import Data.Bits
90

Austin Seipp's avatar
Austin Seipp committed
91 92 93
{-
************************************************************************
*                                                                      *
94
\subsection[Unique-type]{@Unique@ type and operations}
Austin Seipp's avatar
Austin Seipp committed
95 96
*                                                                      *
************************************************************************
97 98 99

The @Chars@ are ``tag letters'' that identify the @UniqueSupply@.
Fast comparison is everything on @Uniques@:
Austin Seipp's avatar
Austin Seipp committed
100
-}
101

102 103 104
-- | Unique identifier.
--
-- The type of unique identifiers that are used in many places in GHC
batterseapower's avatar
batterseapower committed
105 106
-- for fast ordering and equality tests. You should generate these with
-- the functions from the 'UniqSupply' module
107 108
--
-- These are sometimes also referred to as \"keys\" in comments in GHC.
Ömer Sinan Ağacan's avatar
Ömer Sinan Ağacan committed
109
newtype Unique = MkUnique Int
110

111 112 113 114
{-# INLINE uNIQUE_BITS #-}
uNIQUE_BITS :: Int
uNIQUE_BITS = finiteBitSize (0 :: Int) - UNIQUE_TAG_BITS

Austin Seipp's avatar
Austin Seipp committed
115
{-
116 117
Now come the functions which construct uniques from their pieces, and vice versa.
The stuff about unique *supplies* is handled further down this module.
Austin Seipp's avatar
Austin Seipp committed
118
-}
119

Ian Lynagh's avatar
Ian Lynagh committed
120
unpkUnique      :: Unique -> (Char, Int)        -- The reverse
121

Ian Lynagh's avatar
Ian Lynagh committed
122 123
mkUniqueGrimily :: Int -> Unique                -- A trap-door for UniqSupply
getKey          :: Unique -> Int                -- for Var
124

125 126 127
incrUnique   :: Unique -> Unique
stepUnique   :: Unique -> Int -> Unique
newTagUnique :: Unique -> Char -> Unique
128

129
mkUniqueGrimily = MkUnique
130

131
{-# INLINE getKey #-}
132
getKey (MkUnique x) = x
133

134
incrUnique (MkUnique i) = MkUnique (i + 1)
135
stepUnique (MkUnique i) n = MkUnique (i + n)
136

Ben Gamari's avatar
Ben Gamari committed
137 138 139 140 141 142 143 144
mkLocalUnique :: Int -> Unique
mkLocalUnique i = mkUnique 'X' i

minLocalUnique :: Unique
minLocalUnique = mkLocalUnique 0

maxLocalUnique :: Unique
maxLocalUnique = mkLocalUnique uniqueMask
145

146 147 148
-- newTagUnique changes the "domain" of a unique to a different char
newTagUnique u c = mkUnique c i where (_,i) = unpkUnique u

149 150 151
-- | How many bits are devoted to the unique index (as opposed to the class
-- character).
uniqueMask :: Int
152
uniqueMask = (1 `shiftL` uNIQUE_BITS) - 1
153

154 155 156 157
-- 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

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

Ian Lynagh's avatar
Ian Lynagh committed
160 161
mkUnique :: Char -> Int -> Unique       -- Builds a unique from pieces
-- NOT EXPORTED, so that we can see all the Chars that
162
--               are used in this one module
163
mkUnique c i
164
  = MkUnique (tag .|. bits)
165
  where
166
    tag  = ord c `shiftL` uNIQUE_BITS
167
    bits = i .&. uniqueMask
168 169 170

unpkUnique (MkUnique u)
  = let
Ian Lynagh's avatar
Ian Lynagh committed
171 172
        -- as long as the Char may have its eighth bit set, we
        -- really do need the logical right-shift here!
173
        tag = chr (u `shiftR` uNIQUE_BITS)
174
        i   = u .&. uniqueMask
175 176
    in
    (tag, i)
177

178 179 180
-- | The interface file symbol-table encoding assumes that known-key uniques fit
-- in 30-bits; verify this.
--
181
-- See Note [Symbol table representation of names] in GHC.Iface.Binary for details.
182 183 184 185 186
isValidKnownKeyUnique :: Unique -> Bool
isValidKnownKeyUnique u =
    case unpkUnique u of
      (c, x) -> ord c < 0xff && x <= (1 `shiftL` 22)

Austin Seipp's avatar
Austin Seipp committed
187 188 189
{-
************************************************************************
*                                                                      *
190
\subsection[Uniquable-class]{The @Uniquable@ class}
Austin Seipp's avatar
Austin Seipp committed
191 192 193
*                                                                      *
************************************************************************
-}
194

batterseapower's avatar
batterseapower committed
195
-- | Class of things that we can obtain a 'Unique' from
196
class Uniquable a where
197
    getUnique :: a -> Unique
198

Ian Lynagh's avatar
Ian Lynagh committed
199 200
hasKey          :: Uniquable a => a -> Unique -> Bool
x `hasKey` k    = getUnique x == k
201

202
instance Uniquable FastString where
203
 getUnique fs = mkUniqueGrimily (uniqueOfFS fs)
204 205

instance Uniquable Int where
206
 getUnique i = mkUniqueGrimily i
207

Austin Seipp's avatar
Austin Seipp committed
208 209 210
{-
************************************************************************
*                                                                      *
211
\subsection[Unique-instances]{Instance declarations for @Unique@}
Austin Seipp's avatar
Austin Seipp committed
212 213
*                                                                      *
************************************************************************
214 215 216 217

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).
Austin Seipp's avatar
Austin Seipp committed
218
-}
219

220 221 222 223 224 225 226 227 228 229 230 231 232 233
-- Note [Unique Determinism]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~
-- The order of allocated @Uniques@ is not stable across rebuilds.
-- The main reason for that is that typechecking interface files pulls
-- @Uniques@ from @UniqSupply@ and the interface file for the module being
-- currently compiled can, but doesn't have to exist.
--
-- It gets more complicated if you take into account that the interface
-- files are loaded lazily and that building multiple files at once has to
-- work for any subset of interface files present. When you add parallelism
-- this makes @Uniques@ hopelessly random.
--
-- As such, to get deterministic builds, the order of the allocated
-- @Uniques@ should not affect the final result.
234
-- see also wiki/deterministic-builds
niteria's avatar
niteria committed
235 236 237
--
-- Note [Unique Determinism and code generation]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
238
-- The goal of the deterministic builds (wiki/deterministic-builds, #4012)
niteria's avatar
niteria committed
239 240 241 242 243 244 245 246 247 248 249
-- is to get ABI compatible binaries given the same inputs and environment.
-- The motivation behind that is that if the ABI doesn't change the
-- binaries can be safely reused.
-- Note that this is weaker than bit-for-bit identical binaries and getting
-- bit-for-bit identical binaries is not a goal for now.
-- This means that we don't care about nondeterminism that happens after
-- the interface files are created, in particular we don't care about
-- register allocation and code generation.
-- To track progress on bit-for-bit determinism see #12262.

eqUnique :: Unique -> Unique -> Bool
250
eqUnique (MkUnique u1) (MkUnique u2) = u1 == u2
251

252 253 254
ltUnique :: Unique -> Unique -> Bool
ltUnique (MkUnique u1) (MkUnique u2) = u1 < u2

255 256 257
-- Provided here to make it explicit at the call-site that it can
-- introduce non-determinism.
-- See Note [Unique Determinism]
niteria's avatar
niteria committed
258
-- See Note [No Ord for Unique]
259 260
nonDetCmpUnique :: Unique -> Unique -> Ordering
nonDetCmpUnique (MkUnique u1) (MkUnique u2)
261
  = if u1 == u2 then EQ else if u1 < u2 then LT else GT
262

niteria's avatar
niteria committed
263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278
{-
Note [No Ord for Unique]
~~~~~~~~~~~~~~~~~~~~~~~~~~
As explained in Note [Unique Determinism] the relative order of Uniques
is nondeterministic. To prevent from accidental use the Ord Unique
instance has been removed.
This makes it easier to maintain deterministic builds, but comes with some
drawbacks.
The biggest drawback is that Maps keyed by Uniques can't directly be used.
The alternatives are:

  1) Use UniqFM or UniqDFM, see Note [Deterministic UniqFM] to decide which
  2) Create a newtype wrapper based on Unique ordering where nondeterminism
     is controlled. See Module.ModuleEnv
  3) Change the algorithm to use nonDetCmpUnique and document why it's still
     deterministic
279
  4) Use TrieMap as done in GHC.Cmm.CommonBlockElim.groupByLabel
niteria's avatar
niteria committed
280 281
-}

282 283 284 285
instance Eq Unique where
    a == b = eqUnique a b
    a /= b = not (eqUnique a b)

286
instance Uniquable Unique where
287
    getUnique u = u
288

Austin Seipp's avatar
Austin Seipp committed
289 290
-- We do sometimes make strings with @Uniques@ in them:

291 292
showUnique :: Unique -> String
showUnique uniq
293
  = case unpkUnique uniq of
294
      (tag, u) -> finish_show tag u (iToBase62 u)
295

296 297 298 299 300 301
finish_show :: Char -> Int -> String -> String
finish_show 't' u _pp_u | u < 26
  = -- Special case to make v common tyvars, t1, t2, ...
    -- come out as a, b, ... (shorter, easier to read)
    [chr (ord 'a' + u)]
finish_show tag _ pp_u = tag : pp_u
302

303 304 305 306 307 308 309
pprUniqueAlways :: Unique -> SDoc
-- The "always" means regardless of -dsuppress-uniques
-- It replaces the old pprUnique to remind callers that
-- they should consider whether they want to consult
-- Opt_SuppressUniques
pprUniqueAlways u
  = text (showUnique u)
310

311
instance Outputable Unique where
312
    ppr = pprUniqueAlways
313

314
instance Show Unique where
315
    show uniq = showUnique uniq
316

Austin Seipp's avatar
Austin Seipp committed
317 318 319
{-
************************************************************************
*                                                                      *
320
\subsection[Utils-base62]{Base-62 numbers}
Austin Seipp's avatar
Austin Seipp committed
321 322
*                                                                      *
************************************************************************
323 324 325 326

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.
Austin Seipp's avatar
Austin Seipp committed
327
-}
328

329
iToBase62 :: Int -> String
330
iToBase62 n_
331
  = ASSERT(n_ >= 0) go n_ ""
332
  where
333 334 335
    go n cs | n < 62
            = let !c = chooseChar62 n in c : cs
            | otherwise
336
            = go q (c : cs) where (!q, r) = quotRem n 62
337 338 339
                                  !c = chooseChar62 r

    chooseChar62 :: Int -> Char
340
    {-# INLINE chooseChar62 #-}
341 342
    chooseChar62 (I# n) = C# (indexCharOffAddr# chars62 n)
    chars62 = "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"#
343

Austin Seipp's avatar
Austin Seipp committed
344 345 346
{-
************************************************************************
*                                                                      *
347
\subsection[Uniques-prelude]{@Uniques@ for wired-in Prelude things}
Austin Seipp's avatar
Austin Seipp committed
348 349
*                                                                      *
************************************************************************
350

351
Allocation of unique supply characters:
Ian Lynagh's avatar
Ian Lynagh committed
352 353 354
        v,t,u : for renumbering value-, type- and usage- vars.
        B:   builtin
        C-E: pseudo uniques     (used in native-code generator)
Ben Gamari's avatar
Ben Gamari committed
355
        X:   uniques from mkLocalUnique
Ian Lynagh's avatar
Ian Lynagh committed
356 357 358 359 360 361 362 363 364 365
        _:   unifiable tyvars   (above)
        0-9: prelude things below
             (no numbers left any more..)
        ::   (prelude) parallel array data constructors

        other a-z: lower case chars for unique supplies.  Used so far:

        d       desugarer
        f       AbsC flattener
        g       SimplStg
366 367
        k       constraint tuple tycons
        m       constraint tuple datacons
Ian Lynagh's avatar
Ian Lynagh committed
368 369 370
        n       Native codegen
        r       Hsc name cache
        s       simplifier
371
        z       anonymous sums
Austin Seipp's avatar
Austin Seipp committed
372
-}
373

twanvl's avatar
twanvl committed
374 375 376
mkAlphaTyVarUnique     :: Int -> Unique
mkPreludeClassUnique   :: Int -> Unique
mkPreludeTyConUnique   :: Int -> Unique
377
mkPreludeDataConUnique :: Arity -> Unique
twanvl's avatar
twanvl committed
378
mkPrimOpIdUnique       :: Int -> Unique
379 380
-- See Note [Primop wrappers] in PrimOp.hs.
mkPrimOpWrapperUnique  :: Int -> Unique
twanvl's avatar
twanvl committed
381
mkPreludeMiscIdUnique  :: Int -> Unique
382
mkCoVarUnique          :: Int -> Unique
twanvl's avatar
twanvl committed
383

384
mkAlphaTyVarUnique   i = mkUnique '1' i
385
mkCoVarUnique        i = mkUnique 'g' i
386
mkPreludeClassUnique i = mkUnique '2' i
387

388
--------------------------------------------------
389 390 391 392
-- Wired-in type constructor keys occupy *two* slots:
--    * u: the TyCon itself
--    * u+1: the TyConRepName of the TyCon
mkPreludeTyConUnique i                = mkUnique '3' (2*i)
393

394 395
tyConRepNameUnique :: Unique -> Unique
tyConRepNameUnique  u = incrUnique u
396

397 398 399 400 401 402 403 404 405
--------------------------------------------------
-- Wired-in data constructor keys occupy *three* slots:
--    * u: the DataCon itself
--    * u+1: its worker Id
--    * u+2: the TyConRepName of the promoted TyCon
-- Prelude data constructors are too simple to need wrappers.

mkPreludeDataConUnique i              = mkUnique '6' (3*i)    -- Must be alphabetic

406
--------------------------------------------------
407
dataConTyRepNameUnique, dataConWorkerUnique :: Unique -> Unique
408
dataConWorkerUnique  u = incrUnique u
409
dataConTyRepNameUnique u = stepUnique u 2
410

411
--------------------------------------------------
412 413
mkPrimOpIdUnique op         = mkUnique '9' (2*op)
mkPrimOpWrapperUnique op    = mkUnique '9' (2*op+1)
batterseapower's avatar
batterseapower committed
414
mkPreludeMiscIdUnique  i    = mkUnique '0' i
415

sof's avatar
sof committed
416 417 418 419 420 421
-- The "tyvar uniques" print specially nicely: a, b, c, etc.
-- See pprUnique for details

initTyVarUnique :: Unique
initTyVarUnique = mkUnique 't' 0

422
mkPseudoUniqueD, mkPseudoUniqueE, mkPseudoUniqueH,
423
   mkBuiltinUnique :: Int -> Unique
424 425

mkBuiltinUnique i = mkUnique 'B' i
426 427 428
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
429 430 431 432 433 434 435

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

436 437 438
mkCostCentreUnique :: Int -> Unique
mkCostCentreUnique = mkUnique 'C'

439 440
mkVarOccUnique, mkDataOccUnique, mkTvOccUnique, mkTcOccUnique :: FastString -> Unique
-- See Note [The Unique of an OccName] in OccName
441 442 443 444
mkVarOccUnique  fs = mkUnique 'i' (uniqueOfFS fs)
mkDataOccUnique fs = mkUnique 'd' (uniqueOfFS fs)
mkTvOccUnique   fs = mkUnique 'v' (uniqueOfFS fs)
mkTcOccUnique   fs = mkUnique 'c' (uniqueOfFS fs)
445 446 447

initExitJoinUnique :: Unique
initExitJoinUnique = mkUnique 's' 0
Ben Gamari's avatar
Ben Gamari committed
448