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