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