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

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

diff --git a/ghc/compiler/rename/RnNames.lhs b/ghc/compiler/rename/RnNames.lhs
index 9b4abb5..881f497 100644 (file)
--- a/ghc/compiler/rename/RnNames.lhs
+++ b/ghc/compiler/rename/RnNames.lhs
@@ -1,41 +1,48 @@
 %
 %

-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
+% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998

 %
 \section[RnNames]{Extracting imported and top-level names in scope}
 
 \begin{code}
 %
 \section[RnNames]{Extracting imported and top-level names in scope}
 
 \begin{code}

-#include "HsVersions.h"
-

 module RnNames (
        getGlobalNames
     ) where
 
 module RnNames (
        getGlobalNames
     ) where
 

-IMP_Ubiq()
+#include "HsVersions.h"
+
+import CmdLineOpts    ( opt_NoImplicitPrelude, opt_WarnDuplicateExports, 
+                       opt_SourceUnchanged, opt_WarnUnusedBinds
+                     )

 
 

-import CmdLineOpts     ( opt_SourceUnchanged, opt_NoImplicitPrelude )
-import HsSyn   ( HsModule(..), HsDecl(..), FixityDecl(..), Fixity, Fake, InPat, IE(..), HsTyVar,
-                 TyDecl, ClassDecl, InstDecl, DefaultDecl, ImportDecl(..), HsBinds, IfaceSig,
+import HsSyn   ( HsModule(..), ImportDecl(..), HsDecl(..), TyClDecl(..),
+                 IE(..), ieName, 
+                 ForeignDecl(..), ForKind(..), isDynamic,
+                 FixitySig(..), Sig(..),

                  collectTopBinders
                )
                  collectTopBinders
                )

-import HsImpExp        ( ieName )
-import RdrHsSyn        ( RdrNameHsDecl(..), RdrName(..), RdrNameIE(..), SYN_IE(RdrNameImportDecl),
-                 SYN_IE(RdrNameHsModule), SYN_IE(RdrNameFixityDecl),
-                 rdrNameOcc, ieOcc
+import RdrHsSyn        ( RdrNameIE, RdrNameImportDecl,
+                 RdrNameHsModule, RdrNameHsDecl
+               )
+import RnIfaces        ( getInterfaceExports, getDeclBinders, getImportedFixities, 
+                 recordSlurp, checkUpToDate

                )
                )

-import RnHsSyn ( RenamedHsModule(..), RenamedFixityDecl(..) )
-import RnIfaces        ( getInterfaceExports, getDeclBinders, checkUpToDate, recordSlurp )
-import BasicTypes ( IfaceFlavour(..) )

 import RnEnv
 import RnMonad
 import RnEnv
 import RnMonad

+

 import FiniteMap
 import PrelMods
 import FiniteMap
 import PrelMods

-import UniqFM  ( UniqFM, emptyUFM, addListToUFM_C, lookupUFM )
-import Bag     ( Bag, bagToList )
-import Maybes  ( maybeToBool, expectJust )
+import UniqFM  ( lookupUFM )
+import Bag     ( bagToList )
+import Maybes  ( maybeToBool )
+import Module  ( pprModule )
+import NameSet

 import Name
 import Name

-import Pretty
-import Outputable      ( Outputable(..), PprStyle(..) )
-import Util    ( panic, pprTrace, assertPanic )
+import RdrName ( RdrName, rdrNameOcc, mkRdrQual, mkRdrUnqual )
+import SrcLoc  ( SrcLoc )
+import NameSet ( elemNameSet, emptyNameSet )
+import Outputable
+import Unique  ( getUnique )
+import Util    ( removeDups, equivClassesByUniq, sortLt )

 \end{code}
 
 
 \end{code}
 
 

@@ -48,54 +55,107 @@ import Util        ( panic, pprTrace, assertPanic )
 
 \begin{code}
 getGlobalNames :: RdrNameHsModule
 
 \begin{code}
 getGlobalNames :: RdrNameHsModule

