X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fprelude%2FPrelInfo.lhs;h=466c140b963bc0fb56361c6f6b457f111733925c;hb=ae45ff0e9831a0dc862a5d68d03e355d7e323c62;hp=710e25413d84c596f6d4da322ae87db5a4328ecc;hpb=2f51f1402e6869c0f049ffbe7b019bf6ab80558f;p=ghc-hetmet.git diff --git a/ghc/compiler/prelude/PrelInfo.lhs b/ghc/compiler/prelude/PrelInfo.lhs index 710e254..466c140 100644 --- a/ghc/compiler/prelude/PrelInfo.lhs +++ b/ghc/compiler/prelude/PrelInfo.lhs @@ -8,91 +8,15 @@ 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 -import PrelLoop ( primOpNameInfo ) +IMP_Ubiq() +IMPORT_DELOOPER(PrelLoop) ( primOpNameInfo ) -- friends: import PrelMods -- Prelude module names @@ -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 ( origName, OrigName(..) ) 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 OrigName RnName, -- WiredIn Ids + FiniteMap OrigName RnName) -- WiredIn TyCons -- Two maps because "[]" is in both... -type BuiltinKeys = FiniteMap FAST_STRING (Unique, Name -> RnName) - -- Names with known uniques + +type BuiltinKeys = FiniteMap OrigName (Unique, Name -> RnName) + -- Names with known uniques + type BuiltinIdInfos = UniqFM IdInfo -- Info for known unique Ids builtinNameInfo @@ -185,7 +111,6 @@ builtinNameInfo -- values map pcIdWiredInInfo wired_in_ids, - map pcIdWiredInInfo parallel_ids, primop_ids ] assoc_tc_wired @@ -193,8 +118,7 @@ builtinNameInfo -- tycons map pcTyConWiredInInfo prim_tycons, map pcTyConWiredInInfo g_tycons, - map pcTyConWiredInInfo data_tycons, - map pcTyConWiredInInfo synonym_tycons + map pcTyConWiredInInfo data_tycons ] assoc_keys @@ -207,11 +131,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 +154,7 @@ prim_tycons , doublePrimTyCon , floatPrimTyCon , intPrimTyCon - , mallocPtrPrimTyCon + , foreignObjPrimTyCon , mutableArrayPrimTyCon , mutableByteArrayPrimTyCon , synchVarPrimTyCon @@ -248,13 +172,11 @@ g_con_tycons 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 @@ -265,16 +187,16 @@ data_tycons = [ addrTyCon , boolTyCon , charTyCon - , orderingTyCon , doubleTyCon , floatTyCon + , foreignObjTyCon , intTyCon , integerTyCon , liftTyCon - , mallocPtrTyCon - , ratioTyCon + , primIoTyCon , return2GMPsTyCon , returnIntAndGMPTyCon + , stTyCon , stablePtrTyCon , stateAndAddrPrimTyCon , stateAndArrayPrimTyCon @@ -282,82 +204,83 @@ data_tycons , stateAndCharPrimTyCon , stateAndDoublePrimTyCon , stateAndFloatPrimTyCon + , stateAndForeignObjPrimTyCon , stateAndIntPrimTyCon - , stateAndMallocPtrPrimTyCon , stateAndMutableArrayPrimTyCon , stateAndMutableByteArrayPrimTyCon - , stateAndSynchVarPrimTyCon , stateAndPtrPrimTyCon , stateAndStablePtrPrimTyCon + , stateAndSynchVarPrimTyCon , stateAndWordPrimTyCon , stateTyCon + , voidTyCon , wordTyCon ] - -synonym_tycons - = [ primIoTyCon - , rationalTyCon - , 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 ... 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 + = [ aBSENT_ERROR_ID , augmentId + , buildId + , copyableId + , eRROR_ID , foldlId , foldrId + , forkId + , iRREFUT_PAT_ERROR_ID + , integerMinusOneId + , integerPlusOneId + , integerPlusTwoId + , integerZeroId + , nON_EXHAUSTIVE_GUARDS_ERROR_ID + , nO_DEFAULT_METHOD_ERROR_ID + , nO_EXPLICIT_METHOD_ERROR_ID + , noFollowId + , pAR_ERROR_ID + , pAT_ERROR_ID + , packStringForCId + , parAtAbsId + , parAtForNowId + , parAtId + , parAtRelId + , parGlobalId + , parId + , parLocalId + , rEC_CON_ERROR_ID + , rEC_UPD_ERROR_ID + , realWorldPrimId + , runSTId + , seqId + , tRACE_ID + , tRACE_ID + , unpackCString2Id , unpackCStringAppendId , unpackCStringFoldrId + , unpackCStringId + , voidId ] -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 = (nameOf (origName id), WiredInId id) +pcTyConWiredInInfo :: TyCon -> (OrigName, RnName) +pcTyConWiredInInfo tc = (origName "pcTyConWiredInInfo" tc, WiredInTyCon tc) + +pcDataConWiredInInfo :: TyCon -> [(OrigName, RnName)] +pcDataConWiredInInfo tycon + = [ (origName "pcDataConWiredInInfo" con, WiredInId con) | con <- tyConDataCons tycon ] + +pcIdWiredInInfo :: Id -> (OrigName, RnName) +pcIdWiredInInfo id = (origName "pcIdWiredInInfo" id, WiredInId id) \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) -> ((OrigName gHC_BUILTINS s),n) + funny_fn (op,s) = case (primOpNameInfo op) of (_,n) -> ((OrigName gHC_BUILTINS s),n) funny_name_primops = [ (IntAddOp, SLIT("+#")) @@ -387,14 +310,30 @@ 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 :: [(OrigName, Unique, Maybe IdInfo)] id_keys_infos - = [ (SLIT("main"), mainIdKey, Nothing) - , (SLIT("mainPrimIO"), mainPrimIOIdKey, Nothing) + = [ -- here so we can check the type of main/mainPrimIO + (OrigName SLIT("Main") SLIT("main"), mainIdKey, Nothing) + , (OrigName SLIT("Main") SLIT("mainPrimIO"), mainPrimIOIdKey, Nothing) + + -- here because we use them in derived instances + , (OrigName pRELUDE SLIT("&&"), andandIdKey, Nothing) + , (OrigName pRELUDE SLIT("."), composeIdKey, Nothing) + , (OrigName pRELUDE SLIT("lex"), lexIdKey, Nothing) + , (OrigName pRELUDE SLIT("not"), notIdKey, Nothing) + , (OrigName pRELUDE SLIT("readParen"), readParenIdKey, Nothing) + , (OrigName pRELUDE SLIT("showParen"), showParenIdKey, Nothing) + , (OrigName pRELUDE SLIT("showString"), showStringIdKey,Nothing) + , (OrigName gHC__ SLIT("readList__"), ureadListIdKey, Nothing) + , (OrigName gHC__ SLIT("showList__"), ushowListIdKey, Nothing) + , (OrigName gHC__ SLIT("showSpace"), showSpaceIdKey, Nothing) ] tysyn_keys - = [ (SLIT("IO"), (iOTyConKey, RnImplicitTyCon)) + = [ (OrigName gHC__ SLIT("IO"), (iOTyConKey, RnImplicitTyCon)) + , (OrigName pRELUDE SLIT("Ordering"), (orderingTyConKey, RnImplicitTyCon)) + , (OrigName rATIO SLIT("Rational"), (rationalTyConKey, RnImplicitTyCon)) + , (OrigName rATIO SLIT("Ratio"), (ratioTyConKey, RnImplicitTyCon)) ] -- this "class_keys" list *must* include: @@ -402,37 +341,47 @@ 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) <- + [ (OrigName pRELUDE SLIT("Eq"), eqClassKey) -- mentioned, derivable + , (OrigName pRELUDE SLIT("Eval"), evalClassKey) -- mentioned + , (OrigName pRELUDE SLIT("Ord"), ordClassKey) -- derivable + , (OrigName pRELUDE SLIT("Num"), numClassKey) -- mentioned, numeric + , (OrigName pRELUDE SLIT("Real"), realClassKey) -- numeric + , (OrigName pRELUDE SLIT("Integral"), integralClassKey) -- numeric + , (OrigName pRELUDE SLIT("Fractional"), fractionalClassKey) -- numeric + , (OrigName pRELUDE SLIT("Floating"), floatingClassKey) -- numeric + , (OrigName pRELUDE SLIT("RealFrac"), realFracClassKey) -- numeric + , (OrigName pRELUDE SLIT("RealFloat"), realFloatClassKey) -- numeric + , (OrigName iX SLIT("Ix"), ixClassKey) -- derivable (but it isn't Prelude.Ix; hmmm) + , (OrigName pRELUDE SLIT("Bounded"), boundedClassKey) -- derivable + , (OrigName pRELUDE SLIT("Enum"), enumClassKey) -- derivable + , (OrigName pRELUDE SLIT("Show"), showClassKey) -- derivable + , (OrigName pRELUDE SLIT("Read"), readClassKey) -- derivable + , (OrigName pRELUDE SLIT("Monad"), monadClassKey) + , (OrigName pRELUDE SLIT("MonadZero"), monadZeroClassKey) + , (OrigName pRELUDE SLIT("MonadPlus"), monadPlusClassKey) + , (OrigName pRELUDE SLIT("Functor"), functorClassKey) + , (OrigName gHC__ SLIT("CCallable"), cCallableClassKey) -- mentioned, ccallish + , (OrigName gHC__ SLIT("CReturnable"), 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) <- + [ (OrigName pRELUDE SLIT("fromInt"), fromIntClassOpKey) + , (OrigName pRELUDE SLIT("fromInteger"), fromIntegerClassOpKey) + , (OrigName pRELUDE SLIT("fromRational"), fromRationalClassOpKey) + , (OrigName pRELUDE SLIT("enumFrom"), enumFromClassOpKey) + , (OrigName pRELUDE SLIT("enumFromThen"), enumFromThenClassOpKey) + , (OrigName pRELUDE SLIT("enumFromTo"), enumFromToClassOpKey) + , (OrigName pRELUDE SLIT("enumFromThenTo"),enumFromThenToClassOpKey) + , (OrigName pRELUDE SLIT("=="), eqClassOpKey) + , (OrigName pRELUDE SLIT(">>="), thenMClassOpKey) + , (OrigName pRELUDE SLIT("zero"), zeroClassOpKey) ]] \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}