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
20 Unique, Uniquable(..),
21 u2i, -- hack: used in UniqFM
23 pprUnique, pprUnique10, showUnique,
25 mkUnique, -- Used in UniqSupply
26 mkUniqueGrimily, -- Used in UniqSupply only!
28 incrUnique, -- Used for renumbering
29 initTyVarUnique, mkTyVarUnique,
32 -- now all the built-in Uniques (and functions to make them)
33 -- [the Oh-So-Wonderful Haskell module system wins again...]
39 getBuiltinUniques, mkBuiltinUnique,
40 mkPseudoUnique1, mkPseudoUnique2, mkPseudoUnique3,
42 absentErrorIdKey, -- alphabetical...
54 byteArrayPrimTyConKey,
67 enumFromThenClassOpKey,
68 enumFromThenToClassOpKey,
83 foreignObjPrimTyConKey,
89 fromIntegerClassOpKey,
90 fromRationalClassOpKey,
105 irrefutPatErrorIdKey,
117 mutableArrayPrimTyConKey,
118 mutableByteArrayPrimTyConKey,
120 noDefaultMethodErrorIdKey,
121 nonExhaustiveGuardsErrorIdKey,
122 nonExplicitMethodErrorIdKey,
144 return2GMPsDataConKey,
146 returnIntAndGMPDataConKey,
147 returnIntAndGMPTyConKey,
162 stablePtrPrimTyConKey,
164 stateAndAddrPrimDataConKey,
165 stateAndAddrPrimTyConKey,
166 stateAndArrayPrimDataConKey,
167 stateAndArrayPrimTyConKey,
168 stateAndByteArrayPrimDataConKey,
169 stateAndByteArrayPrimTyConKey,
170 stateAndCharPrimDataConKey,
171 stateAndCharPrimTyConKey,
172 stateAndDoublePrimDataConKey,
173 stateAndDoublePrimTyConKey,
174 stateAndFloatPrimDataConKey,
175 stateAndFloatPrimTyConKey,
176 stateAndForeignObjPrimDataConKey,
177 stateAndForeignObjPrimTyConKey,
178 stateAndIntPrimDataConKey,
179 stateAndIntPrimTyConKey,
180 stateAndMutableArrayPrimDataConKey,
181 stateAndMutableArrayPrimTyConKey,
182 stateAndMutableByteArrayPrimDataConKey,
183 stateAndMutableByteArrayPrimTyConKey,
184 stateAndPtrPrimDataConKey,
185 stateAndPtrPrimTyConKey,
186 stateAndStablePtrPrimDataConKey,
187 stateAndStablePtrPrimTyConKey,
188 stateAndSynchVarPrimDataConKey,
189 stateAndSynchVarPrimTyConKey,
190 stateAndWordPrimDataConKey,
191 stateAndWordPrimTyConKey,
197 synchVarPrimTyConKey,
203 unpackCStringAppendIdKey,
204 unpackCStringFoldrIdKey,
224 , mutableByteArrayTyConKey
228 #include "HsVersions.h"
230 import FastString ( uniqueOfFS )
233 import PrelBase ( Char(..), chr, ord )
239 %************************************************************************
241 \subsection[Unique-type]{@Unique@ type and operations}
243 %************************************************************************
245 The @Chars@ are ``tag letters'' that identify the @UniqueSupply@.
246 Fast comparison is everything on @Uniques@:
249 data Unique = MkUnique Int#
253 u2i :: Unique -> FAST_INT
257 Now come the functions which construct uniques from their pieces, and vice versa.
258 The stuff about unique *supplies* is handled further down this module.
261 mkUnique :: Char -> Int -> Unique -- Builds a unique from pieces
262 unpkUnique :: Unique -> (Char, Int) -- The reverse
264 mkUniqueGrimily :: Int# -> Unique -- A trap-door for UniqSupply
266 incrUnique :: Unique -> Unique
271 mkUniqueGrimily x = MkUnique x
273 incrUnique (MkUnique i) = MkUnique (i +# 1#)
275 -- pop the Char in the top 8 bits of the Unique(Supply)
277 -- No 64-bit bugs here, as long as we have at least 32 bits. --JSM
283 mkUnique (C# c) (I# i)
284 = MkUnique (w2i (((i2w (ord# c)) `shiftL#` (i2w_s 24#)) `or#` (i2w i)))
286 unpkUnique (MkUnique u)
288 tag = C# (chr# (w2i ((i2w u) `shiftr` (i2w_s 24#))))
289 i = I# (w2i ((i2w u) `and#` (i2w 16777215#){-``0x00ffffff''-}))
293 shiftr x y = shiftRA# x y
298 %************************************************************************
300 \subsection[Uniquable-class]{The @Uniquable@ class}
302 %************************************************************************
305 class Uniquable a where
306 uniqueOf :: a -> Unique
308 instance Uniquable FastString where
309 uniqueOf fs = mkUniqueGrimily (uniqueOfFS fs)
311 instance Uniquable Int where
312 uniqueOf (I# i#) = mkUniqueGrimily i#
316 %************************************************************************
318 \subsection[Unique-instances]{Instance declarations for @Unique@}
320 %************************************************************************
322 And the whole point (besides uniqueness) is fast equality. We don't
323 use `deriving' because we want {\em precise} control of ordering
324 (equality on @Uniques@ is v common).
327 eqUnique (MkUnique u1) (MkUnique u2) = u1 ==# u2
328 ltUnique (MkUnique u1) (MkUnique u2) = u1 <# u2
329 leUnique (MkUnique u1) (MkUnique u2) = u1 <=# u2
331 cmpUnique (MkUnique u1) (MkUnique u2)
332 = if u1 ==# u2 then EQ else if u1 <# u2 then LT else GT
334 instance Eq Unique where
335 a == b = eqUnique a b
336 a /= b = not (eqUnique a b)
338 instance Ord Unique where
340 a <= b = leUnique a b
341 a > b = not (leUnique a b)
342 a >= b = not (ltUnique a b)
343 compare a b = cmpUnique a b
346 instance Uniquable Unique where
350 We do sometimes make strings with @Uniques@ in them:
352 pprUnique, pprUnique10 :: Unique -> SDoc
355 = case unpkUnique uniq of
356 (tag, u) -> finish_ppr tag u (iToBase62 u)
358 pprUnique10 uniq -- in base-10, dudes
359 = case unpkUnique uniq of
360 (tag, u) -> finish_ppr tag u (int u)
362 finish_ppr 't' u pp_u | u < 26
363 = -- Special case to make v common tyvars, t1, t2, ...
364 -- come out as a, b, ... (shorter, easier to read)
365 char (chr (ord 'a' + u))
366 finish_ppr tag u pp_u = char tag <> pp_u
368 showUnique :: Unique -> String
369 showUnique uniq = showSDoc (pprUnique uniq)
371 instance Outputable Unique where
374 instance Text Unique where
375 showsPrec p uniq rest = showUnique uniq
378 %************************************************************************
380 \subsection[Utils-base62]{Base-62 numbers}
382 %************************************************************************
384 A character-stingy way to read/write numbers (notably Uniques).
385 The ``62-its'' are \tr{[0-9a-zA-Z]}. We don't handle negative Ints.
386 Code stolen from Lennart.
388 # define BYTE_ARRAY GlaExts.ByteArray
389 # define RUN_ST ST.runST
390 # define AND_THEN >>=
391 # define AND_THEN_ >>
392 # define RETURN return
394 iToBase62 :: Int -> SDoc
399 bytes = case chars62 of { BYTE_ARRAY bounds_who_needs_'em bytes -> bytes }
402 case (indexCharArray# bytes n#) of { c ->
405 case (quotRem n 62) of { (q, I# r#) ->
406 case (indexCharArray# bytes r#) of { c ->
407 (<>) (iToBase62 q) (char (C# c)) }}
409 -- keep this at top level! (bug on 94/10/24 WDP)
410 chars62 :: BYTE_ARRAY Int
413 newCharArray (0, 61) AND_THEN \ ch_array ->
414 fill_in ch_array 0 62 "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
416 unsafeFreezeByteArray ch_array
419 fill_in ch_array i lim str
423 = writeCharArray ch_array i (str !! i) AND_THEN_
424 fill_in ch_array (i+1) lim str
427 %************************************************************************
429 \subsection[Uniques-prelude]{@Uniques@ for wired-in Prelude things}
431 %************************************************************************
433 Allocation of unique supply characters:
434 v,t,u : for renumbering value-, type- and usage- vars.
435 other a-z: lower case chars for unique supplies (see Main.lhs)
437 C-E: pseudo uniques (used in native-code generator)
438 _: unifiable tyvars (above)
439 1-8: prelude things below
442 mkAlphaTyVarUnique i = mkUnique '1' i
444 mkPreludeClassUnique i = mkUnique '2' i
445 mkPreludeTyConUnique i = mkUnique '3' i
446 mkTupleTyConUnique a = mkUnique '4' a
448 mkPreludeDataConUnique i = mkUnique '5' i -- must be alphabetic
449 mkTupleDataConUnique a = mkUnique '6' a -- ditto (*may* be used in C labels)
451 mkPrimOpIdUnique op = mkUnique '7' op
452 mkPreludeMiscIdUnique i = mkUnique '8' i
454 -- The "tyvar uniques" print specially nicely: a, b, c, etc.
455 -- See pprUnique for details
457 initTyVarUnique :: Unique
458 initTyVarUnique = mkUnique 't' 0
460 mkTyVarUnique :: Int -> Unique
461 mkTyVarUnique n = mkUnique 't' n
463 initTidyUniques :: (Unique, Unique) -- Global and local
464 initTidyUniques = (mkUnique 'g' 0, mkUnique 'x' 0)
466 mkPseudoUnique1, mkPseudoUnique2, mkPseudoUnique3,
467 mkBuiltinUnique :: Int -> Unique
469 mkBuiltinUnique i = mkUnique 'B' i
470 mkPseudoUnique1 i = mkUnique 'C' i -- used for uniqueOf on Regs
471 mkPseudoUnique2 i = mkUnique 'D' i -- ditto
472 mkPseudoUnique3 i = mkUnique 'E' i -- ditto
474 getBuiltinUniques :: Int -> [Unique]
475 getBuiltinUniques n = map (mkUnique 'B') [1 .. n]
478 %************************************************************************
480 \subsubsection[Uniques-prelude-Classes]{@Uniques@ for wired-in @Classes@}
482 %************************************************************************
485 boundedClassKey = mkPreludeClassUnique 1
486 enumClassKey = mkPreludeClassUnique 2
487 eqClassKey = mkPreludeClassUnique 3
488 evalClassKey = mkPreludeClassUnique 4
489 floatingClassKey = mkPreludeClassUnique 5
490 fractionalClassKey = mkPreludeClassUnique 6
491 integralClassKey = mkPreludeClassUnique 7
492 monadClassKey = mkPreludeClassUnique 8
493 monadZeroClassKey = mkPreludeClassUnique 9
494 monadPlusClassKey = mkPreludeClassUnique 10
495 functorClassKey = mkPreludeClassUnique 11
496 numClassKey = mkPreludeClassUnique 12
497 ordClassKey = mkPreludeClassUnique 13
498 readClassKey = mkPreludeClassUnique 14
499 realClassKey = mkPreludeClassUnique 15
500 realFloatClassKey = mkPreludeClassUnique 16
501 realFracClassKey = mkPreludeClassUnique 17
502 showClassKey = mkPreludeClassUnique 18
504 cCallableClassKey = mkPreludeClassUnique 19
505 cReturnableClassKey = mkPreludeClassUnique 20
507 ixClassKey = mkPreludeClassUnique 21
508 allClassKey = mkPreludeClassUnique 22 -- Pseudo class used for universal quantification
511 %************************************************************************
513 \subsubsection[Uniques-prelude-TyCons]{@Uniques@ for wired-in @TyCons@}
515 %************************************************************************
518 addrPrimTyConKey = mkPreludeTyConUnique 1
519 addrTyConKey = mkPreludeTyConUnique 2
520 arrayPrimTyConKey = mkPreludeTyConUnique 3
521 boolTyConKey = mkPreludeTyConUnique 4
522 byteArrayPrimTyConKey = mkPreludeTyConUnique 5
523 charPrimTyConKey = mkPreludeTyConUnique 7
524 charTyConKey = mkPreludeTyConUnique 8
525 doublePrimTyConKey = mkPreludeTyConUnique 9
526 doubleTyConKey = mkPreludeTyConUnique 10
527 floatPrimTyConKey = mkPreludeTyConUnique 11
528 floatTyConKey = mkPreludeTyConUnique 12
529 funTyConKey = mkPreludeTyConUnique 13
530 intPrimTyConKey = mkPreludeTyConUnique 14
531 intTyConKey = mkPreludeTyConUnique 15
532 integerTyConKey = mkPreludeTyConUnique 16
533 liftTyConKey = mkPreludeTyConUnique 17
534 listTyConKey = mkPreludeTyConUnique 18
535 foreignObjPrimTyConKey = mkPreludeTyConUnique 19
536 foreignObjTyConKey = mkPreludeTyConUnique 20
537 mutableArrayPrimTyConKey = mkPreludeTyConUnique 21
538 mutableByteArrayPrimTyConKey = mkPreludeTyConUnique 22
539 orderingTyConKey = mkPreludeTyConUnique 23
540 synchVarPrimTyConKey = mkPreludeTyConUnique 24
541 ratioTyConKey = mkPreludeTyConUnique 25
542 rationalTyConKey = mkPreludeTyConUnique 26
543 realWorldTyConKey = mkPreludeTyConUnique 27
544 return2GMPsTyConKey = mkPreludeTyConUnique 28
545 returnIntAndGMPTyConKey = mkPreludeTyConUnique 29
546 stablePtrPrimTyConKey = mkPreludeTyConUnique 30
547 stablePtrTyConKey = mkPreludeTyConUnique 31
548 stateAndAddrPrimTyConKey = mkPreludeTyConUnique 32
549 stateAndArrayPrimTyConKey = mkPreludeTyConUnique 33
550 stateAndByteArrayPrimTyConKey = mkPreludeTyConUnique 34
551 stateAndCharPrimTyConKey = mkPreludeTyConUnique 35
552 stateAndDoublePrimTyConKey = mkPreludeTyConUnique 36
553 stateAndFloatPrimTyConKey = mkPreludeTyConUnique 37
554 stateAndIntPrimTyConKey = mkPreludeTyConUnique 38
555 stateAndForeignObjPrimTyConKey = mkPreludeTyConUnique 39
556 stateAndMutableArrayPrimTyConKey = mkPreludeTyConUnique 40
557 stateAndMutableByteArrayPrimTyConKey = mkPreludeTyConUnique 41
558 stateAndSynchVarPrimTyConKey = mkPreludeTyConUnique 42
559 stateAndPtrPrimTyConKey = mkPreludeTyConUnique 43
560 stateAndStablePtrPrimTyConKey = mkPreludeTyConUnique 44
561 stateAndWordPrimTyConKey = mkPreludeTyConUnique 45
562 statePrimTyConKey = mkPreludeTyConUnique 46
563 stateTyConKey = mkPreludeTyConUnique 47
564 mutableByteArrayTyConKey = mkPreludeTyConUnique 48
565 stTyConKey = mkPreludeTyConUnique 49
566 stRetTyConKey = mkPreludeTyConUnique 50
567 ioTyConKey = mkPreludeTyConUnique 51
568 ioResultTyConKey = mkPreludeTyConUnique 52
569 byteArrayTyConKey = mkPreludeTyConUnique 53
570 wordPrimTyConKey = mkPreludeTyConUnique 54
571 wordTyConKey = mkPreludeTyConUnique 55
572 voidTyConKey = mkPreludeTyConUnique 56
575 %************************************************************************
577 \subsubsection[Uniques-prelude-DataCons]{@Uniques@ for wired-in @DataCons@}
579 %************************************************************************
582 addrDataConKey = mkPreludeDataConUnique 1
583 buildDataConKey = mkPreludeDataConUnique 2
584 charDataConKey = mkPreludeDataConUnique 4
585 consDataConKey = mkPreludeDataConUnique 5
586 doubleDataConKey = mkPreludeDataConUnique 6
587 eqDataConKey = mkPreludeDataConUnique 7
588 falseDataConKey = mkPreludeDataConUnique 8
589 floatDataConKey = mkPreludeDataConUnique 9
590 gtDataConKey = mkPreludeDataConUnique 10
591 intDataConKey = mkPreludeDataConUnique 11
592 integerDataConKey = mkPreludeDataConUnique 12
593 liftDataConKey = mkPreludeDataConUnique 13
594 ltDataConKey = mkPreludeDataConUnique 14
595 foreignObjDataConKey = mkPreludeDataConUnique 15
596 nilDataConKey = mkPreludeDataConUnique 18
597 ratioDataConKey = mkPreludeDataConUnique 21
598 return2GMPsDataConKey = mkPreludeDataConUnique 22
599 returnIntAndGMPDataConKey = mkPreludeDataConUnique 23
600 stablePtrDataConKey = mkPreludeDataConUnique 24
601 stateAndAddrPrimDataConKey = mkPreludeDataConUnique 25
602 stateAndArrayPrimDataConKey = mkPreludeDataConUnique 26
603 stateAndByteArrayPrimDataConKey = mkPreludeDataConUnique 27
604 stateAndCharPrimDataConKey = mkPreludeDataConUnique 28
605 stateAndDoublePrimDataConKey = mkPreludeDataConUnique 29
606 stateAndFloatPrimDataConKey = mkPreludeDataConUnique 30
607 stateAndIntPrimDataConKey = mkPreludeDataConUnique 31
608 stateAndForeignObjPrimDataConKey = mkPreludeDataConUnique 32
609 stateAndMutableArrayPrimDataConKey = mkPreludeDataConUnique 33
610 stateAndMutableByteArrayPrimDataConKey = mkPreludeDataConUnique 34
611 stateAndSynchVarPrimDataConKey = mkPreludeDataConUnique 35
612 stateAndPtrPrimDataConKey = mkPreludeDataConUnique 36
613 stateAndStablePtrPrimDataConKey = mkPreludeDataConUnique 37
614 stateAndWordPrimDataConKey = mkPreludeDataConUnique 38
615 stateDataConKey = mkPreludeDataConUnique 39
616 trueDataConKey = mkPreludeDataConUnique 40
617 wordDataConKey = mkPreludeDataConUnique 41
618 stDataConKey = mkPreludeDataConUnique 42
619 stRetDataConKey = mkPreludeDataConUnique 43
620 ioDataConKey = mkPreludeDataConUnique 44
621 ioOkDataConKey = mkPreludeDataConUnique 45
622 ioFailDataConKey = mkPreludeDataConUnique 46
625 %************************************************************************
627 \subsubsection[Uniques-prelude-Ids]{@Uniques@ for wired-in @Ids@ (except @DataCons@)}
629 %************************************************************************
632 absentErrorIdKey = mkPreludeMiscIdUnique 1
633 andandIdKey = mkPreludeMiscIdUnique 2
634 appendIdKey = mkPreludeMiscIdUnique 3
635 augmentIdKey = mkPreludeMiscIdUnique 4
636 buildIdKey = mkPreludeMiscIdUnique 5
637 composeIdKey = mkPreludeMiscIdUnique 6
638 errorIdKey = mkPreludeMiscIdUnique 7
639 foldlIdKey = mkPreludeMiscIdUnique 8
640 foldrIdKey = mkPreludeMiscIdUnique 9
641 forkIdKey = mkPreludeMiscIdUnique 10
642 int2IntegerIdKey = mkPreludeMiscIdUnique 11
643 integerMinusOneIdKey = mkPreludeMiscIdUnique 12
644 integerPlusOneIdKey = mkPreludeMiscIdUnique 13
645 integerPlusTwoIdKey = mkPreludeMiscIdUnique 14
646 integerZeroIdKey = mkPreludeMiscIdUnique 15
647 irrefutPatErrorIdKey = mkPreludeMiscIdUnique 16
648 lexIdKey = mkPreludeMiscIdUnique 17
649 noDefaultMethodErrorIdKey = mkPreludeMiscIdUnique 20
650 nonExhaustiveGuardsErrorIdKey = mkPreludeMiscIdUnique 21
651 nonExplicitMethodErrorIdKey = mkPreludeMiscIdUnique 22
652 notIdKey = mkPreludeMiscIdUnique 23
653 packCStringIdKey = mkPreludeMiscIdUnique 24
654 parErrorIdKey = mkPreludeMiscIdUnique 25
655 parIdKey = mkPreludeMiscIdUnique 26
656 patErrorIdKey = mkPreludeMiscIdUnique 27
657 readParenIdKey = mkPreludeMiscIdUnique 28
658 realWorldPrimIdKey = mkPreludeMiscIdUnique 29
659 recConErrorIdKey = mkPreludeMiscIdUnique 30
660 recUpdErrorIdKey = mkPreludeMiscIdUnique 31
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 55
691 fromRationalClassOpKey = mkPreludeMiscIdUnique 56
692 enumFromClassOpKey = mkPreludeMiscIdUnique 57
693 enumFromThenClassOpKey = mkPreludeMiscIdUnique 58
694 enumFromToClassOpKey = mkPreludeMiscIdUnique 59
695 enumFromThenToClassOpKey= mkPreludeMiscIdUnique 60
696 eqClassOpKey = mkPreludeMiscIdUnique 61
697 geClassOpKey = mkPreludeMiscIdUnique 62
698 zeroClassOpKey = mkPreludeMiscIdUnique 63
699 thenMClassOpKey = mkPreludeMiscIdUnique 64 -- (>>=)
700 unboundKey = mkPreludeMiscIdUnique 65 -- Just a place holder for unbound
701 -- variables produced by the renamer
702 fromEnumClassOpKey = mkPreludeMiscIdUnique 66
704 mainKey = mkPreludeMiscIdUnique 67
705 returnMClassOpKey = mkPreludeMiscIdUnique 68
706 otherwiseIdKey = mkPreludeMiscIdUnique 69
707 toEnumClassOpKey = mkPreludeMiscIdUnique 70