X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fprelude%2FPrelInfo.lhs;h=94666c7101ed3719dd805d082b066e190c9c898e;hb=2869e22f31ff45ac4693551dcc311d5219dc8347;hp=d6caf24710fefcc03e9760bacebb7af121cd8f2d;hpb=c9898dcb4544634e3fab247960e1f132f73e398e;p=ghc-hetmet.git diff --git a/ghc/compiler/prelude/PrelInfo.lhs b/ghc/compiler/prelude/PrelInfo.lhs index d6caf24..94666c7 100644 --- a/ghc/compiler/prelude/PrelInfo.lhs +++ b/ghc/compiler/prelude/PrelInfo.lhs @@ -1,66 +1,63 @@ % -% (c) The GRASP/AQUA Project, Glasgow University, 1992-1996 +% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 % \section[PrelInfo]{The @PrelInfo@ interface to the compiler's prelude knowledge} \begin{code} module PrelInfo ( - -- finite maps for built-in things (for the renamer and typechecker): - builtinNames, derivingOccurrences, - BuiltinNames, + module PrelNames, + module MkId, + builtinNames, -- Names of things whose *unique* must be known, but + -- that is all. If something is in here, you know that + -- if it's used at all then it's Name will be just as + -- it is here, unique and all. Includes all the + + derivingOccurrences, -- For a given class C, this tells what other + derivableClassKeys, -- things are needed as a result of a + -- deriving(C) clause + + + + -- Primop RdrNames + eqH_Char_RDR, ltH_Char_RDR, eqH_Word_RDR, ltH_Word_RDR, + eqH_Addr_RDR, ltH_Addr_RDR, eqH_Float_RDR, ltH_Float_RDR, + eqH_Double_RDR, ltH_Double_RDR, eqH_Int_RDR, ltH_Int_RDR, + geH_RDR, leH_RDR, minusH_RDR, tagToEnumH_RDR, + + -- Random other things maybeCharLikeCon, maybeIntLikeCon, + needsDataDeclCtxtClassKeys, cCallishClassKeys, cCallishTyKeys, + isNoDictClass, isNumericClass, isStandardClass, isCcallishClass, + isCreturnableClass, numericTyKeys, fractionalClassKeys, - eq_RDR, ne_RDR, le_RDR, lt_RDR, ge_RDR, gt_RDR, max_RDR, min_RDR, - compare_RDR, minBound_RDR, maxBound_RDR, enumFrom_RDR, enumFromTo_RDR, - enumFromThen_RDR, enumFromThenTo_RDR, fromEnum_RDR, toEnum_RDR, - ratioDataCon_RDR, range_RDR, index_RDR, inRange_RDR, readsPrec_RDR, - readList_RDR, showsPrec_RDR, showList_RDR, plus_RDR, times_RDR, - ltTag_RDR, eqTag_RDR, gtTag_RDR, eqH_Char_RDR, ltH_Char_RDR, - eqH_Word_RDR, ltH_Word_RDR, eqH_Addr_RDR, ltH_Addr_RDR, eqH_Float_RDR, - ltH_Float_RDR, eqH_Double_RDR, ltH_Double_RDR, eqH_Int_RDR, - ltH_Int_RDR, geH_RDR, leH_RDR, minusH_RDR, false_RDR, true_RDR, - and_RDR, not_RDR, append_RDR, map_RDR, compose_RDR, mkInt_RDR, - error_RDR, assertErr_RDR, - showString_RDR, showParen_RDR, readParen_RDR, lex_RDR, - showSpace_RDR, showList___RDR, readList___RDR, negate_RDR, - - numClass_RDR, fractionalClass_RDR, eqClass_RDR, - ccallableClass_RDR, creturnableClass_RDR, - monadZeroClass_RDR, enumClass_RDR, evalClass_RDR, ordClass_RDR, - ioDataCon_RDR, ioOkDataCon_RDR, - - main_NAME, allClass_NAME, ioTyCon_NAME, - - needsDataDeclCtxtClassKeys, cCallishClassKeys, cCallishTyKeys, isNoDictClass, - isNumericClass, isStandardClass, isCcallishClass, isCreturnableClass ) where #include "HsVersions.h" -import IdUtils ( primOpName ) - -- friends: -import PrelMods -- Prelude module names -import PrelVals -- VALUES -import PrimOp ( PrimOp(..), allThePrimOps ) -import PrimRep ( PrimRep(..) ) +import MkId -- Ditto +import PrelNames -- Prelude module names + +import PrimOp ( PrimOp(..), allThePrimOps, primOpRdrName ) +import DataCon ( DataCon, dataConId, dataConWrapId ) import TysPrim -- TYPES import TysWiredIn -- others: -import RdrHsSyn ( RdrName(..), varQual, tcQual, qual ) -import BasicTypes ( IfaceFlavour ) -import Id ( GenId, Id ) -import Name ( Name, OccName(..), Provenance(..), - getName, mkGlobalName, modAndOcc +import RdrName ( RdrName ) +import Name ( Name, OccName, Provenance(..), + NameSpace, tcName, clsName, varName, dataName, + mkKnownKeyGlobal, + getName, mkGlobalName, nameRdrName ) import Class ( Class, classKey ) -import TyCon ( tyConDataCons, mkFunTyCon, TyCon ) -import Type +import TyCon ( tyConDataConsIfAvailable, TyCon ) +import Type ( funTyCon ) import Bag +import BasicTypes ( Boxity(..) ) import Unique -- *Key stuff -import UniqFM ( UniqFM, listToUFM ) +import UniqFM ( UniqFM, listToUFM ) import Util ( isIn ) \end{code} @@ -74,47 +71,80 @@ We have two ``builtin name funs,'' one to look up @TyCons@ and @Classes@, the other to look up values. \begin{code} -type BuiltinNames = Bag Name - -builtinNames :: BuiltinNames +builtinNames :: Bag Name builtinNames - = -- Wired in TyCons - unionManyBags (map getTyConNames wired_in_tycons) `unionBags` + = unionManyBags + [ -- Wired in TyCons + unionManyBags (map getTyConNames wired_in_tycons) - -- Wired in Ids - listToBag (map getName wired_in_ids) `unionBags` + -- Wired in Ids + , listToBag (map getName wiredInIds) - -- PrimOps - listToBag (map (getName.primOpName) allThePrimOps) `unionBags` + -- PrimOps + , listToBag (map (getName . mkPrimOpId) allThePrimOps) - -- Other names with magic keys - listToBag knownKeyNames + -- Other names with magic keys + , listToBag knownKeyNames + ] \end{code} \begin{code} getTyConNames :: TyCon -> Bag Name getTyConNames tycon - = getName tycon `consBag` listToBag (map getName (tyConDataCons tycon)) + = getName tycon `consBag` + unionManyBags (map get_data_con_names (tyConDataConsIfAvailable tycon)) -- Synonyms return empty list of constructors + where + get_data_con_names dc = listToBag [getName (dataConId dc), -- Worker + getName (dataConWrapId dc)] -- Wrapper \end{code} - We let a lot of "non-standard" values be visible, so that we can make sense of them in interface pragmas. It's cool, though they all have "non-standard" names, so they won't get past the parser in user code. + %************************************************************************ %* * -\subsection{Wired in TyCons} +\subsection{RdrNames for the primops} %* * %************************************************************************ +These can't be in PrelNames, because we get the RdrName from the PrimOp, +which is above PrelNames in the module hierarchy. + +\begin{code} +eqH_Char_RDR = primOpRdrName CharEqOp +ltH_Char_RDR = primOpRdrName CharLtOp +eqH_Word_RDR = primOpRdrName WordEqOp +ltH_Word_RDR = primOpRdrName WordLtOp +eqH_Addr_RDR = primOpRdrName AddrEqOp +ltH_Addr_RDR = primOpRdrName AddrLtOp +eqH_Float_RDR = primOpRdrName FloatEqOp +ltH_Float_RDR = primOpRdrName FloatLtOp +eqH_Double_RDR = primOpRdrName DoubleEqOp +ltH_Double_RDR = primOpRdrName DoubleLtOp +eqH_Int_RDR = primOpRdrName IntEqOp +ltH_Int_RDR = primOpRdrName IntLtOp +geH_RDR = primOpRdrName IntGeOp +leH_RDR = primOpRdrName IntLeOp +minusH_RDR = primOpRdrName IntSubOp + +tagToEnumH_RDR = primOpRdrName TagToEnumOp +\end{code} + +%************************************************************************ +%* * +\subsection{Wired in TyCons} +%* * +%************************************************************************ \begin{code} -wired_in_tycons = [mkFunTyCon] ++ +wired_in_tycons = [funTyCon] ++ prim_tycons ++ tuple_tycons ++ + unboxed_tuple_tycons ++ data_tycons prim_tycons @@ -125,106 +155,38 @@ prim_tycons , doublePrimTyCon , floatPrimTyCon , intPrimTyCon + , int64PrimTyCon , foreignObjPrimTyCon + , weakPrimTyCon , mutableArrayPrimTyCon , mutableByteArrayPrimTyCon - , synchVarPrimTyCon + , mVarPrimTyCon + , mutVarPrimTyCon , realWorldTyCon , stablePtrPrimTyCon + , stableNamePrimTyCon , statePrimTyCon + , threadIdPrimTyCon , wordPrimTyCon + , word64PrimTyCon ] -tuple_tycons = unitTyCon : [tupleTyCon i | i <- [2..37] ] - +tuple_tycons = unitTyCon : [tupleTyCon Boxed i | i <- [2..37] ] +unboxed_tuple_tycons = [tupleTyCon Unboxed i | i <- [1..37] ] data_tycons - = [ listTyCon - , addrTyCon + = [ addrTyCon , boolTyCon , charTyCon , doubleTyCon , floatTyCon - , foreignObjTyCon , intTyCon , integerTyCon - , liftTyCon - , return2GMPsTyCon - , returnIntAndGMPTyCon - , stTyCon - , stRetTyCon - , stablePtrTyCon - , stateAndAddrPrimTyCon - , stateAndArrayPrimTyCon - , stateAndByteArrayPrimTyCon - , stateAndCharPrimTyCon - , stateAndDoublePrimTyCon - , stateAndFloatPrimTyCon - , stateAndForeignObjPrimTyCon - , stateAndIntPrimTyCon - , stateAndMutableArrayPrimTyCon - , stateAndMutableByteArrayPrimTyCon - , stateAndPtrPrimTyCon - , stateAndStablePtrPrimTyCon - , stateAndSynchVarPrimTyCon - , stateAndWordPrimTyCon - , voidTyCon + , listTyCon , wordTyCon ] \end{code} -%************************************************************************ -%* * -\subsection{Wired in Ids} -%* * -%************************************************************************ - -The WiredIn Ids ... -ToDo: Some of these should be moved to id_keys_infos! - -\begin{code} -wired_in_ids - = [ aBSENT_ERROR_ID - , augmentId - , buildId - , eRROR_ID - , foldlId - , foldrId - , iRREFUT_PAT_ERROR_ID - , integerMinusOneId - , integerPlusOneId - , integerPlusTwoId - , integerZeroId - , nON_EXHAUSTIVE_GUARDS_ERROR_ID - , nO_METHOD_BINDING_ERROR_ID - , pAR_ERROR_ID - , pAT_ERROR_ID - , packStringForCId - , rEC_CON_ERROR_ID - , rEC_UPD_ERROR_ID - , realWorldPrimId - , tRACE_ID - , unpackCString2Id - , unpackCStringAppendId - , unpackCStringFoldrId - , unpackCStringId - , unsafeCoerceId - , voidId - --- , copyableId --- , forkId --- , noFollowId --- , parAtAbsId --- , parAtForNowId --- , parAtId --- , parAtRelId --- , parGlobalId --- , parId --- , parLocalId --- , seqId - ] -\end{code} - %************************************************************************ %* * @@ -235,41 +197,32 @@ wired_in_ids Ids, Synonyms, Classes and ClassOps with builtin keys. \begin{code} -mkKnownKeyGlobal :: (RdrName, Unique) -> Name -mkKnownKeyGlobal (Qual mod occ hif, uniq) - = mkGlobalName uniq mod occ NoProvenance - -allClass_NAME = mkKnownKeyGlobal (allClass_RDR, allClassKey) -ioTyCon_NAME = mkKnownKeyGlobal (ioTyCon_RDR, ioTyConKey) -main_NAME = mkKnownKeyGlobal (main_RDR, mainKey) - knownKeyNames :: [Name] knownKeyNames - = [main_NAME, allClass_NAME, ioTyCon_NAME] - ++ - map mkKnownKeyGlobal + = map mkKnownKeyGlobal [ -- Type constructors (synonyms especially) - (ioOkDataCon_RDR, ioOkDataConKey) - , (orderingTyCon_RDR, orderingTyConKey) - , (rationalTyCon_RDR, rationalTyConKey) - , (ratioDataCon_RDR, ratioDataConKey) - , (ratioTyCon_RDR, ratioTyConKey) - , (byteArrayTyCon_RDR, byteArrayTyConKey) + (ioTyCon_RDR, ioTyConKey) + , (main_RDR, mainKey) + , (orderingTyCon_RDR, orderingTyConKey) + , (rationalTyCon_RDR, rationalTyConKey) + , (ratioDataCon_RDR, ratioDataConKey) + , (ratioTyCon_RDR, ratioTyConKey) + , (byteArrayTyCon_RDR, byteArrayTyConKey) , (mutableByteArrayTyCon_RDR, mutableByteArrayTyConKey) - + , (foreignObjTyCon_RDR, foreignObjTyConKey) + , (stablePtrTyCon_RDR, stablePtrTyConKey) + , (stablePtrDataCon_RDR, stablePtrDataConKey) -- Classes. *Must* include: -- classes that are grabbed by key (e.g., eqClassKey) -- classes in "Class.standardClassKeys" (quite a few) , (eqClass_RDR, eqClassKey) -- mentioned, derivable , (ordClass_RDR, ordClassKey) -- derivable - , (evalClass_RDR, evalClassKey) -- mentioned , (boundedClass_RDR, boundedClassKey) -- derivable , (numClass_RDR, numClassKey) -- mentioned, numeric , (enumClass_RDR, enumClassKey) -- derivable , (monadClass_RDR, monadClassKey) - , (monadZeroClass_RDR, monadZeroClassKey) , (monadPlusClass_RDR, monadPlusClassKey) , (functorClass_RDR, functorClassKey) , (showClass_RDR, showClassKey) -- derivable @@ -298,153 +251,54 @@ knownKeyNames , (eq_RDR, eqClassOpKey) , (thenM_RDR, thenMClassOpKey) , (returnM_RDR, returnMClassOpKey) - , (zeroM_RDR, zeroClassOpKey) + , (failM_RDR, failMClassOpKey) , (fromRational_RDR, fromRationalClassOpKey) + + , (deRefStablePtr_RDR, deRefStablePtrIdKey) + , (makeStablePtr_RDR, makeStablePtrIdKey) + , (bindIO_RDR, bindIOIdKey) + , (returnIO_RDR, returnIOIdKey) + , (addr2Integer_RDR, addr2IntegerIdKey) + + -- Strings and lists + , (map_RDR, mapIdKey) + , (append_RDR, appendIdKey) + , (unpackCString_RDR, unpackCStringIdKey) + , (unpackCString2_RDR, unpackCString2IdKey) + , (unpackCStringAppend_RDR, unpackCStringAppendIdKey) + , (unpackCStringFoldr_RDR, unpackCStringFoldrIdKey) + + -- List operations + , (concat_RDR, concatIdKey) + , (filter_RDR, filterIdKey) + , (zip_RDR, zipIdKey) + , (foldr_RDR, foldrIdKey) + , (build_RDR, buildIdKey) + , (augment_RDR, augmentIdKey) + + -- FFI primitive types that are not wired-in. + , (int8TyCon_RDR, int8TyConKey) + , (int16TyCon_RDR, int16TyConKey) + , (int32TyCon_RDR, int32TyConKey) + , (int64TyCon_RDR, int64TyConKey) + , (word8TyCon_RDR, word8TyConKey) + , (word16TyCon_RDR, word16TyConKey) + , (word32TyCon_RDR, word32TyConKey) + , (word64TyCon_RDR, word64TyConKey) -- Others , (otherwiseId_RDR, otherwiseIdKey) , (assert_RDR, assertIdKey) + , (runSTRep_RDR, runSTRepIdKey) ] \end{code} ToDo: make it do the ``like'' part properly (as in 0.26 and before). \begin{code} -maybeCharLikeCon, maybeIntLikeCon :: Id -> Bool -maybeCharLikeCon con = uniqueOf con == charDataConKey -maybeIntLikeCon con = uniqueOf con == intDataConKey -\end{code} - -%************************************************************************ -%* * -\subsection{Commonly-used RdrNames} -%* * -%************************************************************************ - -These RdrNames are not really "built in", but some parts of the compiler -(notably the deriving mechanism) need to mention their names, and it's convenient -to write them all down in one place. - -\begin{code} -prelude_primop op = qual (modAndOcc (primOpName op)) - -intTyCon_RDR = qual (modAndOcc intTyCon) -ioTyCon_RDR = tcQual (pREL_IO_BASE, SLIT("IO")) -ioDataCon_RDR = varQual (pREL_IO_BASE, SLIT("IO")) -ioOkDataCon_RDR = varQual (pREL_IO_BASE, SLIT("IOok")) -orderingTyCon_RDR = tcQual (pREL_BASE, SLIT("Ordering")) -rationalTyCon_RDR = tcQual (pREL_NUM, SLIT("Rational")) -ratioTyCon_RDR = tcQual (pREL_NUM, SLIT("Ratio")) -ratioDataCon_RDR = varQual (pREL_NUM, SLIT(":%")) - -byteArrayTyCon_RDR = tcQual (pREL_ARR, SLIT("ByteArray")) -mutableByteArrayTyCon_RDR = tcQual (pREL_ARR, SLIT("MutableByteArray")) - -allClass_RDR = tcQual (pREL_GHC, SLIT("All")) -eqClass_RDR = tcQual (pREL_BASE, SLIT("Eq")) -ordClass_RDR = tcQual (pREL_BASE, SLIT("Ord")) -evalClass_RDR = tcQual (pREL_BASE, SLIT("Eval")) -boundedClass_RDR = tcQual (pREL_BASE, SLIT("Bounded")) -numClass_RDR = tcQual (pREL_BASE, SLIT("Num")) -enumClass_RDR = tcQual (pREL_BASE, SLIT("Enum")) -monadClass_RDR = tcQual (pREL_BASE, SLIT("Monad")) -monadZeroClass_RDR = tcQual (pREL_BASE, SLIT("MonadZero")) -monadPlusClass_RDR = tcQual (pREL_BASE, SLIT("MonadPlus")) -functorClass_RDR = tcQual (pREL_BASE, SLIT("Functor")) -showClass_RDR = tcQual (pREL_BASE, SLIT("Show")) -realClass_RDR = tcQual (pREL_NUM, SLIT("Real")) -integralClass_RDR = tcQual (pREL_NUM, SLIT("Integral")) -fractionalClass_RDR = tcQual (pREL_NUM, SLIT("Fractional")) -floatingClass_RDR = tcQual (pREL_NUM, SLIT("Floating")) -realFracClass_RDR = tcQual (pREL_NUM, SLIT("RealFrac")) -realFloatClass_RDR = tcQual (pREL_NUM, SLIT("RealFloat")) -readClass_RDR = tcQual (pREL_READ, SLIT("Read")) -ixClass_RDR = tcQual (iX, SLIT("Ix")) -ccallableClass_RDR = tcQual (pREL_GHC, SLIT("CCallable")) -creturnableClass_RDR = tcQual (pREL_GHC, SLIT("CReturnable")) - -fromInt_RDR = varQual (pREL_BASE, SLIT("fromInt")) -fromInteger_RDR = varQual (pREL_BASE, SLIT("fromInteger")) -minus_RDR = varQual (pREL_BASE, SLIT("-")) -toEnum_RDR = varQual (pREL_BASE, SLIT("toEnum")) -fromEnum_RDR = varQual (pREL_BASE, SLIT("fromEnum")) -enumFrom_RDR = varQual (pREL_BASE, SLIT("enumFrom")) -enumFromTo_RDR = varQual (pREL_BASE, SLIT("enumFromTo")) -enumFromThen_RDR = varQual (pREL_BASE, SLIT("enumFromThen")) -enumFromThenTo_RDR = varQual (pREL_BASE, SLIT("enumFromThenTo")) - -thenM_RDR = varQual (pREL_BASE, SLIT(">>=")) -returnM_RDR = varQual (pREL_BASE, SLIT("return")) -zeroM_RDR = varQual (pREL_BASE, SLIT("zero")) -fromRational_RDR = varQual (pREL_NUM, SLIT("fromRational")) - -negate_RDR = varQual (pREL_BASE, SLIT("negate")) -eq_RDR = varQual (pREL_BASE, SLIT("==")) -ne_RDR = varQual (pREL_BASE, SLIT("/=")) -le_RDR = varQual (pREL_BASE, SLIT("<=")) -lt_RDR = varQual (pREL_BASE, SLIT("<")) -ge_RDR = varQual (pREL_BASE, SLIT(">=")) -gt_RDR = varQual (pREL_BASE, SLIT(">")) -ltTag_RDR = varQual (pREL_BASE, SLIT("LT")) -eqTag_RDR = varQual (pREL_BASE, SLIT("EQ")) -gtTag_RDR = varQual (pREL_BASE, SLIT("GT")) -max_RDR = varQual (pREL_BASE, SLIT("max")) -min_RDR = varQual (pREL_BASE, SLIT("min")) -compare_RDR = varQual (pREL_BASE, SLIT("compare")) -minBound_RDR = varQual (pREL_BASE, SLIT("minBound")) -maxBound_RDR = varQual (pREL_BASE, SLIT("maxBound")) -false_RDR = varQual (pREL_BASE, SLIT("False")) -true_RDR = varQual (pREL_BASE, SLIT("True")) -and_RDR = varQual (pREL_BASE, SLIT("&&")) -not_RDR = varQual (pREL_BASE, SLIT("not")) -compose_RDR = varQual (pREL_BASE, SLIT(".")) -append_RDR = varQual (pREL_BASE, SLIT("++")) -map_RDR = varQual (pREL_BASE, SLIT("map")) - -showList___RDR = varQual (pREL_BASE, SLIT("showList__")) -showsPrec_RDR = varQual (pREL_BASE, SLIT("showsPrec")) -showList_RDR = varQual (pREL_BASE, SLIT("showList")) -showSpace_RDR = varQual (pREL_BASE, SLIT("showSpace")) -showString_RDR = varQual (pREL_BASE, SLIT("showString")) -showParen_RDR = varQual (pREL_BASE, SLIT("showParen")) - -range_RDR = varQual (iX, SLIT("range")) -index_RDR = varQual (iX, SLIT("index")) -inRange_RDR = varQual (iX, SLIT("inRange")) - -readsPrec_RDR = varQual (pREL_READ, SLIT("readsPrec")) -readList_RDR = varQual (pREL_READ, SLIT("readList")) -readParen_RDR = varQual (pREL_READ, SLIT("readParen")) -lex_RDR = varQual (pREL_READ, SLIT("lex")) -readList___RDR = varQual (pREL_READ, SLIT("readList__")) - -plus_RDR = varQual (pREL_BASE, SLIT("+")) -times_RDR = varQual (pREL_BASE, SLIT("*")) -mkInt_RDR = varQual (pREL_BASE, SLIT("I#")) - -error_RDR = varQual (pREL_ERR, SLIT("error")) -assert_RDR = varQual (pREL_GHC, SLIT("assert")) -assertErr_RDR = varQual (pREL_ERR, SLIT("assertError")) - -eqH_Char_RDR = prelude_primop CharEqOp -ltH_Char_RDR = prelude_primop CharLtOp -eqH_Word_RDR = prelude_primop WordEqOp -ltH_Word_RDR = prelude_primop WordLtOp -eqH_Addr_RDR = prelude_primop AddrEqOp -ltH_Addr_RDR = prelude_primop AddrLtOp -eqH_Float_RDR = prelude_primop FloatEqOp -ltH_Float_RDR = prelude_primop FloatLtOp -eqH_Double_RDR = prelude_primop DoubleEqOp -ltH_Double_RDR = prelude_primop DoubleLtOp -eqH_Int_RDR = prelude_primop IntEqOp -ltH_Int_RDR = prelude_primop IntLtOp -geH_RDR = prelude_primop IntGeOp -leH_RDR = prelude_primop IntLeOp -minusH_RDR = prelude_primop IntSubOp - -main_RDR = varQual (mAIN, SLIT("main")) - -otherwiseId_RDR = varQual (pREL_BASE, SLIT("otherwise")) +maybeCharLikeCon, maybeIntLikeCon :: DataCon -> Bool +maybeCharLikeCon con = con `hasKey` charDataConKey +maybeIntLikeCon con = con `hasKey` intDataConKey \end{code} %************************************************************************ @@ -476,16 +330,26 @@ deriving_occ_info , (ordClassKey, [intTyCon_RDR, compose_RDR, eqTag_RDR]) -- EQ (from Ordering) is needed to force in the constructors -- as well as the type constructor. - , (enumClassKey, [intTyCon_RDR, map_RDR]) - , (evalClassKey, [intTyCon_RDR]) + , (enumClassKey, [intTyCon_RDR, eq_RDR, ge_RDR, and_RDR, map_RDR, plus_RDR, showsPrec_RDR, append_RDR]) + -- The last two Enum deps are only used to produce better + -- error msgs for derived toEnum methods. , (boundedClassKey, [intTyCon_RDR]) , (showClassKey, [intTyCon_RDR, numClass_RDR, ordClass_RDR, compose_RDR, showString_RDR, showParen_RDR, showSpace_RDR, showList___RDR]) - , (readClassKey, [intTyCon_RDR, numClass_RDR, ordClass_RDR, append_RDR, - lex_RDR, readParen_RDR, readList___RDR]) - , (ixClassKey, [intTyCon_RDR, numClass_RDR, and_RDR, map_RDR, enumFromTo_RDR, - returnM_RDR, zeroM_RDR]) - -- the last two are needed to force returnM, thenM and zeroM + , (readClassKey, [intTyCon_RDR, numClass_RDR, ordClass_RDR, append_RDR, + foldr_RDR, build_RDR, + -- foldr and build required for list comprehension + -- KSW 2000-06 + lex_RDR, readParen_RDR, readList___RDR, thenM_RDR]) + -- returnM (and the rest of the Monad class decl) + -- will be forced in as result of depending + -- on thenM. -- SOF 1/99 + , (ixClassKey, [intTyCon_RDR, numClass_RDR, and_RDR, map_RDR, enumFromTo_RDR, + foldr_RDR, build_RDR, + -- foldr and build required for list comprehension used + -- with single constructor types -- KSW 2000-06 + returnM_RDR, failM_RDR]) + -- the last two are needed to force returnM, thenM and failM -- in before typechecking the list(monad) comprehension -- generated for derived Ix instances (range method) -- of single constructor types. -- SOF 8/97 @@ -505,6 +369,7 @@ because the list of ambiguous dictionaries hasn't been simplified. isCcallishClass, isCreturnableClass, isNoDictClass, isNumericClass, isStandardClass :: Class -> Bool +isFractionalClass clas = classKey clas `is_elem` fractionalClassKeys isNumericClass clas = classKey clas `is_elem` numericClassKeys isStandardClass clas = classKey clas `is_elem` standardClassKeys isCcallishClass clas = classKey clas `is_elem` cCallishClassKeys @@ -512,26 +377,58 @@ isCreturnableClass clas = classKey clas == cReturnableClassKey isNoDictClass clas = classKey clas `is_elem` noDictClassKeys is_elem = isIn "is_X_Class" -numericClassKeys - = [ numClassKey - , realClassKey - , integralClassKey - , fractionalClassKey - , floatingClassKey - , realFracClassKey - , realFloatClassKey - ] - -needsDataDeclCtxtClassKeys -- see comments in TcDeriv - = [ readClassKey - ] - -cCallishClassKeys = [ cCallableClassKey, cReturnableClassKey ] +numericClassKeys = + [ numClassKey + , realClassKey + , integralClassKey + ] + ++ fractionalClassKeys + +fractionalClassKeys = + [ fractionalClassKey + , floatingClassKey + , realFracClassKey + , realFloatClassKey + ] + + -- the strictness analyser needs to know about numeric types + -- (see SaAbsInt.lhs) +numericTyKeys = + [ addrTyConKey + , wordTyConKey + , intTyConKey + , integerTyConKey + , doubleTyConKey + , floatTyConKey + ] + +needsDataDeclCtxtClassKeys = -- see comments in TcDeriv + [ readClassKey + ] + +cCallishClassKeys = + [ cCallableClassKey + , cReturnableClassKey + ] -- Renamer always imports these data decls replete with constructors - -- so that desugarer can always see the constructor. Ugh! -cCallishTyKeys = [ addrTyConKey, wordTyConKey, byteArrayTyConKey, - mutableByteArrayTyConKey, foreignObjTyConKey ] + -- so that desugarer can always see their constructors. Ugh! +cCallishTyKeys = + [ addrTyConKey + , wordTyConKey + , byteArrayTyConKey + , mutableByteArrayTyConKey + , foreignObjTyConKey + , stablePtrTyConKey + , int8TyConKey + , int16TyConKey + , int32TyConKey + , int64TyConKey + , word8TyConKey + , word16TyConKey + , word32TyConKey + , word64TyConKey + ] standardClassKeys = derivableClassKeys ++ numericClassKeys ++ cCallishClassKeys @@ -546,10 +443,5 @@ standardClassKeys noDictClassKeys -- These classes are used only for type annotations; -- they are not implemented by dictionaries, ever. = cCallishClassKeys - -- I used to think that class Eval belonged in here, but - -- we really want functions with type (Eval a => ...) and that - -- means that we really want to pass a placeholder for an Eval - -- dictionary. The unit tuple is what we'll get if we leave things - -- alone, and that'll do for now. Could arrange to drop that parameter - -- in the end. \end{code} +