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(..),
- -- lookup functions for built-in names, for the renamer:
- builtinNameInfo,
-
- -- *odd* values that need to be reached out and grabbed:
- eRROR_ID, pAT_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 TysWiredIn
-- others:
-import CmdLineOpts
-import FiniteMap
-import Id ( mkTupleCon, GenId{-instances-} )
-import Name ( Name(..) )
-import NameTypes ( mkPreludeCoreName, FullName, ShortName )
-import TyCon ( getTyConDataCons, mkFunTyCon, mkTupleTyCon, TyCon{-instances-} )
+import CmdLineOpts ( opt_HideBuiltinNames,
+ opt_HideMostBuiltinNames,
+ opt_ForConcurrent
+ )
+import FiniteMap ( FiniteMap, emptyFM, listToFM )
+import Id ( mkTupleCon, GenId, Id(..) )
+import Maybes ( catMaybes )
+import Name ( moduleNamePair )
+import RnHsSyn ( RnName(..) )
+import TyCon ( tyConDataCons, mkFunTyCon, mkTupleTyCon, TyCon )
import Type
+import UniqFM ( UniqFM, emptyUFM, listToUFM )
import Unique -- *Key stuff
import Util ( nOfThem, panic )
\end{code}
@Classes@, the other to look up values.
\begin{code}
-builtinNameInfo :: (FAST_STRING -> Maybe Name, -- name lookup fn for values
- FAST_STRING -> Maybe Name) -- name lookup fn for tycons/classes
+builtinNameInfo :: ( BuiltinNames, BuiltinKeys, BuiltinIdInfos )
+
+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,Module) (Unique, Name -> RnName)
+ -- Names with known uniques
+
+type BuiltinIdInfos = UniqFM IdInfo -- Info for known unique Ids
builtinNameInfo
- = (init_val_lookup_fn, init_tc_lookup_fn)
+ = if opt_HideBuiltinNames then
+ (
+ (emptyFM, emptyFM),
+ emptyFM,
+ emptyUFM
+ )
+ else if opt_HideMostBuiltinNames then
+ (
+ (listToFM min_assoc_val_wired, listToFM min_assoc_tc_wired),
+ emptyFM,
+ emptyUFM
+ )
+ else
+ (
+ (listToFM assoc_val_wired, listToFM assoc_tc_wired),
+ listToFM assoc_keys,
+ listToUFM assoc_id_infos
+ )
+
where
- --
- -- values (including data constructors)
- --
- init_val_lookup_fn
- = if opt_HideBuiltinNames then
- (\ x -> Nothing)
- else if opt_HideMostBuiltinNames then
- lookupFM (listToFM (concat min_val_assoc_lists))
- else
- lookupFM (listToFM (concat val_assoc_lists))
-
- min_val_assoc_lists -- min needed when compiling bits of Prelude
- = [
- concat (map pcDataConNameInfo g_con_tycons),
- concat (map pcDataConNameInfo min_nonprim_tycon_list),
- totally_wired_in_Ids,
- unboxed_ops
+ min_assoc_val_wired -- min needed when compiling bits of Prelude
+ = concat [
+ -- data constrs
+ concat (map pcDataConWiredInInfo g_con_tycons),
+ concat (map pcDataConWiredInInfo min_nonprim_tycon_list),
+
+ -- values
+ map pcIdWiredInInfo wired_in_ids,
+ primop_ids
+ ]
+ min_assoc_tc_wired
+ = concat [
+ -- tycons
+ map pcTyConWiredInInfo prim_tycons,
+ map pcTyConWiredInInfo g_tycons,
+ map pcTyConWiredInInfo min_nonprim_tycon_list
+ ]
+
+ assoc_val_wired
+ = concat [
+ -- data constrs
+ concat (map pcDataConWiredInInfo g_con_tycons),
+ concat (map pcDataConWiredInInfo data_tycons),
+
+ -- values
+ map pcIdWiredInInfo wired_in_ids,
+ map pcIdWiredInInfo parallel_ids,
+ primop_ids
]
-
- val_assoc_lists
- = [
- concat (map pcDataConNameInfo g_con_tycons),
- concat (map pcDataConNameInfo data_tycons),
- totally_wired_in_Ids,
- unboxed_ops,
- special_class_ops,
- if opt_ForConcurrent then parallel_vals else []
+ assoc_tc_wired
+ = concat [
+ -- tycons
+ map pcTyConWiredInInfo prim_tycons,
+ map pcTyConWiredInInfo g_tycons,
+ map pcTyConWiredInInfo data_tycons,
+ map pcTyConWiredInInfo synonym_tycons
]
- --
- -- type constructors and classes
- --
- init_tc_lookup_fn
- = if opt_HideBuiltinNames then
- (\ x -> Nothing)
- else if opt_HideMostBuiltinNames then
- lookupFM (listToFM (concat min_tc_assoc_lists))
- else
- lookupFM (listToFM (concat tc_assoc_lists))
-
- min_tc_assoc_lists -- again, pretty ad-hoc
- = [
- map pcTyConNameInfo prim_tycons,
- map pcTyConNameInfo g_tycons,
- map pcTyConNameInfo min_nonprim_tycon_list
+ assoc_keys
+ = concat
+ [
+ id_keys,
+ tysyn_keys,
+ class_keys,
+ class_op_keys
]
- tc_assoc_lists
- = [
- map pcTyConNameInfo prim_tycons,
- map pcTyConNameInfo g_tycons,
- map pcTyConNameInfo data_tycons,
- map pcTyConNameInfo synonym_tycons,
- std_tycon_list,
- std_class_list
- ]
+ id_keys = map id_key id_keys_infos
+ id_key (str_mod, uniq, info) = (str_mod, (uniq, RnImplicit))
+
+ assoc_id_infos = catMaybes (map assoc_info id_keys_infos)
+ assoc_info (str_mod, uniq, Just info) = Just (uniq, info)
+ assoc_info (str_mod, uniq, Nothing) = Nothing
+\end{code}
+
- -- 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.
+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 ...
+\begin{code}
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
= 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 ]
+ = [ boolTyCon
+ , orderingTyCon
+ , charTyCon
+ , intTyCon
+ , floatTyCon
+ , doubleTyCon
+ , integerTyCon
+ , ratioTyCon
+ , liftTyCon
+ , return2GMPsTyCon -- ADR asked for these last two (WDP 94/11)
+ , returnIntAndGMPTyCon
+ ]
+
data_tycons
- = [addrTyCon,
- boolTyCon,
--- byteArrayTyCon,
- charTyCon,
- orderingTyCon,
- doubleTyCon,
- floatTyCon,
- intTyCon,
- integerTyCon,
- liftTyCon,
- mallocPtrTyCon,
--- mutableArrayTyCon,
--- mutableByteArrayTyCon,
- ratioTyCon,
- return2GMPsTyCon,
- returnIntAndGMPTyCon,
- stablePtrTyCon,
- stateAndAddrPrimTyCon,
- stateAndArrayPrimTyCon,
- stateAndByteArrayPrimTyCon,
- stateAndCharPrimTyCon,
- stateAndDoublePrimTyCon,
- stateAndFloatPrimTyCon,
- stateAndIntPrimTyCon,
- stateAndMallocPtrPrimTyCon,
- stateAndMutableArrayPrimTyCon,
- stateAndMutableByteArrayPrimTyCon,
- stateAndSynchVarPrimTyCon,
- stateAndPtrPrimTyCon,
- stateAndStablePtrPrimTyCon,
- stateAndWordPrimTyCon,
- stateTyCon,
- wordTyCon
+ = [ addrTyCon
+ , boolTyCon
+ , charTyCon
+ , orderingTyCon
+ , doubleTyCon
+ , floatTyCon
+ , intTyCon
+ , integerTyCon
+ , liftTyCon
+ , foreignObjTyCon
+ , ratioTyCon
+ , return2GMPsTyCon
+ , returnIntAndGMPTyCon
+ , stablePtrTyCon
+ , stateAndAddrPrimTyCon
+ , stateAndArrayPrimTyCon
+ , stateAndByteArrayPrimTyCon
+ , stateAndCharPrimTyCon
+ , stateAndDoublePrimTyCon
+ , stateAndFloatPrimTyCon
+ , stateAndIntPrimTyCon
+ , stateAndForeignObjPrimTyCon
+ , stateAndMutableArrayPrimTyCon
+ , stateAndMutableByteArrayPrimTyCon
+ , stateAndSynchVarPrimTyCon
+ , stateAndPtrPrimTyCon
+ , stateAndStablePtrPrimTyCon
+ , stateAndWordPrimTyCon
+ , stateTyCon
+ , wordTyCon
]
synonym_tycons
- = [primIoTyCon,
- rationalTyCon,
- stTyCon,
- stringTyCon]
-
-
-totally_wired_in_Ids
- = [(SLIT("error"), WiredInVal eRROR_ID),
- (SLIT("patError#"), WiredInVal pAT_ERROR_ID), -- occurs in i/faces
- (SLIT("parError#"), WiredInVal pAR_ERROR_ID), -- ditto
- (SLIT("_trace"), WiredInVal tRACE_ID),
-
- -- now the foldr/build Ids, which need to be built in
- -- because they have magic unfoldings
- (SLIT("_build"), WiredInVal buildId),
- (SLIT("_augment"), WiredInVal augmentId),
- (SLIT("foldl"), WiredInVal foldlId),
- (SLIT("foldr"), WiredInVal foldrId),
- (SLIT("unpackAppendPS#"), WiredInVal unpackCStringAppendId),
- (SLIT("unpackFoldrPS#"), WiredInVal unpackCStringFoldrId),
-
- (SLIT("_runST"), WiredInVal runSTId),
- (SLIT("_seq_"), WiredInVal seqId), -- yes, used in sequential-land, too
- -- WDP 95/11
- (SLIT("realWorld#"), WiredInVal realWorldPrimId)
+ = [ primIoTyCon
+ , rationalTyCon
+ , stTyCon
+ , stringTyCon
]
+\end{code}
-parallel_vals
- =[(SLIT("_par_"), WiredInVal parId),
- (SLIT("_fork_"), WiredInVal forkId)
-#ifdef GRAN
- ,
- (SLIT("_parLocal_"), WiredInVal parLocalId),
- (SLIT("_parGlobal_"), WiredInVal parGlobalId)
- -- Add later:
- -- (SLIT("_parAt_"), WiredInVal parAtId)
- -- (SLIT("_parAtForNow_"), WiredInVal parAtForNowId)
- -- (SLIT("_copyable_"), WiredInVal copyableId)
- -- (SLIT("_noFollow_"), WiredInVal noFollowId)
-#endif {-GRAN-}
- ]
-
-special_class_ops
- = let
- swizzle_over (str, key)
- = (str, ClassOpName key bottom1 str bottom2)
-
- bottom1 = panic "PrelInfo.special_class_ops:class"
- bottom2 = panic "PrelInfo.special_class_ops:tag"
- in
- map swizzle_over
- [ (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),
- (SLIT("-"), negateClassOpKey)
- ]
-
-unboxed_ops
- = map primOpNameInfo allThePrimOps
- -- plus some of the same ones but w/ different names ...
- ++ map fn funny_name_primops
- where
- fn (op,s) = case (primOpNameInfo op) of (_,n) -> (s,n)
+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
+ ]
-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("<=##"))]
-
-
-std_tycon_list
- = let
- swizzle_over (mod, nm, key, arity, is_data)
- = let
- fname = mkPreludeCoreName mod nm
- in
- (nm, TyConName key fname arity is_data (panic "std_tycon_list:data_cons"))
- in
- map swizzle_over
- [(SLIT("PreludeMonadicIO"), SLIT("IO"), iOTyConKey, 1, False)
+parallel_ids
+ = if not opt_ForConcurrent then
+ []
+ else
+ [ parId
+ , forkId
+ , copyableId
+ , noFollowId
+ , parAtAbsId
+ , parAtForNowId
+ , parAtId
+ , parAtRelId
+ , parGlobalId
+ , parLocalId
]
-std_class_list
- = let
- swizzle_over (str, key)
- = (str, ClassName key (mkPreludeCoreName pRELUDE_CORE str) (panic "std_class_list:ops"))
- in
- map swizzle_over
- [(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)
- ]
+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 prim_fn allThePrimOps ++ map funny_fn funny_name_primops
+ where
+ 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("+#"))
+ , (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("<=##"))
+ ]
\end{code}
-Make table entries for various things:
+
+Ids, Synonyms, Classes and ClassOps with builtin keys.
+For the Ids we may also have some builtin IdInfo.
\begin{code}
-pcTyConNameInfo :: TyCon -> (FAST_STRING, Name)
-pcTyConNameInfo tc = (getOccurrenceName tc, WiredInTyCon tc)
+id_keys_infos :: [((FAST_STRING,Module), Unique, Maybe IdInfo)]
+id_keys_infos
+ = [ ((SLIT("main"),SLIT("Main")), mainIdKey, Nothing)
+ , ((SLIT("mainPrimIO"),SLIT("Main")), mainPrimIOIdKey, Nothing)
+ ]
+
+tysyn_keys
+ = [ ((SLIT("IO"),pRELUDE), (iOTyConKey, RnImplicitTyCon))
+ ]
-pcDataConNameInfo :: TyCon -> [(FAST_STRING, Name)]
-pcDataConNameInfo tycon
- = -- slurp out its data constructors...
- [ (getOccurrenceName con, WiredInVal con) | con <- getTyConDataCons tycon ]
+-- this "class_keys" list *must* include:
+-- classes that are grabbed by key (e.g., eqClassKey)
+-- classes in "Class.standardClassKeys" (quite a few)
+
+class_keys
+ = [ (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
+ = [ (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}
projects / ghc-hetmet.git / blobdiff