X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fprelude%2FPrelInfo.lhs;h=d6caf24710fefcc03e9760bacebb7af121cd8f2d;hb=c9898dcb4544634e3fab247960e1f132f73e398e;hp=901af61dfb5ac673833a01f7f2589a40a997e805;hpb=7b0181919416d8f04324575b7e17031ca692f5b0;p=ghc-hetmet.git diff --git a/ghc/compiler/prelude/PrelInfo.lhs b/ghc/compiler/prelude/PrelInfo.lhs index 901af61..d6caf24 100644 --- a/ghc/compiler/prelude/PrelInfo.lhs +++ b/ghc/compiler/prelude/PrelInfo.lhs @@ -4,95 +4,41 @@ \section[PrelInfo]{The @PrelInfo@ interface to the compiler's prelude knowledge} \begin{code} -#include "HsVersions.h" - module PrelInfo ( - - pRELUDE, pRELUDE_BUILTIN, pRELUDE_CORE, pRELUDE_RATIO, - pRELUDE_LIST, pRELUDE_TEXT, - pRELUDE_PRIMIO, pRELUDE_IO, pRELUDE_PS, - gLASGOW_ST, gLASGOW_MISC, - -- finite maps for built-in things (for the renamer and typechecker): - builtinNameInfo, BuiltinNames(..), - BuiltinKeys(..), BuiltinIdInfos(..), - - -- *odd* values that need to be reached out and grabbed: - eRROR_ID, - pAT_ERROR_ID, - rEC_CON_ERROR_ID, - rEC_UPD_ERROR_ID, - iRREFUT_PAT_ERROR_ID, - nON_EXHAUSTIVE_GUARDS_ERROR_ID, - aBSENT_ERROR_ID, - packStringForCId, - unpackCStringId, unpackCString2Id, - unpackCStringAppendId, unpackCStringFoldrId, - integerZeroId, integerPlusOneId, - integerPlusTwoId, integerMinusOneId, - - ----------------------------------------------------- - -- the rest of the export list is organised by *type* - ----------------------------------------------------- - - -- type: Bool - boolTyCon, boolTy, falseDataCon, trueDataCon, - - -- types: Char#, Char, String (= [Char]) - charPrimTy, charTy, stringTy, - charPrimTyCon, charTyCon, charDataCon, - - -- type: Ordering (used in deriving) - orderingTy, ltDataCon, eqDataCon, gtDataCon, - - -- types: Double#, Double - doublePrimTy, doubleTy, - doublePrimTyCon, doubleTyCon, doubleDataCon, - - -- types: Float#, Float - floatPrimTy, floatTy, - floatPrimTyCon, floatTyCon, floatDataCon, - - -- types: Glasgow *primitive* arrays, sequencing and I/O - mkPrimIoTy, -- to typecheck "mainPrimIO" & for _ccall_s - realWorldStatePrimTy, realWorldStateTy{-boxed-}, - realWorldTy, realWorldTyCon, realWorldPrimId, - statePrimTyCon, stateDataCon, getStatePairingConInfo, - - byteArrayPrimTy, - - -- types: Void# (only used within the compiler) - voidPrimTy, voidPrimId, - - -- types: Addr#, Int#, Word#, Int - intPrimTy, intTy, intPrimTyCon, intTyCon, intDataCon, - wordPrimTyCon, wordPrimTy, wordTy, wordTyCon, wordDataCon, - addrPrimTyCon, addrPrimTy, addrTy, addrTyCon, addrDataCon, - - -- types: Integer, Rational (= Ratio Integer) - integerTy, rationalTy, - integerTyCon, integerDataCon, - rationalTyCon, ratioDataCon, - - -- type: Lift - liftTyCon, liftDataCon, mkLiftTy, - - -- type: List - listTyCon, mkListTy, nilDataCon, consDataCon, - - -- type: tuples - mkTupleTy, unitTy, - - -- for compilation of List Comprehensions and foldr - foldlId, foldrId, - mkBuild, buildId, augmentId, appendId - - -- and, finally, we must put in some (abstract) data types, - -- to make the interface self-sufficient + builtinNames, derivingOccurrences, + BuiltinNames, + + maybeCharLikeCon, maybeIntLikeCon, + + 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 -import Ubiq -import PrelLoop ( primOpNameInfo ) +#include "HsVersions.h" + +import IdUtils ( primOpName ) -- friends: import PrelMods -- Prelude module names @@ -103,20 +49,19 @@ import TysPrim -- TYPES import TysWiredIn -- others: -import CmdLineOpts ( opt_HideBuiltinNames, - opt_HideMostBuiltinNames, - opt_ForConcurrent +import RdrHsSyn ( RdrName(..), varQual, tcQual, qual ) +import BasicTypes ( IfaceFlavour ) +import Id ( GenId, Id ) +import Name ( Name, OccName(..), Provenance(..), + getName, mkGlobalName, modAndOcc ) -import FiniteMap ( FiniteMap, emptyFM, listToFM ) -import Id ( mkTupleCon, GenId, Id(..) ) -import Maybes ( catMaybes ) -import Name ( mkBuiltinName, getOrigName ) -import RnHsSyn ( RnName(..) ) -import TyCon ( tyConDataCons, mkFunTyCon, mkTupleTyCon, TyCon ) +import Class ( Class, classKey ) +import TyCon ( tyConDataCons, mkFunTyCon, TyCon ) import Type -import UniqFM ( UniqFM, emptyUFM, listToUFM ) +import Bag import Unique -- *Key stuff -import Util ( nOfThem, panic ) +import UniqFM ( UniqFM, listToUFM ) +import Util ( isIn ) \end{code} %************************************************************************ @@ -129,84 +74,29 @@ 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 RnName -- WiredIn Ids/TyCons -type BuiltinKeys = FiniteMap FAST_STRING Unique -- Names with known uniques -type BuiltinIdInfos = UniqFM IdInfo -- Info for known unique Ids - -builtinNameInfo - = if opt_HideBuiltinNames then - ( - emptyFM, - emptyFM, - emptyUFM - ) - else if opt_HideMostBuiltinNames then - ( - listToFM min_assoc_wired, - emptyFM, - emptyUFM - ) - else - ( - listToFM assoc_wired, - listToFM assoc_keys, - listToUFM assoc_id_infos - ) - - where - min_assoc_wired -- min needed when compiling bits of Prelude - = concat - [ - -- tycons - map pcTyConWiredInInfo prim_tycons, - map pcTyConWiredInInfo g_tycons, - map pcTyConWiredInInfo min_nonprim_tycon_list, - - -- data constrs - concat (map pcDataConWiredInInfo g_con_tycons), - concat (map pcDataConWiredInInfo min_nonprim_tycon_list), - - -- values - map pcIdWiredInInfo wired_in_ids, - primop_ids - ] - - assoc_wired - = concat - [ - -- tycons - map pcTyConWiredInInfo prim_tycons, - map pcTyConWiredInInfo g_tycons, - map pcTyConWiredInInfo data_tycons, - map pcTyConWiredInInfo synonym_tycons, - - -- data consts - concat (map pcDataConWiredInInfo g_con_tycons), - concat (map pcDataConWiredInInfo data_tycons), - - -- values - map pcIdWiredInInfo wired_in_ids, - map pcIdWiredInInfo parallel_ids, - primop_ids - ] - - assoc_keys - = concat - [ - id_keys, - tysyn_keys, - class_keys, - class_op_keys - ] - - id_keys = map id_key id_keys_infos - id_key (str, uniq, info) = (str, uniq) - - assoc_id_infos = catMaybes (map assoc_info id_keys_infos) - assoc_info (str, uniq, Just info) = Just (uniq, info) - assoc_info (str, uniq, Nothing) = Nothing +type BuiltinNames = Bag Name + +builtinNames :: BuiltinNames +builtinNames + = -- Wired in TyCons + unionManyBags (map getTyConNames wired_in_tycons) `unionBags` + + -- Wired in Ids + listToBag (map getName wired_in_ids) `unionBags` + + -- PrimOps + listToBag (map (getName.primOpName) allThePrimOps) `unionBags` + + -- 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} @@ -214,219 +104,452 @@ 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 = [mkFunTyCon] ++ + prim_tycons ++ + tuple_tycons ++ + data_tycons prim_tycons - = [addrPrimTyCon, - arrayPrimTyCon, - byteArrayPrimTyCon, - charPrimTyCon, - doublePrimTyCon, - floatPrimTyCon, - intPrimTyCon, - mallocPtrPrimTyCon, - mutableArrayPrimTyCon, - mutableByteArrayPrimTyCon, - synchVarPrimTyCon, - realWorldTyCon, - stablePtrPrimTyCon, - statePrimTyCon, - wordPrimTyCon + = [ addrPrimTyCon + , arrayPrimTyCon + , byteArrayPrimTyCon + , charPrimTyCon + , doublePrimTyCon + , floatPrimTyCon + , intPrimTyCon + , foreignObjPrimTyCon + , mutableArrayPrimTyCon + , mutableByteArrayPrimTyCon + , synchVarPrimTyCon + , realWorldTyCon + , stablePtrPrimTyCon + , statePrimTyCon + , wordPrimTyCon ] -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, - orderingTyCon, - charTyCon, - intTyCon, - floatTyCon, - doubleTyCon, - integerTyCon, - ratioTyCon, - liftTyCon, - return2GMPsTyCon, -- ADR asked for these last two (WDP 94/11) - returnIntAndGMPTyCon - ] +tuple_tycons = unitTyCon : [tupleTyCon i | i <- [2..37] ] data_tycons - = [ - addrTyCon, - boolTyCon, - charTyCon, - orderingTyCon, - doubleTyCon, - floatTyCon, - intTyCon, - integerTyCon, - liftTyCon, - mallocPtrTyCon, - ratioTyCon, - return2GMPsTyCon, - returnIntAndGMPTyCon, - stablePtrTyCon, - stateAndAddrPrimTyCon, - stateAndArrayPrimTyCon, - stateAndByteArrayPrimTyCon, - stateAndCharPrimTyCon, - stateAndDoublePrimTyCon, - stateAndFloatPrimTyCon, - stateAndIntPrimTyCon, - stateAndMallocPtrPrimTyCon, - stateAndMutableArrayPrimTyCon, - stateAndMutableByteArrayPrimTyCon, - stateAndSynchVarPrimTyCon, - stateAndPtrPrimTyCon, - stateAndStablePtrPrimTyCon, - stateAndWordPrimTyCon, - stateTyCon, - wordTyCon - ] - -synonym_tycons - = [ - primIoTyCon, - rationalTyCon, - stTyCon, - stringTyCon + = [ listTyCon + , 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 + , wordTyCon ] - -pcTyConWiredInInfo :: TyCon -> (FAST_STRING, RnName) -pcTyConWiredInInfo tc = (snd (getOrigName tc), WiredInTyCon tc) - -pcDataConWiredInInfo :: TyCon -> [(FAST_STRING, RnName)] -pcDataConWiredInInfo tycon - = [ (snd (getOrigName con), WiredInId con) | con <- tyConDataCons tycon ] \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 - = [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 + = [ 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 ] - -parallel_ids - = if not opt_ForConcurrent then - [] - else - [parId, - forkId -#ifdef GRAN - ,parLocalId - ,parGlobalId - -- Add later: - -- ,parAtId - -- ,parAtForNowId - -- ,copyableId - -- ,noFollowId -#endif {-GRAN-} - ] - -pcIdWiredInInfo :: Id -> (FAST_STRING, RnName) -pcIdWiredInInfo id = (snd (getOrigName id), WiredInId id) \end{code} -WiredIn primitive numeric operations ... + +%************************************************************************ +%* * +\subsection{Built-in keys} +%* * +%************************************************************************ + +Ids, Synonyms, Classes and ClassOps with builtin keys. + \begin{code} -primop_ids - = map primOpNameInfo allThePrimOps ++ map fn funny_name_primops - where - fn (op,s) = case (primOpNameInfo op) of (_,n) -> (s,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("<=##")) +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 + [ + -- Type constructors (synonyms especially) + (ioOkDataCon_RDR, ioOkDataConKey) + , (orderingTyCon_RDR, orderingTyConKey) + , (rationalTyCon_RDR, rationalTyConKey) + , (ratioDataCon_RDR, ratioDataConKey) + , (ratioTyCon_RDR, ratioTyConKey) + , (byteArrayTyCon_RDR, byteArrayTyConKey) + , (mutableByteArrayTyCon_RDR, mutableByteArrayTyConKey) + + + -- 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 + , (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) + , (zeroM_RDR, zeroClassOpKey) + , (fromRational_RDR, fromRationalClassOpKey) + + -- Others + , (otherwiseId_RDR, otherwiseIdKey) + , (assert_RDR, assertIdKey) ] \end{code} +ToDo: make it do the ``like'' part properly (as in 0.26 and before). -Ids, Synonyms, Classes and ClassOps with builtin keys. -For the Ids we may also have some builtin IdInfo. \begin{code} -id_keys_infos :: [(FAST_STRING, Unique, Maybe IdInfo)] -id_keys_infos - = [ - ] +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")) +\end{code} + +%************************************************************************ +%* * +\subsection[Class-std-groups]{Standard groups of Prelude classes} +%* * +%************************************************************************ + +@derivableClassKeys@ is also used in checking \tr{deriving} constructs +(@TcDeriv@). -tysyn_keys - = [ - (SLIT("IO"), iOTyConKey) -- SLIT("PreludeMonadicIO") +@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} +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, map_RDR]) + , (evalClassKey, [intTyCon_RDR]) + , (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 + -- 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} -class_keys - = [ - (SLIT("Eq"), eqClassKey), - (SLIT("Ord"), ordClassKey), - (SLIT("Num"), numClassKey), - (SLIT("Real"), realClassKey), - (SLIT("Integral"), integralClassKey), - (SLIT("Fractional"), fractionalClassKey), - (SLIT("Floating"), floatingClassKey), - (SLIT("RealFrac"), realFracClassKey), - (SLIT("RealFloat"), realFloatClassKey), - (SLIT("Ix"), ixClassKey), - (SLIT("Enum"), enumClassKey), - (SLIT("Show"), showClassKey), - (SLIT("Read"), readClassKey), - (SLIT("Monad"), monadClassKey), - (SLIT("MonadZero"), monadZeroClassKey), - (SLIT("Binary"), binaryClassKey), - (SLIT("_CCallable"), cCallableClassKey), - (SLIT("_CReturnable"), cReturnableClassKey) + +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} +isCcallishClass, isCreturnableClass, isNoDictClass, + isNumericClass, isStandardClass :: Class -> Bool + +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 + , fractionalClassKey + , floatingClassKey + , realFracClassKey + , realFloatClassKey ] -class_op_keys - = [ - (SLIT("fromInt"), fromIntClassOpKey), - (SLIT("fromInteger"), fromIntegerClassOpKey), - (SLIT("fromRational"), fromRationalClassOpKey), - (SLIT("enumFrom"), enumFromClassOpKey), - (SLIT("enumFromThen"), enumFromThenClassOpKey), - (SLIT("enumFromTo"), enumFromToClassOpKey), - (SLIT("enumFromThenTo"), enumFromThenToClassOpKey), - (SLIT("=="), eqClassOpKey), - (SLIT(">="), geClassOpKey) +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 ] + +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 + -- 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}