2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
5 @Uniques@ are used to distinguish entities in the compiler (@Ids@,
6 @Classes@, etc.) from each other. Thus, @Uniques@ are the basic
7 comparison key in the compiler.
9 If there is any single operation that needs to be fast, it is @Unique@
10 comparison. Unsurprisingly, there is quite a bit of huff-and-puff
13 Some of the other hair in this code is to be able to use a
14 ``splittable @UniqueSupply@'' if requested/possible (not standard
19 Unique, Uniquable(..),
20 u2i, -- hack: used in UniqFM
22 pprUnique, pprUnique10,
24 mkUnique, -- Used in UniqSupply
25 mkUniqueGrimily, -- Used in UniqSupply only!
26 getKey, -- Used in Var only!
28 incrUnique, -- Used for renumbering
29 deriveUnique, -- Ditto
35 -- now all the built-in Uniques (and functions to make them)
36 -- [the Oh-So-Wonderful Haskell module system wins again...]
40 mkUbxTupleDataConUnique,
42 mkUbxTupleTyConUnique,
44 getBuiltinUniques, mkBuiltinUnique,
45 mkPseudoUnique1, mkPseudoUnique2, mkPseudoUnique3,
47 absentErrorIdKey, -- alphabetical...
60 byteArrayPrimTyConKey,
75 enumFromThenClassOpKey,
76 enumFromThenToClassOpKey,
91 foreignObjPrimTyConKey,
96 fromIntegerClassOpKey,
97 fromRationalClassOpKey,
110 smallIntegerDataConKey,
111 largeIntegerDataConKey,
112 integerMinusOneIdKey,
120 irrefutPatErrorIdKey,
129 mutableArrayPrimTyConKey,
130 mutableByteArrayPrimTyConKey,
131 mutableByteArrayTyConKey,
134 noMethodBindingErrorIdKey,
135 nonExhaustiveGuardsErrorIdKey,
163 stablePtrPrimTyConKey,
165 stableNameDataConKey,
166 stableNamePrimTyConKey,
175 threadIdPrimTyConKey,
182 unpackCStringAppendIdKey,
183 unpackCStringFoldrIdKey,
199 #include "HsVersions.h"
201 import FastString ( FastString, uniqueOfFS )
204 import PrelBase ( Char(..), chr, ord )
209 %************************************************************************
211 \subsection[Unique-type]{@Unique@ type and operations}
213 %************************************************************************
215 The @Chars@ are ``tag letters'' that identify the @UniqueSupply@.
216 Fast comparison is everything on @Uniques@:
219 data Unique = MkUnique Int#
223 u2i :: Unique -> FAST_INT
227 Now come the functions which construct uniques from their pieces, and vice versa.
228 The stuff about unique *supplies* is handled further down this module.
231 mkUnique :: Char -> Int -> Unique -- Builds a unique from pieces
232 unpkUnique :: Unique -> (Char, Int) -- The reverse
234 mkUniqueGrimily :: Int# -> Unique -- A trap-door for UniqSupply
236 getKey :: Unique -> Int# -- for Var
238 incrUnique :: Unique -> Unique
239 deriveUnique :: Unique -> Int -> Unique
241 isTupleKey :: Unique -> Bool
246 mkUniqueGrimily x = MkUnique x
248 {-# INLINE getKey #-}
249 getKey (MkUnique x) = x
251 incrUnique (MkUnique i) = MkUnique (i +# 1#)
253 -- deriveUnique uses an 'X' tag so that it won't clash with
254 -- any of the uniques produced any other way
255 deriveUnique (MkUnique i) delta = mkUnique 'X' (I# i + delta)
257 -- pop the Char in the top 8 bits of the Unique(Supply)
259 -- No 64-bit bugs here, as long as we have at least 32 bits. --JSM
265 mkUnique (C# c) (I# i)
266 = MkUnique (w2i (tag `or#` bits))
268 tag = i2w (ord# c) `shiftL#` i2w_s 24#
269 bits = i2w i `and#` (i2w 16777215#){-``0x00ffffff''-}
271 unpkUnique (MkUnique u)
273 tag = C# (chr# (w2i ((i2w u) `shiftr` (i2w_s 24#))))
274 i = I# (w2i ((i2w u) `and#` (i2w 16777215#){-``0x00ffffff''-}))
278 shiftr x y = shiftRL# x y
283 %************************************************************************
285 \subsection[Uniquable-class]{The @Uniquable@ class}
287 %************************************************************************
290 class Uniquable a where
291 getUnique :: a -> Unique
293 instance Uniquable FastString where
294 getUnique fs = mkUniqueGrimily (uniqueOfFS fs)
296 instance Uniquable Int where
297 getUnique (I# i#) = mkUniqueGrimily i#
301 %************************************************************************
303 \subsection[Unique-instances]{Instance declarations for @Unique@}
305 %************************************************************************
307 And the whole point (besides uniqueness) is fast equality. We don't
308 use `deriving' because we want {\em precise} control of ordering
309 (equality on @Uniques@ is v common).
312 eqUnique (MkUnique u1) (MkUnique u2) = u1 ==# u2
313 ltUnique (MkUnique u1) (MkUnique u2) = u1 <# u2
314 leUnique (MkUnique u1) (MkUnique u2) = u1 <=# u2
316 cmpUnique (MkUnique u1) (MkUnique u2)
317 = if u1 ==# u2 then EQ else if u1 <# u2 then LT else GT
319 instance Eq Unique where
320 a == b = eqUnique a b
321 a /= b = not (eqUnique a b)
323 instance Ord Unique where
325 a <= b = leUnique a b
326 a > b = not (leUnique a b)
327 a >= b = not (ltUnique a b)
328 compare a b = cmpUnique a b
331 instance Uniquable Unique where
335 We do sometimes make strings with @Uniques@ in them:
337 pprUnique, pprUnique10 :: Unique -> SDoc
340 = case unpkUnique uniq of
341 (tag, u) -> finish_ppr tag u (iToBase62 u)
343 pprUnique10 uniq -- in base-10, dudes
344 = case unpkUnique uniq of
345 (tag, u) -> finish_ppr tag u (int u)
347 finish_ppr 't' u pp_u | u < 26
348 = -- Special case to make v common tyvars, t1, t2, ...
349 -- come out as a, b, ... (shorter, easier to read)
350 char (chr (ord 'a' + u))
351 finish_ppr tag u pp_u = char tag <> pp_u
353 instance Outputable Unique where
356 instance Show Unique where
357 showsPrec p uniq = showsPrecSDoc p (pprUnique 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 # define BYTE_ARRAY GlaExts.ByteArray
371 # define RUN_ST ST.runST
372 # define AND_THEN >>=
373 # define AND_THEN_ >>
374 # define RETURN return
376 iToBase62 :: Int -> SDoc
381 #if __GLASGOW_HASKELL__ < 405
382 bytes = case chars62 of { BYTE_ARRAY bounds_who_needs_'em bytes -> bytes }
384 bytes = case chars62 of { BYTE_ARRAY _ _ bytes -> bytes }
388 case (indexCharArray# bytes n#) of { c ->
391 case (quotRem n 62) of { (q, I# r#) ->
392 case (indexCharArray# bytes r#) of { c ->
393 (<>) (iToBase62 q) (char (C# c)) }}
395 -- keep this at top level! (bug on 94/10/24 WDP)
396 chars62 :: BYTE_ARRAY Int
399 newCharArray (0, 61) AND_THEN \ ch_array ->
400 fill_in ch_array 0 62 "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
402 unsafeFreezeByteArray ch_array
405 fill_in ch_array i lim str
409 = writeCharArray ch_array i (str !! i) AND_THEN_
410 fill_in ch_array (i+1) lim str
413 %************************************************************************
415 \subsection[Uniques-prelude]{@Uniques@ for wired-in Prelude things}
417 %************************************************************************
419 Allocation of unique supply characters:
420 v,t,u : for renumbering value-, type- and usage- vars.
421 other a-z: lower case chars for unique supplies (see Main.lhs)
423 C-E: pseudo uniques (used in native-code generator)
424 X: uniques derived by deriveUnique
425 _: unifiable tyvars (above)
426 0-9: prelude things below
429 mkAlphaTyVarUnique i = mkUnique '1' i
431 mkPreludeClassUnique i = mkUnique '2' i
432 mkPreludeTyConUnique i = mkUnique '3' i
433 mkTupleTyConUnique a = mkUnique '4' a
434 mkUbxTupleTyConUnique a = mkUnique '5' a
436 -- Data constructor keys occupy *two* slots. The first is used for the
437 -- data constructor itself and its wrapper function (the function that
438 -- evaluates arguments as necessary and calls the worker). The second is
439 -- used for the worker function (the function that builds the constructor
442 mkPreludeDataConUnique i = mkUnique '6' (2*i) -- Must be alphabetic
443 mkTupleDataConUnique a = mkUnique '7' (2*a) -- ditto (*may* be used in C labels)
444 mkUbxTupleDataConUnique a = mkUnique '8' (2*a)
446 -- This one is used for a tiresome reason
447 -- to improve a consistency-checking error check in the renamer
448 isTupleKey u = case unpkUnique u of
449 (tag,_) -> tag == '4' || tag == '5' || tag == '7' || tag == '8'
451 mkPrimOpIdUnique op = mkUnique '9' op
452 mkPreludeMiscIdUnique i = mkUnique '0' 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 initTidyUniques :: (Unique, Unique) -- Global and local
461 initTidyUniques = (mkUnique 'g' 0, mkUnique 'x' 0)
463 mkPseudoUnique1, mkPseudoUnique2, mkPseudoUnique3,
464 mkBuiltinUnique :: Int -> Unique
466 mkBuiltinUnique i = mkUnique 'B' i
467 mkPseudoUnique1 i = mkUnique 'C' i -- used for getUnique on Regs
468 mkPseudoUnique2 i = mkUnique 'D' i -- ditto
469 mkPseudoUnique3 i = mkUnique 'E' i -- ditto
471 getBuiltinUniques :: Int -> [Unique]
472 getBuiltinUniques n = map (mkUnique 'B') [1 .. n]
475 %************************************************************************
477 \subsubsection[Uniques-prelude-Classes]{@Uniques@ for wired-in @Classes@}
479 %************************************************************************
482 boundedClassKey = mkPreludeClassUnique 1
483 enumClassKey = mkPreludeClassUnique 2
484 eqClassKey = mkPreludeClassUnique 3
485 floatingClassKey = mkPreludeClassUnique 5
486 fractionalClassKey = mkPreludeClassUnique 6
487 integralClassKey = mkPreludeClassUnique 7
488 monadClassKey = mkPreludeClassUnique 8
489 monadPlusClassKey = mkPreludeClassUnique 9
490 functorClassKey = mkPreludeClassUnique 10
491 numClassKey = mkPreludeClassUnique 11
492 ordClassKey = mkPreludeClassUnique 12
493 readClassKey = mkPreludeClassUnique 13
494 realClassKey = mkPreludeClassUnique 14
495 realFloatClassKey = mkPreludeClassUnique 15
496 realFracClassKey = mkPreludeClassUnique 16
497 showClassKey = mkPreludeClassUnique 17
499 cCallableClassKey = mkPreludeClassUnique 18
500 cReturnableClassKey = mkPreludeClassUnique 19
502 ixClassKey = mkPreludeClassUnique 20
505 %************************************************************************
507 \subsubsection[Uniques-prelude-TyCons]{@Uniques@ for wired-in @TyCons@}
509 %************************************************************************
512 addrPrimTyConKey = mkPreludeTyConUnique 1
513 addrTyConKey = mkPreludeTyConUnique 2
514 arrayPrimTyConKey = mkPreludeTyConUnique 3
515 boolTyConKey = mkPreludeTyConUnique 4
516 byteArrayPrimTyConKey = mkPreludeTyConUnique 5
517 charPrimTyConKey = mkPreludeTyConUnique 7
518 charTyConKey = mkPreludeTyConUnique 8
519 doublePrimTyConKey = mkPreludeTyConUnique 9
520 doubleTyConKey = mkPreludeTyConUnique 10
521 floatPrimTyConKey = mkPreludeTyConUnique 11
522 floatTyConKey = mkPreludeTyConUnique 12
523 funTyConKey = mkPreludeTyConUnique 13
524 intPrimTyConKey = mkPreludeTyConUnique 14
525 intTyConKey = mkPreludeTyConUnique 15
526 int8TyConKey = mkPreludeTyConUnique 16
527 int16TyConKey = mkPreludeTyConUnique 17
528 int32TyConKey = mkPreludeTyConUnique 18
529 int64PrimTyConKey = mkPreludeTyConUnique 19
530 int64TyConKey = mkPreludeTyConUnique 20
531 integerTyConKey = mkPreludeTyConUnique 21
532 listTyConKey = mkPreludeTyConUnique 22
533 foreignObjPrimTyConKey = mkPreludeTyConUnique 23
534 foreignObjTyConKey = mkPreludeTyConUnique 24
535 weakPrimTyConKey = mkPreludeTyConUnique 25
536 mutableArrayPrimTyConKey = mkPreludeTyConUnique 26
537 mutableByteArrayPrimTyConKey = mkPreludeTyConUnique 27
538 orderingTyConKey = mkPreludeTyConUnique 28
539 mVarPrimTyConKey = mkPreludeTyConUnique 29
540 ratioTyConKey = mkPreludeTyConUnique 30
541 rationalTyConKey = mkPreludeTyConUnique 31
542 realWorldTyConKey = mkPreludeTyConUnique 32
543 stablePtrPrimTyConKey = mkPreludeTyConUnique 33
544 stablePtrTyConKey = mkPreludeTyConUnique 34
545 statePrimTyConKey = mkPreludeTyConUnique 35
546 stableNamePrimTyConKey = mkPreludeTyConUnique 50
547 stableNameTyConKey = mkPreludeTyConUnique 51
548 mutableByteArrayTyConKey = mkPreludeTyConUnique 52
549 mutVarPrimTyConKey = mkPreludeTyConUnique 53
550 ioTyConKey = mkPreludeTyConUnique 55
551 byteArrayTyConKey = mkPreludeTyConUnique 56
552 wordPrimTyConKey = mkPreludeTyConUnique 57
553 wordTyConKey = mkPreludeTyConUnique 58
554 word8TyConKey = mkPreludeTyConUnique 59
555 word16TyConKey = mkPreludeTyConUnique 60
556 word32TyConKey = mkPreludeTyConUnique 61
557 word64PrimTyConKey = mkPreludeTyConUnique 62
558 word64TyConKey = mkPreludeTyConUnique 63
559 boxedConKey = mkPreludeTyConUnique 64
560 unboxedConKey = mkPreludeTyConUnique 65
561 anyBoxConKey = mkPreludeTyConUnique 66
562 kindConKey = mkPreludeTyConUnique 67
563 boxityConKey = mkPreludeTyConUnique 68
564 typeConKey = mkPreludeTyConUnique 69
565 threadIdPrimTyConKey = mkPreludeTyConUnique 70
568 %************************************************************************
570 \subsubsection[Uniques-prelude-DataCons]{@Uniques@ for wired-in @DataCons@}
572 %************************************************************************
575 addrDataConKey = mkPreludeDataConUnique 0
576 charDataConKey = mkPreludeDataConUnique 1
577 consDataConKey = mkPreludeDataConUnique 2
578 doubleDataConKey = mkPreludeDataConUnique 3
579 falseDataConKey = mkPreludeDataConUnique 4
580 floatDataConKey = mkPreludeDataConUnique 5
581 intDataConKey = mkPreludeDataConUnique 6
582 smallIntegerDataConKey = mkPreludeDataConUnique 7
583 largeIntegerDataConKey = mkPreludeDataConUnique 8
584 foreignObjDataConKey = mkPreludeDataConUnique 9
585 nilDataConKey = mkPreludeDataConUnique 10
586 ratioDataConKey = mkPreludeDataConUnique 11
587 stablePtrDataConKey = mkPreludeDataConUnique 12
588 stableNameDataConKey = mkPreludeDataConUnique 13
589 trueDataConKey = mkPreludeDataConUnique 14
590 wordDataConKey = mkPreludeDataConUnique 15
591 stDataConKey = mkPreludeDataConUnique 16
592 ioDataConKey = mkPreludeDataConUnique 17
595 %************************************************************************
597 \subsubsection[Uniques-prelude-Ids]{@Uniques@ for wired-in @Ids@ (except @DataCons@)}
599 %************************************************************************
602 absentErrorIdKey = mkPreludeMiscIdUnique 1
603 appendIdKey = mkPreludeMiscIdUnique 2
604 augmentIdKey = mkPreludeMiscIdUnique 3
605 buildIdKey = mkPreludeMiscIdUnique 4
606 errorIdKey = mkPreludeMiscIdUnique 5
607 foldlIdKey = mkPreludeMiscIdUnique 6
608 foldrIdKey = mkPreludeMiscIdUnique 7
609 recSelErrIdKey = mkPreludeMiscIdUnique 8
610 integerMinusOneIdKey = mkPreludeMiscIdUnique 9
611 integerPlusOneIdKey = mkPreludeMiscIdUnique 10
612 integerPlusTwoIdKey = mkPreludeMiscIdUnique 11
613 integerZeroIdKey = mkPreludeMiscIdUnique 12
614 int2IntegerIdKey = mkPreludeMiscIdUnique 13
615 addr2IntegerIdKey = mkPreludeMiscIdUnique 14
616 irrefutPatErrorIdKey = mkPreludeMiscIdUnique 15
617 lexIdKey = mkPreludeMiscIdUnique 16
618 noMethodBindingErrorIdKey = mkPreludeMiscIdUnique 17
619 nonExhaustiveGuardsErrorIdKey = mkPreludeMiscIdUnique 18
620 parErrorIdKey = mkPreludeMiscIdUnique 20
621 parIdKey = mkPreludeMiscIdUnique 21
622 patErrorIdKey = mkPreludeMiscIdUnique 22
623 realWorldPrimIdKey = mkPreludeMiscIdUnique 23
624 recConErrorIdKey = mkPreludeMiscIdUnique 24
625 recUpdErrorIdKey = mkPreludeMiscIdUnique 25
626 traceIdKey = mkPreludeMiscIdUnique 26
627 unpackCString2IdKey = mkPreludeMiscIdUnique 27
628 unpackCStringAppendIdKey = mkPreludeMiscIdUnique 28
629 unpackCStringFoldrIdKey = mkPreludeMiscIdUnique 29
630 unpackCStringIdKey = mkPreludeMiscIdUnique 30
631 ushowListIdKey = mkPreludeMiscIdUnique 31
632 unsafeCoerceIdKey = mkPreludeMiscIdUnique 32
633 concatIdKey = mkPreludeMiscIdUnique 33
634 filterIdKey = mkPreludeMiscIdUnique 34
635 zipIdKey = mkPreludeMiscIdUnique 35
636 bindIOIdKey = mkPreludeMiscIdUnique 36
637 returnIOIdKey = mkPreludeMiscIdUnique 37
638 deRefStablePtrIdKey = mkPreludeMiscIdUnique 38
639 makeStablePtrIdKey = mkPreludeMiscIdUnique 39
640 getTagIdKey = mkPreludeMiscIdUnique 40
643 Certain class operations from Prelude classes. They get their own
644 uniques so we can look them up easily when we want to conjure them up
645 during type checking.
648 fromIntClassOpKey = mkPreludeMiscIdUnique 101
649 fromIntegerClassOpKey = mkPreludeMiscIdUnique 102
650 minusClassOpKey = mkPreludeMiscIdUnique 103
651 fromRationalClassOpKey = mkPreludeMiscIdUnique 104
652 enumFromClassOpKey = mkPreludeMiscIdUnique 105
653 enumFromThenClassOpKey = mkPreludeMiscIdUnique 106
654 enumFromToClassOpKey = mkPreludeMiscIdUnique 107
655 enumFromThenToClassOpKey = mkPreludeMiscIdUnique 108
656 eqClassOpKey = mkPreludeMiscIdUnique 109
657 geClassOpKey = mkPreludeMiscIdUnique 110
658 failMClassOpKey = mkPreludeMiscIdUnique 112
659 thenMClassOpKey = mkPreludeMiscIdUnique 113 -- (>>=)
660 -- Just a place holder for unbound variables produced by the renamer:
661 unboundKey = mkPreludeMiscIdUnique 114
662 fromEnumClassOpKey = mkPreludeMiscIdUnique 115
664 mainKey = mkPreludeMiscIdUnique 116
665 returnMClassOpKey = mkPreludeMiscIdUnique 117
666 otherwiseIdKey = mkPreludeMiscIdUnique 118
667 toEnumClassOpKey = mkPreludeMiscIdUnique 119
668 mapIdKey = mkPreludeMiscIdUnique 120
672 assertIdKey = mkPreludeMiscIdUnique 121
673 runSTRepIdKey = mkPreludeMiscIdUnique 122