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         rnImports, importsFromLocalDecls,
   9         rnExports,
  10         getLocalDeclBinders, extendRdrEnvRn,
  11         reportUnusedNames, reportDeprecations
  12     ) where
  13
  14 #include "HsVersions.h"
  15
  16 import DynFlags         ( DynFlag(..), GhcMode(..), DynFlags(..) )
  17 import HsSyn            ( IE(..), ieName, ImportDecl(..), LImportDecl,
  18                           ForeignDecl(..), HsGroup(..), HsValBinds(..),
  19                           Sig(..), collectHsBindLocatedBinders, tyClDeclNames,
  20                           instDeclATs, isIdxTyDecl,
  21                           LIE )
  22 import RnEnv
  23 import RnHsDoc          ( rnHsDoc )
  24 import IfaceEnv         ( ifaceExportNames )
  25 import LoadIface        ( loadSrcInterface )
  26 import TcRnMonad hiding (LIE)
  27
  28 import PrelNames
  29 import Module
  30 import Name
  31 import NameSet
  32 import NameEnv
  33 import OccName          ( srcDataName, isTcOcc, pprNonVarNameSpace,
  34                           occNameSpace,
  35                           OccEnv, mkOccEnv, lookupOccEnv, emptyOccEnv,
  36                           extendOccEnv )
  37 import HscTypes         ( GenAvailInfo(..), AvailInfo, availNames, availName,
  38                           HomePackageTable, PackageIfaceTable,
  39                           mkPrintUnqualified, availsToNameSet,
  40                           availsToNameEnv,
  41                           Deprecs(..), ModIface(..), Dependencies(..),
  42                           lookupIfaceByModule, ExternalPackageState(..)
  43                         )
  44 import RdrName          ( RdrName, rdrNameOcc, setRdrNameSpace,
  45                           GlobalRdrEnv, mkGlobalRdrEnv, GlobalRdrElt(..),
  46                           emptyGlobalRdrEnv, plusGlobalRdrEnv, globalRdrEnvElts,
  47                           extendGlobalRdrEnv, lookupGlobalRdrEnv, unQualOK, lookupGRE_Name,
  48                           Provenance(..), ImportSpec(..), ImpDeclSpec(..), ImpItemSpec(..),
  49                           importSpecLoc, importSpecModule, isLocalGRE, pprNameProvenance )
  50 import Outputable
  51 import UniqFM
  52 import Maybes
  53 import SrcLoc           ( Located(..), mkGeneralSrcSpan, getLoc,
  54                           unLoc, noLoc, srcLocSpan, SrcSpan )
  55 import FiniteMap
  56 import ErrUtils
  57 import BasicTypes       ( DeprecTxt )
  58 import DriverPhases     ( isHsBoot )
  59 import Util             ( notNull )
  60 import Data.List        ( nub, partition, concatMap )
  61 import IO               ( openFile, IOMode(..) )
  62 import Monad            ( when )
  63 \end{code}
  64
  65
  66
  67 %************************************************************************
  68 %*                                                                      *
  69                 rnImports
  70 %*                                                                      *
  71 %************************************************************************
  72
  73 \begin{code}
  74 rnImports :: [LImportDecl RdrName]
  75            -> RnM ([LImportDecl Name], GlobalRdrEnv, ImportAvails)
  76
  77 rnImports imports
  78          -- PROCESS IMPORT DECLS
  79          -- Do the non {- SOURCE -} ones first, so that we get a helpful
  80          -- warning for {- SOURCE -} ones that are unnecessary
  81     = do this_mod <- getModule
  82          implicit_prelude <- doptM Opt_ImplicitPrelude
  83          let all_imports               = mk_prel_imports this_mod implicit_prelude ++ imports
  84              (source, ordinary) = partition is_source_import all_imports
  85              is_source_import (L _ (ImportDecl _ is_boot _ _ _)) = is_boot
  86
  87          stuff1 <- mapM (rnImportDecl this_mod) ordinary
  88          stuff2 <- mapM (rnImportDecl this_mod) source
  89          let (decls, rdr_env, avails, imp_avails) = combine (stuff1 ++ stuff2)
  90          return (decls, rdr_env,
  91                  imp_avails{ imp_parent = availsToNameEnv (nubAvails avails) })
  92                     -- why wait until now to set the imp_parent, rather than
  93                     -- setting it in rnImportDecl for each import, and
  94                     -- combining them with plusImportAvails?  The reason is
  95                     -- that we need to combine all the AvailInfos *before*
  96                     -- we build the NameEnv, otherwise the NameEnv can
  97                     -- end up with inconsistencies, eg. the parent can say
  98                     -- C(m1,m2), but the entry for m2 might only say C(m2).
  99                     -- The test mod118 illustrates the bug.
 100     where
 101 -- NB: opt_NoImplicitPrelude is slightly different to import Prelude ();
 102 -- because the former doesn't even look at Prelude.hi for instance
 103 -- declarations, whereas the latter does.
 104    mk_prel_imports this_mod implicit_prelude
 105        |  this_mod == pRELUDE
 106           || explicit_prelude_import
 107           || not implicit_prelude
 108            = []
 109        | otherwise = [preludeImportDecl]
 110    explicit_prelude_import
 111        = notNull [ () | L _ (ImportDecl mod _ _ _ _) <- imports,
 112                    unLoc mod == pRELUDE_NAME ]
 113
 114    combine :: [(LImportDecl Name,  GlobalRdrEnv, [AvailInfo], ImportAvails)]
 115            -> ([LImportDecl Name], GlobalRdrEnv, [AvailInfo], ImportAvails)
 116    combine = foldr plus ([], emptyGlobalRdrEnv, [], emptyImportAvails)
 117         where plus (decl,  gbl_env1, avails1, imp_avails1)
 118                    (decls, gbl_env2, avails2, imp_avails2)
 119                 = (decl:decls,
 120                    gbl_env1 `plusGlobalRdrEnv` gbl_env2,
 121                    avails1 ++ avails2,
 122                    imp_avails1 `plusImportAvails` imp_avails2)
 123
 124 preludeImportDecl :: LImportDecl RdrName
 125 preludeImportDecl
 126   = L loc $
 127         ImportDecl (L loc pRELUDE_NAME)
 128                False {- Not a boot interface -}
 129                False    {- Not qualified -}
 130                Nothing  {- No "as" -}
 131                Nothing  {- No import list -}
 132   where
 133     loc = mkGeneralSrcSpan FSLIT("Implicit import declaration")
 134
 135
 136
 137 rnImportDecl  :: Module
 138               -> LImportDecl RdrName
 139               -> RnM (LImportDecl Name, GlobalRdrEnv,
 140                       [AvailInfo], ImportAvails)
 141
 142 rnImportDecl this_mod (L loc (ImportDecl loc_imp_mod_name want_boot
 143                                          qual_only as_mod imp_details))
 144   =
 145     setSrcSpan loc $ do
 146
 147         -- If there's an error in loadInterface, (e.g. interface
 148         -- file not found) we get lots of spurious errors from 'filterImports'
 149     let
 150         imp_mod_name = unLoc loc_imp_mod_name
 151         doc = ppr imp_mod_name <+> ptext SLIT("is directly imported")
 152
 153     iface <- loadSrcInterface doc imp_mod_name want_boot
 154
 155         -- Compiler sanity check: if the import didn't say
 156         -- {-# SOURCE #-} we should not get a hi-boot file
 157     WARN( not want_boot && mi_boot iface, ppr imp_mod_name ) $ do
 158
 159         -- Issue a user warning for a redundant {- SOURCE -} import
 160         -- NB that we arrange to read all the ordinary imports before
 161         -- any of the {- SOURCE -} imports
 162     warnIf (want_boot && not (mi_boot iface))
 163            (warnRedundantSourceImport imp_mod_name)
 164
 165     let
 166         imp_mod = mi_module iface
 167         deprecs = mi_deprecs iface
 168         is_orph = mi_orphan iface
 169         deps    = mi_deps iface
 170
 171         filtered_exports = filter not_this_mod (mi_exports iface)
 172         not_this_mod (mod,_) = mod /= this_mod
 173         -- If the module exports anything defined in this module, just
 174         -- ignore it.  Reason: otherwise it looks as if there are two
 175         -- local definition sites for the thing, and an error gets
 176         -- reported.  Easiest thing is just to filter them out up
 177         -- front. This situation only arises if a module imports
 178         -- itself, or another module that imported it.  (Necessarily,
 179         -- this invoves a loop.)
 180         --
 181         -- Tiresome consequence: if you say
 182         --      module A where
 183         --         import B( AType )
 184         --         type AType = ...
 185         --
 186         --      module B( AType ) where
 187         --         import {-# SOURCE #-} A( AType )
 188         --
 189         -- then you'll get a 'B does not export AType' message.  Oh well.
 190
 191         qual_mod_name = case as_mod of
 192                           Nothing           -> imp_mod_name
 193                           Just another_name -> another_name
 194         imp_spec  = ImpDeclSpec { is_mod = imp_mod_name, is_qual = qual_only,
 195                                   is_dloc = loc, is_as = qual_mod_name }
 196     -- in
 197
 198         -- Get the total exports from this module
 199     total_avails <- ifaceExportNames filtered_exports
 200
 201         -- filter the imports according to the import declaration
 202     (new_imp_details, filtered_avails, gbl_env) <-
 203         filterImports iface imp_spec imp_details total_avails
 204
 205     dflags <- getDOpts
 206
 207     let
 208         -- Compute new transitive dependencies
 209
 210         orphans | is_orph   = ASSERT( not (imp_mod `elem` dep_orphs deps) )
 211                               imp_mod : dep_orphs deps
 212                 | otherwise = dep_orphs deps
 213
 214         pkg = modulePackageId (mi_module iface)
 215
 216         (dependent_mods, dependent_pkgs)
 217            | pkg == thisPackage dflags =
 218                 -- Imported module is from the home package
 219                 -- Take its dependent modules and add imp_mod itself
 220                 -- Take its dependent packages unchanged
 221                 --
 222                 -- NB: (dep_mods deps) might include a hi-boot file
 223                 -- for the module being compiled, CM. Do *not* filter
 224                 -- this out (as we used to), because when we've
 225                 -- finished dealing with the direct imports we want to
 226                 -- know if any of them depended on CM.hi-boot, in
 227                 -- which case we should do the hi-boot consistency
 228                 -- check.  See LoadIface.loadHiBootInterface
 229                   ((imp_mod_name, want_boot) : dep_mods deps, dep_pkgs deps)
 230
 231            | otherwise =
 232                 -- Imported module is from another package
 233                 -- Dump the dependent modules
 234                 -- Add the package imp_mod comes from to the dependent packages
 235                  ASSERT2( not (pkg `elem` dep_pkgs deps), ppr pkg <+> ppr (dep_pkgs deps) )
 236                  ([], pkg : dep_pkgs deps)
 237
 238         -- True <=> import M ()
 239         import_all = case imp_details of
 240                         Just (is_hiding, ls) -> not is_hiding && null ls
 241                         other                -> False
 242
 243         imports   = ImportAvails {
 244                         imp_env      = unitUFM qual_mod_name filtered_avails,
 245                         imp_mods     = unitModuleEnv imp_mod (imp_mod, import_all, loc),
 246                         imp_orphs    = orphans,
 247                         imp_dep_mods = mkModDeps dependent_mods,
 248                         imp_dep_pkgs = dependent_pkgs,
 249                         imp_parent   = emptyNameEnv
 250                    }
 251
 252     -- in
 253
 254         -- Complain if we import a deprecated module
 255     ifOptM Opt_WarnDeprecations (
 256        case deprecs of
 257           DeprecAll txt -> addWarn (moduleDeprec imp_mod_name txt)
 258           other         -> returnM ()
 259      )
 260
 261     let new_imp_decl = L loc (ImportDecl loc_imp_mod_name want_boot
 262                                          qual_only as_mod new_imp_details)
 263
 264     returnM (new_imp_decl, gbl_env, filtered_avails, imports)
 265
 266 warnRedundantSourceImport mod_name
 267   = ptext SLIT("Unnecessary {-# SOURCE #-} in the import of module")
 268           <+> quotes (ppr mod_name)
 269 \end{code}
 270
 271
 272 %************************************************************************
 273 %*                                                                      *
 274                 importsFromLocalDecls
 275 %*                                                                      *
 276 %************************************************************************
 277
 278 From the top-level declarations of this module produce
 279         * the lexical environment
 280         * the ImportAvails
 281 created by its bindings.
 282
 283 Complain about duplicate bindings
 284
 285 \begin{code}
 286 importsFromLocalDecls :: HsGroup RdrName -> RnM TcGblEnv
 287 importsFromLocalDecls group
 288   = do  { gbl_env  <- getGblEnv
 289
 290         ; avails <- getLocalDeclBinders gbl_env group
 291
 292         ; implicit_prelude <- doptM Opt_ImplicitPrelude
 293         ; let {
 294             -- Optimisation: filter out names for built-in syntax
 295             -- They just clutter up the environment (esp tuples), and the parser
 296             -- will generate Exact RdrNames for them, so the cluttered
 297             -- envt is no use.  To avoid doing this filter all the time,
 298             -- we use -fno-implicit-prelude as a clue that the filter is
 299             -- worth while.  Really, it's only useful for GHC.Base and GHC.Tuple.
 300             --
 301             -- It's worth doing because it makes the environment smaller for
 302             -- every module that imports the Prelude
 303             --
 304             -- Note: don't filter the gbl_env (hence all_names, not filered_all_names
 305             -- in defn of gres above).      Stupid reason: when parsing
 306             -- data type decls, the constructors start as Exact tycon-names,
 307             -- and then get turned into data con names by zapping the name space;
 308             -- but that stops them being Exact, so they get looked up.
 309             -- Ditto in fixity decls; e.g.      infix 5 :
 310             -- Sigh. It doesn't matter because it only affects the Data.Tuple really.
 311             -- The important thing is to trim down the exports.
 312               names = concatMap availNames avails;
 313
 314               filtered_avails
 315                 | implicit_prelude = avails
 316                 | otherwise        = filterAvails (not.isBuiltInSyntax) avails;
 317
 318             ; this_mod = tcg_mod gbl_env
 319             ; imports = emptyImportAvails {
 320                           imp_env = unitUFM (moduleName this_mod)
 321                                         filtered_avails,
 322                           imp_parent = availsToNameEnv avails
 323                         }
 324             }
 325
 326         ; rdr_env' <- extendRdrEnvRn (tcg_rdr_env gbl_env) names
 327
 328         ; traceRn (text "local avails: " <> ppr avails)
 329
 330         ; returnM (gbl_env { tcg_rdr_env = rdr_env',
 331                              tcg_imports = imports `plusImportAvails` tcg_imports gbl_env })
 332         }
 333
 334 extendRdrEnvRn :: GlobalRdrEnv -> [Name] -> RnM GlobalRdrEnv
 335 -- Add the new locally-bound names one by one, checking for duplicates as
 336 -- we do so.  Remember that in Template Haskell the duplicates
 337 -- might *already be* in the GlobalRdrEnv from higher up the module
 338 extendRdrEnvRn rdr_env names
 339   = foldlM add_local rdr_env names
 340   where
 341     add_local rdr_env name
 342         | gres <- lookupGlobalRdrEnv rdr_env (nameOccName name)
 343         , (dup_gre:_) <- filter isLocalGRE gres -- Check for existing *local* defns
 344         = do { addDupDeclErr (gre_name dup_gre) name
 345              ; return rdr_env }
 346         | otherwise
 347         = return (extendGlobalRdrEnv rdr_env new_gre)
 348         where
 349           new_gre = GRE {gre_name = name, gre_prov = LocalDef}
 350 \end{code}
 351
 352 @getLocalDeclBinders@ returns the names for an @HsDecl@.  It's
 353 used for source code.
 354
 355         *** See "THE NAMING STORY" in HsDecls ****
 356
 357 Instances of indexed types
 358 ~~~~~~~~~~~~~~~~~~~~~~~~~~
 359 Indexed data/newtype instances contain data constructors that we need to
 360 collect, too.  Moreover, we need to descend into the data/newtypes instances
 361 of associated families.
 362
 363 We need to be careful with the handling of the type constructor of each type
 364 instance as the family constructor is already defined, and we want to avoid
 365 raising a duplicate declaration error.  So, we make a new name for it, but
 366 don't return it in the 'AvailInfo'.
 367
 368 \begin{code}
 369 getLocalDeclBinders :: TcGblEnv -> HsGroup RdrName -> RnM [AvailInfo]
 370 getLocalDeclBinders gbl_env (HsGroup {hs_valds = ValBindsIn val_decls val_sigs,
 371                                       hs_tyclds = tycl_decls,
 372                                       hs_instds = inst_decls,
 373                                       hs_fords = foreign_decls })
 374   = do  { tc_names_s <- mappM new_tc tycl_decls
 375         ; at_names_s <- mappM inst_ats inst_decls
 376         ; val_names  <- mappM new_simple val_bndrs
 377         ; return (val_names ++ tc_names_s ++ concat at_names_s) }
 378   where
 379     mod        = tcg_mod gbl_env
 380     is_hs_boot = isHsBoot (tcg_src gbl_env) ;
 381     val_bndrs | is_hs_boot = sig_hs_bndrs
 382               | otherwise  = for_hs_bndrs ++ val_hs_bndrs
 383         -- In a hs-boot file, the value binders come from the
 384         --  *signatures*, and there should be no foreign binders
 385
 386     new_simple rdr_name = do
 387         nm <- newTopSrcBinder mod rdr_name
 388         return (Avail nm)
 389
 390     sig_hs_bndrs = [nm | L _ (TypeSig nm _) <- val_sigs]
 391     val_hs_bndrs = collectHsBindLocatedBinders val_decls
 392     for_hs_bndrs = [nm | L _ (ForeignImport nm _ _) <- foreign_decls]
 393
 394     new_tc tc_decl
 395       | isIdxTyDecl (unLoc tc_decl)
 396         = do { main_name <- lookupFamInstDeclBndr mod main_rdr
 397              ; sub_names <- mappM (newTopSrcBinder mod) sub_rdrs
 398              ; return (AvailTC main_name sub_names) }
 399                         -- main_name is not bound here!
 400       | otherwise
 401         = do { main_name <- newTopSrcBinder mod main_rdr
 402              ; sub_names <- mappM (newTopSrcBinder mod) sub_rdrs
 403              ; return (AvailTC main_name (main_name : sub_names)) }
 404       where
 405         (main_rdr : sub_rdrs) = tyClDeclNames (unLoc tc_decl)
 406
 407     inst_ats inst_decl
 408         = mappM new_tc (instDeclATs (unLoc inst_decl))
 409 \end{code}
 410
 411
 412 %************************************************************************
 413 %*                                                                      *
 414 \subsection{Filtering imports}
 415 %*                                                                      *
 416 %************************************************************************
 417
 418 @filterImports@ takes the @ExportEnv@ telling what the imported module makes
 419 available, and filters it through the import spec (if any).
 420
 421 \begin{code}
 422 filterImports :: ModIface
 423               -> ImpDeclSpec                    -- The span for the entire import decl
 424               -> Maybe (Bool, [LIE RdrName])    -- Import spec; True => hiding
 425               -> [AvailInfo]                    -- What's available
 426               -> RnM (Maybe (Bool, [LIE Name]), -- Import spec w/ Names
 427                       [AvailInfo],              -- What's imported
 428                       GlobalRdrEnv)             -- Same again, but in GRE form
 429
 430 filterImports iface decl_spec Nothing all_avails
 431   = return (Nothing, all_avails, mkGenericRdrEnv decl_spec all_avails)
 432
 433 filterImports iface decl_spec (Just (want_hiding, import_items)) all_avails
 434   = do
 435         -- check for errors, convert RdrNames to Names
 436         opt_indexedtypes <- doptM Opt_IndexedTypes
 437         items1 <- mapM (lookup_lie opt_indexedtypes) import_items
 438
 439         let -- build the AvailInfo corresponding to each import item.
 440             items2 = [ (ie, filterAvailByIE (unLoc ie) av)
 441                      | (ie,av) <- concat items1 ]
 442
 443             -- eliminate duplicates
 444             avails = nubAvails (map snd items2)
 445
 446             -- the new import spec, with Names instead of RdrNames
 447             imp_spec_out = Just (want_hiding, map fst items2)
 448
 449         case want_hiding of
 450           True ->
 451             let
 452                keep n = not (n `elemNameSet` availsToNameSet avails)
 453                pruned_avails = filterAvails keep all_avails
 454             in do
 455             traceRn (text "pruned_avails: " <> ppr pruned_avails)
 456             return (imp_spec_out, pruned_avails,
 457                     mkGenericRdrEnv decl_spec pruned_avails)
 458
 459           False ->
 460             let
 461                 gres = concat [ mkGlobalRdrEltsFromIE decl_spec lie avail
 462                               | (lie, avail) <- items2 ]
 463             in do
 464             traceRn (text "imported avails: " <> ppr avails)
 465             return (imp_spec_out, avails, mkGlobalRdrEnv gres)
 466   where
 467         -- This environment is how we map names mentioned in the import
 468         -- list to the actual Name they correspond to, and the family
 469         -- that the Name belongs to (an AvailInfo).
 470         --
 471         -- This env will have entries for data constructors too,
 472         -- they won't make any difference because naked entities like T
 473         -- in an import list map to TcOccs, not VarOccs.
 474     occ_env :: OccEnv (Name,AvailInfo)
 475     occ_env = mkOccEnv [ (nameOccName n, (n,a))
 476                        | a <- all_avails, n <- availNames a ]
 477
 478     lookup_lie :: Bool -> LIE RdrName -> TcRn [(LIE Name, AvailInfo)]
 479     lookup_lie opt_indexedtypes (L loc ieRdr)
 480         = do
 481              stuff <- setSrcSpan loc $
 482                          case lookup_ie opt_indexedtypes ieRdr of
 483                             Failed err  -> addErr err >> return []
 484                             Succeeded a -> return a
 485              checkDodgyImport stuff
 486              return [ (L loc ie, avail) | (ie,avail) <- stuff ]
 487         where
 488                 -- warn when importing T(..) if T was exported absgtractly
 489             checkDodgyImport stuff
 490                 | IEThingAll n <- ieRdr, (_, AvailTC _ [one]):_ <- stuff
 491                 = ifOptM Opt_WarnDodgyImports (addWarn (dodgyImportWarn n))
 492                 -- NB. use the RdrName for reporting the warning
 493             checkDodgyImport _
 494                 = return ()
 495
 496         -- For each import item, we convert its RdrNames to Names,
 497         -- and at the same time construct an AvailInfo corresponding
 498         -- to what is actually imported by this item.
 499         -- Returns Nothing on error.
 500         -- We return a list here, because in the case of an import
 501         -- item like C, if we are hiding, then C refers to *both* a
 502         -- type/class and a data constructor.
 503     lookup_ie :: Bool -> IE RdrName -> MaybeErr Message [(IE Name,AvailInfo)]
 504     lookup_ie opt_indexedtypes ie
 505       = let bad_ie = Failed (badImportItemErr iface decl_spec ie)
 506
 507             lookup_name rdrName =
 508                 case lookupOccEnv occ_env (rdrNameOcc rdrName) of
 509                    Nothing -> bad_ie
 510                    Just n  -> return n
 511         in
 512         case ie of
 513          IEVar n -> do
 514              (name,avail) <- lookup_name n
 515              return [(IEVar name, avail)]
 516
 517          IEThingAll tc -> do
 518              (name,avail) <- lookup_name tc
 519              return [(IEThingAll name, avail)]
 520
 521          IEThingAbs tc
 522              | want_hiding   -- hiding ( C )
 523                         -- Here the 'C' can be a data constructor
 524                         --  *or* a type/class, or even both
 525              -> let tc_name = lookup_name tc
 526                     dc_name = lookup_name (setRdrNameSpace tc srcDataName)
 527                 in
 528                 case catMaybeErr [ tc_name, dc_name ] of
 529                   []    -> bad_ie
 530                   names -> return [ (IEThingAbs n, av) | (n,av) <- names ]
 531              | otherwise
 532              -> do (name,avail) <- lookup_name tc
 533                    return [(IEThingAbs name, avail)]
 534
 535          IEThingWith n ns -> do
 536             (name,avail) <- lookup_name n
 537             case avail of
 538                 AvailTC nm subnames | nm == name -> do
 539                      let env = mkOccEnv [ (nameOccName s, s)
 540                                         | s <- subnames ]
 541                      let mb_children = map (lookupOccEnv env . rdrNameOcc) ns
 542                      children <-
 543                         if any isNothing mb_children
 544                           then bad_ie
 545                           else return (catMaybes mb_children)
 546                         -- check for proper import of indexed types
 547                      when (not opt_indexedtypes && any isTyConName children) $
 548                         Failed (typeItemErr (head . filter isTyConName
 549                                                 $ children )
 550                                      (text "in import list"))
 551                      return [(IEThingWith name children, avail)]
 552                 _otherwise -> bad_ie
 553
 554          _other -> Failed illegalImportItemErr
 555          -- could be IEModuleContents, IEGroup, IEDoc, IEDocNamed
 556          -- all errors.
 557
 558 catMaybeErr :: [MaybeErr err a] -> [a]
 559 catMaybeErr ms =  [ a | Succeeded a <- ms ]
 560 \end{code}
 561
 562 %************************************************************************
 563 %*                                                                      *
 564         Import/Export Utils
 565 %*                                                                      *
 566 %************************************************************************
 567
 568 \begin{code}
 569 -- | make a 'GlobalRdrEnv' where all the elements point to the same
 570 -- import declaration (useful for "hiding" imports, or imports with
 571 -- no details).
 572 mkGenericRdrEnv decl_spec avails
 573   = mkGlobalRdrEnv [ GRE { gre_name = name, gre_prov = Imported [imp_spec] }
 574                    | name <- concatMap availNames avails ]
 575   where
 576     imp_spec = ImpSpec { is_decl = decl_spec, is_item = ImpAll }
 577
 578
 579 -- | filters an 'AvailInfo' by the given import/export spec.
 580 filterAvailByIE :: IE Name -> AvailInfo -> AvailInfo
 581 filterAvailByIE (IEVar n)          a@(Avail _)         = a
 582 filterAvailByIE (IEVar n)          a@(AvailTC tc subs) = AvailTC tc [n]
 583 filterAvailByIE (IEThingAbs n)     a@(AvailTC _ _)     = AvailTC n [n]
 584 filterAvailByIE (IEThingAll n)     a@(AvailTC tc subs) = a
 585 filterAvailByIE (IEThingWith n ns) a@(AvailTC tc subs) =
 586         AvailTC tc (filter (`elem` (n:ns)) subs)
 587 filterAvailByIE _ _  = panic "filterAvailByIE"
 588
 589 -- | filters 'AvailInfo's by the given predicate
 590 filterAvails  :: (Name -> Bool) -> [AvailInfo] -> [AvailInfo]
 591 filterAvails keep avails = foldr (filterAvail keep) [] avails
 592
 593 -- | filters an 'AvailInfo' by the given predicate
 594 filterAvail :: (Name -> Bool) -> AvailInfo -> [AvailInfo] -> [AvailInfo]
 595 filterAvail keep ie rest =
 596   case ie of
 597     Avail n | keep n    -> ie : rest
 598             | otherwise -> rest
 599     AvailTC tc ns ->
 600         let left = filter keep ns in
 601         if null left then rest else AvailTC tc left : rest
 602
 603 -- | combines 'AvailInfo's from the same family
 604 nubAvails :: [AvailInfo] -> [AvailInfo]
 605 nubAvails avails = nameEnvElts (foldr add emptyNameEnv avails)
 606  where
 607    add avail env = extendNameEnv_C comb_avails env (availName avail) avail
 608    comb_avails (AvailTC tc subs1) (AvailTC _ subs2)
 609                 = AvailTC tc (nub (subs1 ++ subs2))
 610    comb_avails avail _ = avail
 611
 612 -- | Given an import/export spec, construct the appropriate 'GlobalRdrElt's.
 613 mkGlobalRdrEltsFromIE :: ImpDeclSpec -> LIE Name -> AvailInfo -> [GlobalRdrElt]
 614 mkGlobalRdrEltsFromIE decl_spec (L loc ie) avail =
 615   case ie of
 616      IEVar name ->
 617         [mk_explicit_gre name]
 618      IEThingAbs name ->
 619         [mk_explicit_gre name]
 620      IEThingAll name | AvailTC _ subs <- avail ->
 621         mk_explicit_gre name : map mk_implicit_gre subs
 622      IEThingWith name subs ->
 623         mk_explicit_gre name : map mk_explicit_gre subs
 624      _ ->
 625         panic "mkGlobalRdrEltsFromIE"
 626   where
 627         mk_explicit_gre = mk_gre True
 628         mk_implicit_gre = mk_gre False
 629
 630         mk_gre explicit name = GRE { gre_name = name,
 631                                      gre_prov = Imported [imp_spec] }
 632           where
 633             imp_spec  = ImpSpec { is_decl = decl_spec, is_item = item_spec }
 634             item_spec = ImpSome { is_explicit = explicit, is_iloc = loc }
 635 \end{code}
 636
 637
 638 %************************************************************************
 639 %*                                                                      *
 640 \subsection{Export list processing}
 641 %*                                                                      *
 642 %************************************************************************
 643
 644 Processing the export list.
 645
 646 You might think that we should record things that appear in the export
 647 list as ``occurrences'' (using @addOccurrenceName@), but you'd be
 648 wrong.  We do check (here) that they are in scope, but there is no
 649 need to slurp in their actual declaration (which is what
 650 @addOccurrenceName@ forces).
 651
 652 Indeed, doing so would big trouble when compiling @PrelBase@, because
 653 it re-exports @GHC@, which includes @takeMVar#@, whose type includes
 654 @ConcBase.StateAndSynchVar#@, and so on...
 655
 656 \begin{code}
 657 type ExportAccum        -- The type of the accumulating parameter of
 658                         -- the main worker function in rnExports
 659      = ([LIE Name],             -- export items with Names
 660         ExportOccMap,           -- Tracks exported occurrence names
 661         [AvailInfo])            -- The accumulated exported stuff
 662 emptyExportAccum = ([], emptyOccEnv, [])
 663
 664 type ExportOccMap = OccEnv (Name, IE RdrName)
 665         -- Tracks what a particular exported OccName
 666         --   in an export list refers to, and which item
 667         --   it came from.  It's illegal to export two distinct things
 668         --   that have the same occurrence name
 669
 670 rnExports :: Bool    -- False => no 'module M(..) where' header at all
 671           -> Maybe [LIE RdrName]        -- Nothing => no explicit export list
 672           -> RnM (Maybe [LIE Name], [AvailInfo])
 673
 674         -- Complains if two distinct exports have same OccName
 675         -- Warns about identical exports.
 676         -- Complains about exports items not in scope
 677
 678 rnExports explicit_mod exports
 679  = do TcGblEnv { tcg_mod = this_mod,
 680                  tcg_rdr_env = rdr_env,
 681                  tcg_imports = imports } <- getGblEnv
 682
 683         -- If the module header is omitted altogether, then behave
 684         -- as if the user had written "module Main(main) where..."
 685         -- EXCEPT in interactive mode, when we behave as if he had
 686         -- written "module Main where ..."
 687         -- Reason: don't want to complain about 'main' not in scope
 688         --         in interactive mode
 689       ghc_mode <- getGhcMode
 690       real_exports <-
 691           case () of
 692             () | explicit_mod
 693                    -> return exports
 694                | ghc_mode == Interactive
 695                    -> return Nothing
 696                | otherwise
 697                    -> do mainName <- lookupGlobalOccRn main_RDR_Unqual
 698                          return (Just ([noLoc (IEVar main_RDR_Unqual)]))
 699                 -- ToDo: the 'noLoc' here is unhelpful if 'main' turns
 700                 -- out to be out of scope
 701
 702       (exp_spec, avails) <- exports_from_avail real_exports rdr_env
 703                                 imports this_mod
 704       return (exp_spec, nubAvails avails)
 705                         -- combine families
 706
 707 exports_from_avail :: Maybe [LIE RdrName]
 708                          -- Nothing => no explicit export list
 709                    -> GlobalRdrEnv
 710                    -> ImportAvails
 711                    -> Module
 712                    -> RnM (Maybe [LIE Name], [AvailInfo])
 713
 714 exports_from_avail Nothing rdr_env imports this_mod
 715  = -- the same as (module M) where M is the current module name,
 716    -- so that's how we handle it.
 717    let
 718        names  = [ gre_name gre | gre <- globalRdrEnvElts rdr_env,
 719                                  isLocalGRE gre ]
 720        avails = map (lookupNameEnv_NF (imp_parent imports)) names
 721    in
 722    return (Nothing, avails)
 723
 724 exports_from_avail (Just rdr_items) rdr_env imports this_mod
 725   = do traceRn (text "parent: " <> ppr (imp_parent imports))
 726        (ie_names, _, exports) <- foldlM do_litem emptyExportAccum rdr_items
 727        return (Just ie_names, exports)
 728   where
 729     do_litem :: ExportAccum -> LIE RdrName -> RnM ExportAccum
 730     do_litem acc lie = setSrcSpan (getLoc lie) (exports_from_item acc lie)
 731
 732     exports_from_item :: ExportAccum -> LIE RdrName -> RnM ExportAccum
 733     exports_from_item acc@(ie_names, occs, exports)
 734                         (L loc ie@(IEModuleContents mod))
 735         | mod `elem` mods       -- Duplicate export of M
 736         = do { warn_dup_exports <- doptM Opt_WarnDuplicateExports ;
 737                warnIf warn_dup_exports (dupModuleExport mod) ;
 738                returnM acc }
 739
 740         | otherwise
 741         = case lookupUFM (imp_env imports) mod of
 742             Nothing -> do addErr (modExportErr mod)
 743                           return acc
 744             Just avails
 745                 -> do traceRn (text "mod avails: " <> ppr mod <+> ppr avails)
 746                       let avails'  = filterAvails (inScopeUnqual rdr_env) $
 747                                         nubAvails avails
 748                           new_exps = concatMap availNames avails'
 749
 750                       occs' <- check_occs ie occs new_exps
 751                       -- This check_occs not only finds conflicts
 752                       -- between this item and others, but also
 753                       -- internally within this item.  That is, if
 754                       -- 'M.x' is in scope in several ways, we'll have
 755                       -- several members of mod_avails with the same
 756                       -- OccName.
 757                       return (L loc (IEModuleContents mod) : ie_names,
 758                               occs', avails' ++ exports)
 759         where
 760            mods = [ mod | (L _ (IEModuleContents mod)) <- ie_names ]
 761
 762     exports_from_item acc@(lie_names, occs, exports) (L loc ie)
 763         = do new_ie <- lookup_ie ie
 764              let ie_name = ieName new_ie
 765              if isUnboundName ie_name
 766                   then return acc       -- Avoid error cascade
 767                   else do
 768              if isDoc new_ie           -- deal with docs
 769                   then return (L loc new_ie : lie_names, occs, exports)
 770                   else do
 771              traceRn (text "lookup_avail: " <> ppr (lookup_avail ie_name))
 772              let avail = filterAvailByIE new_ie (lookup_avail ie_name)
 773                  new_exports = case new_ie of
 774                                      IEThingWith n ns -> n : ns
 775                                      _ -> availNames avail
 776                           -- ^^^ an IEThingWith might contain duplicates
 777                           -- whereas the avail doesn't, but we want
 778                           -- duplicates to be noticed by check_occs below.
 779              -- checkErr (not (null (drop 1 new_exports))) (exportItemErr ie)
 780              checkForDodgyExport new_ie new_exports
 781              occs' <- check_occs ie occs new_exports
 782              return (L loc new_ie : lie_names, occs', avail : exports)
 783
 784     lookup_avail :: Name -> AvailInfo
 785     lookup_avail name =
 786         case lookupNameEnv avail_env name of
 787              Nothing -> pprPanic "rnExports:lookup_avail" (ppr name)
 788              Just a  -> a
 789         where avail_env = imp_parent imports
 790
 791     lookup_ie :: IE RdrName -> RnM (IE Name)
 792
 793     lookup_ie (IEVar rdr)
 794         = do name <- lookupGlobalOccRn rdr
 795              return (IEVar name)
 796
 797     lookup_ie (IEThingAbs rdr)
 798         = do name <- lookupGlobalOccRn rdr
 799              return (IEThingAbs name)
 800
 801     lookup_ie (IEThingAll rdr)
 802         = do name <- lookupGlobalOccRn rdr
 803              return (IEThingAll name)
 804
 805     lookup_ie ie@(IEThingWith rdr sub_rdrs)
 806         = do name <- lookupGlobalOccRn rdr
 807              if isUnboundName name
 808                 then return (IEThingWith name [])
 809                 else do
 810              let avail = lookup_avail name
 811                  env = mkOccEnv [ (nameOccName s, s)
 812                                 | AvailTC _ subnames <- [avail],
 813                                   s <- subnames ]
 814              let mb_names = map (lookupOccEnv env . rdrNameOcc) sub_rdrs
 815              if any isNothing mb_names
 816                 then do addErr (exportItemErr ie)
 817                         return (IEThingWith name [])
 818                 else do let names = catMaybes mb_names
 819                         optIdxTypes <- doptM Opt_IndexedTypes
 820                         when (not optIdxTypes && any isTyConName names) $
 821                           addErr (typeItemErr ( head
 822                                               . filter isTyConName
 823                                               $ names )
 824                                               (text "in export list"))
 825                         return (IEThingWith name (catMaybes mb_names))
 826
 827     lookup_ie (IEGroup lev doc)
 828         = do rn_doc <- rnHsDoc doc
 829              return (IEGroup lev rn_doc)
 830     lookup_ie (IEDoc doc)
 831         = do rn_doc <- rnHsDoc doc
 832              return (IEDoc rn_doc)
 833     lookup_ie (IEDocNamed str)
 834         = return (IEDocNamed str)
 835
 836     lookup_ie (IEModuleContents _)
 837         = panic "rnExports:lookup_ie" -- caught earlier
 838
 839
 840 isDoc (IEDoc _)      = True
 841 isDoc (IEDocNamed _) = True
 842 isDoc (IEGroup _ _)  = True
 843 isDoc _ = False
 844
 845 -------------------------------
 846 inScopeUnqual :: GlobalRdrEnv -> Name -> Bool
 847 -- Checks whether the Name is in scope unqualified,
 848 -- regardless of whether it's ambiguous or not
 849 inScopeUnqual env n = any unQualOK (lookupGRE_Name env n)
 850
 851 -------------------------------
 852 checkForDodgyExport :: IE Name -> [Name] -> RnM ()
 853 checkForDodgyExport ie@(IEThingAll tc) [n]
 854   | isTcOcc (nameOccName n) = addWarn (dodgyExportWarn tc)
 855         -- This occurs when you export T(..), but
 856         -- only import T abstractly, or T is a synonym.
 857         -- The single [n] is the type or class itself
 858   | otherwise = addErr (exportItemErr ie)
 859         -- This happes if you export x(..), which is bogus
 860 checkForDodgyExport _ _ = return ()
 861
 862 -------------------------------
 863 check_occs :: IE RdrName -> ExportOccMap -> [Name] -> RnM ExportOccMap
 864 check_occs ie occs names
 865   = foldlM check occs names
 866   where
 867     check occs name
 868       = case lookupOccEnv occs name_occ of
 869           Nothing -> returnM (extendOccEnv occs name_occ (name, ie))
 870
 871           Just (name', ie')
 872             | name == name'     -- Duplicate export
 873             ->  do { warn_dup_exports <- doptM Opt_WarnDuplicateExports ;
 874                      warnIf warn_dup_exports (dupExportWarn name_occ ie ie') ;
 875                      returnM occs }
 876
 877             | otherwise         -- Same occ name but different names: an error
 878             ->  do { global_env <- getGlobalRdrEnv ;
 879                      addErr (exportClashErr global_env name' name ie' ie) ;
 880                      returnM occs }
 881       where
 882         name_occ = nameOccName name
 883 \end{code}
 884
 885 %*********************************************************
 886 %*                                                       *
 887                 Deprecations
 888 %*                                                       *
 889 %*********************************************************
 890
 891 \begin{code}
 892 reportDeprecations :: DynFlags -> TcGblEnv -> RnM ()
 893 reportDeprecations dflags tcg_env
 894   = ifOptM Opt_WarnDeprecations $
 895     do  { (eps,hpt) <- getEpsAndHpt
 896                 -- By this time, typechecking is complete,
 897                 -- so the PIT is fully populated
 898         ; mapM_ (check hpt (eps_PIT eps)) all_gres }
 899   where
 900     used_names = allUses (tcg_dus tcg_env)
 901         -- Report on all deprecated uses; hence allUses
 902     all_gres   = globalRdrEnvElts (tcg_rdr_env tcg_env)
 903
 904     avail_env = imp_parent (tcg_imports tcg_env)
 905
 906     check hpt pit (GRE {gre_name = name, gre_prov = Imported (imp_spec:_)})
 907       | name `elemNameSet` used_names
 908       , Just deprec_txt <- lookupDeprec dflags hpt pit avail_env name
 909       = addWarnAt (importSpecLoc imp_spec)
 910                   (sep [ptext SLIT("Deprecated use of") <+>
 911                         pprNonVarNameSpace (occNameSpace (nameOccName name)) <+>
 912                         quotes (ppr name),
 913                       (parens imp_msg) <> colon,
 914                       (ppr deprec_txt) ])
 915         where
 916           name_mod = nameModule name
 917           imp_mod  = importSpecModule imp_spec
 918           imp_msg  = ptext SLIT("imported from") <+> ppr imp_mod <> extra
 919           extra | imp_mod == moduleName name_mod = empty
 920                 | otherwise = ptext SLIT(", but defined in") <+> ppr name_mod
 921
 922     check hpt pit ok_gre = returnM ()   -- Local, or not used, or not deprectated
 923             -- The Imported pattern-match: don't deprecate locally defined names
 924             -- For a start, we may be exporting a deprecated thing
 925             -- Also we may use a deprecated thing in the defn of another
 926             -- deprecated things.  We may even use a deprecated thing in
 927             -- the defn of a non-deprecated thing, when changing a module's
 928             -- interface
 929
 930 lookupDeprec :: DynFlags -> HomePackageTable -> PackageIfaceTable
 931              -> NameEnv AvailInfo       -- parent info
 932              -> Name -> Maybe DeprecTxt
 933 lookupDeprec dflags hpt pit avail_env n
 934   = case lookupIfaceByModule dflags hpt pit (nameModule n) of
 935         Just iface -> mi_dep_fn iface n `seqMaybe`      -- Bleat if the thing, *or
 936                       mi_dep_fn iface (nameParent n)    -- its parent*, is deprec'd
 937         Nothing
 938           | isWiredInName n -> Nothing
 939                 -- We have not necessarily loaded the .hi file for a
 940                 -- wired-in name (yet), although we *could*.
 941                 -- And we never deprecate them
 942
 943          | otherwise -> pprPanic "lookupDeprec" (ppr n)
 944                 -- By now all the interfaces should have been loaded
 945   where
 946         nameParent n = case lookupNameEnv avail_env n of
 947                          Just (AvailTC parent _) -> parent
 948                          _ -> n
 949
 950 gre_is_used :: NameSet -> GlobalRdrElt -> Bool
 951 gre_is_used used_names gre = gre_name gre `elemNameSet` used_names
 952 \end{code}
 953
 954 %*********************************************************
 955 %*                                                       *
 956                 Unused names
 957 %*                                                       *
 958 %*********************************************************
 959
 960 \begin{code}
 961 reportUnusedNames :: Maybe [LIE RdrName]        -- Export list
 962                   -> TcGblEnv -> RnM ()
 963 reportUnusedNames export_decls gbl_env
 964   = do  { traceRn ((text "RUN") <+> (ppr (tcg_dus gbl_env)))
 965         ; warnUnusedTopBinds   unused_locals
 966         ; warnUnusedModules    unused_imp_mods
 967         ; warnUnusedImports    unused_imports
 968         ; warnDuplicateImports defined_and_used
 969         ; printMinimalImports  minimal_imports }
 970   where
 971     used_names, all_used_names :: NameSet
 972     used_names = findUses (tcg_dus gbl_env) emptyNameSet
 973         -- NB: currently, if f x = g, we only treat 'g' as used if 'f' is used
 974         -- Hence findUses
 975
 976     avail_env = imp_parent (tcg_imports gbl_env)
 977     nameParent_maybe n = case lookupNameEnv avail_env n of
 978                             Just (AvailTC tc _) | tc /= n  ->  Just tc
 979                             _otherwise  -> Nothing
 980
 981     all_used_names = used_names `unionNameSets`
 982                      mkNameSet (mapCatMaybes nameParent_maybe (nameSetToList used_names))
 983                         -- A use of C implies a use of T,
 984                         -- if C was brought into scope by T(..) or T(C)
 985
 986         -- Collect the defined names from the in-scope environment
 987     defined_names :: [GlobalRdrElt]
 988     defined_names = globalRdrEnvElts (tcg_rdr_env gbl_env)
 989
 990         -- Note that defined_and_used, defined_but_not_used
 991         -- are both [GRE]; that's why we need defined_and_used
 992         -- rather than just all_used_names
 993     defined_and_used, defined_but_not_used :: [GlobalRdrElt]
 994     (defined_and_used, defined_but_not_used)
 995         = partition (gre_is_used all_used_names) defined_names
 996
 997         -- Filter out the ones that are
 998         --  (a) defined in this module, and
 999         --  (b) not defined by a 'deriving' clause
1000         -- The latter have an Internal Name, so we can filter them out easily
1001     unused_locals :: [GlobalRdrElt]
1002     unused_locals = filter is_unused_local defined_but_not_used
1003     is_unused_local :: GlobalRdrElt -> Bool
1004     is_unused_local gre = isLocalGRE gre && isExternalName (gre_name gre)
1005
1006     unused_imports :: [GlobalRdrElt]
1007     unused_imports = filter unused_imp defined_but_not_used
1008     unused_imp (GRE {gre_prov = Imported imp_specs})
1009         = not (all (module_unused . importSpecModule) imp_specs)
1010           && or [exp | ImpSpec { is_item = ImpSome { is_explicit = exp } } <- imp_specs]
1011                 -- Don't complain about unused imports if we've already said the
1012                 -- entire import is unused
1013     unused_imp other = False
1014
1015     -- To figure out the minimal set of imports, start with the things
1016     -- that are in scope (i.e. in gbl_env).  Then just combine them
1017     -- into a bunch of avails, so they are properly grouped
1018     --
1019     -- BUG WARNING: this does not deal properly with qualified imports!
1020     minimal_imports :: FiniteMap ModuleName AvailEnv
1021     minimal_imports0 = foldr add_expall   emptyFM          expall_mods
1022     minimal_imports1 = foldr add_name     minimal_imports0 defined_and_used
1023     minimal_imports  = foldr add_inst_mod minimal_imports1 direct_import_mods
1024         -- The last line makes sure that we retain all direct imports
1025         -- even if we import nothing explicitly.
1026         -- It's not necessarily redundant to import such modules. Consider
1027         --            module This
1028         --              import M ()
1029         --
1030         -- The import M() is not *necessarily* redundant, even if
1031         -- we suck in no instance decls from M (e.g. it contains
1032         -- no instance decls, or This contains no code).  It may be
1033         -- that we import M solely to ensure that M's orphan instance
1034         -- decls (or those in its imports) are visible to people who
1035         -- import This.  Sigh.
1036         -- There's really no good way to detect this, so the error message
1037         -- in RnEnv.warnUnusedModules is weakened instead
1038
1039         -- We've carefully preserved the provenance so that we can
1040         -- construct minimal imports that import the name by (one of)
1041         -- the same route(s) as the programmer originally did.
1042     add_name (GRE {gre_name = n, gre_prov = Imported imp_specs}) acc
1043         = addToFM_C plusAvailEnv acc (importSpecModule (head imp_specs))
1044                     (unitAvailEnv (mk_avail n (nameParent_maybe n)))
1045     add_name other acc
1046         = acc
1047
1048         -- Modules mentioned as 'module M' in the export list
1049     expall_mods = case export_decls of
1050                     Nothing -> []
1051                     Just es -> [m | L _ (IEModuleContents m) <- es]
1052
1053         -- This is really bogus.  The idea is that if we see 'module M' in
1054         -- the export list we must retain the import decls that drive it
1055         -- If we aren't careful we might see
1056         --      module A( module M ) where
1057         --        import M
1058         --        import N
1059         -- and suppose that N exports everything that M does.  Then we
1060         -- must not drop the import of M even though N brings it all into
1061         -- scope.
1062         --
1063         -- BUG WARNING: 'module M' exports aside, what if M.x is mentioned?!
1064         --
1065         -- The reason that add_expall is bogus is that it doesn't take
1066         -- qualified imports into account.  But it's an improvement.
1067     add_expall mod acc = addToFM_C plusAvailEnv acc mod emptyAvailEnv
1068
1069         -- n is the name of the thing, p is the name of its parent
1070     mk_avail n (Just p)                          = AvailTC p [p,n]
1071     mk_avail n Nothing | isTcOcc (nameOccName n) = AvailTC n [n]
1072                        | otherwise               = Avail n
1073
1074     add_inst_mod (mod,_,_) acc
1075       | mod_name `elemFM` acc = acc     -- We import something already
1076       | otherwise             = addToFM acc mod_name emptyAvailEnv
1077       where
1078         mod_name = moduleName mod
1079         -- Add an empty collection of imports for a module
1080         -- from which we have sucked only instance decls
1081
1082     imports = tcg_imports gbl_env
1083
1084     direct_import_mods :: [(Module, Bool, SrcSpan)]
1085         -- See the type of the imp_mods for this triple
1086     direct_import_mods = moduleEnvElts (imp_mods imports)
1087
1088     -- unused_imp_mods are the directly-imported modules
1089     -- that are not mentioned in minimal_imports1
1090     -- [Note: not 'minimal_imports', because that includes directly-imported
1091     --        modules even if we use nothing from them; see notes above]
1092     --
1093     -- BUG WARNING: does not deal correctly with multiple imports of the same module
1094     --              becuase direct_import_mods has only one entry per module
1095     unused_imp_mods = [(mod_name,loc) | (mod,no_imp,loc) <- direct_import_mods,
1096                        let mod_name = moduleName mod,
1097                        not (mod_name `elemFM` minimal_imports1),
1098                        mod /= pRELUDE,
1099                        not no_imp]
1100         -- The not no_imp part is not to complain about
1101         -- import M (), which is an idiom for importing
1102         -- instance declarations
1103
1104     module_unused :: ModuleName -> Bool
1105     module_unused mod = any (((==) mod) . fst) unused_imp_mods
1106
1107 ---------------------
1108 warnDuplicateImports :: [GlobalRdrElt] -> RnM ()
1109 -- Given the GREs for names that are used, figure out which imports
1110 -- could be omitted without changing the top-level environment.
1111 --
1112 -- NB: Given import Foo( T )
1113 --           import qualified Foo
1114 -- we do not report a duplicate import, even though Foo.T is brought
1115 -- into scope by both, because there's nothing you can *omit* without
1116 -- changing the top-level environment.  So we complain only if it's
1117 -- explicitly named in both imports or neither.
1118 --
1119 -- Furthermore, we complain about Foo.T only if
1120 -- there is no complaint about (unqualified) T
1121
1122 warnDuplicateImports gres
1123   = ifOptM Opt_WarnUnusedImports $
1124     sequenceM_  [ warn name pr
1125                         -- The 'head' picks the first offending group
1126                         -- for this particular name
1127                 | GRE { gre_name = name, gre_prov = Imported imps } <- gres
1128                 , pr <- redundants imps ]
1129   where
1130     warn name (red_imp, cov_imp)
1131         = addWarnAt (importSpecLoc red_imp)
1132             (vcat [ptext SLIT("Redundant import of:") <+> quotes pp_name,
1133                    ptext SLIT("It is also") <+> ppr cov_imp])
1134         where
1135           pp_name | is_qual red_decl = ppr (is_as red_decl) <> dot <> ppr occ
1136                   | otherwise       = ppr occ
1137           occ = nameOccName name
1138           red_decl = is_decl red_imp
1139
1140     redundants :: [ImportSpec] -> [(ImportSpec,ImportSpec)]
1141         -- The returned pair is (redundant-import, covering-import)
1142     redundants imps
1143         = [ (red_imp, cov_imp)
1144           | red_imp <- imps
1145           , cov_imp <- take 1 (filter (covers red_imp) imps) ]
1146
1147         -- "red_imp" is a putative redundant import
1148         -- "cov_imp" potentially covers it
1149         -- This test decides whether red_imp could be dropped
1150         --
1151         -- NOTE: currently the test does not warn about
1152         --              import M( x )
1153         --              imoprt N( x )
1154         -- even if the same underlying 'x' is involved, because dropping
1155         -- either import would change the qualified names in scope (M.x, N.x)
1156         -- But if the qualified names aren't used, the import is indeed redundant
1157         -- Sadly we don't know that.  Oh well.
1158     covers red_imp@(ImpSpec { is_decl = red_decl, is_item = red_item })
1159            cov_imp@(ImpSpec { is_decl = cov_decl, is_item = cov_item })
1160         | red_loc == cov_loc
1161         = False         -- Ignore diagonal elements
1162         | not (is_as red_decl == is_as cov_decl)
1163         = False         -- They bring into scope different qualified names
1164         | not (is_qual red_decl) && is_qual cov_decl
1165         = False         -- Covering one doesn't bring unqualified name into scope
1166         | red_selective
1167         = not cov_selective     -- Redundant one is selective and covering one isn't
1168           || red_later          -- Both are explicit; tie-break using red_later
1169         | otherwise
1170         = not cov_selective     -- Neither import is selective
1171           && (is_mod red_decl == is_mod cov_decl)       -- They import the same module
1172           && red_later          -- Tie-break
1173         where
1174           red_loc   = importSpecLoc red_imp
1175           cov_loc   = importSpecLoc cov_imp
1176           red_later = red_loc > cov_loc
1177           cov_selective = selectiveImpItem cov_item
1178           red_selective = selectiveImpItem red_item
1179
1180 selectiveImpItem :: ImpItemSpec -> Bool
1181 selectiveImpItem ImpAll       = False
1182 selectiveImpItem (ImpSome {}) = True
1183
1184 -- ToDo: deal with original imports with 'qualified' and 'as M' clauses
1185 printMinimalImports :: FiniteMap ModuleName AvailEnv    -- Minimal imports
1186                     -> RnM ()
1187 printMinimalImports imps
1188  = ifOptM Opt_D_dump_minimal_imports $ do {
1189
1190    mod_ies  <-  mappM to_ies (fmToList imps) ;
1191    this_mod <- getModule ;
1192    rdr_env  <- getGlobalRdrEnv ;
1193    ioToTcRn (do { h <- openFile (mkFilename this_mod) WriteMode ;
1194                   printForUser h (mkPrintUnqualified rdr_env)
1195                                  (vcat (map ppr_mod_ie mod_ies)) })
1196    }
1197   where
1198     mkFilename this_mod = moduleNameString (moduleName this_mod) ++ ".imports"
1199     ppr_mod_ie (mod_name, ies)
1200         | mod_name == moduleName pRELUDE
1201         = empty
1202         | null ies      -- Nothing except instances comes from here
1203         = ptext SLIT("import") <+> ppr mod_name <> ptext SLIT("()    -- Instances only")
1204         | otherwise
1205         = ptext SLIT("import") <+> ppr mod_name <>
1206                     parens (fsep (punctuate comma (map ppr ies)))
1207
1208     to_ies (mod, avail_env) = do ies <- mapM to_ie (availEnvElts avail_env)
1209                                  returnM (mod, ies)
1210
1211     to_ie :: AvailInfo -> RnM (IE Name)
1212         -- The main trick here is that if we're importing all the constructors
1213         -- we want to say "T(..)", but if we're importing only a subset we want
1214         -- to say "T(A,B,C)".  So we have to find out what the module exports.
1215     to_ie (Avail n)       = returnM (IEVar n)
1216     to_ie (AvailTC n [m]) = ASSERT( n==m )
1217                             returnM (IEThingAbs n)
1218     to_ie (AvailTC n ns)
1219         = loadSrcInterface doc n_mod False                      `thenM` \ iface ->
1220           case [xs | (m,as) <- mi_exports iface,
1221                      moduleName m == n_mod,
1222                      AvailTC x xs <- as,
1223                      x == nameOccName n] of
1224               [xs] | all_used xs -> returnM (IEThingAll n)
1225                    | otherwise   -> returnM (IEThingWith n (filter (/= n) ns))
1226               other              -> pprTrace "to_ie" (ppr n <+> ppr n_mod <+> ppr other) $
1227                                     returnM (IEVar n)
1228         where
1229           all_used avail_occs = all (`elem` map nameOccName ns) avail_occs
1230           doc = text "Compute minimal imports from" <+> ppr n
1231           n_mod = moduleName (nameModule n)
1232 \end{code}
1233
1234
1235 %************************************************************************
1236 %*                                                                      *
1237 \subsection{Errors}
1238 %*                                                                      *
1239 %************************************************************************
1240
1241 \begin{code}
1242 badImportItemErr iface decl_spec ie
1243   = sep [ptext SLIT("Module"), quotes (ppr (is_mod decl_spec)), source_import,
1244          ptext SLIT("does not export"), quotes (ppr ie)]
1245   where
1246     source_import | mi_boot iface = ptext SLIT("(hi-boot interface)")
1247                   | otherwise     = empty
1248
1249 illegalImportItemErr = ptext SLIT("Illegal import item")
1250
1251 dodgyImportWarn item = dodgyMsg (ptext SLIT("import")) item
1252 dodgyExportWarn item = dodgyMsg (ptext SLIT("export")) item
1253
1254 dodgyMsg kind tc
1255   = sep [ ptext SLIT("The") <+> kind <+> ptext SLIT("item") <+> quotes (ppr (IEThingAll tc)),
1256           ptext SLIT("suggests that") <+> quotes (ppr tc) <+> ptext SLIT("has constructor or class methods"),
1257           ptext SLIT("but it has none; it is a type synonym or abstract type or class") ]
1258
1259 modExportErr mod
1260   = hsep [ ptext SLIT("Unknown module in export list: module"), quotes (ppr mod)]
1261
1262 exportItemErr export_item
1263   = sep [ ptext SLIT("The export item") <+> quotes (ppr export_item),
1264           ptext SLIT("attempts to export constructors or class methods that are not visible here") ]
1265
1266 typeItemErr name wherestr
1267   = sep [ ptext SLIT("Using 'type' tag on") <+> quotes (ppr name) <+> wherestr,
1268           ptext SLIT("Use -findexed-types to enable this extension") ]
1269
1270 exportClashErr global_env name1 name2 ie1 ie2
1271   = vcat [ ptext SLIT("Conflicting exports for") <+> quotes (ppr occ) <> colon
1272          , ppr_export ie1 name1
1273          , ppr_export ie2 name2  ]
1274   where
1275     occ = nameOccName name1
1276     ppr_export ie name = nest 2 (quotes (ppr ie) <+> ptext SLIT("exports") <+>
1277                                  quotes (ppr name) <+> pprNameProvenance (get_gre name))
1278
1279         -- get_gre finds a GRE for the Name, so that we can show its provenance
1280     get_gre name
1281         = case lookupGRE_Name global_env name of
1282              (gre:_) -> gre
1283              []      -> pprPanic "exportClashErr" (ppr name)
1284
1285 addDupDeclErr :: Name -> Name -> TcRn ()
1286 addDupDeclErr name_a name_b
1287   = addErrAt (srcLocSpan loc2) $
1288     vcat [ptext SLIT("Multiple declarations of") <+> quotes (ppr name1),
1289           ptext SLIT("Declared at:") <+> vcat [ppr (nameSrcLoc name1), ppr loc2]]
1290   where
1291     loc2 = nameSrcLoc name2
1292     (name1,name2) | nameSrcLoc name_a > nameSrcLoc name_b = (name_b,name_a)
1293                   | otherwise                             = (name_a,name_b)
1294         -- Report the error at the later location
1295
1296 dupExportWarn occ_name ie1 ie2
1297   = hsep [quotes (ppr occ_name),
1298           ptext SLIT("is exported by"), quotes (ppr ie1),
1299           ptext SLIT("and"),            quotes (ppr ie2)]
1300
1301 dupModuleExport mod
1302   = hsep [ptext SLIT("Duplicate"),
1303           quotes (ptext SLIT("Module") <+> ppr mod),
1304           ptext SLIT("in export list")]
1305
1306 moduleDeprec mod txt
1307   = sep [ ptext SLIT("Module") <+> quotes (ppr mod) <+> ptext SLIT("is deprecated:"),
1308           nest 4 (ppr txt) ]
1309 \end{code}