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,
223 , mutableByteArrayTyConKey
227 #if __GLASGOW_HASKELL__ <= 201
232 #if __GLASGOW_HASKELL__ == 202
233 import PrelBase ( Char(..) )
239 #if __GLASGOW_HASKELL__ >= 202
240 import {-# SOURCE #-} UniqFM ( Uniquable(..) )
248 %************************************************************************
250 \subsection[Unique-type]{@Unique@ type and operations}
252 %************************************************************************
254 The @Chars@ are ``tag letters'' that identify the @UniqueSupply@.
255 Fast comparison is everything on @Uniques@:
258 u2i :: Unique -> FAST_INT
260 data Unique = MkUnique Int#
264 Now come the functions which construct uniques from their pieces, and vice versa.
265 The stuff about unique *supplies* is handled further down this module.
268 mkUnique :: Char -> Int -> Unique -- Builds a unique from pieces
269 unpkUnique :: Unique -> (Char, Int) -- The reverse
271 mkUniqueGrimily :: Int# -> Unique -- A trap-door for UniqSupply
273 incrUnique :: Unique -> Unique
278 mkUniqueGrimily x = MkUnique x
280 incrUnique (MkUnique i) = MkUnique (i +# 1#)
282 -- pop the Char in the top 8 bits of the Unique(Supply)
284 -- No 64-bit bugs here, as long as we have at least 32 bits. --JSM
290 mkUnique (C# c) (I# i)
291 = MkUnique (w2i (((i2w (ord# c)) `shiftL#` (i2w_s 24#)) `or#` (i2w i)))
293 unpkUnique (MkUnique u)
295 tag = C# (chr# (w2i ((i2w u) `shiftr` (i2w_s 24#))))
296 i = I# (w2i ((i2w u) `and#` (i2w 16777215#){-``0x00ffffff''-}))
300 shiftr x y = shiftRA# x y
303 %************************************************************************
305 \subsection[Unique-instances]{Instance declarations for @Unique@}
307 %************************************************************************
309 And the whole point (besides uniqueness) is fast equality. We don't
310 use `deriving' because we want {\em precise} control of ordering
311 (equality on @Uniques@ is v common).
314 eqUnique (MkUnique u1) (MkUnique u2) = u1 ==# u2
315 ltUnique (MkUnique u1) (MkUnique u2) = u1 <# u2
316 leUnique (MkUnique u1) (MkUnique u2) = u1 <=# u2
318 cmpUnique (MkUnique u1) (MkUnique u2)
319 = if u1 ==# u2 then EQ_ else if u1 <# u2 then LT_ else GT_
321 instance Eq Unique where
322 a == b = eqUnique a b
323 a /= b = not (eqUnique a b)
325 instance Ord Unique where
327 a <= b = leUnique a b
328 a > b = not (leUnique a b)
329 a >= b = not (ltUnique a b)
330 _tagCmp a b = case cmpUnique a b of { LT_ -> _LT; EQ_ -> _EQ; GT__ -> _GT }
332 instance Ord3 Unique where
336 instance Uniquable Unique where
340 We do sometimes make strings with @Uniques@ in them:
342 pprUnique, pprUnique10 :: Unique -> Doc
345 = case unpkUnique uniq of
346 (tag, u) -> finish_ppr tag u (iToBase62 u)
348 pprUnique10 uniq -- in base-10, dudes
349 = case unpkUnique uniq of
350 (tag, u) -> finish_ppr tag u (int u)
352 finish_ppr tag u pp_u
353 = if tag /= 't' -- this is just to make v common tyvars, t1, t2, ...
354 -- come out as a, b, ... (shorter, easier to read)
364 pp_all = (<>) (char tag) pp_u
366 showUnique :: Unique -> FAST_STRING
367 showUnique uniq = _PK_ (show (pprUnique uniq))
369 instance Outputable Unique where
370 ppr sty u = pprUnique u
372 instance Text Unique where
373 showsPrec p uniq rest = _UNPK_ (showUnique uniq)
376 %************************************************************************
378 \subsection[Utils-base62]{Base-62 numbers}
380 %************************************************************************
382 A character-stingy way to read/write numbers (notably Uniques).
383 The ``62-its'' are \tr{[0-9a-zA-Z]}. We don't handle negative Ints.
384 Code stolen from Lennart.
386 #if __GLASGOW_HASKELL__ == 201
387 # define BYTE_ARRAY GHCbase.ByteArray
388 # define RUN_ST GHCbase.runST
389 # define AND_THEN >>=
390 # define AND_THEN_ >>
391 # define RETURN return
392 #elif __GLASGOW_HASKELL__ >= 202
393 # define BYTE_ARRAY GlaExts.ByteArray
394 # define RUN_ST ST.runST
395 # define AND_THEN >>=
396 # define AND_THEN_ >>
397 # define RETURN return
399 # define BYTE_ARRAY _ByteArray
400 # define RUN_ST _runST
401 # define AND_THEN `thenStrictlyST`
402 # define AND_THEN_ `seqStrictlyST`
403 # define RETURN returnStrictlyST
406 iToBase62 :: Int -> Doc
411 bytes = case chars62 of { BYTE_ARRAY bounds_who_needs_'em bytes -> bytes }
414 case (indexCharArray# bytes n#) of { c ->
417 case (quotRem n 62) of { (q, I# r#) ->
418 case (indexCharArray# bytes r#) of { c ->
419 (<>) (iToBase62 q) (char (C# c)) }}
421 -- keep this at top level! (bug on 94/10/24 WDP)
422 chars62 :: BYTE_ARRAY Int
425 newCharArray (0, 61) AND_THEN \ ch_array ->
426 fill_in ch_array 0 62 "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
428 unsafeFreezeByteArray ch_array
431 fill_in ch_array i lim str
435 = writeCharArray ch_array i (str !! i) AND_THEN_
436 fill_in ch_array (i+1) lim str
439 %************************************************************************
441 \subsection[Uniques-prelude]{@Uniques@ for wired-in Prelude things}
443 %************************************************************************
445 Allocation of unique supply characters:
446 v,t,u : for renumbering value-, type- and usage- vars.
447 other a-z: lower case chars for unique supplies (see Main.lhs)
449 C-E: pseudo uniques (used in native-code generator)
450 _: unifiable tyvars (above)
451 1-8: prelude things below
454 mkAlphaTyVarUnique i = mkUnique '1' i
456 mkPreludeClassUnique i = mkUnique '2' i
457 mkPreludeTyConUnique i = mkUnique '3' i
458 mkTupleTyConUnique a = mkUnique '4' a
460 mkPreludeDataConUnique i = mkUnique '5' i -- must be alphabetic
461 mkTupleDataConUnique a = mkUnique '6' a -- ditto (*may* be used in C labels)
463 mkPrimOpIdUnique op = mkUnique '7' op
464 mkPreludeMiscIdUnique i = mkUnique '8' i
466 initRenumberingUniques = (mkUnique 'v' 1, mkUnique 't' 1, mkUnique 'u' 1)
468 mkPseudoUnique1, mkPseudoUnique2, mkPseudoUnique3,
469 mkBuiltinUnique :: Int -> Unique
471 mkBuiltinUnique i = mkUnique 'B' i
472 mkPseudoUnique1 i = mkUnique 'C' i -- used for uniqueOf on Regs
473 mkPseudoUnique2 i = mkUnique 'D' i -- ditto
474 mkPseudoUnique3 i = mkUnique 'E' i -- ditto
476 getBuiltinUniques :: Int -> [Unique]
477 getBuiltinUniques n = map (mkUnique 'B') [1 .. n]
480 %************************************************************************
482 \subsubsection[Uniques-prelude-Classes]{@Uniques@ for wired-in @Classes@}
484 %************************************************************************
487 boundedClassKey = mkPreludeClassUnique 1
488 enumClassKey = mkPreludeClassUnique 2
489 eqClassKey = mkPreludeClassUnique 3
490 evalClassKey = mkPreludeClassUnique 4
491 floatingClassKey = mkPreludeClassUnique 5
492 fractionalClassKey = mkPreludeClassUnique 6
493 integralClassKey = mkPreludeClassUnique 7
494 monadClassKey = mkPreludeClassUnique 8
495 monadZeroClassKey = mkPreludeClassUnique 9
496 monadPlusClassKey = mkPreludeClassUnique 10
497 functorClassKey = mkPreludeClassUnique 11
498 numClassKey = mkPreludeClassUnique 12
499 ordClassKey = mkPreludeClassUnique 13
500 readClassKey = mkPreludeClassUnique 14
501 realClassKey = mkPreludeClassUnique 15
502 realFloatClassKey = mkPreludeClassUnique 16
503 realFracClassKey = mkPreludeClassUnique 17
504 showClassKey = mkPreludeClassUnique 18
506 cCallableClassKey = mkPreludeClassUnique 19
507 cReturnableClassKey = mkPreludeClassUnique 20
509 ixClassKey = mkPreludeClassUnique 21
510 allClassKey = mkPreludeClassUnique 22 -- Pseudo class used for universal quantification
513 %************************************************************************
515 \subsubsection[Uniques-prelude-TyCons]{@Uniques@ for wired-in @TyCons@}
517 %************************************************************************
520 addrPrimTyConKey = mkPreludeTyConUnique 1
521 addrTyConKey = mkPreludeTyConUnique 2
522 arrayPrimTyConKey = mkPreludeTyConUnique 3
523 boolTyConKey = mkPreludeTyConUnique 4
524 byteArrayPrimTyConKey = mkPreludeTyConUnique 5
525 charPrimTyConKey = mkPreludeTyConUnique 7
526 charTyConKey = mkPreludeTyConUnique 8
527 doublePrimTyConKey = mkPreludeTyConUnique 9
528 doubleTyConKey = mkPreludeTyConUnique 10
529 floatPrimTyConKey = mkPreludeTyConUnique 11
530 floatTyConKey = mkPreludeTyConUnique 12
531 funTyConKey = mkPreludeTyConUnique 13
532 iOTyConKey = mkPreludeTyConUnique 14
533 intPrimTyConKey = mkPreludeTyConUnique 15
534 intTyConKey = mkPreludeTyConUnique 16
535 integerTyConKey = mkPreludeTyConUnique 17
536 liftTyConKey = mkPreludeTyConUnique 18
537 listTyConKey = mkPreludeTyConUnique 19
538 foreignObjPrimTyConKey = mkPreludeTyConUnique 20
539 foreignObjTyConKey = mkPreludeTyConUnique 21
540 mutableArrayPrimTyConKey = mkPreludeTyConUnique 22
541 mutableByteArrayPrimTyConKey = mkPreludeTyConUnique 23
542 orderingTyConKey = mkPreludeTyConUnique 24
543 synchVarPrimTyConKey = mkPreludeTyConUnique 25
544 ratioTyConKey = mkPreludeTyConUnique 26
545 rationalTyConKey = mkPreludeTyConUnique 27
546 realWorldTyConKey = mkPreludeTyConUnique 28
547 return2GMPsTyConKey = mkPreludeTyConUnique 29
548 returnIntAndGMPTyConKey = mkPreludeTyConUnique 30
549 stablePtrPrimTyConKey = mkPreludeTyConUnique 31
550 stablePtrTyConKey = mkPreludeTyConUnique 32
551 stateAndAddrPrimTyConKey = mkPreludeTyConUnique 33
552 stateAndArrayPrimTyConKey = mkPreludeTyConUnique 34
553 stateAndByteArrayPrimTyConKey = mkPreludeTyConUnique 35
554 stateAndCharPrimTyConKey = mkPreludeTyConUnique 36
555 stateAndDoublePrimTyConKey = mkPreludeTyConUnique 37
556 stateAndFloatPrimTyConKey = mkPreludeTyConUnique 38
557 stateAndIntPrimTyConKey = mkPreludeTyConUnique 39
558 stateAndForeignObjPrimTyConKey = mkPreludeTyConUnique 40
559 stateAndMutableArrayPrimTyConKey = mkPreludeTyConUnique 41
560 stateAndMutableByteArrayPrimTyConKey = mkPreludeTyConUnique 42
561 stateAndSynchVarPrimTyConKey = mkPreludeTyConUnique 43
562 stateAndPtrPrimTyConKey = mkPreludeTyConUnique 44
563 stateAndStablePtrPrimTyConKey = mkPreludeTyConUnique 45
564 stateAndWordPrimTyConKey = mkPreludeTyConUnique 46
565 statePrimTyConKey = mkPreludeTyConUnique 47
566 stateTyConKey = mkPreludeTyConUnique 48
567 mutableByteArrayTyConKey = mkPreludeTyConUnique 49
568 stTyConKey = mkPreludeTyConUnique 50
569 primIoTyConKey = mkPreludeTyConUnique 51
570 byteArrayTyConKey = mkPreludeTyConUnique 52
571 wordPrimTyConKey = mkPreludeTyConUnique 53
572 wordTyConKey = mkPreludeTyConUnique 54
573 voidTyConKey = mkPreludeTyConUnique 55
576 %************************************************************************
578 \subsubsection[Uniques-prelude-DataCons]{@Uniques@ for wired-in @DataCons@}
580 %************************************************************************
583 addrDataConKey = mkPreludeDataConUnique 1
584 buildDataConKey = mkPreludeDataConUnique 2
585 charDataConKey = mkPreludeDataConUnique 4
586 consDataConKey = mkPreludeDataConUnique 5
587 doubleDataConKey = mkPreludeDataConUnique 6
588 eqDataConKey = mkPreludeDataConUnique 7
589 falseDataConKey = mkPreludeDataConUnique 8
590 floatDataConKey = mkPreludeDataConUnique 9
591 gtDataConKey = mkPreludeDataConUnique 10
592 intDataConKey = mkPreludeDataConUnique 11
593 integerDataConKey = mkPreludeDataConUnique 12
594 liftDataConKey = mkPreludeDataConUnique 13
595 ltDataConKey = mkPreludeDataConUnique 14
596 foreignObjDataConKey = mkPreludeDataConUnique 15
597 nilDataConKey = mkPreludeDataConUnique 18
598 ratioDataConKey = mkPreludeDataConUnique 21
599 return2GMPsDataConKey = mkPreludeDataConUnique 22
600 returnIntAndGMPDataConKey = mkPreludeDataConUnique 23
601 stablePtrDataConKey = mkPreludeDataConUnique 24
602 stateAndAddrPrimDataConKey = mkPreludeDataConUnique 25
603 stateAndArrayPrimDataConKey = mkPreludeDataConUnique 26
604 stateAndByteArrayPrimDataConKey = mkPreludeDataConUnique 27
605 stateAndCharPrimDataConKey = mkPreludeDataConUnique 28
606 stateAndDoublePrimDataConKey = mkPreludeDataConUnique 29
607 stateAndFloatPrimDataConKey = mkPreludeDataConUnique 30
608 stateAndIntPrimDataConKey = mkPreludeDataConUnique 31
609 stateAndForeignObjPrimDataConKey = mkPreludeDataConUnique 32
610 stateAndMutableArrayPrimDataConKey = mkPreludeDataConUnique 33
611 stateAndMutableByteArrayPrimDataConKey = mkPreludeDataConUnique 34
612 stateAndSynchVarPrimDataConKey = mkPreludeDataConUnique 35
613 stateAndPtrPrimDataConKey = mkPreludeDataConUnique 36
614 stateAndStablePtrPrimDataConKey = mkPreludeDataConUnique 37
615 stateAndWordPrimDataConKey = mkPreludeDataConUnique 38
616 stateDataConKey = mkPreludeDataConUnique 39
617 trueDataConKey = mkPreludeDataConUnique 40
618 wordDataConKey = mkPreludeDataConUnique 41
619 stDataConKey = mkPreludeDataConUnique 42
622 %************************************************************************
624 \subsubsection[Uniques-prelude-Ids]{@Uniques@ for wired-in @Ids@ (except @DataCons@)}
626 %************************************************************************
629 absentErrorIdKey = mkPreludeMiscIdUnique 1
630 andandIdKey = mkPreludeMiscIdUnique 2
631 appendIdKey = mkPreludeMiscIdUnique 3
632 augmentIdKey = mkPreludeMiscIdUnique 4
633 buildIdKey = mkPreludeMiscIdUnique 5
634 composeIdKey = mkPreludeMiscIdUnique 6
635 errorIdKey = mkPreludeMiscIdUnique 7
636 foldlIdKey = mkPreludeMiscIdUnique 8
637 foldrIdKey = mkPreludeMiscIdUnique 9
638 forkIdKey = mkPreludeMiscIdUnique 10
639 int2IntegerIdKey = mkPreludeMiscIdUnique 11
640 integerMinusOneIdKey = mkPreludeMiscIdUnique 12
641 integerPlusOneIdKey = mkPreludeMiscIdUnique 13
642 integerPlusTwoIdKey = mkPreludeMiscIdUnique 14
643 integerZeroIdKey = mkPreludeMiscIdUnique 15
644 irrefutPatErrorIdKey = mkPreludeMiscIdUnique 16
645 lexIdKey = mkPreludeMiscIdUnique 17
646 noDefaultMethodErrorIdKey = mkPreludeMiscIdUnique 20
647 nonExhaustiveGuardsErrorIdKey = mkPreludeMiscIdUnique 21
648 nonExplicitMethodErrorIdKey = mkPreludeMiscIdUnique 22
649 notIdKey = mkPreludeMiscIdUnique 23
650 packCStringIdKey = mkPreludeMiscIdUnique 24
651 parErrorIdKey = mkPreludeMiscIdUnique 25
652 parIdKey = mkPreludeMiscIdUnique 26
653 patErrorIdKey = mkPreludeMiscIdUnique 27
654 readParenIdKey = mkPreludeMiscIdUnique 28
655 realWorldPrimIdKey = mkPreludeMiscIdUnique 29
656 recConErrorIdKey = mkPreludeMiscIdUnique 30
657 recUpdErrorIdKey = mkPreludeMiscIdUnique 31
658 runSTIdKey = mkPreludeMiscIdUnique 32
659 seqIdKey = mkPreludeMiscIdUnique 33
660 showParenIdKey = mkPreludeMiscIdUnique 34
661 showSpaceIdKey = mkPreludeMiscIdUnique 35
662 showStringIdKey = mkPreludeMiscIdUnique 36
663 traceIdKey = mkPreludeMiscIdUnique 37
664 unpackCString2IdKey = mkPreludeMiscIdUnique 38
665 unpackCStringAppendIdKey = mkPreludeMiscIdUnique 39
666 unpackCStringFoldrIdKey = mkPreludeMiscIdUnique 40
667 unpackCStringIdKey = mkPreludeMiscIdUnique 41
668 voidIdKey = mkPreludeMiscIdUnique 42
669 ushowListIdKey = mkPreludeMiscIdUnique 43
670 ureadListIdKey = mkPreludeMiscIdUnique 44
672 copyableIdKey = mkPreludeMiscIdUnique 45
673 noFollowIdKey = mkPreludeMiscIdUnique 46
674 parAtAbsIdKey = mkPreludeMiscIdUnique 47
675 parAtForNowIdKey = mkPreludeMiscIdUnique 48
676 parAtIdKey = mkPreludeMiscIdUnique 49
677 parAtRelIdKey = mkPreludeMiscIdUnique 50
678 parGlobalIdKey = mkPreludeMiscIdUnique 51
679 parLocalIdKey = mkPreludeMiscIdUnique 52
682 Certain class operations from Prelude classes. They get
683 their own uniques so we can look them up easily when we want
684 to conjure them up during type checking.
686 fromIntClassOpKey = mkPreludeMiscIdUnique 53
687 fromIntegerClassOpKey = mkPreludeMiscIdUnique 54
688 minusClassOpKey = mkPreludeMiscIdUnique 69
689 fromRationalClassOpKey = mkPreludeMiscIdUnique 55
690 enumFromClassOpKey = mkPreludeMiscIdUnique 56
691 enumFromThenClassOpKey = mkPreludeMiscIdUnique 57
692 enumFromToClassOpKey = mkPreludeMiscIdUnique 58
693 enumFromThenToClassOpKey= mkPreludeMiscIdUnique 59
694 eqClassOpKey = mkPreludeMiscIdUnique 60
695 geClassOpKey = mkPreludeMiscIdUnique 61
696 zeroClassOpKey = mkPreludeMiscIdUnique 62
697 thenMClassOpKey = mkPreludeMiscIdUnique 63 -- (>>=)
698 unboundKey = mkPreludeMiscIdUnique 64 -- Just a place holder for unbound
699 -- variables produced by the renamer
700 fromEnumClassOpKey = mkPreludeMiscIdUnique 65
702 mainKey = mkPreludeMiscIdUnique 66
703 mainPrimIoKey = mkPreludeMiscIdUnique 67
704 returnMClassOpKey = mkPreludeMiscIdUnique 68
705 -- Used for minusClassOp 69
706 otherwiseIdKey = mkPreludeMiscIdUnique 70
707 toEnumClassOpKey = mkPreludeMiscIdUnique 71