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
\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
]
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}
, 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 ...
, 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("+#"))
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:
-- 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}
getOccName
)
import PrelInfo ( builtinNameInfo, BuiltinNames(..), BuiltinKeys(..) )
+import PrelMods ( pRELUDE )
import Pretty ( Pretty(..), PrettyRep )
import SrcLoc ( SrcLoc, mkUnknownSrcLoc )
import UniqFM ( UniqFM, emptyUFM )
Nothing -> lookup_nonexisting_val b_names b_key imp_var us_var rdr
lookup_nonexisting_val (b_names,_) b_key imp_var us_var rdr
- = case rdr of
- Qual _ _ -> -- builtin things *don't* have Qual names
- lookup_or_create_implicit_val b_key imp_var us_var rdr
-
- Unqual n -> case (lookupFM b_names n) of
- Nothing -> lookup_or_create_implicit_val b_key imp_var us_var rdr
- Just xx -> returnSST xx
+ = let str_mod = case rdr of { Qual m n -> (n,m); Unqual n -> (n, pRELUDE) }
+ in case (lookupFM b_names str_mod) of
+ Nothing -> lookup_or_create_implicit_val b_key imp_var us_var rdr
+ Just xx -> returnSST xx
lookup_or_create_implicit_val b_key imp_var us_var rdr
= readMutVarSST imp_var `thenSST` \ (implicit_val_fm, implicit_tc_fm) ->
case lookupFM implicit_val_fm rdr of
Just implicit -> returnSST implicit
Nothing ->
- (case rdr of
- Qual _ _ -> get_unique us_var
- Unqual n -> case (lookupFM b_key n) of
- Just (u,_) -> returnSST u
- _ -> get_unique us_var
- ) `thenSST` \ uniq ->
+ (let str_mod = case rdr of { Qual m n -> (n,m); Unqual n -> (n, pRELUDE) }
+ in case (lookupFM b_key str_mod) of
+ Just (u,_) -> returnSST u
+ _ -> get_unique us_var
+ ) `thenSST` \ uniq ->
let
implicit = mkRnImplicit (mkImplicitName uniq rdr)
new_val_fm = addToFM implicit_val_fm rdr implicit
in
- writeMutVarSST imp_var (new_val_fm, implicit_tc_fm) `thenSST_`
+ writeMutVarSST imp_var (new_val_fm, implicit_tc_fm) `thenSST_`
returnSST implicit
\end{code}
fail = failButContinueRn (mkRnUnbound rdr) (unknownNameErr err_str rdr locn) down
lookup_nonexisting_tc check mk_implicit fail (_,b_names) b_key imp_var us_var rdr
- = case rdr of
- Qual _ _ -> -- builtin things *don't* have Qual names
- lookup_or_create_implicit_tc check mk_implicit fail b_key imp_var us_var rdr
-
- Unqual n -> case (lookupFM b_names n) of
- Nothing -> lookup_or_create_implicit_tc check mk_implicit fail b_key imp_var us_var rdr
- Just xx -> returnSST xx
+ = let str_mod = case rdr of { Qual m n -> (n,m); Unqual n -> (n, pRELUDE) }
+ in case (lookupFM b_names str_mod) of
+ Nothing -> lookup_or_create_implicit_tc check mk_implicit fail b_key imp_var us_var rdr
+ Just xx -> returnSST xx
lookup_or_create_implicit_tc check mk_implicit fail b_key imp_var us_var rdr
= readMutVarSST imp_var `thenSST` \ (implicit_val_fm, implicit_tc_fm) ->
Just implicit | check implicit -> returnSST implicit
| otherwise -> fail
Nothing ->
- (case rdr of
- Qual _ _ -> get_unique us_var
- Unqual n -> case (lookupFM b_key n) of
- Just (u,_) -> returnSST u
- _ -> get_unique us_var
- ) `thenSST` \ uniq ->
+ (let str_mod = case rdr of { Qual m n -> (n,m); Unqual n -> (n, pRELUDE) }
+ in case (lookupFM b_key str_mod) of
+ Just (u,_) -> returnSST u
+ _ -> get_unique us_var
+ ) `thenSST` \ uniq ->
let
implicit = mk_implicit (mkImplicitName uniq rdr)
new_tc_fm = addToFM implicit_tc_fm rdr implicit
in
- writeMutVarSST imp_var (implicit_val_fm, new_tc_fm) `thenSST_`
+ writeMutVarSST imp_var (implicit_val_fm, new_tc_fm) `thenSST_`
returnSST implicit
\end{code}
projects / ghc-hetmet.git / commitdiff