X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FbasicTypes%2FUnique.lhs;h=3dbdbcd8873c38c0ede9f8e1edc82e19881693c3;hb=2494407a750053daa61718fac371487d04818e57;hp=54c78983a4092f491f245e405a7aaf8803669fb0;hpb=ca5a4a480d10d61e5b7a52eb4d556e8b8c33e69d;p=ghc-hetmet.git diff --git a/ghc/compiler/basicTypes/Unique.lhs b/ghc/compiler/basicTypes/Unique.lhs index 54c7898..3dbdbcd 100644 --- a/ghc/compiler/basicTypes/Unique.lhs +++ b/ghc/compiler/basicTypes/Unique.lhs @@ -46,10 +46,10 @@ module Unique ( addrDataConKey, addrPrimTyConKey, addrTyConKey, + andandIdKey, appendIdKey, arrayPrimTyConKey, augmentIdKey, - binaryClassKey, boolTyConKey, boundedClassKey, buildDataConKey, @@ -60,8 +60,8 @@ module Unique ( charDataConKey, charPrimTyConKey, charTyConKey, + composeIdKey, consDataConKey, - evalClassKey, doubleDataConKey, doublePrimTyConKey, doubleTyConKey, @@ -74,6 +74,7 @@ module Unique ( eqClassOpKey, eqDataConKey, errorIdKey, + evalClassKey, falseDataConKey, floatDataConKey, floatPrimTyConKey, @@ -81,12 +82,17 @@ module Unique ( floatingClassKey, foldlIdKey, foldrIdKey, + foreignObjDataConKey, + foreignObjPrimTyConKey, + foreignObjTyConKey, forkIdKey, fractionalClassKey, + fromEnumClassOpKey, fromIntClassOpKey, fromIntegerClassOpKey, fromRationalClassOpKey, funTyConKey, + functorClassKey, geClassOpKey, gtDataConKey, iOTyConKey, @@ -100,52 +106,59 @@ module Unique ( integerTyConKey, integerZeroIdKey, integralClassKey, + irrefutPatErrorIdKey, ixClassKey, + lexIdKey, liftDataConKey, liftTyConKey, listTyConKey, ltDataConKey, - mainIdKey, - mainPrimIOIdKey, - mallocPtrDataConKey, - mallocPtrPrimTyConKey, - mallocPtrTyConKey, + mainKey, mainPrimIoKey, + minusClassOpKey, monadClassKey, + monadPlusClassKey, monadZeroClassKey, mutableArrayPrimTyConKey, mutableByteArrayPrimTyConKey, nilDataConKey, + noDefaultMethodErrorIdKey, + nonExhaustiveGuardsErrorIdKey, + nonExplicitMethodErrorIdKey, + notIdKey, numClassKey, ordClassKey, orderingTyConKey, + otherwiseIdKey, packCStringIdKey, parErrorIdKey, parIdKey, patErrorIdKey, - recConErrorIdKey, - recUpdErrorIdKey, - irrefutPatErrorIdKey, - nonExhaustiveGuardsErrorIdKey, - noDefaultMethodErrorIdKey, - nonExplicitMethodErrorIdKey, primIoTyConKey, ratioDataConKey, ratioTyConKey, rationalTyConKey, readClassKey, + readParenIdKey, realClassKey, realFloatClassKey, realFracClassKey, realWorldPrimIdKey, realWorldTyConKey, + recConErrorIdKey, + recUpdErrorIdKey, return2GMPsDataConKey, return2GMPsTyConKey, returnIntAndGMPDataConKey, returnIntAndGMPTyConKey, + returnMClassOpKey, runSTIdKey, seqIdKey, showClassKey, + showParenIdKey, + showSpaceIdKey, + showStringIdKey, stTyConKey, + stDataConKey, stablePtrDataConKey, stablePtrPrimTyConKey, stablePtrTyConKey, @@ -161,10 +174,10 @@ module Unique ( stateAndDoublePrimTyConKey, stateAndFloatPrimDataConKey, stateAndFloatPrimTyConKey, + stateAndForeignObjPrimDataConKey, + stateAndForeignObjPrimTyConKey, stateAndIntPrimDataConKey, stateAndIntPrimTyConKey, - stateAndMallocPtrPrimDataConKey, - stateAndMallocPtrPrimTyConKey, stateAndMutableArrayPrimDataConKey, stateAndMutableArrayPrimTyConKey, stateAndMutableByteArrayPrimDataConKey, @@ -180,31 +193,37 @@ module Unique ( stateDataConKey, statePrimTyConKey, stateTyConKey, - stringTyConKey, synchVarPrimTyConKey, + thenMClassOpKey, + toEnumClassOpKey, traceIdKey, trueDataConKey, unpackCString2IdKey, unpackCStringAppendIdKey, unpackCStringFoldrIdKey, unpackCStringIdKey, - voidPrimIdKey, - voidPrimTyConKey, + ureadListIdKey, + ushowListIdKey, + voidIdKey, + voidTyConKey, wordDataConKey, wordPrimTyConKey, - wordTyConKey -#ifdef GRAN + wordTyConKey, + zeroClassOpKey , copyableIdKey , noFollowIdKey + , parAtAbsIdKey + , parAtForNowIdKey + , parAtIdKey + , parAtRelIdKey , parGlobalIdKey , parLocalIdKey -#endif - -- to make interface self-sufficient + , unboundKey ) where import PreludeGlaST -import Ubiq{-uitous-} +IMP_Ubiq(){-uitous-} import Pretty import Util @@ -308,11 +327,25 @@ pprUnique, pprUnique10 :: Unique -> Pretty 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 (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 showUnique :: Unique -> FAST_STRING showUnique uniq = _PK_ (ppShow 80 (pprUnique uniq)) @@ -322,7 +355,6 @@ instance Outputable Unique where instance Text Unique where showsPrec p uniq rest = _UNPK_ (showUnique uniq) - readsPrec p = panic "no readsPrec for Unique" \end{code} %************************************************************************ @@ -335,12 +367,26 @@ A character-stingy way to read/write numbers (notably Uniques). 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 +# define BYTE_ARRAY GHCbase.ByteArray +# define RUN_ST GHCbase.runST +# define AND_THEN >>= +# define AND_THEN_ >> +# define RETURN return +#else +# define BYTE_ARRAY _ByteArray +# define RUN_ST _runST +# define AND_THEN `thenStrictlyST` +# define AND_THEN_ `seqStrictlyST` +# define RETURN returnStrictlyST +#endif + iToBase62 :: Int -> Pretty 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 case (indexCharArray# bytes n#) of { c -> @@ -351,20 +397,20 @@ iToBase62 n@(I# n#) ppBeside (iToBase62 q) (ppChar (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 \end{code} @@ -416,26 +462,29 @@ getBuiltinUniques n = map (mkUnique 'B') [1 .. n] %************************************************************************ \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 -showClassKey = mkPreludeClassUnique 12 -readClassKey = mkPreludeClassUnique 13 -monadClassKey = mkPreludeClassUnique 14 -monadZeroClassKey = mkPreludeClassUnique 15 -binaryClassKey = mkPreludeClassUnique 16 -cCallableClassKey = mkPreludeClassUnique 17 -cReturnableClassKey = mkPreludeClassUnique 18 -evalClassKey = mkPreludeClassUnique 19 -boundedClassKey = mkPreludeClassUnique 20 +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 \end{code} %************************************************************************ @@ -463,8 +512,8 @@ intTyConKey = mkPreludeTyConUnique 16 integerTyConKey = mkPreludeTyConUnique 17 liftTyConKey = mkPreludeTyConUnique 18 listTyConKey = mkPreludeTyConUnique 19 -mallocPtrPrimTyConKey = mkPreludeTyConUnique 20 -mallocPtrTyConKey = mkPreludeTyConUnique 21 +foreignObjPrimTyConKey = mkPreludeTyConUnique 20 +foreignObjTyConKey = mkPreludeTyConUnique 21 mutableArrayPrimTyConKey = mkPreludeTyConUnique 22 mutableByteArrayPrimTyConKey = mkPreludeTyConUnique 23 orderingTyConKey = mkPreludeTyConUnique 24 @@ -483,7 +532,7 @@ stateAndCharPrimTyConKey = mkPreludeTyConUnique 36 stateAndDoublePrimTyConKey = mkPreludeTyConUnique 37 stateAndFloatPrimTyConKey = mkPreludeTyConUnique 38 stateAndIntPrimTyConKey = mkPreludeTyConUnique 39 -stateAndMallocPtrPrimTyConKey = mkPreludeTyConUnique 40 +stateAndForeignObjPrimTyConKey = mkPreludeTyConUnique 40 stateAndMutableArrayPrimTyConKey = mkPreludeTyConUnique 41 stateAndMutableByteArrayPrimTyConKey = mkPreludeTyConUnique 42 stateAndSynchVarPrimTyConKey = mkPreludeTyConUnique 43 @@ -492,12 +541,13 @@ stateAndStablePtrPrimTyConKey = mkPreludeTyConUnique 45 stateAndWordPrimTyConKey = mkPreludeTyConUnique 46 statePrimTyConKey = mkPreludeTyConUnique 47 stateTyConKey = mkPreludeTyConUnique 48 -stringTyConKey = mkPreludeTyConUnique 49 + -- 49 is spare stTyConKey = mkPreludeTyConUnique 50 primIoTyConKey = mkPreludeTyConUnique 51 -voidPrimTyConKey = mkPreludeTyConUnique 52 + -- 52 is spare wordPrimTyConKey = mkPreludeTyConUnique 53 wordTyConKey = mkPreludeTyConUnique 54 +voidTyConKey = mkPreludeTyConUnique 55 \end{code} %************************************************************************ @@ -520,7 +570,7 @@ intDataConKey = mkPreludeDataConUnique 11 integerDataConKey = mkPreludeDataConUnique 12 liftDataConKey = mkPreludeDataConUnique 13 ltDataConKey = mkPreludeDataConUnique 14 -mallocPtrDataConKey = mkPreludeDataConUnique 15 +foreignObjDataConKey = mkPreludeDataConUnique 15 nilDataConKey = mkPreludeDataConUnique 18 ratioDataConKey = mkPreludeDataConUnique 21 return2GMPsDataConKey = mkPreludeDataConUnique 22 @@ -533,7 +583,7 @@ stateAndCharPrimDataConKey = mkPreludeDataConUnique 28 stateAndDoublePrimDataConKey = mkPreludeDataConUnique 29 stateAndFloatPrimDataConKey = mkPreludeDataConUnique 30 stateAndIntPrimDataConKey = mkPreludeDataConUnique 31 -stateAndMallocPtrPrimDataConKey = mkPreludeDataConUnique 32 +stateAndForeignObjPrimDataConKey = mkPreludeDataConUnique 32 stateAndMutableArrayPrimDataConKey = mkPreludeDataConUnique 33 stateAndMutableByteArrayPrimDataConKey = mkPreludeDataConUnique 34 stateAndSynchVarPrimDataConKey = mkPreludeDataConUnique 35 @@ -543,6 +593,7 @@ stateAndWordPrimDataConKey = mkPreludeDataConUnique 38 stateDataConKey = mkPreludeDataConUnique 39 trueDataConKey = mkPreludeDataConUnique 40 wordDataConKey = mkPreludeDataConUnique 41 +stDataConKey = mkPreludeDataConUnique 42 \end{code} %************************************************************************ @@ -553,59 +604,82 @@ wordDataConKey = mkPreludeDataConUnique 41 \begin{code} absentErrorIdKey = mkPreludeMiscIdUnique 1 -appendIdKey = mkPreludeMiscIdUnique 2 -augmentIdKey = mkPreludeMiscIdUnique 3 -buildIdKey = mkPreludeMiscIdUnique 4 -errorIdKey = mkPreludeMiscIdUnique 5 -foldlIdKey = mkPreludeMiscIdUnique 6 -foldrIdKey = mkPreludeMiscIdUnique 7 -forkIdKey = mkPreludeMiscIdUnique 8 -int2IntegerIdKey = mkPreludeMiscIdUnique 9 -integerMinusOneIdKey = mkPreludeMiscIdUnique 10 -integerPlusOneIdKey = mkPreludeMiscIdUnique 11 -integerPlusTwoIdKey = mkPreludeMiscIdUnique 12 -integerZeroIdKey = mkPreludeMiscIdUnique 13 -packCStringIdKey = mkPreludeMiscIdUnique 14 -parErrorIdKey = mkPreludeMiscIdUnique 15 -parIdKey = mkPreludeMiscIdUnique 16 -patErrorIdKey = mkPreludeMiscIdUnique 17 -realWorldPrimIdKey = mkPreludeMiscIdUnique 18 -runSTIdKey = mkPreludeMiscIdUnique 19 -seqIdKey = mkPreludeMiscIdUnique 20 -traceIdKey = mkPreludeMiscIdUnique 21 -unpackCString2IdKey = mkPreludeMiscIdUnique 22 -unpackCStringAppendIdKey = mkPreludeMiscIdUnique 23 -unpackCStringFoldrIdKey = mkPreludeMiscIdUnique 24 -unpackCStringIdKey = mkPreludeMiscIdUnique 25 -voidPrimIdKey = mkPreludeMiscIdUnique 26 -mainIdKey = mkPreludeMiscIdUnique 27 -mainPrimIOIdKey = mkPreludeMiscIdUnique 28 -recConErrorIdKey = mkPreludeMiscIdUnique 29 -recUpdErrorIdKey = mkPreludeMiscIdUnique 30 -irrefutPatErrorIdKey = mkPreludeMiscIdUnique 31 -nonExhaustiveGuardsErrorIdKey = mkPreludeMiscIdUnique 32 -noDefaultMethodErrorIdKey = mkPreludeMiscIdUnique 33 -nonExplicitMethodErrorIdKey = mkPreludeMiscIdUnique 34 - -#ifdef GRAN -parLocalIdKey = mkPreludeMiscIdUnique 35 -parGlobalIdKey = mkPreludeMiscIdUnique 36 -noFollowIdKey = mkPreludeMiscIdUnique 37 -copyableIdKey = mkPreludeMiscIdUnique 38 -#endif +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 +int2IntegerIdKey = mkPreludeMiscIdUnique 11 +integerMinusOneIdKey = mkPreludeMiscIdUnique 12 +integerPlusOneIdKey = mkPreludeMiscIdUnique 13 +integerPlusTwoIdKey = mkPreludeMiscIdUnique 14 +integerZeroIdKey = mkPreludeMiscIdUnique 15 +irrefutPatErrorIdKey = mkPreludeMiscIdUnique 16 +lexIdKey = mkPreludeMiscIdUnique 17 +noDefaultMethodErrorIdKey = mkPreludeMiscIdUnique 20 +nonExhaustiveGuardsErrorIdKey = mkPreludeMiscIdUnique 21 +nonExplicitMethodErrorIdKey = mkPreludeMiscIdUnique 22 +notIdKey = mkPreludeMiscIdUnique 23 +packCStringIdKey = mkPreludeMiscIdUnique 24 +parErrorIdKey = mkPreludeMiscIdUnique 25 +parIdKey = mkPreludeMiscIdUnique 26 +patErrorIdKey = mkPreludeMiscIdUnique 27 +readParenIdKey = mkPreludeMiscIdUnique 28 +realWorldPrimIdKey = mkPreludeMiscIdUnique 29 +recConErrorIdKey = mkPreludeMiscIdUnique 30 +recUpdErrorIdKey = mkPreludeMiscIdUnique 31 +runSTIdKey = mkPreludeMiscIdUnique 32 +seqIdKey = mkPreludeMiscIdUnique 33 +showParenIdKey = mkPreludeMiscIdUnique 34 +showSpaceIdKey = mkPreludeMiscIdUnique 35 +showStringIdKey = mkPreludeMiscIdUnique 36 +traceIdKey = mkPreludeMiscIdUnique 37 +unpackCString2IdKey = mkPreludeMiscIdUnique 38 +unpackCStringAppendIdKey = mkPreludeMiscIdUnique 39 +unpackCStringFoldrIdKey = mkPreludeMiscIdUnique 40 +unpackCStringIdKey = mkPreludeMiscIdUnique 41 +voidIdKey = mkPreludeMiscIdUnique 42 +ushowListIdKey = mkPreludeMiscIdUnique 43 +ureadListIdKey = mkPreludeMiscIdUnique 44 + +copyableIdKey = mkPreludeMiscIdUnique 45 +noFollowIdKey = mkPreludeMiscIdUnique 46 +parAtAbsIdKey = mkPreludeMiscIdUnique 47 +parAtForNowIdKey = mkPreludeMiscIdUnique 48 +parAtIdKey = mkPreludeMiscIdUnique 49 +parAtRelIdKey = mkPreludeMiscIdUnique 50 +parGlobalIdKey = mkPreludeMiscIdUnique 51 +parLocalIdKey = mkPreludeMiscIdUnique 52 \end{code} 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 37 -fromIntegerClassOpKey = mkPreludeMiscIdUnique 38 -fromRationalClassOpKey = mkPreludeMiscIdUnique 39 -enumFromClassOpKey = mkPreludeMiscIdUnique 40 -enumFromThenClassOpKey = mkPreludeMiscIdUnique 41 -enumFromToClassOpKey = mkPreludeMiscIdUnique 42 -enumFromThenToClassOpKey= mkPreludeMiscIdUnique 43 -eqClassOpKey = mkPreludeMiscIdUnique 44 -geClassOpKey = mkPreludeMiscIdUnique 45 +fromIntClassOpKey = mkPreludeMiscIdUnique 53 +fromIntegerClassOpKey = mkPreludeMiscIdUnique 54 +minusClassOpKey = mkPreludeMiscIdUnique 69 +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 + -- variables produced by the renamer +fromEnumClassOpKey = mkPreludeMiscIdUnique 65 + +mainKey = mkPreludeMiscIdUnique 66 +mainPrimIoKey = mkPreludeMiscIdUnique 67 +returnMClassOpKey = mkPreludeMiscIdUnique 68 +-- Used for minusClassOp 69 +otherwiseIdKey = mkPreludeMiscIdUnique 70 +toEnumClassOpKey = mkPreludeMiscIdUnique 71 \end{code}