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