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(..), hasKey,
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...]
42 getBuiltinUniques, mkBuiltinUnique,
43 mkPseudoUnique1, mkPseudoUnique2, mkPseudoUnique3,
45 absentErrorIdKey, -- alphabetical...
58 byteArrayPrimTyConKey,
73 enumFromThenClassOpKey,
74 enumFromThenToClassOpKey,
89 foreignObjPrimTyConKey,
94 fromIntegerClassOpKey,
95 fromRationalClassOpKey,
108 smallIntegerDataConKey,
109 largeIntegerDataConKey,
110 integerMinusOneIdKey,
118 irrefutPatErrorIdKey,
127 mutableArrayPrimTyConKey,
128 mutableByteArrayPrimTyConKey,
129 mutableByteArrayTyConKey,
132 noMethodBindingErrorIdKey,
133 nonExhaustiveGuardsErrorIdKey,
161 stablePtrPrimTyConKey,
163 stableNameDataConKey,
164 stableNamePrimTyConKey,
173 threadIdPrimTyConKey,
180 unpackCStringAppendIdKey,
181 unpackCStringFoldrIdKey,
197 #include "HsVersions.h"
199 import BasicTypes ( Boxity(..) )
200 import FastString ( FastString, uniqueOfFS )
203 import PrelBase ( Char(..), chr, ord )
208 %************************************************************************
210 \subsection[Unique-type]{@Unique@ type and operations}
212 %************************************************************************
214 The @Chars@ are ``tag letters'' that identify the @UniqueSupply@.
215 Fast comparison is everything on @Uniques@:
218 data Unique = MkUnique Int#
222 u2i :: Unique -> FAST_INT
226 Now come the functions which construct uniques from their pieces, and vice versa.
227 The stuff about unique *supplies* is handled further down this module.
230 mkUnique :: Char -> Int -> Unique -- Builds a unique from pieces
231 unpkUnique :: Unique -> (Char, Int) -- The reverse
233 mkUniqueGrimily :: Int# -> Unique -- A trap-door for UniqSupply
235 getKey :: Unique -> Int# -- for Var
237 incrUnique :: Unique -> Unique
238 deriveUnique :: Unique -> Int -> Unique
240 isTupleKey :: Unique -> Bool
245 mkUniqueGrimily x = MkUnique x
247 {-# INLINE getKey #-}
248 getKey (MkUnique x) = x
250 incrUnique (MkUnique i) = MkUnique (i +# 1#)
252 -- deriveUnique uses an 'X' tag so that it won't clash with
253 -- any of the uniques produced any other way
254 deriveUnique (MkUnique i) delta = mkUnique 'X' (I# i + delta)
256 -- pop the Char in the top 8 bits of the Unique(Supply)
258 -- No 64-bit bugs here, as long as we have at least 32 bits. --JSM
264 mkUnique (C# c) (I# i)
265 = MkUnique (w2i (tag `or#` bits))
267 tag = i2w (ord# c) `shiftL#` i2w_s 24#
268 bits = i2w i `and#` (i2w 16777215#){-``0x00ffffff''-}
270 unpkUnique (MkUnique u)
272 tag = C# (chr# (w2i ((i2w u) `shiftr` (i2w_s 24#))))
273 i = I# (w2i ((i2w u) `and#` (i2w 16777215#){-``0x00ffffff''-}))
277 shiftr x y = shiftRL# x y
282 %************************************************************************
284 \subsection[Uniquable-class]{The @Uniquable@ class}
286 %************************************************************************
289 class Uniquable a where
290 getUnique :: a -> Unique
292 hasKey :: Uniquable a => a -> Unique -> Bool
293 x `hasKey` k = getUnique x == k
295 instance Uniquable FastString where
296 getUnique fs = mkUniqueGrimily (uniqueOfFS fs)
298 instance Uniquable Int where
299 getUnique (I# i#) = mkUniqueGrimily i#
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 compare a b = cmpUnique a b
333 instance Uniquable Unique where
337 We do sometimes make strings with @Uniques@ in them:
339 pprUnique, pprUnique10 :: Unique -> SDoc
342 = case unpkUnique uniq of
343 (tag, u) -> finish_ppr tag u (iToBase62 u)
345 pprUnique10 uniq -- in base-10, dudes
346 = case unpkUnique uniq of
347 (tag, u) -> finish_ppr tag u (int u)
349 finish_ppr 't' u pp_u | u < 26
350 = -- Special case to make v common tyvars, t1, t2, ...
351 -- come out as a, b, ... (shorter, easier to read)
352 char (chr (ord 'a' + u))
353 finish_ppr tag u pp_u = char tag <> pp_u
355 instance Outputable Unique where
358 instance Show Unique where
359 showsPrec p uniq = showsPrecSDoc p (pprUnique uniq)
362 %************************************************************************
364 \subsection[Utils-base62]{Base-62 numbers}
366 %************************************************************************
368 A character-stingy way to read/write numbers (notably Uniques).
369 The ``62-its'' are \tr{[0-9a-zA-Z]}. We don't handle negative Ints.
370 Code stolen from Lennart.
372 # define BYTE_ARRAY GlaExts.ByteArray
373 # define RUN_ST ST.runST
374 # define AND_THEN >>=
375 # define AND_THEN_ >>
376 # define RETURN return
378 iToBase62 :: Int -> SDoc
383 #if __GLASGOW_HASKELL__ < 405
384 bytes = case chars62 of { BYTE_ARRAY bounds_who_needs_'em bytes -> bytes }
386 bytes = case chars62 of { BYTE_ARRAY _ _ bytes -> bytes }
390 case (indexCharArray# bytes n#) of { c ->
393 case (quotRem n 62) of { (q, I# r#) ->
394 case (indexCharArray# bytes r#) of { c ->
395 (<>) (iToBase62 q) (char (C# c)) }}
397 -- keep this at top level! (bug on 94/10/24 WDP)
398 chars62 :: BYTE_ARRAY Int
401 newCharArray (0, 61) AND_THEN \ ch_array ->
402 fill_in ch_array 0 62 "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
404 unsafeFreezeByteArray ch_array
407 fill_in ch_array i lim str
411 = writeCharArray ch_array i (str !! i) AND_THEN_
412 fill_in ch_array (i+1) lim str
415 %************************************************************************
417 \subsection[Uniques-prelude]{@Uniques@ for wired-in Prelude things}
419 %************************************************************************
421 Allocation of unique supply characters:
422 v,t,u : for renumbering value-, type- and usage- vars.
423 other a-z: lower case chars for unique supplies (see Main.lhs)
425 C-E: pseudo uniques (used in native-code generator)
426 X: uniques derived by deriveUnique
427 _: unifiable tyvars (above)
428 0-9: prelude things below
431 mkAlphaTyVarUnique i = mkUnique '1' i
433 mkPreludeClassUnique i = mkUnique '2' i
434 mkPreludeTyConUnique i = mkUnique '3' i
435 mkTupleTyConUnique Boxed a = mkUnique '4' a
436 mkTupleTyConUnique Unboxed a = mkUnique '5' a
438 -- Data constructor keys occupy *two* slots. The first is used for the
439 -- data constructor itself and its wrapper function (the function that
440 -- evaluates arguments as necessary and calls the worker). The second is
441 -- used for the worker function (the function that builds the constructor
444 mkPreludeDataConUnique i = mkUnique '6' (2*i) -- Must be alphabetic
445 mkTupleDataConUnique Boxed a = mkUnique '7' (2*a) -- ditto (*may* be used in C labels)
446 mkTupleDataConUnique Unboxed a = mkUnique '8' (2*a)
448 -- This one is used for a tiresome reason
449 -- to improve a consistency-checking error check in the renamer
450 isTupleKey u = case unpkUnique u of
451 (tag,_) -> tag == '4' || tag == '5' || tag == '7' || tag == '8'
453 mkPrimOpIdUnique op = mkUnique '9' op
454 mkPreludeMiscIdUnique i = mkUnique '0' i
456 -- The "tyvar uniques" print specially nicely: a, b, c, etc.
457 -- See pprUnique for details
459 initTyVarUnique :: Unique
460 initTyVarUnique = mkUnique 't' 0
462 initTidyUniques :: (Unique, Unique) -- Global and local
463 initTidyUniques = (mkUnique 'g' 0, mkUnique 'x' 0)
465 mkPseudoUnique1, mkPseudoUnique2, mkPseudoUnique3,
466 mkBuiltinUnique :: Int -> Unique
468 mkBuiltinUnique i = mkUnique 'B' i
469 mkPseudoUnique1 i = mkUnique 'C' i -- used for getUnique on Regs
470 mkPseudoUnique2 i = mkUnique 'D' i -- used in NCG for getUnique on RealRegs
471 mkPseudoUnique3 i = mkUnique 'E' i -- used in NCG spiller to create spill VirtualRegs
475 getBuiltinUniques :: Int -> [Unique]
476 getBuiltinUniques n = map (mkUnique 'B') [1 .. n]
479 %************************************************************************
481 \subsubsection[Uniques-prelude-Classes]{@Uniques@ for wired-in @Classes@}
483 %************************************************************************
486 boundedClassKey = mkPreludeClassUnique 1
487 enumClassKey = mkPreludeClassUnique 2
488 eqClassKey = mkPreludeClassUnique 3
489 floatingClassKey = mkPreludeClassUnique 5
490 fractionalClassKey = mkPreludeClassUnique 6
491 integralClassKey = mkPreludeClassUnique 7
492 monadClassKey = mkPreludeClassUnique 8
493 monadPlusClassKey = mkPreludeClassUnique 9
494 functorClassKey = mkPreludeClassUnique 10
495 numClassKey = mkPreludeClassUnique 11
496 ordClassKey = mkPreludeClassUnique 12
497 readClassKey = mkPreludeClassUnique 13
498 realClassKey = mkPreludeClassUnique 14
499 realFloatClassKey = mkPreludeClassUnique 15
500 realFracClassKey = mkPreludeClassUnique 16
501 showClassKey = mkPreludeClassUnique 17
503 cCallableClassKey = mkPreludeClassUnique 18
504 cReturnableClassKey = mkPreludeClassUnique 19
506 ixClassKey = mkPreludeClassUnique 20
509 %************************************************************************
511 \subsubsection[Uniques-prelude-TyCons]{@Uniques@ for wired-in @TyCons@}
513 %************************************************************************
516 addrPrimTyConKey = mkPreludeTyConUnique 1
517 addrTyConKey = mkPreludeTyConUnique 2
518 arrayPrimTyConKey = mkPreludeTyConUnique 3
519 boolTyConKey = mkPreludeTyConUnique 4
520 byteArrayPrimTyConKey = mkPreludeTyConUnique 5
521 charPrimTyConKey = mkPreludeTyConUnique 7
522 charTyConKey = mkPreludeTyConUnique 8
523 doublePrimTyConKey = mkPreludeTyConUnique 9
524 doubleTyConKey = mkPreludeTyConUnique 10
525 floatPrimTyConKey = mkPreludeTyConUnique 11
526 floatTyConKey = mkPreludeTyConUnique 12
527 funTyConKey = mkPreludeTyConUnique 13
528 intPrimTyConKey = mkPreludeTyConUnique 14
529 intTyConKey = mkPreludeTyConUnique 15
530 int8TyConKey = mkPreludeTyConUnique 16
531 int16TyConKey = mkPreludeTyConUnique 17
532 int32TyConKey = mkPreludeTyConUnique 18
533 int64PrimTyConKey = mkPreludeTyConUnique 19
534 int64TyConKey = mkPreludeTyConUnique 20
535 integerTyConKey = mkPreludeTyConUnique 21
536 listTyConKey = mkPreludeTyConUnique 22
537 foreignObjPrimTyConKey = mkPreludeTyConUnique 23
538 foreignObjTyConKey = mkPreludeTyConUnique 24
539 weakPrimTyConKey = mkPreludeTyConUnique 25
540 mutableArrayPrimTyConKey = mkPreludeTyConUnique 26
541 mutableByteArrayPrimTyConKey = mkPreludeTyConUnique 27
542 orderingTyConKey = mkPreludeTyConUnique 28
543 mVarPrimTyConKey = mkPreludeTyConUnique 29
544 ratioTyConKey = mkPreludeTyConUnique 30
545 rationalTyConKey = mkPreludeTyConUnique 31
546 realWorldTyConKey = mkPreludeTyConUnique 32
547 stablePtrPrimTyConKey = mkPreludeTyConUnique 33
548 stablePtrTyConKey = mkPreludeTyConUnique 34
549 statePrimTyConKey = mkPreludeTyConUnique 35
550 stableNamePrimTyConKey = mkPreludeTyConUnique 50
551 stableNameTyConKey = mkPreludeTyConUnique 51
552 mutableByteArrayTyConKey = mkPreludeTyConUnique 52
553 mutVarPrimTyConKey = mkPreludeTyConUnique 53
554 ioTyConKey = mkPreludeTyConUnique 55
555 byteArrayTyConKey = mkPreludeTyConUnique 56
556 wordPrimTyConKey = mkPreludeTyConUnique 57
557 wordTyConKey = mkPreludeTyConUnique 58
558 word8TyConKey = mkPreludeTyConUnique 59
559 word16TyConKey = mkPreludeTyConUnique 60
560 word32TyConKey = mkPreludeTyConUnique 61
561 word64PrimTyConKey = mkPreludeTyConUnique 62
562 word64TyConKey = mkPreludeTyConUnique 63
563 boxedConKey = mkPreludeTyConUnique 64
564 unboxedConKey = mkPreludeTyConUnique 65
565 anyBoxConKey = mkPreludeTyConUnique 66
566 kindConKey = mkPreludeTyConUnique 67
567 boxityConKey = mkPreludeTyConUnique 68
568 typeConKey = mkPreludeTyConUnique 69
569 threadIdPrimTyConKey = mkPreludeTyConUnique 70
572 %************************************************************************
574 \subsubsection[Uniques-prelude-DataCons]{@Uniques@ for wired-in @DataCons@}
576 %************************************************************************
579 addrDataConKey = mkPreludeDataConUnique 0
580 charDataConKey = mkPreludeDataConUnique 1
581 consDataConKey = mkPreludeDataConUnique 2
582 doubleDataConKey = mkPreludeDataConUnique 3
583 falseDataConKey = mkPreludeDataConUnique 4
584 floatDataConKey = mkPreludeDataConUnique 5
585 intDataConKey = mkPreludeDataConUnique 6
586 smallIntegerDataConKey = mkPreludeDataConUnique 7
587 largeIntegerDataConKey = mkPreludeDataConUnique 8
588 foreignObjDataConKey = mkPreludeDataConUnique 9
589 nilDataConKey = mkPreludeDataConUnique 10
590 ratioDataConKey = mkPreludeDataConUnique 11
591 stablePtrDataConKey = mkPreludeDataConUnique 12
592 stableNameDataConKey = mkPreludeDataConUnique 13
593 trueDataConKey = mkPreludeDataConUnique 14
594 wordDataConKey = mkPreludeDataConUnique 15
595 stDataConKey = mkPreludeDataConUnique 16
596 ioDataConKey = mkPreludeDataConUnique 17
599 %************************************************************************
601 \subsubsection[Uniques-prelude-Ids]{@Uniques@ for wired-in @Ids@ (except @DataCons@)}
603 %************************************************************************
606 absentErrorIdKey = mkPreludeMiscIdUnique 1
607 appendIdKey = mkPreludeMiscIdUnique 2
608 augmentIdKey = mkPreludeMiscIdUnique 3
609 buildIdKey = mkPreludeMiscIdUnique 4
610 errorIdKey = mkPreludeMiscIdUnique 5
611 foldlIdKey = mkPreludeMiscIdUnique 6
612 foldrIdKey = mkPreludeMiscIdUnique 7
613 recSelErrIdKey = mkPreludeMiscIdUnique 8
614 integerMinusOneIdKey = mkPreludeMiscIdUnique 9
615 integerPlusOneIdKey = mkPreludeMiscIdUnique 10
616 integerPlusTwoIdKey = mkPreludeMiscIdUnique 11
617 integerZeroIdKey = mkPreludeMiscIdUnique 12
618 int2IntegerIdKey = mkPreludeMiscIdUnique 13
619 addr2IntegerIdKey = mkPreludeMiscIdUnique 14
620 irrefutPatErrorIdKey = mkPreludeMiscIdUnique 15
621 lexIdKey = mkPreludeMiscIdUnique 16
622 noMethodBindingErrorIdKey = mkPreludeMiscIdUnique 17
623 nonExhaustiveGuardsErrorIdKey = mkPreludeMiscIdUnique 18
624 parErrorIdKey = mkPreludeMiscIdUnique 20
625 parIdKey = mkPreludeMiscIdUnique 21
626 patErrorIdKey = mkPreludeMiscIdUnique 22
627 realWorldPrimIdKey = mkPreludeMiscIdUnique 23
628 recConErrorIdKey = mkPreludeMiscIdUnique 24
629 recUpdErrorIdKey = mkPreludeMiscIdUnique 25
630 traceIdKey = mkPreludeMiscIdUnique 26
631 unpackCString2IdKey = mkPreludeMiscIdUnique 27
632 unpackCStringAppendIdKey = mkPreludeMiscIdUnique 28
633 unpackCStringFoldrIdKey = mkPreludeMiscIdUnique 29
634 unpackCStringIdKey = mkPreludeMiscIdUnique 30
635 ushowListIdKey = mkPreludeMiscIdUnique 31
636 unsafeCoerceIdKey = mkPreludeMiscIdUnique 32
637 concatIdKey = mkPreludeMiscIdUnique 33
638 filterIdKey = mkPreludeMiscIdUnique 34
639 zipIdKey = mkPreludeMiscIdUnique 35
640 bindIOIdKey = mkPreludeMiscIdUnique 36
641 returnIOIdKey = mkPreludeMiscIdUnique 37
642 deRefStablePtrIdKey = mkPreludeMiscIdUnique 38
643 makeStablePtrIdKey = mkPreludeMiscIdUnique 39
644 getTagIdKey = mkPreludeMiscIdUnique 40
647 Certain class operations from Prelude classes. They get their own
648 uniques so we can look them up easily when we want to conjure them up
649 during type checking.
652 fromIntClassOpKey = mkPreludeMiscIdUnique 101
653 fromIntegerClassOpKey = mkPreludeMiscIdUnique 102
654 minusClassOpKey = mkPreludeMiscIdUnique 103
655 fromRationalClassOpKey = mkPreludeMiscIdUnique 104
656 enumFromClassOpKey = mkPreludeMiscIdUnique 105
657 enumFromThenClassOpKey = mkPreludeMiscIdUnique 106
658 enumFromToClassOpKey = mkPreludeMiscIdUnique 107
659 enumFromThenToClassOpKey = mkPreludeMiscIdUnique 108
660 eqClassOpKey = mkPreludeMiscIdUnique 109
661 geClassOpKey = mkPreludeMiscIdUnique 110
662 failMClassOpKey = mkPreludeMiscIdUnique 112
663 thenMClassOpKey = mkPreludeMiscIdUnique 113 -- (>>=)
664 -- Just a place holder for unbound variables produced by the renamer:
665 unboundKey = mkPreludeMiscIdUnique 114
666 fromEnumClassOpKey = mkPreludeMiscIdUnique 115
668 mainKey = mkPreludeMiscIdUnique 116
669 returnMClassOpKey = mkPreludeMiscIdUnique 117
670 otherwiseIdKey = mkPreludeMiscIdUnique 118
671 toEnumClassOpKey = mkPreludeMiscIdUnique 119
672 mapIdKey = mkPreludeMiscIdUnique 120
676 assertIdKey = mkPreludeMiscIdUnique 121
677 runSTRepIdKey = mkPreludeMiscIdUnique 122