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