X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fprelude%2FPrelInfo.lhs;h=34e049fe041bd5ce3b28c8e8209ae0504fa7bbbc;hb=a7bad5034c1163d36522d23c4bafff3354de1d88;hp=901af61dfb5ac673833a01f7f2589a40a997e805;hpb=7b0181919416d8f04324575b7e17031ca692f5b0;p=ghc-hetmet.git diff --git a/ghc/compiler/prelude/PrelInfo.lhs b/ghc/compiler/prelude/PrelInfo.lhs index 901af61..34e049f 100644 --- a/ghc/compiler/prelude/PrelInfo.lhs +++ b/ghc/compiler/prelude/PrelInfo.lhs @@ -1,122 +1,48 @@ % -% (c) The GRASP/AQUA Project, Glasgow University, 1992-1996 +% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 % \section[PrelInfo]{The @PrelInfo@ interface to the compiler's prelude knowledge} \begin{code} -#include "HsVersions.h" - module PrelInfo ( + module PrelNames, + module MkId, - 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, + wiredInThings, -- Names of wired in things + wiredInThingEnv, + + -- Primop RdrNames + eqH_Char_RDR, ltH_Char_RDR, eqH_Word_RDR, ltH_Word_RDR, + eqH_Addr_RDR, ltH_Addr_RDR, eqH_Float_RDR, ltH_Float_RDR, + eqH_Double_RDR, ltH_Double_RDR, eqH_Int_RDR, ltH_Int_RDR, + geH_RDR, leH_RDR, minusH_RDR, tagToEnumH_RDR, - -- types: Float#, Float - floatPrimTy, floatTy, - floatPrimTyCon, floatTyCon, floatDataCon, + -- Random other things + maybeCharLikeCon, maybeIntLikeCon, - -- types: Glasgow *primitive* arrays, sequencing and I/O - mkPrimIoTy, -- to typecheck "mainPrimIO" & for _ccall_s - realWorldStatePrimTy, realWorldStateTy{-boxed-}, - realWorldTy, realWorldTyCon, realWorldPrimId, - statePrimTyCon, stateDataCon, getStatePairingConInfo, + -- Class categories + isCcallishClass, isCreturnableClass, isNoDictClass, + isNumericClass, isStandardClass - 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 ) where -import Ubiq -import PrelLoop ( primOpNameInfo ) +#include "HsVersions.h" -- friends: -import PrelMods -- Prelude module names -import PrelVals -- VALUES -import PrimOp ( PrimOp(..), allThePrimOps ) -import PrimRep ( PrimRep(..) ) -import TysPrim -- TYPES -import TysWiredIn +import PrelNames -- Prelude module names + +import PrimOp ( PrimOp(..), allThePrimOps, primOpRdrName ) +import DataCon ( DataCon ) +import MkId ( mkPrimOpId, wiredInIds ) +import MkId -- All of it, for re-export +import TysPrim ( primTyCons ) +import TysWiredIn ( wiredInTyCons ) +import HscTypes ( TyThing(..), implicitTyThingIds, TypeEnv, mkTypeEnv ) -- others: -import CmdLineOpts ( opt_HideBuiltinNames, - opt_HideMostBuiltinNames, - opt_ForConcurrent - ) -import FiniteMap ( FiniteMap, emptyFM, listToFM ) -import Id ( mkTupleCon, GenId, Id(..) ) -import Maybes ( catMaybes ) -import Name ( mkBuiltinName, getOrigName ) -import RnHsSyn ( RnName(..) ) -import TyCon ( tyConDataCons, mkFunTyCon, mkTupleTyCon, TyCon ) -import Type -import UniqFM ( UniqFM, emptyUFM, listToUFM ) -import Unique -- *Key stuff -import Util ( nOfThem, panic ) +import Class ( Class, classKey ) +import Type ( funTyCon ) +import Util ( isIn ) \end{code} %************************************************************************ @@ -129,304 +55,90 @@ We have two ``builtin name funs,'' one to look up @TyCons@ and @Classes@, the other to look up values. \begin{code} -builtinNameInfo :: ( BuiltinNames, BuiltinKeys, BuiltinIdInfos ) - -type BuiltinNames = FiniteMap FAST_STRING RnName -- WiredIn Ids/TyCons -type BuiltinKeys = FiniteMap FAST_STRING Unique -- Names with known uniques -type BuiltinIdInfos = UniqFM IdInfo -- Info for known unique Ids - -builtinNameInfo - = if opt_HideBuiltinNames then - ( - emptyFM, - emptyFM, - emptyUFM - ) - else if opt_HideMostBuiltinNames then - ( - listToFM min_assoc_wired, - emptyFM, - emptyUFM - ) - else - ( - listToFM assoc_wired, - listToFM assoc_keys, - listToUFM assoc_id_infos - ) - +wiredInThings :: [TyThing] +wiredInThings + = concat + [ -- Wired in TyCons and their implicit Ids + tycon_things + , map AnId (implicitTyThingIds tycon_things) + + -- Wired in Ids + , map AnId wiredInIds + + -- PrimOps + , map (AnId . mkPrimOpId) allThePrimOps + ] where - min_assoc_wired -- min needed when compiling bits of Prelude - = concat - [ - -- tycons - map pcTyConWiredInInfo prim_tycons, - map pcTyConWiredInInfo g_tycons, - map pcTyConWiredInInfo min_nonprim_tycon_list, - - -- data constrs - concat (map pcDataConWiredInInfo g_con_tycons), - concat (map pcDataConWiredInInfo min_nonprim_tycon_list), - - -- values - map pcIdWiredInInfo wired_in_ids, - primop_ids - ] - - assoc_wired - = concat - [ - -- tycons - map pcTyConWiredInInfo prim_tycons, - map pcTyConWiredInInfo g_tycons, - map pcTyConWiredInInfo data_tycons, - map pcTyConWiredInInfo synonym_tycons, - - -- data consts - concat (map pcDataConWiredInInfo g_con_tycons), - concat (map pcDataConWiredInInfo data_tycons), + tycon_things = map ATyCon ([funTyCon] ++ primTyCons ++ wiredInTyCons) - -- values - map pcIdWiredInInfo wired_in_ids, - map pcIdWiredInInfo parallel_ids, - primop_ids - ] - - assoc_keys - = concat - [ - id_keys, - tysyn_keys, - class_keys, - class_op_keys - ] - - id_keys = map id_key id_keys_infos - id_key (str, uniq, info) = (str, uniq) - - 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 +wiredInThingEnv :: TypeEnv +wiredInThingEnv = mkTypeEnv wiredInThings \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. -The WiredIn TyCons and DataCons ... -\begin{code} - -prim_tycons - = [addrPrimTyCon, - arrayPrimTyCon, - byteArrayPrimTyCon, - charPrimTyCon, - doublePrimTyCon, - floatPrimTyCon, - intPrimTyCon, - mallocPtrPrimTyCon, - mutableArrayPrimTyCon, - mutableByteArrayPrimTyCon, - synchVarPrimTyCon, - realWorldTyCon, - stablePtrPrimTyCon, - statePrimTyCon, - wordPrimTyCon - ] - -g_tycons - = mkFunTyCon : g_con_tycons -g_con_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 - ] - - -data_tycons - = [ - addrTyCon, - boolTyCon, - charTyCon, - orderingTyCon, - doubleTyCon, - floatTyCon, - intTyCon, - integerTyCon, - liftTyCon, - mallocPtrTyCon, - ratioTyCon, - return2GMPsTyCon, - returnIntAndGMPTyCon, - stablePtrTyCon, - stateAndAddrPrimTyCon, - stateAndArrayPrimTyCon, - stateAndByteArrayPrimTyCon, - stateAndCharPrimTyCon, - stateAndDoublePrimTyCon, - stateAndFloatPrimTyCon, - stateAndIntPrimTyCon, - stateAndMallocPtrPrimTyCon, - stateAndMutableArrayPrimTyCon, - stateAndMutableByteArrayPrimTyCon, - stateAndSynchVarPrimTyCon, - stateAndPtrPrimTyCon, - stateAndStablePtrPrimTyCon, - stateAndWordPrimTyCon, - stateTyCon, - wordTyCon - ] - -synonym_tycons - = [ - primIoTyCon, - rationalTyCon, - stTyCon, - stringTyCon - ] - -pcTyConWiredInInfo :: TyCon -> (FAST_STRING, RnName) -pcTyConWiredInInfo tc = (snd (getOrigName tc), WiredInTyCon tc) +%************************************************************************ +%* * +\subsection{RdrNames for the primops} +%* * +%************************************************************************ -pcDataConWiredInInfo :: TyCon -> [(FAST_STRING, RnName)] -pcDataConWiredInInfo tycon - = [ (snd (getOrigName con), WiredInId con) | con <- tyConDataCons tycon ] -\end{code} +These can't be in PrelNames, because we get the RdrName from the PrimOp, +which is above PrelNames in the module hierarchy. -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 - ] - -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 = (snd (getOrigName id), WiredInId id) +eqH_Char_RDR = primOpRdrName CharEqOp +ltH_Char_RDR = primOpRdrName CharLtOp +eqH_Word_RDR = primOpRdrName WordEqOp +ltH_Word_RDR = primOpRdrName WordLtOp +eqH_Addr_RDR = primOpRdrName AddrEqOp +ltH_Addr_RDR = primOpRdrName AddrLtOp +eqH_Float_RDR = primOpRdrName FloatEqOp +ltH_Float_RDR = primOpRdrName FloatLtOp +eqH_Double_RDR = primOpRdrName DoubleEqOp +ltH_Double_RDR = primOpRdrName DoubleLtOp +eqH_Int_RDR = primOpRdrName IntEqOp +ltH_Int_RDR = primOpRdrName IntLtOp +geH_RDR = primOpRdrName IntGeOp +leH_RDR = primOpRdrName IntLeOp +minusH_RDR = primOpRdrName IntSubOp + +tagToEnumH_RDR = primOpRdrName TagToEnumOp \end{code} -WiredIn primitive numeric operations ... -\begin{code} -primop_ids - = map primOpNameInfo allThePrimOps ++ map fn funny_name_primops - where - fn (op,s) = case (primOpNameInfo op) of (_,n) -> (s,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} +%************************************************************************ +%* * +\subsection{Built-in keys} +%* * +%************************************************************************ +ToDo: make it do the ``like'' part properly (as in 0.26 and before). -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 - = [ - ] +maybeCharLikeCon, maybeIntLikeCon :: DataCon -> Bool +maybeCharLikeCon con = con `hasKey` charDataConKey +maybeIntLikeCon con = con `hasKey` intDataConKey +\end{code} -tysyn_keys - = [ - (SLIT("IO"), iOTyConKey) -- SLIT("PreludeMonadicIO") - ] -class_keys - = [ - (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) - ] +%************************************************************************ +%* * +\subsection{Class predicates} +%* * +%************************************************************************ -class_op_keys - = [ - (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) - ] +\begin{code} +isCcallishClass, isCreturnableClass, isNoDictClass, + isNumericClass, isStandardClass :: Class -> Bool + +isNumericClass clas = classKey clas `is_elem` numericClassKeys +isStandardClass clas = classKey clas `is_elem` standardClassKeys +isCcallishClass clas = classKey clas `is_elem` cCallishClassKeys +isCreturnableClass clas = classKey clas == cReturnableClassKey +isNoDictClass clas = classKey clas `is_elem` noDictClassKeys +is_elem = isIn "is_X_Class" \end{code}