X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Frename%2FRnEnv.lhs;h=a87d73c52cedc09cd8c4665cc79d1c45adfec9c9;hb=7233046f04c012367e8bcecfc99b597a39c0ad32;hp=1ab14820a1814629d0b73f97bbbf0fc39e65b117;hpb=9579283cadf4ac68a6f4252244041b5127e16811;p=ghc-hetmet.git diff --git a/ghc/compiler/rename/RnEnv.lhs b/ghc/compiler/rename/RnEnv.lhs index 1ab1482..a87d73c 100644 --- a/ghc/compiler/rename/RnEnv.lhs +++ b/ghc/compiler/rename/RnEnv.lhs @@ -22,7 +22,7 @@ import RnMonad import Name ( Name, Provenance(..), ExportFlag(..), NamedThing(..), ImportReason(..), getSrcLoc, mkLocalName, mkImportedLocalName, mkGlobalName, mkUnboundName, - mkIPName, isSystemName, + mkIPName, isSystemName, isWiredInName, nameOccName, setNameModule, nameModule, pprOccName, isLocallyDefined, nameUnique, nameOccName, occNameUserString, @@ -35,17 +35,15 @@ import OccName ( OccName, ) import TysWiredIn ( tupleTyCon, unboxedTupleTyCon, listTyCon ) import Type ( funTyCon ) -import Module ( ModuleName, mkThisModule, moduleName, mkVanillaModule ) +import Module ( ModuleName, mkThisModule, moduleName, mkVanillaModule, pprModuleName ) import TyCon ( TyCon ) import FiniteMap import Unique ( Unique, Uniquable(..) ) -import UniqFM ( emptyUFM, listToUFM, plusUFM_C ) import UniqSupply import SrcLoc ( SrcLoc, noSrcLoc ) import Outputable import Util ( removeDups, equivClasses, thenCmp ) import List ( nub ) -import Maybes ( mapMaybe ) \end{code} @@ -57,8 +55,82 @@ import Maybes ( mapMaybe ) %********************************************************* \begin{code} -newImportedGlobalName :: ModuleName -> OccName -> Module -> RnM d Name -newImportedGlobalName mod_name occ mod +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 + = -- First check the cache + getNameSupplyRn `thenRn` \ (us, inst_ns, cache, ipcache) -> + let + 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) + -- + -- It also means that if there are two defns for the same thing + -- in a module, then each gets a separate SrcLoc + -- + -- There's a complication for wired-in names. We don't want 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_cache = addToFM cache key new_name + in + setNameSupplyRn (us, inst_ns, new_cache, ipcache) `thenRn_` + returnRn new_name + + -- Miss in the cache! + -- Build a completely new Name, and put it in the cache + Nothing -> let + (us', us1) = splitUniqSupply us + uniq = uniqFromSupply us1 + new_name = set_prov (mkGlobalName uniq mod occ implicitImportProvenance) + new_cache = addToFM cache key new_name + in + setNameSupplyRn (us', inst_ns, new_cache, ipcache) `thenRn_` + returnRn new_name + + +mkImportedGlobalName :: 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 + -- + -- This means that a renamed program may have incorrect info + -- on implicitly-imported occurrences, but the correct info on the + -- *binding* declaration. It's the type checker that propagates the + -- correct information to all the occurrences. + -- Since implicitly-imported names never occur in error messages, + -- 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) -> let key = (mod_name, occ) @@ -70,30 +142,40 @@ newImportedGlobalName mod_name occ mod where (us', us1) = splitUniqSupply us uniq = uniqFromSupply us1 - name = mkGlobalName uniq mod occ (NonLocalDef ImplicitImport False) + mod = mkVanillaModule mod_name + name = mkGlobalName uniq mod occ implicitImportProvenance new_cache = addToFM cache key 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 +-- already in the cache. Why not? Consider +-- module A module M( f ) +-- import M( f ) import N( f) +-- import N +-- So f is defined in N, and M re-exports it. +-- When processing module A: +-- 1. We read M.hi first, and make a vanilla name N.f +-- (without reading N.hi). The package info says +-- for lack of anything better. +-- 2. Now we read N, which update the cache to record +-- the correct package for N.f. +-- 3. Finally we update provenances (once we've read all imports). +-- Step 3 must not destroy package info recorded in Step 2. + updateProvenances names = getNameSupplyRn `thenRn` \ (us, inst_ns, cache, ipcache) -> - setNameSupplyRn (us, inst_ns, update cache names, ipcache) + setNameSupplyRn (us, inst_ns, foldr update cache names, ipcache) where - update cache [] = cache - update cache (name:names) = WARN( not (key `elemFM` cache), ppr name ) - update (addToFM cache key name) names - where - key = (moduleName (nameModule name), nameOccName name) + update name cache = addToFM_C update_prov cache key name + where + key = (moduleName (nameModule name), nameOccName name) + + update_prov name_in_cache name_with_prov + = setNameProvenance name_in_cache (getNameProvenance name_with_prov) + -newImportedBinder :: Module -> RdrName -> RnM d Name -newImportedBinder mod rdr_name - = ASSERT2( isUnqual rdr_name, ppr rdr_name ) - newImportedGlobalName (moduleName mod) (rdrNameOcc rdr_name) mod --- Make an imported global name, checking first to see if it's in the cache -mkImportedGlobalName :: ModuleName -> OccName -> RnM d Name -mkImportedGlobalName mod_name occ - = newImportedGlobalName mod_name occ (mkVanillaModule mod_name) - mkImportedGlobalFromRdrName :: RdrName -> RnM d Name mkImportedGlobalFromRdrName rdr_name | isQual rdr_name @@ -107,49 +189,6 @@ mkImportedGlobalFromRdrName rdr_name mkImportedGlobalName mod_name (rdrNameOcc rdr_name) -newLocalTopBinder :: Module -> OccName - -> (Name -> ExportFlag) -> SrcLoc - -> RnM d Name -newLocalTopBinder mod occ rec_exp_fn loc - = -- First check the cache - getNameSupplyRn `thenRn` \ (us, inst_ns, cache, ipcache) -> - let - key = (moduleName mod,occ) - mk_prov 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 newLocallyDefinedGlobalName is used only - -- at binding occurrences, we may as well get the provenance - -- dead right first time; hence the rec_exp_fn passed in - in - case lookupFM cache key of - - -- A hit in the cache! - -- Overwrite whatever provenance is in the cache already; - -- this updates WiredIn things and known-key things, - -- which are there from the start, to LocalDef. - -- - -- It also means that if there are two defns for the same thing - -- in a module, then each gets a separate SrcLoc - Just name -> let - new_name = setNameProvenance name (mk_prov new_name) - new_cache = addToFM cache key new_name - in - setNameSupplyRn (us, inst_ns, new_cache, ipcache) `thenRn_` - returnRn new_name - - -- Miss in the cache! - -- Build a new original name, and put it in the cache - Nothing -> let - (us', us1) = splitUniqSupply us - uniq = uniqFromSupply us1 - new_name = mkGlobalName uniq mod occ (mk_prov new_name) - new_cache = addToFM cache key new_name - in - setNameSupplyRn (us', inst_ns, new_cache, ipcache) `thenRn_` - returnRn new_name - getIPName rdr_name = getNameSupplyRn `thenRn` \ (us, inst_ns, cache, ipcache) -> case lookupFM ipcache key of @@ -554,46 +593,6 @@ will still have different provenances. -\subsubsection{ExportAvails}% ================ - -\begin{code} -mkEmptyExportAvails :: ModuleName -> ExportAvails -mkEmptyExportAvails mod_name = (unitFM mod_name [], emptyUFM) - -mkExportAvails :: ModuleName -> Bool -> GlobalRdrEnv -> [AvailInfo] -> ExportAvails -mkExportAvails mod_name unqual_imp name_env avails - = (mod_avail_env, entity_avail_env) - where - mod_avail_env = unitFM mod_name unqual_avails - - -- unqual_avails is the Avails that are visible in *unqualfied* form - -- (1.4 Report, Section 5.1.1) - -- For example, in - -- import T hiding( f ) - -- we delete f from avails - - unqual_avails | not unqual_imp = [] -- Short cut when no unqualified imports - | otherwise = mapMaybe prune avails - - prune (Avail n) | unqual_in_scope n = Just (Avail n) - prune (Avail n) | otherwise = Nothing - prune (AvailTC n ns) | null uqs = Nothing - | otherwise = Just (AvailTC n uqs) - where - uqs = filter unqual_in_scope ns - - unqual_in_scope n = unQualInScope name_env n - - entity_avail_env = listToUFM [ (name,avail) | avail <- avails, - name <- availNames avail] - -plusExportAvails :: ExportAvails -> ExportAvails -> ExportAvails -plusExportAvails (m1, e1) (m2, e2) - = (plusFM_C (++) m1 m2, plusAvailEnv e1 e2) - -- ToDo: wasteful: we do this once for each constructor! -\end{code} - - \subsubsection{AvailInfo}% ================ \begin{code} @@ -722,8 +721,15 @@ mapFvRn f xs = mapRn f xs `thenRn` \ stuff -> \begin{code} -warnUnusedLocalBinds, warnUnusedImports, warnUnusedMatches :: [Name] -> RnM d () +warnUnusedModules :: [ModuleName] -> RnM d () +warnUnusedModules mods + | not opt_WarnUnusedImports = returnRn () + | otherwise = mapRn_ (addWarnRn . unused_mod) mods + where + unused_mod m = ptext SLIT("Module") <+> quotes (pprModuleName m) <+> + text "is imported, but nothing from it is used" +warnUnusedLocalBinds, warnUnusedImports, warnUnusedMatches :: [Name] -> RnM d () warnUnusedImports names | not opt_WarnUnusedImports = returnRn () -- Don't force names unless necessary