X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fprelude%2FPrelInfo.lhs;h=95af63e27c9e634951af2cdf1a3161a79d922ca0;hb=30cf375e0bc79a6b71074a5e0fd2ec393241a751;hp=710e25413d84c596f6d4da322ae87db5a4328ecc;hpb=2f51f1402e6869c0f049ffbe7b019bf6ab80558f;p=ghc-hetmet.git diff --git a/ghc/compiler/prelude/PrelInfo.lhs b/ghc/compiler/prelude/PrelInfo.lhs index 710e254..95af63e 100644 --- a/ghc/compiler/prelude/PrelInfo.lhs +++ b/ghc/compiler/prelude/PrelInfo.lhs @@ -8,87 +8,11 @@ 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 + maybeCharLikeTyCon, maybeIntLikeTyCon ) where import Ubiq @@ -110,7 +34,7 @@ import CmdLineOpts ( opt_HideBuiltinNames, import FiniteMap ( FiniteMap, emptyFM, listToFM ) import Id ( mkTupleCon, GenId, Id(..) ) import Maybes ( catMaybes ) -import Name ( origName, nameOf ) +import Name ( moduleNamePair ) import RnHsSyn ( RnName(..) ) import TyCon ( tyConDataCons, mkFunTyCon, mkTupleTyCon, TyCon ) import Type @@ -131,11 +55,13 @@ We have two ``builtin name funs,'' one to look up @TyCons@ and \begin{code} builtinNameInfo :: ( BuiltinNames, BuiltinKeys, BuiltinIdInfos ) -type BuiltinNames = (FiniteMap FAST_STRING RnName, -- WiredIn Ids - FiniteMap FAST_STRING RnName) -- WiredIn TyCons +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 (Unique, Name -> RnName) - -- Names with known uniques + +type BuiltinKeys = FiniteMap (FAST_STRING,Module) (Unique, Name -> RnName) + -- Names with known uniques + type BuiltinIdInfos = UniqFM IdInfo -- Info for known unique Ids builtinNameInfo @@ -207,11 +133,11 @@ builtinNameInfo ] id_keys = map id_key id_keys_infos - id_key (str, uniq, info) = (str, (uniq, RnImplicit)) + id_key (str_mod, uniq, info) = (str_mod, (uniq, RnImplicit)) 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 + assoc_info (str_mod, uniq, Just info) = Just (uniq, info) + assoc_info (str_mod, uniq, Nothing) = Nothing \end{code} @@ -230,7 +156,7 @@ prim_tycons , doublePrimTyCon , floatPrimTyCon , intPrimTyCon - , mallocPtrPrimTyCon + , foreignObjPrimTyCon , mutableArrayPrimTyCon , mutableByteArrayPrimTyCon , synchVarPrimTyCon @@ -271,7 +197,7 @@ data_tycons , intTyCon , integerTyCon , liftTyCon - , mallocPtrTyCon + , foreignObjTyCon , ratioTyCon , return2GMPsTyCon , returnIntAndGMPTyCon @@ -283,7 +209,7 @@ data_tycons , stateAndDoublePrimTyCon , stateAndFloatPrimTyCon , stateAndIntPrimTyCon - , stateAndMallocPtrPrimTyCon + , stateAndForeignObjPrimTyCon , stateAndMutableArrayPrimTyCon , stateAndMutableByteArrayPrimTyCon , stateAndSynchVarPrimTyCon @@ -300,13 +226,6 @@ synonym_tycons , stTyCon , stringTyCon ] - -pcTyConWiredInInfo :: TyCon -> (FAST_STRING, RnName) -pcTyConWiredInInfo tc = (nameOf (origName tc), WiredInTyCon tc) - -pcDataConWiredInInfo :: TyCon -> [(FAST_STRING, RnName)] -pcDataConWiredInInfo tycon - = [ (nameOf (origName con), WiredInId con) | con <- tyConDataCons tycon ] \end{code} The WiredIn Ids ... @@ -337,27 +256,37 @@ parallel_ids else [ parId , forkId -#ifdef GRAN - , parLocalId + , copyableId + , noFollowId + , parAtAbsId + , parAtForNowId + , parAtId + , parAtRelId , parGlobalId - -- Add later: - -- ,parAtId - -- ,parAtForNowId - -- ,copyableId - -- ,noFollowId -#endif {-GRAN-} + , parLocalId ] -pcIdWiredInInfo :: Id -> (FAST_STRING, RnName) -pcIdWiredInInfo id = (nameOf (origName id), WiredInId id) + +pcTyConWiredInInfo :: TyCon -> ((FAST_STRING,Module), RnName) +pcTyConWiredInInfo tc = (swap (moduleNamePair tc), WiredInTyCon tc) + +pcDataConWiredInInfo :: TyCon -> [((FAST_STRING,Module), RnName)] +pcDataConWiredInInfo tycon + = [ (swap (moduleNamePair con), WiredInId con) | con <- tyConDataCons tycon ] + +pcIdWiredInInfo :: Id -> ((FAST_STRING,Module), RnName) +pcIdWiredInInfo id = (swap (moduleNamePair id), WiredInId id) + +swap (x,y) = (y,x) \end{code} WiredIn primitive numeric operations ... \begin{code} primop_ids - = map primOpNameInfo allThePrimOps ++ map fn funny_name_primops + = map prim_fn allThePrimOps ++ map funny_fn funny_name_primops where - fn (op,s) = case (primOpNameInfo op) of (_,n) -> (s,n) + 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("+#")) @@ -387,14 +316,14 @@ funny_name_primops 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 :: [((FAST_STRING,Module), Unique, Maybe IdInfo)] id_keys_infos - = [ (SLIT("main"), mainIdKey, Nothing) - , (SLIT("mainPrimIO"), mainPrimIOIdKey, Nothing) + = [ ((SLIT("main"),SLIT("Main")), mainIdKey, Nothing) + , ((SLIT("mainPrimIO"),SLIT("Main")), mainPrimIOIdKey, Nothing) ] tysyn_keys - = [ (SLIT("IO"), (iOTyConKey, RnImplicitTyCon)) + = [ ((SLIT("IO"),pRELUDE), (iOTyConKey, RnImplicitTyCon)) ] -- this "class_keys" list *must* include: @@ -402,37 +331,45 @@ tysyn_keys -- classes in "Class.standardClassKeys" (quite a few) class_keys - = [ (s, (k, RnImplicitClass)) | (s,k) <- - [ (SLIT("Eq"), eqClassKey) -- mentioned, derivable - , (SLIT("Ord"), ordClassKey) -- derivable - , (SLIT("Num"), numClassKey) -- mentioned, numeric - , (SLIT("Real"), realClassKey) -- numeric - , (SLIT("Integral"), integralClassKey) -- numeric - , (SLIT("Fractional"), fractionalClassKey) -- numeric - , (SLIT("Floating"), floatingClassKey) -- numeric - , (SLIT("RealFrac"), realFracClassKey) -- numeric - , (SLIT("RealFloat"), realFloatClassKey) -- numeric --- , (SLIT("Ix"), ixClassKey) - , (SLIT("Bounded"), boundedClassKey) -- derivable - , (SLIT("Enum"), enumClassKey) -- derivable - , (SLIT("Show"), showClassKey) -- derivable - , (SLIT("Read"), readClassKey) -- derivable - , (SLIT("Monad"), monadClassKey) - , (SLIT("MonadZero"), monadZeroClassKey) - , (SLIT("CCallable"), cCallableClassKey) -- mentioned, ccallish - , (SLIT("CReturnable"), cReturnableClassKey) -- mentioned, ccallish + = [ (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 - = [ (s, (k, RnImplicit)) | (s,k) <- - [ (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) + = [ (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) ]] \end{code} + +ToDo: make it do the ``like'' part properly (as in 0.26 and before). +\begin{code} +maybeCharLikeTyCon tc = if (uniqueOf tc == charDataConKey) then Just charDataCon else Nothing +maybeIntLikeTyCon tc = if (uniqueOf tc == intDataConKey) then Just intDataCon else Nothing +\end{code}