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