\begin{code}
module Unique (
- Unique, Uniquable(..),
+ Unique, Uniquable(..), hasKey,
u2i, -- hack: used in UniqFM
pprUnique, pprUnique10,
getKey, -- Used in Var only!
incrUnique, -- Used for renumbering
+ deriveUnique, -- Ditto
initTyVarUnique,
initTidyUniques,
+ isTupleKey,
+
-- now all the built-in Uniques (and functions to make them)
-- [the Oh-So-Wonderful Haskell module system wins again...]
mkAlphaTyVarUnique,
mkPrimOpIdUnique,
mkTupleDataConUnique,
- mkUbxTupleDataConUnique,
mkTupleTyConUnique,
- mkUbxTupleTyConUnique,
getBuiltinUniques, mkBuiltinUnique,
mkPseudoUnique1, mkPseudoUnique2, mkPseudoUnique3,
arrayPrimTyConKey,
assertIdKey,
augmentIdKey,
+ bindIOIdKey,
boolTyConKey,
boundedClassKey,
boxedConKey,
buildIdKey,
byteArrayPrimTyConKey,
+ byteArrayTyConKey,
cCallableClassKey,
cReturnableClassKey,
charDataConKey,
charTyConKey,
concatIdKey,
consDataConKey,
+ deRefStablePtrIdKey,
doubleDataConKey,
doublePrimTyConKey,
doubleTyConKey,
eqClassOpKey,
errorIdKey,
falseDataConKey,
+ failMClassOpKey,
filterIdKey,
floatDataConKey,
floatPrimTyConKey,
foreignObjDataConKey,
foreignObjPrimTyConKey,
foreignObjTyConKey,
- weakPrimTyConKey,
fractionalClassKey,
fromEnumClassOpKey,
fromIntClassOpKey,
funTyConKey,
functorClassKey,
geClassOpKey,
+ getTagIdKey,
intDataConKey,
intPrimTyConKey,
intTyConKey,
int8TyConKey,
- int8DataConKey,
int16TyConKey,
- int16DataConKey,
int32TyConKey,
- int32DataConKey,
- int64DataConKey,
int64PrimTyConKey,
int64TyConKey,
- integerDataConKey,
+ smallIntegerDataConKey,
+ largeIntegerDataConKey,
integerMinusOneIdKey,
integerPlusOneIdKey,
integerPlusTwoIdKey,
ixClassKey,
listTyConKey,
mainKey,
+ makeStablePtrIdKey,
mapIdKey,
minusClassOpKey,
monadClassKey,
monadPlusClassKey,
- monadZeroClassKey,
mutableArrayPrimTyConKey,
mutableByteArrayPrimTyConKey,
+ mutableByteArrayTyConKey,
mutVarPrimTyConKey,
nilDataConKey,
noMethodBindingErrorIdKey,
ordClassKey,
orderingTyConKey,
otherwiseIdKey,
- packCStringIdKey,
parErrorIdKey,
parIdKey,
patErrorIdKey,
recConErrorIdKey,
recSelErrIdKey,
recUpdErrorIdKey,
+ returnIOIdKey,
returnMClassOpKey,
+ runSTRepIdKey,
showClassKey,
ioTyConKey,
ioDataConKey,
stablePtrDataConKey,
stablePtrPrimTyConKey,
stablePtrTyConKey,
- stateDataConKey,
- stateTyConKey,
+ stableNameDataConKey,
+ stableNamePrimTyConKey,
+ stableNameTyConKey,
statePrimTyConKey,
typeConKey,
toEnumClassOpKey,
traceIdKey,
trueDataConKey,
+ unboundKey,
unboxedConKey,
unpackCString2IdKey,
unpackCStringAppendIdKey,
unpackCStringIdKey,
unsafeCoerceIdKey,
ushowListIdKey,
- voidIdKey,
- voidTyConKey,
+ weakPrimTyConKey,
wordDataConKey,
wordPrimTyConKey,
wordTyConKey,
word8TyConKey,
- word8DataConKey,
word16TyConKey,
- word16DataConKey,
word32TyConKey,
- word32DataConKey,
- word64DataConKey,
word64PrimTyConKey,
word64TyConKey,
- zeroClassOpKey,
- zipIdKey,
- bindIOIdKey,
- deRefStablePtrIdKey,
- makeStablePtrIdKey,
- unboundKey,
- byteArrayTyConKey,
- mutableByteArrayTyConKey
+ zipIdKey
) where
#include "HsVersions.h"
+import BasicTypes ( Boxity(..) )
import FastString ( FastString, uniqueOfFS )
import GlaExts
import ST
getKey :: Unique -> Int# -- for Var
incrUnique :: Unique -> Unique
+deriveUnique :: Unique -> Int -> Unique
+
+isTupleKey :: Unique -> Bool
\end{code}
incrUnique (MkUnique i) = MkUnique (i +# 1#)
+-- deriveUnique uses an 'X' tag so that it won't clash with
+-- any of the uniques produced any other way
+deriveUnique (MkUnique i) delta = mkUnique 'X' (I# i + delta)
+
-- pop the Char in the top 8 bits of the Unique(Supply)
-- No 64-bit bugs here, as long as we have at least 32 bits. --JSM
i2w_s x = (x::Int#)
mkUnique (C# c) (I# i)
- = MkUnique (w2i (((i2w (ord# c)) `shiftL#` (i2w_s 24#)) `or#` (i2w i)))
+ = MkUnique (w2i (tag `or#` bits))
+ where
+ tag = i2w (ord# c) `shiftL#` i2w_s 24#
+ bits = i2w i `and#` (i2w 16777215#){-``0x00ffffff''-}
unpkUnique (MkUnique u)
= let
tag = C# (chr# (w2i ((i2w u) `shiftr` (i2w_s 24#))))
- i = I# (w2i ((i2w u) `and#` (i2w 16777215#){-``0x00ffffff''-}))
+ i = I# (w2i ((i2w u) `and#` (i2w 16777215#){-``0x00ffffff''-}))
in
(tag, i)
where
class Uniquable a where
getUnique :: a -> Unique
+hasKey :: Uniquable a => a -> Unique -> Bool
+x `hasKey` k = getUnique x == k
+
instance Uniquable FastString where
getUnique fs = mkUniqueGrimily (uniqueOfFS fs)
iToBase62 n@(I# n#)
= ASSERT(n >= 0)
let
+#if __GLASGOW_HASKELL__ < 405
bytes = case chars62 of { BYTE_ARRAY bounds_who_needs_'em bytes -> bytes }
+#else
+ bytes = case chars62 of { BYTE_ARRAY _ _ bytes -> bytes }
+#endif
in
if n# <# 62# then
case (indexCharArray# bytes n#) of { c ->
other a-z: lower case chars for unique supplies (see Main.lhs)
B: builtin
C-E: pseudo uniques (used in native-code generator)
+ X: uniques derived by deriveUnique
_: unifiable tyvars (above)
0-9: prelude things below
mkPreludeClassUnique i = mkUnique '2' i
mkPreludeTyConUnique i = mkUnique '3' i
-mkTupleTyConUnique a = mkUnique '4' a
-mkUbxTupleTyConUnique a = mkUnique '5' a
+mkTupleTyConUnique Boxed a = mkUnique '4' a
+mkTupleTyConUnique Unboxed a = mkUnique '5' a
+
+-- Data constructor keys occupy *two* slots. The first is used for the
+-- data constructor itself and its wrapper function (the function that
+-- evaluates arguments as necessary and calls the worker). The second is
+-- used for the worker function (the function that builds the constructor
+-- representation).
+
+mkPreludeDataConUnique i = mkUnique '6' (2*i) -- Must be alphabetic
+mkTupleDataConUnique Boxed a = mkUnique '7' (2*a) -- ditto (*may* be used in C labels)
+mkTupleDataConUnique Unboxed a = mkUnique '8' (2*a)
-mkPreludeDataConUnique i = mkUnique '6' i -- must be alphabetic
-mkTupleDataConUnique a = mkUnique '7' a -- ditto (*may* be used in C labels)
-mkUbxTupleDataConUnique a = mkUnique '8' a
+-- This one is used for a tiresome reason
+-- to improve a consistency-checking error check in the renamer
+isTupleKey u = case unpkUnique u of
+ (tag,_) -> tag == '4' || tag == '5' || tag == '7' || tag == '8'
mkPrimOpIdUnique op = mkUnique '9' op
mkPreludeMiscIdUnique i = mkUnique '0' i
fractionalClassKey = mkPreludeClassUnique 6
integralClassKey = mkPreludeClassUnique 7
monadClassKey = mkPreludeClassUnique 8
-monadZeroClassKey = mkPreludeClassUnique 9
-monadPlusClassKey = mkPreludeClassUnique 10
-functorClassKey = mkPreludeClassUnique 11
-numClassKey = mkPreludeClassUnique 12
-ordClassKey = mkPreludeClassUnique 13
-readClassKey = mkPreludeClassUnique 14
-realClassKey = mkPreludeClassUnique 15
-realFloatClassKey = mkPreludeClassUnique 16
-realFracClassKey = mkPreludeClassUnique 17
-showClassKey = mkPreludeClassUnique 18
+monadPlusClassKey = mkPreludeClassUnique 9
+functorClassKey = mkPreludeClassUnique 10
+numClassKey = mkPreludeClassUnique 11
+ordClassKey = mkPreludeClassUnique 12
+readClassKey = mkPreludeClassUnique 13
+realClassKey = mkPreludeClassUnique 14
+realFloatClassKey = mkPreludeClassUnique 15
+realFracClassKey = mkPreludeClassUnique 16
+showClassKey = mkPreludeClassUnique 17
-cCallableClassKey = mkPreludeClassUnique 19
-cReturnableClassKey = mkPreludeClassUnique 20
+cCallableClassKey = mkPreludeClassUnique 18
+cReturnableClassKey = mkPreludeClassUnique 19
-ixClassKey = mkPreludeClassUnique 21
+ixClassKey = mkPreludeClassUnique 20
\end{code}
%************************************************************************
realWorldTyConKey = mkPreludeTyConUnique 32
stablePtrPrimTyConKey = mkPreludeTyConUnique 33
stablePtrTyConKey = mkPreludeTyConUnique 34
-stateTyConKey = mkPreludeTyConUnique 50
-statePrimTyConKey = mkPreludeTyConUnique 51
+statePrimTyConKey = mkPreludeTyConUnique 35
+stableNamePrimTyConKey = mkPreludeTyConUnique 50
+stableNameTyConKey = mkPreludeTyConUnique 51
mutableByteArrayTyConKey = mkPreludeTyConUnique 52
mutVarPrimTyConKey = mkPreludeTyConUnique 53
ioTyConKey = mkPreludeTyConUnique 55
word32TyConKey = mkPreludeTyConUnique 61
word64PrimTyConKey = mkPreludeTyConUnique 62
word64TyConKey = mkPreludeTyConUnique 63
-voidTyConKey = mkPreludeTyConUnique 64
-boxedConKey = mkPreludeTyConUnique 65
-unboxedConKey = mkPreludeTyConUnique 66
-anyBoxConKey = mkPreludeTyConUnique 67
-kindConKey = mkPreludeTyConUnique 68
-boxityConKey = mkPreludeTyConUnique 69
-typeConKey = mkPreludeTyConUnique 70
-threadIdPrimTyConKey = mkPreludeTyConUnique 71
+boxedConKey = mkPreludeTyConUnique 64
+unboxedConKey = mkPreludeTyConUnique 65
+anyBoxConKey = mkPreludeTyConUnique 66
+kindConKey = mkPreludeTyConUnique 67
+boxityConKey = mkPreludeTyConUnique 68
+typeConKey = mkPreludeTyConUnique 69
+threadIdPrimTyConKey = mkPreludeTyConUnique 70
\end{code}
%************************************************************************
%************************************************************************
\begin{code}
-addrDataConKey = mkPreludeDataConUnique 1
-charDataConKey = mkPreludeDataConUnique 2
-consDataConKey = mkPreludeDataConUnique 3
-doubleDataConKey = mkPreludeDataConUnique 4
-falseDataConKey = mkPreludeDataConUnique 5
-floatDataConKey = mkPreludeDataConUnique 6
-intDataConKey = mkPreludeDataConUnique 7
-int8DataConKey = mkPreludeDataConUnique 8
-int16DataConKey = mkPreludeDataConUnique 9
-int32DataConKey = mkPreludeDataConUnique 10
-int64DataConKey = mkPreludeDataConUnique 11
-integerDataConKey = mkPreludeDataConUnique 12
-foreignObjDataConKey = mkPreludeDataConUnique 13
-nilDataConKey = mkPreludeDataConUnique 14
-ratioDataConKey = mkPreludeDataConUnique 15
-stablePtrDataConKey = mkPreludeDataConUnique 16
-stateDataConKey = mkPreludeDataConUnique 33
-trueDataConKey = mkPreludeDataConUnique 34
-wordDataConKey = mkPreludeDataConUnique 35
-word8DataConKey = mkPreludeDataConUnique 36
-word16DataConKey = mkPreludeDataConUnique 37
-word32DataConKey = mkPreludeDataConUnique 38
-word64DataConKey = mkPreludeDataConUnique 39
-stDataConKey = mkPreludeDataConUnique 40
-ioDataConKey = mkPreludeDataConUnique 42
+addrDataConKey = mkPreludeDataConUnique 0
+charDataConKey = mkPreludeDataConUnique 1
+consDataConKey = mkPreludeDataConUnique 2
+doubleDataConKey = mkPreludeDataConUnique 3
+falseDataConKey = mkPreludeDataConUnique 4
+floatDataConKey = mkPreludeDataConUnique 5
+intDataConKey = mkPreludeDataConUnique 6
+smallIntegerDataConKey = mkPreludeDataConUnique 7
+largeIntegerDataConKey = mkPreludeDataConUnique 8
+foreignObjDataConKey = mkPreludeDataConUnique 9
+nilDataConKey = mkPreludeDataConUnique 10
+ratioDataConKey = mkPreludeDataConUnique 11
+stablePtrDataConKey = mkPreludeDataConUnique 12
+stableNameDataConKey = mkPreludeDataConUnique 13
+trueDataConKey = mkPreludeDataConUnique 14
+wordDataConKey = mkPreludeDataConUnique 15
+stDataConKey = mkPreludeDataConUnique 16
+ioDataConKey = mkPreludeDataConUnique 17
\end{code}
%************************************************************************
lexIdKey = mkPreludeMiscIdUnique 16
noMethodBindingErrorIdKey = mkPreludeMiscIdUnique 17
nonExhaustiveGuardsErrorIdKey = mkPreludeMiscIdUnique 18
-packCStringIdKey = mkPreludeMiscIdUnique 19
parErrorIdKey = mkPreludeMiscIdUnique 20
parIdKey = mkPreludeMiscIdUnique 21
patErrorIdKey = mkPreludeMiscIdUnique 22
unpackCStringAppendIdKey = mkPreludeMiscIdUnique 28
unpackCStringFoldrIdKey = mkPreludeMiscIdUnique 29
unpackCStringIdKey = mkPreludeMiscIdUnique 30
-voidIdKey = mkPreludeMiscIdUnique 31
-ushowListIdKey = mkPreludeMiscIdUnique 32
-unsafeCoerceIdKey = mkPreludeMiscIdUnique 33
-concatIdKey = mkPreludeMiscIdUnique 34
-filterIdKey = mkPreludeMiscIdUnique 35
-zipIdKey = mkPreludeMiscIdUnique 36
-bindIOIdKey = mkPreludeMiscIdUnique 37
+ushowListIdKey = mkPreludeMiscIdUnique 31
+unsafeCoerceIdKey = mkPreludeMiscIdUnique 32
+concatIdKey = mkPreludeMiscIdUnique 33
+filterIdKey = mkPreludeMiscIdUnique 34
+zipIdKey = mkPreludeMiscIdUnique 35
+bindIOIdKey = mkPreludeMiscIdUnique 36
+returnIOIdKey = mkPreludeMiscIdUnique 37
deRefStablePtrIdKey = mkPreludeMiscIdUnique 38
makeStablePtrIdKey = mkPreludeMiscIdUnique 39
+getTagIdKey = mkPreludeMiscIdUnique 40
\end{code}
Certain class operations from Prelude classes. They get their own
enumFromThenToClassOpKey = mkPreludeMiscIdUnique 108
eqClassOpKey = mkPreludeMiscIdUnique 109
geClassOpKey = mkPreludeMiscIdUnique 110
-zeroClassOpKey = mkPreludeMiscIdUnique 112
+failMClassOpKey = mkPreludeMiscIdUnique 112
thenMClassOpKey = mkPreludeMiscIdUnique 113 -- (>>=)
-- Just a place holder for unbound variables produced by the renamer:
unboundKey = mkPreludeMiscIdUnique 114
\begin{code}
assertIdKey = mkPreludeMiscIdUnique 121
+runSTRepIdKey = mkPreludeMiscIdUnique 122
\end{code}
projects / ghc-hetmet.git / blobdiff