X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fprelude%2FPrelInfo.lhs;h=58a3d8fe2e9e95b50ca1ffea948e6ee6cab9fbde;hb=e87d56ce33f663da1c445f37e95c40d814caa384;hp=ccefcf3638cea8f618434451d7ea4fdffc1f8497;hpb=e7498a3ee1d0484d02a9e86633cc179c76ebf36e;p=ghc-hetmet.git diff --git a/ghc/compiler/prelude/PrelInfo.lhs b/ghc/compiler/prelude/PrelInfo.lhs index ccefcf3..58a3d8f 100644 --- a/ghc/compiler/prelude/PrelInfo.lhs +++ b/ghc/compiler/prelude/PrelInfo.lhs @@ -1,46 +1,91 @@ % -% (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} -#include "HsVersions.h" - module PrelInfo ( + 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, + + 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, 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, 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, + monadClass_RDR, enumClass_RDR, ordClass_RDR, + ioDataCon_RDR, + + main_RDR, + + mkTupConRdrName, mkUbxTupConRdrName - -- finite maps for built-in things (for the renamer and typechecker): - builtinNameInfo, BuiltinNames(..), - BuiltinKeys(..), BuiltinIdInfos(..), - - maybeCharLikeTyCon, maybeIntLikeTyCon ) where -IMP_Ubiq() -IMPORT_DELOOPER(PrelLoop) ( primOpNameInfo ) +#include "HsVersions.h" + + -- 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 ) import PrimRep ( PrimRep(..) ) import TysPrim -- TYPES import TysWiredIn -- others: -import CmdLineOpts ( opt_HideBuiltinNames, - opt_HideMostBuiltinNames, - opt_ForConcurrent +import RdrName ( RdrName, mkPreludeQual ) +import Var ( varUnique, Id ) +import Name ( Name, OccName, Provenance(..), + NameSpace, tcName, clsName, varName, dataName, + mkKnownKeyGlobal, + getName, mkGlobalName, nameRdrName ) -import FiniteMap ( FiniteMap, emptyFM, listToFM ) -import Id ( mkTupleCon, GenId, Id(..) ) -import Maybes ( catMaybes ) -import Name ( moduleNamePair ) -import RnHsSyn ( RnName(..) ) -import TyCon ( tyConDataCons, mkFunTyCon, mkTupleTyCon, TyCon ) -import Type -import UniqFM ( UniqFM, emptyUFM, listToUFM ) +import RdrName ( rdrNameModule, rdrNameOcc, mkSrcQual ) +import Class ( Class, classKey ) +import TyCon ( tyConDataCons, TyCon ) +import Type ( funTyCon ) +import Bag import Unique -- *Key stuff -import Util ( nOfThem, panic ) +import UniqFM ( UniqFM, listToUFM ) +import Util ( isIn ) +import Panic ( panic ) \end{code} %************************************************************************ @@ -53,99 +98,52 @@ We have two ``builtin name funs,'' one to look up @TyCons@ and @Classes@, the other to look up values. \begin{code} -builtinNameInfo :: ( BuiltinNames, BuiltinKeys, BuiltinIdInfos ) - -type BuiltinNames = (FiniteMap (FAST_STRING,Module) RnName, -- WiredIn Ids - FiniteMap (FAST_STRING,Module) RnName) -- WiredIn TyCons - -- Two maps because "[]" is in both... - -type BuiltinKeys = FiniteMap (FAST_STRING,Module) (Unique, Name -> RnName) - -- Names with known uniques - -type BuiltinIdInfos = UniqFM IdInfo -- Info for known unique Ids - -builtinNameInfo - = if opt_HideBuiltinNames then - ( - (emptyFM, emptyFM), - emptyFM, - emptyUFM - ) - else if opt_HideMostBuiltinNames then - ( - (listToFM min_assoc_val_wired, listToFM min_assoc_tc_wired), - emptyFM, - emptyUFM - ) - else - ( - (listToFM assoc_val_wired, listToFM assoc_tc_wired), - listToFM assoc_keys, - listToUFM assoc_id_infos - ) - - where - min_assoc_val_wired -- min needed when compiling bits of Prelude - = concat [ - -- data constrs - concat (map pcDataConWiredInInfo g_con_tycons), - concat (map pcDataConWiredInInfo min_nonprim_tycon_list), - - -- values - map pcIdWiredInInfo wired_in_ids, - primop_ids - ] - min_assoc_tc_wired - = concat [ - -- tycons - map pcTyConWiredInInfo prim_tycons, - map pcTyConWiredInInfo g_tycons, - map pcTyConWiredInInfo min_nonprim_tycon_list - ] - - assoc_val_wired - = concat [ - -- data constrs - concat (map pcDataConWiredInInfo g_con_tycons), - concat (map pcDataConWiredInInfo data_tycons), - - -- values - map pcIdWiredInInfo wired_in_ids, - map pcIdWiredInInfo parallel_ids, - primop_ids - ] - assoc_tc_wired - = concat [ - -- tycons - map pcTyConWiredInInfo prim_tycons, - map pcTyConWiredInInfo g_tycons, - map pcTyConWiredInInfo data_tycons - ] - - assoc_keys - = concat - [ - id_keys, - tysyn_keys, - class_keys, - class_op_keys - ] - - id_keys = map id_key id_keys_infos - id_key (str_mod, uniq, info) = (str_mod, (uniq, RnImplicit)) - - assoc_id_infos = catMaybes (map assoc_info id_keys_infos) - assoc_info (str_mod, uniq, Just info) = Just (uniq, info) - assoc_info (str_mod, uniq, Nothing) = Nothing +builtinNames :: Bag Name +builtinNames + = unionManyBags + [ -- Wired in TyCons + unionManyBags (map getTyConNames wired_in_tycons) + + -- Wired in Ids + , listToBag (map getName wiredInIds) + + -- PrimOps + , listToBag (map (getName . mkPrimitiveId) allThePrimOps) + + -- Thin-air ids + , listToBag thinAirIdNames + + -- 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)) + -- Synonyms return empty list of constructors +\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. -The WiredIn TyCons and DataCons ... + +%************************************************************************ +%* * +\subsection{Wired in TyCons} +%* * +%************************************************************************ + \begin{code} +wired_in_tycons = [funTyCon] ++ + prim_tycons ++ + tuple_tycons ++ + unboxed_tuple_tycons ++ + data_tycons prim_tycons = [ addrPrimTyCon @@ -155,34 +153,24 @@ prim_tycons , doublePrimTyCon , floatPrimTyCon , intPrimTyCon + , int64PrimTyCon , foreignObjPrimTyCon + , weakPrimTyCon , mutableArrayPrimTyCon , mutableByteArrayPrimTyCon - , synchVarPrimTyCon + , mVarPrimTyCon + , mutVarPrimTyCon , realWorldTyCon , stablePtrPrimTyCon + , stableNamePrimTyCon , statePrimTyCon + , threadIdPrimTyCon , wordPrimTyCon + , word64PrimTyCon ] -g_tycons - = mkFunTyCon : g_con_tycons - -g_con_tycons - = listTyCon : mkTupleTyCon 0 : [mkTupleTyCon i | i <- [2..32] ] - -min_nonprim_tycon_list -- used w/ HideMostBuiltinNames - = [ boolTyCon - , charTyCon - , intTyCon - , floatTyCon - , doubleTyCon - , integerTyCon - , liftTyCon - , return2GMPsTyCon -- ADR asked for these last two (WDP 94/11) - , returnIntAndGMPTyCon - ] - +tuple_tycons = unitTyCon : [tupleTyCon i | i <- [2..37] ] +unboxed_tuple_tycons = [unboxedTupleTyCon i | i <- [1..37] ] data_tycons = [ addrTyCon @@ -190,194 +178,466 @@ data_tycons , charTyCon , doubleTyCon , floatTyCon - , foreignObjTyCon , intTyCon , integerTyCon - , liftTyCon - , primIoTyCon - , return2GMPsTyCon - , returnIntAndGMPTyCon - , stTyCon - , stablePtrTyCon - , stateAndAddrPrimTyCon - , stateAndArrayPrimTyCon - , stateAndByteArrayPrimTyCon - , stateAndCharPrimTyCon - , stateAndDoublePrimTyCon - , stateAndFloatPrimTyCon - , stateAndForeignObjPrimTyCon - , stateAndIntPrimTyCon - , stateAndMutableArrayPrimTyCon - , stateAndMutableByteArrayPrimTyCon - , stateAndPtrPrimTyCon - , stateAndStablePtrPrimTyCon - , stateAndSynchVarPrimTyCon - , stateAndWordPrimTyCon - , stateTyCon + , listTyCon , wordTyCon ] \end{code} -The WiredIn Ids ... -ToDo: Some of these should be moved to id_keys_infos! + +%************************************************************************ +%* * +\subsection{Built-in keys} +%* * +%************************************************************************ + +Ids, Synonyms, Classes and ClassOps with builtin keys. + \begin{code} -wired_in_ids - = [ eRROR_ID - , pAT_ERROR_ID -- occurs in i/faces - , pAR_ERROR_ID -- ditto - , tRACE_ID - - , runSTId - , seqId - , realWorldPrimId - - -- foldr/build Ids have magic unfoldings - , buildId - , augmentId - , foldlId - , foldrId - , unpackCStringAppendId - , unpackCStringFoldrId +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 + [ + -- Type constructors (synonyms especially) + (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 + , (boundedClass_RDR, boundedClassKey) -- derivable + , (numClass_RDR, numClassKey) -- mentioned, numeric + , (enumClass_RDR, enumClassKey) -- derivable + , (monadClass_RDR, monadClassKey) + , (monadPlusClass_RDR, monadPlusClassKey) + , (functorClass_RDR, functorClassKey) + , (showClass_RDR, showClassKey) -- derivable + , (realClass_RDR, realClassKey) -- numeric + , (integralClass_RDR, integralClassKey) -- numeric + , (fractionalClass_RDR, fractionalClassKey) -- numeric + , (floatingClass_RDR, floatingClassKey) -- numeric + , (realFracClass_RDR, realFracClassKey) -- numeric + , (realFloatClass_RDR, realFloatClassKey) -- numeric + , (readClass_RDR, readClassKey) -- derivable + , (ixClass_RDR, ixClassKey) -- derivable (but it isn't Prelude.Ix; hmmm) + , (ccallableClass_RDR, cCallableClassKey) -- mentioned, ccallish + , (creturnableClass_RDR, cReturnableClassKey) -- mentioned, ccallish + + -- ClassOps + , (fromInt_RDR, fromIntClassOpKey) + , (fromInteger_RDR, fromIntegerClassOpKey) + , (ge_RDR, geClassOpKey) + , (minus_RDR, minusClassOpKey) + , (enumFrom_RDR, enumFromClassOpKey) + , (enumFromThen_RDR, enumFromThenClassOpKey) + , (enumFromTo_RDR, enumFromToClassOpKey) + , (enumFromThenTo_RDR, enumFromThenToClassOpKey) + , (fromEnum_RDR, fromEnumClassOpKey) + , (toEnum_RDR, toEnumClassOpKey) + , (eq_RDR, eqClassOpKey) + , (thenM_RDR, thenMClassOpKey) + , (returnM_RDR, returnMClassOpKey) + , (failM_RDR, failMClassOpKey) + , (fromRational_RDR, fromRationalClassOpKey) + + , (deRefStablePtr_RDR, deRefStablePtrIdKey) + , (makeStablePtr_RDR, makeStablePtrIdKey) + , (bindIO_RDR, bindIOIdKey) + + , (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} -parallel_ids - = if not opt_ForConcurrent then - [] - else - [ parId - , forkId - , copyableId - , noFollowId - , parAtAbsId - , parAtForNowId - , parAtId - , parAtRelId - , parGlobalId - , parLocalId - ] +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 +\end{code} -pcTyConWiredInInfo :: TyCon -> ((FAST_STRING,Module), RnName) -pcTyConWiredInInfo tc = (swap (moduleNamePair tc), WiredInTyCon tc) +%************************************************************************ +%* * +\subsection{Commonly-used RdrNames} +%* * +%************************************************************************ -pcDataConWiredInInfo :: TyCon -> [((FAST_STRING,Module), RnName)] -pcDataConWiredInInfo tycon - = [ (swap (moduleNamePair con), WiredInId con) | con <- tyConDataCons tycon ] +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. -pcIdWiredInInfo :: Id -> ((FAST_STRING,Module), RnName) -pcIdWiredInInfo id = (swap (moduleNamePair id), WiredInId id) +\begin{code} +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") + +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 iX_Name SLIT("Ix") +range_RDR = varQual iX_Name SLIT("range") +index_RDR = varQual iX_Name SLIT("index") +inRange_RDR = varQual iX_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} -swap (x,y) = (y,x) +\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} -WiredIn primitive numeric operations ... + +%************************************************************************ +%* * +\subsection[Class-std-groups]{Standard groups of Prelude classes} +%* * +%************************************************************************ + +@derivableClassKeys@ is also used in checking \tr{deriving} constructs +(@TcDeriv@). + +@derivingOccurrences@ maps a class name to a list of the (qualified) occurrences +that will be mentioned by the derived code for the class when it is later generated. +We don't need to put in things that are WiredIn (because they are already mapped to their +correct name by the @NameSupply@. The class itself, and all its class ops, is +already flagged as an occurrence so we don't need to mention that either. + +@derivingOccurrences@ has an item for every derivable class, even if that item is empty, +because we treat lookup failure as indicating that the class is illegal in a deriving clause. + \begin{code} -primop_ids - = map prim_fn allThePrimOps ++ map funny_fn funny_name_primops - where - prim_fn op = case (primOpNameInfo op) of (s,n) -> ((s,pRELUDE),n) - funny_fn (op,s) = case (primOpNameInfo op) of (_,n) -> ((s,pRELUDE),n) - -funny_name_primops - = [ (IntAddOp, SLIT("+#")) - , (IntSubOp, SLIT("-#")) - , (IntMulOp, SLIT("*#")) - , (IntGtOp, SLIT(">#")) - , (IntGeOp, SLIT(">=#")) - , (IntEqOp, SLIT("==#")) - , (IntNeOp, SLIT("/=#")) - , (IntLtOp, SLIT("<#")) - , (IntLeOp, SLIT("<=#")) - , (DoubleAddOp, SLIT("+##")) - , (DoubleSubOp, SLIT("-##")) - , (DoubleMulOp, SLIT("*##")) - , (DoubleDivOp, SLIT("/##")) - , (DoublePowerOp, SLIT("**##")) - , (DoubleGtOp, SLIT(">##")) - , (DoubleGeOp, SLIT(">=##")) - , (DoubleEqOp, SLIT("==##")) - , (DoubleNeOp, SLIT("/=##")) - , (DoubleLtOp, SLIT("<##")) - , (DoubleLeOp, SLIT("<=##")) +derivingOccurrences :: UniqFM [RdrName] +derivingOccurrences = listToUFM deriving_occ_info + +derivableClassKeys = map fst deriving_occ_info + +deriving_occ_info + = [ (eqClassKey, [intTyCon_RDR, and_RDR, not_RDR]) + , (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, 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, 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, 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 ] + -- intTyCon: Practically any deriving needs Int, either for index calculations, + -- or for taggery. + -- ordClass: really it's the methods that are actually used. + -- numClass: for Int literals \end{code} -Ids, Synonyms, Classes and ClassOps with builtin keys. -For the Ids we may also have some builtin IdInfo. +NOTE: @Eq@ and @Text@ do need to appear in @standardClasses@ +even though every numeric class has these two as a superclass, +because the list of ambiguous dictionaries hasn't been simplified. + \begin{code} -id_keys_infos :: [((FAST_STRING,Module), Unique, Maybe IdInfo)] -id_keys_infos - = [ -- here so we can check the type of main/mainPrimIO - ((SLIT("main"),SLIT("Main")), mainIdKey, Nothing) - , ((SLIT("mainPrimIO"),SLIT("Main")), mainPrimIOIdKey, Nothing) - - -- here because we use them in derived instances - , ((SLIT("&&"), pRELUDE), andandIdKey, Nothing) - , ((SLIT("."), pRELUDE), composeIdKey, Nothing) - , ((SLIT("lex"), pRELUDE), lexIdKey, Nothing) - , ((SLIT("not"), pRELUDE), notIdKey, Nothing) - , ((SLIT("readParen"), pRELUDE), readParenIdKey, Nothing) - , ((SLIT("showParen"), pRELUDE), showParenIdKey, Nothing) - , ((SLIT("showString"), pRELUDE), showStringIdKey,Nothing) - , ((SLIT("__readList"), pRELUDE), ureadListIdKey, Nothing) - , ((SLIT("__showList"), pRELUDE), ushowListIdKey, Nothing) - , ((SLIT("__showSpace"), pRELUDE), showSpaceIdKey, Nothing) - ] +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 +isCreturnableClass clas = classKey clas == cReturnableClassKey +isNoDictClass clas = classKey clas `is_elem` noDictClassKeys +is_elem = isIn "is_X_Class" + +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 + ] -tysyn_keys - = [ ((SLIT("IO"),pRELUDE), (iOTyConKey, RnImplicitTyCon)) - , ((SLIT("Rational"),rATIO), (rationalTyConKey, RnImplicitTyCon)) - , ((SLIT("Ratio"),rATIO), (ratioTyConKey, RnImplicitTyCon)) - , ((SLIT("Ordering"),pRELUDE), (orderingTyConKey, RnImplicitTyCon)) - ] +needsDataDeclCtxtClassKeys = -- see comments in TcDeriv + [ readClassKey + ] --- this "class_keys" list *must* include: --- classes that are grabbed by key (e.g., eqClassKey) --- classes in "Class.standardClassKeys" (quite a few) - -class_keys - = [ (str_mod, (k, RnImplicitClass)) | (str_mod,k) <- - [ ((SLIT("Eq"),pRELUDE), eqClassKey) -- mentioned, derivable - , ((SLIT("Eval"),pRELUDE), evalClassKey) -- mentioned - , ((SLIT("Ord"),pRELUDE), ordClassKey) -- derivable - , ((SLIT("Num"),pRELUDE), numClassKey) -- mentioned, numeric - , ((SLIT("Real"),pRELUDE), realClassKey) -- numeric - , ((SLIT("Integral"),pRELUDE), integralClassKey) -- numeric - , ((SLIT("Fractional"),pRELUDE), fractionalClassKey) -- numeric - , ((SLIT("Floating"),pRELUDE), floatingClassKey) -- numeric - , ((SLIT("RealFrac"),pRELUDE), realFracClassKey) -- numeric - , ((SLIT("RealFloat"),pRELUDE), realFloatClassKey) -- numeric - , ((SLIT("Ix"),iX), ixClassKey) -- derivable (but it isn't Prelude.Ix; hmmm) - , ((SLIT("Bounded"),pRELUDE), boundedClassKey) -- derivable - , ((SLIT("Enum"),pRELUDE), enumClassKey) -- derivable - , ((SLIT("Show"),pRELUDE), showClassKey) -- derivable - , ((SLIT("Read"),pRELUDE), readClassKey) -- derivable - , ((SLIT("Monad"),pRELUDE), monadClassKey) - , ((SLIT("MonadZero"),pRELUDE), monadZeroClassKey) - , ((SLIT("MonadPlus"),pRELUDE), monadPlusClassKey) - , ((SLIT("Functor"),pRELUDE), functorClassKey) - , ((SLIT("_CCallable"),pRELUDE), cCallableClassKey) -- mentioned, ccallish - , ((SLIT("_CReturnable"),pRELUDE), cReturnableClassKey) -- mentioned, ccallish - ]] - -class_op_keys - = [ (str_mod, (k, RnImplicit)) | (str_mod,k) <- - [ ((SLIT("fromInt"),pRELUDE), fromIntClassOpKey) - , ((SLIT("fromInteger"),pRELUDE), fromIntegerClassOpKey) - , ((SLIT("fromRational"),pRELUDE), fromRationalClassOpKey) - , ((SLIT("enumFrom"),pRELUDE), enumFromClassOpKey) - , ((SLIT("enumFromThen"),pRELUDE), enumFromThenClassOpKey) - , ((SLIT("enumFromTo"),pRELUDE), enumFromToClassOpKey) - , ((SLIT("enumFromThenTo"),pRELUDE),enumFromThenToClassOpKey) - , ((SLIT("=="),pRELUDE), eqClassOpKey) - , ((SLIT(">>="),pRELUDE), thenMClassOpKey) - , ((SLIT("zero"),pRELUDE), zeroClassOpKey) - ]] +cCallishClassKeys = + [ cCallableClassKey + , cReturnableClassKey + ] + + -- Renamer always imports these data decls replete with constructors + -- 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 + -- + -- We have to have "CCallable" and "CReturnable" in the standard + -- classes, so that if you go... + -- + -- _ccall_ foo ... 93{-numeric literal-} ... + -- + -- ... it can do The Right Thing on the 93. + +noDictClassKeys -- These classes are used only for type annotations; + -- they are not implemented by dictionaries, ever. + = cCallishClassKeys \end{code} -ToDo: make it do the ``like'' part properly (as in 0.26 and before). + +%************************************************************************ +%* * +\subsection{Local helpers} +%* * +%************************************************************************ + \begin{code} -maybeCharLikeTyCon tc = if (uniqueOf tc == charDataConKey) then Just charDataCon else Nothing -maybeIntLikeTyCon tc = if (uniqueOf tc == intDataConKey) then Just intDataCon else Nothing +varQual = mkPreludeQual varName +dataQual = mkPreludeQual dataName +tcQual = mkPreludeQual tcName +clsQual = mkPreludeQual clsName \end{code} +