X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FbasicTypes%2FUnique.lhs;h=e8b4e38e25873826f10f9989b0b14ba8963612f5;hb=9adbdb312507dcc7d5777e36376535918549103b;hp=a04fbd6f6922b17ffd38be84a7336e67899e8422;hpb=940841711bb0c30326a5173d8107c2792919641c;p=ghc-hetmet.git diff --git a/ghc/compiler/basicTypes/Unique.lhs b/ghc/compiler/basicTypes/Unique.lhs index a04fbd6..e8b4e38 100644 --- a/ghc/compiler/basicTypes/Unique.lhs +++ b/ghc/compiler/basicTypes/Unique.lhs @@ -16,7 +16,7 @@ Haskell). \begin{code} module Unique ( - Unique, Uniquable(..), + Unique, Uniquable(..), hasKey, u2i, -- hack: used in UniqFM pprUnique, pprUnique10, @@ -27,181 +27,32 @@ module Unique ( incrUnique, -- Used for renumbering deriveUnique, -- Ditto + newTagUnique, -- Used in CgCase initTyVarUnique, initTidyUniques, - isTupleKey, + 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, - - absentErrorIdKey, -- alphabetical... - addrDataConKey, - addrPrimTyConKey, - addrTyConKey, - appendIdKey, - arrayPrimTyConKey, - assertIdKey, - augmentIdKey, - bindIOIdKey, - boolTyConKey, - boundedClassKey, - boxedConKey, - buildIdKey, - byteArrayPrimTyConKey, - byteArrayTyConKey, - cCallableClassKey, - cReturnableClassKey, - charDataConKey, - charPrimTyConKey, - charTyConKey, - concatIdKey, - consDataConKey, - deRefStablePtrIdKey, - doubleDataConKey, - doublePrimTyConKey, - doubleTyConKey, - enumClassKey, - enumFromClassOpKey, - enumFromThenClassOpKey, - enumFromThenToClassOpKey, - enumFromToClassOpKey, - eqClassKey, - eqClassOpKey, - errorIdKey, - falseDataConKey, - failMClassOpKey, - filterIdKey, - floatDataConKey, - floatPrimTyConKey, - floatTyConKey, - floatingClassKey, - foldlIdKey, - foldrIdKey, - foreignObjDataConKey, - foreignObjPrimTyConKey, - foreignObjTyConKey, - fractionalClassKey, - fromEnumClassOpKey, - fromIntClassOpKey, - fromIntegerClassOpKey, - fromRationalClassOpKey, - funTyConKey, - functorClassKey, - geClassOpKey, - getTagIdKey, - intDataConKey, - intPrimTyConKey, - intTyConKey, - int8TyConKey, - int16TyConKey, - int32TyConKey, - int64PrimTyConKey, - int64TyConKey, - smallIntegerDataConKey, - largeIntegerDataConKey, - integerMinusOneIdKey, - integerPlusOneIdKey, - integerPlusTwoIdKey, - int2IntegerIdKey, - addr2IntegerIdKey, - integerTyConKey, - integerZeroIdKey, - integralClassKey, - irrefutPatErrorIdKey, - ixClassKey, - listTyConKey, - mainKey, - makeStablePtrIdKey, - mapIdKey, - minusClassOpKey, - monadClassKey, - monadPlusClassKey, - mutableArrayPrimTyConKey, - mutableByteArrayPrimTyConKey, - mutableByteArrayTyConKey, - mutVarPrimTyConKey, - nilDataConKey, - noMethodBindingErrorIdKey, - nonExhaustiveGuardsErrorIdKey, - numClassKey, - anyBoxConKey, - ordClassKey, - orderingTyConKey, - otherwiseIdKey, - parErrorIdKey, - parIdKey, - patErrorIdKey, - ratioDataConKey, - ratioTyConKey, - rationalTyConKey, - readClassKey, - realClassKey, - realFloatClassKey, - realFracClassKey, - realWorldPrimIdKey, - realWorldTyConKey, - recConErrorIdKey, - recSelErrIdKey, - recUpdErrorIdKey, - returnIOIdKey, - returnMClassOpKey, - runSTRepIdKey, - showClassKey, - ioTyConKey, - ioDataConKey, - stablePtrDataConKey, - stablePtrPrimTyConKey, - stablePtrTyConKey, - stableNameDataConKey, - stableNamePrimTyConKey, - stableNameTyConKey, - - statePrimTyConKey, - typeConKey, - kindConKey, - boxityConKey, - mVarPrimTyConKey, - thenMClassOpKey, - threadIdPrimTyConKey, - toEnumClassOpKey, - traceIdKey, - trueDataConKey, - unboundKey, - unboxedConKey, - unpackCString2IdKey, - unpackCStringAppendIdKey, - unpackCStringFoldrIdKey, - unpackCStringIdKey, - unsafeCoerceIdKey, - ushowListIdKey, - weakPrimTyConKey, - wordDataConKey, - wordPrimTyConKey, - wordTyConKey, - word8TyConKey, - word16TyConKey, - word32TyConKey, - word64PrimTyConKey, - word64TyConKey, - zipIdKey + mkTupleTyConUnique, mkTupleDataConUnique, + mkPreludeMiscIdUnique, mkPreludeDataConUnique, + mkPreludeTyConUnique, mkPreludeClassUnique, + + getNumBuiltinUniques, getBuiltinUniques, mkBuiltinUnique, + mkPseudoUnique1, mkPseudoUnique2, mkPseudoUnique3 ) where #include "HsVersions.h" +import BasicTypes ( Boxity(..) ) import FastString ( FastString, uniqueOfFS ) import GlaExts import ST import PrelBase ( Char(..), chr, ord ) +import FastTypes import Outputable \end{code} @@ -220,7 +71,7 @@ data Unique = MkUnique Int# \end{code} \begin{code} -u2i :: Unique -> FAST_INT +u2i :: Unique -> FastInt u2i (MkUnique i) = i \end{code} @@ -237,6 +88,7 @@ getKey :: Unique -> Int# -- for Var incrUnique :: Unique -> Unique deriveUnique :: Unique -> Int -> Unique +newTagUnique :: Unique -> Char -> Unique isTupleKey :: Unique -> Bool \end{code} @@ -254,6 +106,9 @@ incrUnique (MkUnique i) = MkUnique (i +# 1#) -- any of the uniques produced any other way deriveUnique (MkUnique i) delta = mkUnique 'X' (I# i + delta) +-- newTagUnique changes the "domain" of a unique to a different char +newTagUnique u c = mkUnique c i where (_,i) = unpkUnique u + -- 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 @@ -290,6 +145,9 @@ unpkUnique (MkUnique u) 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) @@ -429,9 +287,9 @@ Allocation of unique supply characters: mkAlphaTyVarUnique i = mkUnique '1' i mkPreludeClassUnique i = mkUnique '2' i -mkPreludeTyConUnique i = mkUnique '3' i -mkTupleTyConUnique a = mkUnique '4' a -mkUbxTupleTyConUnique a = mkUnique '5' a +mkPreludeTyConUnique i = mkUnique '3' (3*i) +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 @@ -440,8 +298,8 @@ mkUbxTupleTyConUnique a = mkUnique '5' a -- representation). mkPreludeDataConUnique i = mkUnique '6' (2*i) -- Must be alphabetic -mkTupleDataConUnique a = mkUnique '7' (2*a) -- ditto (*may* be used in C labels) -mkUbxTupleDataConUnique a = mkUnique '8' (2*a) +mkTupleDataConUnique Boxed a = mkUnique '7' (2*a) -- ditto (*may* be used in C labels) +mkTupleDataConUnique Unboxed a = mkUnique '8' (2*a) -- This one is used for a tiresome reason -- to improve a consistency-checking error check in the renamer @@ -460,215 +318,22 @@ initTyVarUnique = mkUnique 't' 0 initTidyUniques :: (Unique, Unique) -- Global and local initTidyUniques = (mkUnique 'g' 0, mkUnique 'x' 0) -mkPseudoUnique1, mkPseudoUnique2, mkPseudoUnique3, - mkBuiltinUnique :: Int -> Unique +mkPseudoUnique1, mkPseudoUnique2, mkPseudoUnique3, + mkBuiltinUnique :: Int -> Unique mkBuiltinUnique i = mkUnique 'B' i mkPseudoUnique1 i = mkUnique 'C' i -- used for getUnique 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} - -%************************************************************************ -%* * -\subsubsection[Uniques-prelude-Classes]{@Uniques@ for wired-in @Classes@} -%* * -%************************************************************************ - -\begin{code} -boundedClassKey = mkPreludeClassUnique 1 -enumClassKey = mkPreludeClassUnique 2 -eqClassKey = mkPreludeClassUnique 3 -floatingClassKey = mkPreludeClassUnique 5 -fractionalClassKey = mkPreludeClassUnique 6 -integralClassKey = mkPreludeClassUnique 7 -monadClassKey = mkPreludeClassUnique 8 -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 18 -cReturnableClassKey = mkPreludeClassUnique 19 - -ixClassKey = mkPreludeClassUnique 20 -\end{code} - -%************************************************************************ -%* * -\subsubsection[Uniques-prelude-TyCons]{@Uniques@ for wired-in @TyCons@} -%* * -%************************************************************************ +mkPseudoUnique2 i = mkUnique 'D' i -- used in NCG for getUnique on RealRegs +mkPseudoUnique3 i = mkUnique 'E' i -- used in NCG spiller to create spill VirtualRegs -\begin{code} -addrPrimTyConKey = mkPreludeTyConUnique 1 -addrTyConKey = mkPreludeTyConUnique 2 -arrayPrimTyConKey = mkPreludeTyConUnique 3 -boolTyConKey = mkPreludeTyConUnique 4 -byteArrayPrimTyConKey = mkPreludeTyConUnique 5 -charPrimTyConKey = mkPreludeTyConUnique 7 -charTyConKey = mkPreludeTyConUnique 8 -doublePrimTyConKey = mkPreludeTyConUnique 9 -doubleTyConKey = mkPreludeTyConUnique 10 -floatPrimTyConKey = mkPreludeTyConUnique 11 -floatTyConKey = mkPreludeTyConUnique 12 -funTyConKey = mkPreludeTyConUnique 13 -intPrimTyConKey = mkPreludeTyConUnique 14 -intTyConKey = mkPreludeTyConUnique 15 -int8TyConKey = mkPreludeTyConUnique 16 -int16TyConKey = mkPreludeTyConUnique 17 -int32TyConKey = mkPreludeTyConUnique 18 -int64PrimTyConKey = mkPreludeTyConUnique 19 -int64TyConKey = mkPreludeTyConUnique 20 -integerTyConKey = mkPreludeTyConUnique 21 -listTyConKey = mkPreludeTyConUnique 22 -foreignObjPrimTyConKey = mkPreludeTyConUnique 23 -foreignObjTyConKey = mkPreludeTyConUnique 24 -weakPrimTyConKey = mkPreludeTyConUnique 25 -mutableArrayPrimTyConKey = mkPreludeTyConUnique 26 -mutableByteArrayPrimTyConKey = mkPreludeTyConUnique 27 -orderingTyConKey = mkPreludeTyConUnique 28 -mVarPrimTyConKey = mkPreludeTyConUnique 29 -ratioTyConKey = mkPreludeTyConUnique 30 -rationalTyConKey = mkPreludeTyConUnique 31 -realWorldTyConKey = mkPreludeTyConUnique 32 -stablePtrPrimTyConKey = mkPreludeTyConUnique 33 -stablePtrTyConKey = mkPreludeTyConUnique 34 -statePrimTyConKey = mkPreludeTyConUnique 35 -stableNamePrimTyConKey = mkPreludeTyConUnique 50 -stableNameTyConKey = mkPreludeTyConUnique 51 -mutableByteArrayTyConKey = mkPreludeTyConUnique 52 -mutVarPrimTyConKey = mkPreludeTyConUnique 53 -ioTyConKey = mkPreludeTyConUnique 55 -byteArrayTyConKey = mkPreludeTyConUnique 56 -wordPrimTyConKey = mkPreludeTyConUnique 57 -wordTyConKey = mkPreludeTyConUnique 58 -word8TyConKey = mkPreludeTyConUnique 59 -word16TyConKey = mkPreludeTyConUnique 60 -word32TyConKey = mkPreludeTyConUnique 61 -word64PrimTyConKey = mkPreludeTyConUnique 62 -word64TyConKey = mkPreludeTyConUnique 63 -boxedConKey = mkPreludeTyConUnique 64 -unboxedConKey = mkPreludeTyConUnique 65 -anyBoxConKey = mkPreludeTyConUnique 66 -kindConKey = mkPreludeTyConUnique 67 -boxityConKey = mkPreludeTyConUnique 68 -typeConKey = mkPreludeTyConUnique 69 -threadIdPrimTyConKey = mkPreludeTyConUnique 70 -\end{code} - -%************************************************************************ -%* * -\subsubsection[Uniques-prelude-DataCons]{@Uniques@ for wired-in @DataCons@} -%* * -%************************************************************************ - -\begin{code} -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} -%************************************************************************ -%* * -\subsubsection[Uniques-prelude-Ids]{@Uniques@ for wired-in @Ids@ (except @DataCons@)} -%* * -%************************************************************************ -\begin{code} -absentErrorIdKey = mkPreludeMiscIdUnique 1 -appendIdKey = mkPreludeMiscIdUnique 2 -augmentIdKey = mkPreludeMiscIdUnique 3 -buildIdKey = mkPreludeMiscIdUnique 4 -errorIdKey = mkPreludeMiscIdUnique 5 -foldlIdKey = mkPreludeMiscIdUnique 6 -foldrIdKey = mkPreludeMiscIdUnique 7 -recSelErrIdKey = mkPreludeMiscIdUnique 8 -integerMinusOneIdKey = mkPreludeMiscIdUnique 9 -integerPlusOneIdKey = mkPreludeMiscIdUnique 10 -integerPlusTwoIdKey = mkPreludeMiscIdUnique 11 -integerZeroIdKey = mkPreludeMiscIdUnique 12 -int2IntegerIdKey = mkPreludeMiscIdUnique 13 -addr2IntegerIdKey = mkPreludeMiscIdUnique 14 -irrefutPatErrorIdKey = mkPreludeMiscIdUnique 15 -lexIdKey = mkPreludeMiscIdUnique 16 -noMethodBindingErrorIdKey = mkPreludeMiscIdUnique 17 -nonExhaustiveGuardsErrorIdKey = mkPreludeMiscIdUnique 18 -parErrorIdKey = mkPreludeMiscIdUnique 20 -parIdKey = mkPreludeMiscIdUnique 21 -patErrorIdKey = mkPreludeMiscIdUnique 22 -realWorldPrimIdKey = mkPreludeMiscIdUnique 23 -recConErrorIdKey = mkPreludeMiscIdUnique 24 -recUpdErrorIdKey = mkPreludeMiscIdUnique 25 -traceIdKey = mkPreludeMiscIdUnique 26 -unpackCString2IdKey = mkPreludeMiscIdUnique 27 -unpackCStringAppendIdKey = mkPreludeMiscIdUnique 28 -unpackCStringFoldrIdKey = mkPreludeMiscIdUnique 29 -unpackCStringIdKey = mkPreludeMiscIdUnique 30 -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} +getBuiltinUniques :: Int -> [Unique] +getBuiltinUniques n = map (mkUnique 'B') [1 .. n] -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 101 -fromIntegerClassOpKey = mkPreludeMiscIdUnique 102 -minusClassOpKey = mkPreludeMiscIdUnique 103 -fromRationalClassOpKey = mkPreludeMiscIdUnique 104 -enumFromClassOpKey = mkPreludeMiscIdUnique 105 -enumFromThenClassOpKey = mkPreludeMiscIdUnique 106 -enumFromToClassOpKey = mkPreludeMiscIdUnique 107 -enumFromThenToClassOpKey = mkPreludeMiscIdUnique 108 -eqClassOpKey = mkPreludeMiscIdUnique 109 -geClassOpKey = mkPreludeMiscIdUnique 110 -failMClassOpKey = mkPreludeMiscIdUnique 112 -thenMClassOpKey = mkPreludeMiscIdUnique 113 -- (>>=) - -- Just a place holder for unbound variables produced by the renamer: -unboundKey = mkPreludeMiscIdUnique 114 -fromEnumClassOpKey = mkPreludeMiscIdUnique 115 - -mainKey = mkPreludeMiscIdUnique 116 -returnMClassOpKey = mkPreludeMiscIdUnique 117 -otherwiseIdKey = mkPreludeMiscIdUnique 118 -toEnumClassOpKey = mkPreludeMiscIdUnique 119 -mapIdKey = mkPreludeMiscIdUnique 120 +getNumBuiltinUniques :: Int -- First unique + -> Int -- Number required + -> [Unique] +getNumBuiltinUniques base n = map (mkUnique 'B') [base .. base+n-1] \end{code} -\begin{code} -assertIdKey = mkPreludeMiscIdUnique 121 -runSTRepIdKey = mkPreludeMiscIdUnique 122 -\end{code}