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