X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fprelude%2FPrelInfo.lhs;h=95af63e27c9e634951af2cdf1a3161a79d922ca0;hb=30cf375e0bc79a6b71074a5e0fd2ec393241a751;hp=dee0852bb4c778123f6a883479dfe39c897f7616;hpb=dabfa71f33eabc5a2d10959728f772aa016f1c84;p=ghc-hetmet.git diff --git a/ghc/compiler/prelude/PrelInfo.lhs b/ghc/compiler/prelude/PrelInfo.lhs index dee0852..95af63e 100644 --- a/ghc/compiler/prelude/PrelInfo.lhs +++ b/ghc/compiler/prelude/PrelInfo.lhs @@ -34,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 @@ -55,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 @@ -131,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} @@ -224,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 ... @@ -271,16 +266,27 @@ parallel_ids , 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("+#")) @@ -310,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: @@ -325,41 +331,40 @@ tysyn_keys -- 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) <- + [ ((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) + = [ (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}