ghc/compiler/basicTypes/Unique.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1995
   3 %
   4 \section[Unique]{The @Unique@ data type and a (monadic) supply thereof}
   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 \begin{code}
  19 #include "HsVersions.h"
  20
  21 module Unique (
  22         Unique,
  23         UniqueSupply,                   -- abstract types
  24         u2i,                            -- hack: used in UniqFM
  25         getUnique, getUniques,          -- basic ops
  26         eqUnique, cmpUnique,            -- comparison is everything!
  27
  28 --not exported: mkUnique, unpkUnique,
  29         mkUniqueGrimily,                -- use in SplitUniq only!
  30         mkUniqueSupplyGrimily,          -- ditto! (but FALSE: WDP 95/01)
  31         mkUnifiableTyVarUnique,
  32         unpkUnifiableTyVarUnique,
  33         showUnique, pprUnique, pprUnique10,
  34
  35         UniqSM(..),             -- type: unique supply monad
  36         initUs, thenUs, returnUs,
  37         mapUs, mapAndUnzipUs,
  38
  39         -- the pre-defined unique supplies:
  40 {- NOT exported:
  41         uniqSupply_r, uniqSupply_t, uniqSupply_d,
  42         uniqSupply_s, uniqSupply_c, uniqSupply_T,
  43         uniqSupply_f,
  44         uniqSupply_P,
  45 -}
  46         uniqSupply_u,
  47 #ifdef DPH
  48         -- otherwise, not exported
  49         uniqSupply_p, uniqSupply_S, uniqSupply_L,
  50 #endif
  51
  52         -- and the access functions for the `builtin' UniqueSupply
  53         getBuiltinUniques, mkBuiltinUnique, runBuiltinUs,
  54         mkPseudoUnique1, mkPseudoUnique2, mkPseudoUnique3,
  55
  56         -- now all the built-in Uniques (and functions to make them)
  57         -- [the Oh-So-Wonderful Haskell module system wins again...]
  58         mkPrimOpIdUnique,
  59         mkTupleDataConUnique,
  60
  61         absentErrorIdKey,
  62         runSTIdKey, realWorldPrimIdKey,
  63         arrayPrimTyConKey,
  64         byteArrayPrimTyConKey, --UNUSED: byteArrayDataConKey, byteArrayTyConKey,
  65         binaryClassKey,
  66         boolTyConKey, buildDataConKey, buildIdKey, charDataConKey,
  67         charPrimTyConKey, charTyConKey, cmpTagTyConKey,
  68         consDataConKey,
  69         dialogueTyConKey,
  70         doubleDataConKey,
  71         doublePrimTyConKey,
  72         doubleTyConKey,
  73         enumClassKey, eqClassKey,
  74         eqTagDataConKey, errorIdKey,
  75         falseDataConKey, floatDataConKey,
  76         floatPrimTyConKey, floatTyConKey, floatingClassKey,
  77         foldlIdKey, foldrIdKey,
  78         forkIdKey,
  79         fractionalClassKey,
  80         gtTagDataConKey, --UNUSED: iOErrorTyConKey,
  81 --UNUSED:       iOIntPrimTyConKey, -- UNUSED: int2IntegerIdKey,
  82         iOTyConKey,
  83         intDataConKey,
  84         wordPrimTyConKey, wordTyConKey, wordDataConKey,
  85         addrPrimTyConKey, addrTyConKey, addrDataConKey,
  86         intPrimTyConKey, intTyConKey,
  87         integerDataConKey, integerTyConKey, integralClassKey,
  88         ixClassKey,
  89 --UNUSED:       lexIdKey,
  90         liftDataConKey, liftTyConKey, listTyConKey,
  91         ltTagDataConKey,
  92         mutableArrayPrimTyConKey, -- UNUSED: mutableArrayDataConKey, mutableArrayTyConKey,
  93         mutableByteArrayPrimTyConKey, -- UNUSED: mutableByteArrayDataConKey,
  94 --UNUSED:       mutableByteArrayTyConKey,
  95         synchVarPrimTyConKey,
  96         nilDataConKey, numClassKey, ordClassKey,
  97         parIdKey, parErrorIdKey,
  98 #ifdef GRAN
  99         parGlobalIdKey, parLocalIdKey, copyableIdKey, noFollowIdKey,
 100 #endif
 101         patErrorIdKey,
 102         ratioDataConKey, ratioTyConKey,
 103         rationalTyConKey,
 104 --UNUSED:       readParenIdKey,
 105         realClassKey, realFloatClassKey,
 106         realFracClassKey,
 107 --UNUSED:       requestTyConKey, responseTyConKey,
 108         return2GMPsDataConKey, return2GMPsTyConKey,
 109         returnIntAndGMPDataConKey, returnIntAndGMPTyConKey,
 110         seqIdKey, -- UNUSED: seqIntPrimTyConKey,
 111 --UNUSED:       seqTyConKey,
 112 --UNUSED:       showParenIdKey,
 113 --UNUSED:       showSpaceIdKey,
 114         statePrimTyConKey, stateTyConKey, stateDataConKey,
 115         voidPrimTyConKey,
 116         realWorldTyConKey,
 117         stablePtrPrimTyConKey, stablePtrTyConKey, stablePtrDataConKey,
 118         mallocPtrPrimTyConKey, mallocPtrTyConKey, mallocPtrDataConKey,
 119         stateAndPtrPrimTyConKey,
 120         stateAndPtrPrimDataConKey,
 121         stateAndCharPrimTyConKey,
 122         stateAndCharPrimDataConKey,
 123         stateAndIntPrimTyConKey,
 124         stateAndIntPrimDataConKey,
 125         stateAndWordPrimTyConKey,
 126         stateAndWordPrimDataConKey,
 127         stateAndAddrPrimTyConKey,
 128         stateAndAddrPrimDataConKey,
 129         stateAndStablePtrPrimTyConKey,
 130         stateAndStablePtrPrimDataConKey,
 131         stateAndMallocPtrPrimTyConKey,
 132         stateAndMallocPtrPrimDataConKey,
 133         stateAndFloatPrimTyConKey,
 134         stateAndFloatPrimDataConKey,
 135         stateAndDoublePrimTyConKey,
 136         stateAndDoublePrimDataConKey,
 137         stateAndArrayPrimTyConKey,
 138         stateAndArrayPrimDataConKey,
 139         stateAndMutableArrayPrimTyConKey,
 140         stateAndMutableArrayPrimDataConKey,
 141         stateAndByteArrayPrimTyConKey,
 142         stateAndByteArrayPrimDataConKey,
 143         stateAndMutableByteArrayPrimTyConKey,
 144         stateAndMutableByteArrayPrimDataConKey,
 145         stateAndSynchVarPrimTyConKey,
 146         stateAndSynchVarPrimDataConKey,
 147         stringTyConKey,
 148         stTyConKey, primIoTyConKey,
 149 --UNUSED:       ioResultTyConKey,
 150         textClassKey,
 151         traceIdKey,
 152         trueDataConKey,
 153         unpackCStringIdKey, unpackCString2IdKey, unpackCStringAppendIdKey,
 154         packCStringIdKey,
 155         integerZeroIdKey, integerPlusOneIdKey,
 156         integerPlusTwoIdKey, integerMinusOneIdKey,
 157         voidPrimIdKey,
 158         cCallableClassKey,
 159         cReturnableClassKey,
 160 --UNUSED:       packedStringTyConKey, psDataConKey, cpsDataConKey,
 161
 162         -- to make interface self-sufficient
 163         PrimOp, SplitUniqSupply, CSeq
 164
 165 #ifndef __GLASGOW_HASKELL__
 166         , TAG_
 167 #endif
 168     ) where
 169
 170 import Outputable       -- class for printing, forcing
 171 import Pretty
 172 import PrimOps          -- ** DIRECTLY **
 173 import SplitUniq
 174 import Util
 175
 176 #ifndef __GLASGOW_HASKELL__
 177 {-hide import from mkdependHS-}
 178 import
 179         Word
 180 #endif
 181 #ifdef __GLASGOW_HASKELL__
 182 import PreludeGlaST
 183 #endif
 184
 185 infixr 9 `thenUs`
 186 \end{code}
 187
 188 %************************************************************************
 189 %*                                                                      *
 190 \subsection[Unique-type]{@Unique@ type and operations}
 191 %*                                                                      *
 192 %************************************************************************
 193
 194 The @Chars@ are ``tag letters'' that identify the @UniqueSupply@.
 195 Fast comparison is everything on @Uniques@:
 196
 197 \begin{code}
 198 u2i :: Unique -> FAST_INT
 199
 200 #ifdef __GLASGOW_HASKELL__
 201
 202 data Unique = MkUnique Int#
 203 u2i (MkUnique i) = i
 204
 205 #else
 206
 207 data Unique = MkUnique Word{-#STRICT#-}
 208 u2i (MkUnique w) = wordToInt w
 209
 210 #endif
 211 \end{code}
 212
 213 Now come the functions which construct uniques from their pieces, and vice versa.
 214 The stuff about unique *supplies* is handled further down this module.
 215
 216 \begin{code}
 217 mkUnique                 :: Char -> Int -> Unique       -- Builds a unique from pieces
 218 unpkUnique               :: Unique -> (Char, Int)       -- The reverse
 219
 220 mkUnifiableTyVarUnique   :: Int -> Unique       -- Injects a subst-array index into the Unique type
 221 unpkUnifiableTyVarUnique :: Unique -> Int       -- The reverse process
 222
 223 #ifdef __GLASGOW_HASKELL__
 224 mkUniqueGrimily :: Int# -> Unique               -- A trap-door for SplitUniq
 225 #else
 226 mkUniqueGrimily :: Int -> Unique
 227 #endif
 228 \end{code}
 229
 230
 231 \begin{code}
 232 #ifdef __GLASGOW_HASKELL__
 233 mkUniqueGrimily x = MkUnique x
 234 #else
 235 mkUniqueGrimily x = MkUnique (fromInteger (toInteger x))
 236 #endif
 237
 238 mkUnifiableTyVarUnique i = mkUnique '_'{-MAGIC CHAR-} i
 239
 240 unpkUnifiableTyVarUnique uniq
 241   = case (unpkUnique uniq) of { (tag, i) ->
 242     ASSERT(tag == '_'{-MAGIC CHAR-})
 243     i }
 244
 245 -- pop the Char in the top 8 bits of the Unique(Supply)
 246
 247 #ifdef __GLASGOW_HASKELL__
 248
 249 -- No 64-bit bugs here, as long as we have at least 32 bits. --JSM
 250
 251 w2i x = word2Int# x
 252 i2w x = int2Word# x
 253 i2w_s x = (x::Int#)
 254
 255 mkUnique (MkChar c#) (MkInt i#)
 256   = MkUnique (w2i (((i2w (ord# c#)) `shiftL#` (i2w_s 24#)) `or#` (i2w i#)))
 257
 258 unpkUnique (MkUnique u)
 259   = let
 260         tag = MkChar (chr# (w2i ((i2w u) `shiftr` (i2w_s 24#))))
 261         i   = MkInt  (w2i ((i2w u) `and#` (i2w 16777215#){-``0x00ffffff''-}))
 262     in
 263     (tag, i)
 264 # if __GLASGOW_HASKELL__ >= 23
 265   where
 266     shiftr x y = shiftRA# x y
 267 # else
 268     shiftr x y = shiftR#  x y
 269 # endif
 270
 271 #else {-probably HBC-}
 272
 273 mkUnique c i
 274   = MkUnique (((fromInt (ord c)) `bitLsh` 24) `bitOr` (fromInt i))
 275
 276 unpkUnique (MkUnique u)
 277   = let
 278         tag = chr (wordToInt (u `bitRsh` 24))
 279         i   = wordToInt (u `bitAnd` 16777215 {-0x00ffffff-})
 280     in
 281     (tag, i)
 282
 283 #endif  {-probably HBC-}
 284 \end{code}
 285
 286 %************************************************************************
 287 %*                                                                      *
 288 \subsection[Unique-instances]{Instance declarations for @Unique@}
 289 %*                                                                      *
 290 %************************************************************************
 291
 292 And the whole point (besides uniqueness) is fast equality.  We don't
 293 use `deriving' because we want {\em precise} control of ordering
 294 (equality on @Uniques@ is v common).
 295
 296 \begin{code}
 297 #ifdef __GLASGOW_HASKELL__
 298
 299 {-# INLINE eqUnique  #-} -- this is Hammered City here...
 300 {-# INLINE cmpUnique #-}
 301
 302 eqUnique (MkUnique u1) (MkUnique u2) = u1 ==# u2
 303 ltUnique (MkUnique u1) (MkUnique u2) = u1 <#  u2
 304 leUnique (MkUnique u1) (MkUnique u2) = u1 <=# u2
 305
 306 cmpUnique (MkUnique u1) (MkUnique u2)
 307   = if u1 ==# u2 then EQ_ else if u1 <# u2 then LT_ else GT_
 308
 309 #else
 310 eqUnique (MkUnique u1) (MkUnique u2) = u1 == u2
 311 ltUnique (MkUnique u1) (MkUnique u2) = u1 <  u2
 312 leUnique (MkUnique u1) (MkUnique u2) = u1 <= u2
 313
 314 cmpUnique (MkUnique u1) (MkUnique u2)
 315   = if u1 == u2 then EQ_ else if u1 < u2 then LT_ else GT_
 316 #endif
 317
 318 instance Eq Unique where
 319     a == b = eqUnique a b
 320     a /= b = not (eqUnique a b)
 321
 322 instance Ord Unique where
 323     a  < b = ltUnique a b
 324     a <= b = leUnique a b
 325     a  > b = not (leUnique a b)
 326     a >= b = not (ltUnique a b)
 327 #ifdef __GLASGOW_HASKELL__
 328     _tagCmp a b = case cmpUnique a b of { LT_ -> _LT; EQ_ -> _EQ; GT__ -> _GT }
 329 #endif
 330 \end{code}
 331
 332 And for output:
 333 \begin{code}
 334 {- OLD:
 335 instance Outputable Unique where
 336    ppr any_style uniq
 337      = case unpkUnique uniq of
 338          (tag, u) -> ppStr (tag : iToBase62 u)
 339 -}
 340 \end{code}
 341
 342 We do sometimes make strings with @Uniques@ in them:
 343 \begin{code}
 344 pprUnique, pprUnique10 :: Unique -> Pretty
 345
 346 pprUnique uniq
 347   = case unpkUnique uniq of
 348       (tag, u) -> ppBeside (ppChar tag) (iToBase62 u)
 349
 350 pprUnique10 uniq        -- in base-10, dudes
 351   = case unpkUnique uniq of
 352       (tag, u) -> ppBeside (ppChar tag) (ppInt u)
 353
 354 showUnique :: Unique -> FAST_STRING
 355 showUnique uniq = _PK_ (ppShow 80 (pprUnique uniq))
 356
 357 instance Text Unique where
 358     showsPrec p uniq rest = _UNPK_ (showUnique uniq)
 359     readsPrec p = panic "no readsPrec for Unique"
 360 \end{code}
 361
 362 %************************************************************************
 363 %*                                                                      *
 364 \subsection[Utils-base62]{Base-62 numbers}
 365 %*                                                                      *
 366 %************************************************************************
 367
 368 A character-stingy way to read/write numbers (notably Uniques).
 369 The ``62-its'' are \tr{[0-9a-zA-Z]}.  We don't handle negative Ints.
 370 Code stolen from Lennart.
 371 \begin{code}
 372 iToBase62 :: Int -> Pretty
 373
 374 #ifdef __GLASGOW_HASKELL__
 375 iToBase62 n@(I# n#)
 376   = ASSERT(n >= 0)
 377     let
 378         bytes = case chars62 of { _ByteArray bounds_who_needs_'em bytes -> bytes }
 379     in
 380     if n# <# 62# then
 381         case (indexCharArray# bytes n#) of { c ->
 382         ppChar (C# c) }
 383     else
 384         case (quotRem n 62)             of { (q, I# r#) ->
 385         case (indexCharArray# bytes r#) of { c  ->
 386         ppBeside (iToBase62 q) (ppChar (C# c)) }}
 387
 388 -- keep this at top level! (bug on 94/10/24 WDP)
 389 chars62 :: _ByteArray Int
 390 chars62
 391   = _runST (
 392         newCharArray (0, 61)    `thenStrictlyST` \ ch_array ->
 393         fill_in ch_array 0 62 "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
 394                                 `seqStrictlyST`
 395         unsafeFreezeByteArray ch_array
 396     )
 397   where
 398     fill_in ch_array i lim str
 399       | i == lim
 400       = returnStrictlyST ()
 401       | otherwise
 402       = writeCharArray ch_array i (str !! i)    `seqStrictlyST`
 403         fill_in ch_array (i+1) lim str
 404
 405 #else {- not GHC -}
 406 iToBase62 n
 407   = ASSERT(n >= 0)
 408     if n < 62 then
 409         ppChar (chars62 ! n)
 410     else
 411         case (quotRem n 62) of { (q, r) ->
 412         ppBeside (iToBase62 q) (ppChar (chars62 ! r)) }
 413
 414 -- keep this at top level! (bug on 94/10/24 WDP)
 415 chars62 :: Array Int Char
 416 chars62
 417   = array (0,61) (zipWith (:=) [0..] "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ")
 418 #endif {- not GHC -}
 419 \end{code}
 420
 421 %************************************************************************
 422 %*                                                                      *
 423 \subsection[Uniques-prelude]{@Uniques@ for wired-in Prelude things}
 424 %*                                                                      *
 425 %************************************************************************
 426
 427 \begin{code}
 428 mkPreludeClassUnique i          = mkUnique '1' i
 429 mkPreludeTyConUnique i          = mkUnique '2' i
 430 mkPreludeDataConUnique i        = mkUnique 'Y' i -- must be alphabetic
 431 mkTupleDataConUnique i          = mkUnique 'Z' i -- ditto (*may* be used in C labels)
 432 -- mkPrimOpIdUnique op: see below (uses '5')
 433 mkPreludeMiscIdUnique i         = mkUnique '7' i
 434 \end{code}
 435
 436 %************************************************************************
 437 %*                                                                      *
 438 \subsubsection[Uniques-prelude-Classes]{@Uniques@ for wired-in @Classes@}
 439 %*                                                                      *
 440 %************************************************************************
 441
 442 \begin{code}
 443 eqClassKey              = mkPreludeClassUnique 1
 444 ordClassKey             = mkPreludeClassUnique 2
 445 numClassKey             = mkPreludeClassUnique 3
 446 integralClassKey        = mkPreludeClassUnique 4
 447 fractionalClassKey      = mkPreludeClassUnique 5
 448 floatingClassKey        = mkPreludeClassUnique 6
 449 realClassKey            = mkPreludeClassUnique 7
 450 realFracClassKey        = mkPreludeClassUnique 8
 451 realFloatClassKey       = mkPreludeClassUnique 9
 452 ixClassKey              = mkPreludeClassUnique 10
 453 enumClassKey            = mkPreludeClassUnique 11
 454 textClassKey            = mkPreludeClassUnique 12
 455 binaryClassKey          = mkPreludeClassUnique 13
 456 cCallableClassKey       = mkPreludeClassUnique 14
 457 cReturnableClassKey     = mkPreludeClassUnique 15
 458 #ifdef DPH
 459 pidClassKey             = mkPreludeClassUnique 16
 460 processorClassKey       = mkPreludeClassUnique 17
 461 #endif {- Data Parallel Haskell -}
 462 \end{code}
 463
 464 %************************************************************************
 465 %*                                                                      *
 466 \subsubsection[Uniques-prelude-TyCons]{@Uniques@ for wired-in @TyCons@}
 467 %*                                                                      *
 468 %************************************************************************
 469
 470 \begin{code}
 471 addrPrimTyConKey                        = mkPreludeTyConUnique  1
 472 addrTyConKey                            = mkPreludeTyConUnique  2
 473 arrayPrimTyConKey                       = mkPreludeTyConUnique  3
 474 boolTyConKey                            = mkPreludeTyConUnique  4
 475 byteArrayPrimTyConKey                   = mkPreludeTyConUnique  5
 476 --UNUSED:byteArrayTyConKey                      = mkPreludeTyConUnique  6
 477 charPrimTyConKey                        = mkPreludeTyConUnique  7
 478 charTyConKey                            = mkPreludeTyConUnique  8
 479 cmpTagTyConKey                          = mkPreludeTyConUnique  9
 480 dialogueTyConKey                        = mkPreludeTyConUnique 10
 481 doublePrimTyConKey                      = mkPreludeTyConUnique 11
 482 doubleTyConKey                          = mkPreludeTyConUnique 12
 483 floatPrimTyConKey                       = mkPreludeTyConUnique 13
 484 floatTyConKey                           = mkPreludeTyConUnique 14
 485 --UNUSED:iOErrorTyConKey                                = mkPreludeTyConUnique 14
 486 --UNUSED:iOIntPrimTyConKey                      = mkPreludeTyConUnique 15
 487 iOTyConKey                              = mkPreludeTyConUnique 16
 488 intPrimTyConKey                         = mkPreludeTyConUnique 17
 489 intTyConKey                             = mkPreludeTyConUnique 18
 490 integerTyConKey                         = mkPreludeTyConUnique 19
 491 liftTyConKey                            = mkPreludeTyConUnique 20
 492 listTyConKey                            = mkPreludeTyConUnique 21
 493 mallocPtrPrimTyConKey                   = mkPreludeTyConUnique 22
 494 mallocPtrTyConKey                       = mkPreludeTyConUnique 23
 495 mutableArrayPrimTyConKey                = mkPreludeTyConUnique 24
 496 --UNUSED:mutableArrayTyConKey                   = mkPreludeTyConUnique 25
 497 mutableByteArrayPrimTyConKey            = mkPreludeTyConUnique 26
 498 --UNUSED:mutableByteArrayTyConKey               = mkPreludeTyConUnique 27
 499 --UNUSED:packedStringTyConKey                   = mkPreludeTyConUnique 28
 500 synchVarPrimTyConKey                    = mkPreludeTyConUnique 29
 501 ratioTyConKey                           = mkPreludeTyConUnique 30
 502 rationalTyConKey                        = mkPreludeTyConUnique 31
 503 realWorldTyConKey                       = mkPreludeTyConUnique 32
 504 --UNUSED:requestTyConKey                                = mkPreludeTyConUnique 33
 505 --UNUSED:responseTyConKey                       = mkPreludeTyConUnique 34
 506 return2GMPsTyConKey                     = mkPreludeTyConUnique 35
 507 returnIntAndGMPTyConKey                 = mkPreludeTyConUnique 36
 508 --UNUSED:seqIntPrimTyConKey                     = mkPreludeTyConUnique 37
 509 --UNUSED:seqTyConKey                            = mkPreludeTyConUnique 38
 510 stablePtrPrimTyConKey                   = mkPreludeTyConUnique 39
 511 stablePtrTyConKey                       = mkPreludeTyConUnique 40
 512 stateAndAddrPrimTyConKey                = mkPreludeTyConUnique 41
 513 stateAndArrayPrimTyConKey               = mkPreludeTyConUnique 42
 514 stateAndByteArrayPrimTyConKey           = mkPreludeTyConUnique 43
 515 stateAndCharPrimTyConKey                = mkPreludeTyConUnique 44
 516 stateAndDoublePrimTyConKey              = mkPreludeTyConUnique 45
 517 stateAndFloatPrimTyConKey               = mkPreludeTyConUnique 46
 518 stateAndIntPrimTyConKey                 = mkPreludeTyConUnique 47
 519 stateAndMallocPtrPrimTyConKey           = mkPreludeTyConUnique 48
 520 stateAndMutableArrayPrimTyConKey        = mkPreludeTyConUnique 49
 521 stateAndMutableByteArrayPrimTyConKey    = mkPreludeTyConUnique 50
 522 stateAndSynchVarPrimTyConKey            = mkPreludeTyConUnique 51
 523 stateAndPtrPrimTyConKey                 = mkPreludeTyConUnique 52
 524 stateAndStablePtrPrimTyConKey           = mkPreludeTyConUnique 53
 525 stateAndWordPrimTyConKey                = mkPreludeTyConUnique 54
 526 statePrimTyConKey                       = mkPreludeTyConUnique 55
 527 stateTyConKey                           = mkPreludeTyConUnique 56
 528 stringTyConKey                          = mkPreludeTyConUnique 57
 529 stTyConKey                              = mkPreludeTyConUnique 58
 530 primIoTyConKey                          = mkPreludeTyConUnique 59
 531 --UNUSED:ioResultTyConKey                       = mkPreludeTyConUnique 60
 532 voidPrimTyConKey                        = mkPreludeTyConUnique 61
 533 wordPrimTyConKey                        = mkPreludeTyConUnique 62
 534 wordTyConKey                            = mkPreludeTyConUnique 63
 535
 536 #ifdef DPH
 537 podTyConKey                             = mkPreludeTyConUnique 64
 538 interfacePodTyConKey                    = mkPreludeTyConUnique 65
 539
 540 podizedPodTyConKey _ = panic "ToDo:DPH:podizedPodTyConKey"
 541 #endif {- Data Parallel Haskell -}
 542 \end{code}
 543
 544 %************************************************************************
 545 %*                                                                      *
 546 \subsubsection[Uniques-prelude-DataCons]{@Uniques@ for wired-in @DataCons@}
 547 %*                                                                      *
 548 %************************************************************************
 549
 550 \begin{code}
 551 addrDataConKey                          = mkPreludeDataConUnique  1
 552 buildDataConKey                         = mkPreludeDataConUnique  2
 553 --UNUSED:byteArrayDataConKey                    = mkPreludeDataConUnique  3
 554 charDataConKey                          = mkPreludeDataConUnique  4
 555 consDataConKey                          = mkPreludeDataConUnique  5
 556 doubleDataConKey                        = mkPreludeDataConUnique  6
 557 eqTagDataConKey                         = mkPreludeDataConUnique  7
 558 falseDataConKey                         = mkPreludeDataConUnique  8
 559 floatDataConKey                         = mkPreludeDataConUnique  9
 560 gtTagDataConKey                         = mkPreludeDataConUnique 10
 561 intDataConKey                           = mkPreludeDataConUnique 11
 562 integerDataConKey                       = mkPreludeDataConUnique 12
 563 liftDataConKey                          = mkPreludeDataConUnique 13
 564 ltTagDataConKey                         = mkPreludeDataConUnique 14
 565 mallocPtrDataConKey                     = mkPreludeDataConUnique 15
 566 --UNUSED:mutableArrayDataConKey                 = mkPreludeDataConUnique 16
 567 --UNUSED:mutableByteArrayDataConKey             = mkPreludeDataConUnique 17
 568 nilDataConKey                           = mkPreludeDataConUnique 18
 569 --UNUSED:psDataConKey                           = mkPreludeDataConUnique 19
 570 --UNUSED:cpsDataConKey                          = mkPreludeDataConUnique 20
 571 ratioDataConKey                         = mkPreludeDataConUnique 21
 572 return2GMPsDataConKey                   = mkPreludeDataConUnique 22
 573 returnIntAndGMPDataConKey               = mkPreludeDataConUnique 23
 574 stablePtrDataConKey                     = mkPreludeDataConUnique 24
 575 stateAndAddrPrimDataConKey              = mkPreludeDataConUnique 25
 576 stateAndArrayPrimDataConKey             = mkPreludeDataConUnique 26
 577 stateAndByteArrayPrimDataConKey         = mkPreludeDataConUnique 27
 578 stateAndCharPrimDataConKey              = mkPreludeDataConUnique 28
 579 stateAndDoublePrimDataConKey            = mkPreludeDataConUnique 29
 580 stateAndFloatPrimDataConKey             = mkPreludeDataConUnique 30
 581 stateAndIntPrimDataConKey               = mkPreludeDataConUnique 31
 582 stateAndMallocPtrPrimDataConKey         = mkPreludeDataConUnique 32
 583 stateAndMutableArrayPrimDataConKey      = mkPreludeDataConUnique 33
 584 stateAndMutableByteArrayPrimDataConKey  = mkPreludeDataConUnique 34
 585 stateAndSynchVarPrimDataConKey          = mkPreludeDataConUnique 35
 586 stateAndPtrPrimDataConKey               = mkPreludeDataConUnique 36
 587 stateAndStablePtrPrimDataConKey         = mkPreludeDataConUnique 37
 588 stateAndWordPrimDataConKey              = mkPreludeDataConUnique 38
 589 stateDataConKey                         = mkPreludeDataConUnique 39
 590 trueDataConKey                          = mkPreludeDataConUnique 40
 591 wordDataConKey                          = mkPreludeDataConUnique 41
 592
 593 #ifdef DPH
 594 interfacePodDataConKey                  = mkPreludeDataConUnique 42
 595 #endif {- Data Parallel Haskell -}
 596 \end{code}
 597
 598 %************************************************************************
 599 %*                                                                      *
 600 \subsubsection[Uniques-prelude-Ids]{@Uniques@ for wired-in @Ids@ (except @DataCons@)}
 601 %*                                                                      *
 602 %************************************************************************
 603
 604 First, for raw @PrimOps@ and their boxed versions:
 605 \begin{code}
 606 mkPrimOpIdUnique :: PrimOp -> Unique
 607
 608 mkPrimOpIdUnique op = mkUnique '5' IBOX((tagOf_PrimOp op))
 609 \end{code}
 610
 611 Now for other non-@DataCon@ @Ids@:
 612 \begin{code}
 613 absentErrorIdKey        = mkPreludeMiscIdUnique  1
 614 buildIdKey              = mkPreludeMiscIdUnique  2
 615 errorIdKey              = mkPreludeMiscIdUnique  3
 616 foldlIdKey              = mkPreludeMiscIdUnique  4
 617 foldrIdKey              = mkPreludeMiscIdUnique  5
 618 forkIdKey               = mkPreludeMiscIdUnique  6
 619 int2IntegerIdKey        = mkPreludeMiscIdUnique  7
 620 integerMinusOneIdKey    = mkPreludeMiscIdUnique  8
 621 integerPlusOneIdKey     = mkPreludeMiscIdUnique  9
 622 integerZeroIdKey        = mkPreludeMiscIdUnique 10
 623 integerPlusTwoIdKey     = mkPreludeMiscIdUnique 11
 624 packCStringIdKey        = mkPreludeMiscIdUnique 12
 625 parIdKey                = mkPreludeMiscIdUnique 13
 626 parErrorIdKey           = mkPreludeMiscIdUnique 14
 627 patErrorIdKey           = mkPreludeMiscIdUnique 15
 628 --UNUSED:readParenIdKey         = mkPreludeMiscIdUnique 16
 629 realWorldPrimIdKey      = mkPreludeMiscIdUnique 17
 630 runSTIdKey              = mkPreludeMiscIdUnique 18
 631 seqIdKey                = mkPreludeMiscIdUnique 19
 632 --UNUSED:showParenIdKey         = mkPreludeMiscIdUnique 20
 633 --UNUSED:showSpaceIdKey         = mkPreludeMiscIdUnique 21
 634 traceIdKey              = mkPreludeMiscIdUnique 22
 635 unpackCStringIdKey      = mkPreludeMiscIdUnique 23
 636 unpackCString2IdKey     = mkPreludeMiscIdUnique 20 -- NB: NB: NB
 637 unpackCStringAppendIdKey= mkPreludeMiscIdUnique 21 -- NB: NB: NB
 638 voidPrimIdKey           = mkPreludeMiscIdUnique 24
 639
 640 #ifdef GRAN
 641 parLocalIdKey           = mkPreludeMiscIdUnique 25
 642 parGlobalIdKey          = mkPreludeMiscIdUnique 26
 643 noFollowIdKey           = mkPreludeMiscIdUnique 27
 644 copyableIdKey           = mkPreludeMiscIdUnique 28
 645 #endif
 646
 647 #ifdef DPH
 648 podSelectorIdKey        = mkPreludeMiscIdUnique 29
 649 #endif {- Data Parallel Haskell -}
 650 \end{code}
 651
 652 %************************************************************************
 653 %*                                                                      *
 654 \subsection[UniqueSupply-type]{@UniqueSupply@ type and operations}
 655 %*                                                                      *
 656 %************************************************************************
 657
 658 \begin{code}
 659 #ifdef __GLASGOW_HASKELL__
 660 data UniqueSupply
 661   = MkUniqueSupply  Int#
 662   | MkNewSupply     SplitUniqSupply
 663
 664 #else
 665 data UniqueSupply
 666   = MkUniqueSupply  Word{-#STRICT#-}
 667   | MkNewSupply     SplitUniqSupply
 668 #endif
 669 \end{code}
 670
 671 @mkUniqueSupply@ is used to get a @UniqueSupply@ started.
 672 \begin{code}
 673 mkUniqueSupply :: Char -> UniqueSupply
 674
 675 #ifdef __GLASGOW_HASKELL__
 676
 677 mkUniqueSupply (MkChar c#)
 678   = MkUniqueSupply (w2i ((i2w (ord# c#)) `shiftL#` (i2w_s 24#)))
 679
 680 #else
 681
 682 mkUniqueSupply c
 683   = MkUniqueSupply ((fromInt (ord c)) `bitLsh` 24)
 684
 685 #endif
 686
 687 mkUniqueSupplyGrimily s = MkNewSupply s
 688 \end{code}
 689
 690 The basic operation on a @UniqueSupply@ is to get a @Unique@ (or a
 691 few).  It's just plain different when splittable vs.~not...
 692 \begin{code}
 693 getUnique :: UniqueSupply -> (UniqueSupply, Unique)
 694
 695 getUnique (MkUniqueSupply n)
 696 #ifdef __GLASGOW_HASKELL__
 697   = (MkUniqueSupply (n +# 1#), MkUnique n)
 698 #else
 699   = (MkUniqueSupply (n + 1), MkUnique n)
 700 #endif
 701 getUnique (MkNewSupply s)
 702   = let
 703         (u, s1) = getSUniqueAndDepleted s
 704     in
 705     (MkNewSupply s1, u)
 706
 707 getUniques :: Int               -- how many you want
 708            -> UniqueSupply
 709            -> (UniqueSupply, [Unique])
 710
 711 #ifdef __GLASGOW_HASKELL__
 712 getUniques i@(MkInt i#) (MkUniqueSupply n)
 713   = (MkUniqueSupply (n +# i#),
 714      [ case x of { MkInt x# ->
 715          MkUnique (n +# x#) } | x <- [0 .. i-1] ])
 716 #else
 717 getUniques i (MkUniqueSupply n)
 718   = (MkUniqueSupply (n + fromInt i), [ MkUnique (n + fromInt x) | x <- [0 .. i-1] ])
 719 #endif
 720 getUniques i (MkNewSupply s)
 721   = let
 722         (us, s1) = getSUniquesAndDepleted i s
 723     in
 724     (MkNewSupply s1, us)
 725 \end{code}
 726
 727 [OLD-ish NOTE] Simon says: The last line is preferable over @(n+i,
 728 <mumble> [n .. (n+i-1)])@, because it is a little lazier.  If n=bot
 729 you get ([bot, bot, bot], bot) back instead of (bot,bot).  This is
 730 sometimes important for knot-tying.
 731
 732 Alternatively, if you hate the inefficiency:
 733 \begin{pseudocode}
 734 (range 0, n+i)  where range m | m=i = []
 735                       range m       = n+m : range (m+1)
 736 \end{pseudocode}
 737
 738 %************************************************************************
 739 %*                                                                      *
 740 \subsection[UniqueSupplies-compiler]{@UniqueSupplies@ specific to the compiler}
 741 %*                                                                      *
 742 %************************************************************************
 743
 744 Different parts of the compiler have their own @UniqueSupplies@, each
 745 identified by their ``tag letter:''
 746 \begin{verbatim}
 747     B           builtin; for when the compiler conjures @Uniques@ out of
 748                 thin air
 749     b           a second builtin; we need two in mkWrapperUnfolding (False)
 750     r           renamer
 751     t           typechecker
 752     d           desugarer
 753     p           ``podizer'' (DPH only)
 754     s           core-to-core simplifier
 755     S           ``pod'' simplifier (DPH only)
 756     c           core-to-stg
 757     T           stg-to-stg simplifier
 758     f           flattener (of abstract~C)
 759     L           Assembly labels (for native-code generators)
 760     u           Printing out unfoldings (so don't have constant renaming)
 761     P           profiling (finalCCstg)
 762
 763     v           used in specialised TyVarUniques (see TyVar.lhs)
 764
 765     1-9         used for ``prelude Uniques'' (wired-in things; see below)
 766                 1 = classes
 767                 2 = tycons
 768                 3 = data cons
 769                 4 = tuple datacons
 770                 5 = unboxed-primop ids
 771                 6 = boxed-primop ids
 772                 7 = misc ids
 773 \end{verbatim}
 774
 775 \begin{code}
 776 uniqSupply_r = mkUniqueSupply 'r'
 777 uniqSupply_t = mkUniqueSupply 't'
 778 uniqSupply_d = mkUniqueSupply 'd'
 779 uniqSupply_p = mkUniqueSupply 'p'
 780 uniqSupply_s = mkUniqueSupply 's'
 781 uniqSupply_S = mkUniqueSupply 'S'
 782 uniqSupply_c = mkUniqueSupply 'c'
 783 uniqSupply_T = mkUniqueSupply 'T'
 784 uniqSupply_f = mkUniqueSupply 'f'
 785 uniqSupply_L = mkUniqueSupply 'L'
 786 uniqSupply_u = mkUniqueSupply 'u'
 787 uniqSupply_P = mkUniqueSupply 'P'
 788 \end{code}
 789
 790 The ``builtin UniqueSupplies'' are more magical.  You don't use the
 791 supply, you ask for @Uniques@ directly from it.  (They probably aren't
 792 unique, but you know that!)
 793
 794 \begin{code}
 795 uniqSupply_B = mkUniqueSupply 'B' -- not exported!
 796 uniqSupply_b = mkUniqueSupply 'b' -- not exported!
 797 \end{code}
 798
 799 \begin{code}
 800 mkPseudoUnique1, mkPseudoUnique2, mkPseudoUnique3,
 801  mkBuiltinUnique :: Int -> Unique
 802
 803 mkBuiltinUnique i = mkUnique 'B' i
 804 mkPseudoUnique1 i = mkUnique 'C' i -- used for getTheUnique on Regs
 805 mkPseudoUnique2 i = mkUnique 'D' i -- ditto
 806 mkPseudoUnique3 i = mkUnique 'E' i -- ditto
 807
 808 getBuiltinUniques :: Int -> [Unique]
 809 getBuiltinUniques n = map (mkUnique 'B') [1 .. n]
 810 \end{code}
 811
 812 The following runs a uniq monad expression, using builtin uniq values:
 813 \begin{code}
 814 runBuiltinUs :: UniqSM a -> a
 815 runBuiltinUs m = snd (initUs uniqSupply_B m)
 816 \end{code}
 817
 818 %************************************************************************
 819 %*                                                                      *
 820 \subsection[Unique-monad]{Unique supply monad}
 821 %*                                                                      *
 822 %************************************************************************
 823
 824 A very plain unique-supply monad.
 825
 826 \begin{code}
 827 type UniqSM result = UniqueSupply -> (UniqueSupply, result)
 828
 829 -- the initUs function also returns the final UniqueSupply
 830
 831 initUs :: UniqueSupply -> UniqSM a -> (UniqueSupply, a)
 832
 833 initUs init_us m = m init_us
 834
 835 #ifdef __GLASGOW_HASKELL__
 836 {-# INLINE thenUs #-}
 837 {-# INLINE returnUs #-}
 838 #endif
 839 \end{code}
 840
 841 @thenUs@ is are where we split the @UniqueSupply@.
 842 \begin{code}
 843 thenUs :: UniqSM a -> (a -> UniqSM b) -> UniqSM b
 844
 845 thenUs expr cont us
 846   = case (expr us) of
 847       (us1, result) -> cont result us1
 848 \end{code}
 849
 850 \begin{code}
 851 returnUs :: a -> UniqSM a
 852 returnUs result us = (us, result)
 853
 854 mapUs :: (a -> UniqSM b) -> [a] -> UniqSM [b]
 855
 856 mapUs f []     = returnUs []
 857 mapUs f (x:xs)
 858   = f x         `thenUs` \ r  ->
 859     mapUs f xs  `thenUs` \ rs ->
 860     returnUs (r:rs)
 861
 862 mapAndUnzipUs  :: (a -> UniqSM (b,c))   -> [a] -> UniqSM ([b],[c])
 863
 864 mapAndUnzipUs f [] = returnUs ([],[])
 865 mapAndUnzipUs f (x:xs)
 866   = f x                 `thenUs` \ (r1,  r2)  ->
 867     mapAndUnzipUs f xs  `thenUs` \ (rs1, rs2) ->
 868     returnUs (r1:rs1, r2:rs2)
 869 \end{code}