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
32 -- now all the built-in Uniques (and functions to make them)
33 -- [the Oh-So-Wonderful Haskell module system wins again...]
37 mkUbxTupleDataConUnique,
39 mkUbxTupleTyConUnique,
41 getBuiltinUniques, mkBuiltinUnique,
42 mkPseudoUnique1, mkPseudoUnique2, mkPseudoUnique3,
44 absentErrorIdKey, -- alphabetical...
56 byteArrayPrimTyConKey,
69 enumFromThenClassOpKey,
70 enumFromThenToClassOpKey,
84 foreignObjPrimTyConKey,
90 fromIntegerClassOpKey,
91 fromRationalClassOpKey,
108 integerMinusOneIdKey,
116 irrefutPatErrorIdKey,
125 mutableArrayPrimTyConKey,
126 mutableByteArrayPrimTyConKey,
129 noMethodBindingErrorIdKey,
130 nonExhaustiveGuardsErrorIdKey,
157 stablePtrPrimTyConKey,
168 threadIdPrimTyConKey,
174 unpackCStringAppendIdKey,
175 unpackCStringFoldrIdKey,
200 mutableByteArrayTyConKey
203 #include "HsVersions.h"
205 import FastString ( FastString, uniqueOfFS )
208 import PrelBase ( Char(..), chr, ord )
213 %************************************************************************
215 \subsection[Unique-type]{@Unique@ type and operations}
217 %************************************************************************
219 The @Chars@ are ``tag letters'' that identify the @UniqueSupply@.
220 Fast comparison is everything on @Uniques@:
223 data Unique = MkUnique Int#
227 u2i :: Unique -> FAST_INT
231 Now come the functions which construct uniques from their pieces, and vice versa.
232 The stuff about unique *supplies* is handled further down this module.
235 mkUnique :: Char -> Int -> Unique -- Builds a unique from pieces
236 unpkUnique :: Unique -> (Char, Int) -- The reverse
238 mkUniqueGrimily :: Int# -> Unique -- A trap-door for UniqSupply
240 getKey :: Unique -> Int# -- for Var
242 incrUnique :: Unique -> Unique
247 mkUniqueGrimily x = MkUnique x
249 {-# INLINE getKey #-}
250 getKey (MkUnique x) = x
252 incrUnique (MkUnique i) = MkUnique (i +# 1#)
254 -- pop the Char in the top 8 bits of the Unique(Supply)
256 -- No 64-bit bugs here, as long as we have at least 32 bits. --JSM
262 mkUnique (C# c) (I# i)
263 = MkUnique (w2i (((i2w (ord# c)) `shiftL#` (i2w_s 24#)) `or#` (i2w i)))
265 unpkUnique (MkUnique u)
267 tag = C# (chr# (w2i ((i2w u) `shiftr` (i2w_s 24#))))
268 i = I# (w2i ((i2w u) `and#` (i2w 16777215#){-``0x00ffffff''-}))
272 shiftr x y = shiftRL# x y
277 %************************************************************************
279 \subsection[Uniquable-class]{The @Uniquable@ class}
281 %************************************************************************
284 class Uniquable a where
285 getUnique :: a -> Unique
287 instance Uniquable FastString where
288 getUnique fs = mkUniqueGrimily (uniqueOfFS fs)
290 instance Uniquable Int where
291 getUnique (I# i#) = mkUniqueGrimily i#
295 %************************************************************************
297 \subsection[Unique-instances]{Instance declarations for @Unique@}
299 %************************************************************************
301 And the whole point (besides uniqueness) is fast equality. We don't
302 use `deriving' because we want {\em precise} control of ordering
303 (equality on @Uniques@ is v common).
306 eqUnique (MkUnique u1) (MkUnique u2) = u1 ==# u2
307 ltUnique (MkUnique u1) (MkUnique u2) = u1 <# u2
308 leUnique (MkUnique u1) (MkUnique u2) = u1 <=# u2
310 cmpUnique (MkUnique u1) (MkUnique u2)
311 = if u1 ==# u2 then EQ else if u1 <# u2 then LT else GT
313 instance Eq Unique where
314 a == b = eqUnique a b
315 a /= b = not (eqUnique a b)
317 instance Ord Unique where
319 a <= b = leUnique a b
320 a > b = not (leUnique a b)
321 a >= b = not (ltUnique a b)
322 compare a b = cmpUnique a b
325 instance Uniquable Unique where
329 We do sometimes make strings with @Uniques@ in them:
331 pprUnique, pprUnique10 :: Unique -> SDoc
334 = case unpkUnique uniq of
335 (tag, u) -> finish_ppr tag u (iToBase62 u)
337 pprUnique10 uniq -- in base-10, dudes
338 = case unpkUnique uniq of
339 (tag, u) -> finish_ppr tag u (int u)
341 finish_ppr 't' u pp_u | u < 26
342 = -- Special case to make v common tyvars, t1, t2, ...
343 -- come out as a, b, ... (shorter, easier to read)
344 char (chr (ord 'a' + u))
345 finish_ppr tag u pp_u = char tag <> pp_u
347 instance Outputable Unique where
350 instance Show Unique where
351 showsPrec p uniq = showsPrecSDoc p (pprUnique uniq)
354 %************************************************************************
356 \subsection[Utils-base62]{Base-62 numbers}
358 %************************************************************************
360 A character-stingy way to read/write numbers (notably Uniques).
361 The ``62-its'' are \tr{[0-9a-zA-Z]}. We don't handle negative Ints.
362 Code stolen from Lennart.
364 # define BYTE_ARRAY GlaExts.ByteArray
365 # define RUN_ST ST.runST
366 # define AND_THEN >>=
367 # define AND_THEN_ >>
368 # define RETURN return
370 iToBase62 :: Int -> SDoc
375 bytes = case chars62 of { BYTE_ARRAY bounds_who_needs_'em bytes -> bytes }
378 case (indexCharArray# bytes n#) of { c ->
381 case (quotRem n 62) of { (q, I# r#) ->
382 case (indexCharArray# bytes r#) of { c ->
383 (<>) (iToBase62 q) (char (C# c)) }}
385 -- keep this at top level! (bug on 94/10/24 WDP)
386 chars62 :: BYTE_ARRAY Int
389 newCharArray (0, 61) AND_THEN \ ch_array ->
390 fill_in ch_array 0 62 "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
392 unsafeFreezeByteArray ch_array
395 fill_in ch_array i lim str
399 = writeCharArray ch_array i (str !! i) AND_THEN_
400 fill_in ch_array (i+1) lim str
403 %************************************************************************
405 \subsection[Uniques-prelude]{@Uniques@ for wired-in Prelude things}
407 %************************************************************************
409 Allocation of unique supply characters:
410 v,t,u : for renumbering value-, type- and usage- vars.
411 other a-z: lower case chars for unique supplies (see Main.lhs)
413 C-E: pseudo uniques (used in native-code generator)
414 _: unifiable tyvars (above)
415 0-9: prelude things below
418 mkAlphaTyVarUnique i = mkUnique '1' i
420 mkPreludeClassUnique i = mkUnique '2' i
421 mkPreludeTyConUnique i = mkUnique '3' i
422 mkTupleTyConUnique a = mkUnique '4' a
423 mkUbxTupleTyConUnique a = mkUnique '5' a
425 mkPreludeDataConUnique i = mkUnique '6' i -- must be alphabetic
426 mkTupleDataConUnique a = mkUnique '7' a -- ditto (*may* be used in C labels)
427 mkUbxTupleDataConUnique a = mkUnique '8' a
429 mkPrimOpIdUnique op = mkUnique '9' op
430 mkPreludeMiscIdUnique i = mkUnique '0' i
432 -- The "tyvar uniques" print specially nicely: a, b, c, etc.
433 -- See pprUnique for details
435 initTyVarUnique :: Unique
436 initTyVarUnique = mkUnique 't' 0
438 initTidyUniques :: (Unique, Unique) -- Global and local
439 initTidyUniques = (mkUnique 'g' 0, mkUnique 'x' 0)
441 mkPseudoUnique1, mkPseudoUnique2, mkPseudoUnique3,
442 mkBuiltinUnique :: Int -> Unique
444 mkBuiltinUnique i = mkUnique 'B' i
445 mkPseudoUnique1 i = mkUnique 'C' i -- used for getUnique on Regs
446 mkPseudoUnique2 i = mkUnique 'D' i -- ditto
447 mkPseudoUnique3 i = mkUnique 'E' i -- ditto
449 getBuiltinUniques :: Int -> [Unique]
450 getBuiltinUniques n = map (mkUnique 'B') [1 .. n]
453 %************************************************************************
455 \subsubsection[Uniques-prelude-Classes]{@Uniques@ for wired-in @Classes@}
457 %************************************************************************
460 boundedClassKey = mkPreludeClassUnique 1
461 enumClassKey = mkPreludeClassUnique 2
462 eqClassKey = mkPreludeClassUnique 3
463 floatingClassKey = mkPreludeClassUnique 5
464 fractionalClassKey = mkPreludeClassUnique 6
465 integralClassKey = mkPreludeClassUnique 7
466 monadClassKey = mkPreludeClassUnique 8
467 monadZeroClassKey = mkPreludeClassUnique 9
468 monadPlusClassKey = mkPreludeClassUnique 10
469 functorClassKey = mkPreludeClassUnique 11
470 numClassKey = mkPreludeClassUnique 12
471 ordClassKey = mkPreludeClassUnique 13
472 readClassKey = mkPreludeClassUnique 14
473 realClassKey = mkPreludeClassUnique 15
474 realFloatClassKey = mkPreludeClassUnique 16
475 realFracClassKey = mkPreludeClassUnique 17
476 showClassKey = mkPreludeClassUnique 18
478 cCallableClassKey = mkPreludeClassUnique 19
479 cReturnableClassKey = mkPreludeClassUnique 20
481 ixClassKey = mkPreludeClassUnique 21
484 %************************************************************************
486 \subsubsection[Uniques-prelude-TyCons]{@Uniques@ for wired-in @TyCons@}
488 %************************************************************************
491 addrPrimTyConKey = mkPreludeTyConUnique 1
492 addrTyConKey = mkPreludeTyConUnique 2
493 arrayPrimTyConKey = mkPreludeTyConUnique 3
494 boolTyConKey = mkPreludeTyConUnique 4
495 byteArrayPrimTyConKey = mkPreludeTyConUnique 5
496 charPrimTyConKey = mkPreludeTyConUnique 7
497 charTyConKey = mkPreludeTyConUnique 8
498 doublePrimTyConKey = mkPreludeTyConUnique 9
499 doubleTyConKey = mkPreludeTyConUnique 10
500 floatPrimTyConKey = mkPreludeTyConUnique 11
501 floatTyConKey = mkPreludeTyConUnique 12
502 funTyConKey = mkPreludeTyConUnique 13
503 intPrimTyConKey = mkPreludeTyConUnique 14
504 intTyConKey = mkPreludeTyConUnique 15
505 int8TyConKey = mkPreludeTyConUnique 16
506 int16TyConKey = mkPreludeTyConUnique 17
507 int32TyConKey = mkPreludeTyConUnique 18
508 int64PrimTyConKey = mkPreludeTyConUnique 19
509 int64TyConKey = mkPreludeTyConUnique 20
510 integerTyConKey = mkPreludeTyConUnique 21
511 listTyConKey = mkPreludeTyConUnique 22
512 foreignObjPrimTyConKey = mkPreludeTyConUnique 23
513 foreignObjTyConKey = mkPreludeTyConUnique 24
514 weakPrimTyConKey = mkPreludeTyConUnique 25
515 mutableArrayPrimTyConKey = mkPreludeTyConUnique 26
516 mutableByteArrayPrimTyConKey = mkPreludeTyConUnique 27
517 orderingTyConKey = mkPreludeTyConUnique 28
518 mVarPrimTyConKey = mkPreludeTyConUnique 29
519 ratioTyConKey = mkPreludeTyConUnique 30
520 rationalTyConKey = mkPreludeTyConUnique 31
521 realWorldTyConKey = mkPreludeTyConUnique 32
522 stablePtrPrimTyConKey = mkPreludeTyConUnique 33
523 stablePtrTyConKey = mkPreludeTyConUnique 34
524 stateTyConKey = mkPreludeTyConUnique 50
525 statePrimTyConKey = mkPreludeTyConUnique 51
526 mutableByteArrayTyConKey = mkPreludeTyConUnique 52
527 mutVarPrimTyConKey = mkPreludeTyConUnique 53
528 ioTyConKey = mkPreludeTyConUnique 55
529 byteArrayTyConKey = mkPreludeTyConUnique 56
530 wordPrimTyConKey = mkPreludeTyConUnique 57
531 wordTyConKey = mkPreludeTyConUnique 58
532 word8TyConKey = mkPreludeTyConUnique 59
533 word16TyConKey = mkPreludeTyConUnique 60
534 word32TyConKey = mkPreludeTyConUnique 61
535 word64PrimTyConKey = mkPreludeTyConUnique 62
536 word64TyConKey = mkPreludeTyConUnique 63
537 voidTyConKey = mkPreludeTyConUnique 64
538 boxedConKey = mkPreludeTyConUnique 65
539 unboxedConKey = mkPreludeTyConUnique 66
540 anyBoxConKey = mkPreludeTyConUnique 67
541 kindConKey = mkPreludeTyConUnique 68
542 boxityConKey = mkPreludeTyConUnique 69
543 typeConKey = mkPreludeTyConUnique 70
544 threadIdPrimTyConKey = mkPreludeTyConUnique 71
547 %************************************************************************
549 \subsubsection[Uniques-prelude-DataCons]{@Uniques@ for wired-in @DataCons@}
551 %************************************************************************
554 addrDataConKey = mkPreludeDataConUnique 1
555 charDataConKey = mkPreludeDataConUnique 2
556 consDataConKey = mkPreludeDataConUnique 3
557 doubleDataConKey = mkPreludeDataConUnique 4
558 falseDataConKey = mkPreludeDataConUnique 5
559 floatDataConKey = mkPreludeDataConUnique 6
560 intDataConKey = mkPreludeDataConUnique 7
561 int8DataConKey = mkPreludeDataConUnique 8
562 int16DataConKey = mkPreludeDataConUnique 9
563 int32DataConKey = mkPreludeDataConUnique 10
564 int64DataConKey = mkPreludeDataConUnique 11
565 integerDataConKey = mkPreludeDataConUnique 12
566 foreignObjDataConKey = mkPreludeDataConUnique 13
567 nilDataConKey = mkPreludeDataConUnique 14
568 ratioDataConKey = mkPreludeDataConUnique 15
569 stablePtrDataConKey = mkPreludeDataConUnique 16
570 stateDataConKey = mkPreludeDataConUnique 33
571 trueDataConKey = mkPreludeDataConUnique 34
572 wordDataConKey = mkPreludeDataConUnique 35
573 word8DataConKey = mkPreludeDataConUnique 36
574 word16DataConKey = mkPreludeDataConUnique 37
575 word32DataConKey = mkPreludeDataConUnique 38
576 word64DataConKey = mkPreludeDataConUnique 39
577 stDataConKey = mkPreludeDataConUnique 40
578 ioDataConKey = mkPreludeDataConUnique 42
581 %************************************************************************
583 \subsubsection[Uniques-prelude-Ids]{@Uniques@ for wired-in @Ids@ (except @DataCons@)}
585 %************************************************************************
588 absentErrorIdKey = mkPreludeMiscIdUnique 1
589 appendIdKey = mkPreludeMiscIdUnique 2
590 augmentIdKey = mkPreludeMiscIdUnique 3
591 buildIdKey = mkPreludeMiscIdUnique 4
592 errorIdKey = mkPreludeMiscIdUnique 5
593 foldlIdKey = mkPreludeMiscIdUnique 6
594 foldrIdKey = mkPreludeMiscIdUnique 7
595 recSelErrIdKey = mkPreludeMiscIdUnique 8
596 integerMinusOneIdKey = mkPreludeMiscIdUnique 9
597 integerPlusOneIdKey = mkPreludeMiscIdUnique 10
598 integerPlusTwoIdKey = mkPreludeMiscIdUnique 11
599 integerZeroIdKey = mkPreludeMiscIdUnique 12
600 int2IntegerIdKey = mkPreludeMiscIdUnique 13
601 addr2IntegerIdKey = mkPreludeMiscIdUnique 14
602 irrefutPatErrorIdKey = mkPreludeMiscIdUnique 15
603 lexIdKey = mkPreludeMiscIdUnique 16
604 noMethodBindingErrorIdKey = mkPreludeMiscIdUnique 17
605 nonExhaustiveGuardsErrorIdKey = mkPreludeMiscIdUnique 18
606 packCStringIdKey = mkPreludeMiscIdUnique 19
607 parErrorIdKey = mkPreludeMiscIdUnique 20
608 parIdKey = mkPreludeMiscIdUnique 21
609 patErrorIdKey = mkPreludeMiscIdUnique 22
610 realWorldPrimIdKey = mkPreludeMiscIdUnique 23
611 recConErrorIdKey = mkPreludeMiscIdUnique 24
612 recUpdErrorIdKey = mkPreludeMiscIdUnique 25
613 traceIdKey = mkPreludeMiscIdUnique 26
614 unpackCString2IdKey = mkPreludeMiscIdUnique 27
615 unpackCStringAppendIdKey = mkPreludeMiscIdUnique 28
616 unpackCStringFoldrIdKey = mkPreludeMiscIdUnique 29
617 unpackCStringIdKey = mkPreludeMiscIdUnique 30
618 voidIdKey = mkPreludeMiscIdUnique 31
619 ushowListIdKey = mkPreludeMiscIdUnique 32
620 unsafeCoerceIdKey = mkPreludeMiscIdUnique 33
621 concatIdKey = mkPreludeMiscIdUnique 34
622 filterIdKey = mkPreludeMiscIdUnique 35
623 zipIdKey = mkPreludeMiscIdUnique 36
624 bindIOIdKey = mkPreludeMiscIdUnique 37
625 deRefStablePtrIdKey = mkPreludeMiscIdUnique 38
626 makeStablePtrIdKey = mkPreludeMiscIdUnique 39
629 Certain class operations from Prelude classes. They get their own
630 uniques so we can look them up easily when we want to conjure them up
631 during type checking.
634 fromIntClassOpKey = mkPreludeMiscIdUnique 101
635 fromIntegerClassOpKey = mkPreludeMiscIdUnique 102
636 minusClassOpKey = mkPreludeMiscIdUnique 103
637 fromRationalClassOpKey = mkPreludeMiscIdUnique 104
638 enumFromClassOpKey = mkPreludeMiscIdUnique 105
639 enumFromThenClassOpKey = mkPreludeMiscIdUnique 106
640 enumFromToClassOpKey = mkPreludeMiscIdUnique 107
641 enumFromThenToClassOpKey = mkPreludeMiscIdUnique 108
642 eqClassOpKey = mkPreludeMiscIdUnique 109
643 geClassOpKey = mkPreludeMiscIdUnique 110
644 zeroClassOpKey = mkPreludeMiscIdUnique 112
645 thenMClassOpKey = mkPreludeMiscIdUnique 113 -- (>>=)
646 -- Just a place holder for unbound variables produced by the renamer:
647 unboundKey = mkPreludeMiscIdUnique 114
648 fromEnumClassOpKey = mkPreludeMiscIdUnique 115
650 mainKey = mkPreludeMiscIdUnique 116
651 returnMClassOpKey = mkPreludeMiscIdUnique 117
652 otherwiseIdKey = mkPreludeMiscIdUnique 118
653 toEnumClassOpKey = mkPreludeMiscIdUnique 119
654 mapIdKey = mkPreludeMiscIdUnique 120
658 assertIdKey = mkPreludeMiscIdUnique 121