[project @ 1996-01-08 20:28:12 by partain]
[ghc.git] / 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}