X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fprelude%2FPrelInfo.lhs;h=12acaa9215dbdf51246c1e5778b5a15dc29d9840;hb=4b8c44044b7d54b0ca8e3585616bcf7d4dadb1d8;hp=33022296a4377c646d5ed28819bd7a67ce829d89;hpb=aae367819798b0883de61ea4d91ea2c47452884e;p=ghc-hetmet.git diff --git a/ghc/compiler/prelude/PrelInfo.lhs b/ghc/compiler/prelude/PrelInfo.lhs index 3302229..12acaa9 100644 --- a/ghc/compiler/prelude/PrelInfo.lhs +++ b/ghc/compiler/prelude/PrelInfo.lhs @@ -5,96 +5,63 @@ \begin{code} module PrelInfo ( + 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 - -- wired-in names. - - thinAirIdNames, -- Names of non-wired-in Ids that may be used out of - setThinAirIds, -- thin air in any compilation. If they are not wired in - thinAirModules, -- we must be sure to import them from some Prelude - -- interface file even if they are not overtly - -- mentioned. Subset of builtinNames. - noRepIntegerIds, - noRepStrIds, derivingOccurrences, -- For a given class C, this tells what other - -- things are needed as a result of a + derivableClassKeys, -- things are needed as a result of a -- deriving(C) clause - -- Here are the thin-air Ids themselves - addr2IntegerId, - packStringForCId, unpackCStringId, unpackCString2Id, - unpackCStringAppendId, unpackCStringFoldrId, - foldrId, + + -- 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 - main_NAME, ioTyCon_NAME, - deRefStablePtr_NAME, makeStablePtr_NAME, - bindIO_NAME, - maybeCharLikeCon, maybeIntLikeCon, needsDataDeclCtxtClassKeys, cCallishClassKeys, cCallishTyKeys, isNoDictClass, isNumericClass, isStandardClass, isCcallishClass, - isCreturnableClass, numericTyKeys, - - -- 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, 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, - 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, getTag_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, - monadClass_RDR, enumClass_RDR, ordClass_RDR, - ioDataCon_RDR, - - mkTupConRdrName, mkUbxTupConRdrName + isCreturnableClass, numericTyKeys, fractionalClassKeys, ) where #include "HsVersions.h" - -- friends: -import PrelMods -- Prelude module names -import PrelVals -- VALUES -import MkId ( mkPrimitiveId ) -import PrimOp ( PrimOp(..), allThePrimOps ) -import DataCon ( DataCon ) +import MkId -- Ditto +import PrelNames -- Prelude module names + +import PrimOp ( PrimOp(..), allThePrimOps, primOpRdrName ) +import DataCon ( DataCon, dataConId, dataConWrapId ) import PrimRep ( PrimRep(..) ) import TysPrim -- TYPES import TysWiredIn -- others: -import RdrName ( RdrName, mkPreludeQual ) +import RdrName ( RdrName ) import Var ( varUnique, Id ) import Name ( Name, OccName, Provenance(..), NameSpace, tcName, clsName, varName, dataName, - getName, mkGlobalName, nameRdrName, systemProvenance + mkKnownKeyGlobal, + getName, mkGlobalName, nameRdrName ) -import RdrName ( rdrNameModule, rdrNameOcc, mkSrcQual ) import Class ( Class, classKey ) -import TyCon ( tyConDataCons, TyCon ) +import TyCon ( tyConDataConsIfAvailable, TyCon ) import Type ( funTyCon ) import Bag +import BasicTypes ( Boxity(..) ) import Unique -- *Key stuff -import UniqFM ( UniqFM, listToUFM, lookupWithDefaultUFM ) +import UniqFM ( UniqFM, listToUFM ) import Util ( isIn ) import Panic ( panic ) - -import IOExts \end{code} %************************************************************************ @@ -114,13 +81,10 @@ builtinNames unionManyBags (map getTyConNames wired_in_tycons) -- Wired in Ids - , listToBag (map getName wired_in_ids) + , listToBag (map getName wiredInIds) -- PrimOps - , listToBag (map (getName . mkPrimitiveId) allThePrimOps) - - -- Thin-air ids - , listToBag thinAirIdNames + , listToBag (map (getName . mkPrimOpId) allThePrimOps) -- Other names with magic keys , listToBag knownKeyNames @@ -132,8 +96,11 @@ builtinNames getTyConNames :: TyCon -> Bag Name getTyConNames tycon = getName tycon `consBag` - listToBag (map getName (tyConDataCons tycon)) + 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 @@ -143,6 +110,35 @@ sense of them in interface pragmas. It's cool, though they all have %************************************************************************ %* * +\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} %* * %************************************************************************ @@ -178,8 +174,8 @@ prim_tycons , word64PrimTyCon ] -tuple_tycons = unitTyCon : [tupleTyCon i | i <- [2..37] ] -unboxed_tuple_tycons = [unboxedTupleTyCon i | i <- [1..37] ] +tuple_tycons = unitTyCon : [tupleTyCon Boxed i | i <- [2..37] ] +unboxed_tuple_tycons = [tupleTyCon Unboxed i | i <- [1..37] ] data_tycons = [ addrTyCon @@ -197,115 +193,6 @@ data_tycons %************************************************************************ %* * -\subsection{Wired in Ids} -%* * -%************************************************************************ - -\begin{code} -wired_in_ids - = [ -- These error-y things are wired in because we don't yet have - -- a way to express in an interface file that the result type variable - -- is 'open'; that is can be unified with an unboxed type - -- - -- [The interface file format now carry such information, but there's - -- no way yet of expressing at the definition site for these error-reporting - -- functions that they have an 'open' result type. -- sof 1/99] - -- - aBSENT_ERROR_ID - , eRROR_ID - , iRREFUT_PAT_ERROR_ID - , nON_EXHAUSTIVE_GUARDS_ERROR_ID - , nO_METHOD_BINDING_ERROR_ID - , pAR_ERROR_ID - , pAT_ERROR_ID - , rEC_CON_ERROR_ID - , rEC_UPD_ERROR_ID - - -- These three can't be defined in Haskell - , realWorldPrimId - , unsafeCoerceId - , getTagId - ] - -\end{code} - -%************************************************************************ -%* * -\subsection{Thin air entities} -%* * -%************************************************************************ - -These are Ids that we need to reference in various parts of the -system, and we'd like to pull them out of thin air rather than pass -them around. We'd also like to have all the IdInfo available for each -one: i.e. everything that gets pulled out of the interface file. - -The solution is to generate this map of global Ids after the -typechecker, and assign it to a global variable. Any subsequent -pass may refer to the map to pull Ids out. Any invalid -(i.e. pre-typechecker) access to the map will result in a panic. - -\begin{code} -thinAirIdNames - = map mkKnownKeyGlobal - [ - -- Needed for converting literals to Integers (used in tidyCoreExpr) - (varQual pREL_BASE SLIT("addr2Integer"), addr2IntegerIdKey) - - -- String literals - , (varQual pREL_PACK SLIT("packCString#"), packCStringIdKey) - , (varQual pREL_PACK SLIT("unpackCString#"), unpackCStringIdKey) - , (varQual pREL_PACK SLIT("unpackNBytes#"), unpackCString2IdKey) - , (varQual pREL_PACK SLIT("unpackAppendCString#"), unpackCStringAppendIdKey) - , (varQual pREL_PACK SLIT("unpackFoldrCString#"), unpackCStringFoldrIdKey) - - -- Folds; introduced by desugaring list comprehensions - , (varQual pREL_BASE SLIT("foldr"), foldrIdKey) - ] - -thinAirModules = [pREL_PACK] -- See notes with RnIfaces.findAndReadIface - -noRepIntegerIds = [addr2IntegerId] - -noRepStrIds = [unpackCString2Id, unpackCStringId] - -addr2IntegerId = lookupThinAirId addr2IntegerIdKey - -packStringForCId = lookupThinAirId packCStringIdKey -unpackCStringId = lookupThinAirId unpackCStringIdKey -unpackCString2Id = lookupThinAirId unpackCString2IdKey -unpackCStringAppendId = lookupThinAirId unpackCStringAppendIdKey -unpackCStringFoldrId = lookupThinAirId unpackCStringFoldrIdKey - -foldrId = lookupThinAirId foldrIdKey -\end{code} - - -\begin{code} -\end{code} - -\begin{code} -thinAirIdMapRef :: IORef (UniqFM Id) -thinAirIdMapRef = unsafePerformIO (newIORef (panic "thinAirIdMap: still empty")) - -setThinAirIds :: [Id] -> IO () -setThinAirIds thin_air_ids - = writeIORef thinAirIdMapRef the_map - where - the_map = listToUFM [(varUnique id, id) | id <- thin_air_ids] - -thinAirIdMap :: UniqFM Id -thinAirIdMap = unsafePerformIO (readIORef thinAirIdMapRef) - -- Read it just once, the first time someone tugs on thinAirIdMap - -lookupThinAirId :: Unique -> Id -lookupThinAirId uniq = lookupWithDefaultUFM thinAirIdMap - (panic "lookupThinAirId: no mapping") uniq -\end{code} - - -%************************************************************************ -%* * \subsection{Built-in keys} %* * %************************************************************************ @@ -313,27 +200,14 @@ lookupThinAirId uniq = lookupWithDefaultUFM thinAirIdMap Ids, Synonyms, Classes and ClassOps with builtin keys. \begin{code} -mkKnownKeyGlobal :: (RdrName, Unique) -> Name -mkKnownKeyGlobal (rdr_name, uniq) - = mkGlobalName uniq (rdrNameModule rdr_name) (rdrNameOcc rdr_name) - systemProvenance - -ioTyCon_NAME = mkKnownKeyGlobal (ioTyCon_RDR, ioTyConKey) -main_NAME = mkKnownKeyGlobal (main_RDR, mainKey) - - -- Operations needed when compiling FFI decls -bindIO_NAME = mkKnownKeyGlobal (bindIO_RDR, bindIOIdKey) -deRefStablePtr_NAME = mkKnownKeyGlobal (deRefStablePtr_RDR, deRefStablePtrIdKey) -makeStablePtr_NAME = mkKnownKeyGlobal (makeStablePtr_RDR, makeStablePtrIdKey) - knownKeyNames :: [Name] knownKeyNames - = [main_NAME, ioTyCon_NAME] - ++ - map mkKnownKeyGlobal + = map mkKnownKeyGlobal [ -- Type constructors (synonyms especially) - (orderingTyCon_RDR, orderingTyConKey) + (ioTyCon_RDR, ioTyConKey) + , (main_RDR, mainKey) + , (orderingTyCon_RDR, orderingTyConKey) , (rationalTyCon_RDR, rationalTyConKey) , (ratioDataCon_RDR, ratioDataConKey) , (ratioTyCon_RDR, ratioTyConKey) @@ -386,14 +260,24 @@ knownKeyNames , (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) @@ -408,6 +292,7 @@ knownKeyNames -- Others , (otherwiseId_RDR, otherwiseIdKey) , (assert_RDR, assertIdKey) + , (runSTRep_RDR, runSTRepIdKey) ] \end{code} @@ -415,175 +300,12 @@ ToDo: make it do the ``like'' part properly (as in 0.26 and before). \begin{code} maybeCharLikeCon, maybeIntLikeCon :: DataCon -> Bool -maybeCharLikeCon con = getUnique con == charDataConKey -maybeIntLikeCon con = getUnique con == intDataConKey +maybeCharLikeCon con = con `hasKey` charDataConKey +maybeIntLikeCon con = con `hasKey` 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 = nameRdrName (getName (mkPrimitiveId op)) - -main_RDR = varQual mAIN SLIT("main") -otherwiseId_RDR = varQual pREL_BASE SLIT("otherwise") - -intTyCon_RDR = nameRdrName (getName intTyCon) -ioTyCon_RDR = tcQual pREL_IO_BASE SLIT("IO") -ioDataCon_RDR = dataQual pREL_IO_BASE SLIT("IO") -bindIO_RDR = varQual pREL_IO_BASE SLIT("bindIO") - -orderingTyCon_RDR = tcQual pREL_BASE SLIT("Ordering") -rationalTyCon_RDR = tcQual pREL_NUM SLIT("Rational") -ratioTyCon_RDR = tcQual pREL_NUM SLIT("Ratio") -ratioDataCon_RDR = dataQual pREL_NUM SLIT(":%") - -byteArrayTyCon_RDR = tcQual pREL_ARR SLIT("ByteArray") -mutableByteArrayTyCon_RDR = tcQual pREL_ARR SLIT("MutableByteArray") - -foreignObjTyCon_RDR = tcQual pREL_IO_BASE SLIT("ForeignObj") -stablePtrTyCon_RDR = tcQual pREL_STABLE SLIT("StablePtr") -stablePtrDataCon_RDR = dataQual pREL_STABLE SLIT("StablePtr") -deRefStablePtr_RDR = varQual pREL_STABLE SLIT("deRefStablePtr") -makeStablePtr_RDR = varQual pREL_STABLE SLIT("makeStablePtr") - -eqClass_RDR = clsQual pREL_BASE SLIT("Eq") -ordClass_RDR = clsQual pREL_BASE SLIT("Ord") -boundedClass_RDR = clsQual pREL_BASE SLIT("Bounded") -numClass_RDR = clsQual pREL_BASE SLIT("Num") -enumClass_RDR = clsQual pREL_BASE SLIT("Enum") -monadClass_RDR = clsQual pREL_BASE SLIT("Monad") -monadPlusClass_RDR = clsQual pREL_BASE SLIT("MonadPlus") -functorClass_RDR = clsQual pREL_BASE SLIT("Functor") -showClass_RDR = clsQual pREL_BASE SLIT("Show") -realClass_RDR = clsQual pREL_NUM SLIT("Real") -integralClass_RDR = clsQual pREL_NUM SLIT("Integral") -fractionalClass_RDR = clsQual pREL_NUM SLIT("Fractional") -floatingClass_RDR = clsQual pREL_NUM SLIT("Floating") -realFracClass_RDR = clsQual pREL_NUM SLIT("RealFrac") -realFloatClass_RDR = clsQual pREL_NUM SLIT("RealFloat") -readClass_RDR = clsQual pREL_READ SLIT("Read") -ixClass_RDR = clsQual iX SLIT("Ix") -ccallableClass_RDR = clsQual pREL_GHC SLIT("CCallable") -creturnableClass_RDR = clsQual pREL_GHC SLIT("CReturnable") - -fromInt_RDR = varQual pREL_BASE SLIT("fromInt") -fromInteger_RDR = varQual pREL_BASE SLIT("fromInteger") -minus_RDR = varQual pREL_BASE SLIT("-") -succ_RDR = varQual pREL_BASE SLIT("succ") -pred_RDR = varQual pREL_BASE SLIT("pred") -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") -failM_RDR = varQual pREL_BASE SLIT("fail") - -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 = dataQual pREL_BASE SLIT("LT") -eqTag_RDR = dataQual pREL_BASE SLIT("EQ") -gtTag_RDR = dataQual 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 = dataQual pREL_BASE SLIT("False") -true_RDR = dataQual 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") -concat_RDR = varQual mONAD SLIT("concat") -filter_RDR = varQual mONAD SLIT("filter") -zip_RDR = varQual pREL_LIST SLIT("zip") - -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 = dataQual pREL_BASE SLIT("I#") - -int8TyCon_RDR = tcQual iNT SLIT("Int8") -int16TyCon_RDR = tcQual iNT SLIT("Int16") -int32TyCon_RDR = tcQual iNT SLIT("Int32") -int64TyCon_RDR = tcQual pREL_ADDR SLIT("Int64") - -word8TyCon_RDR = tcQual wORD SLIT("Word8") -word16TyCon_RDR = tcQual wORD SLIT("Word16") -word32TyCon_RDR = tcQual wORD SLIT("Word32") -word64TyCon_RDR = tcQual pREL_ADDR SLIT("Word64") - -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 - -getTag_RDR = varQual pREL_GHC 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} %* * %************************************************************************ @@ -617,12 +339,18 @@ deriving_occ_info , (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, + , (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, + , (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 @@ -644,6 +372,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 @@ -655,7 +384,11 @@ numericClassKeys = [ numClassKey , realClassKey , integralClassKey - , fractionalClassKey + ] + ++ fractionalClassKeys + +fractionalClassKeys = + [ fractionalClassKey , floatingClassKey , realFracClassKey , realFloatClassKey @@ -715,17 +448,3 @@ noDictClassKeys -- These classes are used only for type annotations; = cCallishClassKeys \end{code} - -%************************************************************************ -%* * -\subsection{Local helpers} -%* * -%************************************************************************ - -\begin{code} -varQual = mkPreludeQual varName -dataQual = mkPreludeQual dataName -tcQual = mkPreludeQual tcName -clsQual = mkPreludeQual clsName -\end{code} -