maybeCharLikeTyCon, maybeIntLikeTyCon
) where
-import Ubiq
-import PrelLoop ( primOpNameInfo )
+IMP_Ubiq()
+IMPORT_DELOOPER(PrelLoop) ( primOpNameInfo )
-- friends:
import PrelMods -- Prelude module names
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
\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
-- values
map pcIdWiredInInfo wired_in_ids,
- map pcIdWiredInInfo parallel_ids,
primop_ids
]
assoc_tc_wired
-- tycons
map pcTyConWiredInInfo prim_tycons,
map pcTyConWiredInInfo g_tycons,
- map pcTyConWiredInInfo data_tycons,
- map pcTyConWiredInInfo synonym_tycons
+ map pcTyConWiredInInfo data_tycons
]
assoc_keys
]
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}
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
= [ addrTyCon
, boolTyCon
, charTyCon
- , orderingTyCon
, doubleTyCon
, floatTyCon
+ , foreignObjTyCon
, intTyCon
, integerTyCon
, liftTyCon
- , foreignObjTyCon
- , ratioTyCon
+ , primIoTyCon
, return2GMPsTyCon
, returnIntAndGMPTyCon
+ , stTyCon
, stablePtrTyCon
, stateAndAddrPrimTyCon
, stateAndArrayPrimTyCon
, stateAndCharPrimTyCon
, stateAndDoublePrimTyCon
, stateAndFloatPrimTyCon
- , stateAndIntPrimTyCon
, stateAndForeignObjPrimTyCon
+ , stateAndIntPrimTyCon
, 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
- , copyableId
- , noFollowId
- , parAtAbsId
- , parAtForNowId
- , parAtId
- , parAtRelId
- , parGlobalId
- , parLocalId
- ]
-
-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("+#"))
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:
-- classes in "Class.standardClassKeys" (quite a few)
class_keys
- = [ (s, (k, RnImplicitClass)) | (s,k) <-
- [ (SLIT("Eq"), eqClassKey) -- mentioned, derivable
- , (SLIT("Eval"), evalClassKey) -- mentioned
- , (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) -- derivable (but it isn't Prelude.Ix; hmmm)
- -- see *hack* in Rename
- , (SLIT("Bounded"), boundedClassKey) -- derivable
- , (SLIT("Enum"), enumClassKey) -- derivable
- , (SLIT("Show"), showClassKey) -- derivable
- , (SLIT("Read"), readClassKey) -- derivable
- , (SLIT("Monad"), monadClassKey)
- , (SLIT("MonadZero"), monadZeroClassKey)
- , (SLIT("MonadPlus"), monadPlusClassKey)
- , (SLIT("Functor"), functorClassKey)
- , (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)
+ = [ (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}
projects / ghc-hetmet.git / blobdiff