[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 c9c477e..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 )
@@ -38,7 +39,6 @@ import Outputable
 import Util            ( removeDups, equivClasses, thenCmp )
 import List            ( nub )
 import Maybes          ( mapMaybe )
-import Char            ( isAlphanum )
 \end{code}
 
 
@@ -50,14 +50,12 @@ import Char         ( isAlphanum )
 %*********************************************************
 
 \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
        
@@ -84,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
@@ -463,8 +462,8 @@ combine_globals :: [Name]   -- Old
 combine_globals ns_old ns_new  -- ns_new is often short
   = foldr add ns_old ns_new
   where
-    add n ns | all (no_conflict n) ns_old = map choose ns      -- Eliminate duplicates
-            | otherwise                  = n:ns
+    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'
@@ -480,12 +479,16 @@ better_provenance n1 n2
        (NonLocalDef (UserImport _ _ _   ) _, NonLocalDef ImplicitImport _) -> True
        other                                                               -> False
 
-no_conflict :: Name -> Name -> Bool
-no_conflict n1 n2 | isLocallyDefined n1 && isLocallyDefined n2 = False
-                 | otherwise                                  = n1 == n2
-       -- We complain of a conflict if one RdrName maps to two different Names,
-       -- OR if one RdrName maps to the same *locally-defined* Name.  The latter
-       -- case is to catch two separate, local definitions of the same thing.
+is_duplicate :: Name -> Name -> Bool
+is_duplicate n1 n2 | isLocallyDefined n1 && isLocallyDefined n2 = False
+                  | otherwise                                  = n1 == n2
+       -- 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, *not* eliminate a duplicate.
+
+       -- On the other hand, if you import the same name from two different
+       -- import statements, we *do* want to eliminate the duplicate, not report
+       -- an error.
        --
        -- If a module imports itself then there might be a local defn and an imported
        -- defn of the same name; in this case the names will compare as equal, but
@@ -644,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
@@ -674,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                  $