[project @ 2004-10-20 13:34:04 by simonpj]

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

diff --git a/ghc/compiler/rename/RnNames.lhs b/ghc/compiler/rename/RnNames.lhs
index 9e15a4b..4dfcc13 100644 (file)
--- a/ghc/compiler/rename/RnNames.lhs
+++ b/ghc/compiler/rename/RnNames.lhs
@@ -23,16 +23,16 @@ import LoadIface    ( loadSrcInterface )
 import TcRnMonad
 
 import FiniteMap
-import PrelNames       ( pRELUDE_Name, isBuiltInSyntaxName, isUnboundName,
+import PrelNames       ( pRELUDE_Name, isUnboundName,
                          main_RDR_Unqual )
 import Module          ( Module, ModuleName, moduleName, mkPackageModule,
                          moduleNameUserString, isHomeModule,
                          unitModuleEnvByName, unitModuleEnv, 
                          lookupModuleEnvByName, moduleEnvElts )
 import Name            ( Name, nameSrcLoc, nameOccName, nameModuleName, isWiredInName,
-                         nameParent, nameParent_maybe, isExternalName, nameModule )
+                         nameParent, nameParent_maybe, isExternalName, nameModule,
+                         isBuiltInSyntax )
 import NameSet
-import NameEnv
 import OccName         ( srcDataName, isTcOcc, occNameFlavour, OccEnv, 
                          mkOccEnv, lookupOccEnv, emptyOccEnv, extendOccEnv )
 import HscTypes                ( GenAvailInfo(..), AvailInfo, Avails, GhciMode(..),
@@ -48,9 +48,9 @@ import RdrName                ( RdrName, rdrNameOcc, setRdrNameSpace,
                          Provenance(..), ImportSpec(..), 
                          isLocalGRE, pprNameProvenance )
 import Outputable
-import Maybes          ( isJust, isNothing, catMaybes, mapCatMaybes, seqMaybe )
+import Maybes          ( isNothing, catMaybes, mapCatMaybes, seqMaybe )
 import SrcLoc          ( noSrcLoc, Located(..), mkGeneralSrcSpan,
-                         unLoc, noLoc, srcLocSpan, SrcSpan )
+                         unLoc, noLoc, srcLocSpan, combineSrcSpans, SrcSpan )
 import BasicTypes      ( DeprecTxt )
 import ListSetOps      ( removeDups )
 import Util            ( sortLe, notNull, isSingleton )
@@ -132,7 +132,7 @@ importsFromImportDecl :: Module
 importsFromImportDecl this_mod
        (L loc (ImportDecl loc_imp_mod_name want_boot qual_only as_mod imp_details))
   = 
-    addSrcSpan loc $
+    setSrcSpan loc $
 
        -- If there's an error in loadInterface, (e.g. interface
        -- file not found) we get lots of spurious errors from 'filterImports'
@@ -200,11 +200,14 @@ importsFromImportDecl this_mod
        (dependent_mods, dependent_pkgs) 
           | isHomeModule imp_mod 
           =    -- Imported module is from the home package
-               -- Take its dependent modules and
-               --      (a) remove this_mod (might be there as a hi-boot)
-               --      (b) add imp_mod itself
+               -- Take its dependent modules and add imp_mod itself
                -- Take its dependent packages unchanged
-            ((imp_mod_name, want_boot) : filter not_self (dep_mods deps), dep_pkgs deps)
+               -- NB: (dep_mods deps) might include a hi-boot file for the module being
+               --      compiled, CM. Do *not* filter this out (as we used to), because when 
+               --      we've finished dealing with the direct imports we want to know if any 
+               --      of them depended on CM.hi-boot, in which case we should do the hi-boot
+               --      consistency check.  See LoadIface.loadHiBootInterface
+            ((imp_mod_name, want_boot) : dep_mods deps, dep_pkgs deps)
 
           | otherwise  
           =    -- Imported module is from another package
@@ -213,8 +216,6 @@ importsFromImportDecl this_mod
             ASSERT( not (mi_package iface `elem` dep_pkgs deps) )
             ([], mi_package iface : dep_pkgs deps)
 
-       not_self (m, _) = m /= this_mod_name
-
        import_all = case imp_details of
                        Just (is_hiding, ls)     -- Imports are spec'd explicitly
                          | not is_hiding -> Just (not (null ls))
@@ -336,10 +337,10 @@ importsFromLocalDecls group
 
        avails' | implicit_prelude = filter not_built_in_syntax avails
                | otherwise        = avails
-       not_built_in_syntax a = not (all isBuiltInSyntaxName (availNames a))
+       not_built_in_syntax a = not (all isBuiltInSyntax (availNames a))
                -- Only filter it if all the names of the avail are built-in
                -- In particular, lists have (:) which is not built in syntax
-               -- so we don't filter it out.  [Sept 03: wrong: see isBuiltInSyntaxName]
+               -- so we don't filter it out.  [Sept 03: wrong: see isBuiltInSyntax]
 
        avail_env = mkAvailEnv avails'
        imports   = emptyImportAvails {
@@ -737,9 +738,9 @@ reportDeprecations tcg_env
     check hpt pit (GRE {gre_name = name, gre_prov = Imported (imp_spec:_) _})
       | name `elemNameSet` used_names
       ,        Just deprec_txt <- lookupDeprec hpt pit name
-      = addSrcSpan (is_loc imp_spec) $
+      = setSrcSpan (is_loc imp_spec) $
        addWarn (sep [ptext SLIT("Deprecated use of") <+> 
-                       text (occNameFlavour (nameOccName name)) <+> 
+                       occNameFlavour (nameOccName name) <+> 
                        quotes (ppr name),
                      (parens imp_msg),
                      (ppr deprec_txt) ])
@@ -1004,17 +1005,15 @@ exportClashErr global_env name1 name2 ie1 ie2
             []      -> pprPanic "exportClashErr" (ppr name)
 
 addDupDeclErr :: [Name] -> TcRn ()
-addDupDeclErr (n:ns)
-  = addErrAt (srcLocSpan (nameSrcLoc n)) $
-    vcat [ptext SLIT("Multiple declarations of") <+> quotes (ppr n),
-         nest 2 (ptext SLIT("other declarations at:")),
-         nest 4 (vcat (map ppr sorted_locs))]
+addDupDeclErr names
+  = addErrAt big_loc $
+    vcat [ptext SLIT("Multiple declarations of") <+> quotes (ppr name1),
+         ptext SLIT("Declared at:") <+> vcat (map ppr sorted_locs)]
   where
-    sorted_locs = sortLe occ'ed_before (map nameSrcLoc ns)
-    occ'ed_before a b = case compare a b of
-                         LT -> True
-                         EQ -> True
-                         GT -> False
+    locs    = map nameSrcLoc names
+    big_loc = foldr1 combineSrcSpans (map srcLocSpan locs)
+    name1   = head names
+    sorted_locs = sortLe (<=) (sortLe (<=) locs)
 
 dupExportWarn occ_name ie1 ie2
   = hsep [quotes (ppr occ_name),