X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fprelude%2FPrelInfo.lhs;h=a24196185da91c580300e921d70af6f8b23a8882;hb=940841711bb0c30326a5173d8107c2792919641c;hp=d6caf24710fefcc03e9760bacebb7af121cd8f2d;hpb=c9898dcb4544634e3fab247960e1f132f73e398e;p=ghc-hetmet.git diff --git a/ghc/compiler/prelude/PrelInfo.lhs b/ghc/compiler/prelude/PrelInfo.lhs index d6caf24..a241961 100644 --- a/ghc/compiler/prelude/PrelInfo.lhs +++ b/ghc/compiler/prelude/PrelInfo.lhs @@ -1,19 +1,37 @@ % -% (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 ThinAir, + 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 + + + -- Random other things + main_NAME, ioTyCon_NAME, + deRefStablePtr_NAME, makeStablePtr_NAME, + bindIO_NAME, returnIO_NAME, maybeCharLikeCon, maybeIntLikeCon, + needsDataDeclCtxtClassKeys, cCallishClassKeys, cCallishTyKeys, + isNoDictClass, isNumericClass, isStandardClass, isCcallishClass, + isCreturnableClass, numericTyKeys, fractionalClassKeys, + -- RdrNames for lots of things, mainly used in derivings 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, + enumFromThen_RDR, enumFromThenTo_RDR, succ_RDR, pred_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, @@ -21,47 +39,53 @@ module PrelInfo ( 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, + error_RDR, assertErr_RDR, getTag_RDR, tagToEnumH_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, + monadClass_RDR, enumClass_RDR, ordClass_RDR, + ioDataCon_RDR, + + main_RDR, - main_NAME, allClass_NAME, ioTyCon_NAME, + mkTupConRdrName, mkUbxTupConRdrName - needsDataDeclCtxtClassKeys, cCallishClassKeys, cCallishTyKeys, isNoDictClass, - isNumericClass, isStandardClass, isCcallishClass, isCreturnableClass ) where #include "HsVersions.h" -import IdUtils ( primOpName ) + -- friends: +import ThinAir -- Re-export all these +import MkId -- Ditto + import PrelMods -- Prelude module names -import PrelVals -- VALUES -import PrimOp ( PrimOp(..), allThePrimOps ) +import PrimOp ( PrimOp(..), allThePrimOps, primOpRdrName ) +import DataCon ( DataCon, dataConId, dataConWrapId ) import PrimRep ( PrimRep(..) ) 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, mkPreludeQual ) +import Var ( varUnique, Id ) +import Name ( Name, OccName, Provenance(..), + NameSpace, tcName, clsName, varName, dataName, + mkKnownKeyGlobal, + getName, mkGlobalName, nameRdrName ) +import RdrName ( rdrNameModule, rdrNameOcc, mkSrcQual ) import Class ( Class, classKey ) -import TyCon ( tyConDataCons, mkFunTyCon, TyCon ) -import Type +import TyCon ( tyConDataCons, TyCon ) +import Type ( funTyCon ) import Bag import Unique -- *Key stuff -import UniqFM ( UniqFM, listToUFM ) +import UniqFM ( UniqFM, listToUFM ) import Util ( isIn ) +import Panic ( panic ) \end{code} %************************************************************************ @@ -74,47 +98,54 @@ 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 wiredInIds) - -- Wired in Ids - listToBag (map getName wired_in_ids) `unionBags` + -- PrimOps + , listToBag (map (getName . mkPrimOpId) allThePrimOps) - -- PrimOps - listToBag (map (getName.primOpName) allThePrimOps) `unionBags` + -- Thin-air ids + , listToBag thinAirIdNames - -- 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 (tyConDataCons 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} %* * %************************************************************************ - \begin{code} -wired_in_tycons = [mkFunTyCon] ++ +wired_in_tycons = [funTyCon] ++ prim_tycons ++ tuple_tycons ++ + unboxed_tuple_tycons ++ data_tycons prim_tycons @@ -125,106 +156,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] ] - +unboxed_tuple_tycons = [unboxedTupleTyCon 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 +198,41 @@ 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 +ioTyCon_NAME = mkKnownKeyGlobal (ioTyCon_RDR, ioTyConKey) +main_NAME = mkKnownKeyGlobal (main_RDR, mainKey) -allClass_NAME = mkKnownKeyGlobal (allClass_RDR, allClassKey) -ioTyCon_NAME = mkKnownKeyGlobal (ioTyCon_RDR, ioTyConKey) -main_NAME = mkKnownKeyGlobal (main_RDR, mainKey) + -- Operations needed when compiling FFI decls +bindIO_NAME = mkKnownKeyGlobal (bindIO_RDR, bindIOIdKey) +returnIO_NAME = mkKnownKeyGlobal (returnIO_RDR, returnIOIdKey) +deRefStablePtr_NAME = mkKnownKeyGlobal (deRefStablePtr_RDR, deRefStablePtrIdKey) +makeStablePtr_NAME = mkKnownKeyGlobal (makeStablePtr_RDR, makeStablePtrIdKey) knownKeyNames :: [Name] knownKeyNames - = [main_NAME, allClass_NAME, ioTyCon_NAME] + = [main_NAME, ioTyCon_NAME] ++ map mkKnownKeyGlobal [ -- Type constructors (synonyms especially) - (ioOkDataCon_RDR, ioOkDataConKey) - , (orderingTyCon_RDR, orderingTyConKey) - , (rationalTyCon_RDR, rationalTyConKey) - , (ratioDataCon_RDR, ratioDataConKey) - , (ratioTyCon_RDR, ratioTyConKey) - , (byteArrayTyCon_RDR, byteArrayTyConKey) + (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,21 +261,47 @@ 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) + + , (map_RDR, mapIdKey) + , (append_RDR, appendIdKey) + + -- List operations + , (concat_RDR, concatIdKey) + , (filter_RDR, filterIdKey) + , (zip_RDR, zipIdKey) + , (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 +maybeCharLikeCon, maybeIntLikeCon :: DataCon -> Bool +maybeCharLikeCon con = getUnique con == charDataConKey +maybeIntLikeCon con = getUnique con == intDataConKey \end{code} %************************************************************************ @@ -326,127 +315,186 @@ These RdrNames are not really "built in", but some parts of the compiler 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")) +main_RDR = varQual mAIN_Name SLIT("main") +otherwiseId_RDR = varQual pREL_BASE_Name SLIT("otherwise") + +intTyCon_RDR = nameRdrName (getName intTyCon) +ioTyCon_RDR = tcQual pREL_IO_BASE_Name SLIT("IO") +ioDataCon_RDR = dataQual pREL_IO_BASE_Name SLIT("IO") +bindIO_RDR = varQual pREL_IO_BASE_Name SLIT("bindIO") +returnIO_RDR = varQual pREL_IO_BASE_Name SLIT("returnIO") + +orderingTyCon_RDR = tcQual pREL_BASE_Name SLIT("Ordering") + +rationalTyCon_RDR = tcQual pREL_REAL_Name SLIT("Rational") +ratioTyCon_RDR = tcQual pREL_REAL_Name SLIT("Ratio") +ratioDataCon_RDR = dataQual pREL_REAL_Name SLIT(":%") + +byteArrayTyCon_RDR = tcQual pREL_BYTEARR_Name SLIT("ByteArray") +mutableByteArrayTyCon_RDR = tcQual pREL_BYTEARR_Name SLIT("MutableByteArray") + +foreignObjTyCon_RDR = tcQual pREL_IO_BASE_Name SLIT("ForeignObj") +stablePtrTyCon_RDR = tcQual pREL_STABLE_Name SLIT("StablePtr") +stablePtrDataCon_RDR = dataQual pREL_STABLE_Name SLIT("StablePtr") +deRefStablePtr_RDR = varQual pREL_STABLE_Name SLIT("deRefStablePtr") +makeStablePtr_RDR = varQual pREL_STABLE_Name SLIT("makeStablePtr") + +-- Random PrelBase data constructors +mkInt_RDR = dataQual pREL_BASE_Name SLIT("I#") +false_RDR = dataQual pREL_BASE_Name SLIT("False") +true_RDR = dataQual pREL_BASE_Name SLIT("True") + +-- Random PrelBase functions +and_RDR = varQual pREL_BASE_Name SLIT("&&") +not_RDR = varQual pREL_BASE_Name SLIT("not") +compose_RDR = varQual pREL_BASE_Name SLIT(".") +append_RDR = varQual pREL_BASE_Name SLIT("++") +map_RDR = varQual pREL_BASE_Name SLIT("map") +build_RDR = varQual pREL_BASE_Name SLIT("build") +augment_RDR = varQual pREL_BASE_Name SLIT("augment") + +-- Classes Eq and Ord +eqClass_RDR = clsQual pREL_BASE_Name SLIT("Eq") +ordClass_RDR = clsQual pREL_BASE_Name SLIT("Ord") +eq_RDR = varQual pREL_BASE_Name SLIT("==") +ne_RDR = varQual pREL_BASE_Name SLIT("/=") +le_RDR = varQual pREL_BASE_Name SLIT("<=") +lt_RDR = varQual pREL_BASE_Name SLIT("<") +ge_RDR = varQual pREL_BASE_Name SLIT(">=") +gt_RDR = varQual pREL_BASE_Name SLIT(">") +ltTag_RDR = dataQual pREL_BASE_Name SLIT("LT") +eqTag_RDR = dataQual pREL_BASE_Name SLIT("EQ") +gtTag_RDR = dataQual pREL_BASE_Name SLIT("GT") +max_RDR = varQual pREL_BASE_Name SLIT("max") +min_RDR = varQual pREL_BASE_Name SLIT("min") +compare_RDR = varQual pREL_BASE_Name SLIT("compare") + +-- Class Monad +monadClass_RDR = clsQual pREL_BASE_Name SLIT("Monad") +monadPlusClass_RDR = clsQual pREL_BASE_Name SLIT("MonadPlus") +thenM_RDR = varQual pREL_BASE_Name SLIT(">>=") +returnM_RDR = varQual pREL_BASE_Name SLIT("return") +failM_RDR = varQual pREL_BASE_Name SLIT("fail") + +-- Class Functor +functorClass_RDR = clsQual pREL_BASE_Name SLIT("Functor") + +-- Class Show +showClass_RDR = clsQual pREL_SHOW_Name SLIT("Show") +showList___RDR = varQual pREL_SHOW_Name SLIT("showList__") +showsPrec_RDR = varQual pREL_SHOW_Name SLIT("showsPrec") +showList_RDR = varQual pREL_SHOW_Name SLIT("showList") +showSpace_RDR = varQual pREL_SHOW_Name SLIT("showSpace") +showString_RDR = varQual pREL_SHOW_Name SLIT("showString") +showParen_RDR = varQual pREL_SHOW_Name SLIT("showParen") + + +-- Class Read +readClass_RDR = clsQual pREL_READ_Name SLIT("Read") +readsPrec_RDR = varQual pREL_READ_Name SLIT("readsPrec") +readList_RDR = varQual pREL_READ_Name SLIT("readList") +readParen_RDR = varQual pREL_READ_Name SLIT("readParen") +lex_RDR = varQual pREL_READ_Name SLIT("lex") +readList___RDR = varQual pREL_READ_Name SLIT("readList__") + + +-- Class Num +numClass_RDR = clsQual pREL_NUM_Name SLIT("Num") +fromInt_RDR = varQual pREL_NUM_Name SLIT("fromInt") +fromInteger_RDR = varQual pREL_NUM_Name SLIT("fromInteger") +minus_RDR = varQual pREL_NUM_Name SLIT("-") +negate_RDR = varQual pREL_NUM_Name SLIT("negate") +plus_RDR = varQual pREL_NUM_Name SLIT("+") +times_RDR = varQual pREL_NUM_Name SLIT("*") + +-- Other numberic classes +realClass_RDR = clsQual pREL_REAL_Name SLIT("Real") +integralClass_RDR = clsQual pREL_REAL_Name SLIT("Integral") +realFracClass_RDR = clsQual pREL_REAL_Name SLIT("RealFrac") +fractionalClass_RDR = clsQual pREL_REAL_Name SLIT("Fractional") +fromRational_RDR = varQual pREL_REAL_Name SLIT("fromRational") + +floatingClass_RDR = clsQual pREL_FLOAT_Name SLIT("Floating") +realFloatClass_RDR = clsQual pREL_FLOAT_Name SLIT("RealFloat") + +-- Class Ix +ixClass_RDR = clsQual pREL_ARR_Name SLIT("Ix") +range_RDR = varQual pREL_ARR_Name SLIT("range") +index_RDR = varQual pREL_ARR_Name SLIT("index") +inRange_RDR = varQual pREL_ARR_Name SLIT("inRange") + +-- Class CCallable and CReturnable +ccallableClass_RDR = clsQual pREL_GHC_Name SLIT("CCallable") +creturnableClass_RDR = clsQual pREL_GHC_Name SLIT("CReturnable") + +-- Class Enum +enumClass_RDR = clsQual pREL_ENUM_Name SLIT("Enum") +succ_RDR = varQual pREL_ENUM_Name SLIT("succ") +pred_RDR = varQual pREL_ENUM_Name SLIT("pred") +toEnum_RDR = varQual pREL_ENUM_Name SLIT("toEnum") +fromEnum_RDR = varQual pREL_ENUM_Name SLIT("fromEnum") +enumFrom_RDR = varQual pREL_ENUM_Name SLIT("enumFrom") +enumFromTo_RDR = varQual pREL_ENUM_Name SLIT("enumFromTo") +enumFromThen_RDR = varQual pREL_ENUM_Name SLIT("enumFromThen") +enumFromThenTo_RDR = varQual pREL_ENUM_Name SLIT("enumFromThenTo") + +-- Class Bounded +boundedClass_RDR = clsQual pREL_ENUM_Name SLIT("Bounded") +minBound_RDR = varQual pREL_ENUM_Name SLIT("minBound") +maxBound_RDR = varQual pREL_ENUM_Name SLIT("maxBound") + + +-- List functions +concat_RDR = varQual pREL_LIST_Name SLIT("concat") +filter_RDR = varQual pREL_LIST_Name SLIT("filter") +zip_RDR = varQual pREL_LIST_Name SLIT("zip") + +int8TyCon_RDR = tcQual iNT_Name SLIT("Int8") +int16TyCon_RDR = tcQual iNT_Name SLIT("Int16") +int32TyCon_RDR = tcQual iNT_Name SLIT("Int32") +int64TyCon_RDR = tcQual pREL_ADDR_Name SLIT("Int64") + +word8TyCon_RDR = tcQual wORD_Name SLIT("Word8") +word16TyCon_RDR = tcQual wORD_Name SLIT("Word16") +word32TyCon_RDR = tcQual wORD_Name SLIT("Word32") +word64TyCon_RDR = tcQual pREL_ADDR_Name SLIT("Word64") + +error_RDR = varQual pREL_ERR_Name SLIT("error") +assert_RDR = varQual pREL_GHC_Name SLIT("assert") +assertErr_RDR = varQual pREL_ERR_Name SLIT("assertError") +runSTRep_RDR = varQual pREL_ST_Name SLIT("runSTRep") + +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 +getTag_RDR = varQual pREL_GHC_Name SLIT("getTag#") +\end{code} + +\begin{code} +mkTupConRdrName :: Int -> RdrName +mkTupConRdrName arity = case mkTupNameStr arity of + (mod, occ) -> dataQual mod occ + +mkUbxTupConRdrName :: Int -> RdrName +mkUbxTupConRdrName arity = case mkUbxTupNameStr arity of + (mod, occ) -> dataQual mod occ \end{code} + %************************************************************************ %* * \subsection[Class-std-groups]{Standard groups of Prelude classes} @@ -476,16 +524,20 @@ 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]) + 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, - returnM_RDR, zeroM_RDR]) - -- the last two are needed to force returnM, thenM and zeroM + 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 +557,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 +565,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 +631,19 @@ 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} + + +%************************************************************************ +%* * +\subsection{Local helpers} +%* * +%************************************************************************ + +\begin{code} +varQual = mkPreludeQual varName +dataQual = mkPreludeQual dataName +tcQual = mkPreludeQual tcName +clsQual = mkPreludeQual clsName +\end{code} +