-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1995
-%
-\section[Unique]{The @Unique@ data type and a (monadic) supply thereof}
+
@Uniques@ are used to distinguish entities in the compiler (@Ids@,
@Classes@, etc.) from each other. Thus, @Uniques@ are the basic
Haskell).
\begin{code}
-#include "HsVersions.h"
-
module Unique (
- Unique,
- UniqueSupply, -- abstract types
+ Unique, Uniquable(..),
u2i, -- hack: used in UniqFM
- getUnique, getUniques, -- basic ops
- eqUnique, cmpUnique, -- comparison is everything!
-
---not exported: mkUnique, unpkUnique,
- mkUniqueGrimily, -- use in SplitUniq only!
- mkUniqueSupplyGrimily, -- ditto! (but FALSE: WDP 95/01)
- mkUnifiableTyVarUnique,
- unpkUnifiableTyVarUnique,
- showUnique, pprUnique, pprUnique10,
-
- UniqSM(..), -- type: unique supply monad
- initUs, thenUs, returnUs,
- mapUs, mapAndUnzipUs,
-
- -- the pre-defined unique supplies:
-{- NOT exported:
- uniqSupply_r, uniqSupply_t, uniqSupply_d,
- uniqSupply_s, uniqSupply_c, uniqSupply_T,
- uniqSupply_f,
- uniqSupply_P,
--}
- uniqSupply_u,
-#ifdef DPH
- -- otherwise, not exported
- uniqSupply_p, uniqSupply_S, uniqSupply_L,
-#endif
-
- -- and the access functions for the `builtin' UniqueSupply
- getBuiltinUniques, mkBuiltinUnique, runBuiltinUs,
- mkPseudoUnique1, mkPseudoUnique2, mkPseudoUnique3,
+
+ pprUnique, pprUnique10, showUnique,
+
+ mkUnique, -- Used in UniqSupply
+ mkUniqueGrimily, -- Used in UniqSupply only!
+
+ incrUnique, -- Used for renumbering
+ initTyVarUnique, mkTyVarUnique,
+ initTidyUniques,
-- now all the built-in Uniques (and functions to make them)
-- [the Oh-So-Wonderful Haskell module system wins again...]
+ mkAlphaTyVarUnique,
mkPrimOpIdUnique,
mkTupleDataConUnique,
+ mkTupleTyConUnique,
- absentErrorIdKey,
- runSTIdKey, realWorldPrimIdKey,
+ getBuiltinUniques, mkBuiltinUnique,
+ mkPseudoUnique1, mkPseudoUnique2, mkPseudoUnique3,
+
+ absentErrorIdKey, -- alphabetical...
+ addrDataConKey,
+ addrPrimTyConKey,
+ addrTyConKey,
+ andandIdKey,
+ appendIdKey,
arrayPrimTyConKey,
- byteArrayPrimTyConKey, --UNUSED: byteArrayDataConKey, byteArrayTyConKey,
- binaryClassKey,
- boolTyConKey, buildDataConKey, buildIdKey, charDataConKey,
- charPrimTyConKey, charTyConKey, cmpTagTyConKey,
+ assertIdKey,
+ augmentIdKey,
+ boolTyConKey,
+ boundedClassKey,
+ buildDataConKey,
+ buildIdKey,
+ byteArrayPrimTyConKey,
+ cCallableClassKey,
+ cReturnableClassKey,
+ charDataConKey,
+ charPrimTyConKey,
+ charTyConKey,
+ coerceIdKey,
+ composeIdKey,
consDataConKey,
- dialogueTyConKey,
doubleDataConKey,
doublePrimTyConKey,
doubleTyConKey,
- enumClassKey, eqClassKey,
- eqTagDataConKey, errorIdKey,
- falseDataConKey, floatDataConKey,
- floatPrimTyConKey, floatTyConKey, floatingClassKey,
- foldlIdKey, foldrIdKey,
+ enumClassKey,
+ enumFromClassOpKey,
+ enumFromThenClassOpKey,
+ enumFromThenToClassOpKey,
+ enumFromToClassOpKey,
+ eqClassKey,
+ eqClassOpKey,
+ eqDataConKey,
+ errorIdKey,
+ evalClassKey,
+ falseDataConKey,
+ floatDataConKey,
+ floatPrimTyConKey,
+ floatTyConKey,
+ floatingClassKey,
+ foldlIdKey,
+ foldrIdKey,
+ foreignObjDataConKey,
+ foreignObjPrimTyConKey,
+ foreignObjTyConKey,
forkIdKey,
fractionalClassKey,
- gtTagDataConKey, --UNUSED: iOErrorTyConKey,
---UNUSED: iOIntPrimTyConKey, -- UNUSED: int2IntegerIdKey,
- iOTyConKey,
+ fromEnumClassOpKey,
+ fromIntClassOpKey,
+ fromIntegerClassOpKey,
+ fromRationalClassOpKey,
+ funTyConKey,
+ functorClassKey,
+ geClassOpKey,
+ gtDataConKey,
+ inlineIdKey,
intDataConKey,
- wordPrimTyConKey, wordTyConKey, wordDataConKey,
- addrPrimTyConKey, addrTyConKey, addrDataConKey,
- intPrimTyConKey, intTyConKey,
- integerDataConKey, integerTyConKey, integralClassKey,
+ intPrimTyConKey,
+ intTyConKey,
+ integerDataConKey,
+ integerMinusOneIdKey,
+ integerPlusOneIdKey,
+ integerPlusTwoIdKey,
+ integerTyConKey,
+ integerZeroIdKey,
+ integralClassKey,
+ irrefutPatErrorIdKey,
ixClassKey,
---UNUSED: lexIdKey,
- liftDataConKey, liftTyConKey, listTyConKey,
- ltTagDataConKey,
- mutableArrayPrimTyConKey, -- UNUSED: mutableArrayDataConKey, mutableArrayTyConKey,
- mutableByteArrayPrimTyConKey, -- UNUSED: mutableByteArrayDataConKey,
---UNUSED: mutableByteArrayTyConKey,
- synchVarPrimTyConKey,
- nilDataConKey, numClassKey, ordClassKey,
- parIdKey, parErrorIdKey,
-#ifdef GRAN
- parGlobalIdKey, parLocalIdKey, copyableIdKey, noFollowIdKey,
-#endif
+ lexIdKey,
+ liftDataConKey,
+ liftTyConKey,
+ listTyConKey,
+ ltDataConKey,
+ mainKey,
+ minusClassOpKey,
+ monadClassKey,
+ monadPlusClassKey,
+ monadZeroClassKey,
+ mutableArrayPrimTyConKey,
+ mutableByteArrayPrimTyConKey,
+ nilDataConKey,
+ noMethodBindingErrorIdKey,
+ nonExhaustiveGuardsErrorIdKey,
+ notIdKey,
+ numClassKey,
+ ordClassKey,
+ orderingTyConKey,
+ otherwiseIdKey,
+ packCStringIdKey,
+ parErrorIdKey,
+ parIdKey,
patErrorIdKey,
- ratioDataConKey, ratioTyConKey,
+ ratioDataConKey,
+ ratioTyConKey,
rationalTyConKey,
---UNUSED: readParenIdKey,
- realClassKey, realFloatClassKey,
+ readClassKey,
+ readParenIdKey,
+ realClassKey,
+ realFloatClassKey,
realFracClassKey,
---UNUSED: requestTyConKey, responseTyConKey,
- return2GMPsDataConKey, return2GMPsTyConKey,
- returnIntAndGMPDataConKey, returnIntAndGMPTyConKey,
- seqIdKey, -- UNUSED: seqIntPrimTyConKey,
---UNUSED: seqTyConKey,
---UNUSED: showParenIdKey,
---UNUSED: showSpaceIdKey,
- statePrimTyConKey, stateTyConKey, stateDataConKey,
- voidPrimTyConKey,
+ realWorldPrimIdKey,
realWorldTyConKey,
- stablePtrPrimTyConKey, stablePtrTyConKey, stablePtrDataConKey,
- mallocPtrPrimTyConKey, mallocPtrTyConKey, mallocPtrDataConKey,
- stateAndPtrPrimTyConKey,
- stateAndPtrPrimDataConKey,
- stateAndCharPrimTyConKey,
- stateAndCharPrimDataConKey,
- stateAndIntPrimTyConKey,
- stateAndIntPrimDataConKey,
- stateAndWordPrimTyConKey,
- stateAndWordPrimDataConKey,
- stateAndAddrPrimTyConKey,
+ recConErrorIdKey,
+ recSelErrIdKey,
+ recUpdErrorIdKey,
+ return2GMPsDataConKey,
+ return2GMPsTyConKey,
+ returnIntAndGMPDataConKey,
+ returnIntAndGMPTyConKey,
+ returnMClassOpKey,
+ seqIdKey,
+ showClassKey,
+ showParenIdKey,
+ showSpaceIdKey,
+ showStringIdKey,
+ stTyConKey,
+ stDataConKey,
+ ioTyConKey,
+ ioDataConKey,
+ ioResultTyConKey,
+ ioOkDataConKey,
+ ioFailDataConKey,
+ stablePtrDataConKey,
+ stablePtrPrimTyConKey,
+ stablePtrTyConKey,
stateAndAddrPrimDataConKey,
- stateAndStablePtrPrimTyConKey,
- stateAndStablePtrPrimDataConKey,
- stateAndMallocPtrPrimTyConKey,
- stateAndMallocPtrPrimDataConKey,
- stateAndFloatPrimTyConKey,
- stateAndFloatPrimDataConKey,
- stateAndDoublePrimTyConKey,
- stateAndDoublePrimDataConKey,
- stateAndArrayPrimTyConKey,
+ stateAndAddrPrimTyConKey,
stateAndArrayPrimDataConKey,
- stateAndMutableArrayPrimTyConKey,
- stateAndMutableArrayPrimDataConKey,
- stateAndByteArrayPrimTyConKey,
+ stateAndArrayPrimTyConKey,
stateAndByteArrayPrimDataConKey,
- stateAndMutableByteArrayPrimTyConKey,
+ stateAndByteArrayPrimTyConKey,
+ stateAndCharPrimDataConKey,
+ stateAndCharPrimTyConKey,
+ stateAndDoublePrimDataConKey,
+ stateAndDoublePrimTyConKey,
+ stateAndFloatPrimDataConKey,
+ stateAndFloatPrimTyConKey,
+ stateAndForeignObjPrimDataConKey,
+ stateAndForeignObjPrimTyConKey,
+ stateAndIntPrimDataConKey,
+ stateAndIntPrimTyConKey,
+ stateAndMutableArrayPrimDataConKey,
+ stateAndMutableArrayPrimTyConKey,
stateAndMutableByteArrayPrimDataConKey,
- stateAndSynchVarPrimTyConKey,
+ stateAndMutableByteArrayPrimTyConKey,
+ stateAndPtrPrimDataConKey,
+ stateAndPtrPrimTyConKey,
+ stateAndStablePtrPrimDataConKey,
+ stateAndStablePtrPrimTyConKey,
stateAndSynchVarPrimDataConKey,
- stringTyConKey,
- stTyConKey, primIoTyConKey,
---UNUSED: ioResultTyConKey,
- textClassKey,
+ stateAndSynchVarPrimTyConKey,
+ stateAndWordPrimDataConKey,
+ stateAndWordPrimTyConKey,
+ stateDataConKey,
+ stRetDataConKey,
+ statePrimTyConKey,
+ stateTyConKey,
+ stRetTyConKey,
+ synchVarPrimTyConKey,
+ thenMClassOpKey,
+ toEnumClassOpKey,
traceIdKey,
trueDataConKey,
- unpackCStringIdKey, unpackCString2IdKey, unpackCStringAppendIdKey,
- packCStringIdKey,
- integerZeroIdKey, integerPlusOneIdKey,
- integerPlusTwoIdKey, integerMinusOneIdKey,
- voidPrimIdKey,
- cCallableClassKey,
- cReturnableClassKey,
---UNUSED: packedStringTyConKey, psDataConKey, cpsDataConKey,
-
- -- to make interface self-sufficient
- PrimOp, SplitUniqSupply, CSeq
-
-#ifndef __GLASGOW_HASKELL__
- , TAG_
-#endif
+ unpackCString2IdKey,
+ unpackCStringAppendIdKey,
+ unpackCStringFoldrIdKey,
+ unpackCStringIdKey,
+ ureadListIdKey,
+ ushowListIdKey,
+ voidIdKey,
+ voidTyConKey,
+ wordDataConKey,
+ wordPrimTyConKey,
+ wordTyConKey,
+ zeroClassOpKey
+ , copyableIdKey
+ , noFollowIdKey
+ , parAtAbsIdKey
+ , parAtForNowIdKey
+ , parAtIdKey
+ , parAtRelIdKey
+ , parGlobalIdKey
+ , parLocalIdKey
+ , unboundKey
+ , byteArrayTyConKey
+ , mutableByteArrayTyConKey
+ , allClassKey
) where
-import Outputable -- class for printing, forcing
-import Pretty
-import PrimOps -- ** DIRECTLY **
-import SplitUniq
-import Util
+#include "HsVersions.h"
-#ifndef __GLASGOW_HASKELL__
-{-hide import from mkdependHS-}
-import
- Word
-#endif
-#ifdef __GLASGOW_HASKELL__
-import PreludeGlaST
-#endif
+import FastString ( uniqueOfFS )
+import GlaExts
+import ST
+import PrelBase ( Char(..), chr, ord )
-infixr 9 `thenUs`
+import Outputable
+import Util
\end{code}
%************************************************************************
Fast comparison is everything on @Uniques@:
\begin{code}
-u2i :: Unique -> FAST_INT
-
-#ifdef __GLASGOW_HASKELL__
-
data Unique = MkUnique Int#
-u2i (MkUnique i) = i
-
-#else
-
-data Unique = MkUnique Word{-#STRICT#-}
-u2i (MkUnique w) = wordToInt w
+\end{code}
-#endif
+\begin{code}
+u2i :: Unique -> FAST_INT
+u2i (MkUnique i) = i
\end{code}
Now come the functions which construct uniques from their pieces, and vice versa.
The stuff about unique *supplies* is handled further down this module.
\begin{code}
-mkUnique :: Char -> Int -> Unique -- Builds a unique from pieces
-unpkUnique :: Unique -> (Char, Int) -- The reverse
+mkUnique :: Char -> Int -> Unique -- Builds a unique from pieces
+unpkUnique :: Unique -> (Char, Int) -- The reverse
-mkUnifiableTyVarUnique :: Int -> Unique -- Injects a subst-array index into the Unique type
-unpkUnifiableTyVarUnique :: Unique -> Int -- The reverse process
+mkUniqueGrimily :: Int# -> Unique -- A trap-door for UniqSupply
-#ifdef __GLASGOW_HASKELL__
-mkUniqueGrimily :: Int# -> Unique -- A trap-door for SplitUniq
-#else
-mkUniqueGrimily :: Int -> Unique
-#endif
+incrUnique :: Unique -> Unique
\end{code}
\begin{code}
-#ifdef __GLASGOW_HASKELL__
mkUniqueGrimily x = MkUnique x
-#else
-mkUniqueGrimily x = MkUnique (fromInteger (toInteger x))
-#endif
-mkUnifiableTyVarUnique i = mkUnique '_'{-MAGIC CHAR-} i
-
-unpkUnifiableTyVarUnique uniq
- = case (unpkUnique uniq) of { (tag, i) ->
- ASSERT(tag == '_'{-MAGIC CHAR-})
- i }
+incrUnique (MkUnique i) = MkUnique (i +# 1#)
-- pop the Char in the top 8 bits of the Unique(Supply)
-#ifdef __GLASGOW_HASKELL__
-
-- No 64-bit bugs here, as long as we have at least 32 bits. --JSM
w2i x = word2Int# x
i2w x = int2Word# x
i2w_s x = (x::Int#)
-mkUnique (MkChar c#) (MkInt i#)
- = MkUnique (w2i (((i2w (ord# c#)) `shiftL#` (i2w_s 24#)) `or#` (i2w i#)))
+mkUnique (C# c) (I# i)
+ = MkUnique (w2i (((i2w (ord# c)) `shiftL#` (i2w_s 24#)) `or#` (i2w i)))
unpkUnique (MkUnique u)
= let
- tag = MkChar (chr# (w2i ((i2w u) `shiftr` (i2w_s 24#))))
- i = MkInt (w2i ((i2w u) `and#` (i2w 16777215#){-``0x00ffffff''-}))
+ tag = C# (chr# (w2i ((i2w u) `shiftr` (i2w_s 24#))))
+ i = I# (w2i ((i2w u) `and#` (i2w 16777215#){-``0x00ffffff''-}))
in
(tag, i)
-# if __GLASGOW_HASKELL__ >= 23
where
shiftr x y = shiftRA# x y
-# else
- shiftr x y = shiftR# x y
-# endif
+\end{code}
-#else {-probably HBC-}
-mkUnique c i
- = MkUnique (((fromInt (ord c)) `bitLsh` 24) `bitOr` (fromInt i))
-unpkUnique (MkUnique u)
- = let
- tag = chr (wordToInt (u `bitRsh` 24))
- i = wordToInt (u `bitAnd` 16777215 {-0x00ffffff-})
- in
- (tag, i)
+%************************************************************************
+%* *
+\subsection[Uniquable-class]{The @Uniquable@ class}
+%* *
+%************************************************************************
+
+\begin{code}
+class Uniquable a where
+ uniqueOf :: a -> Unique
-#endif {-probably HBC-}
+instance Uniquable FastString where
+ uniqueOf fs = mkUniqueGrimily (uniqueOfFS fs)
+
+instance Uniquable Int where
+ uniqueOf (I# i#) = mkUniqueGrimily i#
\end{code}
+
%************************************************************************
%* *
\subsection[Unique-instances]{Instance declarations for @Unique@}
(equality on @Uniques@ is v common).
\begin{code}
-#ifdef __GLASGOW_HASKELL__
-
-{-# INLINE eqUnique #-} -- this is Hammered City here...
-{-# INLINE cmpUnique #-}
-
eqUnique (MkUnique u1) (MkUnique u2) = u1 ==# u2
ltUnique (MkUnique u1) (MkUnique u2) = u1 <# u2
leUnique (MkUnique u1) (MkUnique u2) = u1 <=# u2
cmpUnique (MkUnique u1) (MkUnique u2)
- = if u1 ==# u2 then EQ_ else if u1 <# u2 then LT_ else GT_
-
-#else
-eqUnique (MkUnique u1) (MkUnique u2) = u1 == u2
-ltUnique (MkUnique u1) (MkUnique u2) = u1 < u2
-leUnique (MkUnique u1) (MkUnique u2) = u1 <= u2
-
-cmpUnique (MkUnique u1) (MkUnique u2)
- = if u1 == u2 then EQ_ else if u1 < u2 then LT_ else GT_
-#endif
+ = if u1 ==# u2 then EQ else if u1 <# u2 then LT else GT
instance Eq Unique where
a == b = eqUnique a b
a <= b = leUnique a b
a > b = not (leUnique a b)
a >= b = not (ltUnique a b)
-#ifdef __GLASGOW_HASKELL__
- _tagCmp a b = case cmpUnique a b of { LT_ -> _LT; EQ_ -> _EQ; GT__ -> _GT }
-#endif
-\end{code}
+ compare a b = cmpUnique a b
-And for output:
-\begin{code}
-{- OLD:
-instance Outputable Unique where
- ppr any_style uniq
- = case unpkUnique uniq of
- (tag, u) -> ppStr (tag : iToBase62 u)
--}
+-----------------
+instance Uniquable Unique where
+ uniqueOf u = u
\end{code}
We do sometimes make strings with @Uniques@ in them:
\begin{code}
-pprUnique, pprUnique10 :: Unique -> Pretty
+pprUnique, pprUnique10 :: Unique -> SDoc
pprUnique uniq
= case unpkUnique uniq of
- (tag, u) -> ppBeside (ppChar tag) (iToBase62 u)
+ (tag, u) -> finish_ppr tag u (iToBase62 u)
pprUnique10 uniq -- in base-10, dudes
= case unpkUnique uniq of
- (tag, u) -> ppBeside (ppChar tag) (ppInt 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 -> String
+showUnique uniq = showSDoc (pprUnique uniq)
-showUnique :: Unique -> FAST_STRING
-showUnique uniq = _PK_ (ppShow 80 (pprUnique uniq))
+instance Outputable Unique where
+ ppr u = pprUnique u
instance Text Unique where
- showsPrec p uniq rest = _UNPK_ (showUnique uniq)
- readsPrec p = panic "no readsPrec for Unique"
+ 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}
-iToBase62 :: Int -> Pretty
+# define BYTE_ARRAY GlaExts.ByteArray
+# define RUN_ST ST.runST
+# define AND_THEN >>=
+# define AND_THEN_ >>
+# define RETURN return
+
+iToBase62 :: Int -> SDoc
-#ifdef __GLASGOW_HASKELL__
iToBase62 n@(I# n#)
= ASSERT(n >= 0)
let
- bytes = case chars62 of { _ByteArray bounds_who_needs_'em bytes -> bytes }
+ bytes = case chars62 of { BYTE_ARRAY bounds_who_needs_'em bytes -> bytes }
in
- if n# <# 62# then
+ 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 :: _ByteArray Int
+chars62 :: BYTE_ARRAY Int
chars62
- = _runST (
- newCharArray (0, 61) `thenStrictlyST` \ ch_array ->
+ = RUN_ST (
+ newCharArray (0, 61) AND_THEN \ ch_array ->
fill_in ch_array 0 62 "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
- `seqStrictlyST`
+ AND_THEN_
unsafeFreezeByteArray ch_array
)
where
fill_in ch_array i lim str
| i == lim
- = returnStrictlyST ()
+ = RETURN ()
| otherwise
- = writeCharArray ch_array i (str !! i) `seqStrictlyST`
+ = writeCharArray ch_array i (str !! i) AND_THEN_
fill_in ch_array (i+1) lim str
-
-#else {- not GHC -}
-iToBase62 n
- = ASSERT(n >= 0)
- if n < 62 then
- ppChar (chars62 ! n)
- else
- case (quotRem n 62) of { (q, r) ->
- ppBeside (iToBase62 q) (ppChar (chars62 ! r)) }
-
--- keep this at top level! (bug on 94/10/24 WDP)
-chars62 :: Array Int Char
-chars62
- = array (0,61) (zipWith (:=) [0..] "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ")
-#endif {- not GHC -}
\end{code}
%************************************************************************
%* *
%************************************************************************
+Allocation of unique supply characters:
+ v,t,u : for renumbering value-, type- and usage- vars.
+ other a-z: lower case chars for unique supplies (see Main.lhs)
+ B: builtin
+ C-E: pseudo uniques (used in native-code generator)
+ _: unifiable tyvars (above)
+ 1-8: prelude things below
+
\begin{code}
-mkPreludeClassUnique i = mkUnique '1' i
-mkPreludeTyConUnique i = mkUnique '2' i
-mkPreludeDataConUnique i = mkUnique 'Y' i -- must be alphabetic
-mkTupleDataConUnique i = mkUnique 'Z' i -- ditto (*may* be used in C labels)
--- mkPrimOpIdUnique op: see below (uses '5')
-mkPreludeMiscIdUnique i = mkUnique '7' i
+mkAlphaTyVarUnique i = mkUnique '1' i
+
+mkPreludeClassUnique i = mkUnique '2' i
+mkPreludeTyConUnique i = mkUnique '3' i
+mkTupleTyConUnique a = mkUnique '4' a
+
+mkPreludeDataConUnique i = mkUnique '5' i -- must be alphabetic
+mkTupleDataConUnique a = mkUnique '6' a -- ditto (*may* be used in C labels)
+
+mkPrimOpIdUnique op = mkUnique '7' op
+mkPreludeMiscIdUnique i = mkUnique '8' i
+
+-- 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
+
+mkBuiltinUnique i = mkUnique 'B' i
+mkPseudoUnique1 i = mkUnique 'C' i -- used for uniqueOf on Regs
+mkPseudoUnique2 i = mkUnique 'D' i -- ditto
+mkPseudoUnique3 i = mkUnique 'E' i -- ditto
+
+getBuiltinUniques :: Int -> [Unique]
+getBuiltinUniques n = map (mkUnique 'B') [1 .. n]
\end{code}
%************************************************************************
%************************************************************************
\begin{code}
-eqClassKey = mkPreludeClassUnique 1
-ordClassKey = mkPreludeClassUnique 2
-numClassKey = mkPreludeClassUnique 3
-integralClassKey = mkPreludeClassUnique 4
-fractionalClassKey = mkPreludeClassUnique 5
-floatingClassKey = mkPreludeClassUnique 6
-realClassKey = mkPreludeClassUnique 7
-realFracClassKey = mkPreludeClassUnique 8
-realFloatClassKey = mkPreludeClassUnique 9
-ixClassKey = mkPreludeClassUnique 10
-enumClassKey = mkPreludeClassUnique 11
-textClassKey = mkPreludeClassUnique 12
-binaryClassKey = mkPreludeClassUnique 13
-cCallableClassKey = mkPreludeClassUnique 14
-cReturnableClassKey = mkPreludeClassUnique 15
-#ifdef DPH
-pidClassKey = mkPreludeClassUnique 16
-processorClassKey = mkPreludeClassUnique 17
-#endif {- Data Parallel Haskell -}
+boundedClassKey = mkPreludeClassUnique 1
+enumClassKey = mkPreludeClassUnique 2
+eqClassKey = mkPreludeClassUnique 3
+evalClassKey = mkPreludeClassUnique 4
+floatingClassKey = mkPreludeClassUnique 5
+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
+
+cCallableClassKey = mkPreludeClassUnique 19
+cReturnableClassKey = mkPreludeClassUnique 20
+
+ixClassKey = mkPreludeClassUnique 21
+allClassKey = mkPreludeClassUnique 22 -- Pseudo class used for universal quantification
\end{code}
%************************************************************************
arrayPrimTyConKey = mkPreludeTyConUnique 3
boolTyConKey = mkPreludeTyConUnique 4
byteArrayPrimTyConKey = mkPreludeTyConUnique 5
---UNUSED:byteArrayTyConKey = mkPreludeTyConUnique 6
charPrimTyConKey = mkPreludeTyConUnique 7
charTyConKey = mkPreludeTyConUnique 8
-cmpTagTyConKey = mkPreludeTyConUnique 9
-dialogueTyConKey = mkPreludeTyConUnique 10
-doublePrimTyConKey = mkPreludeTyConUnique 11
-doubleTyConKey = mkPreludeTyConUnique 12
-floatPrimTyConKey = mkPreludeTyConUnique 13
-floatTyConKey = mkPreludeTyConUnique 14
---UNUSED:iOErrorTyConKey = mkPreludeTyConUnique 14
---UNUSED:iOIntPrimTyConKey = mkPreludeTyConUnique 15
-iOTyConKey = mkPreludeTyConUnique 16
-intPrimTyConKey = mkPreludeTyConUnique 17
-intTyConKey = mkPreludeTyConUnique 18
-integerTyConKey = mkPreludeTyConUnique 19
-liftTyConKey = mkPreludeTyConUnique 20
-listTyConKey = mkPreludeTyConUnique 21
-mallocPtrPrimTyConKey = mkPreludeTyConUnique 22
-mallocPtrTyConKey = mkPreludeTyConUnique 23
-mutableArrayPrimTyConKey = mkPreludeTyConUnique 24
---UNUSED:mutableArrayTyConKey = mkPreludeTyConUnique 25
-mutableByteArrayPrimTyConKey = mkPreludeTyConUnique 26
---UNUSED:mutableByteArrayTyConKey = mkPreludeTyConUnique 27
---UNUSED:packedStringTyConKey = mkPreludeTyConUnique 28
-synchVarPrimTyConKey = mkPreludeTyConUnique 29
-ratioTyConKey = mkPreludeTyConUnique 30
-rationalTyConKey = mkPreludeTyConUnique 31
-realWorldTyConKey = mkPreludeTyConUnique 32
---UNUSED:requestTyConKey = mkPreludeTyConUnique 33
---UNUSED:responseTyConKey = mkPreludeTyConUnique 34
-return2GMPsTyConKey = mkPreludeTyConUnique 35
-returnIntAndGMPTyConKey = mkPreludeTyConUnique 36
---UNUSED:seqIntPrimTyConKey = mkPreludeTyConUnique 37
---UNUSED:seqTyConKey = mkPreludeTyConUnique 38
-stablePtrPrimTyConKey = mkPreludeTyConUnique 39
-stablePtrTyConKey = mkPreludeTyConUnique 40
-stateAndAddrPrimTyConKey = mkPreludeTyConUnique 41
-stateAndArrayPrimTyConKey = mkPreludeTyConUnique 42
-stateAndByteArrayPrimTyConKey = mkPreludeTyConUnique 43
-stateAndCharPrimTyConKey = mkPreludeTyConUnique 44
-stateAndDoublePrimTyConKey = mkPreludeTyConUnique 45
-stateAndFloatPrimTyConKey = mkPreludeTyConUnique 46
-stateAndIntPrimTyConKey = mkPreludeTyConUnique 47
-stateAndMallocPtrPrimTyConKey = mkPreludeTyConUnique 48
-stateAndMutableArrayPrimTyConKey = mkPreludeTyConUnique 49
-stateAndMutableByteArrayPrimTyConKey = mkPreludeTyConUnique 50
-stateAndSynchVarPrimTyConKey = mkPreludeTyConUnique 51
-stateAndPtrPrimTyConKey = mkPreludeTyConUnique 52
-stateAndStablePtrPrimTyConKey = mkPreludeTyConUnique 53
-stateAndWordPrimTyConKey = mkPreludeTyConUnique 54
-statePrimTyConKey = mkPreludeTyConUnique 55
-stateTyConKey = mkPreludeTyConUnique 56
-stringTyConKey = mkPreludeTyConUnique 57
-stTyConKey = mkPreludeTyConUnique 58
-primIoTyConKey = mkPreludeTyConUnique 59
---UNUSED:ioResultTyConKey = mkPreludeTyConUnique 60
-voidPrimTyConKey = mkPreludeTyConUnique 61
-wordPrimTyConKey = mkPreludeTyConUnique 62
-wordTyConKey = mkPreludeTyConUnique 63
-
-#ifdef DPH
-podTyConKey = mkPreludeTyConUnique 64
-interfacePodTyConKey = mkPreludeTyConUnique 65
-
-podizedPodTyConKey _ = panic "ToDo:DPH:podizedPodTyConKey"
-#endif {- Data Parallel Haskell -}
+doublePrimTyConKey = mkPreludeTyConUnique 9
+doubleTyConKey = mkPreludeTyConUnique 10
+floatPrimTyConKey = mkPreludeTyConUnique 11
+floatTyConKey = mkPreludeTyConUnique 12
+funTyConKey = mkPreludeTyConUnique 13
+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}
%************************************************************************
\begin{code}
addrDataConKey = mkPreludeDataConUnique 1
buildDataConKey = mkPreludeDataConUnique 2
---UNUSED:byteArrayDataConKey = mkPreludeDataConUnique 3
charDataConKey = mkPreludeDataConUnique 4
consDataConKey = mkPreludeDataConUnique 5
doubleDataConKey = mkPreludeDataConUnique 6
-eqTagDataConKey = mkPreludeDataConUnique 7
+eqDataConKey = mkPreludeDataConUnique 7
falseDataConKey = mkPreludeDataConUnique 8
floatDataConKey = mkPreludeDataConUnique 9
-gtTagDataConKey = mkPreludeDataConUnique 10
+gtDataConKey = mkPreludeDataConUnique 10
intDataConKey = mkPreludeDataConUnique 11
integerDataConKey = mkPreludeDataConUnique 12
liftDataConKey = mkPreludeDataConUnique 13
-ltTagDataConKey = mkPreludeDataConUnique 14
-mallocPtrDataConKey = mkPreludeDataConUnique 15
---UNUSED:mutableArrayDataConKey = mkPreludeDataConUnique 16
---UNUSED:mutableByteArrayDataConKey = mkPreludeDataConUnique 17
+ltDataConKey = mkPreludeDataConUnique 14
+foreignObjDataConKey = mkPreludeDataConUnique 15
nilDataConKey = mkPreludeDataConUnique 18
---UNUSED:psDataConKey = mkPreludeDataConUnique 19
---UNUSED:cpsDataConKey = mkPreludeDataConUnique 20
ratioDataConKey = mkPreludeDataConUnique 21
return2GMPsDataConKey = mkPreludeDataConUnique 22
returnIntAndGMPDataConKey = mkPreludeDataConUnique 23
stateAndDoublePrimDataConKey = mkPreludeDataConUnique 29
stateAndFloatPrimDataConKey = mkPreludeDataConUnique 30
stateAndIntPrimDataConKey = mkPreludeDataConUnique 31
-stateAndMallocPtrPrimDataConKey = mkPreludeDataConUnique 32
+stateAndForeignObjPrimDataConKey = mkPreludeDataConUnique 32
stateAndMutableArrayPrimDataConKey = mkPreludeDataConUnique 33
stateAndMutableByteArrayPrimDataConKey = mkPreludeDataConUnique 34
stateAndSynchVarPrimDataConKey = mkPreludeDataConUnique 35
stateDataConKey = mkPreludeDataConUnique 39
trueDataConKey = mkPreludeDataConUnique 40
wordDataConKey = mkPreludeDataConUnique 41
-
-#ifdef DPH
-interfacePodDataConKey = mkPreludeDataConUnique 42
-#endif {- Data Parallel Haskell -}
+stDataConKey = mkPreludeDataConUnique 42
+stRetDataConKey = mkPreludeDataConUnique 43
+ioDataConKey = mkPreludeDataConUnique 44
+ioOkDataConKey = mkPreludeDataConUnique 45
+ioFailDataConKey = mkPreludeDataConUnique 46
\end{code}
%************************************************************************
%* *
%************************************************************************
-First, for raw @PrimOps@ and their boxed versions:
\begin{code}
-mkPrimOpIdUnique :: PrimOp -> Unique
-
-mkPrimOpIdUnique op = mkUnique '5' IBOX((tagOf_PrimOp op))
+absentErrorIdKey = mkPreludeMiscIdUnique 1
+andandIdKey = mkPreludeMiscIdUnique 2
+appendIdKey = mkPreludeMiscIdUnique 3
+augmentIdKey = mkPreludeMiscIdUnique 4
+buildIdKey = mkPreludeMiscIdUnique 5
+composeIdKey = mkPreludeMiscIdUnique 6
+errorIdKey = mkPreludeMiscIdUnique 7
+foldlIdKey = mkPreludeMiscIdUnique 8
+foldrIdKey = mkPreludeMiscIdUnique 9
+forkIdKey = mkPreludeMiscIdUnique 10
+recSelErrIdKey = mkPreludeMiscIdUnique 11
+integerMinusOneIdKey = mkPreludeMiscIdUnique 12
+integerPlusOneIdKey = mkPreludeMiscIdUnique 13
+integerPlusTwoIdKey = mkPreludeMiscIdUnique 14
+integerZeroIdKey = mkPreludeMiscIdUnique 15
+irrefutPatErrorIdKey = mkPreludeMiscIdUnique 16
+lexIdKey = mkPreludeMiscIdUnique 17
+noMethodBindingErrorIdKey = mkPreludeMiscIdUnique 20
+nonExhaustiveGuardsErrorIdKey = mkPreludeMiscIdUnique 21
+notIdKey = mkPreludeMiscIdUnique 22
+packCStringIdKey = mkPreludeMiscIdUnique 23
+parErrorIdKey = mkPreludeMiscIdUnique 24
+parIdKey = mkPreludeMiscIdUnique 25
+patErrorIdKey = mkPreludeMiscIdUnique 26
+readParenIdKey = mkPreludeMiscIdUnique 27
+realWorldPrimIdKey = mkPreludeMiscIdUnique 28
+recConErrorIdKey = mkPreludeMiscIdUnique 29
+recUpdErrorIdKey = mkPreludeMiscIdUnique 30
+seqIdKey = mkPreludeMiscIdUnique 31
+showParenIdKey = mkPreludeMiscIdUnique 32
+showSpaceIdKey = mkPreludeMiscIdUnique 33
+showStringIdKey = mkPreludeMiscIdUnique 34
+traceIdKey = mkPreludeMiscIdUnique 35
+unpackCString2IdKey = mkPreludeMiscIdUnique 36
+unpackCStringAppendIdKey = mkPreludeMiscIdUnique 37
+unpackCStringFoldrIdKey = mkPreludeMiscIdUnique 38
+unpackCStringIdKey = mkPreludeMiscIdUnique 39
+voidIdKey = mkPreludeMiscIdUnique 40
+ushowListIdKey = mkPreludeMiscIdUnique 41
+ureadListIdKey = mkPreludeMiscIdUnique 42
+
+copyableIdKey = mkPreludeMiscIdUnique 43
+noFollowIdKey = mkPreludeMiscIdUnique 44
+parAtAbsIdKey = mkPreludeMiscIdUnique 45
+parAtForNowIdKey = mkPreludeMiscIdUnique 46
+parAtIdKey = mkPreludeMiscIdUnique 47
+parAtRelIdKey = mkPreludeMiscIdUnique 48
+parGlobalIdKey = mkPreludeMiscIdUnique 49
+parLocalIdKey = mkPreludeMiscIdUnique 50
\end{code}
-Now for other non-@DataCon@ @Ids@:
-\begin{code}
-absentErrorIdKey = mkPreludeMiscIdUnique 1
-buildIdKey = mkPreludeMiscIdUnique 2
-errorIdKey = mkPreludeMiscIdUnique 3
-foldlIdKey = mkPreludeMiscIdUnique 4
-foldrIdKey = mkPreludeMiscIdUnique 5
-forkIdKey = mkPreludeMiscIdUnique 6
-int2IntegerIdKey = mkPreludeMiscIdUnique 7
-integerMinusOneIdKey = mkPreludeMiscIdUnique 8
-integerPlusOneIdKey = mkPreludeMiscIdUnique 9
-integerZeroIdKey = mkPreludeMiscIdUnique 10
-integerPlusTwoIdKey = mkPreludeMiscIdUnique 11
-packCStringIdKey = mkPreludeMiscIdUnique 12
-parIdKey = mkPreludeMiscIdUnique 13
-parErrorIdKey = mkPreludeMiscIdUnique 14
-patErrorIdKey = mkPreludeMiscIdUnique 15
---UNUSED:readParenIdKey = mkPreludeMiscIdUnique 16
-realWorldPrimIdKey = mkPreludeMiscIdUnique 17
-runSTIdKey = mkPreludeMiscIdUnique 18
-seqIdKey = mkPreludeMiscIdUnique 19
---UNUSED:showParenIdKey = mkPreludeMiscIdUnique 20
---UNUSED:showSpaceIdKey = mkPreludeMiscIdUnique 21
-traceIdKey = mkPreludeMiscIdUnique 22
-unpackCStringIdKey = mkPreludeMiscIdUnique 23
-unpackCString2IdKey = mkPreludeMiscIdUnique 20 -- NB: NB: NB
-unpackCStringAppendIdKey= mkPreludeMiscIdUnique 21 -- NB: NB: NB
-voidPrimIdKey = mkPreludeMiscIdUnique 24
-
-#ifdef GRAN
-parLocalIdKey = mkPreludeMiscIdUnique 25
-parGlobalIdKey = mkPreludeMiscIdUnique 26
-noFollowIdKey = mkPreludeMiscIdUnique 27
-copyableIdKey = mkPreludeMiscIdUnique 28
-#endif
-
-#ifdef DPH
-podSelectorIdKey = mkPreludeMiscIdUnique 29
-#endif {- Data Parallel Haskell -}
+Certain class operations from Prelude classes. They get
+their own uniques so we can look them up easily when we want
+to conjure them up during type checking.
+\begin{code}
+fromIntClassOpKey = mkPreludeMiscIdUnique 51
+fromIntegerClassOpKey = mkPreludeMiscIdUnique 52
+minusClassOpKey = mkPreludeMiscIdUnique 53
+fromRationalClassOpKey = mkPreludeMiscIdUnique 54
+enumFromClassOpKey = mkPreludeMiscIdUnique 55
+enumFromThenClassOpKey = mkPreludeMiscIdUnique 56
+enumFromToClassOpKey = mkPreludeMiscIdUnique 57
+enumFromThenToClassOpKey= mkPreludeMiscIdUnique 58
+eqClassOpKey = mkPreludeMiscIdUnique 59
+geClassOpKey = mkPreludeMiscIdUnique 60
+zeroClassOpKey = mkPreludeMiscIdUnique 61
+thenMClassOpKey = mkPreludeMiscIdUnique 62 -- (>>=)
+unboundKey = mkPreludeMiscIdUnique 63 -- Just a place holder for unbound
+ -- variables produced by the renamer
+fromEnumClassOpKey = mkPreludeMiscIdUnique 64
+
+mainKey = mkPreludeMiscIdUnique 65
+returnMClassOpKey = mkPreludeMiscIdUnique 66
+otherwiseIdKey = mkPreludeMiscIdUnique 67
+toEnumClassOpKey = mkPreludeMiscIdUnique 68
\end{code}
-%************************************************************************
-%* *
-\subsection[UniqueSupply-type]{@UniqueSupply@ type and operations}
-%* *
-%************************************************************************
-
\begin{code}
-#ifdef __GLASGOW_HASKELL__
-data UniqueSupply
- = MkUniqueSupply Int#
- | MkNewSupply SplitUniqSupply
-
-#else
-data UniqueSupply
- = MkUniqueSupply Word{-#STRICT#-}
- | MkNewSupply SplitUniqSupply
-#endif
-\end{code}
-
-@mkUniqueSupply@ is used to get a @UniqueSupply@ started.
-\begin{code}
-mkUniqueSupply :: Char -> UniqueSupply
-
-#ifdef __GLASGOW_HASKELL__
-
-mkUniqueSupply (MkChar c#)
- = MkUniqueSupply (w2i ((i2w (ord# c#)) `shiftL#` (i2w_s 24#)))
-
-#else
-
-mkUniqueSupply c
- = MkUniqueSupply ((fromInt (ord c)) `bitLsh` 24)
-
-#endif
-
-mkUniqueSupplyGrimily s = MkNewSupply s
-\end{code}
-
-The basic operation on a @UniqueSupply@ is to get a @Unique@ (or a
-few). It's just plain different when splittable vs.~not...
-\begin{code}
-getUnique :: UniqueSupply -> (UniqueSupply, Unique)
-
-getUnique (MkUniqueSupply n)
-#ifdef __GLASGOW_HASKELL__
- = (MkUniqueSupply (n +# 1#), MkUnique n)
-#else
- = (MkUniqueSupply (n + 1), MkUnique n)
-#endif
-getUnique (MkNewSupply s)
- = let
- (u, s1) = getSUniqueAndDepleted s
- in
- (MkNewSupply s1, u)
-
-getUniques :: Int -- how many you want
- -> UniqueSupply
- -> (UniqueSupply, [Unique])
-
-#ifdef __GLASGOW_HASKELL__
-getUniques i@(MkInt i#) (MkUniqueSupply n)
- = (MkUniqueSupply (n +# i#),
- [ case x of { MkInt x# ->
- MkUnique (n +# x#) } | x <- [0 .. i-1] ])
-#else
-getUniques i (MkUniqueSupply n)
- = (MkUniqueSupply (n + fromInt i), [ MkUnique (n + fromInt x) | x <- [0 .. i-1] ])
-#endif
-getUniques i (MkNewSupply s)
- = let
- (us, s1) = getSUniquesAndDepleted i s
- in
- (MkNewSupply s1, us)
-\end{code}
-
-[OLD-ish NOTE] Simon says: The last line is preferable over @(n+i,
-<mumble> [n .. (n+i-1)])@, because it is a little lazier. If n=bot
-you get ([bot, bot, bot], bot) back instead of (bot,bot). This is
-sometimes important for knot-tying.
-
-Alternatively, if you hate the inefficiency:
-\begin{pseudocode}
-(range 0, n+i) where range m | m=i = []
- range m = n+m : range (m+1)
-\end{pseudocode}
-
-%************************************************************************
-%* *
-\subsection[UniqueSupplies-compiler]{@UniqueSupplies@ specific to the compiler}
-%* *
-%************************************************************************
-
-Different parts of the compiler have their own @UniqueSupplies@, each
-identified by their ``tag letter:''
-\begin{verbatim}
- B builtin; for when the compiler conjures @Uniques@ out of
- thin air
- b a second builtin; we need two in mkWrapperUnfolding (False)
- r renamer
- t typechecker
- d desugarer
- p ``podizer'' (DPH only)
- s core-to-core simplifier
- S ``pod'' simplifier (DPH only)
- c core-to-stg
- T stg-to-stg simplifier
- f flattener (of abstract~C)
- L Assembly labels (for native-code generators)
- u Printing out unfoldings (so don't have constant renaming)
- P profiling (finalCCstg)
-
- v used in specialised TyVarUniques (see TyVar.lhs)
-
- 1-9 used for ``prelude Uniques'' (wired-in things; see below)
- 1 = classes
- 2 = tycons
- 3 = data cons
- 4 = tuple datacons
- 5 = unboxed-primop ids
- 6 = boxed-primop ids
- 7 = misc ids
-\end{verbatim}
-
-\begin{code}
-uniqSupply_r = mkUniqueSupply 'r'
-uniqSupply_t = mkUniqueSupply 't'
-uniqSupply_d = mkUniqueSupply 'd'
-uniqSupply_p = mkUniqueSupply 'p'
-uniqSupply_s = mkUniqueSupply 's'
-uniqSupply_S = mkUniqueSupply 'S'
-uniqSupply_c = mkUniqueSupply 'c'
-uniqSupply_T = mkUniqueSupply 'T'
-uniqSupply_f = mkUniqueSupply 'f'
-uniqSupply_L = mkUniqueSupply 'L'
-uniqSupply_u = mkUniqueSupply 'u'
-uniqSupply_P = mkUniqueSupply 'P'
-\end{code}
-
-The ``builtin UniqueSupplies'' are more magical. You don't use the
-supply, you ask for @Uniques@ directly from it. (They probably aren't
-unique, but you know that!)
-
-\begin{code}
-uniqSupply_B = mkUniqueSupply 'B' -- not exported!
-uniqSupply_b = mkUniqueSupply 'b' -- not exported!
-\end{code}
-
-\begin{code}
-mkPseudoUnique1, mkPseudoUnique2, mkPseudoUnique3,
- mkBuiltinUnique :: Int -> Unique
-
-mkBuiltinUnique i = mkUnique 'B' i
-mkPseudoUnique1 i = mkUnique 'C' i -- used for getTheUnique on Regs
-mkPseudoUnique2 i = mkUnique 'D' i -- ditto
-mkPseudoUnique3 i = mkUnique 'E' i -- ditto
-
-getBuiltinUniques :: Int -> [Unique]
-getBuiltinUniques n = map (mkUnique 'B') [1 .. n]
-\end{code}
-
-The following runs a uniq monad expression, using builtin uniq values:
-\begin{code}
-runBuiltinUs :: UniqSM a -> a
-runBuiltinUs m = snd (initUs uniqSupply_B m)
-\end{code}
-
-%************************************************************************
-%* *
-\subsection[Unique-monad]{Unique supply monad}
-%* *
-%************************************************************************
-
-A very plain unique-supply monad.
-
-\begin{code}
-type UniqSM result = UniqueSupply -> (UniqueSupply, result)
-
--- the initUs function also returns the final UniqueSupply
-
-initUs :: UniqueSupply -> UniqSM a -> (UniqueSupply, a)
-
-initUs init_us m = m init_us
-
-#ifdef __GLASGOW_HASKELL__
-{-# INLINE thenUs #-}
-{-# INLINE returnUs #-}
-#endif
-\end{code}
-
-@thenUs@ is are where we split the @UniqueSupply@.
-\begin{code}
-thenUs :: UniqSM a -> (a -> UniqSM b) -> UniqSM b
-
-thenUs expr cont us
- = case (expr us) of
- (us1, result) -> cont result us1
-\end{code}
-
-\begin{code}
-returnUs :: a -> UniqSM a
-returnUs result us = (us, result)
-
-mapUs :: (a -> UniqSM b) -> [a] -> UniqSM [b]
-
-mapUs f [] = returnUs []
-mapUs f (x:xs)
- = f x `thenUs` \ r ->
- mapUs f xs `thenUs` \ rs ->
- returnUs (r:rs)
-
-mapAndUnzipUs :: (a -> UniqSM (b,c)) -> [a] -> UniqSM ([b],[c])
-
-mapAndUnzipUs f [] = returnUs ([],[])
-mapAndUnzipUs f (x:xs)
- = f x `thenUs` \ (r1, r2) ->
- mapAndUnzipUs f xs `thenUs` \ (rs1, rs2) ->
- returnUs (r1:rs1, r2:rs2)
+inlineIdKey = mkPreludeMiscIdUnique 69
+coerceIdKey = mkPreludeMiscIdUnique 70
+assertIdKey = mkPreludeMiscIdUnique 71
\end{code}
projects / ghc-hetmet.git / blobdiff