[project @ 1998-01-12 09:29:22 by simonpj]
[ghc-hetmet.git] / ghc / compiler / rename / RnNames.lhs
index beca595..a3ff994 100644 (file)
@@ -4,37 +4,39 @@
 \section[RnNames]{Extracting imported and top-level names in scope}
 
 \begin{code}
-#include "HsVersions.h"
-
 module RnNames (
        getGlobalNames
     ) where
 
-IMP_Ubiq()
+#include "HsVersions.h"
 
-import CmdLineOpts     ( opt_SourceUnchanged, opt_NoImplicitPrelude )
-import HsSyn   ( HsModule(..), HsDecl(..), FixityDecl(..), Fixity, Fake, InPat, IE(..), HsTyVar,
-                 TyDecl, ClassDecl, InstDecl, DefaultDecl, ImportDecl(..), HsBinds, IfaceSig,
+import CmdLineOpts    ( opt_NoImplicitPrelude, opt_WarnDuplicateExports, 
+                       opt_SourceUnchanged
+                     )
+
+import HsSyn   ( HsModule(..), ImportDecl(..), HsDecl(..), 
+                 IE(..), ieName,
+                 FixityDecl(..),
                  collectTopBinders
                )
-import HsImpExp        ( ieName )
-import RdrHsSyn        ( RdrNameHsDecl(..), RdrName(..), RdrNameIE(..), SYN_IE(RdrNameImportDecl),
-                 SYN_IE(RdrNameHsModule), SYN_IE(RdrNameFixityDecl),
+import RdrHsSyn        ( RdrNameHsDecl(..), RdrName(..), RdrNameIE(..), RdrNameImportDecl,
+                 RdrNameHsModule, RdrNameFixityDecl,
                  rdrNameOcc, ieOcc
                )
 import RnHsSyn ( RenamedHsModule(..), RenamedFixityDecl(..) )
-import RnIfaces        ( getInterfaceExports, getDeclBinders, checkUpToDate, recordSlurp )
+import RnIfaces        ( getInterfaceExports, getDeclBinders, recordSlurp, checkUpToDate )
+import BasicTypes ( IfaceFlavour(..) )
 import RnEnv
 import RnMonad
+
 import FiniteMap
 import PrelMods
 import UniqFM  ( UniqFM, emptyUFM, addListToUFM_C, lookupUFM )
 import Bag     ( Bag, bagToList )
 import Maybes  ( maybeToBool, expectJust )
 import Name
-import Pretty
-import Outputable      ( Outputable(..), PprStyle(..) )
-import Util    ( panic, pprTrace, assertPanic )
+import Outputable
+import Util    ( removeDups )
 \end{code}
 
 
@@ -47,11 +49,11 @@ import Util ( panic, pprTrace, assertPanic )
 
 \begin{code}
 getGlobalNames :: RdrNameHsModule
-              -> RnMG (Maybe (ExportEnv, RnEnv, NameSet))
-                       -- Nothing <=> no need to recompile
+              -> RnMG (Maybe (ExportEnv, RnEnv, NameSet, Name -> PrintUnqualified))
                        -- The NameSet is the set of names that are
                        --      either locally defined,
                        --      or explicitly imported
+                       -- Nothing => no need to recompile
 
 getGlobalNames m@(HsModule this_mod _ exports imports _ _ mod_loc)
   = fixRn (\ ~(rec_exp_fn, _) ->
@@ -65,34 +67,55 @@ getGlobalNames m@(HsModule this_mod _ exports imports _ _ mod_loc)
       mapAndUnzip3Rn importsFromImportDecl all_imports
                                                `thenRn` \ (imp_rn_envs, imp_avails_s, explicit_imports_s) ->
 
-       -- CHECK FOR EARLY EXIT
-      checkEarlyExit this_mod                  `thenRn` \ early_exit ->
-      if early_exit then
-               returnRn (junk_exp_fn, Nothing)
-      else
-
        -- COMBINE RESULTS
-       -- We put the local env first, so that a local provenance
+       -- We put the local env second, so that a local provenance
        -- "wins", even if a module imports itself.
       foldlRn plusRnEnv emptyRnEnv imp_rn_envs         `thenRn` \ imp_rn_env ->
-      plusRnEnv local_rn_env imp_rn_env                        `thenRn` \ rn_env ->
+      plusRnEnv imp_rn_env local_rn_env                        `thenRn` \ rn_env ->
+
+       -- TRY FOR EARLY EXIT
+       -- We can't go for an early exit before this because we have to check
+       -- for name clashes.  Consider:
+       --
+       --      module A where          module B where
+       --         import B                h = True
+       --         f = h
+       --
+       -- Suppose I've compiled everything up, and then I add a
+       -- new definition to module B, that defines "f".
+       --
+       -- Then I must detect the name clash in A before going for an early
+       -- exit.  The early-exit code checks what's actually needed from B
+       -- to compile A, and of course that doesn't include B.f.  That's
+       -- why we wait till after the plusRnEnv stuff to do the early-exit.
+      checkEarlyExit this_mod                          `thenRn` \ up_to_date ->
+      if up_to_date then
+       returnRn (error "early exit", Nothing)
+      else
+
+       -- PROCESS EXPORT LISTS
       let
-        all_avails :: ModuleAvails
-        all_avails = foldr plusModuleAvails local_mod_avails imp_avails_s
+        export_avails :: ExportAvails
+        export_avails = foldr plusExportAvails local_mod_avails imp_avails_s
 
         explicit_names :: NameSet      -- locally defined or explicitly imported
         explicit_names = foldr add_on emptyNameSet (local_avails : explicit_imports_s)
         add_on avails names = foldr (unionNameSets . mkNameSet . availNames) names avails
       in
-  
-       -- PROCESS EXPORT LISTS
-      exportsFromAvail this_mod exports all_avails rn_env      
+      exportsFromAvail this_mod exports export_avails rn_env   
                                                        `thenRn` \ (export_fn, export_env) ->
 
        -- RECORD THAT LOCALLY DEFINED THINGS ARE AVAILABLE
       mapRn (recordSlurp Nothing Compulsory) local_avails      `thenRn_`
 
-      returnRn (export_fn, Just (export_env, rn_env, explicit_names))
+        -- BUILD THE "IMPORT FN".  It just tells whether a name is in
+       -- scope in an unqualified form.
+      let 
+         print_unqual = mkImportFn imp_rn_env
+      in   
+
+      returnRn (export_fn, Just (export_env, rn_env, explicit_names, print_unqual))
     )                                                  `thenRn` \ (_, result) ->
     returnRn result
   where
@@ -110,7 +133,7 @@ getGlobalNames m@(HsModule this_mod _ exports imports _ _ mod_loc)
 
                 | otherwise               = [ImportDecl pRELUDE 
                                                         False          {- Not qualified -}
-                                                        False          {- Not source imported -}
+                                                        HiFile         {- Not source imported -}
                                                         Nothing        {- No "as" -}
                                                         Nothing        {- No import list -}
                                                         mod_loc]
@@ -126,49 +149,43 @@ checkEarlyExit mod
        -- Found errors already, so exit now
        returnRn True
     else
+
     traceRn (text "Considering whether compilation is required...")    `thenRn_`
-    (if not opt_SourceUnchanged then
+    if not opt_SourceUnchanged then
        -- Source code changed and no errors yet... carry on 
-       traceRn (nest 4 (text "source file changed"))                   `thenRn_` 
+       traceRn (nest 4 (text "source file changed or recompilation check turned off")) `thenRn_` 
        returnRn False
-     else
+    else
+
        -- Unchanged source, and no errors yet; see if usage info
        -- up to date, and exit if so
-       checkUpToDate mod
-    )                                                                  `thenRn` \ up_to_date ->
-    traceRn (text "Hence, compilation" <+> 
-            text (if up_to_date then "IS NOT" else "IS") <+>
-            text "required")                                           `thenRn_`
+    checkUpToDate mod                                          `thenRn` \ up_to_date ->
+    putDocRn (text "Compilation" <+> 
+             text (if up_to_date then "IS NOT" else "IS") <+>
+             text "required")                                  `thenRn_`
     returnRn up_to_date
 \end{code}
        
-
 \begin{code}
 importsFromImportDecl :: RdrNameImportDecl
-                     -> RnMG (RnEnv, ModuleAvails, [AvailInfo])
+                     -> RnMG (RnEnv, ExportAvails, [AvailInfo])
 
 importsFromImportDecl (ImportDecl mod qual_only as_source as_mod import_spec loc)
   = pushSrcLocRn loc $
     getInterfaceExports mod as_source          `thenRn` \ (avails, fixities) ->
     filterImports mod import_spec avails       `thenRn` \ (filtered_avails, hides, explicits) ->
     let
-       filtered_avails' = map set_avail_prov filtered_avails
-       fixities'        = [ (occ,(fixity,provenance)) | (occ,fixity) <- fixities ]
+       how_in_scope = FromImportDecl mod loc
     in
     qualifyImports mod 
                   True                 -- Want qualified names
                   (not qual_only)      -- Maybe want unqualified names
                   as_mod
-                  (ExportEnv filtered_avails' fixities')
                   hides
+                  filtered_avails (\n -> how_in_scope)
+                  [ (occ,(fixity,how_in_scope)) | (occ,fixity) <- fixities ]
                                                        `thenRn` \ (rn_env, mod_avails) ->
     returnRn (rn_env, mod_avails, explicits)
-  where
-    set_avail_prov NotAvailable   = NotAvailable
-    set_avail_prov (Avail n)      = Avail (set_name_prov n) 
-    set_avail_prov (AvailTC n ns) = AvailTC (set_name_prov n) (map set_name_prov ns)
-    set_name_prov name = setNameProvenance name provenance
-    provenance = Imported mod loc
 \end{code}
 
 
@@ -180,8 +197,9 @@ importsFromLocalDecls rec_exp_fn (HsModule mod _ _ _ fix_decls decls _)
                   False        -- Don't want qualified names
                   True         -- Want unqualified names
                   Nothing      -- No "as M" part
-                  (ExportEnv avails fixities)
                   []           -- Hide nothing
+                  avails (\n -> FromLocalDefn (getSrcLoc n))
+                  fixities
                                                        `thenRn` \ (rn_env, mod_avails) ->
     returnRn (rn_env, mod_avails, avails)
   where
@@ -221,7 +239,7 @@ filterImports :: Module
                       [AvailInfo])                     -- What was imported explicitly
 
        -- Complains if import spec mentions things that the module doesn't export
-
+        -- Warns/informs if import spec contains duplicates.
 filterImports mod Nothing imports
   = returnRn (imports, [], [])
 
@@ -275,16 +293,18 @@ qualifyImports :: Module                          -- Imported module
               -> Bool                                  -- True <=> want qualified import
               -> Bool                                  -- True <=> want unqualified import
               -> Maybe Module                          -- Optional "as M" part 
-              -> ExportEnv                             -- What's imported
               -> [AvailInfo]                           -- What's to be hidden
-              -> RnMG (RnEnv, ModuleAvails)
+              -> Avails -> (Name -> HowInScope)        -- Whats imported and how
+              -> [(OccName, (Fixity, HowInScope))]     -- Ditto for fixities
+              -> RnMG (RnEnv, ExportAvails)
 
-qualifyImports this_mod qual_imp unqual_imp as_mod (ExportEnv avails fixities) hides
+qualifyImports this_mod qual_imp unqual_imp as_mod hides
+              avails name_to_his fixities
   = 
        -- Make the name environment.  Even though we're talking about a 
        -- single import module there might still be name clashes, 
        -- because it might be the module being compiled.
-    foldlRn add_avail emptyNameEnv avails      `thenRn` \ name_env1 ->
+    foldlRn add_avail emptyGlobalNameEnv avails        `thenRn` \ name_env1 ->
     let
        -- Delete things that are hidden
        name_env2 = foldl del_avail name_env1 hides
@@ -292,45 +312,48 @@ qualifyImports this_mod qual_imp unqual_imp as_mod (ExportEnv avails fixities) h
        -- Create the fixity env
        fixity_env = foldl (add_fixity name_env2) emptyFixityEnv fixities
 
-       -- The "module M" syntax only applies to *unqualified* imports (1.4 Report, Section 5.1.1)
-       mod_avail_env | unqual_imp = unitFM qual_mod avails
-                     | otherwise  = emptyFM
+       -- Create the export-availability info
+       export_avails = mkExportAvails unqual_imp qual_mod avails
     in
-    returnRn (RnEnv name_env2 fixity_env, mod_avail_env)
+    returnRn (RnEnv name_env2 fixity_env, export_avails)
   where
     qual_mod = case as_mod of
                  Nothing           -> this_mod
                  Just another_name -> another_name
 
+    add_avail :: GlobalNameEnv -> AvailInfo -> RnMG GlobalNameEnv
     add_avail env avail = foldlRn add_name env (availNames avail)
-    add_name env name   = add qual_imp   env  (Qual qual_mod occ)      `thenRn` \ env1 ->
+
+    add_name env name   = add qual_imp   env  (Qual qual_mod occ err_hif) `thenRn` \ env1 ->
                          add unqual_imp env1 (Unqual occ)
                        where
                          add False env rdr_name = returnRn env
-                         add True  env rdr_name = addOneToNameEnv env rdr_name name
+                         add True  env rdr_name = addOneToGlobalNameEnv env rdr_name (name, name_to_his name)
                          occ  = nameOccName name
 
-    del_avail env avail = foldl delOneFromNameEnv env rdr_names
+    del_avail env avail = foldl delOneFromGlobalNameEnv env rdr_names
                        where
                          rdr_names = map (Unqual . nameOccName) (availNames avail)
                        
-    add_fixity name_env fix_env (occ_name, (fixity, provenance))
+    add_fixity name_env fix_env (occ_name, fixity)
        = add qual $ add unqual $ fix_env
        where
-         qual   = Qual qual_mod occ_name
+         qual   = Qual qual_mod occ_name err_hif
          unqual = Unqual occ_name
 
          add rdr_name fix_env | maybeToBool (lookupFM name_env rdr_name)
-                              = addOneToFixityEnv fix_env rdr_name (fixity,provenance)
+                              = addOneToFixityEnv fix_env rdr_name fixity
                               | otherwise
                               = fix_env
+
+err_hif = error "qualifyImports: hif"  -- Not needed in key to mapping
 \end{code}
 
 unQualify adds an Unqual binding for every existing Qual binding.
 
 \begin{code}
 unQualify :: FiniteMap RdrName elt -> FiniteMap RdrName elt
-unQualify fm = addListToFM fm [(Unqual occ, elt) | (Qual _ occ, elt) <- fmToList fm]
+unQualify fm = addListToFM fm [(Unqual occ, elt) | (Qual _ occ _, elt) <- fmToList fm]
 \end{code}
 
 %************************************************************************
@@ -341,10 +364,10 @@ unQualify fm = addListToFM fm [(Unqual occ, elt) | (Qual _ occ, elt) <- fmToList
 
 
 \begin{code}
-fixityFromFixDecl :: RdrNameFixityDecl -> RnMG (OccName, (Fixity, Provenance))
+fixityFromFixDecl :: RdrNameFixityDecl -> RnMG (OccName, (Fixity, HowInScope))
 
 fixityFromFixDecl (FixityDecl rdr_name fixity loc)
-  = returnRn (rdrNameOcc rdr_name, (fixity, LocalDef (panic "export-flag") loc))
+  = returnRn (rdrNameOcc rdr_name, (fixity, FromLocalDefn loc))
 \end{code}
 
 
@@ -360,27 +383,46 @@ exported thing, and we also need to check for name clashes -- that
 is: two exported things must have different @OccNames@.
 
 \begin{code}
-type AvailEnv = FiniteMap OccName (RdrNameIE, AvailInfo)
+type AvailEnv = FiniteMap OccName (RdrNameIE, AvailInfo, Int{-no. of clashes-})
        -- The FM maps each OccName to the RdrNameIE that gave rise to it,
        -- for error reporting, as well as to its AvailInfo
 
 emptyAvailEnv = emptyFM
 
-unitAvailEnv :: RdrNameIE -> AvailInfo -> AvailEnv
-unitAvailEnv ie NotAvailable   = emptyFM
-unitAvailEnv ie (AvailTC _ []) = emptyFM
-unitAvailEnv ie avail         = unitFM (nameOccName (availName avail)) (ie,avail)
+{-
+ Add new entry to environment. Checks for name clashes, i.e.,
+ plain duplicates or exported entity pairs that have different OccNames.
+ (c.f. 5.1.1 of Haskell 1.4 report.)
+-}
+addAvailEnv :: Bool -> RdrNameIE -> AvailEnv -> AvailInfo -> RnM s d AvailEnv
+addAvailEnv warn_dups ie env NotAvailable   = returnRn env
+addAvailEnv warn_dups ie env (AvailTC _ []) = returnRn env
+addAvailEnv warn_dups ie env avail
+  | warn_dups = mapMaybeRn (addErrRn  . availClashErr) () conflict `thenRn_`
+                returnRn (addToFM_C addAvail env key elt)
+  | otherwise = returnRn (addToFM_C addAvail env key elt)
+  where
+   key  = nameOccName (availName avail)
+   elt  = (ie,avail,reports_on)
+
+   reports_on
+    | maybeToBool dup = 1
+    | otherwise       = 0
 
-plusAvailEnv a1 a2
-  = mapRn (addErrRn.availClashErr) (conflictsFM bad_avail a1 a2)       `thenRn_`
-    returnRn (plusFM_C plus_avail a1 a2)
+   conflict = conflictFM bad_avail env key elt
+   dup 
+    | warn_dups = conflictFM dup_avail env key elt
+    | otherwise = Nothing
 
-listToAvailEnv :: RdrNameIE -> [AvailInfo] -> RnM s d AvailEnv
-listToAvailEnv ie items
-  = foldlRn plusAvailEnv emptyAvailEnv (map (unitAvailEnv ie) items)
+addListToAvailEnv :: AvailEnv -> RdrNameIE -> [AvailInfo] -> RnM s d AvailEnv
+addListToAvailEnv env ie items = foldlRn (addAvailEnv False ie) env items
 
-bad_avail  (ie1,avail1) (ie2,avail2) = availName avail1 /= availName avail2    -- Same OccName, different Name
-plus_avail (ie1,a1) (ie2,a2) = (ie1, a1 `plusAvail` a2)
+bad_avail  (ie1,avail1,r1) (ie2,avail2,r2) 
+   = availName avail1 /= availName avail2  -- Same OccName, different Name
+dup_avail  (ie1,avail1,r1) (ie2,avail2,r2) 
+   = availName avail1 == availName avail2 -- Same OccName & avail.
+
+addAvail (ie1,a1,r1) (ie2,a2,r2) = (ie1, a1 `plusAvail` a2, r1 + r2)
 \end{code}
 
 Processing the export list.
@@ -395,83 +437,81 @@ includes ConcBase.StateAndSynchVar#, and so on...
 \begin{code}
 exportsFromAvail :: Module
                 -> Maybe [RdrNameIE]   -- Export spec
-                -> ModuleAvails
+                -> ExportAvails
                 -> RnEnv
                 -> RnMG (Name -> ExportFlag, ExportEnv)
        -- Complains if two distinct exports have same OccName
+        -- Warns about identical exports.
        -- Complains about exports items not in scope
-exportsFromAvail this_mod Nothing all_avails rn_env
-  = exportsFromAvail this_mod (Just [IEModuleContents this_mod]) all_avails rn_env
-
-exportsFromAvail this_mod (Just export_items) all_avails (RnEnv name_env fixity_env)
-  = mapRn exports_from_item export_items               `thenRn` \ avail_envs ->
-    foldlRn plusAvailEnv emptyAvailEnv avail_envs      `thenRn` \ export_avail_env -> 
+exportsFromAvail this_mod Nothing export_avails rn_env
+  = exportsFromAvail this_mod (Just [IEModuleContents this_mod]) export_avails rn_env
+
+exportsFromAvail this_mod (Just export_items) 
+                (mod_avail_env, entity_avail_env)
+                (RnEnv global_name_env fixity_env)
+  = checkForModuleExportDups export_items                 `thenRn` \ export_items' ->
+    foldlRn exports_from_item emptyAvailEnv export_items' `thenRn` \ export_avail_env ->
     let
-       export_avails   = map snd (eltsFM export_avail_env)
+     dup_entries = fmToList (filterFM (\ _ (_,_,clashes) -> clashes > 0) export_avail_env)
+    in
+    mapRn (addWarnRn . dupExportWarn) dup_entries         `thenRn_`
+    let
+       export_avails   = map (\ (_,a,_) -> a) (eltsFM export_avail_env)
        export_fixities = mk_exported_fixities (availsToNameSet export_avails)
        export_fn       = mk_export_fn export_avails
     in
     returnRn (export_fn, ExportEnv export_avails export_fixities)
 
   where
-    full_avail_env :: UniqFM AvailInfo
-    full_avail_env = addListToUFM_C plusAvail emptyUFM
-                          [(name, avail) | avail <- concat (eltsFM all_avails),
-                                           name  <- availEntityNames avail 
-                          ]
-
-       -- NB: full_avail_env will contain bindings for class ops but not constructors
-       -- (see defn of availEntityNames)
-
-    exports_from_item :: RdrNameIE -> RnMG AvailEnv
-    exports_from_item ie@(IEModuleContents mod)
-       = case lookupFM all_avails mod of
-               Nothing     -> failWithRn emptyAvailEnv (modExportErr mod)
-               Just avails -> listToAvailEnv ie avails
-
-    exports_from_item ie
+    exports_from_item :: AvailEnv -> RdrNameIE -> RnMG AvailEnv
+    exports_from_item export_avail_env ie@(IEModuleContents mod)
+       = case lookupFM mod_avail_env mod of
+               Nothing     -> failWithRn export_avail_env (modExportErr mod)
+               Just avails -> addListToAvailEnv export_avail_env ie avails
+
+    exports_from_item export_avail_env ie
        | not (maybeToBool maybe_in_scope) 
-       = failWithRn emptyAvailEnv (unknownNameErr (ieName ie))
+       = failWithRn export_avail_env (unknownNameErr (ieName ie))
 
 #ifdef DEBUG
        -- I can't see why this should ever happen; if the thing is in scope
        -- at all it ought to have some availability
        | not (maybeToBool maybe_avail)
-       = pprTrace "exportsFromAvail: curious Nothing:" (ppr PprDebug name)
-         returnRn emptyAvailEnv
+       = pprTrace "exportsFromAvail: curious Nothing:" (ppr name)
+         returnRn export_avail_env
 #endif
 
        | not enough_avail
-       = failWithRn emptyAvailEnv (exportItemErr ie export_avail)
+       = failWithRn export_avail_env (exportItemErr ie export_avail)
 
        | otherwise     -- Phew!  It's OK!
-       = returnRn (unitAvailEnv ie export_avail)
+       = addAvailEnv opt_WarnDuplicateExports ie export_avail_env export_avail
        where
-          maybe_in_scope  = lookupNameEnv name_env (ieName ie)
-         Just name       = maybe_in_scope
-         maybe_avail     = lookupUFM full_avail_env name
+          maybe_in_scope  = lookupFM global_name_env (ieName ie)
+         Just (name,_)   = maybe_in_scope
+         maybe_avail     = lookupUFM entity_avail_env name
          Just avail      = maybe_avail
          export_avail    = filterAvail ie avail
          enough_avail    = case export_avail of {NotAvailable -> False; other -> True}
 
        -- We export a fixity iff we export a thing with the same (qualified) RdrName
-    mk_exported_fixities :: NameSet -> [(OccName, (Fixity, Provenance))]
+    mk_exported_fixities :: NameSet -> [(OccName, Fixity)]
     mk_exported_fixities exports
        = fmToList (foldr (perhaps_add_fixity exports) 
                          emptyFM
                          (fmToList fixity_env))
 
-    perhaps_add_fixity :: NameSet -> (RdrName, (Fixity, Provenance))
-                      -> FiniteMap OccName (Fixity,Provenance)
-                      -> FiniteMap OccName (Fixity,Provenance)
-    perhaps_add_fixity exports (rdr_name, (fixity, prov)) fix_env
+    perhaps_add_fixity :: NameSet -> (RdrName, (Fixity, HowInScope))
+                      -> FiniteMap OccName Fixity
+                      -> FiniteMap OccName Fixity
+    perhaps_add_fixity exports (rdr_name, (fixity, how_in_scope)) fix_env
       =  let
            do_nothing = fix_env                -- The default is to pass on the env unchanged
         in
                -- Step 1: check whether the rdr_name is in scope; if so find its Name
-        case lookupFM name_env rdr_name of {
-          Nothing          -> do_nothing;
-          Just fixity_name -> 
+        case lookupFM global_name_env rdr_name of {
+          Nothing              -> do_nothing;
+          Just (fixity_name,_) -> 
 
                -- Step 2: check whether the fixity thing is exported
         if not (fixity_name `elemNameSet` exports) then
@@ -487,15 +527,40 @@ exportsFromAvail this_mod (Just export_items) all_avails (RnEnv name_env fixity_
            occ_name = rdrNameOcc rdr_name
        in
        case lookupFM fix_env occ_name of {
-         Just (fixity1, prov1) ->      -- Got it already
-                                  ASSERT( fixity == fixity1 )
-                                  do_nothing;
+         Just fixity1 ->       -- Got it already
+                          ASSERT( fixity == fixity1 )
+                          do_nothing;
          Nothing -> 
 
                -- Step 3: add it to the outgoing fix_env
-       addToFM fix_env occ_name (fixity,prov)
+       addToFM fix_env occ_name fixity
        }}
 
+{- warn and weed out duplicate module entries from export list. -}
+checkForModuleExportDups :: [RdrNameIE] -> RnMG [RdrNameIE]
+checkForModuleExportDups ls 
+  | opt_WarnDuplicateExports = check_modules ls
+  | otherwise                = returnRn ls
+  where
+   -- NOTE: reorders the export list by moving all module-contents
+   -- exports to the end (removing duplicates in the process.)
+   check_modules ls = 
+     (case dups of
+        [] -> returnRn ()
+        ls -> mapRn (\ ds@(IEModuleContents x:_) -> 
+                       addWarnRn (dupModuleExport x (length ds))) ls `thenRn_`
+              returnRn ()) `thenRn_`
+     returnRn (ls_no_modules ++ no_module_dups)
+     where
+      (ls_no_modules,modules) = foldr split_mods ([],[]) ls
+
+      split_mods i@(IEModuleContents _) ~(no_ms,ms) = (no_ms,i:ms)
+      split_mods i ~(no_ms,ms) = (i:no_ms,ms)
+
+      (no_module_dups, dups) = removeDups cmp_mods modules
+
+      cmp_mods (IEModuleContents m1) (IEModuleContents m2) = m1 `compare` m2
+  
 mk_export_fn :: [AvailInfo] -> (Name -> ExportFlag)
 mk_export_fn avails
   = \name -> if name `elemNameSet` exported_names
@@ -504,8 +569,7 @@ mk_export_fn avails
   where
     exported_names :: NameSet
     exported_names = availsToNameSet avails
-\end{code}                               
-
+\end{code}
 
 %************************************************************************
 %*                                                                     *
@@ -514,22 +578,33 @@ mk_export_fn avails
 %************************************************************************
 
 \begin{code}
-badImportItemErr mod ie sty
-  = sep [ptext SLIT("Module"), pprModule sty mod, ptext SLIT("does not export"), ppr sty ie]
+badImportItemErr mod ie
+  = sep [ptext SLIT("Module"), quotes (pprModule mod), 
+        ptext SLIT("does not export"), quotes (ppr ie)]
 
-modExportErr mod sty
-  = hsep [ ptext SLIT("Unknown module in export list: module"), ptext mod]
+modExportErr mod
+  = hsep [ ptext SLIT("Unknown module in export list: module"), quotes (pprModule mod)]
 
-exportItemErr export_item NotAvailable sty
-  = sep [ ptext SLIT("Export item not in scope:"), ppr sty export_item ]
+exportItemErr export_item NotAvailable
+  = sep [ ptext SLIT("Export item not in scope:"), quotes (ppr export_item)]
 
-exportItemErr export_item avail sty
+exportItemErr export_item avail
   = hang (ptext SLIT("Export item not fully in scope:"))
-          4 (vcat [hsep [ptext SLIT("Wanted:   "), ppr sty export_item],
-                   hsep [ptext SLIT("Available:"), ppr sty (ieOcc export_item), pprAvail sty avail]])
-
-availClashErr (occ_name, ((ie1,avail1), (ie2,avail2))) sty
-  = hsep [ptext SLIT("The export items"), ppr sty ie1, ptext SLIT("and"), ppr sty ie2,
-         ptext SLIT("create conflicting exports for"), ppr sty occ_name]
+          4 (vcat [hsep [ptext SLIT("Wanted:   "), ppr export_item],
+                   hsep [ptext SLIT("Available:"), ppr (ieOcc export_item), pprAvail avail]])
+
+availClashErr (occ_name, ((ie1,avail1,_), (ie2,avail2,_)))
+  = hsep [ptext SLIT("The export items"), quotes (ppr ie1), ptext SLIT("and"), quotes (ppr ie2),
+         ptext SLIT("create conflicting exports for"), quotes (ppr occ_name)]
+
+dupExportWarn (occ_name, (_,_,times))
+  = hsep [quotes (ppr occ_name), 
+          ptext SLIT("mentioned"), speakNTimes (times+1),
+          ptext SLIT("in export list")]
+
+dupModuleExport mod times
+  = hsep [ptext SLIT("Module"), quotes (pprModule mod), 
+          ptext SLIT("mentioned"), speakNTimes times,
+          ptext SLIT("in export list")]
 \end{code}