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 initTyVarUnique, mkTyVarUnique,
36 -- now all the built-in Uniques (and functions to make them)
37 -- [the Oh-So-Wonderful Haskell module system wins again...]
43 getBuiltinUniques, mkBuiltinUnique,
44 mkPseudoUnique1, mkPseudoUnique2, mkPseudoUnique3,
46 absentErrorIdKey, -- alphabetical...
58 byteArrayPrimTyConKey,
71 enumFromThenClassOpKey,
72 enumFromThenToClassOpKey,
87 foreignObjPrimTyConKey,
93 fromIntegerClassOpKey,
94 fromRationalClassOpKey,
104 integerMinusOneIdKey,
110 irrefutPatErrorIdKey,
117 mainKey, mainPrimIoKey,
122 mutableArrayPrimTyConKey,
123 mutableByteArrayPrimTyConKey,
125 noDefaultMethodErrorIdKey,
126 nonExhaustiveGuardsErrorIdKey,
127 nonExplicitMethodErrorIdKey,
150 return2GMPsDataConKey,
152 returnIntAndGMPDataConKey,
153 returnIntAndGMPTyConKey,
164 stablePtrPrimTyConKey,
166 stateAndAddrPrimDataConKey,
167 stateAndAddrPrimTyConKey,
168 stateAndArrayPrimDataConKey,
169 stateAndArrayPrimTyConKey,
170 stateAndByteArrayPrimDataConKey,
171 stateAndByteArrayPrimTyConKey,
172 stateAndCharPrimDataConKey,
173 stateAndCharPrimTyConKey,
174 stateAndDoublePrimDataConKey,
175 stateAndDoublePrimTyConKey,
176 stateAndFloatPrimDataConKey,
177 stateAndFloatPrimTyConKey,
178 stateAndForeignObjPrimDataConKey,
179 stateAndForeignObjPrimTyConKey,
180 stateAndIntPrimDataConKey,
181 stateAndIntPrimTyConKey,
182 stateAndMutableArrayPrimDataConKey,
183 stateAndMutableArrayPrimTyConKey,
184 stateAndMutableByteArrayPrimDataConKey,
185 stateAndMutableByteArrayPrimTyConKey,
186 stateAndPtrPrimDataConKey,
187 stateAndPtrPrimTyConKey,
188 stateAndStablePtrPrimDataConKey,
189 stateAndStablePtrPrimTyConKey,
190 stateAndSynchVarPrimDataConKey,
191 stateAndSynchVarPrimTyConKey,
192 stateAndWordPrimDataConKey,
193 stateAndWordPrimTyConKey,
197 synchVarPrimTyConKey,
203 unpackCStringAppendIdKey,
204 unpackCStringFoldrIdKey,
224 , mutableByteArrayTyConKey
228 #if __GLASGOW_HASKELL__ <= 201
233 import PrelBase ( Char(..), chr, ord )
243 %************************************************************************
245 \subsection[Unique-type]{@Unique@ type and operations}
247 %************************************************************************
249 The @Chars@ are ``tag letters'' that identify the @UniqueSupply@.
250 Fast comparison is everything on @Uniques@:
253 data Unique = MkUnique Int#
255 class Uniquable a where
256 uniqueOf :: a -> Unique
260 u2i :: Unique -> FAST_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 't' u pp_u | u < 26
353 = -- Special case to make v common tyvars, t1, t2, ...
354 -- come out as a, b, ... (shorter, easier to read)
355 char (chr (ord 'a' + u))
356 finish_ppr tag u pp_u = char tag <> pp_u
358 showUnique :: Unique -> String
359 showUnique uniq = show (pprUnique uniq)
361 instance Outputable Unique where
362 ppr sty u = pprUnique u
364 instance Text Unique where
365 showsPrec p uniq rest = showUnique uniq
368 %************************************************************************
370 \subsection[Utils-base62]{Base-62 numbers}
372 %************************************************************************
374 A character-stingy way to read/write numbers (notably Uniques).
375 The ``62-its'' are \tr{[0-9a-zA-Z]}. We don't handle negative Ints.
376 Code stolen from Lennart.
378 #if __GLASGOW_HASKELL__ == 201
379 # define BYTE_ARRAY GHCbase.ByteArray
380 # define RUN_ST GHCbase.runST
381 # define AND_THEN >>=
382 # define AND_THEN_ >>
383 # define RETURN return
384 #elif __GLASGOW_HASKELL__ >= 202
385 # define BYTE_ARRAY GlaExts.ByteArray
386 # define RUN_ST ST.runST
387 # define AND_THEN >>=
388 # define AND_THEN_ >>
389 # define RETURN return
391 # define BYTE_ARRAY _ByteArray
392 # define RUN_ST _runST
393 # define AND_THEN `thenStrictlyST`
394 # define AND_THEN_ `seqStrictlyST`
395 # define RETURN returnStrictlyST
398 iToBase62 :: Int -> Doc
403 bytes = case chars62 of { BYTE_ARRAY bounds_who_needs_'em bytes -> bytes }
406 case (indexCharArray# bytes n#) of { c ->
409 case (quotRem n 62) of { (q, I# r#) ->
410 case (indexCharArray# bytes r#) of { c ->
411 (<>) (iToBase62 q) (char (C# c)) }}
413 -- keep this at top level! (bug on 94/10/24 WDP)
414 chars62 :: BYTE_ARRAY Int
417 newCharArray (0, 61) AND_THEN \ ch_array ->
418 fill_in ch_array 0 62 "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
420 unsafeFreezeByteArray ch_array
423 fill_in ch_array i lim str
427 = writeCharArray ch_array i (str !! i) AND_THEN_
428 fill_in ch_array (i+1) lim str
431 %************************************************************************
433 \subsection[Uniques-prelude]{@Uniques@ for wired-in Prelude things}
435 %************************************************************************
437 Allocation of unique supply characters:
438 v,t,u : for renumbering value-, type- and usage- vars.
439 other a-z: lower case chars for unique supplies (see Main.lhs)
441 C-E: pseudo uniques (used in native-code generator)
442 _: unifiable tyvars (above)
443 1-8: prelude things below
446 mkAlphaTyVarUnique i = mkUnique '1' i
448 mkPreludeClassUnique i = mkUnique '2' i
449 mkPreludeTyConUnique i = mkUnique '3' i
450 mkTupleTyConUnique a = mkUnique '4' a
452 mkPreludeDataConUnique i = mkUnique '5' i -- must be alphabetic
453 mkTupleDataConUnique a = mkUnique '6' a -- ditto (*may* be used in C labels)
455 mkPrimOpIdUnique op = mkUnique '7' op
456 mkPreludeMiscIdUnique i = mkUnique '8' i
458 -- The "tyvar uniques" print specially nicely: a, b, c, etc.
459 -- See pprUnique for details
461 initTyVarUnique :: Unique
462 initTyVarUnique = mkUnique 't' 0
464 mkTyVarUnique :: Int -> Unique
465 mkTyVarUnique n = mkUnique 't' n
467 initTidyUniques :: (Unique, Unique) -- Global and local
468 initTidyUniques = (mkUnique 'g' 0, mkUnique 'x' 0)
470 mkPseudoUnique1, mkPseudoUnique2, mkPseudoUnique3,
471 mkBuiltinUnique :: Int -> Unique
473 mkBuiltinUnique i = mkUnique 'B' i
474 mkPseudoUnique1 i = mkUnique 'C' i -- used for uniqueOf on Regs
475 mkPseudoUnique2 i = mkUnique 'D' i -- ditto
476 mkPseudoUnique3 i = mkUnique 'E' i -- ditto
478 getBuiltinUniques :: Int -> [Unique]
479 getBuiltinUniques n = map (mkUnique 'B') [1 .. n]
482 %************************************************************************
484 \subsubsection[Uniques-prelude-Classes]{@Uniques@ for wired-in @Classes@}
486 %************************************************************************
489 boundedClassKey = mkPreludeClassUnique 1
490 enumClassKey = mkPreludeClassUnique 2
491 eqClassKey = mkPreludeClassUnique 3
492 evalClassKey = mkPreludeClassUnique 4
493 floatingClassKey = mkPreludeClassUnique 5
494 fractionalClassKey = mkPreludeClassUnique 6
495 integralClassKey = mkPreludeClassUnique 7
496 monadClassKey = mkPreludeClassUnique 8
497 monadZeroClassKey = mkPreludeClassUnique 9
498 monadPlusClassKey = mkPreludeClassUnique 10
499 functorClassKey = mkPreludeClassUnique 11
500 numClassKey = mkPreludeClassUnique 12
501 ordClassKey = mkPreludeClassUnique 13
502 readClassKey = mkPreludeClassUnique 14
503 realClassKey = mkPreludeClassUnique 15
504 realFloatClassKey = mkPreludeClassUnique 16
505 realFracClassKey = mkPreludeClassUnique 17
506 showClassKey = mkPreludeClassUnique 18
508 cCallableClassKey = mkPreludeClassUnique 19
509 cReturnableClassKey = mkPreludeClassUnique 20
511 ixClassKey = mkPreludeClassUnique 21
512 allClassKey = mkPreludeClassUnique 22 -- Pseudo class used for universal quantification
515 %************************************************************************
517 \subsubsection[Uniques-prelude-TyCons]{@Uniques@ for wired-in @TyCons@}
519 %************************************************************************
522 addrPrimTyConKey = mkPreludeTyConUnique 1
523 addrTyConKey = mkPreludeTyConUnique 2
524 arrayPrimTyConKey = mkPreludeTyConUnique 3
525 boolTyConKey = mkPreludeTyConUnique 4
526 byteArrayPrimTyConKey = mkPreludeTyConUnique 5
527 charPrimTyConKey = mkPreludeTyConUnique 7
528 charTyConKey = mkPreludeTyConUnique 8
529 doublePrimTyConKey = mkPreludeTyConUnique 9
530 doubleTyConKey = mkPreludeTyConUnique 10
531 floatPrimTyConKey = mkPreludeTyConUnique 11
532 floatTyConKey = mkPreludeTyConUnique 12
533 funTyConKey = mkPreludeTyConUnique 13
534 iOTyConKey = mkPreludeTyConUnique 14
535 intPrimTyConKey = mkPreludeTyConUnique 15
536 intTyConKey = mkPreludeTyConUnique 16
537 integerTyConKey = mkPreludeTyConUnique 17
538 liftTyConKey = mkPreludeTyConUnique 18
539 listTyConKey = mkPreludeTyConUnique 19
540 foreignObjPrimTyConKey = mkPreludeTyConUnique 20
541 foreignObjTyConKey = mkPreludeTyConUnique 21
542 mutableArrayPrimTyConKey = mkPreludeTyConUnique 22
543 mutableByteArrayPrimTyConKey = mkPreludeTyConUnique 23
544 orderingTyConKey = mkPreludeTyConUnique 24
545 synchVarPrimTyConKey = mkPreludeTyConUnique 25
546 ratioTyConKey = mkPreludeTyConUnique 26
547 rationalTyConKey = mkPreludeTyConUnique 27
548 realWorldTyConKey = mkPreludeTyConUnique 28
549 return2GMPsTyConKey = mkPreludeTyConUnique 29
550 returnIntAndGMPTyConKey = mkPreludeTyConUnique 30
551 stablePtrPrimTyConKey = mkPreludeTyConUnique 31
552 stablePtrTyConKey = mkPreludeTyConUnique 32
553 stateAndAddrPrimTyConKey = mkPreludeTyConUnique 33
554 stateAndArrayPrimTyConKey = mkPreludeTyConUnique 34
555 stateAndByteArrayPrimTyConKey = mkPreludeTyConUnique 35
556 stateAndCharPrimTyConKey = mkPreludeTyConUnique 36
557 stateAndDoublePrimTyConKey = mkPreludeTyConUnique 37
558 stateAndFloatPrimTyConKey = mkPreludeTyConUnique 38
559 stateAndIntPrimTyConKey = mkPreludeTyConUnique 39
560 stateAndForeignObjPrimTyConKey = mkPreludeTyConUnique 40
561 stateAndMutableArrayPrimTyConKey = mkPreludeTyConUnique 41
562 stateAndMutableByteArrayPrimTyConKey = mkPreludeTyConUnique 42
563 stateAndSynchVarPrimTyConKey = mkPreludeTyConUnique 43
564 stateAndPtrPrimTyConKey = mkPreludeTyConUnique 44
565 stateAndStablePtrPrimTyConKey = mkPreludeTyConUnique 45
566 stateAndWordPrimTyConKey = mkPreludeTyConUnique 46
567 statePrimTyConKey = mkPreludeTyConUnique 47
568 stateTyConKey = mkPreludeTyConUnique 48
569 mutableByteArrayTyConKey = mkPreludeTyConUnique 49
570 stTyConKey = mkPreludeTyConUnique 50
571 primIoTyConKey = mkPreludeTyConUnique 51
572 byteArrayTyConKey = mkPreludeTyConUnique 52
573 wordPrimTyConKey = mkPreludeTyConUnique 53
574 wordTyConKey = mkPreludeTyConUnique 54
575 voidTyConKey = mkPreludeTyConUnique 55
578 %************************************************************************
580 \subsubsection[Uniques-prelude-DataCons]{@Uniques@ for wired-in @DataCons@}
582 %************************************************************************
585 addrDataConKey = mkPreludeDataConUnique 1
586 buildDataConKey = mkPreludeDataConUnique 2
587 charDataConKey = mkPreludeDataConUnique 4
588 consDataConKey = mkPreludeDataConUnique 5
589 doubleDataConKey = mkPreludeDataConUnique 6
590 eqDataConKey = mkPreludeDataConUnique 7
591 falseDataConKey = mkPreludeDataConUnique 8
592 floatDataConKey = mkPreludeDataConUnique 9
593 gtDataConKey = mkPreludeDataConUnique 10
594 intDataConKey = mkPreludeDataConUnique 11
595 integerDataConKey = mkPreludeDataConUnique 12
596 liftDataConKey = mkPreludeDataConUnique 13
597 ltDataConKey = mkPreludeDataConUnique 14
598 foreignObjDataConKey = mkPreludeDataConUnique 15
599 nilDataConKey = mkPreludeDataConUnique 18
600 ratioDataConKey = mkPreludeDataConUnique 21
601 return2GMPsDataConKey = mkPreludeDataConUnique 22
602 returnIntAndGMPDataConKey = mkPreludeDataConUnique 23
603 stablePtrDataConKey = mkPreludeDataConUnique 24
604 stateAndAddrPrimDataConKey = mkPreludeDataConUnique 25
605 stateAndArrayPrimDataConKey = mkPreludeDataConUnique 26
606 stateAndByteArrayPrimDataConKey = mkPreludeDataConUnique 27
607 stateAndCharPrimDataConKey = mkPreludeDataConUnique 28
608 stateAndDoublePrimDataConKey = mkPreludeDataConUnique 29
609 stateAndFloatPrimDataConKey = mkPreludeDataConUnique 30
610 stateAndIntPrimDataConKey = mkPreludeDataConUnique 31
611 stateAndForeignObjPrimDataConKey = mkPreludeDataConUnique 32
612 stateAndMutableArrayPrimDataConKey = mkPreludeDataConUnique 33
613 stateAndMutableByteArrayPrimDataConKey = mkPreludeDataConUnique 34
614 stateAndSynchVarPrimDataConKey = mkPreludeDataConUnique 35
615 stateAndPtrPrimDataConKey = mkPreludeDataConUnique 36
616 stateAndStablePtrPrimDataConKey = mkPreludeDataConUnique 37
617 stateAndWordPrimDataConKey = mkPreludeDataConUnique 38
618 stateDataConKey = mkPreludeDataConUnique 39
619 trueDataConKey = mkPreludeDataConUnique 40
620 wordDataConKey = mkPreludeDataConUnique 41
621 stDataConKey = mkPreludeDataConUnique 42
624 %************************************************************************
626 \subsubsection[Uniques-prelude-Ids]{@Uniques@ for wired-in @Ids@ (except @DataCons@)}
628 %************************************************************************
631 absentErrorIdKey = mkPreludeMiscIdUnique 1
632 andandIdKey = mkPreludeMiscIdUnique 2
633 appendIdKey = mkPreludeMiscIdUnique 3
634 augmentIdKey = mkPreludeMiscIdUnique 4
635 buildIdKey = mkPreludeMiscIdUnique 5
636 composeIdKey = mkPreludeMiscIdUnique 6
637 errorIdKey = mkPreludeMiscIdUnique 7
638 foldlIdKey = mkPreludeMiscIdUnique 8
639 foldrIdKey = mkPreludeMiscIdUnique 9
640 forkIdKey = mkPreludeMiscIdUnique 10
641 int2IntegerIdKey = mkPreludeMiscIdUnique 11
642 integerMinusOneIdKey = mkPreludeMiscIdUnique 12
643 integerPlusOneIdKey = mkPreludeMiscIdUnique 13
644 integerPlusTwoIdKey = mkPreludeMiscIdUnique 14
645 integerZeroIdKey = mkPreludeMiscIdUnique 15
646 irrefutPatErrorIdKey = mkPreludeMiscIdUnique 16
647 lexIdKey = mkPreludeMiscIdUnique 17
648 noDefaultMethodErrorIdKey = mkPreludeMiscIdUnique 20
649 nonExhaustiveGuardsErrorIdKey = mkPreludeMiscIdUnique 21
650 nonExplicitMethodErrorIdKey = mkPreludeMiscIdUnique 22
651 notIdKey = mkPreludeMiscIdUnique 23
652 packCStringIdKey = mkPreludeMiscIdUnique 24
653 parErrorIdKey = mkPreludeMiscIdUnique 25
654 parIdKey = mkPreludeMiscIdUnique 26
655 patErrorIdKey = mkPreludeMiscIdUnique 27
656 readParenIdKey = mkPreludeMiscIdUnique 28
657 realWorldPrimIdKey = mkPreludeMiscIdUnique 29
658 recConErrorIdKey = mkPreludeMiscIdUnique 30
659 recUpdErrorIdKey = mkPreludeMiscIdUnique 31
660 runSTIdKey = mkPreludeMiscIdUnique 32
661 seqIdKey = mkPreludeMiscIdUnique 33
662 showParenIdKey = mkPreludeMiscIdUnique 34
663 showSpaceIdKey = mkPreludeMiscIdUnique 35
664 showStringIdKey = mkPreludeMiscIdUnique 36
665 traceIdKey = mkPreludeMiscIdUnique 37
666 unpackCString2IdKey = mkPreludeMiscIdUnique 38
667 unpackCStringAppendIdKey = mkPreludeMiscIdUnique 39
668 unpackCStringFoldrIdKey = mkPreludeMiscIdUnique 40
669 unpackCStringIdKey = mkPreludeMiscIdUnique 41
670 voidIdKey = mkPreludeMiscIdUnique 42
671 ushowListIdKey = mkPreludeMiscIdUnique 43
672 ureadListIdKey = mkPreludeMiscIdUnique 44
674 copyableIdKey = mkPreludeMiscIdUnique 45
675 noFollowIdKey = mkPreludeMiscIdUnique 46
676 parAtAbsIdKey = mkPreludeMiscIdUnique 47
677 parAtForNowIdKey = mkPreludeMiscIdUnique 48
678 parAtIdKey = mkPreludeMiscIdUnique 49
679 parAtRelIdKey = mkPreludeMiscIdUnique 50
680 parGlobalIdKey = mkPreludeMiscIdUnique 51
681 parLocalIdKey = mkPreludeMiscIdUnique 52
684 Certain class operations from Prelude classes. They get
685 their own uniques so we can look them up easily when we want
686 to conjure them up during type checking.
688 fromIntClassOpKey = mkPreludeMiscIdUnique 53
689 fromIntegerClassOpKey = mkPreludeMiscIdUnique 54
690 minusClassOpKey = mkPreludeMiscIdUnique 69
691 fromRationalClassOpKey = mkPreludeMiscIdUnique 55
692 enumFromClassOpKey = mkPreludeMiscIdUnique 56
693 enumFromThenClassOpKey = mkPreludeMiscIdUnique 57
694 enumFromToClassOpKey = mkPreludeMiscIdUnique 58
695 enumFromThenToClassOpKey= mkPreludeMiscIdUnique 59
696 eqClassOpKey = mkPreludeMiscIdUnique 60
697 geClassOpKey = mkPreludeMiscIdUnique 61
698 zeroClassOpKey = mkPreludeMiscIdUnique 62
699 thenMClassOpKey = mkPreludeMiscIdUnique 63 -- (>>=)
700 unboundKey = mkPreludeMiscIdUnique 64 -- Just a place holder for unbound
701 -- variables produced by the renamer
702 fromEnumClassOpKey = mkPreludeMiscIdUnique 65
704 mainKey = mkPreludeMiscIdUnique 66
705 mainPrimIoKey = mkPreludeMiscIdUnique 67
706 returnMClassOpKey = mkPreludeMiscIdUnique 68
707 -- Used for minusClassOp 69
708 otherwiseIdKey = mkPreludeMiscIdUnique 70
709 toEnumClassOpKey = mkPreludeMiscIdUnique 71