ghc/compiler/rename/RnNames.lhs

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