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