2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
4 \section[Unique]{The @Unique@ data type}
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.
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
14 Some of the other hair in this code is to be able to use a
15 ``splittable @UniqueSupply@'' if requested/possible (not standard
19 #include "HsVersions.h"
21 --<mkdependHS:friends> UniqSupply
25 u2i, -- hack: used in UniqFM
27 pprUnique, pprUnique10, showUnique,
29 mkUnique, -- Used in UniqSupply
30 mkUniqueGrimily, -- Used in UniqSupply only!
32 incrUnique, -- Used for renumbering
33 initRenumberingUniques,
35 -- now all the built-in Uniques (and functions to make them)
36 -- [the Oh-So-Wonderful Haskell module system wins again...]
42 getBuiltinUniques, mkBuiltinUnique,
43 mkPseudoUnique1, mkPseudoUnique2, mkPseudoUnique3,
45 absentErrorIdKey, -- alphabetical...
57 byteArrayPrimTyConKey,
70 enumFromThenClassOpKey,
71 enumFromThenToClassOpKey,
86 foreignObjPrimTyConKey,
92 fromIntegerClassOpKey,
93 fromRationalClassOpKey,
103 integerMinusOneIdKey,
109 irrefutPatErrorIdKey,
116 mainKey, mainPrimIoKey,
121 mutableArrayPrimTyConKey,
122 mutableByteArrayPrimTyConKey,
124 noDefaultMethodErrorIdKey,
125 nonExhaustiveGuardsErrorIdKey,
126 nonExplicitMethodErrorIdKey,
149 return2GMPsDataConKey,
151 returnIntAndGMPDataConKey,
152 returnIntAndGMPTyConKey,
163 stablePtrPrimTyConKey,
165 stateAndAddrPrimDataConKey,
166 stateAndAddrPrimTyConKey,
167 stateAndArrayPrimDataConKey,
168 stateAndArrayPrimTyConKey,
169 stateAndByteArrayPrimDataConKey,
170 stateAndByteArrayPrimTyConKey,
171 stateAndCharPrimDataConKey,
172 stateAndCharPrimTyConKey,
173 stateAndDoublePrimDataConKey,
174 stateAndDoublePrimTyConKey,
175 stateAndFloatPrimDataConKey,
176 stateAndFloatPrimTyConKey,
177 stateAndForeignObjPrimDataConKey,
178 stateAndForeignObjPrimTyConKey,
179 stateAndIntPrimDataConKey,
180 stateAndIntPrimTyConKey,
181 stateAndMutableArrayPrimDataConKey,
182 stateAndMutableArrayPrimTyConKey,
183 stateAndMutableByteArrayPrimDataConKey,
184 stateAndMutableByteArrayPrimTyConKey,
185 stateAndPtrPrimDataConKey,
186 stateAndPtrPrimTyConKey,
187 stateAndStablePtrPrimDataConKey,
188 stateAndStablePtrPrimTyConKey,
189 stateAndSynchVarPrimDataConKey,
190 stateAndSynchVarPrimTyConKey,
191 stateAndWordPrimDataConKey,
192 stateAndWordPrimTyConKey,
196 synchVarPrimTyConKey,
202 unpackCStringAppendIdKey,
203 unpackCStringFoldrIdKey,
232 %************************************************************************
234 \subsection[Unique-type]{@Unique@ type and operations}
236 %************************************************************************
238 The @Chars@ are ``tag letters'' that identify the @UniqueSupply@.
239 Fast comparison is everything on @Uniques@:
242 u2i :: Unique -> FAST_INT
244 data Unique = MkUnique Int#
248 Now come the functions which construct uniques from their pieces, and vice versa.
249 The stuff about unique *supplies* is handled further down this module.
252 mkUnique :: Char -> Int -> Unique -- Builds a unique from pieces
253 unpkUnique :: Unique -> (Char, Int) -- The reverse
255 mkUniqueGrimily :: Int# -> Unique -- A trap-door for UniqSupply
257 incrUnique :: Unique -> Unique
262 mkUniqueGrimily x = MkUnique x
264 incrUnique (MkUnique i) = MkUnique (i +# 1#)
266 -- pop the Char in the top 8 bits of the Unique(Supply)
268 -- No 64-bit bugs here, as long as we have at least 32 bits. --JSM
274 mkUnique (C# c) (I# i)
275 = MkUnique (w2i (((i2w (ord# c)) `shiftL#` (i2w_s 24#)) `or#` (i2w i)))
277 unpkUnique (MkUnique u)
279 tag = C# (chr# (w2i ((i2w u) `shiftr` (i2w_s 24#))))
280 i = I# (w2i ((i2w u) `and#` (i2w 16777215#){-``0x00ffffff''-}))
284 shiftr x y = shiftRA# x y
287 %************************************************************************
289 \subsection[Unique-instances]{Instance declarations for @Unique@}
291 %************************************************************************
293 And the whole point (besides uniqueness) is fast equality. We don't
294 use `deriving' because we want {\em precise} control of ordering
295 (equality on @Uniques@ is v common).
298 eqUnique (MkUnique u1) (MkUnique u2) = u1 ==# u2
299 ltUnique (MkUnique u1) (MkUnique u2) = u1 <# u2
300 leUnique (MkUnique u1) (MkUnique u2) = u1 <=# u2
302 cmpUnique (MkUnique u1) (MkUnique u2)
303 = if u1 ==# u2 then EQ_ else if u1 <# u2 then LT_ else GT_
305 instance Eq Unique where
306 a == b = eqUnique a b
307 a /= b = not (eqUnique a b)
309 instance Ord Unique where
311 a <= b = leUnique a b
312 a > b = not (leUnique a b)
313 a >= b = not (ltUnique a b)
314 _tagCmp a b = case cmpUnique a b of { LT_ -> _LT; EQ_ -> _EQ; GT__ -> _GT }
316 instance Ord3 Unique where
320 instance Uniquable Unique where
324 We do sometimes make strings with @Uniques@ in them:
326 pprUnique, pprUnique10 :: Unique -> Pretty
329 = case unpkUnique uniq of
330 (tag, u) -> finish_ppr tag u (iToBase62 u)
332 pprUnique10 uniq -- in base-10, dudes
333 = case unpkUnique uniq of
334 (tag, u) -> finish_ppr tag u (ppInt u)
336 finish_ppr tag u pp_u
337 = if tag /= 't' -- this is just to make v common tyvars, t1, t2, ...
338 -- come out as a, b, ... (shorter, easier to read)
348 pp_all = ppBeside (ppChar tag) pp_u
350 showUnique :: Unique -> FAST_STRING
351 showUnique uniq = _PK_ (ppShow 80 (pprUnique uniq))
353 instance Outputable Unique where
354 ppr sty u = pprUnique u
356 instance Text Unique where
357 showsPrec p uniq rest = _UNPK_ (showUnique uniq)
360 %************************************************************************
362 \subsection[Utils-base62]{Base-62 numbers}
364 %************************************************************************
366 A character-stingy way to read/write numbers (notably Uniques).
367 The ``62-its'' are \tr{[0-9a-zA-Z]}. We don't handle negative Ints.
368 Code stolen from Lennart.
370 #if __GLASGOW_HASKELL__ >= 200
371 # define BYTE_ARRAY GHCbase.ByteArray
372 # define RUN_ST GHCbase.runST
373 # define AND_THEN >>=
374 # define AND_THEN_ >>
375 # define RETURN return
377 # define BYTE_ARRAY _ByteArray
378 # define RUN_ST _runST
379 # define AND_THEN `thenStrictlyST`
380 # define AND_THEN_ `seqStrictlyST`
381 # define RETURN returnStrictlyST
384 iToBase62 :: Int -> Pretty
389 bytes = case chars62 of { BYTE_ARRAY bounds_who_needs_'em bytes -> bytes }
392 case (indexCharArray# bytes n#) of { c ->
395 case (quotRem n 62) of { (q, I# r#) ->
396 case (indexCharArray# bytes r#) of { c ->
397 ppBeside (iToBase62 q) (ppChar (C# c)) }}
399 -- keep this at top level! (bug on 94/10/24 WDP)
400 chars62 :: BYTE_ARRAY Int
403 newCharArray (0, 61) AND_THEN \ ch_array ->
404 fill_in ch_array 0 62 "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
406 unsafeFreezeByteArray ch_array
409 fill_in ch_array i lim str
413 = writeCharArray ch_array i (str !! i) AND_THEN_
414 fill_in ch_array (i+1) lim str
417 %************************************************************************
419 \subsection[Uniques-prelude]{@Uniques@ for wired-in Prelude things}
421 %************************************************************************
423 Allocation of unique supply characters:
424 v,t,u : for renumbering value-, type- and usage- vars.
425 other a-z: lower case chars for unique supplies (see Main.lhs)
427 C-E: pseudo uniques (used in native-code generator)
428 _: unifiable tyvars (above)
429 1-8: prelude things below
432 mkAlphaTyVarUnique i = mkUnique '1' i
434 mkPreludeClassUnique i = mkUnique '2' i
435 mkPreludeTyConUnique i = mkUnique '3' i
436 mkTupleTyConUnique a = mkUnique '4' a
438 mkPreludeDataConUnique i = mkUnique '5' i -- must be alphabetic
439 mkTupleDataConUnique a = mkUnique '6' a -- ditto (*may* be used in C labels)
441 mkPrimOpIdUnique op = mkUnique '7' op
442 mkPreludeMiscIdUnique i = mkUnique '8' i
444 initRenumberingUniques = (mkUnique 'v' 1, mkUnique 't' 1, mkUnique 'u' 1)
446 mkPseudoUnique1, mkPseudoUnique2, mkPseudoUnique3,
447 mkBuiltinUnique :: Int -> Unique
449 mkBuiltinUnique i = mkUnique 'B' i
450 mkPseudoUnique1 i = mkUnique 'C' i -- used for uniqueOf on Regs
451 mkPseudoUnique2 i = mkUnique 'D' i -- ditto
452 mkPseudoUnique3 i = mkUnique 'E' i -- ditto
454 getBuiltinUniques :: Int -> [Unique]
455 getBuiltinUniques n = map (mkUnique 'B') [1 .. n]
458 %************************************************************************
460 \subsubsection[Uniques-prelude-Classes]{@Uniques@ for wired-in @Classes@}
462 %************************************************************************
465 boundedClassKey = mkPreludeClassUnique 1
466 enumClassKey = mkPreludeClassUnique 2
467 eqClassKey = mkPreludeClassUnique 3
468 evalClassKey = mkPreludeClassUnique 4
469 floatingClassKey = mkPreludeClassUnique 5
470 fractionalClassKey = mkPreludeClassUnique 6
471 integralClassKey = mkPreludeClassUnique 7
472 monadClassKey = mkPreludeClassUnique 8
473 monadZeroClassKey = mkPreludeClassUnique 9
474 monadPlusClassKey = mkPreludeClassUnique 10
475 functorClassKey = mkPreludeClassUnique 11
476 numClassKey = mkPreludeClassUnique 12
477 ordClassKey = mkPreludeClassUnique 13
478 readClassKey = mkPreludeClassUnique 14
479 realClassKey = mkPreludeClassUnique 15
480 realFloatClassKey = mkPreludeClassUnique 16
481 realFracClassKey = mkPreludeClassUnique 17
482 showClassKey = mkPreludeClassUnique 18
484 cCallableClassKey = mkPreludeClassUnique 19
485 cReturnableClassKey = mkPreludeClassUnique 20
487 ixClassKey = mkPreludeClassUnique 21
490 %************************************************************************
492 \subsubsection[Uniques-prelude-TyCons]{@Uniques@ for wired-in @TyCons@}
494 %************************************************************************
497 addrPrimTyConKey = mkPreludeTyConUnique 1
498 addrTyConKey = mkPreludeTyConUnique 2
499 arrayPrimTyConKey = mkPreludeTyConUnique 3
500 boolTyConKey = mkPreludeTyConUnique 4
501 byteArrayPrimTyConKey = mkPreludeTyConUnique 5
502 charPrimTyConKey = mkPreludeTyConUnique 7
503 charTyConKey = mkPreludeTyConUnique 8
504 doublePrimTyConKey = mkPreludeTyConUnique 9
505 doubleTyConKey = mkPreludeTyConUnique 10
506 floatPrimTyConKey = mkPreludeTyConUnique 11
507 floatTyConKey = mkPreludeTyConUnique 12
508 funTyConKey = mkPreludeTyConUnique 13
509 iOTyConKey = mkPreludeTyConUnique 14
510 intPrimTyConKey = mkPreludeTyConUnique 15
511 intTyConKey = mkPreludeTyConUnique 16
512 integerTyConKey = mkPreludeTyConUnique 17
513 liftTyConKey = mkPreludeTyConUnique 18
514 listTyConKey = mkPreludeTyConUnique 19
515 foreignObjPrimTyConKey = mkPreludeTyConUnique 20
516 foreignObjTyConKey = mkPreludeTyConUnique 21
517 mutableArrayPrimTyConKey = mkPreludeTyConUnique 22
518 mutableByteArrayPrimTyConKey = mkPreludeTyConUnique 23
519 orderingTyConKey = mkPreludeTyConUnique 24
520 synchVarPrimTyConKey = mkPreludeTyConUnique 25
521 ratioTyConKey = mkPreludeTyConUnique 26
522 rationalTyConKey = mkPreludeTyConUnique 27
523 realWorldTyConKey = mkPreludeTyConUnique 28
524 return2GMPsTyConKey = mkPreludeTyConUnique 29
525 returnIntAndGMPTyConKey = mkPreludeTyConUnique 30
526 stablePtrPrimTyConKey = mkPreludeTyConUnique 31
527 stablePtrTyConKey = mkPreludeTyConUnique 32
528 stateAndAddrPrimTyConKey = mkPreludeTyConUnique 33
529 stateAndArrayPrimTyConKey = mkPreludeTyConUnique 34
530 stateAndByteArrayPrimTyConKey = mkPreludeTyConUnique 35
531 stateAndCharPrimTyConKey = mkPreludeTyConUnique 36
532 stateAndDoublePrimTyConKey = mkPreludeTyConUnique 37
533 stateAndFloatPrimTyConKey = mkPreludeTyConUnique 38
534 stateAndIntPrimTyConKey = mkPreludeTyConUnique 39
535 stateAndForeignObjPrimTyConKey = mkPreludeTyConUnique 40
536 stateAndMutableArrayPrimTyConKey = mkPreludeTyConUnique 41
537 stateAndMutableByteArrayPrimTyConKey = mkPreludeTyConUnique 42
538 stateAndSynchVarPrimTyConKey = mkPreludeTyConUnique 43
539 stateAndPtrPrimTyConKey = mkPreludeTyConUnique 44
540 stateAndStablePtrPrimTyConKey = mkPreludeTyConUnique 45
541 stateAndWordPrimTyConKey = mkPreludeTyConUnique 46
542 statePrimTyConKey = mkPreludeTyConUnique 47
543 stateTyConKey = mkPreludeTyConUnique 48
545 stTyConKey = mkPreludeTyConUnique 50
546 primIoTyConKey = mkPreludeTyConUnique 51
548 wordPrimTyConKey = mkPreludeTyConUnique 53
549 wordTyConKey = mkPreludeTyConUnique 54
550 voidTyConKey = mkPreludeTyConUnique 55
553 %************************************************************************
555 \subsubsection[Uniques-prelude-DataCons]{@Uniques@ for wired-in @DataCons@}
557 %************************************************************************
560 addrDataConKey = mkPreludeDataConUnique 1
561 buildDataConKey = mkPreludeDataConUnique 2
562 charDataConKey = mkPreludeDataConUnique 4
563 consDataConKey = mkPreludeDataConUnique 5
564 doubleDataConKey = mkPreludeDataConUnique 6
565 eqDataConKey = mkPreludeDataConUnique 7
566 falseDataConKey = mkPreludeDataConUnique 8
567 floatDataConKey = mkPreludeDataConUnique 9
568 gtDataConKey = mkPreludeDataConUnique 10
569 intDataConKey = mkPreludeDataConUnique 11
570 integerDataConKey = mkPreludeDataConUnique 12
571 liftDataConKey = mkPreludeDataConUnique 13
572 ltDataConKey = mkPreludeDataConUnique 14
573 foreignObjDataConKey = mkPreludeDataConUnique 15
574 nilDataConKey = mkPreludeDataConUnique 18
575 ratioDataConKey = mkPreludeDataConUnique 21
576 return2GMPsDataConKey = mkPreludeDataConUnique 22
577 returnIntAndGMPDataConKey = mkPreludeDataConUnique 23
578 stablePtrDataConKey = mkPreludeDataConUnique 24
579 stateAndAddrPrimDataConKey = mkPreludeDataConUnique 25
580 stateAndArrayPrimDataConKey = mkPreludeDataConUnique 26
581 stateAndByteArrayPrimDataConKey = mkPreludeDataConUnique 27
582 stateAndCharPrimDataConKey = mkPreludeDataConUnique 28
583 stateAndDoublePrimDataConKey = mkPreludeDataConUnique 29
584 stateAndFloatPrimDataConKey = mkPreludeDataConUnique 30
585 stateAndIntPrimDataConKey = mkPreludeDataConUnique 31
586 stateAndForeignObjPrimDataConKey = mkPreludeDataConUnique 32
587 stateAndMutableArrayPrimDataConKey = mkPreludeDataConUnique 33
588 stateAndMutableByteArrayPrimDataConKey = mkPreludeDataConUnique 34
589 stateAndSynchVarPrimDataConKey = mkPreludeDataConUnique 35
590 stateAndPtrPrimDataConKey = mkPreludeDataConUnique 36
591 stateAndStablePtrPrimDataConKey = mkPreludeDataConUnique 37
592 stateAndWordPrimDataConKey = mkPreludeDataConUnique 38
593 stateDataConKey = mkPreludeDataConUnique 39
594 trueDataConKey = mkPreludeDataConUnique 40
595 wordDataConKey = mkPreludeDataConUnique 41
596 stDataConKey = mkPreludeDataConUnique 42
599 %************************************************************************
601 \subsubsection[Uniques-prelude-Ids]{@Uniques@ for wired-in @Ids@ (except @DataCons@)}
603 %************************************************************************
606 absentErrorIdKey = mkPreludeMiscIdUnique 1
607 andandIdKey = mkPreludeMiscIdUnique 2
608 appendIdKey = mkPreludeMiscIdUnique 3
609 augmentIdKey = mkPreludeMiscIdUnique 4
610 buildIdKey = mkPreludeMiscIdUnique 5
611 composeIdKey = mkPreludeMiscIdUnique 6
612 errorIdKey = mkPreludeMiscIdUnique 7
613 foldlIdKey = mkPreludeMiscIdUnique 8
614 foldrIdKey = mkPreludeMiscIdUnique 9
615 forkIdKey = mkPreludeMiscIdUnique 10
616 int2IntegerIdKey = mkPreludeMiscIdUnique 11
617 integerMinusOneIdKey = mkPreludeMiscIdUnique 12
618 integerPlusOneIdKey = mkPreludeMiscIdUnique 13
619 integerPlusTwoIdKey = mkPreludeMiscIdUnique 14
620 integerZeroIdKey = mkPreludeMiscIdUnique 15
621 irrefutPatErrorIdKey = mkPreludeMiscIdUnique 16
622 lexIdKey = mkPreludeMiscIdUnique 17
623 noDefaultMethodErrorIdKey = mkPreludeMiscIdUnique 20
624 nonExhaustiveGuardsErrorIdKey = mkPreludeMiscIdUnique 21
625 nonExplicitMethodErrorIdKey = mkPreludeMiscIdUnique 22
626 notIdKey = mkPreludeMiscIdUnique 23
627 packCStringIdKey = mkPreludeMiscIdUnique 24
628 parErrorIdKey = mkPreludeMiscIdUnique 25
629 parIdKey = mkPreludeMiscIdUnique 26
630 patErrorIdKey = mkPreludeMiscIdUnique 27
631 readParenIdKey = mkPreludeMiscIdUnique 28
632 realWorldPrimIdKey = mkPreludeMiscIdUnique 29
633 recConErrorIdKey = mkPreludeMiscIdUnique 30
634 recUpdErrorIdKey = mkPreludeMiscIdUnique 31
635 runSTIdKey = mkPreludeMiscIdUnique 32
636 seqIdKey = mkPreludeMiscIdUnique 33
637 showParenIdKey = mkPreludeMiscIdUnique 34
638 showSpaceIdKey = mkPreludeMiscIdUnique 35
639 showStringIdKey = mkPreludeMiscIdUnique 36
640 traceIdKey = mkPreludeMiscIdUnique 37
641 unpackCString2IdKey = mkPreludeMiscIdUnique 38
642 unpackCStringAppendIdKey = mkPreludeMiscIdUnique 39
643 unpackCStringFoldrIdKey = mkPreludeMiscIdUnique 40
644 unpackCStringIdKey = mkPreludeMiscIdUnique 41
645 voidIdKey = mkPreludeMiscIdUnique 42
646 ushowListIdKey = mkPreludeMiscIdUnique 43
647 ureadListIdKey = mkPreludeMiscIdUnique 44
649 copyableIdKey = mkPreludeMiscIdUnique 45
650 noFollowIdKey = mkPreludeMiscIdUnique 46
651 parAtAbsIdKey = mkPreludeMiscIdUnique 47
652 parAtForNowIdKey = mkPreludeMiscIdUnique 48
653 parAtIdKey = mkPreludeMiscIdUnique 49
654 parAtRelIdKey = mkPreludeMiscIdUnique 50
655 parGlobalIdKey = mkPreludeMiscIdUnique 51
656 parLocalIdKey = mkPreludeMiscIdUnique 52
659 Certain class operations from Prelude classes. They get
660 their own uniques so we can look them up easily when we want
661 to conjure them up during type checking.
663 fromIntClassOpKey = mkPreludeMiscIdUnique 53
664 fromIntegerClassOpKey = mkPreludeMiscIdUnique 54
665 minusClassOpKey = mkPreludeMiscIdUnique 69
666 fromRationalClassOpKey = mkPreludeMiscIdUnique 55
667 enumFromClassOpKey = mkPreludeMiscIdUnique 56
668 enumFromThenClassOpKey = mkPreludeMiscIdUnique 57
669 enumFromToClassOpKey = mkPreludeMiscIdUnique 58
670 enumFromThenToClassOpKey= mkPreludeMiscIdUnique 59
671 eqClassOpKey = mkPreludeMiscIdUnique 60
672 geClassOpKey = mkPreludeMiscIdUnique 61
673 zeroClassOpKey = mkPreludeMiscIdUnique 62
674 thenMClassOpKey = mkPreludeMiscIdUnique 63 -- (>>=)
675 unboundKey = mkPreludeMiscIdUnique 64 -- Just a place holder for unbound
676 -- variables produced by the renamer
677 fromEnumClassOpKey = mkPreludeMiscIdUnique 65
679 mainKey = mkPreludeMiscIdUnique 66
680 mainPrimIoKey = mkPreludeMiscIdUnique 67
681 returnMClassOpKey = mkPreludeMiscIdUnique 68
682 -- Used for minusClassOp 69
683 otherwiseIdKey = mkPreludeMiscIdUnique 70
684 toEnumClassOpKey = mkPreludeMiscIdUnique 71