-              -> RnMG (Maybe (ExportEnv, RnEnv, NameSet))
-                       -- Nothing <=> no need to recompile
-                       -- The NameSet is the set of names that are
-                       --      either locally defined,
-                       --      or explicitly imported
-
-getGlobalNames m@(HsModule this_mod _ exports imports _ _ mod_loc)
-  = fixRn (\ ~(rec_exp_fn, _) ->
-
-       -- PROCESS LOCAL DECLS
-       -- Do these *first* so that the correct provenance gets
-       -- into the global name cache.
-      importsFromLocalDecls rec_exp_fn m       `thenRn` \ (local_rn_env, local_mod_avails, local_avails) ->
-
-       -- PROCESS IMPORT DECLS
-      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
+              -> RnMG (Maybe (ExportEnv, 
+                              RnEnv,
+                              NameEnv AvailInfo        -- Maps a name to its parent AvailInfo
+                                                       -- Just for in-scope things only
+                              ))
+                       -- Nothing => no need to recompile
+
+getGlobalNames (HsModule this_mod _ exports imports decls mod_loc)
+  =    -- These two fix-loops are to get the right
+       -- provenance information into a Name
+    fixRn (\ ~(rec_exported_avails, _) ->
+
+      fixRn (\ ~(rec_rn_env, _) ->
+       let
+          rec_unqual_fn :: Name -> Bool        -- Is this chap in scope unqualified?
+          rec_unqual_fn = unQualInScope rec_rn_env

 
 

-       -- COMBINE RESULTS
-       -- 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 imp_rn_env local_rn_env                        `thenRn` \ rn_env ->
-      let
-        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 export_avails rn_env   
-                                                       `thenRn` \ (export_fn, export_env) ->
+          rec_exp_fn :: Name -> ExportFlag
+          rec_exp_fn = mk_export_fn (availsToNameSet rec_exported_avails)
+       in
+       setOmitQualFn rec_unqual_fn             $
+       setModuleRn this_mod                    $

 
 

-       -- RECORD THAT LOCALLY DEFINED THINGS ARE AVAILABLE
-      mapRn (recordSlurp Nothing Compulsory) local_avails      `thenRn_`
+               -- PROCESS LOCAL DECLS
+               -- Do these *first* so that the correct provenance gets
+               -- into the global name cache.
+       importsFromLocalDecls this_mod rec_exp_fn decls `thenRn` \ (local_gbl_env, local_mod_avails) ->
+
+               -- PROCESS IMPORT DECLS
+       mapAndUnzipRn importsFromImportDecl all_imports `thenRn` \ (imp_gbl_envs, imp_avails_s) ->
+
+               -- COMBINE RESULTS
+               -- We put the local env second, so that a local provenance
+               -- "wins", even if a module imports itself.
+       let
+           gbl_env :: GlobalRdrEnv
+           imp_gbl_env = foldr plusGlobalRdrEnv emptyRdrEnv imp_gbl_envs
+           gbl_env     = imp_gbl_env `plusGlobalRdrEnv` local_gbl_env

 
 

-      returnRn (export_fn, Just (export_env, rn_env, explicit_names))
-    )                                                  `thenRn` \ (_, result) ->
-    returnRn result
+           all_avails :: ExportAvails
+           all_avails = foldr plusExportAvails local_mod_avails imp_avails_s
+       in
+       returnRn (gbl_env, all_avails)
+      )                                                        `thenRn` \ (gbl_env, all_avails) ->
+
+       -- 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 (junk_exp_fn, Nothing)
+      else
+ 
+       -- PROCESS EXPORT LISTS
+      exportsFromAvail this_mod exports all_avails gbl_env     `thenRn` \ exported_avails ->
+
+       -- DONE
+      returnRn (exported_avails, Just (all_avails, gbl_env))
+    )          `thenRn` \ (exported_avails, maybe_stuff) ->
+
+    case maybe_stuff of {
+       Nothing -> returnRn Nothing ;
+       Just (all_avails, gbl_env) ->
+
+
+       -- DEAL WITH FIXITIES
+   fixitiesFromLocalDecls gbl_env decls                `thenRn` \ local_fixity_env ->
+   getImportedFixities gbl_env                 `thenRn` \ imp_fixity_env ->
+   let
+       -- Export only those fixities that are for names that are
+       --      (a) defined in this module
+       --      (b) exported
+       exported_fixities :: [(Name,Fixity)]
+       exported_fixities = [(name,fixity) | FixitySig name fixity _ <- nameEnvElts local_fixity_env,
+                                            isLocallyDefined name
+                           ]
+
+       fixity_env = imp_fixity_env `plusNameEnv` local_fixity_env
+   in
+   traceRn (text "fixity env" <+> vcat (map ppr (nameEnvElts fixity_env)))     `thenRn_`
+
+       --- TIDY UP 
+   let
+       export_env            = ExportEnv exported_avails exported_fixities
+       rn_env                = RnEnv gbl_env fixity_env
+       (_, global_avail_env) = all_avails
+   in
+   returnRn (Just (export_env, rn_env, global_avail_env))
+   }

   where
     junk_exp_fn = error "RnNames:export_fn"
 
   where
     junk_exp_fn = error "RnNames:export_fn"
 

@@ -111,13 +171,12 @@ getGlobalNames m@(HsModule this_mod _ exports imports _ _ mod_loc)
 
                 | otherwise               = [ImportDecl pRELUDE 
                                                         False          {- Not qualified -}
 
                 | otherwise               = [ImportDecl pRELUDE 
                                                         False          {- Not qualified -}

-                                                        HiFile         {- Not source imported -}

                                                         Nothing        {- No "as" -}
                                                         Nothing        {- No import list -}
                                                         mod_loc]
     
     explicit_prelude_import
                                                         Nothing        {- No "as" -}
                                                         Nothing        {- No import list -}
                                                         mod_loc]
     
     explicit_prelude_import

