[project @ 1999-03-02 17:12:54 by sof]

[ghc-hetmet.git] / ghc / compiler / rename / RnEnv.lhs

diff --git a/ghc/compiler/rename/RnEnv.lhs b/ghc/compiler/rename/RnEnv.lhs
index ebe6af2..53bf1bc 100644 (file)
--- a/ghc/compiler/rename/RnEnv.lhs
+++ b/ghc/compiler/rename/RnEnv.lhs
@@ -26,8 +26,9 @@ import Name           ( Name, Provenance(..), ExportFlag(..), NamedThing(..),
 import NameSet
 import OccName         ( OccName,
                          mkDFunOcc, 
-                         occNameFlavour, moduleIfaceFlavour
+                         occNameFlavour
                        )
+import Module          ( moduleIfaceFlavour )                  
 import TyCon           ( TyCon )
 import FiniteMap
 import Unique          ( Unique, Uniquable(..), unboundKey )
@@ -49,14 +50,12 @@ import Maybes               ( mapMaybe )
 %*********************************************************
 
 \begin{code}
-newImportedGlobalName :: Module -> OccName
-                     -> RnM s d Name
+newImportedGlobalName :: Module -> OccName -> RnM s d Name
 newImportedGlobalName mod occ
   =    -- First check the cache
     getNameSupplyRn            `thenRn` \ (us, inst_ns, cache) ->
     let 
        key     = (mod,occ)
-       mod_hif = moduleIfaceFlavour mod
     in
     case lookupFM cache key of
        
@@ -83,10 +82,11 @@ newImportedGlobalName mod occ
        Nothing ->      -- Miss in the cache!
                        -- Build a new original name, and put it in the cache
                   getOmitQualFn                        `thenRn` \ omit_fn ->
+                  setModuleFlavourRn mod               `thenRn` \ mod' ->
                   let
                        (us', us1) = splitUniqSupply us
                        uniq       = uniqFromSupply us1
-                       name       = mkGlobalName uniq mod occ (NonLocalDef ImplicitImport (omit_fn name))
+                       name       = mkGlobalName uniq mod' occ (NonLocalDef ImplicitImport (omit_fn name))
                                        -- For in-scope things we improve the provenance
                                        -- in RnNames.importsFromImportDecl
                        new_cache  = addToFM cache key name
@@ -647,21 +647,21 @@ warnUnusedLocalBinds, warnUnusedTopNames, warnUnusedMatches :: [Name] -> RnM s d
 
 warnUnusedTopNames names
   | not opt_WarnUnusedBinds && not opt_WarnUnusedImports = returnRn () -- Don't force ns unless necessary
-  | otherwise                                           = warnUnusedBinds names
+  | otherwise                                           = warnUnusedBinds (\ is_local -> not is_local) names
 
 warnUnusedLocalBinds ns
   | not opt_WarnUnusedBinds = returnRn ()
-  | otherwise              = warnUnusedBinds ns
+  | otherwise              = warnUnusedBinds (\ is_local -> is_local) ns
 
 warnUnusedMatches names
-  | opt_WarnUnusedMatches = warnUnusedGroup names
+  | opt_WarnUnusedMatches = warnUnusedGroup (const True) names
   | otherwise            = returnRn ()
 
 -------------------------
 
-warnUnusedBinds :: [Name] -> RnM s d ()
-warnUnusedBinds names
-  = mapRn warnUnusedGroup groups       `thenRn_`
+warnUnusedBinds :: (Bool -> Bool) -> [Name] -> RnM s d ()
+warnUnusedBinds warn_when_local names
+  = mapRn (warnUnusedGroup warn_when_local) groups     `thenRn_`
     returnRn ()
   where
        -- Group by provenance
@@ -677,13 +677,12 @@ warnUnusedBinds names
 
 -------------------------
 
-warnUnusedGroup :: [Name] -> RnM s d ()
-warnUnusedGroup []
+warnUnusedGroup :: (Bool -> Bool) -> [Name] -> RnM s d ()
+warnUnusedGroup _ []
   = returnRn ()
 
-warnUnusedGroup names
-  | is_local     && not opt_WarnUnusedBinds   = returnRn ()
-  | not is_local && not opt_WarnUnusedImports = returnRn ()
+warnUnusedGroup emit_warning names
+  | not (emit_warning is_local) = returnRn ()
   | otherwise
   = pushSrcLocRn def_loc       $
     addWarnRn                  $