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...
57 byteArrayPrimTyConKey,
72 enumFromThenClassOpKey,
73 enumFromThenToClassOpKey,
88 foreignObjPrimTyConKey,
93 fromIntegerClassOpKey,
94 fromRationalClassOpKey,
111 integerMinusOneIdKey,
119 irrefutPatErrorIdKey,
128 mutableArrayPrimTyConKey,
129 mutableByteArrayPrimTyConKey,
130 mutableByteArrayTyConKey,
133 noMethodBindingErrorIdKey,
134 nonExhaustiveGuardsErrorIdKey,
161 stablePtrPrimTyConKey,
172 threadIdPrimTyConKey,
179 unpackCStringAppendIdKey,
180 unpackCStringFoldrIdKey,
200 #include "HsVersions.h"
202 import FastString ( FastString, uniqueOfFS )
205 import PrelBase ( Char(..), chr, ord )
210 %************************************************************************
212 \subsection[Unique-type]{@Unique@ type and operations}
214 %************************************************************************
216 The @Chars@ are ``tag letters'' that identify the @UniqueSupply@.
217 Fast comparison is everything on @Uniques@:
220 data Unique = MkUnique Int#
224 u2i :: Unique -> FAST_INT
228 Now come the functions which construct uniques from their pieces, and vice versa.
229 The stuff about unique *supplies* is handled further down this module.
232 mkUnique :: Char -> Int -> Unique -- Builds a unique from pieces
233 unpkUnique :: Unique -> (Char, Int) -- The reverse
235 mkUniqueGrimily :: Int# -> Unique -- A trap-door for UniqSupply
237 getKey :: Unique -> Int# -- for Var
239 incrUnique :: Unique -> Unique
244 mkUniqueGrimily x = MkUnique x
246 {-# INLINE getKey #-}
247 getKey (MkUnique x) = x
249 incrUnique (MkUnique i) = MkUnique (i +# 1#)
251 -- pop the Char in the top 8 bits of the Unique(Supply)
253 -- No 64-bit bugs here, as long as we have at least 32 bits. --JSM
259 mkUnique (C# c) (I# i)
260 = MkUnique (w2i (((i2w (ord# c)) `shiftL#` (i2w_s 24#)) `or#` (i2w i)))
262 unpkUnique (MkUnique u)
264 tag = C# (chr# (w2i ((i2w u) `shiftr` (i2w_s 24#))))
265 i = I# (w2i ((i2w u) `and#` (i2w 16777215#){-``0x00ffffff''-}))
269 shiftr x y = shiftRL# x y
274 %************************************************************************
276 \subsection[Uniquable-class]{The @Uniquable@ class}
278 %************************************************************************
281 class Uniquable a where
282 getUnique :: a -> Unique
284 instance Uniquable FastString where
285 getUnique fs = mkUniqueGrimily (uniqueOfFS fs)
287 instance Uniquable Int where
288 getUnique (I# i#) = mkUniqueGrimily i#
292 %************************************************************************
294 \subsection[Unique-instances]{Instance declarations for @Unique@}
296 %************************************************************************
298 And the whole point (besides uniqueness) is fast equality. We don't
299 use `deriving' because we want {\em precise} control of ordering
300 (equality on @Uniques@ is v common).
303 eqUnique (MkUnique u1) (MkUnique u2) = u1 ==# u2
304 ltUnique (MkUnique u1) (MkUnique u2) = u1 <# u2
305 leUnique (MkUnique u1) (MkUnique u2) = u1 <=# u2
307 cmpUnique (MkUnique u1) (MkUnique u2)
308 = if u1 ==# u2 then EQ else if u1 <# u2 then LT else GT
310 instance Eq Unique where
311 a == b = eqUnique a b
312 a /= b = not (eqUnique a b)
314 instance Ord Unique where
316 a <= b = leUnique a b
317 a > b = not (leUnique a b)
318 a >= b = not (ltUnique a b)
319 compare a b = cmpUnique a b
322 instance Uniquable Unique where
326 We do sometimes make strings with @Uniques@ in them:
328 pprUnique, pprUnique10 :: Unique -> SDoc
331 = case unpkUnique uniq of
332 (tag, u) -> finish_ppr tag u (iToBase62 u)
334 pprUnique10 uniq -- in base-10, dudes
335 = case unpkUnique uniq of
336 (tag, u) -> finish_ppr tag u (int u)
338 finish_ppr 't' u pp_u | u < 26
339 = -- Special case to make v common tyvars, t1, t2, ...
340 -- come out as a, b, ... (shorter, easier to read)
341 char (chr (ord 'a' + u))
342 finish_ppr tag u pp_u = char tag <> pp_u
344 instance Outputable Unique where
347 instance Show Unique where
348 showsPrec p uniq = showsPrecSDoc p (pprUnique uniq)
351 %************************************************************************
353 \subsection[Utils-base62]{Base-62 numbers}
355 %************************************************************************
357 A character-stingy way to read/write numbers (notably Uniques).
358 The ``62-its'' are \tr{[0-9a-zA-Z]}. We don't handle negative Ints.
359 Code stolen from Lennart.
361 # define BYTE_ARRAY GlaExts.ByteArray
362 # define RUN_ST ST.runST
363 # define AND_THEN >>=
364 # define AND_THEN_ >>
365 # define RETURN return
367 iToBase62 :: Int -> SDoc
372 bytes = case chars62 of { BYTE_ARRAY bounds_who_needs_'em bytes -> bytes }
375 case (indexCharArray# bytes n#) of { c ->
378 case (quotRem n 62) of { (q, I# r#) ->
379 case (indexCharArray# bytes r#) of { c ->
380 (<>) (iToBase62 q) (char (C# c)) }}
382 -- keep this at top level! (bug on 94/10/24 WDP)
383 chars62 :: BYTE_ARRAY Int
386 newCharArray (0, 61) AND_THEN \ ch_array ->
387 fill_in ch_array 0 62 "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
389 unsafeFreezeByteArray ch_array
392 fill_in ch_array i lim str
396 = writeCharArray ch_array i (str !! i) AND_THEN_
397 fill_in ch_array (i+1) lim str
400 %************************************************************************
402 \subsection[Uniques-prelude]{@Uniques@ for wired-in Prelude things}
404 %************************************************************************
406 Allocation of unique supply characters:
407 v,t,u : for renumbering value-, type- and usage- vars.
408 other a-z: lower case chars for unique supplies (see Main.lhs)
410 C-E: pseudo uniques (used in native-code generator)
411 _: unifiable tyvars (above)
412 0-9: prelude things below
415 mkAlphaTyVarUnique i = mkUnique '1' i
417 mkPreludeClassUnique i = mkUnique '2' i
418 mkPreludeTyConUnique i = mkUnique '3' i
419 mkTupleTyConUnique a = mkUnique '4' a
420 mkUbxTupleTyConUnique a = mkUnique '5' a
422 mkPreludeDataConUnique i = mkUnique '6' i -- must be alphabetic
423 mkTupleDataConUnique a = mkUnique '7' a -- ditto (*may* be used in C labels)
424 mkUbxTupleDataConUnique a = mkUnique '8' a
426 mkPrimOpIdUnique op = mkUnique '9' op
427 mkPreludeMiscIdUnique i = mkUnique '0' i
429 -- The "tyvar uniques" print specially nicely: a, b, c, etc.
430 -- See pprUnique for details
432 initTyVarUnique :: Unique
433 initTyVarUnique = mkUnique 't' 0
435 initTidyUniques :: (Unique, Unique) -- Global and local
436 initTidyUniques = (mkUnique 'g' 0, mkUnique 'x' 0)
438 mkPseudoUnique1, mkPseudoUnique2, mkPseudoUnique3,
439 mkBuiltinUnique :: Int -> Unique
441 mkBuiltinUnique i = mkUnique 'B' i
442 mkPseudoUnique1 i = mkUnique 'C' i -- used for getUnique on Regs
443 mkPseudoUnique2 i = mkUnique 'D' i -- ditto
444 mkPseudoUnique3 i = mkUnique 'E' i -- ditto
446 getBuiltinUniques :: Int -> [Unique]
447 getBuiltinUniques n = map (mkUnique 'B') [1 .. n]
450 %************************************************************************
452 \subsubsection[Uniques-prelude-Classes]{@Uniques@ for wired-in @Classes@}
454 %************************************************************************
457 boundedClassKey = mkPreludeClassUnique 1
458 enumClassKey = mkPreludeClassUnique 2
459 eqClassKey = mkPreludeClassUnique 3
460 floatingClassKey = mkPreludeClassUnique 5
461 fractionalClassKey = mkPreludeClassUnique 6
462 integralClassKey = mkPreludeClassUnique 7
463 monadClassKey = mkPreludeClassUnique 8
464 monadPlusClassKey = mkPreludeClassUnique 9
465 functorClassKey = mkPreludeClassUnique 10
466 numClassKey = mkPreludeClassUnique 11
467 ordClassKey = mkPreludeClassUnique 12
468 readClassKey = mkPreludeClassUnique 13
469 realClassKey = mkPreludeClassUnique 14
470 realFloatClassKey = mkPreludeClassUnique 15
471 realFracClassKey = mkPreludeClassUnique 16
472 showClassKey = mkPreludeClassUnique 17
474 cCallableClassKey = mkPreludeClassUnique 18
475 cReturnableClassKey = mkPreludeClassUnique 19
477 ixClassKey = mkPreludeClassUnique 20
480 %************************************************************************
482 \subsubsection[Uniques-prelude-TyCons]{@Uniques@ for wired-in @TyCons@}
484 %************************************************************************
487 addrPrimTyConKey = mkPreludeTyConUnique 1
488 addrTyConKey = mkPreludeTyConUnique 2
489 arrayPrimTyConKey = mkPreludeTyConUnique 3
490 boolTyConKey = mkPreludeTyConUnique 4
491 byteArrayPrimTyConKey = mkPreludeTyConUnique 5
492 charPrimTyConKey = mkPreludeTyConUnique 7
493 charTyConKey = mkPreludeTyConUnique 8
494 doublePrimTyConKey = mkPreludeTyConUnique 9
495 doubleTyConKey = mkPreludeTyConUnique 10
496 floatPrimTyConKey = mkPreludeTyConUnique 11
497 floatTyConKey = mkPreludeTyConUnique 12
498 funTyConKey = mkPreludeTyConUnique 13
499 intPrimTyConKey = mkPreludeTyConUnique 14
500 intTyConKey = mkPreludeTyConUnique 15
501 int8TyConKey = mkPreludeTyConUnique 16
502 int16TyConKey = mkPreludeTyConUnique 17
503 int32TyConKey = mkPreludeTyConUnique 18
504 int64PrimTyConKey = mkPreludeTyConUnique 19
505 int64TyConKey = mkPreludeTyConUnique 20
506 integerTyConKey = mkPreludeTyConUnique 21
507 listTyConKey = mkPreludeTyConUnique 22
508 foreignObjPrimTyConKey = mkPreludeTyConUnique 23
509 foreignObjTyConKey = mkPreludeTyConUnique 24
510 weakPrimTyConKey = mkPreludeTyConUnique 25
511 mutableArrayPrimTyConKey = mkPreludeTyConUnique 26
512 mutableByteArrayPrimTyConKey = mkPreludeTyConUnique 27
513 orderingTyConKey = mkPreludeTyConUnique 28
514 mVarPrimTyConKey = mkPreludeTyConUnique 29
515 ratioTyConKey = mkPreludeTyConUnique 30
516 rationalTyConKey = mkPreludeTyConUnique 31
517 realWorldTyConKey = mkPreludeTyConUnique 32
518 stablePtrPrimTyConKey = mkPreludeTyConUnique 33
519 stablePtrTyConKey = mkPreludeTyConUnique 34
520 stateTyConKey = mkPreludeTyConUnique 50
521 statePrimTyConKey = mkPreludeTyConUnique 51
522 mutableByteArrayTyConKey = mkPreludeTyConUnique 52
523 mutVarPrimTyConKey = mkPreludeTyConUnique 53
524 ioTyConKey = mkPreludeTyConUnique 55
525 byteArrayTyConKey = mkPreludeTyConUnique 56
526 wordPrimTyConKey = mkPreludeTyConUnique 57
527 wordTyConKey = mkPreludeTyConUnique 58
528 word8TyConKey = mkPreludeTyConUnique 59
529 word16TyConKey = mkPreludeTyConUnique 60
530 word32TyConKey = mkPreludeTyConUnique 61
531 word64PrimTyConKey = mkPreludeTyConUnique 62
532 word64TyConKey = mkPreludeTyConUnique 63
533 boxedConKey = mkPreludeTyConUnique 64
534 unboxedConKey = mkPreludeTyConUnique 65
535 anyBoxConKey = mkPreludeTyConUnique 66
536 kindConKey = mkPreludeTyConUnique 67
537 boxityConKey = mkPreludeTyConUnique 68
538 typeConKey = mkPreludeTyConUnique 69
539 threadIdPrimTyConKey = mkPreludeTyConUnique 70
542 %************************************************************************
544 \subsubsection[Uniques-prelude-DataCons]{@Uniques@ for wired-in @DataCons@}
546 %************************************************************************
549 addrDataConKey = mkPreludeDataConUnique 1
550 charDataConKey = mkPreludeDataConUnique 2
551 consDataConKey = mkPreludeDataConUnique 3
552 doubleDataConKey = mkPreludeDataConUnique 4
553 falseDataConKey = mkPreludeDataConUnique 5
554 floatDataConKey = mkPreludeDataConUnique 6
555 intDataConKey = mkPreludeDataConUnique 7
556 int8DataConKey = mkPreludeDataConUnique 8
557 int16DataConKey = mkPreludeDataConUnique 9
558 int32DataConKey = mkPreludeDataConUnique 10
559 int64DataConKey = mkPreludeDataConUnique 11
560 integerDataConKey = mkPreludeDataConUnique 12
561 foreignObjDataConKey = mkPreludeDataConUnique 13
562 nilDataConKey = mkPreludeDataConUnique 14
563 ratioDataConKey = mkPreludeDataConUnique 15
564 stablePtrDataConKey = mkPreludeDataConUnique 16
565 stateDataConKey = mkPreludeDataConUnique 33
566 trueDataConKey = mkPreludeDataConUnique 34
567 wordDataConKey = mkPreludeDataConUnique 35
568 word8DataConKey = mkPreludeDataConUnique 36
569 word16DataConKey = mkPreludeDataConUnique 37
570 word32DataConKey = mkPreludeDataConUnique 38
571 word64DataConKey = mkPreludeDataConUnique 39
572 stDataConKey = mkPreludeDataConUnique 40
573 ioDataConKey = mkPreludeDataConUnique 42
576 %************************************************************************
578 \subsubsection[Uniques-prelude-Ids]{@Uniques@ for wired-in @Ids@ (except @DataCons@)}
580 %************************************************************************
583 absentErrorIdKey = mkPreludeMiscIdUnique 1
584 appendIdKey = mkPreludeMiscIdUnique 2
585 augmentIdKey = mkPreludeMiscIdUnique 3
586 buildIdKey = mkPreludeMiscIdUnique 4
587 errorIdKey = mkPreludeMiscIdUnique 5
588 foldlIdKey = mkPreludeMiscIdUnique 6
589 foldrIdKey = mkPreludeMiscIdUnique 7
590 recSelErrIdKey = mkPreludeMiscIdUnique 8
591 integerMinusOneIdKey = mkPreludeMiscIdUnique 9
592 integerPlusOneIdKey = mkPreludeMiscIdUnique 10
593 integerPlusTwoIdKey = mkPreludeMiscIdUnique 11
594 integerZeroIdKey = mkPreludeMiscIdUnique 12
595 int2IntegerIdKey = mkPreludeMiscIdUnique 13
596 addr2IntegerIdKey = mkPreludeMiscIdUnique 14
597 irrefutPatErrorIdKey = mkPreludeMiscIdUnique 15
598 lexIdKey = mkPreludeMiscIdUnique 16
599 noMethodBindingErrorIdKey = mkPreludeMiscIdUnique 17
600 nonExhaustiveGuardsErrorIdKey = mkPreludeMiscIdUnique 18
601 packCStringIdKey = mkPreludeMiscIdUnique 19
602 parErrorIdKey = mkPreludeMiscIdUnique 20
603 parIdKey = mkPreludeMiscIdUnique 21
604 patErrorIdKey = mkPreludeMiscIdUnique 22
605 realWorldPrimIdKey = mkPreludeMiscIdUnique 23
606 recConErrorIdKey = mkPreludeMiscIdUnique 24
607 recUpdErrorIdKey = mkPreludeMiscIdUnique 25
608 traceIdKey = mkPreludeMiscIdUnique 26
609 unpackCString2IdKey = mkPreludeMiscIdUnique 27
610 unpackCStringAppendIdKey = mkPreludeMiscIdUnique 28
611 unpackCStringFoldrIdKey = mkPreludeMiscIdUnique 29
612 unpackCStringIdKey = mkPreludeMiscIdUnique 30
613 ushowListIdKey = mkPreludeMiscIdUnique 31
614 unsafeCoerceIdKey = mkPreludeMiscIdUnique 32
615 concatIdKey = mkPreludeMiscIdUnique 33
616 filterIdKey = mkPreludeMiscIdUnique 34
617 zipIdKey = mkPreludeMiscIdUnique 35
618 bindIOIdKey = mkPreludeMiscIdUnique 36
619 deRefStablePtrIdKey = mkPreludeMiscIdUnique 37
620 makeStablePtrIdKey = mkPreludeMiscIdUnique 38
623 Certain class operations from Prelude classes. They get their own
624 uniques so we can look them up easily when we want to conjure them up
625 during type checking.
628 fromIntClassOpKey = mkPreludeMiscIdUnique 101
629 fromIntegerClassOpKey = mkPreludeMiscIdUnique 102
630 minusClassOpKey = mkPreludeMiscIdUnique 103
631 fromRationalClassOpKey = mkPreludeMiscIdUnique 104
632 enumFromClassOpKey = mkPreludeMiscIdUnique 105
633 enumFromThenClassOpKey = mkPreludeMiscIdUnique 106
634 enumFromToClassOpKey = mkPreludeMiscIdUnique 107
635 enumFromThenToClassOpKey = mkPreludeMiscIdUnique 108
636 eqClassOpKey = mkPreludeMiscIdUnique 109
637 geClassOpKey = mkPreludeMiscIdUnique 110
638 failMClassOpKey = mkPreludeMiscIdUnique 112
639 thenMClassOpKey = mkPreludeMiscIdUnique 113 -- (>>=)
640 -- Just a place holder for unbound variables produced by the renamer:
641 unboundKey = mkPreludeMiscIdUnique 114
642 fromEnumClassOpKey = mkPreludeMiscIdUnique 115
644 mainKey = mkPreludeMiscIdUnique 116
645 returnMClassOpKey = mkPreludeMiscIdUnique 117
646 otherwiseIdKey = mkPreludeMiscIdUnique 118
647 toEnumClassOpKey = mkPreludeMiscIdUnique 119
648 mapIdKey = mkPreludeMiscIdUnique 120
652 assertIdKey = mkPreludeMiscIdUnique 121