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 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 :: (Name -> Bool)         -- True => print unqualified
 185                       -> RdrNameImportDecl
 186                       -> RnMG (GlobalRdrEnv,
 187                                ExportAvails)
 188
 189 importsFromImportDecl rec_unqual_fn (ImportDecl mod qual_only as_source as_mod import_spec iloc)
 190   = pushSrcLocRn iloc $
 191     getInterfaceExports mod as_source           `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 mod)
 197     else
 198
 199     filterImports 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                                 -- Drop NotAvailables.
 209                                 -- Happens if filterAvail finds something missing
 210                                case avail of
 211                                   NotAvailable -> False
 212                                   other        -> True,
 213
 214                                let name = availName avail,
 215                                nameModule (availName avail) /= mod
 216                                 -- This nameModule predicate is a bit of a hack.
 217                                 -- PrelBase imports error from PrelErr.hi-boot; but error is
 218                                 -- wired in, so its provenance doesn't say it's from an hi-boot
 219                                 -- file. Result: disaster when PrelErr.hi doesn't exist.
 220                                 --      [Jan 99: I now can't see how the predicate achieves the goal!]
 221                         ]
 222
 223         same_module n1 n2 = nameModule n1 == nameModule n2
 224         load n            = loadHomeInterface (doc_str n) n
 225         doc_str n         = ptext SLIT("Need fixities from") <+> ppr (nameModule n) <+> parens (ppr n)
 226     in
 227     mapRn load (nubBy same_module home_modules)                 `thenRn_`
 228
 229         -- We 'improve' the provenance by setting
 230         --      (a) the import-reason field, so that the Name says how it came into scope
 231         --              including whether it's explicitly imported
 232         --      (b) the print-unqualified field
 233         -- But don't fiddle with wired-in things or we get in a twist
 234     let
 235         improve_prov name | isWiredInName name = name
 236                           | otherwise          = setNameProvenance name (mk_new_prov name)
 237
 238         is_explicit name = name `elemNameSet` explicits
 239         mk_new_prov name = NonLocalDef (UserImport mod iloc (is_explicit name))
 240                                        as_source
 241                                        (rec_unqual_fn name)
 242     in
 243     qualifyImports mod
 244                    (not qual_only)      -- Maybe want unqualified names
 245                    as_mod hides
 246                    filtered_avails improve_prov         `thenRn` \ (rdr_name_env, mod_avails) ->
 247
 248     returnRn (rdr_name_env, mod_avails)
 249 \end{code}
 250
 251
 252 \begin{code}
 253 importsFromLocalDecls mod rec_exp_fn decls
 254   = mapRn (getLocalDeclBinders newLocalName) decls      `thenRn` \ avails_s ->
 255
 256     let
 257         avails = concat avails_s
 258
 259         all_names :: [Name]     -- All the defns; no dups eliminated
 260         all_names = [name | avail <- avails, name <- availNames avail]
 261
 262         dups :: [[Name]]
 263         dups = filter non_singleton (equivClassesByUniq getUnique all_names)
 264              where
 265                 non_singleton (x1:x2:xs) = True
 266                 non_singleton other      = False
 267     in
 268         -- Check for duplicate definitions
 269     mapRn (addErrRn . dupDeclErr) dups                          `thenRn_`
 270
 271         -- Record that locally-defined things are available
 272     mapRn (recordSlurp Nothing Compulsory) avails       `thenRn_`
 273
 274         -- Build the environment
 275     qualifyImports mod
 276                    True         -- Want unqualified names
 277                    Nothing      -- no 'as M'
 278                    []           -- Hide nothing
 279                    avails
 280                    (\n -> n)
 281
 282   where
 283     newLocalName rdr_name loc = newLocallyDefinedGlobalName mod (rdrNameOcc rdr_name)
 284                                                             rec_exp_fn loc
 285
 286 getLocalDeclBinders :: (RdrName -> SrcLoc -> RnMG Name) -- New-name function
 287                     -> RdrNameHsDecl
 288                     -> RnMG Avails
 289 getLocalDeclBinders new_name (ValD binds)
 290   = mapRn do_one (bagToList (collectTopBinders binds))
 291   where
 292     do_one (rdr_name, loc) = new_name rdr_name loc      `thenRn` \ name ->
 293                              returnRn (Avail name)
 294
 295     -- foreign import declaration
 296 getLocalDeclBinders new_name (ForD (ForeignDecl nm kind _ _ _ loc))
 297   | binds_haskell_name kind
 298   = new_name nm loc                 `thenRn` \ name ->
 299     returnRn [Avail name]
 300
 301   | otherwise
 302   = returnRn []
 303
 304 getLocalDeclBinders new_name decl
 305   = getDeclBinders new_name decl        `thenRn` \ avail ->
 306     case avail of
 307         NotAvailable -> returnRn []             -- Instance decls and suchlike
 308         other        -> returnRn [avail]
 309
 310 binds_haskell_name (FoImport _) = True
 311 binds_haskell_name FoLabel      = True
 312 binds_haskell_name FoExport     = False
 313
 314 fixitiesFromLocalDecls :: GlobalRdrEnv -> [RdrNameHsDecl] -> RnMG FixityEnv
 315 fixitiesFromLocalDecls gbl_env decls
 316   = foldlRn getFixities emptyNameEnv decls
 317   where
 318     getFixities :: FixityEnv -> RdrNameHsDecl -> RnMG FixityEnv
 319     getFixities acc (FixD fix)
 320       = fix_decl acc fix
 321
 322     getFixities acc (TyClD (ClassDecl _ _ _ sigs _ _ _ _ _))
 323       = foldlRn fix_decl acc [sig | FixSig sig <- sigs]
 324                 -- Get fixities from class decl sigs too
 325
 326     getFixities acc other_decl
 327       = returnRn acc
 328
 329     fix_decl acc (FixitySig rdr_name fixity loc)
 330         =       -- Check for fixity decl for something not declared
 331           case lookupRdrEnv gbl_env rdr_name of {
 332             Nothing   -> pushSrcLocRn loc                               $
 333                          addWarnRn (unusedFixityDecl rdr_name fixity)   `thenRn_`
 334                          returnRn acc ;
 335             Just (name:_) ->
 336
 337                 -- Check for duplicate fixity decl
 338           case lookupNameEnv acc name of {
 339             Just (FixitySig _ _ loc') -> addErrRn (dupFixityDecl rdr_name loc loc')     `thenRn_`
 340                                          returnRn acc ;
 341
 342
 343             Nothing -> returnRn (addToNameEnv acc name (FixitySig name fixity loc))
 344           }}
 345 \end{code}
 346
 347 %************************************************************************
 348 %*                                                                      *
 349 \subsection{Filtering imports}
 350 %*                                                                      *
 351 %************************************************************************
 352
 353 @filterImports@ takes the @ExportEnv@ telling what the imported module makes
 354 available, and filters it through the import spec (if any).
 355
 356 \begin{code}
 357 filterImports :: Module
 358               -> Maybe (Bool, [RdrNameIE])      -- Import spec; True => hiding
 359               -> [AvailInfo]                    -- What's available
 360               -> RnMG ([AvailInfo],             -- What's actually imported
 361                        [AvailInfo],             -- What's to be hidden (the unqualified version, that is)
 362                        NameSet)                 -- What was imported explicitly
 363
 364         -- Complains if import spec mentions things that the module doesn't export
 365         -- Warns/informs if import spec contains duplicates.
 366 filterImports mod Nothing imports
 367   = returnRn (imports, [], emptyNameSet)
 368
 369 filterImports mod (Just (want_hiding, import_items)) avails
 370   = mapRn check_item import_items               `thenRn` \ item_avails ->
 371     if want_hiding
 372     then
 373         -- All imported; item_avails to be hidden
 374         returnRn (avails, item_avails, emptyNameSet)
 375     else
 376         -- Just item_avails imported; nothing to be hidden
 377         returnRn (item_avails, [], availsToNameSet item_avails)
 378
 379   where
 380     import_fm :: FiniteMap OccName AvailInfo
 381     import_fm = listToFM [ (nameOccName name, avail)
 382                          | avail <- avails,
 383                            name  <- availNames avail]
 384         -- Even though availNames returns data constructors too,
 385         -- they won't make any difference because naked entities like T
 386         -- in an import list map to TCOccs, not VarOccs.
 387
 388     check_item item@(IEModuleContents _)
 389       = addErrRn (badImportItemErr mod item)    `thenRn_`
 390         returnRn NotAvailable
 391
 392     check_item item
 393       | not (maybeToBool maybe_in_import_avails) ||
 394         (case filtered_avail of { NotAvailable -> True; other -> False })
 395       = addErrRn (badImportItemErr mod item)    `thenRn_`
 396         returnRn NotAvailable
 397
 398       | dodgy_import = addWarnRn (dodgyImportWarn mod item)     `thenRn_`
 399                        returnRn filtered_avail
 400
 401       | otherwise    = returnRn filtered_avail
 402
 403       where
 404         maybe_in_import_avails = lookupFM import_fm (ieOcc item)
 405         Just avail             = maybe_in_import_avails
 406         filtered_avail         = filterAvail item avail
 407         dodgy_import           = case (item, avail) of
 408                                    (IEThingAll _, AvailTC _ [n]) -> True
 409                                         -- This occurs when you import T(..), but
 410                                         -- only export T abstractly.  The single [n]
 411                                         -- in the AvailTC is the type or class itself
 412
 413                                    other -> False
 414
 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  (Qual qual_mod occ err_hif) better_name
 474           env2 = addOneToGlobalRdrEnv env1 (Unqual 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 (Unqual . nameOccName) (availNames avail)
 481
 482 err_hif = error "qualifyImports: hif"   -- Not needed in key to mapping
 483 \end{code}
 484
 485
 486 %************************************************************************
 487 %*                                                                      *
 488 \subsection{Export list processing
 489 %*                                                                      *
 490 %************************************************************************
 491
 492 Processing the export list.
 493
 494 You might think that we should record things that appear in the export list as
 495 ``occurrences'' (using addOccurrenceName), but you'd be wrong.  We do check (here)
 496 that they are in scope, but there is no need to slurp in their actual declaration
 497 (which is what addOccurrenceName forces).  Indeed, doing so would big trouble when
 498 compiling PrelBase, because it re-exports GHC, which includes takeMVar#, whose type
 499 includes ConcBase.StateAndSynchVar#, and so on...
 500
 501 \begin{code}
 502 type ExportAccum        -- The type of the accumulating parameter of
 503                         -- the main worker function in exportsFromAvail
 504      = ([Module],               -- 'module M's seen so far
 505         ExportOccMap,           -- Tracks exported occurrence names
 506         NameEnv AvailInfo)      -- The accumulated exported stuff, kept in an env
 507                                 --   so we can common-up related AvailInfos
 508
 509 type ExportOccMap = FiniteMap OccName (Name, RdrNameIE)
 510         -- Tracks what a particular exported OccName
 511         --   in an export list refers to, and which item
 512         --   it came from.  It's illegal to export two distinct things
 513         --   that have the same occurrence name
 514
 515
 516 exportsFromAvail :: Module
 517                  -> Maybe [RdrNameIE]   -- Export spec
 518                  -> ExportAvails
 519                  -> RnEnv
 520                  -> RnMG (Name -> ExportFlag, ExportEnv)
 521         -- Complains if two distinct exports have same OccName
 522         -- Warns about identical exports.
 523         -- Complains about exports items not in scope
 524 exportsFromAvail this_mod Nothing export_avails rn_env
 525   = exportsFromAvail this_mod (Just [IEModuleContents this_mod]) export_avails rn_env
 526
 527 exportsFromAvail this_mod (Just export_items)
 528                  (mod_avail_env, entity_avail_env)
 529                  (RnEnv global_name_env fixity_env)
 530   = foldlRn exports_from_item
 531             ([], emptyFM, emptyNameEnv) export_items    `thenRn` \ (_, _, export_avail_map) ->
 532     let
 533         export_avails :: [AvailInfo]
 534         export_avails   = nameEnvElts export_avail_map
 535
 536         export_names :: NameSet
 537         export_names = availsToNameSet export_avails
 538
 539         -- Export only those fixities that are for names that are
 540         --      (a) defined in this module
 541         --      (b) exported
 542         export_fixities :: [(Name,Fixity)]
 543         export_fixities = [ (name,fixity)
 544                           | FixitySig name fixity _ <- nameEnvElts fixity_env,
 545                             name `elemNameSet` export_names,
 546                             isLocallyDefined name
 547                           ]
 548
 549         export_fn :: Name -> ExportFlag
 550         export_fn = mk_export_fn export_names
 551     in
 552     returnRn (export_fn, ExportEnv export_avails export_fixities)
 553
 554   where
 555     exports_from_item :: ExportAccum -> RdrNameIE -> RnMG ExportAccum
 556
 557     exports_from_item acc@(mods, occs, avails) ie@(IEModuleContents mod)
 558         | mod `elem` mods       -- Duplicate export of M
 559         = warnCheckRn opt_WarnDuplicateExports
 560                       (dupModuleExport mod)     `thenRn_`
 561           returnRn acc
 562
 563         | otherwise
 564         = case lookupFM mod_avail_env mod of
 565                 Nothing         -> failWithRn acc (modExportErr mod)
 566                 Just mod_avails -> foldlRn (check_occs ie) occs mod_avails      `thenRn` \ occs' ->
 567                                    let
 568                                         avails' = foldl add_avail avails mod_avails
 569                                    in
 570                                    returnRn (mod:mods, occs', avails')
 571
 572     exports_from_item acc@(mods, occs, avails) ie
 573         | not (maybeToBool maybe_in_scope)
 574         = failWithRn acc (unknownNameErr (ieName ie))
 575
 576         | not (null dup_names)
 577         = addNameClashErrRn rdr_name (name:dup_names)   `thenRn_`
 578           returnRn acc
 579
 580 #ifdef DEBUG
 581         -- I can't see why this should ever happen; if the thing is in scope
 582         -- at all it ought to have some availability
 583         | not (maybeToBool maybe_avail)
 584         = pprTrace "exportsFromAvail: curious Nothing:" (ppr name)
 585           returnRn acc
 586 #endif
 587
 588         | not enough_avail
 589         = failWithRn acc (exportItemErr ie export_avail)
 590
 591         | otherwise     -- Phew!  It's OK!  Now to check the occurrence stuff!
 592         = check_occs ie occs export_avail       `thenRn` \ occs' ->
 593           returnRn (mods, occs', add_avail avails export_avail)
 594
 595        where
 596           rdr_name        = ieName ie
 597           maybe_in_scope  = lookupFM global_name_env rdr_name
 598           Just (name:dup_names) = maybe_in_scope
 599           maybe_avail     = lookupUFM entity_avail_env name
 600           Just avail      = maybe_avail
 601           export_avail    = filterAvail ie avail
 602           enough_avail    = case export_avail of {NotAvailable -> False; other -> True}
 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 NotAvailable
 651   = sep [ ptext SLIT("Export item not in scope:"), quotes (ppr export_item)]
 652
 653 exportItemErr export_item avail
 654   = hang (ptext SLIT("Export item not fully in scope:"))
 655            4 (vcat [hsep [ptext SLIT("Wanted:   "), ppr export_item],
 656                     hsep [ptext SLIT("Available:"), ppr (ieOcc export_item), pprAvail avail]])
 657
 658 exportClashErr occ_name ie1 ie2
 659   = hsep [ptext SLIT("The export items"), quotes (ppr ie1), ptext SLIT("and"), quotes (ppr ie2),
 660           ptext SLIT("create conflicting exports for"), quotes (ppr occ_name)]
 661
 662 dupDeclErr (n:ns)
 663   = vcat [ptext SLIT("Multiple declarations of") <+> quotes (ppr n),
 664           nest 4 (vcat (map pp (n:ns)))]
 665   where
 666     pp n = pprProvenance (getNameProvenance n)
 667
 668 dupExportWarn occ_name ie1 ie2
 669   = hsep [quotes (ppr occ_name),
 670           ptext SLIT("is exported by"), quotes (ppr ie1),
 671           ptext SLIT("and"),            quotes (ppr ie2)]
 672
 673 dupModuleExport mod
 674   = hsep [ptext SLIT("Duplicate"),
 675           quotes (ptext SLIT("Module") <+> pprModule mod),
 676           ptext SLIT("in export list")]
 677
 678 unusedFixityDecl rdr_name fixity
 679   = hsep [ptext SLIT("Unused fixity declaration for"), quotes (ppr rdr_name)]
 680
 681 dupFixityDecl rdr_name loc1 loc2
 682   = vcat [ptext SLIT("Multiple fixity declarations for") <+> quotes (ppr rdr_name),
 683           ptext SLIT("at ") <+> ppr loc1,
 684           ptext SLIT("and") <+> ppr loc2]
 685
 686 \end{code}