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, 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 'Y' i -- must be alphabetic
 430 mkTupleDataConUnique i          = mkUnique 'Z' i -- ditto (*may* be used in C labels)
 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 unpackCString2IdKey     = mkPreludeMiscIdUnique 20 -- NB: NB: NB
 636 unpackCStringAppendIdKey= mkPreludeMiscIdUnique 21 -- NB: NB: NB
 637 voidPrimIdKey           = mkPreludeMiscIdUnique 24
 638
 639 #ifdef GRAN
 640 parLocalIdKey           = mkPreludeMiscIdUnique 25
 641 parGlobalIdKey          = mkPreludeMiscIdUnique 26
 642 noFollowIdKey           = mkPreludeMiscIdUnique 27
 643 copyableIdKey           = mkPreludeMiscIdUnique 28
 644 #endif
 645
 646 #ifdef DPH
 647 podSelectorIdKey        = mkPreludeMiscIdUnique 29
 648 #endif {- Data Parallel Haskell -}
 649 \end{code}
 650
 651 %************************************************************************
 652 %*                                                                      *
 653 \subsection[UniqueSupply-type]{@UniqueSupply@ type and operations}
 654 %*                                                                      *
 655 %************************************************************************
 656
 657 \begin{code}
 658 #ifdef __GLASGOW_HASKELL__
 659 data UniqueSupply
 660   = MkUniqueSupply  Int#
 661   | MkNewSupply     SplitUniqSupply
 662
 663 #else
 664 data UniqueSupply
 665   = MkUniqueSupply  Word{-#STRICT#-}
 666   | MkNewSupply     SplitUniqSupply
 667 #endif
 668 \end{code}
 669
 670 @mkUniqueSupply@ is used to get a @UniqueSupply@ started.
 671 \begin{code}
 672 mkUniqueSupply :: Char -> UniqueSupply
 673
 674 #ifdef __GLASGOW_HASKELL__
 675
 676 mkUniqueSupply (MkChar c#)
 677   = MkUniqueSupply (w2i ((i2w (ord# c#)) `shiftL#` (i2w_s 24#)))
 678
 679 #else
 680
 681 mkUniqueSupply c
 682   = MkUniqueSupply ((fromInt (ord c)) `bitLsh` 24)
 683
 684 #endif
 685
 686 mkUniqueSupplyGrimily s = MkNewSupply s
 687 \end{code}
 688
 689 The basic operation on a @UniqueSupply@ is to get a @Unique@ (or a
 690 few).  It's just plain different when splittable vs.~not...
 691 \begin{code}
 692 getUnique :: UniqueSupply -> (UniqueSupply, Unique)
 693
 694 getUnique (MkUniqueSupply n)
 695 #ifdef __GLASGOW_HASKELL__
 696   = (MkUniqueSupply (n +# 1#), MkUnique n)
 697 #else
 698   = (MkUniqueSupply (n + 1), MkUnique n)
 699 #endif
 700 getUnique (MkNewSupply s)
 701   = let
 702         (u, s1) = getSUniqueAndDepleted s
 703     in
 704     (MkNewSupply s1, u)
 705
 706 getUniques :: Int               -- how many you want
 707            -> UniqueSupply
 708            -> (UniqueSupply, [Unique])
 709
 710 #ifdef __GLASGOW_HASKELL__
 711 getUniques i@(MkInt i#) (MkUniqueSupply n)
 712   = (MkUniqueSupply (n +# i#),
 713      [ case x of { MkInt x# ->
 714          MkUnique (n +# x#) } | x <- [0 .. i-1] ])
 715 #else
 716 getUniques i (MkUniqueSupply n)
 717   = (MkUniqueSupply (n + fromInt i), [ MkUnique (n + fromInt x) | x <- [0 .. i-1] ])
 718 #endif
 719 getUniques i (MkNewSupply s)
 720   = let
 721         (us, s1) = getSUniquesAndDepleted i s
 722     in
 723     (MkNewSupply s1, us)
 724 \end{code}
 725
 726 [OLD-ish NOTE] Simon says: The last line is preferable over @(n+i,
 727 <mumble> [n .. (n+i-1)])@, because it is a little lazier.  If n=bot
 728 you get ([bot, bot, bot], bot) back instead of (bot,bot).  This is
 729 sometimes important for knot-tying.
 730
 731 Alternatively, if you hate the inefficiency:
 732 \begin{pseudocode}
 733 (range 0, n+i)  where range m | m=i = []
 734                       range m       = n+m : range (m+1)
 735 \end{pseudocode}
 736
 737 %************************************************************************
 738 %*                                                                      *
 739 \subsection[UniqueSupplies-compiler]{@UniqueSupplies@ specific to the compiler}
 740 %*                                                                      *
 741 %************************************************************************
 742
 743 Different parts of the compiler have their own @UniqueSupplies@, each
 744 identified by their ``tag letter:''
 745 \begin{verbatim}
 746     B           builtin; for when the compiler conjures @Uniques@ out of
 747                 thin air
 748     b           a second builtin; we need two in mkWrapperUnfolding (False)
 749     r           renamer
 750     t           typechecker
 751     d           desugarer
 752     p           ``podizer'' (DPH only)
 753     s           core-to-core simplifier
 754     S           ``pod'' simplifier (DPH only)
 755     c           core-to-stg
 756     T           stg-to-stg simplifier
 757     f           flattener (of abstract~C)
 758     L           Assembly labels (for native-code generators)
 759     u           Printing out unfoldings (so don't have constant renaming)
 760     P           profiling (finalCCstg)
 761
 762     v           used in specialised TyVarUniques (see TyVar.lhs)
 763
 764     1-9         used for ``prelude Uniques'' (wired-in things; see below)
 765                 1 = classes
 766                 2 = tycons
 767                 3 = data cons
 768                 4 = tuple datacons
 769                 5 = unboxed-primop ids
 770                 6 = boxed-primop ids
 771                 7 = misc ids
 772 \end{verbatim}
 773
 774 \begin{code}
 775 uniqSupply_r = mkUniqueSupply 'r'
 776 uniqSupply_t = mkUniqueSupply 't'
 777 uniqSupply_d = mkUniqueSupply 'd'
 778 uniqSupply_p = mkUniqueSupply 'p'
 779 uniqSupply_s = mkUniqueSupply 's'
 780 uniqSupply_S = mkUniqueSupply 'S'
 781 uniqSupply_c = mkUniqueSupply 'c'
 782 uniqSupply_T = mkUniqueSupply 'T'
 783 uniqSupply_f = mkUniqueSupply 'f'
 784 uniqSupply_L = mkUniqueSupply 'L'
 785 uniqSupply_u = mkUniqueSupply 'u'
 786 uniqSupply_P = mkUniqueSupply 'P'
 787 \end{code}
 788
 789 The ``builtin UniqueSupplies'' are more magical.  You don't use the
 790 supply, you ask for @Uniques@ directly from it.  (They probably aren't
 791 unique, but you know that!)
 792
 793 \begin{code}
 794 uniqSupply_B = mkUniqueSupply 'B' -- not exported!
 795 uniqSupply_b = mkUniqueSupply 'b' -- not exported!
 796 \end{code}
 797
 798 \begin{code}
 799 mkPseudoUnique1, mkPseudoUnique2, mkPseudoUnique3,
 800  mkBuiltinUnique :: Int -> Unique
 801
 802 mkBuiltinUnique i = mkUnique 'B' i
 803 mkPseudoUnique1 i = mkUnique 'C' i -- used for getTheUnique on Regs
 804 mkPseudoUnique2 i = mkUnique 'D' i -- ditto
 805 mkPseudoUnique3 i = mkUnique 'E' i -- ditto
 806
 807 getBuiltinUniques :: Int -> [Unique]
 808 getBuiltinUniques n = map (mkUnique 'B') [1 .. n]
 809 \end{code}
 810
 811 The following runs a uniq monad expression, using builtin uniq values:
 812 \begin{code}
 813 runBuiltinUs :: UniqSM a -> a
 814 runBuiltinUs m = snd (initUs uniqSupply_B m)
 815 \end{code}
 816
 817 %************************************************************************
 818 %*                                                                      *
 819 \subsection[Unique-monad]{Unique supply monad}
 820 %*                                                                      *
 821 %************************************************************************
 822
 823 A very plain unique-supply monad.
 824
 825 \begin{code}
 826 type UniqSM result = UniqueSupply -> (UniqueSupply, result)
 827
 828 -- the initUs function also returns the final UniqueSupply
 829
 830 initUs :: UniqueSupply -> UniqSM a -> (UniqueSupply, a)
 831
 832 initUs init_us m = m init_us
 833
 834 #ifdef __GLASGOW_HASKELL__
 835 {-# INLINE thenUs #-}
 836 {-# INLINE returnUs #-}
 837 #endif
 838 \end{code}
 839
 840 @thenUs@ is are where we split the @UniqueSupply@.
 841 \begin{code}
 842 thenUs :: UniqSM a -> (a -> UniqSM b) -> UniqSM b
 843
 844 thenUs expr cont us
 845   = case (expr us) of
 846       (us1, result) -> cont result us1
 847 \end{code}
 848
 849 \begin{code}
 850 returnUs :: a -> UniqSM a
 851 returnUs result us = (us, result)
 852
 853 mapUs :: (a -> UniqSM b) -> [a] -> UniqSM [b]
 854
 855 mapUs f []     = returnUs []
 856 mapUs f (x:xs)
 857   = f x         `thenUs` \ r  ->
 858     mapUs f xs  `thenUs` \ rs ->
 859     returnUs (r:rs)
 860
 861 mapAndUnzipUs  :: (a -> UniqSM (b,c))   -> [a] -> UniqSM ([b],[c])
 862
 863 mapAndUnzipUs f [] = returnUs ([],[])
 864 mapAndUnzipUs f (x:xs)
 865   = f x                 `thenUs` \ (r1,  r2)  ->
 866     mapAndUnzipUs f xs  `thenUs` \ (rs1, rs2) ->
 867     returnUs (r1:rs1, r2:rs2)
 868 \end{code}