Unique.hs 13.4 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 11 12 13 14 15 16

@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).
Austin Seipp's avatar
Austin Seipp committed
17
-}
18

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

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

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

Ian Lynagh's avatar
Ian Lynagh committed
28
        pprUnique,
29

Ian Lynagh's avatar
Ian Lynagh committed
30
        mkUniqueGrimily,                -- Used in UniqSupply only!
31
        getKey,                         -- Used in Var, UniqFM, Name only!
32
        mkUnique, unpkUnique,           -- Used in BinIface only
33

Ian Lynagh's avatar
Ian Lynagh committed
34 35 36 37
        incrUnique,                     -- Used for renumbering
        deriveUnique,                   -- Ditto
        newTagUnique,                   -- Used in CgCase
        initTyVarUnique,
38
        nonDetCmpUnique,
39

Ian Lynagh's avatar
Ian Lynagh committed
40
        -- ** Making built-in uniques
batterseapower's avatar
batterseapower committed
41

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

52
        mkVarOccUnique, mkDataOccUnique, mkTvOccUnique, mkTcOccUnique,
53
        mkRegSingleUnique, mkRegPairUnique, mkRegClassUnique, mkRegSubUnique,
54
        mkCostCentreUnique,
55

56 57 58
        tyConRepNameUnique,
        dataConWorkerUnique, dataConRepNameUnique,

Ian Lynagh's avatar
Ian Lynagh committed
59
        mkBuiltinUnique,
60
        mkPseudoUniqueD,
Ian Lynagh's avatar
Ian Lynagh committed
61 62
        mkPseudoUniqueE,
        mkPseudoUniqueH
63 64
    ) where

65 66
#include "HsVersions.h"

Simon Marlow's avatar
Simon Marlow committed
67 68
import BasicTypes
import FastString
69
import Outputable
70
import Util
71

