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