X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Frename%2FRnEnv.lhs;h=7bd630cbd51be104f8f41fbb33c5347902760511;hb=fe69f3c1d6062b90635963aa414c33951bf18427;hp=8c81f2e3d1078dc74a97e30afd52c415ce6d133b;hpb=bb91427f27c940e4dd0fc6c7360e7ef61264b240;p=ghc-hetmet.git diff --git a/ghc/compiler/rename/RnEnv.lhs b/ghc/compiler/rename/RnEnv.lhs index 8c81f2e..7bd630c 100644 --- a/ghc/compiler/rename/RnEnv.lhs +++ b/ghc/compiler/rename/RnEnv.lhs @@ -16,33 +16,31 @@ import RnHsSyn ( RenamedHsType ) import RdrName ( RdrName, rdrNameModule, rdrNameOcc, isQual, isUnqual, mkRdrUnqual, qualifyRdrName ) -import HsTypes ( getTyVarName, replaceTyVarName ) +import HsTypes ( hsTyVarName, hsTyVarNames, replaceTyVarName ) import RnMonad import Name ( Name, Provenance(..), ExportFlag(..), NamedThing(..), ImportReason(..), getSrcLoc, mkLocalName, mkImportedLocalName, mkGlobalName, mkUnboundName, - mkIPName, isSystemName, isWiredInName, + mkIPName, isWiredInName, hasBetterProv, nameOccName, setNameModule, nameModule, - pprOccName, isLocallyDefined, nameUnique, nameOccName, - occNameUserString, - setNameProvenance, getNameProvenance, pprNameProvenance + pprOccName, isLocallyDefined, nameUnique, + setNameProvenance, getNameProvenance, pprNameProvenance, + extendNameEnv_C, plusNameEnv_C, nameEnvElts ) import NameSet import OccName ( OccName, mkDFunOcc, occNameUserString, occNameString, occNameFlavour ) -import TysWiredIn ( tupleTyCon, unboxedTupleTyCon, listTyCon ) +import TysWiredIn ( listTyCon ) import Type ( funTyCon ) import Module ( ModuleName, mkThisModule, moduleName, mkVanillaModule, pprModuleName ) -import TyCon ( TyCon ) import FiniteMap -import Unique ( Unique, Uniquable(..) ) import UniqSupply import SrcLoc ( SrcLoc, noSrcLoc ) import Outputable -import Util ( removeDups, equivClasses, thenCmp ) +import Util ( removeDups, equivClasses, thenCmp, sortLt ) import List ( nub ) \end{code} @@ -55,72 +53,70 @@ import List ( nub ) %********************************************************* \begin{code} -newLocalTopBinder :: Module -> OccName - -> (Name -> ExportFlag) -> SrcLoc - -> RnM d Name -newLocalTopBinder mod occ rec_exp_fn loc - = newTopBinder mod occ (\name -> setNameProvenance name (LocalDef loc (rec_exp_fn name))) - -- We must set the provenance of the thing in the cache - -- correctly, particularly whether or not it is locally defined. - -- - -- Since newLocalTopBinder is used only - -- at binding occurrences, we may as well get the provenance - -- dead right first time; hence the rec_exp_fn passed in - -newImportedBinder :: Module -> RdrName -> RnM d Name -newImportedBinder mod rdr_name - = ASSERT2( isUnqual rdr_name, ppr rdr_name ) - newTopBinder mod (rdrNameOcc rdr_name) (\name -> name) - -- Provenance is already implicitImportProvenance - implicitImportProvenance = NonLocalDef ImplicitImport False -newTopBinder :: Module -> OccName -> (Name -> Name) -> RnM d Name -newTopBinder mod occ set_prov +newTopBinder :: Module -> OccName -> RnM d Name +newTopBinder mod occ = -- First check the cache - getNameSupplyRn `thenRn` \ (us, inst_ns, cache, ipcache) -> + traceRn (text "newTopBinder" <+> ppr mod <+> ppr occ) `thenRn_` + + getNameSupplyRn `thenRn` \ (us, cache, ipcache) -> let - key = (moduleName mod, occ) + key = (moduleName mod, occ) in case lookupFM cache key of - -- A hit in the cache! - -- Set the Module of the thing, and set its provenance (hack pending - -- spj update) + -- A hit in the cache! We are at the binding site of the name, which is + -- the time we know all about the Name's host Module (in particular, which + -- package it comes from), so update the Module in the name. + -- But otherwise *leave the Provenance alone*: + -- + -- * For imported names, the Provenance may already be correct. + -- e.g. We imported Prelude.hi, and set the provenance of PrelShow.Show + -- to 'UserImport from Prelude'. Note that we havn't yet opened PrelShow.hi + -- Later we find we really need PrelShow.Show, so we open PrelShow.hi, and + -- that's when we find the binding occurrence of Show. -- - -- It also means that if there are two defns for the same thing - -- in a module, then each gets a separate SrcLoc + -- * For locally defined names, we do a setProvenance on the Name + -- right after newTopBinder, and then use updateProveances to finally + -- set the provenances in the cache correctly. -- - -- There's a complication for wired-in names. We don't want to + -- NB: for wired-in names it's important not to -- forget that they are wired in even when compiling that module -- (else we spit out redundant defns into the interface file) - -- So for them we just set the provenance Just name -> let - new_name = set_prov (setNameModule name mod) + new_name = setNameModule name mod new_cache = addToFM cache key new_name in - setNameSupplyRn (us, inst_ns, new_cache, ipcache) `thenRn_` + setNameSupplyRn (us, new_cache, ipcache) `thenRn_` + traceRn (text "newTopBinder: overwrite" <+> ppr new_name) `thenRn_` returnRn new_name -- Miss in the cache! -- Build a completely new Name, and put it in the cache + -- Even for locally-defined names we use implicitImportProvenance; + -- updateProvenances will set it to rights Nothing -> let (us', us1) = splitUniqSupply us uniq = uniqFromSupply us1 - new_name = set_prov (mkGlobalName uniq mod occ implicitImportProvenance) + new_name = mkGlobalName uniq mod occ implicitImportProvenance new_cache = addToFM cache key new_name in - setNameSupplyRn (us', inst_ns, new_cache, ipcache) `thenRn_` + setNameSupplyRn (us', new_cache, ipcache) `thenRn_` + traceRn (text "newTopBinder: new" <+> ppr new_name) `thenRn_` returnRn new_name -mkImportedGlobalName :: ModuleName -> OccName -> RnM d Name +newGlobalName :: ModuleName -> OccName -> RnM d Name -- Used for *occurrences*. We make a place-holder Name, really just -- to agree on its unique, which gets overwritten when we read in -- the binding occurence later (newImportedBinder) -- The place-holder Name doesn't have the right Provenance, and its - -- Module won't have the right Package either + -- Module won't have the right Package either. + -- + -- (We have to pass a ModuleName, not a Module, because we may be + -- simply looking at an occurrence M.x in an interface file.) -- -- This means that a renamed program may have incorrect info -- on implicitly-imported occurrences, but the correct info on the @@ -130,14 +126,17 @@ mkImportedGlobalName :: ModuleName -> OccName -> RnM d Name -- it doesn't matter that we get the correct info in place till later, -- (but since it affects DLL-ery it does matter that we get it right -- in the end). -mkImportedGlobalName mod_name occ - = getNameSupplyRn `thenRn` \ (us, inst_ns, cache, ipcache) -> +newGlobalName mod_name occ + = getNameSupplyRn `thenRn` \ (us, cache, ipcache) -> let key = (mod_name, occ) in case lookupFM cache key of - Just name -> returnRn name - Nothing -> setNameSupplyRn (us', inst_ns, new_cache, ipcache) `thenRn_` + Just name -> traceRn (text "newGlobalName: hit" <+> ppr name) `thenRn_` + returnRn name + + Nothing -> setNameSupplyRn (us', new_cache, ipcache) `thenRn_` + traceRn (text "newGlobalName: new" <+> ppr name) `thenRn_` returnRn name where (us', us1) = splitUniqSupply us @@ -146,6 +145,20 @@ mkImportedGlobalName mod_name occ name = mkGlobalName uniq mod occ implicitImportProvenance new_cache = addToFM cache key name + +newIPName rdr_name + = getNameSupplyRn `thenRn` \ (us, cache, ipcache) -> + case lookupFM ipcache key of + Just name -> returnRn name + Nothing -> setNameSupplyRn (us', cache, new_ipcache) `thenRn_` + returnRn name + where + (us', us1) = splitUniqSupply us + uniq = uniqFromSupply us1 + name = mkIPName uniq key + new_ipcache = addToFM ipcache key name + where key = (rdrNameOcc rdr_name) + updateProvenances :: [Name] -> RnM d () -- Update the provenances of everything that is in scope. -- We must be careful not to disturb the Module package info @@ -164,8 +177,8 @@ updateProvenances :: [Name] -> RnM d () -- Step 3 must not destroy package info recorded in Step 2. updateProvenances names - = getNameSupplyRn `thenRn` \ (us, inst_ns, cache, ipcache) -> - setNameSupplyRn (us, inst_ns, foldr update cache names, ipcache) + = getNameSupplyRn `thenRn` \ (us, cache, ipcache) -> + setNameSupplyRn (us, foldr update cache names, ipcache) where update name cache = addToFM_C update_prov cache key name where @@ -173,75 +186,161 @@ updateProvenances names update_prov name_in_cache name_with_prov = setNameProvenance name_in_cache (getNameProvenance name_with_prov) - +\end{code} +%********************************************************* +%* * +\subsection{Looking up names} +%* * +%********************************************************* + +Looking up a name in the RnEnv. + +\begin{code} +lookupBndrRn rdr_name + = getLocalNameEnv `thenRn` \ local_env -> + case lookupRdrEnv local_env rdr_name of + Just name -> returnRn name + Nothing -> lookupTopBndrRn rdr_name + +lookupTopBndrRn rdr_name + = getModeRn `thenRn` \ mode -> + case mode of + InterfaceMode -> -- Look in the global name cache + lookupOrigName rdr_name -mkImportedGlobalFromRdrName :: RdrName -> RnM d Name -mkImportedGlobalFromRdrName rdr_name + SourceMode -> -- Source mode, so look up a *qualified* version + -- of the name, so that we get the right one even + -- if there are many with the same occ name + -- There must *be* a binding + getModuleRn `thenRn` \ mod -> + getGlobalNameEnv `thenRn` \ global_env -> + case lookupRdrEnv global_env (qualifyRdrName (moduleName mod) rdr_name) of + Just (name:rest) -> ASSERT( null rest ) + returnRn name + Nothing -> -- Almost always this case is a compiler bug. + -- But consider a type signature that doesn't have + -- a corresponding binder: + -- module M where { f :: Int->Int } + -- We use lookupSigOccRn, which uses lookupBndrRn (for good reasons) + -- and we don't want to panic. So we report an out-of-scope error + failWithRn (mkUnboundName rdr_name) + (unknownNameErr rdr_name) + +-- lookupSigOccRn is used for type signatures and pragmas +-- Is this valid? +-- module A +-- import M( f ) +-- f :: Int -> Int +-- f x = x +-- It's clear that the 'f' in the signature must refer to A.f +-- The Haskell98 report does not stipulate this, but it will! +-- So we must treat the 'f' in the signature in the same way +-- as the binding occurrence of 'f', using lookupBndrRn +lookupSigOccRn :: RdrName -> RnMS Name +lookupSigOccRn = lookupBndrRn + +-- lookupOccRn looks up an occurrence of a RdrName +lookupOccRn :: RdrName -> RnMS Name +lookupOccRn rdr_name + = getLocalNameEnv `thenRn` \ local_env -> + case lookupRdrEnv local_env rdr_name of + Just name -> returnRn name + Nothing -> lookupGlobalOccRn rdr_name + +-- lookupGlobalOccRn is like lookupOccRn, except that it looks in the global +-- environment. It's used only for +-- record field names +-- class op names in class and instance decls +lookupGlobalOccRn rdr_name + = getModeRn `thenRn` \ mode -> + case mode of { + -- When processing interface files, the global env + -- is always empty, so go straight to the name cache + InterfaceMode -> lookupOrigName rdr_name ; + + SourceMode -> + + getGlobalNameEnv `thenRn` \ global_env -> + case lookupRdrEnv global_env rdr_name of + Just [name] -> returnRn name + Just stuff@(name:_) -> addNameClashErrRn rdr_name stuff `thenRn_` + returnRn name + Nothing -> -- Not found when processing source code; so fail + failWithRn (mkUnboundName rdr_name) + (unknownNameErr rdr_name) + } +\end{code} +% + +@lookupOrigName@ takes an RdrName representing an {\em original} +name, and adds it to the occurrence pool so that it'll be loaded +later. This is used when language constructs (such as monad +comprehensions, overloaded literals, or deriving clauses) require some +stuff to be loaded that isn't explicitly mentioned in the code. + +This doesn't apply in interface mode, where everything is explicit, +but we don't check for this case: it does no harm to record an +``extra'' occurrence and @lookupOrigNames@ isn't used much in +interface mode (it's only the @Nothing@ clause of @rnDerivs@ that +calls it at all I think). + + \fbox{{\em Jan 98: this comment is wrong: @rnHsType@ uses it quite a bit.}} + +For List and Tuple types it's important to get the correct +@isLocallyDefined@ flag, which is used in turn when deciding +whether there are any instance decls in this module are ``special''. +The name cache should have the correct provenance, though. + +\begin{code} +lookupOrigName :: RdrName -> RnM d Name +lookupOrigName rdr_name | isQual rdr_name - = mkImportedGlobalName (rdrNameModule rdr_name) (rdrNameOcc rdr_name) + = newGlobalName (rdrNameModule rdr_name) (rdrNameOcc rdr_name) | otherwise = -- An Unqual is allowed; interface files contain -- unqualified names for locally-defined things, such as -- constructors of a data type. - getModuleRn `thenRn ` \ mod_name -> - mkImportedGlobalName mod_name (rdrNameOcc rdr_name) - + getModuleRn `thenRn ` \ mod -> + newGlobalName (moduleName mod) (rdrNameOcc rdr_name) -getIPName rdr_name - = getNameSupplyRn `thenRn` \ (us, inst_ns, cache, ipcache) -> - case lookupFM ipcache key of - Just name -> returnRn name - Nothing -> setNameSupplyRn (us', inst_ns, cache, new_ipcache) `thenRn_` - returnRn name - where - (us', us1) = splitUniqSupply us - uniq = uniqFromSupply us1 - name = mkIPName uniq key - new_ipcache = addToFM ipcache key name - where key = (rdrNameOcc rdr_name) +lookupOrigNames :: [RdrName] -> RnM d NameSet +lookupOrigNames rdr_names + = mapRn lookupOrigName rdr_names `thenRn` \ names -> + returnRn (mkNameSet names) \end{code} -%********************************************************* -%* * -\subsection{Dfuns and default methods} -%* * -%********************************************************* - -@newImplicitBinder@ is used for (a) dfuns -(b) default methods, defined in this module. +lookupSysBinder is used for the "system binders" of a type, class, or instance decl. +It ensures that the module is set correctly in the name cache, and sets the provenance +on the returned name too. The returned name will end up actually in the type, class, +or instance. \begin{code} -newImplicitBinder occ src_loc - = getModuleRn `thenRn` \ mod_name -> - newLocalTopBinder (mkThisModule mod_name) occ (\_ -> Exported) src_loc +lookupSysBinder rdr_name + = ASSERT( isUnqual rdr_name ) + getModuleRn `thenRn` \ mod -> + newTopBinder mod (rdrNameOcc rdr_name) `thenRn` \ name -> + getModeRn `thenRn` \ mode -> + case mode of + SourceMode -> getSrcLocRn `thenRn` \ loc -> + returnRn (setNameProvenance name (LocalDef loc Exported)) + InterfaceMode -> returnRn name \end{code} -Make a name for the dict fun for an instance decl +@unQualInScope@ returns a function that takes a @Name@ and tells whether +its unqualified name is in scope. This is put as a boolean flag in +the @Name@'s provenance to guide whether or not to print the name qualified +in error messages. \begin{code} -newDFunName :: (OccName, OccName) -> SrcLoc -> RnMS Name -newDFunName key@(cl_occ, tycon_occ) loc - = newInstUniq string `thenRn` \ inst_uniq -> - newImplicitBinder (mkDFunOcc string inst_uniq) loc +unQualInScope :: GlobalRdrEnv -> Name -> Bool +unQualInScope env + = lookup where - -- Any string that is somewhat unique will do - string = occNameString cl_occ ++ occNameString tycon_occ -\end{code} - -\begin{code} -getDFunKey :: RenamedHsType -> (OccName, OccName) -- Used to manufacture DFun names -getDFunKey (HsForAllTy _ _ ty) = getDFunKey ty -getDFunKey (MonoFunTy _ ty) = getDFunKey ty -getDFunKey (MonoDictTy cls (ty:_)) = (nameOccName cls, get_tycon_key ty) - -get_tycon_key (MonoTyVar tv) = nameOccName (getName tv) -get_tycon_key (MonoTyApp ty _) = get_tycon_key ty -get_tycon_key (MonoTupleTy tys True) = getOccName (tupleTyCon (length tys)) -get_tycon_key (MonoTupleTy tys False) = getOccName (unboxedTupleTyCon (length tys)) -get_tycon_key (MonoListTy _) = getOccName listTyCon -get_tycon_key (MonoFunTy _ _) = getOccName funTyCon + lookup name = case lookupRdrEnv env (mkRdrUnqual (nameOccName name)) of + Just [name'] -> name == name' + other -> False \end{code} @@ -252,7 +351,6 @@ get_tycon_key (MonoFunTy _ _) = getOccName funTyCon %********************************************************* \begin{code} -------------------------------------- bindLocatedLocalsRn :: SDoc -- Documentation string for error message -> [(RdrName,SrcLoc)] -> ([Name] -> RnMS a) @@ -260,16 +358,16 @@ bindLocatedLocalsRn :: SDoc -- Documentation string for error message bindLocatedLocalsRn doc_str rdr_names_w_loc enclosed_scope = checkDupOrQualNames doc_str rdr_names_w_loc `thenRn_` + getModeRn `thenRn` \ mode -> getLocalNameEnv `thenRn` \ name_env -> - (if opt_WarnNameShadowing - then - mapRn_ (check_shadow name_env) rdr_names_w_loc - else - returnRn () + + -- Warn about shadowing, but only in source modules + (case mode of + SourceMode | opt_WarnNameShadowing -> mapRn_ (check_shadow name_env) rdr_names_w_loc + other -> returnRn () ) `thenRn_` - getNameSupplyRn `thenRn` \ (us, inst_ns, cache, ipcache) -> - getModeRn `thenRn` \ mode -> + getNameSupplyRn `thenRn` \ (us, cache, ipcache) -> let n = length rdr_names_w_loc (us', us1) = splitUniqSupply us @@ -283,7 +381,7 @@ bindLocatedLocalsRn doc_str rdr_names_w_loc enclosed_scope -- Keep track of whether the name originally came from -- an interface file. in - setNameSupplyRn (us', inst_ns, cache, ipcache) `thenRn_` + setNameSupplyRn (us', cache, ipcache) `thenRn_` let new_name_env = addListToRdrEnv name_env (map fst rdr_names_w_loc `zip` names) @@ -308,13 +406,13 @@ bindCoreLocalFVRn :: RdrName -> (Name -> RnMS (a, FreeVars)) bindCoreLocalFVRn rdr_name enclosed_scope = getSrcLocRn `thenRn` \ loc -> getLocalNameEnv `thenRn` \ name_env -> - getNameSupplyRn `thenRn` \ (us, inst_ns, cache, ipcache) -> + getNameSupplyRn `thenRn` \ (us, cache, ipcache) -> let (us', us1) = splitUniqSupply us uniq = uniqFromSupply us1 name = mkImportedLocalName uniq (rdrNameOcc rdr_name) loc in - setNameSupplyRn (us', inst_ns, cache, ipcache) `thenRn_` + setNameSupplyRn (us', cache, ipcache) `thenRn_` let new_name_env = extendRdrEnv name_env rdr_name name in @@ -326,6 +424,13 @@ bindCoreLocalsFVRn (b:bs) thing_inside = bindCoreLocalFVRn b $ \ name' -> bindCoreLocalsFVRn bs $ \ names' -> thing_inside (name':names') +bindLocalNames names enclosed_scope + = getLocalNameEnv `thenRn` \ name_env -> + setLocalNameEnv (addListToRdrEnv name_env pairs) + enclosed_scope + where + pairs = [(mkRdrUnqual (nameOccName n), n) | n <- names] + ------------------------------------- bindLocalRn doc rdr_name enclosed_scope = getSrcLocRn `thenRn` \ loc -> @@ -351,48 +456,43 @@ bindUVarRn :: SDoc -> RdrName -> (Name -> RnMS (a, FreeVars)) -> RnMS (a, FreeVa bindUVarRn = bindLocalRn ------------------------------------- -extendTyVarEnvFVRn :: [HsTyVar Name] -> RnMS (a, FreeVars) -> RnMS (a, FreeVars) +extendTyVarEnvFVRn :: [HsTyVarBndr Name] -> RnMS (a, FreeVars) -> RnMS (a, FreeVars) -- This tiresome function is used only in rnDecl on InstDecl extendTyVarEnvFVRn tyvars enclosed_scope - = getLocalNameEnv `thenRn` \ env -> - let - tyvar_names = map getTyVarName tyvars - new_env = addListToRdrEnv env [ (mkRdrUnqual (getOccName name), name) - | name <- tyvar_names - ] - in - setLocalNameEnv new_env enclosed_scope `thenRn` \ (thing, fvs) -> + = bindLocalNames tyvar_names enclosed_scope `thenRn` \ (thing, fvs) -> returnRn (thing, delListFromNameSet fvs tyvar_names) + where + tyvar_names = hsTyVarNames tyvars -bindTyVarsRn :: SDoc -> [HsTyVar RdrName] - -> ([HsTyVar Name] -> RnMS a) +bindTyVarsRn :: SDoc -> [HsTyVarBndr RdrName] + -> ([HsTyVarBndr Name] -> RnMS a) -> RnMS a bindTyVarsRn doc_str tyvar_names enclosed_scope = bindTyVars2Rn doc_str tyvar_names $ \ names tyvars -> enclosed_scope tyvars -- Gruesome name: return Names as well as HsTyVars -bindTyVars2Rn :: SDoc -> [HsTyVar RdrName] - -> ([Name] -> [HsTyVar Name] -> RnMS a) +bindTyVars2Rn :: SDoc -> [HsTyVarBndr RdrName] + -> ([Name] -> [HsTyVarBndr Name] -> RnMS a) -> RnMS a bindTyVars2Rn doc_str tyvar_names enclosed_scope = getSrcLocRn `thenRn` \ loc -> let - located_tyvars = [(getTyVarName tv, loc) | tv <- tyvar_names] + located_tyvars = [(hsTyVarName tv, loc) | tv <- tyvar_names] in bindLocatedLocalsRn doc_str located_tyvars $ \ names -> enclosed_scope names (zipWith replaceTyVarName tyvar_names names) -bindTyVarsFVRn :: SDoc -> [HsTyVar RdrName] - -> ([HsTyVar Name] -> RnMS (a, FreeVars)) +bindTyVarsFVRn :: SDoc -> [HsTyVarBndr RdrName] + -> ([HsTyVarBndr Name] -> RnMS (a, FreeVars)) -> RnMS (a, FreeVars) bindTyVarsFVRn doc_str rdr_names enclosed_scope = bindTyVars2Rn doc_str rdr_names $ \ names tyvars -> enclosed_scope tyvars `thenRn` \ (thing, fvs) -> returnRn (thing, delListFromNameSet fvs names) -bindTyVarsFV2Rn :: SDoc -> [HsTyVar RdrName] - -> ([Name] -> [HsTyVar Name] -> RnMS (a, FreeVars)) +bindTyVarsFV2Rn :: SDoc -> [HsTyVarBndr RdrName] + -> ([Name] -> [HsTyVarBndr Name] -> RnMS (a, FreeVars)) -> RnMS (a, FreeVars) bindTyVarsFV2Rn doc_str rdr_names enclosed_scope = bindTyVars2Rn doc_str rdr_names $ \ names tyvars -> @@ -421,119 +521,6 @@ checkDupNames doc_str rdr_names_w_loc \end{code} -%********************************************************* -%* * -\subsection{Looking up names} -%* * -%********************************************************* - -Looking up a name in the RnEnv. - -\begin{code} -lookupBndrRn rdr_name - = getNameEnvs `thenRn` \ (global_env, local_env) -> - - -- Try local env - case lookupRdrEnv local_env rdr_name of { - Just name -> returnRn name ; - Nothing -> - - getModeRn `thenRn` \ mode -> - case mode of - InterfaceMode -> -- Look in the global name cache - mkImportedGlobalFromRdrName rdr_name - - SourceMode -> -- Source mode, so look up a *qualified* version - -- of the name, so that we get the right one even - -- if there are many with the same occ name - -- There must *be* a binding - getModuleRn `thenRn` \ mod -> - case lookupRdrEnv global_env (qualifyRdrName mod rdr_name) of - Just (name:rest) -> ASSERT( null rest ) - returnRn name - Nothing -> pprPanic "lookupBndrRn" (ppr mod <+> ppr rdr_name) - } - --- Just like lookupRn except that we record the occurrence too --- Perhaps surprisingly, even wired-in names are recorded. --- Why? So that we know which wired-in names are referred to when --- deciding which instance declarations to import. -lookupOccRn :: RdrName -> RnMS Name -lookupOccRn rdr_name - = getNameEnvs `thenRn` \ (global_env, local_env) -> - lookup_occ global_env local_env rdr_name - --- lookupGlobalOccRn is like lookupOccRn, except that it looks in the global --- environment. It's used only for --- record field names --- class op names in class and instance decls -lookupGlobalOccRn :: RdrName -> RnMS Name -lookupGlobalOccRn rdr_name - = getNameEnvs `thenRn` \ (global_env, local_env) -> - lookup_global_occ global_env rdr_name - --- Look in both local and global env -lookup_occ global_env local_env rdr_name - = case lookupRdrEnv local_env rdr_name of - Just name -> returnRn name - Nothing -> lookup_global_occ global_env rdr_name - --- Look in global env only -lookup_global_occ global_env rdr_name - = case lookupRdrEnv global_env rdr_name of - Just [name] -> returnRn name - Just stuff@(name:_) -> addNameClashErrRn rdr_name stuff `thenRn_` - returnRn name - Nothing -> getModeRn `thenRn` \ mode -> - case mode of - -- Not found when processing source code; so fail - SourceMode -> failWithRn (mkUnboundName rdr_name) - (unknownNameErr rdr_name) - - -- Not found when processing an imported declaration, - -- so we create a new name for the purpose - InterfaceMode -> mkImportedGlobalFromRdrName rdr_name -\end{code} -% -@lookupImplicitOccRn@ takes an RdrName representing an {\em original} name, -and adds it to the occurrence pool so that it'll be loaded later. -This is used when language constructs -(such as monad comprehensions, overloaded literals, or deriving clauses) -require some stuff to be loaded that isn't explicitly mentioned in the code. - -This doesn't apply in interface mode, where everything is explicit, -but we don't check for this case: -it does no harm to record an ``extra'' occurrence -and @lookupImplicitOccRn@ isn't used much in interface mode -(it's only the @Nothing@ clause of @rnDerivs@ that calls it at all I think). - - \fbox{{\em Jan 98: this comment is wrong: @rnHsType@ uses it quite a bit.}} - -For List and Tuple types it's important to get the correct -@isLocallyDefined@ flag, which is used in turn when deciding -whether there are any instance decls in this module are ``special''. -The name cache should have the correct provenance, though. - -\begin{code} -lookupImplicitOccRn :: RdrName -> RnM d Name -lookupImplicitOccRn rdr_name = mkImportedGlobalFromRdrName rdr_name -\end{code} - -@unQualInScope@ returns a function that takes a @Name@ and tells whether -its unqualified name is in scope. This is put as a boolean flag in -the @Name@'s provenance to guide whether or not to print the name qualified -in error messages. - -\begin{code} -unQualInScope :: GlobalRdrEnv -> Name -> Bool -unQualInScope env - = lookup - where - lookup name = case lookupRdrEnv env (mkRdrUnqual (nameOccName name)) of - Just [name'] -> name == name' - other -> False -\end{code} - %************************************************************************ %* * \subsection{Envt utility functions} @@ -561,24 +548,15 @@ combine_globals ns_old ns_new -- ns_new is often short add n ns | any (is_duplicate n) ns_old = map choose ns -- Eliminate duplicates | otherwise = n:ns where - choose n' | n==n' && better_provenance n n' = n - | otherwise = n' - --- Choose --- a local thing over an imported thing --- a user-imported thing over a non-user-imported thing --- an explicitly-imported thing over an implicitly imported thing -better_provenance n1 n2 - = case (getNameProvenance n1, getNameProvenance n2) of - (LocalDef _ _, _ ) -> True - (NonLocalDef (UserImport _ _ True) _, _ ) -> True - (NonLocalDef (UserImport _ _ _ ) _, NonLocalDef ImplicitImport _) -> True - other -> False + choose m | n==m && n `hasBetterProv` m = n + | otherwise = m + is_duplicate :: Name -> Name -> Bool is_duplicate n1 n2 | isLocallyDefined n1 && isLocallyDefined n2 = False | otherwise = n1 == n2 \end{code} + We treat two bindings of a locally-defined name as a duplicate, because they might be two separate, local defns and we want to report and error for that, {\em not} eliminate a duplicate. @@ -604,7 +582,7 @@ plusAvail a1 a2 = pprPanic "RnEnv.plusAvail" (hsep [pprAvail a1,pprAvail a2]) #endif addAvail :: AvailEnv -> AvailInfo -> AvailEnv -addAvail avails avail = addToNameEnv_C plusAvail avails (availName avail) avail +addAvail avails avail = extendNameEnv_C plusAvail avails (availName avail) avail emptyAvailEnv = emptyNameEnv unitAvailEnv :: AvailInfo -> AvailEnv @@ -621,11 +599,11 @@ addAvailToNameSet names avail = addListToNameSet names (availNames avail) availsToNameSet :: [AvailInfo] -> NameSet availsToNameSet avails = foldl addAvailToNameSet emptyNameSet avails -availName :: AvailInfo -> Name +availName :: GenAvailInfo name -> name availName (Avail n) = n availName (AvailTC n _) = n -availNames :: AvailInfo -> [Name] +availNames :: GenAvailInfo name -> [name] availNames (Avail n) = [n] availNames (AvailTC n ns) = ns @@ -633,6 +611,12 @@ addSysAvails :: AvailInfo -> [Name] -> AvailInfo addSysAvails avail [] = avail addSysAvails (AvailTC n ns) sys = AvailTC n (sys ++ ns) +rdrAvailInfo :: AvailInfo -> RdrAvailInfo +-- Used when building the avails we are going to put in an interface file +-- We sort the components to reduce needless wobbling of interfaces +rdrAvailInfo (Avail n) = Avail (nameOccName n) +rdrAvailInfo (AvailTC n ns) = AvailTC (nameOccName n) (sortLt (<) (map nameOccName ns)) + filterAvail :: RdrNameIE -- Wanted -> AvailInfo -- Available -> Maybe AvailInfo -- Resulting available; @@ -726,8 +710,10 @@ warnUnusedModules mods | not opt_WarnUnusedImports = returnRn () | otherwise = mapRn_ (addWarnRn . unused_mod) mods where - unused_mod m = ptext SLIT("Module") <+> quotes (pprModuleName m) <+> - ptext SLIT("is imported, but nothing from it is used") + unused_mod m = vcat [ptext SLIT("Module") <+> quotes (pprModuleName m) <+> + text "is imported, but nothing from it is used", + parens (ptext SLIT("except perhaps to re-export instances visible in") <+> + quotes (pprModuleName m))] warnUnusedLocalBinds, warnUnusedImports, warnUnusedMatches :: [Name] -> RnM d () warnUnusedImports names