X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fprelude%2FPrelInfo.lhs;h=0dab7976b5966c68af76e29d08035e5e96a7c1cc;hb=fd5ab9dcc7a0194d371ba41a780c3d73b0abc80f;hp=7001a7bd0161d916314f4e47f419fad364f62161;hpb=8de16184643ea3c2f9f30b5eaed18db6ef247760;p=ghc-hetmet.git diff --git a/ghc/compiler/prelude/PrelInfo.lhs b/ghc/compiler/prelude/PrelInfo.lhs index 7001a7b..0dab797 100644 --- a/ghc/compiler/prelude/PrelInfo.lhs +++ b/ghc/compiler/prelude/PrelInfo.lhs @@ -15,7 +15,7 @@ module PrelInfo ( 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, + 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, @@ -27,15 +27,19 @@ module PrelInfo ( numClass_RDR, fractionalClass_RDR, eqClass_RDR, ccallableClass_RDR, creturnableClass_RDR, monadZeroClass_RDR, enumClass_RDR, evalClass_RDR, ordClass_RDR, - main_NAME, mainPrimIO_NAME, ioTyCon_NAME, primIoTyCon_NAME, + main_NAME, mainPrimIO_NAME, ioTyCon_NAME, primIoTyCon_NAME, allClass_NAME, - needsDataDeclCtxtClassKeys, cCallishClassKeys, isNoDictClass, + needsDataDeclCtxtClassKeys, cCallishClassKeys, cCallishTyKeys, isNoDictClass, isNumericClass, isStandardClass, isCcallishClass ) where IMP_Ubiq() + +#if __GLASGOW_HASKELL__ >= 202 +import IdUtils ( primOpName ) +#else IMPORT_DELOOPER(PrelLoop) ( primOpName ) --- IMPORT_DELOOPER(IdLoop) ( SpecEnv ) +#endif -- friends: import PrelMods -- Prelude module names @@ -48,8 +52,9 @@ import TysWiredIn -- others: import SpecEnv ( SpecEnv ) import RdrHsSyn ( RdrName(..), varQual, tcQual, qual ) +import BasicTypes ( IfaceFlavour ) import Id ( GenId, SYN_IE(Id) ) -import Name ( Name, OccName(..), DefnInfo(..), Provenance(..), +import Name ( Name, OccName(..), Provenance(..), getName, mkGlobalName, modAndOcc ) import Class ( Class(..), GenClass, classKey ) import TyCon ( tyConDataCons, mkFunTyCon, TyCon ) @@ -246,8 +251,10 @@ Ids, Synonyms, Classes and ClassOps with builtin keys. \begin{code} mkKnownKeyGlobal :: (RdrName, Unique) -> Name -mkKnownKeyGlobal (Qual mod occ, uniq) = mkGlobalName uniq mod occ VanillaDefn Implicit +mkKnownKeyGlobal (Qual mod occ hif, uniq) + = mkGlobalName uniq mod occ (Implicit hif) +allClass_NAME = mkKnownKeyGlobal (allClass_RDR, allClassKey) main_NAME = mkKnownKeyGlobal (main_RDR, mainKey) mainPrimIO_NAME = mkKnownKeyGlobal (mainPrimIO_RDR, mainPrimIoKey) ioTyCon_NAME = mkKnownKeyGlobal (ioTyCon_RDR, iOTyConKey) @@ -255,14 +262,18 @@ primIoTyCon_NAME = getName primIoTyCon knownKeyNames :: [Name] knownKeyNames - = [main_NAME, mainPrimIO_NAME, ioTyCon_NAME] + = [main_NAME, mainPrimIO_NAME, ioTyCon_NAME, allClass_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) + -- Classes. *Must* include: -- classes that are grabbed by key (e.g., eqClassKey) @@ -292,15 +303,22 @@ knownKeyNames -- 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) ] \end{code} @@ -329,7 +347,12 @@ ioTyCon_RDR = tcQual (iO_BASE, SLIT("IO")) 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 (aRR_BASE, SLIT("ByteArray")) +mutableByteArrayTyCon_RDR = tcQual (aRR_BASE, SLIT("MutableByteArray")) + +allClass_RDR = tcQual (gHC__, SLIT("All")) eqClass_RDR = tcQual (pREL_BASE, SLIT("Eq")) ordClass_RDR = tcQual (pREL_BASE, SLIT("Ord")) evalClass_RDR = tcQual (pREL_BASE, SLIT("Eval")) @@ -354,6 +377,8 @@ creturnableClass_RDR = tcQual (fOREIGN, 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")) @@ -361,8 +386,9 @@ 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")) +fromRational_RDR = varQual (pREL_NUM, SLIT("fromRational")) negate_RDR = varQual (pREL_BASE, SLIT("negate")) eq_RDR = varQual (pREL_BASE, SLIT("==")) @@ -428,6 +454,8 @@ minusH_RDR = prelude_primop IntSubOp main_RDR = varQual (mAIN, SLIT("main")) mainPrimIO_RDR = varQual (gHC_MAIN, SLIT("mainPrimIO")) + +otherwiseId_RDR = varQual (pREL_BASE, SLIT("otherwise")) \end{code} %************************************************************************ @@ -456,7 +484,9 @@ derivableClassKeys = map fst deriving_occ_info deriving_occ_info = [ (eqClassKey, [intTyCon_RDR, and_RDR, not_RDR]) - , (ordClassKey, [intTyCon_RDR, compose_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]) @@ -464,7 +494,7 @@ deriving_occ_info 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]) + , (ixClassKey, [intTyCon_RDR, numClass_RDR, and_RDR, map_RDR, enumFromTo_RDR]) ] -- intTyCon: Practically any deriving needs Int, either for index calculations, -- or for taggery. @@ -502,6 +532,10 @@ needsDataDeclCtxtClassKeys -- see comments in TcDeriv 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 ] + standardClassKeys = derivableClassKeys ++ numericClassKeys ++ cCallishClassKeys --