-      = not (null [ () | (ImportDecl mod qual _ _ _ _) <- imports, mod == pRELUDE ])
+      = not (null [ () | (ImportDecl mod qual _ _ _) <- imports, mod == pRELUDE ])

 \end{code}
        
 \begin{code}
 \end{code}
        
 \begin{code}

@@ -127,81 +186,153 @@ checkEarlyExit mod
        -- Found errors already, so exit now
        returnRn True
     else
        -- Found errors already, so exit now
        returnRn True
     else

+

     traceRn (text "Considering whether compilation is required...")    `thenRn_`
     if not opt_SourceUnchanged then
        -- Source code changed and no errors yet... carry on 
        traceRn (nest 4 (text "source file changed or recompilation check turned off")) `thenRn_` 
        returnRn False
     else
     traceRn (text "Considering whether compilation is required...")    `thenRn_`
     if not opt_SourceUnchanged then
        -- Source code changed and no errors yet... carry on 
        traceRn (nest 4 (text "source file changed or recompilation check turned off")) `thenRn_` 
        returnRn False
     else

+

        -- Unchanged source, and no errors yet; see if usage info
        -- up to date, and exit if so
        -- Unchanged source, and no errors yet; see if usage info
        -- up to date, and exit if so

-       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
+    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}
        
 \end{code}
        

-

 \begin{code}
 importsFromImportDecl :: RdrNameImportDecl
 \begin{code}
 importsFromImportDecl :: RdrNameImportDecl

-                     -> RnMG (RnEnv, ExportAvails, [AvailInfo])
+                     -> RnMG (GlobalRdrEnv, 
+                              ExportAvails) 

 
 

-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) ->
+importsFromImportDecl (ImportDecl imp_mod qual_only as_mod import_spec iloc)
+  = pushSrcLocRn iloc $
+    getInterfaceExports imp_mod        `thenRn` \ (imp_mod, avails) ->
+
+    if null avails then
+       -- If there's an error in getInterfaceExports, (e.g. interface
+       -- file not found) we get lots of spurious errors from 'filterImports'
+       returnRn (emptyRdrEnv, mkEmptyExportAvails imp_mod)
+    else
+
+    filterImports imp_mod import_spec avails   `thenRn` \ (filtered_avails, hides, explicits) ->
+
+       -- We 'improve' the provenance by setting
+       --      (a) the import-reason field, so that the Name says how it came into scope
+       --              including whether it's explicitly imported
+       --      (b) the print-unqualified field
+       -- But don't fiddle with wired-in things or we get in a twist

     let
     let

-       filtered_avails' = map set_avail_prov filtered_avails
-       fixities'        = [ (occ,(fixity,provenance)) | (occ,fixity) <- fixities ]
+       improve_prov name = setNameImportReason name (UserImport imp_mod iloc (is_explicit name))
+       is_explicit name  = name `elemNameSet` explicits

     in
     in

-    qualifyImports mod 
-                  True                 -- Want qualified names
+    qualifyImports imp_mod 

                   (not qual_only)      -- Maybe want unqualified names
                   (not qual_only)      -- Maybe want unqualified names

