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