--<mkdependHS:friends> UniqSupply
module Unique (
- Unique,
+ Unique, Uniquable(..),
u2i, -- hack: used in UniqFM
pprUnique, pprUnique10, showUnique,
mkUniqueGrimily, -- Used in UniqSupply only!
incrUnique, -- Used for renumbering
- initRenumberingUniques,
+ initTyVarUnique, mkTyVarUnique,
+ initTidyUniques,
-- now all the built-in Uniques (and functions to make them)
-- [the Oh-So-Wonderful Haskell module system wins again...]
functorClassKey,
geClassOpKey,
gtDataConKey,
- iOTyConKey,
intDataConKey,
intPrimTyConKey,
intTyConKey,
liftTyConKey,
listTyConKey,
ltDataConKey,
+ mainKey,
+ minusClassOpKey,
monadClassKey,
monadPlusClassKey,
monadZeroClassKey,
numClassKey,
ordClassKey,
orderingTyConKey,
+ otherwiseIdKey,
packCStringIdKey,
parErrorIdKey,
parIdKey,
patErrorIdKey,
- primIoTyConKey,
ratioDataConKey,
ratioTyConKey,
rationalTyConKey,
return2GMPsTyConKey,
returnIntAndGMPDataConKey,
returnIntAndGMPTyConKey,
+ returnMClassOpKey,
runSTIdKey,
seqIdKey,
showClassKey,
showStringIdKey,
stTyConKey,
stDataConKey,
+ ioTyConKey,
+ ioDataConKey,
+ ioResultTyConKey,
+ ioOkDataConKey,
+ ioFailDataConKey,
stablePtrDataConKey,
stablePtrPrimTyConKey,
stablePtrTyConKey,
stateAndWordPrimDataConKey,
stateAndWordPrimTyConKey,
stateDataConKey,
+ stRetDataConKey,
statePrimTyConKey,
stateTyConKey,
+ stRetTyConKey,
synchVarPrimTyConKey,
thenMClassOpKey,
+ toEnumClassOpKey,
traceIdKey,
trueDataConKey,
unpackCString2IdKey,
, parGlobalIdKey
, parLocalIdKey
, unboundKey
+ , byteArrayTyConKey
+ , mutableByteArrayTyConKey
+ , allClassKey
) where
+#if __GLASGOW_HASKELL__ <= 201
import PreludeGlaST
+#else
+import GlaExts
+import ST
+import PrelBase ( Char(..), chr, ord )
+#endif
IMP_Ubiq(){-uitous-}
+import Outputable
import Pretty
import Util
\end{code}
Fast comparison is everything on @Uniques@:
\begin{code}
-u2i :: Unique -> FAST_INT
-
data Unique = MkUnique Int#
+
+class Uniquable a where
+ uniqueOf :: a -> Unique
+\end{code}
+
+\begin{code}
+u2i :: Unique -> FAST_INT
u2i (MkUnique i) = i
\end{code}
We do sometimes make strings with @Uniques@ in them:
\begin{code}
-pprUnique, pprUnique10 :: Unique -> Pretty
+pprUnique, pprUnique10 :: Unique -> Doc
pprUnique uniq
= case unpkUnique uniq of
pprUnique10 uniq -- in base-10, dudes
= case unpkUnique uniq of
- (tag, u) -> finish_ppr tag u (ppInt u)
-
-finish_ppr tag u pp_u
- = if tag /= 't' -- this is just to make v common tyvars, t1, t2, ...
- -- come out as a, b, ... (shorter, easier to read)
- then pp_all
- else case u of
- 1 -> ppChar 'a'
- 2 -> ppChar 'b'
- 3 -> ppChar 'c'
- 4 -> ppChar 'd'
- 5 -> ppChar 'e'
- _ -> pp_all
- where
- pp_all = ppBeside (ppChar tag) pp_u
+ (tag, u) -> finish_ppr tag u (int u)
+
+finish_ppr 't' u pp_u | u < 26
+ = -- Special case to make v common tyvars, t1, t2, ...
+ -- come out as a, b, ... (shorter, easier to read)
+ char (chr (ord 'a' + u))
+finish_ppr tag u pp_u = char tag <> pp_u
-showUnique :: Unique -> FAST_STRING
-showUnique uniq = _PK_ (ppShow 80 (pprUnique uniq))
+showUnique :: Unique -> String
+showUnique uniq = show (pprUnique uniq)
instance Outputable Unique where
ppr sty u = pprUnique u
instance Text Unique where
- showsPrec p uniq rest = _UNPK_ (showUnique uniq)
+ showsPrec p uniq rest = showUnique uniq
\end{code}
%************************************************************************
The ``62-its'' are \tr{[0-9a-zA-Z]}. We don't handle negative Ints.
Code stolen from Lennart.
\begin{code}
-#if __GLASGOW_HASKELL__ >= 200
+#if __GLASGOW_HASKELL__ == 201
# define BYTE_ARRAY GHCbase.ByteArray
# define RUN_ST GHCbase.runST
# define AND_THEN >>=
# define AND_THEN_ >>
# define RETURN return
+#elif __GLASGOW_HASKELL__ >= 202
+# define BYTE_ARRAY GlaExts.ByteArray
+# define RUN_ST ST.runST
+# define AND_THEN >>=
+# define AND_THEN_ >>
+# define RETURN return
#else
# define BYTE_ARRAY _ByteArray
# define RUN_ST _runST
# define RETURN returnStrictlyST
#endif
-iToBase62 :: Int -> Pretty
+iToBase62 :: Int -> Doc
iToBase62 n@(I# n#)
= ASSERT(n >= 0)
in
if n# <# 62# then
case (indexCharArray# bytes n#) of { c ->
- ppChar (C# c) }
+ char (C# c) }
else
case (quotRem n 62) of { (q, I# r#) ->
case (indexCharArray# bytes r#) of { c ->
- ppBeside (iToBase62 q) (ppChar (C# c)) }}
+ (<>) (iToBase62 q) (char (C# c)) }}
-- keep this at top level! (bug on 94/10/24 WDP)
chars62 :: BYTE_ARRAY Int
mkPrimOpIdUnique op = mkUnique '7' op
mkPreludeMiscIdUnique i = mkUnique '8' i
-initRenumberingUniques = (mkUnique 'v' 1, mkUnique 't' 1, mkUnique 'u' 1)
+-- The "tyvar uniques" print specially nicely: a, b, c, etc.
+-- See pprUnique for details
+
+initTyVarUnique :: Unique
+initTyVarUnique = mkUnique 't' 0
+
+mkTyVarUnique :: Int -> Unique
+mkTyVarUnique n = mkUnique 't' n
+
+initTidyUniques :: (Unique, Unique) -- Global and local
+initTidyUniques = (mkUnique 'g' 0, mkUnique 'x' 0)
mkPseudoUnique1, mkPseudoUnique2, mkPseudoUnique3,
mkBuiltinUnique :: Int -> Unique
cReturnableClassKey = mkPreludeClassUnique 20
ixClassKey = mkPreludeClassUnique 21
+allClassKey = mkPreludeClassUnique 22 -- Pseudo class used for universal quantification
\end{code}
%************************************************************************
floatPrimTyConKey = mkPreludeTyConUnique 11
floatTyConKey = mkPreludeTyConUnique 12
funTyConKey = mkPreludeTyConUnique 13
-iOTyConKey = mkPreludeTyConUnique 14
-intPrimTyConKey = mkPreludeTyConUnique 15
-intTyConKey = mkPreludeTyConUnique 16
-integerTyConKey = mkPreludeTyConUnique 17
-liftTyConKey = mkPreludeTyConUnique 18
-listTyConKey = mkPreludeTyConUnique 19
-foreignObjPrimTyConKey = mkPreludeTyConUnique 20
-foreignObjTyConKey = mkPreludeTyConUnique 21
-mutableArrayPrimTyConKey = mkPreludeTyConUnique 22
-mutableByteArrayPrimTyConKey = mkPreludeTyConUnique 23
-orderingTyConKey = mkPreludeTyConUnique 24
-synchVarPrimTyConKey = mkPreludeTyConUnique 25
-ratioTyConKey = mkPreludeTyConUnique 26
-rationalTyConKey = mkPreludeTyConUnique 27
-realWorldTyConKey = mkPreludeTyConUnique 28
-return2GMPsTyConKey = mkPreludeTyConUnique 29
-returnIntAndGMPTyConKey = mkPreludeTyConUnique 30
-stablePtrPrimTyConKey = mkPreludeTyConUnique 31
-stablePtrTyConKey = mkPreludeTyConUnique 32
-stateAndAddrPrimTyConKey = mkPreludeTyConUnique 33
-stateAndArrayPrimTyConKey = mkPreludeTyConUnique 34
-stateAndByteArrayPrimTyConKey = mkPreludeTyConUnique 35
-stateAndCharPrimTyConKey = mkPreludeTyConUnique 36
-stateAndDoublePrimTyConKey = mkPreludeTyConUnique 37
-stateAndFloatPrimTyConKey = mkPreludeTyConUnique 38
-stateAndIntPrimTyConKey = mkPreludeTyConUnique 39
-stateAndForeignObjPrimTyConKey = mkPreludeTyConUnique 40
-stateAndMutableArrayPrimTyConKey = mkPreludeTyConUnique 41
-stateAndMutableByteArrayPrimTyConKey = mkPreludeTyConUnique 42
-stateAndSynchVarPrimTyConKey = mkPreludeTyConUnique 43
-stateAndPtrPrimTyConKey = mkPreludeTyConUnique 44
-stateAndStablePtrPrimTyConKey = mkPreludeTyConUnique 45
-stateAndWordPrimTyConKey = mkPreludeTyConUnique 46
-statePrimTyConKey = mkPreludeTyConUnique 47
-stateTyConKey = mkPreludeTyConUnique 48
- -- 49 is spare
-stTyConKey = mkPreludeTyConUnique 50
-primIoTyConKey = mkPreludeTyConUnique 51
- -- 52 is spare
-wordPrimTyConKey = mkPreludeTyConUnique 53
-wordTyConKey = mkPreludeTyConUnique 54
-voidTyConKey = mkPreludeTyConUnique 55
+intPrimTyConKey = mkPreludeTyConUnique 14
+intTyConKey = mkPreludeTyConUnique 15
+integerTyConKey = mkPreludeTyConUnique 16
+liftTyConKey = mkPreludeTyConUnique 17
+listTyConKey = mkPreludeTyConUnique 18
+foreignObjPrimTyConKey = mkPreludeTyConUnique 19
+foreignObjTyConKey = mkPreludeTyConUnique 20
+mutableArrayPrimTyConKey = mkPreludeTyConUnique 21
+mutableByteArrayPrimTyConKey = mkPreludeTyConUnique 22
+orderingTyConKey = mkPreludeTyConUnique 23
+synchVarPrimTyConKey = mkPreludeTyConUnique 24
+ratioTyConKey = mkPreludeTyConUnique 25
+rationalTyConKey = mkPreludeTyConUnique 26
+realWorldTyConKey = mkPreludeTyConUnique 27
+return2GMPsTyConKey = mkPreludeTyConUnique 28
+returnIntAndGMPTyConKey = mkPreludeTyConUnique 29
+stablePtrPrimTyConKey = mkPreludeTyConUnique 30
+stablePtrTyConKey = mkPreludeTyConUnique 31
+stateAndAddrPrimTyConKey = mkPreludeTyConUnique 32
+stateAndArrayPrimTyConKey = mkPreludeTyConUnique 33
+stateAndByteArrayPrimTyConKey = mkPreludeTyConUnique 34
+stateAndCharPrimTyConKey = mkPreludeTyConUnique 35
+stateAndDoublePrimTyConKey = mkPreludeTyConUnique 36
+stateAndFloatPrimTyConKey = mkPreludeTyConUnique 37
+stateAndIntPrimTyConKey = mkPreludeTyConUnique 38
+stateAndForeignObjPrimTyConKey = mkPreludeTyConUnique 39
+stateAndMutableArrayPrimTyConKey = mkPreludeTyConUnique 40
+stateAndMutableByteArrayPrimTyConKey = mkPreludeTyConUnique 41
+stateAndSynchVarPrimTyConKey = mkPreludeTyConUnique 42
+stateAndPtrPrimTyConKey = mkPreludeTyConUnique 43
+stateAndStablePtrPrimTyConKey = mkPreludeTyConUnique 44
+stateAndWordPrimTyConKey = mkPreludeTyConUnique 45
+statePrimTyConKey = mkPreludeTyConUnique 46
+stateTyConKey = mkPreludeTyConUnique 47
+mutableByteArrayTyConKey = mkPreludeTyConUnique 48
+stTyConKey = mkPreludeTyConUnique 49
+stRetTyConKey = mkPreludeTyConUnique 50
+ioTyConKey = mkPreludeTyConUnique 51
+ioResultTyConKey = mkPreludeTyConUnique 52
+byteArrayTyConKey = mkPreludeTyConUnique 53
+wordPrimTyConKey = mkPreludeTyConUnique 54
+wordTyConKey = mkPreludeTyConUnique 55
+voidTyConKey = mkPreludeTyConUnique 56
\end{code}
%************************************************************************
trueDataConKey = mkPreludeDataConUnique 40
wordDataConKey = mkPreludeDataConUnique 41
stDataConKey = mkPreludeDataConUnique 42
+stRetDataConKey = mkPreludeDataConUnique 43
+ioDataConKey = mkPreludeDataConUnique 44
+ioOkDataConKey = mkPreludeDataConUnique 45
+ioFailDataConKey = mkPreludeDataConUnique 46
\end{code}
%************************************************************************
\begin{code}
fromIntClassOpKey = mkPreludeMiscIdUnique 53
fromIntegerClassOpKey = mkPreludeMiscIdUnique 54
-fromRationalClassOpKey = mkPreludeMiscIdUnique 55
-enumFromClassOpKey = mkPreludeMiscIdUnique 56
-enumFromThenClassOpKey = mkPreludeMiscIdUnique 57
-enumFromToClassOpKey = mkPreludeMiscIdUnique 58
-enumFromThenToClassOpKey= mkPreludeMiscIdUnique 59
-eqClassOpKey = mkPreludeMiscIdUnique 60
-geClassOpKey = mkPreludeMiscIdUnique 61
-zeroClassOpKey = mkPreludeMiscIdUnique 62
-thenMClassOpKey = mkPreludeMiscIdUnique 63 -- (>>=)
-unboundKey = mkPreludeMiscIdUnique 64 -- Just a place holder for unbound
+minusClassOpKey = mkPreludeMiscIdUnique 55
+fromRationalClassOpKey = mkPreludeMiscIdUnique 56
+enumFromClassOpKey = mkPreludeMiscIdUnique 57
+enumFromThenClassOpKey = mkPreludeMiscIdUnique 58
+enumFromToClassOpKey = mkPreludeMiscIdUnique 59
+enumFromThenToClassOpKey= mkPreludeMiscIdUnique 60
+eqClassOpKey = mkPreludeMiscIdUnique 61
+geClassOpKey = mkPreludeMiscIdUnique 62
+zeroClassOpKey = mkPreludeMiscIdUnique 63
+thenMClassOpKey = mkPreludeMiscIdUnique 64 -- (>>=)
+unboundKey = mkPreludeMiscIdUnique 65 -- Just a place holder for unbound
-- variables produced by the renamer
-fromEnumClassOpKey = mkPreludeMiscIdUnique 65
+fromEnumClassOpKey = mkPreludeMiscIdUnique 66
+
+mainKey = mkPreludeMiscIdUnique 67
+returnMClassOpKey = mkPreludeMiscIdUnique 68
+otherwiseIdKey = mkPreludeMiscIdUnique 69
+toEnumClassOpKey = mkPreludeMiscIdUnique 70
\end{code}
projects / ghc-hetmet.git / blobdiff