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         setModuleRn this_mod                    $
  77
  78                 -- PROCESS LOCAL DECLS
  79                 -- Do these *first* so that the correct provenance gets
  80                 -- into the global name cache.
  81         importsFromLocalDecls this_mod rec_exp_fn decls `thenRn` \ (local_gbl_env, local_mod_avails) ->
  82
  83                 -- PROCESS IMPORT DECLS
  84         mapAndUnzipRn importsFromImportDecl all_imports `thenRn` \ (imp_gbl_envs, imp_avails_s) ->
  85
  86                 -- COMBINE RESULTS
  87                 -- We put the local env second, so that a local provenance
  88                 -- "wins", even if a module imports itself.
  89         let
  90             gbl_env :: GlobalRdrEnv
  91             imp_gbl_env = foldr plusGlobalRdrEnv emptyRdrEnv imp_gbl_envs
  92             gbl_env     = imp_gbl_env `plusGlobalRdrEnv` local_gbl_env
  93
  94             export_avails :: ExportAvails
  95             export_avails = foldr plusExportAvails local_mod_avails imp_avails_s
  96         in
  97         returnRn (gbl_env, export_avails)
  98       )                                                 `thenRn` \ (gbl_env, export_avails) ->
  99
 100         -- TRY FOR EARLY EXIT
 101         -- We can't go for an early exit before this because we have to check
 102         -- for name clashes.  Consider:
 103         --
 104         --      module A where          module B where
 105         --         import B                h = True
 106         --         f = h
 107         --
 108         -- Suppose I've compiled everything up, and then I add a
 109         -- new definition to module B, that defines "f".
 110         --
 111         -- Then I must detect the name clash in A before going for an early
 112         -- exit.  The early-exit code checks what's actually needed from B
 113         -- to compile A, and of course that doesn't include B.f.  That's
 114         -- why we wait till after the plusRnEnv stuff to do the early-exit.
 115       checkEarlyExit this_mod                   `thenRn` \ up_to_date ->
 116       if up_to_date then
 117         returnRn (junk_exp_fn, Nothing)
 118       else
 119
 120         -- FIXITIES
 121       fixitiesFromLocalDecls gbl_env decls              `thenRn` \ local_fixity_env ->
 122       getImportedFixities                               `thenRn` \ imp_fixity_env ->
 123       let
 124         fixity_env = imp_fixity_env `plusNameEnv` local_fixity_env
 125         rn_env     = RnEnv gbl_env fixity_env
 126         (_, global_avail_env) = export_avails
 127       in
 128       traceRn (text "fixity env" <+> vcat (map ppr (nameEnvElts fixity_env)))   `thenRn_`
 129
 130         -- PROCESS EXPORT LISTS
 131       exportsFromAvail this_mod exports export_avails rn_env    `thenRn` \ (export_fn, export_env) ->
 132
 133         -- DONE
 134       returnRn (export_fn, Just (export_env, rn_env, global_avail_env))
 135     )                                                   `thenRn` \ (_, result) ->
 136     returnRn result
 137   where
 138     junk_exp_fn = error "RnNames:export_fn"
 139
 140     all_imports = prel_imports ++ imports
 141
 142         -- NB: opt_NoImplicitPrelude is slightly different to import Prelude ();
 143         -- because the former doesn't even look at Prelude.hi for instance declarations,
 144         -- whereas the latter does.
 145     prel_imports | this_mod == pRELUDE ||
 146                    explicit_prelude_import ||
 147                    opt_NoImplicitPrelude
 148                  = []
 149
 150                  | otherwise               = [ImportDecl pRELUDE
 151                                                          False          {- Not qualified -}
 152                                                          Nothing        {- No "as" -}
 153                                                          Nothing        {- No import list -}
 154                                                          mod_loc]
 155
 156     explicit_prelude_import
 157       = not (null [ () | (ImportDecl mod qual _ _ _) <- imports, mod == pRELUDE ])
 158 \end{code}
 159
 160 \begin{code}
 161 checkEarlyExit mod
 162   = checkErrsRn                         `thenRn` \ no_errs_so_far ->
 163     if not no_errs_so_far then
 164         -- Found errors already, so exit now
 165         returnRn True
 166     else
 167
 168     traceRn (text "Considering whether compilation is required...")     `thenRn_`
 169     if not opt_SourceUnchanged then
 170         -- Source code changed and no errors yet... carry on
 171         traceRn (nest 4 (text "source file changed or recompilation check turned off")) `thenRn_`
 172         returnRn False
 173     else
 174
 175         -- Unchanged source, and no errors yet; see if usage info
 176         -- up to date, and exit if so
 177     checkUpToDate mod                                           `thenRn` \ up_to_date ->
 178     putDocRn (text "Compilation" <+>
 179               text (if up_to_date then "IS NOT" else "IS") <+>
 180               text "required")                                  `thenRn_`
 181     returnRn up_to_date
 182 \end{code}
 183
 184 \begin{code}
 185 importsFromImportDecl :: RdrNameImportDecl
 186                       -> RnMG (GlobalRdrEnv,
 187                                ExportAvails)
 188
 189 importsFromImportDecl (ImportDecl imp_mod qual_only as_mod import_spec iloc)
 190   = pushSrcLocRn iloc $
 191     getInterfaceExports imp_mod         `thenRn` \ avails ->
 192
 193     if null avails then
 194         -- If there's an error in getInterfaceExports, (e.g. interface
 195         -- file not found) we get lots of spurious errors from 'filterImports'
 196         returnRn (emptyRdrEnv, mkEmptyExportAvails imp_mod)
 197     else
 198
 199     filterImports imp_mod import_spec avails    `thenRn` \ (filtered_avails, hides, explicits) ->
 200
 201         -- Load all the home modules for the things being
 202         -- bought into scope.  This makes sure their fixities
 203         -- are loaded before we grab the FixityEnv from Ifaces
 204     let
 205         home_modules = [name | avail <- filtered_avails,
 206                                 -- Doesn't take account of hiding, but that doesn't matter
 207
 208                                let name = availName avail,
 209                                not (isLocallyDefined name || nameModule name == imp_mod)
 210                                 -- Don't try to load the module being compiled
 211                                 --      (this can happen in mutual-recursion situations)
 212                                 -- or from the module being imported (it's already loaded)
 213                         ]
 214
 215         same_module n1 n2 = nameModule n1 == nameModule n2
 216         load n            = loadHomeInterface (doc_str n) n
 217         doc_str n         = ptext SLIT("Need fixities from") <+> ppr (nameModule n) <+> parens (ppr n)
 218     in
 219     mapRn load (nubBy same_module home_modules)                 `thenRn_`
 220
 221         -- We 'improve' the provenance by setting
 222         --      (a) the import-reason field, so that the Name says how it came into scope
 223         --              including whether it's explicitly imported
 224         --      (b) the print-unqualified field
 225         -- But don't fiddle with wired-in things or we get in a twist
 226     let
 227         improve_prov name = setNameImportReason name (UserImport imp_mod iloc (is_explicit name))
 228         is_explicit name  = name `elemNameSet` explicits
 229     in
 230     qualifyImports imp_mod
 231                    (not qual_only)      -- Maybe want unqualified names
 232                    as_mod hides
 233                    filtered_avails improve_prov         `thenRn` \ (rdr_name_env, mod_avails) ->
 234
 235     returnRn (rdr_name_env, mod_avails)
 236 \end{code}
 237
 238
 239 \begin{code}
 240 importsFromLocalDecls mod rec_exp_fn decls
 241   = mapRn (getLocalDeclBinders newLocalName) decls      `thenRn` \ avails_s ->
 242
 243     let
 244         avails = concat avails_s
 245
 246         all_names :: [Name]     -- All the defns; no dups eliminated
 247         all_names = [name | avail <- avails, name <- availNames avail]
 248
 249         dups :: [[Name]]
 250         dups = filter non_singleton (equivClassesByUniq getUnique all_names)
 251              where
 252                 non_singleton (x1:x2:xs) = True
 253                 non_singleton other      = False
 254     in
 255         -- Check for duplicate definitions
 256     mapRn (addErrRn . dupDeclErr) dups                          `thenRn_`
 257
 258         -- Record that locally-defined things are available
 259     mapRn (recordSlurp Nothing Compulsory) avails       `thenRn_`
 260
 261         -- Build the environment
 262     qualifyImports mod
 263                    True         -- Want unqualified names
 264                    Nothing      -- no 'as M'
 265                    []           -- Hide nothing
 266                    avails
 267                    (\n -> n)
 268
 269   where
 270     newLocalName rdr_name loc = newLocallyDefinedGlobalName mod (rdrNameOcc rdr_name)
 271                                                             rec_exp_fn loc
 272
 273 getLocalDeclBinders :: (RdrName -> SrcLoc -> RnMG Name) -- New-name function
 274                     -> RdrNameHsDecl
 275                     -> RnMG Avails
 276 getLocalDeclBinders new_name (ValD binds)
 277   = mapRn do_one (bagToList (collectTopBinders binds))
 278   where
 279     do_one (rdr_name, loc) = new_name rdr_name loc      `thenRn` \ name ->
 280                              returnRn (Avail name)
 281
 282     -- foreign declarations
 283 getLocalDeclBinders new_name (ForD (ForeignDecl nm kind _ dyn _ loc))
 284   | binds_haskell_name kind dyn
 285   = new_name nm loc                 `thenRn` \ name ->
 286     returnRn [Avail name]
 287
 288   | otherwise
 289   = returnRn []
 290
 291 getLocalDeclBinders new_name decl
 292   = getDeclBinders new_name decl        `thenRn` \ maybe_avail ->
 293     case maybe_avail of
 294         Nothing    -> returnRn []               -- Instance decls and suchlike
 295         Just avail -> returnRn [avail]
 296
 297 binds_haskell_name (FoImport _) _   = True
 298 binds_haskell_name FoLabel      _   = True
 299 binds_haskell_name FoExport  ext_nm = isDynamic ext_nm
 300
 301 fixitiesFromLocalDecls :: GlobalRdrEnv -> [RdrNameHsDecl] -> RnMG FixityEnv
 302 fixitiesFromLocalDecls gbl_env decls
 303   = foldlRn getFixities emptyNameEnv decls
 304   where
 305     getFixities :: FixityEnv -> RdrNameHsDecl -> RnMG FixityEnv
 306     getFixities acc (FixD fix)
 307       = fix_decl acc fix
 308
 309     getFixities acc (TyClD (ClassDecl _ _ _ sigs _ _ _ _ _))
 310       = foldlRn fix_decl acc [sig | FixSig sig <- sigs]
 311                 -- Get fixities from class decl sigs too
 312
 313     getFixities acc other_decl
 314       = returnRn acc
 315
 316     fix_decl acc (FixitySig rdr_name fixity loc)
 317         =       -- Check for fixity decl for something not declared
 318           case lookupRdrEnv gbl_env rdr_name of {
 319             Nothing | opt_WarnUnusedBinds
 320                     -> pushSrcLocRn loc (addWarnRn (unusedFixityDecl rdr_name fixity))  `thenRn_`
 321                        returnRn acc
 322                     | otherwise -> returnRn acc ;
 323
 324             Just (name:_) ->
 325
 326                 -- Check for duplicate fixity decl
 327           case lookupNameEnv acc name of {
 328             Just (FixitySig _ _ loc') -> addErrRn (dupFixityDecl rdr_name loc loc')     `thenRn_`
 329                                          returnRn acc ;
 330
 331
 332             Nothing -> returnRn (addToNameEnv acc name (FixitySig name fixity loc))
 333           }}
 334 \end{code}
 335
 336 %************************************************************************
 337 %*                                                                      *
 338 \subsection{Filtering imports}
 339 %*                                                                      *
 340 %************************************************************************
 341
 342 @filterImports@ takes the @ExportEnv@ telling what the imported module makes
 343 available, and filters it through the import spec (if any).
 344
 345 \begin{code}
 346 filterImports :: Module                         -- The module being imported
 347               -> Maybe (Bool, [RdrNameIE])      -- Import spec; True => hiding
 348               -> [AvailInfo]                    -- What's available
 349               -> RnMG ([AvailInfo],             -- What's actually imported
 350                        [AvailInfo],             -- What's to be hidden (the unqualified version, that is)
 351                        NameSet)                 -- What was imported explicitly
 352
 353         -- Complains if import spec mentions things that the module doesn't export
 354         -- Warns/informs if import spec contains duplicates.
 355 filterImports mod Nothing imports
 356   = returnRn (imports, [], emptyNameSet)
 357
 358 filterImports mod (Just (want_hiding, import_items)) avails
 359   = mapMaybeRn check_item import_items          `thenRn` \ avails_w_explicits ->
 360     let
 361         (item_avails, explicits_s) = unzip avails_w_explicits
 362         explicits                  = foldl addListToNameSet emptyNameSet explicits_s
 363     in
 364     if want_hiding
 365     then
 366         -- All imported; item_avails to be hidden
 367         returnRn (avails, item_avails, emptyNameSet)
 368     else
 369         -- Just item_avails imported; nothing to be hidden
 370         returnRn (item_avails, [], explicits)
 371   where
 372     import_fm :: FiniteMap OccName AvailInfo
 373     import_fm = listToFM [ (nameOccName name, avail)
 374                          | avail <- avails,
 375                            name  <- availNames avail]
 376         -- Even though availNames returns data constructors too,
 377         -- they won't make any difference because naked entities like T
 378         -- in an import list map to TcOccs, not VarOccs.
 379
 380     check_item item@(IEModuleContents _)
 381       = addErrRn (badImportItemErr mod item)    `thenRn_`
 382         returnRn Nothing
 383
 384     check_item item
 385       | not (maybeToBool maybe_in_import_avails) ||
 386         not (maybeToBool maybe_filtered_avail)
 387       = addErrRn (badImportItemErr mod item)    `thenRn_`
 388         returnRn Nothing
 389
 390       | dodgy_import = addWarnRn (dodgyImportWarn mod item)     `thenRn_`
 391                        returnRn (Just (filtered_avail, explicits))
 392
 393       | otherwise    = returnRn (Just (filtered_avail, explicits))
 394
 395       where
 396         wanted_occ             = rdrNameOcc (ieName item)
 397         maybe_in_import_avails = lookupFM import_fm wanted_occ
 398
 399         Just avail             = maybe_in_import_avails
 400         maybe_filtered_avail   = filterAvail item avail
 401         Just filtered_avail    = maybe_filtered_avail
 402         explicits              | dot_dot   = [availName filtered_avail]
 403                                | otherwise = availNames filtered_avail
 404
 405         dot_dot = case item of
 406                     IEThingAll _    -> True
 407                     other           -> False
 408
 409         dodgy_import = case (item, avail) of
 410                           (IEThingAll _, AvailTC _ [n]) -> True
 411                                 -- This occurs when you import T(..), but
 412                                 -- only export T abstractly.  The single [n]
 413                                 -- in the AvailTC is the type or class itself
 414
 415                           other -> False
 416 \end{code}
 417
 418
 419
 420 %************************************************************************
 421 %*                                                                      *
 422 \subsection{Qualifiying imports}
 423 %*                                                                      *
 424 %************************************************************************
 425
 426 @qualifyImports@ takes the @ExportEnv@ after filtering through the import spec
 427 of an import decl, and deals with producing an @RnEnv@ with the
 428 right qualified names.  It also turns the @Names@ in the @ExportEnv@ into
 429 fully fledged @Names@.
 430
 431 \begin{code}
 432 qualifyImports :: Module                -- Imported module
 433                -> Bool                  -- True <=> want unqualified import
 434                -> Maybe Module          -- Optional "as M" part
 435                -> [AvailInfo]           -- What's to be hidden
 436                -> Avails                -- Whats imported and how
 437                -> (Name -> Name)        -- Improves the provenance on imported things
 438                -> RnMG (GlobalRdrEnv, ExportAvails)
 439         -- NB: the Names in ExportAvails don't have the improve-provenance
 440         --     function applied to them
 441         -- We could fix that, but I don't think it matters
 442
 443 qualifyImports this_mod unqual_imp as_mod hides
 444                avails improve_prov
 445   =
 446         -- Make the name environment.  We're talking about a
 447         -- single module here, so there must be no name clashes.
 448         -- In practice there only ever will be if it's the module
 449         -- being compiled.
 450     let
 451         -- Add the things that are available
 452         name_env1 = foldl add_avail emptyRdrEnv avails
 453
 454         -- Delete things that are hidden
 455         name_env2 = foldl del_avail name_env1 hides
 456
 457         -- Create the export-availability info
 458         export_avails = mkExportAvails qual_mod unqual_imp name_env2 avails
 459     in
 460     returnRn (name_env2, export_avails)
 461
 462   where
 463     qual_mod = case as_mod of
 464                   Nothing           -> this_mod
 465                   Just another_name -> another_name
 466
 467     add_avail :: GlobalRdrEnv -> AvailInfo -> GlobalRdrEnv
 468     add_avail env avail = foldl add_name env (availNames avail)
 469
 470     add_name env name
 471         | unqual_imp = env2
 472         | otherwise  = env1
 473         where
 474           env1 = addOneToGlobalRdrEnv env  (mkRdrQual qual_mod occ) better_name
 475           env2 = addOneToGlobalRdrEnv env1 (mkRdrUnqual occ)        better_name
 476           occ         = nameOccName name
 477           better_name = improve_prov name
 478
 479     del_avail env avail = foldl delOneFromGlobalRdrEnv env rdr_names
 480                         where
 481                           rdr_names = map (mkRdrUnqual . nameOccName) (availNames avail)
 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)
 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           maybe_export_avail = filterAvail ie avail
 601           enough_avail       = maybeToBool maybe_export_avail
 602           Just export_avail  = maybe_export_avail
 603
 604 add_avail avails avail = addToNameEnv_C plusAvail avails (availName avail) avail
 605
 606 check_occs :: RdrNameIE -> ExportOccMap -> AvailInfo -> RnMG ExportOccMap
 607 check_occs ie occs avail
 608   = foldlRn check occs (availNames avail)
 609   where
 610     check occs name
 611       = case lookupFM occs name_occ of
 612           Nothing           -> returnRn (addToFM occs name_occ (name, ie))
 613           Just (name', ie')
 614             | name == name' ->  -- Duplicate export
 615                                 warnCheckRn opt_WarnDuplicateExports
 616                                             (dupExportWarn name_occ ie ie')     `thenRn_`
 617                                 returnRn occs
 618
 619             | otherwise     ->  -- Same occ name but different names: an error
 620                                 failWithRn occs (exportClashErr name_occ ie ie')
 621       where
 622         name_occ = nameOccName name
 623
 624 mk_export_fn :: NameSet -> (Name -> ExportFlag)
 625 mk_export_fn exported_names
 626   = \name -> if name `elemNameSet` exported_names
 627              then Exported
 628              else NotExported
 629 \end{code}
 630
 631 %************************************************************************
 632 %*                                                                      *
 633 \subsection{Errors}
 634 %*                                                                      *
 635 %************************************************************************
 636
 637 \begin{code}
 638 badImportItemErr mod ie
 639   = sep [ptext SLIT("Module"), quotes (pprModule mod),
 640          ptext SLIT("does not export"), quotes (ppr ie)]
 641
 642 dodgyImportWarn mod (IEThingAll tc)
 643   = sep [ptext SLIT("Module") <+> quotes (pprModule mod) <+> ptext SLIT("exports") <+> quotes (ppr tc),
 644          ptext SLIT("with no constructors/class operations;"),
 645          ptext SLIT("yet it is imported with a (..)")]
 646
 647 modExportErr mod
 648   = hsep [ ptext SLIT("Unknown module in export list: module"), quotes (pprModule mod)]
 649
 650 exportItemErr export_item
 651   = sep [ ptext SLIT("Bad export item"), quotes (ppr export_item)]
 652
 653 exportClashErr occ_name ie1 ie2
 654   = hsep [ptext SLIT("The export items"), quotes (ppr ie1), ptext SLIT("and"), quotes (ppr ie2),
 655           ptext SLIT("create conflicting exports for"), quotes (ppr occ_name)]
 656
 657 dupDeclErr (n:ns)
 658   = vcat [ptext SLIT("Multiple declarations of") <+> quotes (ppr n),
 659           nest 4 (vcat (map pp sorted_ns))]
 660   where
 661     sorted_ns = sortLt occ'ed_before (n:ns)
 662
 663     occ'ed_before a b = LT == compare (getSrcLoc a) (getSrcLoc b)
 664
 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}