ghc/compiler/rename/RnNames.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   3 %
   4 \section[RnNames]{Extracting imported and top-level names in scope}
   5
   6 \begin{code}
   7 module RnNames (
   8         getGlobalNames
   9     ) where
  10
  11 #include "HsVersions.h"
  12
  13 import CmdLineOpts    ( opt_NoImplicitPrelude, opt_WarnDuplicateExports,
  14                         opt_SourceUnchanged, opt_WarnUnusedBinds
  15                       )
  16
  17 import HsSyn    ( HsModule(..), HsDecl(..), TyClDecl(..),
  18                   IE(..), ieName,
  19                   ForeignDecl(..), ForKind(..), isDynamic,
  20                   FixitySig(..), Sig(..), ImportDecl(..),
  21                   collectTopBinders
  22                 )
  23 import RdrHsSyn ( RdrNameIE, RdrNameImportDecl,
  24                   RdrNameHsModule, RdrNameHsDecl
  25                 )
  26 import RnIfaces ( getInterfaceExports, getDeclBinders, getDeclSysBinders,
  27                   recordSlurp, checkUpToDate
  28                 )
  29 import RnEnv
  30 import RnMonad
  31
  32 import FiniteMap
  33 import PrelMods
  34 import PrelInfo ( main_RDR )
  35 import UniqFM   ( lookupUFM )
  36 import Bag      ( bagToList )
  37 import Maybes   ( maybeToBool )
  38 import Module   ( ModuleName, mkThisModule, pprModuleName, WhereFrom(..) )
  39 import NameSet
  40 import Name     ( Name, ExportFlag(..), ImportReason(..), Provenance(..),
  41                   isLocallyDefined, setNameProvenance,
  42                   nameOccName, getSrcLoc, pprProvenance, getNameProvenance
  43                 )
  44 import RdrName  ( RdrName, rdrNameOcc, mkRdrQual, mkRdrUnqual, isQual )
  45 import SrcLoc   ( SrcLoc )
  46 import NameSet  ( elemNameSet, emptyNameSet )
  47 import Outputable
  48 import Unique   ( getUnique )
  49 import Util     ( removeDups, equivClassesByUniq, sortLt )
  50 import List     ( partition )
  51 \end{code}
  52
  53
  54
  55 %************************************************************************
  56 %*                                                                      *
  57 \subsection{Get global names}
  58 %*                                                                      *
  59 %************************************************************************
  60
  61 \begin{code}
  62 getGlobalNames :: RdrNameHsModule
  63                -> RnMG (Maybe (ExportEnv,
  64                                GlobalRdrEnv,
  65                                FixityEnv,               -- Fixities for local decls only
  66                                NameEnv AvailInfo        -- Maps a name to its parent AvailInfo
  67                                                         -- Just for in-scope things only
  68                                ))
  69                         -- Nothing => no need to recompile
  70
  71 getGlobalNames (HsModule this_mod _ exports imports decls mod_loc)
  72   =     -- These two fix-loops are to get the right
  73         -- provenance information into a Name
  74     fixRn (\ ~(rec_gbl_env, rec_exported_avails, _) ->
  75
  76         let
  77            rec_unqual_fn :: Name -> Bool        -- Is this chap in scope unqualified?
  78            rec_unqual_fn = unQualInScope rec_gbl_env
  79
  80            rec_exp_fn :: Name -> ExportFlag
  81            rec_exp_fn = mk_export_fn (availsToNameSet rec_exported_avails)
  82         in
  83         setModuleRn this_mod                    $
  84
  85                 -- PROCESS LOCAL DECLS
  86                 -- Do these *first* so that the correct provenance gets
  87                 -- into the global name cache.
  88         importsFromLocalDecls this_mod rec_exp_fn decls `thenRn` \ (local_gbl_env, local_mod_avails) ->
  89
  90                 -- PROCESS IMPORT DECLS
  91                 -- Do the non {- SOURCE -} ones first, so that we get a helpful
  92                 -- warning for {- SOURCE -} ones that are unnecessary
  93         let
  94           (source, ordinary) = partition is_source_import all_imports
  95           is_source_import (ImportDecl _ ImportByUserSource _ _ _ _) = True
  96           is_source_import other                                     = False
  97         in
  98         mapAndUnzipRn (importsFromImportDecl rec_unqual_fn) ordinary    `thenRn` \ (imp_gbl_envs1, imp_avails_s1) ->
  99         mapAndUnzipRn (importsFromImportDecl rec_unqual_fn) source      `thenRn` \ (imp_gbl_envs2, imp_avails_s2) ->
 100
 101                 -- COMBINE RESULTS
 102                 -- We put the local env second, so that a local provenance
 103                 -- "wins", even if a module imports itself.
 104         let
 105             gbl_env :: GlobalRdrEnv
 106             imp_gbl_env = foldr plusGlobalRdrEnv emptyRdrEnv (imp_gbl_envs2 ++ imp_gbl_envs1)
 107             gbl_env     = imp_gbl_env `plusGlobalRdrEnv` local_gbl_env
 108
 109             all_avails :: ExportAvails
 110             all_avails = foldr plusExportAvails local_mod_avails (imp_avails_s2 ++ imp_avails_s1)
 111         in
 112
 113         -- TRY FOR EARLY EXIT
 114         -- We can't go for an early exit before this because we have to check
 115         -- for name clashes.  Consider:
 116         --
 117         --      module A where          module B where
 118         --         import B                h = True
 119         --         f = h
 120         --
 121         -- Suppose I've compiled everything up, and then I add a
 122         -- new definition to module B, that defines "f".
 123         --
 124         -- Then I must detect the name clash in A before going for an early
 125         -- exit.  The early-exit code checks what's actually needed from B
 126         -- to compile A, and of course that doesn't include B.f.  That's
 127         -- why we wait till after the plusEnv stuff to do the early-exit.
 128       checkEarlyExit this_mod                   `thenRn` \ up_to_date ->
 129       if up_to_date then
 130         returnRn (gbl_env, junk_exp_fn, Nothing)
 131       else
 132
 133         -- RECORD BETTER PROVENANCES IN THE CACHE
 134         -- The names in the envirnoment have better provenances (e.g. imported on line x)
 135         -- than the names in the name cache.  We update the latter now, so that we
 136         -- we start renaming declarations we'll get the good names
 137         -- The isQual is because the qualified name is always in scope
 138       updateProvenances (concat [names | (rdr_name, names) <- rdrEnvToList imp_gbl_env,
 139                                           isQual rdr_name])     `thenRn_`
 140
 141         -- PROCESS EXPORT LISTS
 142       exportsFromAvail this_mod exports all_avails gbl_env      `thenRn` \ exported_avails ->
 143
 144         -- DONE
 145       returnRn (gbl_env, exported_avails, Just all_avails)
 146     )           `thenRn` \ (gbl_env, exported_avails, maybe_stuff) ->
 147
 148     case maybe_stuff of {
 149         Nothing -> returnRn Nothing ;
 150         Just all_avails ->
 151
 152    traceRn (text "updateProv" <+> fsep (map ppr (rdrEnvElts gbl_env)))  `thenRn_`
 153
 154         -- DEAL WITH FIXITIES
 155    fixitiesFromLocalDecls gbl_env decls         `thenRn` \ local_fixity_env ->
 156    let
 157         -- Export only those fixities that are for names that are
 158         --      (a) defined in this module
 159         --      (b) exported
 160         exported_fixities :: [(Name,Fixity)]
 161         exported_fixities = [(name,fixity) | FixitySig name fixity _ <- nameEnvElts local_fixity_env,
 162                                              isLocallyDefined name
 163                             ]
 164    in
 165    traceRn (text "fixity env" <+> vcat (map ppr (nameEnvElts local_fixity_env)))        `thenRn_`
 166
 167         --- TIDY UP
 168    let
 169         export_env            = ExportEnv exported_avails exported_fixities
 170         (_, global_avail_env) = all_avails
 171    in
 172    returnRn (Just (export_env, gbl_env, local_fixity_env, global_avail_env))
 173    }
 174   where
 175     junk_exp_fn = error "RnNames:export_fn"
 176
 177     all_imports = prel_imports ++ imports
 178
 179         -- NB: opt_NoImplicitPrelude is slightly different to import Prelude ();
 180         -- because the former doesn't even look at Prelude.hi for instance declarations,
 181         -- whereas the latter does.
 182     prel_imports | this_mod == pRELUDE_Name ||
 183                    explicit_prelude_import ||
 184                    opt_NoImplicitPrelude
 185                  = []
 186
 187                  | otherwise               = [ImportDecl pRELUDE_Name
 188                                                          ImportByUser
 189                                                          False          {- Not qualified -}
 190                                                          Nothing        {- No "as" -}
 191                                                          Nothing        {- No import list -}
 192                                                          mod_loc]
 193
 194     explicit_prelude_import
 195       = not (null [ () | (ImportDecl mod _ _ _ _ _) <- imports, mod == pRELUDE_Name ])
 196 \end{code}
 197
 198 \begin{code}
 199 checkEarlyExit mod
 200   = checkErrsRn                         `thenRn` \ no_errs_so_far ->
 201     if not no_errs_so_far then
 202         -- Found errors already, so exit now
 203         returnRn True
 204     else
 205
 206     traceRn (text "Considering whether compilation is required...")     `thenRn_`
 207     if not opt_SourceUnchanged then
 208         -- Source code changed and no errors yet... carry on
 209         traceRn (nest 4 (text "source file changed or recompilation check turned off")) `thenRn_`
 210         returnRn False
 211     else
 212
 213         -- Unchanged source, and no errors yet; see if usage info
 214         -- up to date, and exit if so
 215     checkUpToDate mod                                           `thenRn` \ up_to_date ->
 216     putDocRn (text "Compilation" <+>
 217               text (if up_to_date then "IS NOT" else "IS") <+>
 218               text "required")                                  `thenRn_`
 219     returnRn up_to_date
 220 \end{code}
 221
 222 \begin{code}
 223 importsFromImportDecl :: (Name -> Bool)         -- OK to omit qualifier
 224                       -> RdrNameImportDecl
 225                       -> RnMG (GlobalRdrEnv,
 226                                ExportAvails)
 227
 228 importsFromImportDecl is_unqual (ImportDecl imp_mod_name from qual_only as_mod import_spec iloc)
 229   = pushSrcLocRn iloc $
 230     getInterfaceExports imp_mod_name from       `thenRn` \ (imp_mod, avails) ->
 231
 232     if null avails then
 233         -- If there's an error in getInterfaceExports, (e.g. interface
 234         -- file not found) we get lots of spurious errors from 'filterImports'
 235         returnRn (emptyRdrEnv, mkEmptyExportAvails imp_mod_name)
 236     else
 237
 238     filterImports imp_mod_name import_spec avails       `thenRn` \ (filtered_avails, hides, explicits) ->
 239
 240         -- We 'improve' the provenance by setting
 241         --      (a) the import-reason field, so that the Name says how it came into scope
 242         --              including whether it's explicitly imported
 243         --      (b) the print-unqualified field
 244         -- But don't fiddle with wired-in things or we get in a twist
 245     let
 246         improve_prov name = setNameProvenance name (NonLocalDef (UserImport imp_mod iloc (is_explicit name))
 247                                                                 (is_unqual name))
 248         is_explicit name  = name `elemNameSet` explicits
 249     in
 250     qualifyImports imp_mod_name
 251                    (not qual_only)      -- Maybe want unqualified names
 252                    as_mod hides
 253                    filtered_avails improve_prov         `thenRn` \ (rdr_name_env, mod_avails) ->
 254
 255     returnRn (rdr_name_env, mod_avails)
 256 \end{code}
 257
 258
 259 \begin{code}
 260 importsFromLocalDecls mod_name rec_exp_fn decls
 261   = mapRn (getLocalDeclBinders newLocalName) decls      `thenRn` \ avails_s ->
 262
 263     let
 264         avails = concat avails_s
 265
 266         all_names :: [Name]     -- All the defns; no dups eliminated
 267         all_names = [name | avail <- avails, name <- availNames avail]
 268
 269         dups :: [[Name]]
 270         dups = filter non_singleton (equivClassesByUniq getUnique all_names)
 271              where
 272                 non_singleton (x1:x2:xs) = True
 273                 non_singleton other      = False
 274     in
 275         -- Check for duplicate definitions
 276     mapRn_ (addErrRn . dupDeclErr) dups         `thenRn_`
 277
 278         -- Record that locally-defined things are available
 279     mapRn_ (recordSlurp Nothing) avails         `thenRn_`
 280
 281         -- Build the environment
 282     qualifyImports mod_name
 283                    True         -- Want unqualified names
 284                    Nothing      -- no 'as M'
 285                    []           -- Hide nothing
 286                    avails
 287                    (\n -> n)
 288
 289   where
 290     newLocalName rdr_name loc = newLocalTopBinder mod (rdrNameOcc rdr_name)
 291                                                   rec_exp_fn loc
 292     mod = mkThisModule mod_name
 293
 294 getLocalDeclBinders :: (RdrName -> SrcLoc -> RnMG Name) -- New-name function
 295                     -> RdrNameHsDecl
 296                     -> RnMG Avails
 297 getLocalDeclBinders new_name (ValD binds)
 298   = mapRn do_one (bagToList (collectTopBinders binds))
 299   where
 300     do_one (rdr_name, loc) = new_name rdr_name loc      `thenRn` \ name ->
 301                              returnRn (Avail name)
 302
 303     -- foreign declarations
 304 getLocalDeclBinders new_name (ForD (ForeignDecl nm kind _ dyn _ loc))
 305   | binds_haskell_name kind dyn
 306   = new_name nm loc                 `thenRn` \ name ->
 307     returnRn [Avail name]
 308
 309   | otherwise
 310   = returnRn []
 311
 312 getLocalDeclBinders new_name decl
 313   = getDeclBinders new_name decl        `thenRn` \ maybe_avail ->
 314     case maybe_avail of
 315         Nothing    -> returnRn []               -- Instance decls and suchlike
 316         Just avail -> getDeclSysBinders new_sys_name decl               `thenRn_`
 317                       returnRn [avail]
 318   where
 319         -- The getDeclSysBinders is just to get the names of superclass selectors
 320         -- etc, into the cache
 321     new_sys_name rdr_name loc = newImplicitBinder (rdrNameOcc rdr_name) loc
 322
 323 binds_haskell_name (FoImport _) _   = True
 324 binds_haskell_name FoLabel      _   = True
 325 binds_haskell_name FoExport  ext_nm = isDynamic ext_nm
 326
 327 fixitiesFromLocalDecls :: GlobalRdrEnv -> [RdrNameHsDecl] -> RnMG FixityEnv
 328 fixitiesFromLocalDecls gbl_env decls
 329   = foldlRn getFixities emptyNameEnv decls
 330   where
 331     getFixities :: FixityEnv -> RdrNameHsDecl -> RnMG FixityEnv
 332     getFixities acc (FixD fix)
 333       = fix_decl acc fix
 334
 335     getFixities acc (TyClD (ClassDecl _ _ _ sigs _ _ _ _ _ _))
 336       = foldlRn fix_decl acc [sig | FixSig sig <- sigs]
 337                 -- Get fixities from class decl sigs too.
 338     getFixities acc other_decl
 339       = returnRn acc
 340
 341     fix_decl acc sig@(FixitySig rdr_name fixity loc)
 342         =       -- Check for fixity decl for something not declared
 343           case lookupRdrEnv gbl_env rdr_name of {
 344             Nothing | opt_WarnUnusedBinds
 345                     -> pushSrcLocRn loc (addWarnRn (unusedFixityDecl rdr_name fixity))  `thenRn_`
 346                        returnRn acc
 347                     | otherwise -> returnRn acc ;
 348
 349             Just (name:_) ->
 350
 351                 -- Check for duplicate fixity decl
 352           case lookupNameEnv acc name of {
 353             Just (FixitySig _ _ loc') -> addErrRn (dupFixityDecl rdr_name loc loc')     `thenRn_`
 354                                          returnRn acc ;
 355
 356             Nothing -> returnRn (addToNameEnv acc name (FixitySig name fixity loc))
 357           }}
 358 \end{code}
 359
 360 %************************************************************************
 361 %*                                                                      *
 362 \subsection{Filtering imports}
 363 %*                                                                      *
 364 %************************************************************************
 365
 366 @filterImports@ takes the @ExportEnv@ telling what the imported module makes
 367 available, and filters it through the import spec (if any).
 368
 369 \begin{code}
 370 filterImports :: ModuleName                     -- The module being imported
 371               -> Maybe (Bool, [RdrNameIE])      -- Import spec; True => hiding
 372               -> [AvailInfo]                    -- What's available
 373               -> RnMG ([AvailInfo],             -- What's actually imported
 374                        [AvailInfo],             -- What's to be hidden (the unqualified version, that is)
 375                        NameSet)                 -- What was imported explicitly
 376
 377         -- Complains if import spec mentions things that the module doesn't export
 378         -- Warns/informs if import spec contains duplicates.
 379 filterImports mod Nothing imports
 380   = returnRn (imports, [], emptyNameSet)
 381
 382 filterImports mod (Just (want_hiding, import_items)) avails
 383   = mapMaybeRn check_item import_items          `thenRn` \ avails_w_explicits ->
 384     let
 385         (item_avails, explicits_s) = unzip avails_w_explicits
 386         explicits                  = foldl addListToNameSet emptyNameSet explicits_s
 387     in
 388     if want_hiding
 389     then
 390         -- All imported; item_avails to be hidden
 391         returnRn (avails, item_avails, emptyNameSet)
 392     else
 393         -- Just item_avails imported; nothing to be hidden
 394         returnRn (item_avails, [], explicits)
 395   where
 396     import_fm :: FiniteMap OccName AvailInfo
 397     import_fm = listToFM [ (nameOccName name, avail)
 398                          | avail <- avails,
 399                            name  <- availNames avail]
 400         -- Even though availNames returns data constructors too,
 401         -- they won't make any difference because naked entities like T
 402         -- in an import list map to TcOccs, not VarOccs.
 403
 404     check_item item@(IEModuleContents _)
 405       = addErrRn (badImportItemErr mod item)    `thenRn_`
 406         returnRn Nothing
 407
 408     check_item item
 409       | not (maybeToBool maybe_in_import_avails) ||
 410         not (maybeToBool maybe_filtered_avail)
 411       = addErrRn (badImportItemErr mod item)    `thenRn_`
 412         returnRn Nothing
 413
 414       | dodgy_import = addWarnRn (dodgyImportWarn mod item)     `thenRn_`
 415                        returnRn (Just (filtered_avail, explicits))
 416
 417       | otherwise    = returnRn (Just (filtered_avail, explicits))
 418
 419       where
 420         wanted_occ             = rdrNameOcc (ieName item)
 421         maybe_in_import_avails = lookupFM import_fm wanted_occ
 422
 423         Just avail             = maybe_in_import_avails
 424         maybe_filtered_avail   = filterAvail item avail
 425         Just filtered_avail    = maybe_filtered_avail
 426         explicits              | dot_dot   = [availName filtered_avail]
 427                                | otherwise = availNames filtered_avail
 428
 429         dot_dot = case item of
 430                     IEThingAll _    -> True
 431                     other           -> False
 432
 433         dodgy_import = case (item, avail) of
 434                           (IEThingAll _, AvailTC _ [n]) -> True
 435                                 -- This occurs when you import T(..), but
 436                                 -- only export T abstractly.  The single [n]
 437                                 -- in the AvailTC is the type or class itself
 438
 439                           other -> False
 440 \end{code}
 441
 442
 443
 444 %************************************************************************
 445 %*                                                                      *
 446 \subsection{Qualifiying imports}
 447 %*                                                                      *
 448 %************************************************************************
 449
 450 @qualifyImports@ takes the @ExportEnv@ after filtering through the import spec
 451 of an import decl, and deals with producing an @RnEnv@ with the
 452 right qualified names.  It also turns the @Names@ in the @ExportEnv@ into
 453 fully fledged @Names@.
 454
 455 \begin{code}
 456 qualifyImports :: ModuleName            -- Imported module
 457                -> Bool                  -- True <=> want unqualified import
 458                -> Maybe ModuleName      -- Optional "as M" part
 459                -> [AvailInfo]           -- What's to be hidden
 460                -> Avails                -- Whats imported and how
 461                -> (Name -> Name)        -- Improves the provenance on imported things
 462                -> RnMG (GlobalRdrEnv, ExportAvails)
 463         -- NB: the Names in ExportAvails don't have the improve-provenance
 464         --     function applied to them
 465         -- We could fix that, but I don't think it matters
 466
 467 qualifyImports this_mod unqual_imp as_mod hides
 468                avails improve_prov
 469   =
 470         -- Make the name environment.  We're talking about a
 471         -- single module here, so there must be no name clashes.
 472         -- In practice there only ever will be if it's the module
 473         -- being compiled.
 474     let
 475         -- Add the things that are available
 476         name_env1 = foldl add_avail emptyRdrEnv avails
 477
 478         -- Delete things that are hidden
 479         name_env2 = foldl del_avail name_env1 hides
 480
 481         -- Create the export-availability info
 482         export_avails = mkExportAvails qual_mod unqual_imp name_env2 avails
 483     in
 484     returnRn (name_env2, export_avails)
 485
 486   where
 487     qual_mod = case as_mod of
 488                   Nothing           -> this_mod
 489                   Just another_name -> another_name
 490
 491     add_avail :: GlobalRdrEnv -> AvailInfo -> GlobalRdrEnv
 492     add_avail env avail = foldl add_name env (availNames avail)
 493
 494     add_name env name
 495         | unqual_imp = env2
 496         | otherwise  = env1
 497         where
 498           env1 = addOneToGlobalRdrEnv env  (mkRdrQual qual_mod occ) better_name
 499           env2 = addOneToGlobalRdrEnv env1 (mkRdrUnqual occ)        better_name
 500           occ         = nameOccName name
 501           better_name = improve_prov name
 502
 503     del_avail env avail = foldl delOneFromGlobalRdrEnv env rdr_names
 504                         where
 505                           rdr_names = map (mkRdrUnqual . nameOccName) (availNames avail)
 506 \end{code}
 507
 508
 509 %************************************************************************
 510 %*                                                                      *
 511 \subsection{Export list processing
 512 %*                                                                      *
 513 %************************************************************************
 514
 515 Processing the export list.
 516
 517 You might think that we should record things that appear in the export list as
 518 ``occurrences'' (using addOccurrenceName), but you'd be wrong.  We do check (here)
 519 that they are in scope, but there is no need to slurp in their actual declaration
 520 (which is what addOccurrenceName forces).  Indeed, doing so would big trouble when
 521 compiling PrelBase, because it re-exports GHC, which includes takeMVar#, whose type
 522 includes ConcBase.StateAndSynchVar#, and so on...
 523
 524 \begin{code}
 525 type ExportAccum        -- The type of the accumulating parameter of
 526                         -- the main worker function in exportsFromAvail
 527      = ([ModuleName],           -- 'module M's seen so far
 528         ExportOccMap,           -- Tracks exported occurrence names
 529         NameEnv AvailInfo)      -- The accumulated exported stuff, kept in an env
 530                                 --   so we can common-up related AvailInfos
 531
 532 type ExportOccMap = FiniteMap OccName (Name, RdrNameIE)
 533         -- Tracks what a particular exported OccName
 534         --   in an export list refers to, and which item
 535         --   it came from.  It's illegal to export two distinct things
 536         --   that have the same occurrence name
 537
 538
 539 exportsFromAvail :: ModuleName
 540                  -> Maybe [RdrNameIE]   -- Export spec
 541                  -> ExportAvails
 542                  -> GlobalRdrEnv
 543                  -> RnMG Avails
 544         -- Complains if two distinct exports have same OccName
 545         -- Warns about identical exports.
 546         -- Complains about exports items not in scope
 547 exportsFromAvail this_mod Nothing export_avails global_name_env
 548   = exportsFromAvail this_mod true_exports export_avails global_name_env
 549   where
 550     true_exports = Just $ if this_mod == mAIN_Name
 551                           then [IEVar main_RDR]
 552                                -- export Main.main *only* unless otherwise specified,
 553                           else [IEModuleContents this_mod]
 554                                -- but for all other modules export everything.
 555
 556 exportsFromAvail this_mod (Just export_items)
 557                  (mod_avail_env, entity_avail_env)
 558                  global_name_env
 559   = foldlRn exports_from_item
 560             ([], emptyFM, emptyNameEnv) export_items    `thenRn` \ (_, _, export_avail_map) ->
 561     let
 562         export_avails :: [AvailInfo]
 563         export_avails   = nameEnvElts export_avail_map
 564     in
 565     returnRn export_avails
 566
 567   where
 568     exports_from_item :: ExportAccum -> RdrNameIE -> RnMG ExportAccum
 569
 570     exports_from_item acc@(mods, occs, avails) ie@(IEModuleContents mod)
 571         | mod `elem` mods       -- Duplicate export of M
 572         = warnCheckRn opt_WarnDuplicateExports
 573                       (dupModuleExport mod)     `thenRn_`
 574           returnRn acc
 575
 576         | otherwise
 577         = case lookupFM mod_avail_env mod of
 578                 Nothing         -> failWithRn acc (modExportErr mod)
 579                 Just mod_avails -> foldlRn (check_occs ie) occs mod_avails      `thenRn` \ occs' ->
 580                                    let
 581                                         avails' = foldl add_avail avails mod_avails
 582                                    in
 583                                    returnRn (mod:mods, occs', avails')
 584
 585     exports_from_item acc@(mods, occs, avails) ie
 586         | not (maybeToBool maybe_in_scope)
 587         = failWithRn acc (unknownNameErr (ieName ie))
 588
 589         | not (null dup_names)
 590         = addNameClashErrRn rdr_name (name:dup_names)   `thenRn_`
 591           returnRn acc
 592
 593 #ifdef DEBUG
 594         -- I can't see why this should ever happen; if the thing is in scope
 595         -- at all it ought to have some availability
 596         | not (maybeToBool maybe_avail)
 597         = pprTrace "exportsFromAvail: curious Nothing:" (ppr name)
 598           returnRn acc
 599 #endif
 600
 601         | not enough_avail
 602         = failWithRn acc (exportItemErr ie)
 603
 604         | otherwise     -- Phew!  It's OK!  Now to check the occurrence stuff!
 605         = check_occs ie occs export_avail       `thenRn` \ occs' ->
 606           returnRn (mods, occs', add_avail avails export_avail)
 607
 608        where
 609           rdr_name        = ieName ie
 610           maybe_in_scope  = lookupFM global_name_env rdr_name
 611           Just (name:dup_names) = maybe_in_scope
 612           maybe_avail        = lookupUFM entity_avail_env name
 613           Just avail         = maybe_avail
 614           maybe_export_avail = filterAvail ie avail
 615           enough_avail       = maybeToBool maybe_export_avail
 616           Just export_avail  = maybe_export_avail
 617
 618 add_avail avails avail = addToNameEnv_C plusAvail avails (availName avail) avail
 619
 620 check_occs :: RdrNameIE -> ExportOccMap -> AvailInfo -> RnMG ExportOccMap
 621 check_occs ie occs avail
 622   = foldlRn check occs (availNames avail)
 623   where
 624     check occs name
 625       = case lookupFM occs name_occ of
 626           Nothing           -> returnRn (addToFM occs name_occ (name, ie))
 627           Just (name', ie')
 628             | name == name' ->  -- Duplicate export
 629                                 warnCheckRn opt_WarnDuplicateExports
 630                                             (dupExportWarn name_occ ie ie')     `thenRn_`
 631                                 returnRn occs
 632
 633             | otherwise     ->  -- Same occ name but different names: an error
 634                                 failWithRn occs (exportClashErr name_occ ie ie')
 635       where
 636         name_occ = nameOccName name
 637
 638 mk_export_fn :: NameSet -> (Name -> ExportFlag)
 639 mk_export_fn exported_names
 640   = \name -> if name `elemNameSet` exported_names
 641              then Exported
 642              else NotExported
 643 \end{code}
 644
 645 %************************************************************************
 646 %*                                                                      *
 647 \subsection{Errors}
 648 %*                                                                      *
 649 %************************************************************************
 650
 651 \begin{code}
 652 badImportItemErr mod ie
 653   = sep [ptext SLIT("Module"), quotes (pprModuleName mod),
 654          ptext SLIT("does not export"), quotes (ppr ie)]
 655
 656 dodgyImportWarn mod (IEThingAll tc)
 657   = sep [ptext SLIT("Module") <+> quotes (pprModuleName mod) <+> ptext SLIT("exports") <+> quotes (ppr tc),
 658          ptext SLIT("with no constructors/class operations;"),
 659          ptext SLIT("yet it is imported with a (..)")]
 660
 661 modExportErr mod
 662   = hsep [ ptext SLIT("Unknown module in export list: module"), quotes (pprModuleName mod)]
 663
 664 exportItemErr export_item
 665   = sep [ ptext SLIT("Bad export item"), quotes (ppr export_item)]
 666
 667 exportClashErr occ_name ie1 ie2
 668   = hsep [ptext SLIT("The export items"), quotes (ppr ie1), ptext SLIT("and"), quotes (ppr ie2),
 669           ptext SLIT("create conflicting exports for"), quotes (ppr occ_name)]
 670
 671 dupDeclErr (n:ns)
 672   = vcat [ptext SLIT("Multiple declarations of") <+> quotes (ppr n),
 673           nest 4 (vcat (map pp sorted_ns))]
 674   where
 675     sorted_ns = sortLt occ'ed_before (n:ns)
 676
 677     occ'ed_before a b = LT == compare (getSrcLoc a) (getSrcLoc b)
 678
 679     pp n      = pprProvenance (getNameProvenance n)
 680
 681 dupExportWarn occ_name ie1 ie2
 682   = hsep [quotes (ppr occ_name),
 683           ptext SLIT("is exported by"), quotes (ppr ie1),
 684           ptext SLIT("and"),            quotes (ppr ie2)]
 685
 686 dupModuleExport mod
 687   = hsep [ptext SLIT("Duplicate"),
 688           quotes (ptext SLIT("Module") <+> pprModuleName mod),
 689           ptext SLIT("in export list")]
 690
 691 unusedFixityDecl rdr_name fixity
 692   = hsep [ptext SLIT("Unused fixity declaration for"), quotes (ppr rdr_name)]
 693
 694 dupFixityDecl rdr_name loc1 loc2
 695   = vcat [ptext SLIT("Multiple fixity declarations for") <+> quotes (ppr rdr_name),
 696           ptext SLIT("at ") <+> ppr loc1,
 697           ptext SLIT("and") <+> ppr loc2]
 698
 699 \end{code}