72 73
-- just for implementing a fast [0,61) -> Char function
import GHC.Exts (indexCharOffAddr#, Char(..), Int(..))
74

Ian Lynagh's avatar
Ian Lynagh committed
75
import Data.Char        ( chr, ord )
76
import Data.Bits
77

Austin Seipp's avatar
Austin Seipp committed
78 79 80
{-
************************************************************************
*                                                                      *
81
\subsection[Unique-type]{@Unique@ type and operations}
Austin Seipp's avatar
Austin Seipp committed
82 83
*                                                                      *
************************************************************************
84 85 86

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

89
--why not newtype Int?
batterseapower's avatar
batterseapower committed
90 91 92 93

-- | 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
94
data Unique = MkUnique {-# UNPACK #-} !Int
95

Austin Seipp's avatar
Austin Seipp committed
96
{-
97 98
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
99
-}
100

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

Ian Lynagh's avatar
Ian Lynagh committed
103 104
mkUniqueGrimily :: Int -> Unique                -- A trap-door for UniqSupply
getKey          :: Unique -> Int                -- for Var
105

106 107 108 109
incrUnique   :: Unique -> Unique
stepUnique   :: Unique -> Int -> Unique
deriveUnique :: Unique -> Int -> Unique
newTagUnique :: Unique -> Char -> Unique
110

111
mkUniqueGrimily = MkUnique
112

113
{-# INLINE getKey #-}
114
getKey (MkUnique x) = x
115

116
incrUnique (MkUnique i) = MkUnique (i + 1)
117
stepUnique (MkUnique i) n = MkUnique (i + n)
118 119 120

-- deriveUnique uses an 'X' tag so that it won't clash with
-- any of the uniques produced any other way
121
-- SPJ says: this looks terribly smelly to me!
122
deriveUnique (MkUnique i) delta = mkUnique 'X' (i + delta)
123

124 125 126
-- newTagUnique changes the "domain" of a unique to a different char
newTagUnique u c = mkUnique c i where (_,i) = unpkUnique u

127 128 129 130
-- 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

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

Ian Lynagh's avatar
Ian Lynagh committed
133 134
mkUnique :: Char -> Int -> Unique       -- Builds a unique from pieces
-- NOT EXPORTED, so that we can see all the Chars that
135
--               are used in this one module
136
mkUnique c i
137
  = MkUnique (tag .|. bits)
138
  where
139 140
    tag  = ord c `shiftL` 24
    bits = i .&. 16777215 {-``0x00ffffff''-}
141 142 143

unpkUnique (MkUnique u)
  = let
Ian Lynagh's avatar
Ian Lynagh committed
144 145
        -- as long as the Char may have its eighth bit set, we
        -- really do need the logical right-shift here!
146 147
        tag = chr (u `shiftR` 24)
        i   = u .&. 16777215 {-``0x00ffffff''-}
148 149
    in
    (tag, i)
150

Austin Seipp's avatar
Austin Seipp committed
151 152 153
{-
************************************************************************
*                                                                      *
154
\subsection[Uniquable-class]{The @Uniquable@ class}
Austin Seipp's avatar
Austin Seipp committed
155 156 157
*                                                                      *
************************************************************************
-}
158

batterseapower's avatar
batterseapower committed
159
-- | Class of things that we can obtain a 'Unique' from
160
class Uniquable a where
161
    getUnique :: a -> Unique
162

Ian Lynagh's avatar
Ian Lynagh committed
163 164
hasKey          :: Uniquable a => a -> Unique -> Bool
x `hasKey` k    = getUnique x == k
165

166
instance Uniquable FastString where
167
 getUnique fs = mkUniqueGrimily (uniqueOfFS fs)
168 169

instance Uniquable Int where
170
 getUnique i = mkUniqueGrimily i
171

Austin Seipp's avatar
Austin Seipp committed
172 173 174
{-
************************************************************************
*                                                                      *
175
\subsection[Unique-instances]{Instance declarations for @Unique@}
Austin Seipp's avatar
Austin Seipp committed
176 177
*                                                                      *
************************************************************************
178 179 180 181

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
182
-}
183

184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199
-- 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.
-- see also wiki/DeterministicBuilds

twanvl's avatar
twanvl committed
200
eqUnique, ltUnique, leUnique :: Unique -> Unique -> Bool
201 202 203
eqUnique (MkUnique u1) (MkUnique u2) = u1 == u2
ltUnique (MkUnique u1) (MkUnique u2) = u1 <  u2
leUnique (MkUnique u1) (MkUnique u2) = u1 <= u2
204

205 206 207 208 209
-- Provided here to make it explicit at the call-site that it can
-- introduce non-determinism.
-- See Note [Unique Determinism]
nonDetCmpUnique :: Unique -> Unique -> Ordering
nonDetCmpUnique (MkUnique u1) (MkUnique u2)
210
  = if u1 == u2 then EQ else if u1 < u2 then LT else GT
211 212 213 214 215 216 217 218 219 220

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)
221
    compare a b = nonDetCmpUnique a b
222

223 224
-----------------
instance Uniquable Unique where
225
    getUnique u = u
226

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

229 230
showUnique :: Unique -> String
showUnique uniq
231
  = case unpkUnique uniq of
232
      (tag, u) -> finish_show tag u (iToBase62 u)
233

234 235 236 237 238 239
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
240

241 242
pprUnique :: Unique -> SDoc
pprUnique u = text (showUnique u)
243

244
instance Outputable Unique where
245
    ppr = pprUnique
246

247
instance Show Unique where
248
    show uniq = showUnique uniq
249

Austin Seipp's avatar
Austin Seipp committed
250 251 252
{-
************************************************************************
*                                                                      *
253
\subsection[Utils-base62]{Base-62 numbers}
Austin Seipp's avatar
Austin Seipp committed
254 255
*                                                                      *
************************************************************************
256 257 258 259

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
260
-}
261

262
iToBase62 :: Int -> String
263
iToBase62 n_
264
  = ASSERT(n_ >= 0) go n_ ""
265
  where
266 267 268 269 270 271 272
    go n cs | n < 62
            = let !c = chooseChar62 n in c : cs
            | otherwise
            = go q (c : cs) where (q, r) = quotRem n 62
                                  !c = chooseChar62 r

    chooseChar62 :: Int -> Char
273
    {-# INLINE chooseChar62 #-}
274 275
    chooseChar62 (I# n) = C# (indexCharOffAddr# chars62 n)
    chars62 = "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"#
276

Austin Seipp's avatar
Austin Seipp committed
277 278 279
{-
************************************************************************
*                                                                      *
280
\subsection[Uniques-prelude]{@Uniques@ for wired-in Prelude things}
Austin Seipp's avatar
Austin Seipp committed
281 282
*                                                                      *
************************************************************************
283

284
Allocation of unique supply characters:
Ian Lynagh's avatar
Ian Lynagh committed
285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301
        v,t,u : for renumbering value-, type- and usage- vars.
        B:   builtin
        C-E: pseudo uniques     (used in native-code generator)
        X:   uniques derived by deriveUnique
        _:   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
        n       Native codegen
        r       Hsc name cache
        s       simplifier
Austin Seipp's avatar
Austin Seipp committed
302
-}
303

twanvl's avatar
twanvl committed
304 305 306
mkAlphaTyVarUnique     :: Int -> Unique
mkPreludeClassUnique   :: Int -> Unique
mkPreludeTyConUnique   :: Int -> Unique
307 308 309 310
mkTupleTyConUnique     :: Boxity -> Arity -> Unique
mkCTupleTyConUnique    :: Arity -> Unique
mkPreludeDataConUnique :: Arity -> Unique
mkTupleDataConUnique   :: Boxity -> Arity -> Unique
twanvl's avatar
twanvl committed
311 312 313
mkPrimOpIdUnique       :: Int -> Unique
mkPreludeMiscIdUnique  :: Int -> Unique
mkPArrDataConUnique    :: Int -> Unique
314
mkCoVarUnique          :: Int -> Unique
twanvl's avatar
twanvl committed
315

316
mkAlphaTyVarUnique   i = mkUnique '1' i
317
mkCoVarUnique        i = mkUnique 'g' i
318
mkPreludeClassUnique i = mkUnique '2' i
319

320
--------------------------------------------------
321 322 323 324 325 326 327
-- 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)
mkTupleTyConUnique Boxed           a  = mkUnique '4' (2*a)
mkTupleTyConUnique Unboxed         a  = mkUnique '5' (2*a)
mkCTupleTyConUnique                a  = mkUnique 'k' (2*a)
328

329 330
tyConRepNameUnique :: Unique -> Unique
tyConRepNameUnique  u = incrUnique u
331

332 333 334 335 336 337
-- 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).

338 339 340 341 342 343 344 345 346 347 348 349 350 351
--------------------------------------------------
-- 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
mkTupleDataConUnique Boxed          a = mkUnique '7' (3*a)    -- ditto (*may* be used in C labels)
mkTupleDataConUnique Unboxed        a = mkUnique '8' (3*a)

dataConRepNameUnique, dataConWorkerUnique :: Unique -> Unique
dataConWorkerUnique  u = incrUnique u
dataConRepNameUnique u = stepUnique u 2
352

353
--------------------------------------------------
batterseapower's avatar
batterseapower committed
354 355
mkPrimOpIdUnique op         = mkUnique '9' op
mkPreludeMiscIdUnique  i    = mkUnique '0' i
356

Ian Lynagh's avatar
Ian Lynagh committed
357 358
-- No numbers left anymore, so I pick something different for the character tag
mkPArrDataConUnique a           = mkUnique ':' (2*a)
chak's avatar
chak committed
359

sof's avatar
sof committed
360 361 362 363 364 365
-- The "tyvar uniques" print specially nicely: a, b, c, etc.
-- See pprUnique for details

initTyVarUnique :: Unique
initTyVarUnique = mkUnique 't' 0

366
mkPseudoUniqueD, mkPseudoUniqueE, mkPseudoUniqueH,
367
   mkBuiltinUnique :: Int -> Unique
368 369

mkBuiltinUnique i = mkUnique 'B' i
370 371 372
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
373 374 375 376 377 378 379

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

380 381 382
mkCostCentreUnique :: Int -> Unique
mkCostCentreUnique = mkUnique 'C'

383 384
mkVarOccUnique, mkDataOccUnique, mkTvOccUnique, mkTcOccUnique :: FastString -> Unique
-- See Note [The Unique of an OccName] in OccName
385 386 387 388
mkVarOccUnique  fs = mkUnique 'i' (uniqueOfFS fs)
mkDataOccUnique fs = mkUnique 'd' (uniqueOfFS fs)
mkTvOccUnique   fs = mkUnique 'v' (uniqueOfFS fs)
mkTcOccUnique   fs = mkUnique 'c' (uniqueOfFS fs)