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