ghc/compiler/rename/RnNames.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
   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(..),
  18                   IE(..), ieName,
  19                   FixityDecl(..),
  20                   collectTopBinders
  21                 )
  22 import RdrHsSyn ( RdrNameHsDecl, RdrName(..), RdrNameIE, RdrNameImportDecl,
  23                   RdrNameHsModule, RdrNameFixityDecl,
  24                   rdrNameOcc, ieOcc
  25                 )
  26 import RnIfaces ( getInterfaceExports, getDeclBinders, recordSlurp, checkUpToDate )
  27 import BasicTypes ( IfaceFlavour(..) )
  28 import RnEnv
  29 import RnMonad
  30
  31 import FiniteMap
  32 import PrelMods
  33 import UniqFM   ( UniqFM, addListToUFM_C, lookupUFM )
  34 import Bag      ( Bag, bagToList )
  35 import Maybes   ( maybeToBool )
  36 import Name
  37 import Outputable
  38 import Util     ( removeDups )
  39 \end{code}
  40
  41
  42
  43 %************************************************************************
  44 %*                                                                      *
  45 \subsection{Get global names}
  46 %*                                                                      *
  47 %************************************************************************
  48
  49 \begin{code}
  50 getGlobalNames :: RdrNameHsModule
  51                -> RnMG (Maybe (ExportEnv,
  52                                RnEnv,
  53                                FiniteMap Name HowInScope,       -- Locally defined or explicitly imported
  54                                Name -> PrintUnqualified))
  55                         -- Nothing => no need to recompile
  56
  57 getGlobalNames m@(HsModule this_mod _ exports imports _ _ mod_loc)
  58   = fixRn (\ ~(rec_exp_fn, _) ->
  59
  60         -- PROCESS LOCAL DECLS
  61         -- Do these *first* so that the correct provenance gets
  62         -- into the global name cache.
  63       importsFromLocalDecls rec_exp_fn m        `thenRn` \ (local_rn_env, local_mod_avails, local_info) ->
  64
  65         -- PROCESS IMPORT DECLS
  66       mapAndUnzip3Rn importsFromImportDecl all_imports
  67                                                 `thenRn` \ (imp_rn_envs, imp_avails_s, explicit_imports_s) ->
  68
  69         -- COMBINE RESULTS
  70         -- We put the local env second, so that a local provenance
  71         -- "wins", even if a module imports itself.
  72       foldlRn plusRnEnv emptyRnEnv imp_rn_envs          `thenRn` \ imp_rn_env ->
  73       plusRnEnv imp_rn_env local_rn_env                 `thenRn` \ rn_env ->
  74
  75         -- TRY FOR EARLY EXIT
  76         -- We can't go for an early exit before this because we have to check
  77         -- for name clashes.  Consider:
  78         --
  79         --      module A where          module B where
  80         --         import B                h = True
  81         --         f = h
  82         --
  83         -- Suppose I've compiled everything up, and then I add a
  84         -- new definition to module B, that defines "f".
  85         --
  86         -- Then I must detect the name clash in A before going for an early
  87         -- exit.  The early-exit code checks what's actually needed from B
  88         -- to compile A, and of course that doesn't include B.f.  That's
  89         -- why we wait till after the plusRnEnv stuff to do the early-exit.
  90       checkEarlyExit this_mod                           `thenRn` \ up_to_date ->
  91       if up_to_date then
  92         returnRn (error "early exit", Nothing)
  93       else
  94
  95
  96         -- PROCESS EXPORT LISTS
  97       let
  98          export_avails :: ExportAvails
  99          export_avails = foldr plusExportAvails local_mod_avails imp_avails_s
 100
 101          explicit_info :: FiniteMap Name HowInScope  -- Locally defined or explicitly imported
 102          explicit_info = foldr plusFM local_info explicit_imports_s
 103       in
 104       exportsFromAvail this_mod exports export_avails rn_env
 105                                                         `thenRn` \ (export_fn, export_env) ->
 106
 107         -- BUILD THE "IMPORT FN".  It just tells whether a name is in
 108         -- scope in an unqualified form.
 109       let
 110           print_unqual = mkImportFn imp_rn_env
 111       in
 112
 113       returnRn (export_fn, Just (export_env, rn_env, explicit_info, print_unqual))
 114     )                                                   `thenRn` \ (_, result) ->
 115     returnRn result
 116   where
 117     junk_exp_fn = error "RnNames:export_fn"
 118
 119     all_imports = prel_imports ++ imports
 120
 121         -- NB: opt_NoImplicitPrelude is slightly different to import Prelude ();
 122         -- because the former doesn't even look at Prelude.hi for instance declarations,
 123         -- whereas the latter does.
 124     prel_imports | this_mod == pRELUDE ||
 125                    explicit_prelude_import ||
 126                    opt_NoImplicitPrelude
 127                  = []
 128
 129                  | otherwise               = [ImportDecl pRELUDE
 130                                                          False          {- Not qualified -}
 131                                                          HiFile         {- Not source imported -}
 132                                                          Nothing        {- No "as" -}
 133                                                          Nothing        {- No import list -}
 134                                                          mod_loc]
 135
 136     explicit_prelude_import
 137       = not (null [ () | (ImportDecl mod qual _ _ _ _) <- imports, mod == pRELUDE ])
 138 \end{code}
 139
 140 \begin{code}
 141 checkEarlyExit mod
 142   = checkErrsRn                         `thenRn` \ no_errs_so_far ->
 143     if not no_errs_so_far then
 144         -- Found errors already, so exit now
 145         returnRn True
 146     else
 147
 148     traceRn (text "Considering whether compilation is required...")     `thenRn_`
 149     if not opt_SourceUnchanged then
 150         -- Source code changed and no errors yet... carry on
 151         traceRn (nest 4 (text "source file changed or recompilation check turned off")) `thenRn_`
 152         returnRn False
 153     else
 154
 155         -- Unchanged source, and no errors yet; see if usage info
 156         -- up to date, and exit if so
 157     checkUpToDate mod                                           `thenRn` \ up_to_date ->
 158     putDocRn (text "Compilation" <+>
 159               text (if up_to_date then "IS NOT" else "IS") <+>
 160               text "required")                                  `thenRn_`
 161     returnRn up_to_date
 162 \end{code}
 163
 164 \begin{code}
 165 importsFromImportDecl :: RdrNameImportDecl
 166                       -> RnMG (RnEnv,
 167                                ExportAvails,
 168                                FiniteMap Name HowInScope)  -- Records the explicitly-imported things
 169
 170 importsFromImportDecl (ImportDecl mod qual_only as_source as_mod import_spec loc)
 171   = pushSrcLocRn loc $
 172     getInterfaceExports mod as_source           `thenRn` \ (avails, fixities) ->
 173     filterImports mod import_spec avails        `thenRn` \ (filtered_avails, hides, explicits) ->
 174     let
 175         how_in_scope = FromImportDecl mod loc
 176         explicit_info = listToFM [(name, how_in_scope)
 177                                  | avail <- explicits,
 178                                    name  <- availNames avail
 179                                  ]
 180     in
 181     qualifyImports mod
 182                    True                 -- Want qualified names
 183                    (not qual_only)      -- Maybe want unqualified names
 184                    as_mod
 185                    hides
 186                    filtered_avails (\n -> how_in_scope)
 187                    [ (occ,(fixity,how_in_scope)) | (occ,fixity) <- fixities ]
 188                                                         `thenRn` \ (rn_env, mod_avails) ->
 189     returnRn (rn_env, mod_avails, explicit_info)
 190 \end{code}
 191
 192
 193 \begin{code}
 194 importsFromLocalDecls rec_exp_fn (HsModule mod _ _ _ fix_decls decls _)
 195   = foldlRn getLocalDeclBinders [] decls                `thenRn` \ avails ->
 196
 197         -- Record that locally-defined things are available
 198     mapRn (recordSlurp Nothing Compulsory) avails       `thenRn_`
 199
 200         -- Fixities
 201     mapRn fixityFromFixDecl fix_decls                   `thenRn` \ fixities ->
 202
 203         -- Record where the available stuff came from
 204     let
 205         explicit_info = listToFM [(name, FromLocalDefn (getSrcLoc name))
 206                                  | avail <- avails,
 207                                    name  <- availNames avail
 208                                  ]
 209     in
 210     qualifyImports mod
 211                    False        -- Don't want qualified names
 212                    True         -- Want unqualified names
 213                    Nothing      -- No "as M" part
 214                    []           -- Hide nothing
 215                    avails (\n -> FromLocalDefn (getSrcLoc n))
 216                    fixities
 217                                                         `thenRn` \ (rn_env, mod_avails) ->
 218     returnRn (rn_env, mod_avails, explicit_info)
 219   where
 220     newLocalName rdr_name loc
 221       = newLocallyDefinedGlobalName mod (rdrNameOcc rdr_name) rec_exp_fn loc
 222
 223     getLocalDeclBinders avails (ValD binds)
 224       = mapRn do_one (bagToList (collectTopBinders binds))      `thenRn` \ val_avails ->
 225         returnRn (val_avails ++ avails)
 226
 227     getLocalDeclBinders avails decl
 228       = getDeclBinders newLocalName decl        `thenRn` \ avail ->
 229         case avail of
 230            NotAvailable -> returnRn avails              -- Instance decls and suchlike
 231            other        -> returnRn (avail : avails)
 232
 233     do_one (rdr_name, loc)
 234       = newLocalName rdr_name loc       `thenRn` \ name ->
 235         returnRn (Avail name)
 236 \end{code}
 237
 238 %************************************************************************
 239 %*                                                                      *
 240 \subsection{Filtering imports}
 241 %*                                                                      *
 242 %************************************************************************
 243
 244 @filterImports@ takes the @ExportEnv@ telling what the imported module makes
 245 available, and filters it through the import spec (if any).
 246
 247 \begin{code}
 248 filterImports :: Module
 249               -> Maybe (Bool, [RdrNameIE])              -- Import spec; True => hidin
 250               -> [AvailInfo]                            -- What's available
 251               -> RnMG ([AvailInfo],                     -- What's actually imported
 252                        [AvailInfo],                     -- What's to be hidden (the unqualified version, that is)
 253                        [AvailInfo])                     -- What was imported explicitly
 254
 255         -- Complains if import spec mentions things that the module doesn't export
 256         -- Warns/informs if import spec contains duplicates.
 257 filterImports mod Nothing imports
 258   = returnRn (imports, [], [])
 259
 260 filterImports mod (Just (want_hiding, import_items)) avails
 261   = mapRn check_item import_items               `thenRn` \ item_avails ->
 262     if want_hiding
 263     then
 264         returnRn (avails, item_avails, [])      -- All imported; item_avails to be hidden
 265     else
 266         returnRn (item_avails, [], item_avails) -- Just item_avails imported; nothing to be hidden
 267
 268   where
 269     import_fm :: FiniteMap OccName AvailInfo
 270     import_fm = listToFM [ (nameOccName name, avail)
 271                          | avail <- avails,
 272                            name  <- availEntityNames avail]
 273
 274     check_item item@(IEModuleContents _)
 275       = addErrRn (badImportItemErr mod item)    `thenRn_`
 276         returnRn NotAvailable
 277
 278     check_item item
 279       | not (maybeToBool maybe_in_import_avails) ||
 280         (case filtered_avail of { NotAvailable -> True; other -> False })
 281       = addErrRn (badImportItemErr mod item)    `thenRn_`
 282         returnRn NotAvailable
 283
 284       | dodgy_import = addWarnRn (dodgyImportWarn mod item)     `thenRn_`
 285                        returnRn filtered_avail
 286
 287       | otherwise    = returnRn filtered_avail
 288
 289       where
 290         maybe_in_import_avails = lookupFM import_fm (ieOcc item)
 291         Just avail             = maybe_in_import_avails
 292         filtered_avail         = filterAvail item avail
 293         dodgy_import           = case (item, avail) of
 294                                    (IEThingAll _, AvailTC _ [n]) -> True
 295                                         -- This occurs when you import T(..), but
 296                                         -- only export T abstractly.  The single [n]
 297                                         -- in the AvailTC is the type or class itself
 298
 299                                    other -> False
 300
 301 \end{code}
 302
 303
 304
 305 %************************************************************************
 306 %*                                                                      *
 307 \subsection{Qualifiying imports}
 308 %*                                                                      *
 309 %************************************************************************
 310
 311 @qualifyImports@ takes the @ExportEnv@ after filtering through the import spec
 312 of an import decl, and deals with producing an @RnEnv@ with the
 313 right qualified names.  It also turns the @Names@ in the @ExportEnv@ into
 314 fully fledged @Names@.
 315
 316 \begin{code}
 317 qualifyImports :: Module                                -- Imported module
 318                -> Bool                                  -- True <=> want qualified import
 319                -> Bool                                  -- True <=> want unqualified import
 320                -> Maybe Module                          -- Optional "as M" part
 321                -> [AvailInfo]                           -- What's to be hidden
 322                -> Avails -> (Name -> HowInScope)        -- Whats imported and how
 323                -> [(OccName, (Fixity, HowInScope))]     -- Ditto for fixities
 324                -> RnMG (RnEnv, ExportAvails)
 325
 326 qualifyImports this_mod qual_imp unqual_imp as_mod hides
 327                avails name_to_his fixities
 328   =
 329         -- Make the name environment.  Even though we're talking about a
 330         -- single import module there might still be name clashes,
 331         -- because it might be the module being compiled.
 332     foldlRn add_avail emptyGlobalNameEnv avails `thenRn` \ name_env1 ->
 333     let
 334         -- Delete things that are hidden
 335         name_env2 = foldl del_avail name_env1 hides
 336
 337         -- Create the fixity env
 338         fixity_env = foldl (add_fixity name_env2) emptyFixityEnv fixities
 339
 340         -- Create the export-availability info
 341         export_avails = mkExportAvails qual_mod unqual_imp name_env2 avails
 342     in
 343     returnRn (RnEnv name_env2 fixity_env, export_avails)
 344   where
 345     qual_mod = case as_mod of
 346                   Nothing           -> this_mod
 347                   Just another_name -> another_name
 348
 349     add_avail :: GlobalNameEnv -> AvailInfo -> RnMG GlobalNameEnv
 350     add_avail env avail = foldlRn add_name env (availNames avail)
 351
 352     add_name env name   = add qual_imp   env  (Qual qual_mod occ err_hif) `thenRn` \ env1 ->
 353                           add unqual_imp env1 (Unqual occ)
 354                         where
 355                           add False env rdr_name = returnRn env
 356                           add True  env rdr_name = addOneToGlobalNameEnv env rdr_name (name, name_to_his name)
 357                           occ  = nameOccName name
 358
 359     del_avail env avail = foldl delOneFromGlobalNameEnv env rdr_names
 360                         where
 361                           rdr_names = map (Unqual . nameOccName) (availNames avail)
 362
 363     add_fixity name_env fix_env (occ_name, fixity)
 364         = add qual $ add unqual $ fix_env
 365         where
 366           qual   = Qual qual_mod occ_name err_hif
 367           unqual = Unqual occ_name
 368
 369           add rdr_name fix_env | maybeToBool (lookupFM name_env rdr_name)
 370                                = addOneToFixityEnv fix_env rdr_name fixity
 371                                | otherwise
 372                                = fix_env
 373
 374 err_hif = error "qualifyImports: hif"   -- Not needed in key to mapping
 375 \end{code}
 376
 377 unQualify adds an Unqual binding for every existing Qual binding.
 378
 379 \begin{code}
 380 unQualify :: FiniteMap RdrName elt -> FiniteMap RdrName elt
 381 unQualify fm = addListToFM fm [(Unqual occ, elt) | (Qual _ occ _, elt) <- fmToList fm]
 382 \end{code}
 383
 384 %************************************************************************
 385 %*                                                                      *
 386 \subsection{Local declarations}
 387 %*                                                                      *
 388 %************************************************************************
 389
 390
 391 \begin{code}
 392 fixityFromFixDecl :: RdrNameFixityDecl -> RnMG (OccName, (Fixity, HowInScope))
 393
 394 fixityFromFixDecl (FixityDecl rdr_name fixity loc)
 395   = returnRn (rdrNameOcc rdr_name, (fixity, FromLocalDefn loc))
 396 \end{code}
 397
 398
 399 %************************************************************************
 400 %*                                                                      *
 401 \subsection{Export list processing
 402 %*                                                                      *
 403 %************************************************************************
 404
 405 The @AvailEnv@ type is just used internally in @exportsFromAvail@.
 406 When exporting we need to combine the availabilities for a particular
 407 exported thing, and we also need to check for name clashes -- that
 408 is: two exported things must have different @OccNames@.
 409
 410 \begin{code}
 411 type AvailEnv = FiniteMap OccName (RdrNameIE, AvailInfo, Int{-no. of clashes-})
 412         -- The FM maps each OccName to the RdrNameIE that gave rise to it,
 413         -- for error reporting, as well as to its AvailInfo
 414
 415 emptyAvailEnv = emptyFM
 416
 417 {-
 418  Add new entry to environment. Checks for name clashes, i.e.,
 419  plain duplicates or exported entity pairs that have different OccNames.
 420  (c.f. 5.1.1 of Haskell 1.4 report.)
 421 -}
 422 addAvailEnv :: Bool -> RdrNameIE -> AvailEnv -> AvailInfo -> RnM s d AvailEnv
 423 addAvailEnv warn_dups ie env NotAvailable   = returnRn env
 424 addAvailEnv warn_dups ie env (AvailTC _ []) = returnRn env
 425 addAvailEnv warn_dups ie env avail
 426   | warn_dups = mapMaybeRn (addErrRn . availClashErr) () conflict `thenRn_`
 427                 returnRn (addToFM_C addAvail env key elt)
 428   | otherwise = returnRn (addToFM_C addAvail env key elt)
 429   where
 430    occ_avail = nameOccName (availName avail)
 431    occ_ie    = ieOcc ie
 432    key
 433     | not warn_dups || occ_ie == occ_avail = occ_avail
 434     | otherwise                            = occ_ie
 435         -- export item is a class method, use export occ name instead.
 436         -- (this is only needed to get more precise warnings about
 437         --  duplicates.)
 438    elt  = (ie,avail,reports_on)
 439
 440    reports_on
 441     | maybeToBool dup = 1
 442     | otherwise       = 0
 443
 444    conflict = conflictFM bad_avail env key elt
 445    dup
 446     | warn_dups = conflictFM dup_avail env key elt
 447     | otherwise = Nothing
 448
 449 addListToAvailEnv :: AvailEnv -> RdrNameIE -> [AvailInfo] -> RnM s d AvailEnv
 450 addListToAvailEnv env ie items
 451   = foldlRn (addAvailEnv False{-don't warn about dups-} ie) env items
 452
 453 bad_avail  (ie1,avail1,r1) (ie2,avail2,r2)
 454    = availName avail1 /= availName avail2  -- Same OccName, different Name
 455 dup_avail  (ie1,avail1,r1) (ie2,avail2,r2)
 456    = availName avail1 == availName avail2 -- Same OccName & avail.
 457
 458 addAvail (ie1,a1,r1) (ie2,a2,r2) = (ie1, a1 `plusAvail` a2, r1 + r2)
 459 \end{code}
 460
 461 Processing the export list.
 462
 463 You might think that we should record things that appear in the export list as
 464 ``occurrences'' (using addOccurrenceName), but you'd be wrong.  We do check (here)
 465 that they are in scope, but there is no need to slurp in their actual declaration
 466 (which is what addOccurrenceName forces).  Indeed, doing so would big trouble when
 467 compiling PrelBase, because it re-exports GHC, which includes takeMVar#, whose type
 468 includes ConcBase.StateAndSynchVar#, and so on...
 469
 470 \begin{code}
 471 exportsFromAvail :: Module
 472                  -> Maybe [RdrNameIE]   -- Export spec
 473                  -> ExportAvails
 474                  -> RnEnv
 475                  -> RnMG (Name -> ExportFlag, ExportEnv)
 476         -- Complains if two distinct exports have same OccName
 477         -- Warns about identical exports.
 478         -- Complains about exports items not in scope
 479 exportsFromAvail this_mod Nothing export_avails rn_env
 480   = exportsFromAvail this_mod (Just [IEModuleContents this_mod]) export_avails rn_env
 481
 482 exportsFromAvail this_mod (Just export_items)
 483                  (mod_avail_env, entity_avail_env)
 484                  (RnEnv global_name_env fixity_env)
 485   = checkForModuleExportDups export_items                 `thenRn` \ export_items' ->
 486     foldlRn exports_from_item emptyAvailEnv export_items' `thenRn` \ export_avail_env ->
 487     let
 488      dup_entries = fmToList (filterFM (\ _ (_,_,clashes) -> clashes > 0) export_avail_env)
 489     in
 490     mapRn (addWarnRn . dupExportWarn) dup_entries         `thenRn_`
 491     let
 492         export_avails   = map (\ (_,a,_) -> a) (eltsFM export_avail_env)
 493         export_fixities = mk_exported_fixities (availsToNameSet export_avails)
 494         export_fn       = mk_export_fn export_avails
 495     in
 496     returnRn (export_fn, ExportEnv export_avails export_fixities)
 497
 498   where
 499     exports_from_item :: AvailEnv -> RdrNameIE -> RnMG AvailEnv
 500     exports_from_item export_avail_env ie@(IEModuleContents mod)
 501         = case lookupFM mod_avail_env mod of
 502                 Nothing     -> failWithRn export_avail_env (modExportErr mod)
 503                 Just avails -> addListToAvailEnv export_avail_env ie avails
 504
 505     exports_from_item export_avail_env ie
 506         | not (maybeToBool maybe_in_scope)
 507         = failWithRn export_avail_env (unknownNameErr (ieName ie))
 508
 509 #ifdef DEBUG
 510         -- I can't see why this should ever happen; if the thing is in scope
 511         -- at all it ought to have some availability
 512         | not (maybeToBool maybe_avail)
 513         = pprTrace "exportsFromAvail: curious Nothing:" (ppr name)
 514           returnRn export_avail_env
 515 #endif
 516
 517         | not enough_avail
 518         = failWithRn export_avail_env (exportItemErr ie export_avail)
 519
 520         | otherwise     -- Phew!  It's OK!
 521         = addAvailEnv opt_WarnDuplicateExports ie export_avail_env export_avail
 522        where
 523           maybe_in_scope  = lookupFM global_name_env (ieName ie)
 524           Just (name,_)   = maybe_in_scope
 525           maybe_avail     = lookupUFM entity_avail_env name
 526           Just avail      = maybe_avail
 527           export_avail    = filterAvail ie avail
 528           enough_avail    = case export_avail of {NotAvailable -> False; other -> True}
 529
 530         -- We export a fixity iff we export a thing with the same (qualified) RdrName
 531     mk_exported_fixities :: NameSet -> [(OccName, Fixity)]
 532     mk_exported_fixities exports
 533         = fmToList (foldr (perhaps_add_fixity exports)
 534                           emptyFM
 535                           (fmToList fixity_env))
 536
 537     perhaps_add_fixity :: NameSet -> (RdrName, (Fixity, HowInScope))
 538                        -> FiniteMap OccName Fixity
 539                        -> FiniteMap OccName Fixity
 540     perhaps_add_fixity exports (rdr_name, (fixity, how_in_scope)) fix_env
 541       =  let
 542             do_nothing = fix_env                -- The default is to pass on the env unchanged
 543          in
 544                 -- Step 1: check whether the rdr_name is in scope; if so find its Name
 545          case lookupFM global_name_env rdr_name of {
 546            Nothing              -> do_nothing;
 547            Just (fixity_name,_) ->
 548
 549                 -- Step 2: check whether the fixity thing is exported
 550          if not (fixity_name `elemNameSet` exports) then
 551                 do_nothing
 552          else
 553
 554                 -- Step 3: check whether we already have a fixity for the
 555                 -- Name's OccName in the fix_env we are building up.  This can easily
 556                 -- happen.  the original fixity_env might contain bindings for
 557                 --      M.a and N.a, if a was imported via M and N.
 558                 -- If this does happen, we expect the fixity to be the same either way.
 559         let
 560             occ_name = rdrNameOcc rdr_name
 561         in
 562         case lookupFM fix_env occ_name of {
 563           Just fixity1 ->       -- Got it already
 564                            ASSERT( fixity == fixity1 )
 565                            do_nothing;
 566           Nothing ->
 567
 568                 -- Step 3: add it to the outgoing fix_env
 569         addToFM fix_env occ_name fixity
 570         }}
 571
 572 {- warn and weed out duplicate module entries from export list. -}
 573 checkForModuleExportDups :: [RdrNameIE] -> RnMG [RdrNameIE]
 574 checkForModuleExportDups ls
 575   | opt_WarnDuplicateExports = check_modules ls
 576   | otherwise                = returnRn ls
 577   where
 578    -- NOTE: reorders the export list by moving all module-contents
 579    -- exports to the end (removing duplicates in the process.)
 580    check_modules ls =
 581      (case dups of
 582         [] -> returnRn ()
 583         ls -> mapRn (\ ds@(IEModuleContents x:_) ->
 584                        addWarnRn (dupModuleExport x (length ds))) ls `thenRn_`
 585               returnRn ()) `thenRn_`
 586      returnRn (ls_no_modules ++ no_module_dups)
 587      where
 588       (ls_no_modules,modules) = foldr split_mods ([],[]) ls
 589
 590       split_mods i@(IEModuleContents _) (no_ms,ms) = (no_ms,i:ms)
 591       split_mods i (no_ms,ms) = (i:no_ms,ms)
 592
 593       (no_module_dups, dups) = removeDups cmp_mods modules
 594
 595       cmp_mods (IEModuleContents m1) (IEModuleContents m2) = m1 `compare` m2
 596
 597 mk_export_fn :: [AvailInfo] -> (Name -> ExportFlag)
 598 mk_export_fn avails
 599   = \name -> if name `elemNameSet` exported_names
 600              then Exported
 601              else NotExported
 602   where
 603     exported_names :: NameSet
 604     exported_names = availsToNameSet avails
 605 \end{code}
 606
 607 %************************************************************************
 608 %*                                                                      *
 609 \subsection{Errors}
 610 %*                                                                      *
 611 %************************************************************************
 612
 613 \begin{code}
 614 badImportItemErr mod ie
 615   = sep [ptext SLIT("Module"), quotes (pprModule mod),
 616          ptext SLIT("does not export"), quotes (ppr ie)]
 617
 618 dodgyImportWarn mod (IEThingAll tc)
 619   = sep [ptext SLIT("Module") <+> quotes (pprModule mod) <+> ptext SLIT("exports") <+> quotes (ppr tc),
 620          ptext SLIT("with no constructors/class operations;"),
 621          ptext SLIT("yet it is imported with a (..)")]
 622
 623 modExportErr mod
 624   = hsep [ ptext SLIT("Unknown module in export list: module"), quotes (pprModule mod)]
 625
 626 exportItemErr export_item NotAvailable
 627   = sep [ ptext SLIT("Export item not in scope:"), quotes (ppr export_item)]
 628
 629 exportItemErr export_item avail
 630   = hang (ptext SLIT("Export item not fully in scope:"))
 631            4 (vcat [hsep [ptext SLIT("Wanted:   "), ppr export_item],
 632                     hsep [ptext SLIT("Available:"), ppr (ieOcc export_item), pprAvail avail]])
 633
 634 availClashErr (occ_name, ((ie1,avail1,_), (ie2,avail2,_)))
 635   = hsep [ptext SLIT("The export items"), quotes (ppr ie1), ptext SLIT("and"), quotes (ppr ie2),
 636           ptext SLIT("create conflicting exports for"), quotes (ppr occ_name)]
 637
 638 dupExportWarn (occ_name, (_,_,times))
 639   = hsep [quotes (ppr occ_name),
 640           ptext SLIT("mentioned"), speakNTimes (times+1),
 641           ptext SLIT("in export list")]
 642
 643 dupModuleExport mod times
 644   = hsep [ptext SLIT("Module"), quotes (pprModule mod),
 645           ptext SLIT("mentioned"), speakNTimes times,
 646           ptext SLIT("in export list")]
 647 \end{code}
 648