-                  as_mod
-                  (ExportEnv filtered_avails' fixities')
-                  hides
-                                                       `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 | isWiredInName name = name
-                      | otherwise          = setNameProvenance name provenance
-    provenance = Imported mod loc as_source
+                  as_mod hides
+                  filtered_avails improve_prov         `thenRn` \ (rdr_name_env, mod_avails) ->
+
+    returnRn (rdr_name_env, mod_avails)

 \end{code}
 
 
 \begin{code}
 \end{code}
 
 
 \begin{code}

-importsFromLocalDecls rec_exp_fn (HsModule mod _ _ _ fix_decls decls _)
-  = foldlRn getLocalDeclBinders [] decls               `thenRn` \ avails ->
-    mapRn fixityFromFixDecl fix_decls                  `thenRn` \ fixities ->
+importsFromLocalDecls mod rec_exp_fn decls
+  = mapRn (getLocalDeclBinders newLocalName) decls     `thenRn` \ avails_s ->
+
+    let
+       avails = concat avails_s
+
+       all_names :: [Name]     -- All the defns; no dups eliminated
+       all_names = [name | avail <- avails, name <- availNames avail]
+
+       dups :: [[Name]]
+       dups = filter non_singleton (equivClassesByUniq getUnique all_names)
+            where
+               non_singleton (x1:x2:xs) = True
+               non_singleton other      = False
+    in
+       -- Check for duplicate definitions
+    mapRn (addErrRn . dupDeclErr) dups                         `thenRn_` 
+
+       -- Record that locally-defined things are available
+    mapRn (recordSlurp Nothing Compulsory) avails      `thenRn_`
+
+       -- Build the environment

     qualifyImports mod 
     qualifyImports mod 

-                  False        -- Don't want qualified names

                   True         -- Want unqualified names
                   True         -- Want unqualified names

-                  Nothing      -- No "as M" part
-                  (ExportEnv avails fixities)
+                  Nothing      -- no 'as M'

                   []           -- Hide nothing
                   []           -- Hide nothing

-                                                       `thenRn` \ (rn_env, mod_avails) ->
-    returnRn (rn_env, mod_avails, avails)
+                  avails
+                  (\n -> n)
+
+  where
+    newLocalName rdr_name loc = newLocallyDefinedGlobalName mod (rdrNameOcc rdr_name)
+                                                           rec_exp_fn loc
+
+getLocalDeclBinders :: (RdrName -> SrcLoc -> RnMG Name)        -- New-name function
+                   -> RdrNameHsDecl
+                   -> RnMG Avails
+getLocalDeclBinders new_name (ValD binds)
+  = mapRn do_one (bagToList (collectTopBinders binds))

   where
   where

-    newLocalName rdr_name loc
-      = newLocallyDefinedGlobalName mod (rdrNameOcc rdr_name) rec_exp_fn loc
-
-    getLocalDeclBinders avails (ValD binds)
-      = mapRn do_one (bagToList (collectTopBinders binds))     `thenRn` \ val_avails ->
-       returnRn (val_avails ++ avails)
-
-    getLocalDeclBinders avails decl
-      = getDeclBinders newLocalName decl       `thenRn` \ avail ->
-       case avail of
-          NotAvailable -> returnRn avails              -- Instance decls and suchlike
-          other        -> returnRn (avail : avails)
-
-    do_one (rdr_name, loc)
-      = newLocalName rdr_name loc      `thenRn` \ name ->
-        returnRn (Avail name)
+    do_one (rdr_name, loc) = new_name rdr_name loc     `thenRn` \ name ->
+                            returnRn (Avail name)
+
+    -- foreign declarations
+getLocalDeclBinders new_name (ForD (ForeignDecl nm kind _ dyn _ loc))
+  | binds_haskell_name kind dyn
+  = new_name nm loc                `thenRn` \ name ->
+    returnRn [Avail name]
+
+  | otherwise
+  = returnRn []
+
+getLocalDeclBinders new_name decl
+  = getDeclBinders new_name decl       `thenRn` \ maybe_avail ->
+    case maybe_avail of
+       Nothing    -> returnRn []               -- Instance decls and suchlike
+       Just avail -> returnRn [avail]
+
+binds_haskell_name (FoImport _) _   = True
+binds_haskell_name FoLabel      _   = True
+binds_haskell_name FoExport  ext_nm = isDynamic ext_nm
+
+fixitiesFromLocalDecls :: GlobalRdrEnv -> [RdrNameHsDecl] -> RnMG FixityEnv
+fixitiesFromLocalDecls gbl_env decls
+  = foldlRn getFixities emptyNameEnv decls
+  where
+    getFixities :: FixityEnv -> RdrNameHsDecl -> RnMG FixityEnv
+    getFixities acc (FixD fix)
+      = fix_decl acc fix
+
+    getFixities acc (TyClD (ClassDecl _ _ _ sigs _ _ _ _ _))
+      = foldlRn fix_decl acc [sig | FixSig sig <- sigs]
+               -- Get fixities from class decl sigs too
+
+    getFixities acc other_decl
+      = returnRn acc
+
+    fix_decl acc (FixitySig rdr_name fixity loc)
+       =       -- Check for fixity decl for something not declared
+         case lookupRdrEnv gbl_env rdr_name of {
+           Nothing | opt_WarnUnusedBinds 
+                   -> pushSrcLocRn loc (addWarnRn (unusedFixityDecl rdr_name fixity))  `thenRn_`
+                      returnRn acc 
+                   | otherwise -> returnRn acc ;
+       
+           Just (name:_) ->
+
+               -- Check for duplicate fixity decl
+         case lookupNameEnv acc name of {
+           Just (FixitySig _ _ loc') -> addErrRn (dupFixityDecl rdr_name loc loc')     `thenRn_`
+                                        returnRn acc ;
+
+
+           Nothing -> returnRn (addToNameEnv acc name (FixitySig name fixity loc))
+         }}

 \end{code}
 
 %************************************************************************
 \end{code}
 
 %************************************************************************

@@ -214,48 +345,76 @@ importsFromLocalDecls rec_exp_fn (HsModule mod _ _ _ fix_decls decls _)
 available, and filters it through the import spec (if any).
 
 \begin{code}
 available, and filters it through the import spec (if any).
 
 \begin{code}

-filterImports :: Module
-             -> Maybe (Bool, [RdrNameIE])              -- Import spec; True => hidin
-             -> [AvailInfo]                            -- What's available
-             -> RnMG ([AvailInfo],                     -- What's actually imported
-                      [AvailInfo],                     -- What's to be hidden (the unqualified version, that is)
-                      [AvailInfo])                     -- What was imported explicitly
+filterImports :: Module                                -- The module being imported
+             -> Maybe (Bool, [RdrNameIE])      -- Import spec; True => hiding
+             -> [AvailInfo]                    -- What's available
+             -> RnMG ([AvailInfo],             -- What's actually imported
+                      [AvailInfo],             -- What's to be hidden (the unqualified version, that is)
+                      NameSet)                 -- What was imported explicitly

 
        -- Complains if import spec mentions things that the module doesn't export
 
        -- Complains if import spec mentions things that the module doesn't export

-
+        -- Warns/informs if import spec contains duplicates.

 filterImports mod Nothing imports
 filterImports mod Nothing imports

-  = returnRn (imports, [], [])
+  = returnRn (imports, [], emptyNameSet)

 
 filterImports mod (Just (want_hiding, import_items)) avails
 
 filterImports mod (Just (want_hiding, import_items)) avails

-  = mapRn check_item import_items              `thenRn` \ item_avails ->
+  = mapMaybeRn check_item import_items         `thenRn` \ avails_w_explicits ->
+    let
+       (item_avails, explicits_s) = unzip avails_w_explicits
+       explicits                  = foldl addListToNameSet emptyNameSet explicits_s
+    in

     if want_hiding 
     then       
     if want_hiding 
     then       

-       returnRn (avails, item_avails, [])      -- All imported; item_avails to be hidden
+       -- All imported; item_avails to be hidden
+       returnRn (avails, item_avails, emptyNameSet)

     else
     else

-       returnRn (item_avails, [], item_avails) -- Just item_avails imported; nothing to be hidden
-
+       -- Just item_avails imported; nothing to be hidden
+       returnRn (item_avails, [], explicits)

   where
     import_fm :: FiniteMap OccName AvailInfo
     import_fm = listToFM [ (nameOccName name, avail) 
                         | avail <- avails,
   where
     import_fm :: FiniteMap OccName AvailInfo
     import_fm = listToFM [ (nameOccName name, avail) 
                         | avail <- avails,

-                          name  <- availEntityNames avail]
+                          name  <- availNames avail]
+       -- Even though availNames returns data constructors too,
+       -- they won't make any difference because naked entities like T
+       -- in an import list map to TcOccs, not VarOccs.

 
     check_item item@(IEModuleContents _)
       = addErrRn (badImportItemErr mod item)   `thenRn_`
 
     check_item item@(IEModuleContents _)
       = addErrRn (badImportItemErr mod item)   `thenRn_`

-       returnRn NotAvailable
+       returnRn Nothing

 
     check_item item
       | not (maybeToBool maybe_in_import_avails) ||
 
     check_item item
       | not (maybeToBool maybe_in_import_avails) ||

-       (case filtered_avail of { NotAvailable -> True; other -> False })
+       not (maybeToBool maybe_filtered_avail)

       = addErrRn (badImportItemErr mod item)   `thenRn_`
       = addErrRn (badImportItemErr mod item)   `thenRn_`

-       returnRn NotAvailable
+       returnRn Nothing

 
 

-      | otherwise   = returnRn filtered_avail
+      | dodgy_import = addWarnRn (dodgyImportWarn mod item)    `thenRn_`
+                      returnRn (Just (filtered_avail, explicits))
+
+      | otherwise    = returnRn (Just (filtered_avail, explicits))

                
       where
                
       where

-       maybe_in_import_avails = lookupFM import_fm (ieOcc item)
+       wanted_occ             = rdrNameOcc (ieName item)
+       maybe_in_import_avails = lookupFM import_fm wanted_occ
+

        Just avail             = maybe_in_import_avails
        Just avail             = maybe_in_import_avails

-       filtered_avail         = filterAvail item avail
+       maybe_filtered_avail   = filterAvail item avail
+       Just filtered_avail    = maybe_filtered_avail
+       explicits              | dot_dot   = [availName filtered_avail]
+                              | otherwise = availNames filtered_avail
+
+       dot_dot = case item of 
+                   IEThingAll _    -> True
+                   other           -> False
+
+       dodgy_import = case (item, avail) of
+                         (IEThingAll _, AvailTC _ [n]) -> True
+                               -- This occurs when you import T(..), but
+                               -- only export T abstractly.  The single [n]
+                               -- in the AvailTC is the type or class itself
+                                       
+                         other -> False

 \end{code}
 
 
 \end{code}
 
 

@@ -272,81 +431,56 @@ right qualified names.  It also turns the @Names@ in the @ExportEnv@ into
 fully fledged @Names@.
 
 \begin{code}
 fully fledged @Names@.
 
 \begin{code}

-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, ExportAvails)
-
-qualifyImports this_mod qual_imp unqual_imp as_mod (ExportEnv avails fixities) hides
+qualifyImports :: Module               -- Imported module
+              -> Bool                  -- True <=> want unqualified import
+              -> Maybe Module          -- Optional "as M" part 
+              -> [AvailInfo]           -- What's to be hidden
+              -> Avails                -- Whats imported and how
+              -> (Name -> Name)        -- Improves the provenance on imported things
+              -> RnMG (GlobalRdrEnv, ExportAvails)
+       -- NB: the Names in ExportAvails don't have the improve-provenance
+       --     function applied to them
+       -- We could fix that, but I don't think it matters
+
+qualifyImports this_mod unqual_imp as_mod hides
+              avails improve_prov

   = 
   = 

-       -- 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 ->
+       -- Make the name environment.  We're talking about a 
+       -- single module here, so there must be no name clashes.
+       -- In practice there only ever will be if it's the module
+       -- being compiled.

     let
     let

+       -- Add the things that are available
+       name_env1 = foldl add_avail emptyRdrEnv avails
+

        -- Delete things that are hidden
        name_env2 = foldl del_avail name_env1 hides
 
        -- Delete things that are hidden
        name_env2 = foldl del_avail name_env1 hides
 

-       -- Create the fixity env
-       fixity_env = foldl (add_fixity name_env2) emptyFixityEnv fixities
-

        -- Create the export-availability info
        -- Create the export-availability info

-       export_avails = mkExportAvails unqual_imp qual_mod avails
+       export_avails = mkExportAvails qual_mod unqual_imp name_env2 avails

     in
     in

-    returnRn (RnEnv name_env2 fixity_env, export_avails)
+    returnRn (name_env2, export_avails)
+

   where
     qual_mod = case as_mod of
                  Nothing           -> this_mod
                  Just another_name -> another_name
 
   where
     qual_mod = case as_mod of
                  Nothing           -> this_mod
                  Just another_name -> another_name
 

-    add_avail env avail = foldlRn add_name env (availNames avail)
-    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
-                         occ  = nameOccName name
+    add_avail :: GlobalRdrEnv -> AvailInfo -> GlobalRdrEnv
+    add_avail env avail = foldl add_name env (availNames avail)

 
 

-    del_avail env avail = foldl delOneFromNameEnv env rdr_names
-                       where
-                         rdr_names = map (Unqual . nameOccName) (availNames avail)
-                       
-    add_fixity name_env fix_env (occ_name, (fixity, provenance))
-       = add qual $ add unqual $ fix_env
-       where
-         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)
-                              | otherwise
-                              = fix_env
-
-err_hif = error "qualifyImports: hif"  -- Not needed in key to mapping
-\end{code}
+    add_name env name
+       | unqual_imp = env2
+       | otherwise  = env1
+       where
+         env1 = addOneToGlobalRdrEnv env  (mkRdrQual qual_mod occ) better_name
+         env2 = addOneToGlobalRdrEnv env1 (mkRdrUnqual occ)        better_name
+         occ         = nameOccName name
+         better_name = improve_prov name

 
 

-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]
-\end{code}
-
-%************************************************************************
-%*                                                                     *
-\subsection{Local declarations}
-%*                                                                     *
-%************************************************************************
-
-
-\begin{code}
-fixityFromFixDecl :: RdrNameFixityDecl -> RnMG (OccName, (Fixity, Provenance))
-
-fixityFromFixDecl (FixityDecl rdr_name fixity loc)
-  = returnRn (rdrNameOcc rdr_name, (fixity, LocalDef (panic "export-flag") loc))
+    del_avail env avail = foldl delOneFromGlobalRdrEnv env rdr_names
+                       where
+                         rdr_names = map (mkRdrUnqual . nameOccName) (availNames avail)

 \end{code}
 
 
 \end{code}
 
 

@@ -356,35 +490,6 @@ fixityFromFixDecl (FixityDecl rdr_name fixity loc)
 %*                                                                     *
 %************************************************************************
 
 %*                                                                     *
 %************************************************************************
 

-The @AvailEnv@ type is just used internally in @exportsFromAvail@.
-When exporting we need to combine the availabilities for a particular
-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)
-       -- 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)
-
-plusAvailEnv a1 a2
-  = mapRn (addErrRn.availClashErr) (conflictsFM bad_avail a1 a2)       `thenRn_`
-    returnRn (plusFM_C plus_avail a1 a2)
-
-listToAvailEnv :: RdrNameIE -> [AvailInfo] -> RnM s d AvailEnv
-listToAvailEnv ie items
-  = foldlRn plusAvailEnv emptyAvailEnv (map (unitAvailEnv ie) 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)
-\end{code}
-

 Processing the export list.
 
 You might think that we should record things that appear in the export list as
 Processing the export list.
 
 You might think that we should record things that appear in the export list as

@@ -395,112 +500,120 @@ compiling PrelBase, because it re-exports GHC, which includes takeMVar#, whose t
 includes ConcBase.StateAndSynchVar#, and so on...
 
 \begin{code}
 includes ConcBase.StateAndSynchVar#, and so on...
 
 \begin{code}

+type ExportAccum       -- The type of the accumulating parameter of
+                       -- the main worker function in exportsFromAvail
+     = ([Module],              -- 'module M's seen so far
+       ExportOccMap,           -- Tracks exported occurrence names
+       NameEnv AvailInfo)      -- The accumulated exported stuff, kept in an env
+                               --   so we can common-up related AvailInfos
+
+type ExportOccMap = FiniteMap OccName (Name, RdrNameIE)
+       -- Tracks what a particular exported OccName
+       --   in an export list refers to, and which item
+       --   it came from.  It's illegal to export two distinct things
+       --   that have the same occurrence name
+
+

 exportsFromAvail :: Module
                 -> Maybe [RdrNameIE]   -- Export spec
                 -> ExportAvails
 exportsFromAvail :: Module
                 -> Maybe [RdrNameIE]   -- Export spec
                 -> ExportAvails

-                -> RnEnv
-                -> RnMG (Name -> ExportFlag, ExportEnv)
+                -> GlobalRdrEnv 
+                -> RnMG Avails

        -- Complains if two distinct exports have same OccName
        -- Complains if two distinct exports have same OccName

+        -- Warns about identical exports.

        -- Complains about exports items not in scope
        -- Complains about exports items not in scope

-exportsFromAvail this_mod Nothing export_avails rn_env
-  = exportsFromAvail this_mod (Just [IEModuleContents this_mod]) export_avails rn_env
+exportsFromAvail this_mod Nothing export_avails global_name_env
+  = exportsFromAvail this_mod (Just [IEModuleContents this_mod]) 
+                    export_avails global_name_env

 
 exportsFromAvail this_mod (Just export_items) 
                 (mod_avail_env, entity_avail_env)
 
 exportsFromAvail this_mod (Just export_items) 
                 (mod_avail_env, entity_avail_env)

-                (RnEnv name_env fixity_env)
-  = mapRn exports_from_item export_items               `thenRn` \ avail_envs ->
-    foldlRn plusAvailEnv emptyAvailEnv avail_envs      `thenRn` \ export_avail_env -> 
+                global_name_env
+  = foldlRn exports_from_item
+           ([], emptyFM, emptyNameEnv) export_items    `thenRn` \ (_, _, export_avail_map) ->

     let
     let

-       export_avails   = map snd (eltsFM export_avail_env)
-       export_fixities = mk_exported_fixities (availsToNameSet export_avails)
-       export_fn       = mk_export_fn export_avails
+       export_avails :: [AvailInfo]
+       export_avails   = nameEnvElts export_avail_map

     in
     in

-    returnRn (export_fn, ExportEnv export_avails export_fixities)
+    returnRn export_avails

 
   where
 
   where

-    exports_from_item :: RdrNameIE -> RnMG AvailEnv
-    exports_from_item ie@(IEModuleContents mod)
-       = case lookupFM mod_avail_env mod of
-               Nothing     -> failWithRn emptyAvailEnv (modExportErr mod)
-               Just avails -> listToAvailEnv ie avails
+    exports_from_item :: ExportAccum -> RdrNameIE -> RnMG ExportAccum

 
 

-    exports_from_item ie
+    exports_from_item acc@(mods, occs, avails) ie@(IEModuleContents mod)
+       | mod `elem` mods       -- Duplicate export of M
+       = warnCheckRn opt_WarnDuplicateExports
+                     (dupModuleExport mod)     `thenRn_`
+         returnRn acc
+
+       | otherwise
+       = case lookupFM mod_avail_env mod of
+               Nothing         -> failWithRn acc (modExportErr mod)
+               Just mod_avails -> foldlRn (check_occs ie) occs mod_avails      `thenRn` \ occs' ->
+                                  let
+                                       avails' = foldl add_avail avails mod_avails
+                                  in
+                                  returnRn (mod:mods, occs', avails')
+
+    exports_from_item acc@(mods, occs, avails) ie

        | not (maybeToBool maybe_in_scope) 
        | not (maybeToBool maybe_in_scope) 

-       = failWithRn emptyAvailEnv (unknownNameErr (ieName ie))
+       = failWithRn acc (unknownNameErr (ieName ie))
+
+       | not (null dup_names)
+       = addNameClashErrRn rdr_name (name:dup_names)   `thenRn_`
+         returnRn acc

 
 #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)
 
 #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 acc

 #endif
 
        | not enough_avail
 #endif
 
        | not enough_avail

-       = failWithRn emptyAvailEnv (exportItemErr ie export_avail)
+       = failWithRn acc (exportItemErr ie)
+
+       | otherwise     -- Phew!  It's OK!  Now to check the occurrence stuff!
+       = check_occs ie occs export_avail       `thenRn` \ occs' ->
+         returnRn (mods, occs', add_avail avails export_avail)

 
 

-       | otherwise     -- Phew!  It's OK!
-       = returnRn (unitAvailEnv ie export_avail)

        where
        where

-          maybe_in_scope  = lookupNameEnv 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 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
-      =  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 -> 
-
-               -- Step 2: check whether the fixity thing is exported
-        if not (fixity_name `elemNameSet` exports) then
-               do_nothing
-        else
+         rdr_name        = ieName ie
+          maybe_in_scope  = lookupFM global_name_env rdr_name
+         Just (name:dup_names) = maybe_in_scope
+         maybe_avail        = lookupUFM entity_avail_env name
+         Just avail         = maybe_avail
+         maybe_export_avail = filterAvail ie avail
+         enough_avail       = maybeToBool maybe_export_avail
+         Just export_avail  = maybe_export_avail
+
+add_avail avails avail = addToNameEnv_C plusAvail avails (availName avail) avail
+
+check_occs :: RdrNameIE -> ExportOccMap -> AvailInfo -> RnMG ExportOccMap
+check_occs ie occs avail 
+  = foldlRn check occs (availNames avail)
+  where
+    check occs name
+      = case lookupFM occs name_occ of
+         Nothing           -> returnRn (addToFM occs name_occ (name, ie))
+         Just (name', ie') 
+           | name == name' ->  -- Duplicate export
+                               warnCheckRn opt_WarnDuplicateExports
+                                           (dupExportWarn name_occ ie ie')     `thenRn_`
+                               returnRn occs
+
+           | otherwise     ->  -- Same occ name but different names: an error
+                               failWithRn occs (exportClashErr name_occ ie ie')
+      where
+       name_occ = nameOccName name

        
        

-               -- Step 3: check whether we already have a fixity for the
-               -- Name's OccName in the fix_env we are building up.  This can easily
-               -- happen.  the original fixity_env might contain bindings for
-               --      M.a and N.a, if a was imported via M and N.
-               -- If this does happen, we expect the fixity to be the same either way.
-       let
-           occ_name = rdrNameOcc rdr_name
-       in
-       case lookupFM fix_env occ_name of {
-         Just (fixity1, prov1) ->      -- 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)
-       }}
-
-mk_export_fn :: [AvailInfo] -> (Name -> ExportFlag)
-mk_export_fn avails
+mk_export_fn :: NameSet -> (Name -> ExportFlag)
+mk_export_fn exported_names

   = \name -> if name `elemNameSet` exported_names
             then Exported
             else NotExported
   = \name -> if name `elemNameSet` exported_names
             then Exported
             else NotExported

-  where
-    exported_names :: NameSet
-    exported_names = availsToNameSet avails
-\end{code}                               
-
+\end{code}

 
 %************************************************************************
 %*                                                                     *
 
 %************************************************************************
 %*                                                                     *

@@ -509,22 +622,51 @@ mk_export_fn avails
 %************************************************************************
 
 \begin{code}
 %************************************************************************
 
 \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]
+dodgyImportWarn mod (IEThingAll tc)
+  = sep [ptext SLIT("Module") <+> quotes (pprModule mod) <+> ptext SLIT("exports") <+> quotes (ppr tc), 
+        ptext SLIT("with no constructors/class operations;"),
+        ptext SLIT("yet it is imported with a (..)")]

 
 

-exportItemErr export_item NotAvailable sty
-  = sep [ ptext SLIT("Export item not in scope:"), ppr sty export_item ]
+modExportErr mod
+  = hsep [ ptext SLIT("Unknown module in export list: module"), quotes (pprModule mod)]

 
 

-exportItemErr export_item avail sty
-  = 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]])
+exportItemErr export_item
+  = sep [ ptext SLIT("Bad export item"), quotes (ppr export_item)]

 
 

-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]
-\end{code}
+exportClashErr occ_name ie1 ie2
+  = 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)]
+
+dupDeclErr (n:ns)
+  = vcat [ptext SLIT("Multiple declarations of") <+> quotes (ppr n),
+         nest 4 (vcat (map pp sorted_ns))]
+  where
+    sorted_ns = sortLt occ'ed_before (n:ns)
+
+    occ'ed_before a b = LT == compare (getSrcLoc a) (getSrcLoc b)

 
 

+    pp n      = pprProvenance (getNameProvenance n)
+
+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 mod
+  = hsep [ptext SLIT("Duplicate"),
+         quotes (ptext SLIT("Module") <+> pprModule mod), 
+          ptext SLIT("in export list")]
+
+unusedFixityDecl rdr_name fixity
+  = hsep [ptext SLIT("Unused fixity declaration for"), quotes (ppr rdr_name)]
+
+dupFixityDecl rdr_name loc1 loc2
+  = vcat [ptext SLIT("Multiple fixity declarations for") <+> quotes (ppr rdr_name),
+         ptext SLIT("at ") <+> ppr loc1,
+         ptext SLIT("and") <+> ppr loc2]
+
+\end{code}