Add ASSERTs to all calls of nameModule
[ghc-hetmet.git] / compiler / rename / RnNames.lhs
index bb164ea..68286b7 100644 (file)
@@ -4,27 +4,16 @@
 \section[RnNames]{Extracting imported and top-level names in scope}
 
 \begin{code}
-{-# OPTIONS -w #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and fix
--- any warnings in the module. See
---     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
--- for details
-
 module RnNames (
        rnImports, getLocalNonValBinders,
        rnExports, extendGlobalRdrEnvRn,
-       reportUnusedNames, finishDeprecations,
+       reportUnusedNames, finishWarnings,
     ) where
 
 #include "HsVersions.h"
 
 import DynFlags
-import HsSyn           ( IE(..), ieName, ImportDecl(..), LImportDecl,
-                         ForeignDecl(..), HsGroup(..), HsValBindsLR(..),
-                         Sig(..), collectHsBindLocatedBinders, tyClDeclNames,
-                         instDeclATs, isFamInstDecl,
-                         LIE )
+import HsSyn
 import RnEnv
 import RnHsDoc          ( rnHsDoc )
 import IfaceEnv                ( ifaceExportNames )
@@ -35,7 +24,6 @@ import PrelNames
 import Module
 import Name
 import NameEnv
-import LazyUniqFM
 import NameSet
 import OccName
 import HscTypes
@@ -45,7 +33,7 @@ import Maybes
 import SrcLoc
 import FiniteMap
 import ErrUtils
-import BasicTypes      ( DeprecTxt, Fixity )
+import BasicTypes      ( WarningTxt(..) )
 import DriverPhases    ( isHsBoot )
 import Util
 import FastString
@@ -75,7 +63,7 @@ rnImports imports
          implicit_prelude <- doptM Opt_ImplicitPrelude
          let prel_imports      = mkPrelImports this_mod implicit_prelude imports
              (source, ordinary) = partition is_source_import imports
-             is_source_import (L _ (ImportDecl _ is_boot _ _ _)) = is_boot
+             is_source_import (L _ (ImportDecl _ _ is_boot _ _ _)) = is_boot
 
          ifOptM Opt_WarnImplicitPrelude (
             when (notNull prel_imports) $ addWarn (implicitPreludeWarn)
@@ -111,13 +99,14 @@ mkPrelImports this_mod implicit_prelude import_decls
   | otherwise = [preludeImportDecl]
   where
       explicit_prelude_import
-       = notNull [ () | L _ (ImportDecl mod _ _ _ _) <- import_decls, 
+       = notNull [ () | L _ (ImportDecl mod Nothing _ _ _ _) <- import_decls, 
                   unLoc mod == pRELUDE_NAME ]
 
       preludeImportDecl :: LImportDecl RdrName
       preludeImportDecl
         = L loc $
          ImportDecl (L loc pRELUDE_NAME)
+               Nothing {- no specific package -}
               False {- Not a boot interface -}
               False    {- Not qualified -}
               Nothing  {- No "as" -}
@@ -130,18 +119,22 @@ rnImportDecl  :: Module
              -> LImportDecl RdrName
              -> RnM (LImportDecl Name, GlobalRdrEnv, ImportAvails,AnyHpcUsage)
 
-rnImportDecl this_mod (L loc (ImportDecl loc_imp_mod_name want_boot
+rnImportDecl this_mod (L loc (ImportDecl loc_imp_mod_name mb_pkg want_boot
                                          qual_only as_mod imp_details))
   = 
     setSrcSpan loc $ do
 
+    when (isJust mb_pkg) $ do
+        pkg_imports <- doptM Opt_PackageImports
+        when (not pkg_imports) $ addErr packageImportErr
+
        -- If there's an error in loadInterface, (e.g. interface
        -- file not found) we get lots of spurious errors from 'filterImports'
     let
        imp_mod_name = unLoc loc_imp_mod_name
        doc = ppr imp_mod_name <+> ptext (sLit "is directly imported")
 
-    iface <- loadSrcInterface doc imp_mod_name want_boot
+    iface <- loadSrcInterface doc imp_mod_name want_boot mb_pkg
 
        -- Compiler sanity check: if the import didn't say
        -- {-# SOURCE #-} we should not get a hi-boot file
@@ -155,7 +148,7 @@ rnImportDecl this_mod (L loc (ImportDecl loc_imp_mod_name want_boot
 
     let
        imp_mod    = mi_module iface
-       deprecs    = mi_deprecs iface
+       warns      = mi_warns iface
        orph_iface = mi_orphan iface 
        has_finsts = mi_finsts iface 
        deps       = mi_deps iface
@@ -234,10 +227,10 @@ rnImportDecl this_mod (L loc (ImportDecl loc_imp_mod_name want_boot
        -- True <=> import M ()
        import_all = case imp_details of
                        Just (is_hiding, ls) -> not is_hiding && null ls        
-                       other                -> False
+                       _                    -> False
 
        imports   = ImportAvails { 
-                       imp_mods     = unitModuleEnv imp_mod (imp_mod, [(qual_mod_name, import_all, loc)]),
+                       imp_mods     = unitModuleEnv imp_mod [(qual_mod_name, import_all, loc)],
                        imp_orphs    = orphans,
                        imp_finsts   = finsts,
                        imp_dep_mods = mkModDeps dependent_mods,
@@ -245,18 +238,19 @@ rnImportDecl this_mod (L loc (ImportDecl loc_imp_mod_name want_boot
                    }
 
        -- Complain if we import a deprecated module
-    ifOptM Opt_WarnDeprecations        (
-       case deprecs of 
-         DeprecAll txt -> addWarn (moduleDeprec imp_mod_name txt)
-         other         -> return ()
+    ifOptM Opt_WarnWarningsDeprecations        (
+       case warns of   
+         WarnAll txt -> addWarn (moduleWarn imp_mod_name txt)
+         _           -> return ()
      )
 
-    let new_imp_decl = L loc (ImportDecl loc_imp_mod_name want_boot
+    let new_imp_decl = L loc (ImportDecl loc_imp_mod_name mb_pkg want_boot
                                          qual_only as_mod new_imp_details)
 
     return (new_imp_decl, gbl_env, imports, mi_hpc iface)
     )
 
+warnRedundantSourceImport :: ModuleName -> SDoc
 warnRedundantSourceImport mod_name
   = ptext (sLit "Unnecessary {-# SOURCE #-} in the import of module")
           <+> quotes (ppr mod_name)
@@ -315,30 +309,28 @@ extendGlobalRdrEnvRn shadowP avails new_fixities
              (rdr_env2, lcl_env2) | shadowP   = (rdr_env1, lcl_env1)
                                   | otherwise = (rdr_env,  lcl_env)
 
-       ; (rdr_env', fix_env') <- foldlM extend (rdr_env2, fix_env) gres
+             rdr_env3 = foldl extendGlobalRdrEnv rdr_env2 gres
+             fix_env' = foldl extend_fix_env     fix_env  gres
+             (rdr_env', dups) = findLocalDupsRdrEnv rdr_env3 new_occs
+
+             gbl_env' = gbl_env { tcg_rdr_env = rdr_env', tcg_fix_env = fix_env' }
+             
+       ; mapM_ addDupDeclErr dups
        
-       ; let gbl_env' = gbl_env { tcg_rdr_env = rdr_env', tcg_fix_env = fix_env' }
        ; traceRn (text "extendGlobalRdrEnvRn" <+> (ppr new_fixities $$ ppr fix_env $$ ppr fix_env'))
        ; return (gbl_env', lcl_env2) }
   where
     gres = gresFromAvails LocalDef avails
 
-    extend envs@(cur_rdr_env, cur_fix_env) gre
-       = let gres = lookupGlobalRdrEnv cur_rdr_env (nameOccName (gre_name gre)) 
-          in case filter isLocalGRE gres of -- Check for existing *local* defns 
-                  dup_gre:_ -> do { addDupDeclErr (gre_name dup_gre) (gre_name gre)
-                                 ; return envs }
-                  [] -> return (simple_extend envs gre)
-
-    simple_extend (rdr_env, fix_env) gre 
-      = (extendGlobalRdrEnv rdr_env gre, fix_env')
-      where
        --  If there is a fixity decl for the gre, add it to the fixity env
+    extend_fix_env fix_env gre 
+      | Just (L _ fi) <- lookupFsEnv new_fixities (occNameFS occ)
+      = extendNameEnv fix_env name (FixItem occ fi)
+      | otherwise
+      = fix_env
+      where
        name = gre_name gre
         occ  = nameOccName name
-        fix_env' = case lookupFsEnv new_fixities (occNameFS occ) of
-                     Nothing       -> fix_env
-                     Just (L _ fi) -> extendNameEnv fix_env name (FixItem occ fi)
 \end{code}
 
 @getLocalDeclBinders@ returns the names for an @HsDecl@.  It's
@@ -372,6 +364,7 @@ getLocalNonValBinders group
   = do         { gbl_env <- getGblEnv
        ; get_local_binders gbl_env group }
 
+get_local_binders :: TcGblEnv -> HsGroup RdrName -> RnM [GenAvailInfo Name]
 get_local_binders gbl_env (HsGroup {hs_valds  = ValBindsIn _ val_sigs,
                                    hs_tyclds = tycl_decls, 
                                    hs_instds = inst_decls,
@@ -384,13 +377,16 @@ get_local_binders gbl_env (HsGroup {hs_valds  = ValBindsIn _ val_sigs,
     mod        = tcg_mod gbl_env
     is_hs_boot = isHsBoot (tcg_src gbl_env) ;
 
+    for_hs_bndrs :: [Located RdrName]
     for_hs_bndrs = [nm | L _ (ForeignImport nm _ _) <- foreign_decls]
 
     -- In a hs-boot file, the value binders come from the
     --  *signatures*, and there should be no foreign binders 
+    val_bndrs :: [Located RdrName]
     val_bndrs | is_hs_boot = [nm | L _ (TypeSig nm _) <- val_sigs]
               | otherwise  = for_hs_bndrs
 
+    new_simple :: Located RdrName -> RnM (GenAvailInfo Name)
     new_simple rdr_name = do
         nm <- newTopSrcBinder mod rdr_name
         return (Avail nm)
@@ -411,7 +407,7 @@ get_local_binders gbl_env (HsGroup {hs_valds  = ValBindsIn _ val_sigs,
     inst_ats inst_decl 
        = mapM new_tc (instDeclATs (unLoc inst_decl))
 
-getLocalDeclBinders _ _ = panic "getLocalDeclBinders"  -- ValBindsOut can't happen
+get_local_binders _ g = pprPanic "get_local_binders" (ppr g)
 \end{code}
 
 
@@ -431,8 +427,7 @@ filterImports :: ModIface
              -> [AvailInfo]                    -- What's available
              -> RnM (Maybe (Bool, [LIE Name]), -- Import spec w/ Names
                      GlobalRdrEnv)             -- Same again, but in GRE form
-                       
-filterImports iface decl_spec Nothing all_avails
+filterImports _ decl_spec Nothing all_avails
   = return (Nothing, mkGlobalRdrEnv (gresFromAvails prov all_avails))
   where
     prov = Imported [ImpSpec { is_decl = decl_spec, is_item = ImpAll }]
@@ -486,6 +481,7 @@ filterImports iface decl_spec (Just (want_hiding, import_items)) all_avails
              (parent, subs) = if p1 == name then (p2, subs1) else (p1, subs2)
            in
            (name, AvailTC name subs, Just parent)
+        combine x y = pprPanic "filterImports/combine" (ppr x $$ ppr y)
 
     lookup_lie :: Bool -> LIE RdrName -> TcRn [(LIE Name, AvailInfo)]
     lookup_lie opt_typeFamilies (L loc ieRdr)
@@ -499,7 +495,7 @@ filterImports iface decl_spec (Just (want_hiding, import_items)) all_avails
         where
                 -- Warn when importing T(..) if T was exported abstractly
             checkDodgyImport stuff
-                | IEThingAll n <- ieRdr, (_, AvailTC _ [one]):_ <- stuff
+                | IEThingAll n <- ieRdr, (_, AvailTC _ [_]):_ <- stuff
                 = ifOptM Opt_WarnDodgyImports (addWarn (dodgyImportWarn n))
                 -- NB. use the RdrName for reporting the warning
             checkDodgyImport _
@@ -554,7 +550,7 @@ filterImports iface decl_spec (Just (want_hiding, import_items)) all_avails
                    return [mkIEThingAbs nameAvail]
 
          IEThingWith tc ns -> do
-            (name, AvailTC name2 subnames, mb_parent) <- lookup_name tc
+            (name, AvailTC _ subnames, mb_parent) <- lookup_name tc
            let 
              env         = mkOccEnv [(nameOccName s, s) | s <- subnames]
              mb_children = map (lookupOccEnv env . rdrNameOcc) ns
@@ -581,7 +577,7 @@ filterImports iface decl_spec (Just (want_hiding, import_items)) all_avails
 
       where
         mkIEThingAbs (n, av, Nothing    ) = (IEThingAbs n, trimAvail av n) 
-       mkIEThingAbs (n, av, Just parent) = (IEThingAbs n, AvailTC parent [n]) 
+        mkIEThingAbs (n, _,  Just parent) = (IEThingAbs n, AvailTC parent [n]) 
 
 
 catMaybeErr :: [MaybeErr err a] -> [a]
@@ -617,17 +613,18 @@ mkUnitAvail me (ParentIs p)                = AvailTC p  [me]
 mkUnitAvail me NoParent | isTyConName me = AvailTC me [me]
                        | otherwise      = Avail me
 
-plusAvail (Avail n1)      (Avail n2)       = Avail n1
-plusAvail (AvailTC n1 ns1) (AvailTC n2 ns2) = AvailTC n2 (ns1 `unionLists` ns2)
+plusAvail :: GenAvailInfo Name -> GenAvailInfo Name -> GenAvailInfo Name
+plusAvail (Avail n1)      (Avail _)        = Avail n1
+plusAvail (AvailTC _ ns1) (AvailTC n2 ns2) = AvailTC n2 (ns1 `unionLists` ns2)
 plusAvail a1 a2 = pprPanic "RnEnv.plusAvail" (hsep [ppr a1,ppr a2])
 
 availParent :: Name -> AvailInfo -> Parent
-availParent n (Avail _)                 = NoParent
-availParent n (AvailTC m ms) | n==m      = NoParent
-                            | otherwise = ParentIs m
+availParent _ (Avail _)                 = NoParent
+availParent n (AvailTC m _) | n == m    = NoParent
+                            | otherwise = ParentIs m
 
 trimAvail :: AvailInfo -> Name -> AvailInfo
-trimAvail (Avail n)      m = Avail n
+trimAvail (Avail n)      _ = Avail n
 trimAvail (AvailTC n ns) m = ASSERT( m `elem` ns) AvailTC n [m]
 
 -- | filters 'AvailInfo's by the given predicate
@@ -644,14 +641,14 @@ filterAvail keep ie rest =
         let left = filter keep ns in
         if null left then rest else AvailTC tc left : rest
 
--- | Given an import/export spec, construct the appropriate 'GlobalRdrElt's.
+-- | Given an import\/export spec, construct the appropriate 'GlobalRdrElt's.
 gresFromIE :: ImpDeclSpec -> (LIE Name, AvailInfo) -> [GlobalRdrElt]
 gresFromIE decl_spec (L loc ie, avail)
   = gresFromAvail prov_fn avail
   where
     is_explicit = case ie of
-                   IEThingAll name -> \n -> n==name
-                   other           -> \n -> True
+                   IEThingAll name -> \n -> n == name
+                   _               -> \_ -> True
     prov_fn name = Imported [imp_spec]
        where
          imp_spec  = ImpSpec { is_decl = decl_spec, is_item = item_spec }
@@ -661,7 +658,7 @@ mkChildEnv :: [GlobalRdrElt] -> NameEnv [Name]
 mkChildEnv gres = foldr add emptyNameEnv gres
     where
        add (GRE { gre_name = n, gre_par = ParentIs p }) env = extendNameEnv_C (++) env p [n]
-       add other_gre                                    env = env
+       add _                                            env = env
 
 findChildren :: NameEnv [Name] -> Name -> [Name]
 findChildren env n = lookupNameEnv env n `orElse` []
@@ -740,6 +737,7 @@ type ExportAccum    -- The type of the accumulating parameter of
        [AvailInfo])            -- The accumulated exported stuff
                                --   Not nub'd!
 
+emptyExportAccum :: ExportAccum
 emptyExportAccum = ([], emptyOccEnv, []) 
 
 type ExportOccMap = OccEnv (Name, IE RdrName)
@@ -794,7 +792,7 @@ exports_from_avail :: Maybe [LIE RdrName]
                    -> Module
                    -> RnM (Maybe [LIE Name], [AvailInfo])
 
-exports_from_avail Nothing rdr_env imports this_mod
+exports_from_avail Nothing rdr_env _imports _this_mod
  = -- The same as (module M) where M is the current module name,
    -- so that's how we handle it.
    let
@@ -815,7 +813,7 @@ exports_from_avail (Just rdr_items) rdr_env imports this_mod
     kids_env = mkChildEnv (globalRdrEnvElts rdr_env)
 
     imported_modules = [ qual_name
-                       | (_, xs) <- moduleEnvElts $ imp_mods imports,
+                       | xs <- moduleEnvElts $ imp_mods imports,
                          (qual_name, _, _) <- xs ]
 
     exports_from_item :: ExportAccum -> LIE RdrName -> RnM ExportAccum
@@ -909,7 +907,7 @@ exports_from_avail (Just rdr_items) rdr_env imports this_mod
                                               (text "in export list"))
                         return (IEThingWith name names, AvailTC name (name:names))
 
-    lookup_ie ie = panic "lookup_ie"   -- Other cases covered earlier
+    lookup_ie _ = panic "lookup_ie"    -- Other cases covered earlier
 
     -------------
     lookup_doc_ie :: IE RdrName -> RnM (IE Name)
@@ -918,9 +916,10 @@ exports_from_avail (Just rdr_items) rdr_env imports this_mod
     lookup_doc_ie (IEDoc doc)       = do rn_doc <- rnHsDoc doc
                                         return (IEDoc rn_doc)
     lookup_doc_ie (IEDocNamed str)  = return (IEDocNamed str)
-    lookup_doc_ie ie = panic "lookup_doc_ie"   -- Other cases covered earlier
+    lookup_doc_ie _ = panic "lookup_doc_ie"    -- Other cases covered earlier
 
 
+isDoc :: IE RdrName -> Bool
 isDoc (IEDoc _)      = True
 isDoc (IEDocNamed _) = True
 isDoc (IEGroup _ _)  = True
@@ -935,7 +934,7 @@ isModuleExported implicit_prelude mod (GRE { gre_name = name, gre_prov = prov })
        -- They just clutter up the environment (esp tuples), and the parser
        -- will generate Exact RdrNames for them, so the cluttered
        -- envt is no use.  To avoid doing this filter all the time,
-       -- we use -fno-implicit-prelude as a clue that the filter is
+       -- we use -XNoImplicitPrelude as a clue that the filter is
        -- worth while.  Really, it's only useful for GHC.Base and GHC.Tuple.
        --
        -- It's worth doing because it makes the environment smaller for
@@ -975,23 +974,23 @@ check_occs ie occs names
 %*********************************************************
 
 \begin{code}
-finishDeprecations :: DynFlags -> Maybe DeprecTxt 
-                  -> TcGblEnv -> RnM TcGblEnv
--- (a) Report usasge of deprecated imports
--- (b) If the whole module is deprecated, update tcg_deprecs
---             All this happens only once per module
-finishDeprecations dflags mod_deprec tcg_env
+finishWarnings :: DynFlags -> Maybe WarningTxt 
+               -> TcGblEnv -> RnM TcGblEnv
+-- (a) Report usage of imports that are deprecated or have other warnings
+-- (b) If the whole module is warned about or deprecated, update tcg_warns
+--     All this happens only once per module
+finishWarnings dflags mod_warn tcg_env
   = do { (eps,hpt) <- getEpsAndHpt
-       ; ifOptM Opt_WarnDeprecations   $
+       ; ifOptM Opt_WarnWarningsDeprecations $
          mapM_ (check hpt (eps_PIT eps)) all_gres
                -- By this time, typechecking is complete, 
                -- so the PIT is fully populated
 
-       -- Deal with a module deprecation; it overrides all existing deprecs
-       ; let new_deprecs = case mod_deprec of
-                               Just txt -> DeprecAll txt
-                               Nothing  -> tcg_deprecs tcg_env
-       ; return (tcg_env { tcg_deprecs = new_deprecs }) }
+       -- Deal with a module deprecation; it overrides all existing warns
+       ; let new_warns = case mod_warn of
+                               Just txt -> WarnAll txt
+                               Nothing  -> tcg_warns tcg_env
+       ; return (tcg_env { tcg_warns = new_warns }) }
   where
     used_names = allUses (tcg_dus tcg_env) 
        -- Report on all deprecated uses; hence allUses
@@ -1001,19 +1000,19 @@ finishDeprecations dflags mod_deprec tcg_env
       | name `elemNameSet` used_names
       ,        Just deprec_txt <- lookupImpDeprec dflags hpt pit gre
       = addWarnAt (importSpecLoc imp_spec)
-                 (sep [ptext (sLit "Deprecated use of") <+> 
+                 (sep [ptext (sLit "In the use of") <+> 
                        pprNonVarNameSpace (occNameSpace (nameOccName name)) <+> 
                        quotes (ppr name),
                      (parens imp_msg) <> colon,
                      (ppr deprec_txt) ])
        where
-         name_mod = nameModule name
+         name_mod = ASSERT2( isExternalName name, ppr name ) nameModule name
          imp_mod  = importSpecModule imp_spec
          imp_msg  = ptext (sLit "imported from") <+> ppr imp_mod <> extra
          extra | imp_mod == moduleName name_mod = empty
                | otherwise = ptext (sLit ", but defined in") <+> ppr name_mod
 
-    check hpt pit ok_gre = return ()   -- Local, or not used, or not deprectated
+    check _ _ _ = return ()    -- Local, or not used, or not deprectated
            -- The Imported pattern-match: don't deprecate locally defined names
            -- For a start, we may be exporting a deprecated thing
            -- Also we may use a deprecated thing in the defn of another
@@ -1022,18 +1021,19 @@ finishDeprecations dflags mod_deprec tcg_env
            -- interface
 
 lookupImpDeprec :: DynFlags -> HomePackageTable -> PackageIfaceTable 
-               -> GlobalRdrElt -> Maybe DeprecTxt
+               -> GlobalRdrElt -> Maybe WarningTxt
 -- The name is definitely imported, so look in HPT, PIT
 lookupImpDeprec dflags hpt pit gre
-  = case lookupIfaceByModule dflags hpt pit (nameModule name) of
-       Just iface -> mi_dep_fn iface name `mplus`      -- Bleat if the thing, *or
+  = case lookupIfaceByModule dflags hpt pit mod of
+       Just iface -> mi_warn_fn iface name `mplus`     -- Bleat if the thing, *or
                      case gre_par gre of       
-                       ParentIs p -> mi_dep_fn iface p -- its parent*, is deprec'd
+                       ParentIs p -> mi_warn_fn iface p        -- its parent*, is warn'd
                        NoParent   -> Nothing
 
        Nothing -> Nothing      -- See Note [Used names with interface not loaded]
   where
-       name = gre_name gre
+    name = gre_name gre
+    mod = ASSERT2( isExternalName name, ppr name ) nameModule name
 \end{code}
 
 Note [Used names with interface not loaded]
@@ -1047,7 +1047,7 @@ a) It might be a WiredInName; in that case we may not load
    its interface (although we could).
 
 b) It might be GHC.Real.fromRational, or GHC.Num.fromInteger
-   These are seen as "used" by the renamer (if -fno-implicit-prelude) 
+   These are seen as "used" by the renamer (if -XNoImplicitPrelude) 
    is on), but the typechecker may discard their uses 
    if in fact the in-scope fromRational is GHC.Read.fromRational,
    (see tcPat.tcOverloadedLit), and the typechecker sees that the type 
@@ -1113,7 +1113,7 @@ reportUnusedNames export_decls gbl_env
     unused_imports :: [GlobalRdrElt]   
     unused_imports = mapCatMaybes unused_imp defined_but_not_used
     unused_imp :: GlobalRdrElt -> Maybe GlobalRdrElt   -- Result has trimmed Imported provenances
-    unused_imp gre@(GRE {gre_prov = LocalDef}) = Nothing
+    unused_imp (GRE {gre_prov = LocalDef}) = Nothing
     unused_imp gre@(GRE {gre_prov = Imported imp_specs}) 
        | null trimmed_specs = Nothing
        | otherwise          = Just (gre {gre_prov = Imported trimmed_specs})
@@ -1150,7 +1150,7 @@ reportUnusedNames export_decls gbl_env
     add_name gre@(GRE {gre_prov = Imported (imp_spec:_)}) acc 
        = addToFM_C plusAvailEnv acc 
                    (importSpecModule imp_spec) (unitAvailEnv (greAvail gre))
-    add_name gre acc = acc     -- Local
+    add_name _ acc = acc       -- Local
 
        -- Modules mentioned as 'module M' in the export list
     expall_mods = case export_decls of
@@ -1185,7 +1185,7 @@ reportUnusedNames export_decls gbl_env
 
     direct_import_mods :: [(Module, [(ModuleName, Bool, SrcSpan)])]
        -- See the type of the imp_mods for this triple
-    direct_import_mods = moduleEnvElts (imp_mods imports)
+    direct_import_mods = fmToList (imp_mods imports)
 
     -- unused_imp_mods are the directly-imported modules 
     -- that are not mentioned in minimal_imports1
@@ -1199,7 +1199,10 @@ reportUnusedNames export_decls gbl_env
                       (_, no_imp, loc) <- xs,
                       let mod_name = moduleName mod,
                       not (mod_name `elemFM` minimal_imports1),
-                      mod /= pRELUDE,
+                      moduleName mod /= pRELUDE_NAME,
+                             -- XXX not really correct, but we don't want
+                             -- to generate warnings when compiling against
+                             -- a compat version of base.
                       not no_imp]
        -- The not no_imp part is not to complain about
        -- import M (), which is an idiom for importing
@@ -1268,7 +1271,7 @@ warnDuplicateImports gres
        -- either import would change the qualified names in scope (M.x, N.x)
        -- But if the qualified names aren't used, the import is indeed redundant
        -- Sadly we don't know that.  Oh well.
-    covers red_imp@(ImpSpec { is_decl = red_decl, is_item = red_item }) 
+    covers red_imp@(ImpSpec { is_decl = red_decl }) 
           cov_imp@(ImpSpec { is_decl = cov_decl, is_item = cov_item })
        | red_loc == cov_loc
        = False         -- Ignore diagonal elements
@@ -1341,7 +1344,7 @@ printMinimalImports imps
        where
          all_used avail_occs = all (`elem` map nameOccName ns) avail_occs
          doc = text "Compute minimal imports from" <+> ppr n
-         n_mod = nameModule n
+         n_mod = ASSERT( isExternalName n ) nameModule n
 \end{code}
 
 
@@ -1352,6 +1355,7 @@ printMinimalImports imps
 %************************************************************************
 
 \begin{code}
+badImportItemErr :: ModIface -> ImpDeclSpec -> IE RdrName -> SDoc
 badImportItemErr iface decl_spec ie
   = sep [ptext (sLit "Module"), quotes (ppr (is_mod decl_spec)), source_import,
         ptext (sLit "does not export"), quotes (ppr ie)]
@@ -1359,20 +1363,26 @@ badImportItemErr iface decl_spec ie
     source_import | mi_boot iface = ptext (sLit "(hi-boot interface)")
                  | otherwise     = empty
 
+illegalImportItemErr :: SDoc
 illegalImportItemErr = ptext (sLit "Illegal import item")
 
+dodgyImportWarn :: RdrName -> SDoc
 dodgyImportWarn item = dodgyMsg (ptext (sLit "import")) item
+dodgyExportWarn :: Name -> SDoc
 dodgyExportWarn item = dodgyMsg (ptext (sLit "export")) item
 
+dodgyMsg :: OutputableBndr n => SDoc -> n -> SDoc
 dodgyMsg kind tc
   = sep [ ptext (sLit "The") <+> kind <+> ptext (sLit "item") <+> quotes (ppr (IEThingAll tc)),
          ptext (sLit "suggests that") <+> quotes (ppr tc) <+> ptext (sLit "has constructors or class methods,"),
          ptext (sLit "but it has none") ]
-         
+
+exportItemErr :: IE RdrName -> SDoc
 exportItemErr export_item
   = sep [ ptext (sLit "The export item") <+> quotes (ppr export_item),
          ptext (sLit "attempts to export constructors or class methods that are not visible here") ]
 
+typeItemErr :: Name -> SDoc -> SDoc
 typeItemErr name wherestr
   = sep [ ptext (sLit "Using 'type' tag on") <+> quotes (ppr name) <+> wherestr,
          ptext (sLit "Use -XTypeFamilies to enable this extension") ]
@@ -1398,22 +1408,24 @@ exportClashErr global_env name1 name2 ie1 ie2
                                    then (name1, ie1, name2, ie2)
                                    else (name2, ie2, name1, ie1)
 
-addDupDeclErr :: Name -> Name -> TcRn ()
-addDupDeclErr name_a name_b
-  = addErrAt (srcLocSpan loc2) $
-    vcat [ptext (sLit "Multiple declarations of") <+> quotes (ppr name1),
-         ptext (sLit "Declared at:") <+> vcat [ppr (nameSrcLoc name1), ppr loc2]]
-  where
-    loc2 = nameSrcLoc name2
-    (name1,name2) | nameSrcLoc name_a > nameSrcLoc name_b = (name_b,name_a)
-                 | otherwise                             = (name_a,name_b)
+addDupDeclErr :: [Name] -> TcRn ()
+addDupDeclErr []
+  = panic "addDupDeclErr: empty list"
+addDupDeclErr names@(name : _)
+  = addErrAt (getSrcSpan (last sorted_names)) $
        -- Report the error at the later location
+    vcat [ptext (sLit "Multiple declarations of") <+> quotes (ppr name),
+         ptext (sLit "Declared at:") <+> vcat (map (ppr . nameSrcLoc) sorted_names)]
+  where
+    sorted_names = sortWith nameSrcLoc names
 
+dupExportWarn :: OccName -> IE RdrName -> IE RdrName -> SDoc
 dupExportWarn occ_name ie1 ie2
   = hsep [quotes (ppr occ_name), 
           ptext (sLit "is exported by"), quotes (ppr ie1),
           ptext (sLit "and"),            quotes (ppr ie2)]
 
+dupModuleExport :: ModuleName -> SDoc
 dupModuleExport mod
   = hsep [ptext (sLit "Duplicate"),
          quotes (ptext (sLit "Module") <+> ppr mod), 
@@ -1424,13 +1436,24 @@ moduleNotImported mod
   = ptext (sLit "The export item `module") <+> ppr mod <>
     ptext (sLit "' is not imported")
 
+nullModuleExport :: ModuleName -> SDoc
 nullModuleExport mod
   = ptext (sLit "The export item `module") <+> ppr mod <> ptext (sLit "' exports nothing")
 
-moduleDeprec mod txt
-  = sep [ ptext (sLit "Module") <+> quotes (ppr mod) <+> ptext (sLit "is deprecated:"), 
-         nest 4 (ppr txt) ]      
+moduleWarn :: ModuleName -> WarningTxt -> SDoc
+moduleWarn mod (WarningTxt txt)
+  = sep [ ptext (sLit "Module") <+> quotes (ppr mod) <> ptext (sLit ":"), 
+          nest 4 (ppr txt) ]
+moduleWarn mod (DeprecatedTxt txt)
+  = sep [ ptext (sLit "Module") <+> quotes (ppr mod)
+                                <+> ptext (sLit "is deprecated:"), 
+          nest 4 (ppr txt) ]
 
+implicitPreludeWarn :: SDoc
 implicitPreludeWarn
   = ptext (sLit "Module `Prelude' implicitly imported")
+
+packageImportErr :: SDoc
+packageImportErr
+  = ptext (sLit "Package-qualified imports are not enabled; use -XPackageImports")
 \end{code}