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, getLocalNonValBinders,
   9         rnExports, extendGlobalRdrEnvRn,
  10         reportUnusedNames, finishWarnings,
  11     ) where
  12
  13 #include "HsVersions.h"
  14
  15 import DynFlags
  16 import HsSyn
  17 import TcEnv            ( isBrackStage )
  18 import RnEnv
  19 import RnHsDoc          ( rnHsDoc )
  20 import IfaceEnv         ( ifaceExportNames )
  21 import LoadIface        ( loadSrcInterface, loadSysInterface )
  22 import TcRnMonad hiding (LIE)
  23
  24 import HeaderInfo       ( mkPrelImports )
  25 import PrelNames
  26 import Module
  27 import Name
  28 import NameEnv
  29 import NameSet
  30 import HscTypes
  31 import RdrName
  32 import Outputable
  33 import Maybes
  34 import SrcLoc
  35 import FiniteMap
  36 import ErrUtils
  37 import Util
  38 import FastString
  39 import ListSetOps
  40 import Data.List        ( partition, (\\), delete )
  41 import qualified Data.Set as Set
  42 import System.IO
  43 import Control.Monad
  44 \end{code}
  45
  46
  47
  48 %************************************************************************
  49 %*                                                                      *
  50                 rnImports
  51 %*                                                                      *
  52 %************************************************************************
  53
  54 \begin{code}
  55 rnImports :: [LImportDecl RdrName]
  56            -> RnM ([LImportDecl Name], GlobalRdrEnv, ImportAvails,AnyHpcUsage)
  57
  58 rnImports imports
  59          -- PROCESS IMPORT DECLS
  60          -- Do the non {- SOURCE -} ones first, so that we get a helpful
  61          -- warning for {- SOURCE -} ones that are unnecessary
  62     = do this_mod <- getModule
  63          implicit_prelude <- doptM Opt_ImplicitPrelude
  64          let prel_imports       = mkPrelImports (moduleName this_mod) implicit_prelude imports
  65              (source, ordinary) = partition is_source_import imports
  66              is_source_import (L _ (ImportDecl _ _ is_boot _ _ _)) = is_boot
  67
  68          ifOptM Opt_WarnImplicitPrelude (
  69             when (notNull prel_imports) $ addWarn (implicitPreludeWarn)
  70           )
  71
  72          stuff1 <- mapM (rnImportDecl this_mod) (prel_imports ++ ordinary)
  73          stuff2 <- mapM (rnImportDecl this_mod) source
  74          let (decls, rdr_env, imp_avails,hpc_usage) = combine (stuff1 ++ stuff2)
  75          return (decls, rdr_env, imp_avails,hpc_usage)
  76
  77     where
  78    combine :: [(LImportDecl Name,  GlobalRdrEnv, ImportAvails,AnyHpcUsage)]
  79            -> ([LImportDecl Name], GlobalRdrEnv, ImportAvails,AnyHpcUsage)
  80    combine = foldr plus ([], emptyGlobalRdrEnv, emptyImportAvails,False)
  81         where plus (decl,  gbl_env1, imp_avails1,hpc_usage1)
  82                    (decls, gbl_env2, imp_avails2,hpc_usage2)
  83                 = (decl:decls,
  84                    gbl_env1 `plusGlobalRdrEnv` gbl_env2,
  85                    imp_avails1 `plusImportAvails` imp_avails2,
  86                    hpc_usage1 || hpc_usage2)
  87
  88 rnImportDecl  :: Module
  89               -> LImportDecl RdrName
  90               -> RnM (LImportDecl Name, GlobalRdrEnv, ImportAvails,AnyHpcUsage)
  91
  92 rnImportDecl this_mod (L loc (ImportDecl loc_imp_mod_name mb_pkg want_boot
  93                                          qual_only as_mod imp_details))
  94   = setSrcSpan loc $ do
  95
  96     when (isJust mb_pkg) $ do
  97         pkg_imports <- doptM Opt_PackageImports
  98         when (not pkg_imports) $ addErr packageImportErr
  99
 100         -- If there's an error in loadInterface, (e.g. interface
 101         -- file not found) we get lots of spurious errors from 'filterImports'
 102     let
 103         imp_mod_name = unLoc loc_imp_mod_name
 104         doc = ppr imp_mod_name <+> ptext (sLit "is directly imported")
 105
 106     iface <- loadSrcInterface doc imp_mod_name want_boot mb_pkg
 107
 108         -- Compiler sanity check: if the import didn't say
 109         -- {-# SOURCE #-} we should not get a hi-boot file
 110     WARN( not want_boot && mi_boot iface, ppr imp_mod_name ) (do
 111
 112         -- Issue a user warning for a redundant {- SOURCE -} import
 113         -- NB that we arrange to read all the ordinary imports before
 114         -- any of the {- SOURCE -} imports.
 115         --
 116         -- in --make and GHCi, the compilation manager checks for this,
 117         -- and indeed we shouldn't do it here because the existence of
 118         -- the non-boot module depends on the compilation order, which
 119         -- is not deterministic.  The hs-boot test can show this up.
 120     dflags <- getDOpts
 121     warnIf (want_boot && not (mi_boot iface) && isOneShot (ghcMode dflags))
 122            (warnRedundantSourceImport imp_mod_name)
 123
 124     let
 125         imp_mod    = mi_module iface
 126         warns      = mi_warns iface
 127         orph_iface = mi_orphan iface
 128         has_finsts = mi_finsts iface
 129         deps       = mi_deps iface
 130
 131         filtered_exports = filter not_this_mod (mi_exports iface)
 132         not_this_mod (mod,_) = mod /= this_mod
 133         -- If the module exports anything defined in this module, just
 134         -- ignore it.  Reason: otherwise it looks as if there are two
 135         -- local definition sites for the thing, and an error gets
 136         -- reported.  Easiest thing is just to filter them out up
 137         -- front. This situation only arises if a module imports
 138         -- itself, or another module that imported it.  (Necessarily,
 139         -- this invoves a loop.)
 140         --
 141         -- Tiresome consequence: if you say
 142         --      module A where
 143         --         import B( AType )
 144         --         type AType = ...
 145         --
 146         --      module B( AType ) where
 147         --         import {-# SOURCE #-} A( AType )
 148         --
 149         -- then you'll get a 'B does not export AType' message.  Oh well.
 150
 151         qual_mod_name = case as_mod of
 152                           Nothing           -> imp_mod_name
 153                           Just another_name -> another_name
 154         imp_spec  = ImpDeclSpec { is_mod = imp_mod_name, is_qual = qual_only,
 155                                   is_dloc = loc, is_as = qual_mod_name }
 156     -- in
 157
 158         -- Get the total exports from this module
 159     total_avails <- ifaceExportNames filtered_exports
 160
 161         -- filter the imports according to the import declaration
 162     (new_imp_details, gbl_env) <-
 163         filterImports iface imp_spec imp_details total_avails
 164
 165     dflags <- getDOpts
 166
 167     let
 168         -- Compute new transitive dependencies
 169
 170         orphans | orph_iface = ASSERT( not (imp_mod `elem` dep_orphs deps) )
 171                                imp_mod : dep_orphs deps
 172                 | otherwise  = dep_orphs deps
 173
 174         finsts | has_finsts = ASSERT( not (imp_mod `elem` dep_finsts deps) )
 175                               imp_mod : dep_finsts deps
 176                 | otherwise = dep_finsts deps
 177
 178         pkg = modulePackageId (mi_module iface)
 179
 180         (dependent_mods, dependent_pkgs)
 181            | pkg == thisPackage dflags =
 182                 -- Imported module is from the home package
 183                 -- Take its dependent modules and add imp_mod itself
 184                 -- Take its dependent packages unchanged
 185                 --
 186                 -- NB: (dep_mods deps) might include a hi-boot file
 187                 -- for the module being compiled, CM. Do *not* filter
 188                 -- this out (as we used to), because when we've
 189                 -- finished dealing with the direct imports we want to
 190                 -- know if any of them depended on CM.hi-boot, in
 191                 -- which case we should do the hi-boot consistency
 192                 -- check.  See LoadIface.loadHiBootInterface
 193                   ((imp_mod_name, want_boot) : dep_mods deps, dep_pkgs deps)
 194
 195            | otherwise =
 196                 -- Imported module is from another package
 197                 -- Dump the dependent modules
 198                 -- Add the package imp_mod comes from to the dependent packages
 199                  ASSERT2( not (pkg `elem` dep_pkgs deps), ppr pkg <+> ppr (dep_pkgs deps) )
 200                  ([], pkg : dep_pkgs deps)
 201
 202         -- True <=> import M ()
 203         import_all = case imp_details of
 204                         Just (is_hiding, ls) -> not is_hiding && null ls
 205                         _                    -> False
 206
 207         imports   = ImportAvails {
 208                         imp_mods     = unitModuleEnv imp_mod [(qual_mod_name, import_all, loc)],
 209                         imp_orphs    = orphans,
 210                         imp_finsts   = finsts,
 211                         imp_dep_mods = mkModDeps dependent_mods,
 212                         imp_dep_pkgs = dependent_pkgs
 213                    }
 214
 215         -- Complain if we import a deprecated module
 216     ifOptM Opt_WarnWarningsDeprecations (
 217        case warns of
 218           WarnAll txt -> addWarn (moduleWarn imp_mod_name txt)
 219           _           -> return ()
 220      )
 221
 222     let new_imp_decl = L loc (ImportDecl loc_imp_mod_name mb_pkg want_boot
 223                                          qual_only as_mod new_imp_details)
 224
 225     return (new_imp_decl, gbl_env, imports, mi_hpc iface)
 226     )
 227
 228 warnRedundantSourceImport :: ModuleName -> SDoc
 229 warnRedundantSourceImport mod_name
 230   = ptext (sLit "Unnecessary {-# SOURCE #-} in the import of module")
 231           <+> quotes (ppr mod_name)
 232 \end{code}
 233
 234
 235 %************************************************************************
 236 %*                                                                      *
 237                 importsFromLocalDecls
 238 %*                                                                      *
 239 %************************************************************************
 240
 241 From the top-level declarations of this module produce
 242         * the lexical environment
 243         * the ImportAvails
 244 created by its bindings.
 245
 246 Note [Top-level Names in Template Haskell decl quotes]
 247 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 248 Consider a Template Haskell declaration quotation like this:
 249       module M where
 250         f x = h [d| f = 3 |]
 251 When renaming the declarations inside [d| ...|], we treat the
 252 top level binders specially in two ways
 253
 254 1.  We give them an Internal name, not (as usual) an External one.
 255     Otherwise the NameCache gets confused by a second allocation of
 256     M.f.  (We used to invent a fake module ThFake to avoid this, but
 257     that had other problems, notably in getting the correct answer for
 258     nameIsLocalOrFrom in lookupFixity. So we now leave tcg_module
 259     unaffected.)
 260
 261 2.  We make them *shadow* the outer bindings. If we don't do that,
 262     we'll get a complaint when extending the GlobalRdrEnv, saying that
 263     there are two bindings for 'f'.
 264
 265     This shadowing applies even if the binding for 'f' is in a
 266     where-clause, and hence is in the *local* RdrEnv not the *global*
 267     RdrEnv.
 268
 269 We find out whether we are inside a [d| ... |] by testing the TH
 270 stage. This is a slight hack, because the stage field was really meant for
 271 the type checker, and here we are not interested in the fields of Brack,
 272 hence the error thunks in thRnBrack.
 273
 274 \begin{code}
 275 extendGlobalRdrEnvRn :: [AvailInfo]
 276                      -> MiniFixityEnv
 277                      -> RnM (TcGblEnv, TcLclEnv)
 278   -- Updates both the GlobalRdrEnv and the FixityEnv
 279   -- We return a new TcLclEnv only becuase we might have to
 280   -- delete some bindings from it;
 281   -- see Note [Top-level Names in Template Haskell decl quotes]
 282
 283 extendGlobalRdrEnvRn avails new_fixities
 284   = do  { (gbl_env, lcl_env) <- getEnvs
 285         ; stage <- getStage
 286         ; let rdr_env = tcg_rdr_env gbl_env
 287               fix_env = tcg_fix_env gbl_env
 288
 289                 -- Delete new_occs from global and local envs
 290                 -- If we are in a TemplateHaskell decl bracket,
 291                 --    we are going to shadow them
 292                 -- See Note [Top-level Names in Template Haskell decl quotes]
 293               shadowP  = isBrackStage stage
 294               new_occs = map (nameOccName . gre_name) gres
 295               rdr_env1 = hideSomeUnquals rdr_env new_occs
 296               lcl_env1 = lcl_env { tcl_rdr = delListFromOccEnv (tcl_rdr lcl_env) new_occs }
 297               (rdr_env2, lcl_env2) | shadowP   = (rdr_env1, lcl_env1)
 298                                    | otherwise = (rdr_env,  lcl_env)
 299
 300               rdr_env3 = foldl extendGlobalRdrEnv rdr_env2 gres
 301               fix_env' = foldl extend_fix_env     fix_env  gres
 302               (rdr_env', dups) = findLocalDupsRdrEnv rdr_env3 new_occs
 303
 304               gbl_env' = gbl_env { tcg_rdr_env = rdr_env', tcg_fix_env = fix_env' }
 305
 306         ; mapM_ addDupDeclErr dups
 307
 308         ; traceRn (text "extendGlobalRdrEnvRn" <+> (ppr new_fixities $$ ppr fix_env $$ ppr fix_env'))
 309         ; return (gbl_env', lcl_env2) }
 310   where
 311     gres = gresFromAvails LocalDef avails
 312
 313         --  If there is a fixity decl for the gre, add it to the fixity env
 314     extend_fix_env fix_env gre
 315       | Just (L _ fi) <- lookupFsEnv new_fixities (occNameFS occ)
 316       = extendNameEnv fix_env name (FixItem occ fi)
 317       | otherwise
 318       = fix_env
 319       where
 320         name = gre_name gre
 321         occ  = nameOccName name
 322 \end{code}
 323
 324 @getLocalDeclBinders@ returns the names for an @HsDecl@.  It's
 325 used for source code.
 326
 327         *** See "THE NAMING STORY" in HsDecls ****
 328
 329 Instances of type families
 330 ~~~~~~~~~~~~~~~~~~~~~~~~~~
 331 Family instances contain data constructors that we need to collect and we also
 332 need to descend into the type instances of associated families in class
 333 instances. The type constructor of a family instance is a usage occurence.
 334 Hence, we don't return it as a subname in 'AvailInfo'; otherwise, we would get
 335 a duplicate declaration error.
 336
 337 Note [Looking up family names in family instances]
 338 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 339 Consider
 340
 341   module M where
 342     type family T a :: *
 343     type instance M.T Int = Bool
 344
 345 We might think that we can simply use 'lookupOccRn' when processing the type
 346 instance to look up 'M.T'.  Alas, we can't!  The type family declaration is in
 347 the *same* HsGroup as the type instance declaration.  Hence, as we are
 348 currently collecting the binders declared in that HsGroup, these binders will
 349 not have been added to the global environment yet.
 350
 351 In the case of type classes, this problem does not arise, as a class instance
 352 does not define any binders of it's own.  So, we simply don't attempt to look
 353 up the class names of class instances in 'get_local_binders' below.
 354
 355 If we don't look up class instances, can't we get away without looking up type
 356 instances, too?  No, we can't.  Data type instances define data constructors
 357 and we need to
 358
 359   (1) collect those in 'get_local_binders' and
 360   (2) we need to get their parent name in 'get_local_binders', too, to
 361       produce an appropriate 'AvailTC'.
 362
 363 This parent name is exactly the family name of the type instance that is so
 364 difficult to look up.
 365
 366 We solve this problem as follows:
 367
 368   (a) We process all type declarations other than type instances first.
 369   (b) Then, we compute a 'GlobalRdrEnv' from the result of the first step.
 370   (c) Finally, we process all type instances (both those on the toplevel and
 371       those nested in class instances) and check for the family names in the
 372       'GlobalRdrEnv' produced in the previous step before using 'lookupOccRn'.
 373
 374 \begin{code}
 375 getLocalNonValBinders :: HsGroup RdrName -> RnM [AvailInfo]
 376 -- Get all the top-level binders bound the group *except*
 377 -- for value bindings, which are treated separately
 378 -- Specificaly we return AvailInfo for
 379 --      type decls
 380 --      class decls
 381 --      associated types
 382 --      foreign imports
 383 --      (in hs-boot files) value signatures
 384
 385 getLocalNonValBinders group
 386   = do  { gbl_env <- getGblEnv
 387         ; get_local_binders gbl_env group }
 388
 389 get_local_binders :: TcGblEnv -> HsGroup RdrName -> RnM [GenAvailInfo Name]
 390 get_local_binders gbl_env (HsGroup {hs_valds  = ValBindsIn _ val_sigs,
 391                                     hs_tyclds = tycl_decls,
 392                                     hs_instds = inst_decls,
 393                                     hs_fords  = foreign_decls })
 394   = do  {   -- separate out the family instance declarations
 395           let (tyinst_decls1, tycl_decls_noinsts)
 396                            = partition (isFamInstDecl . unLoc) tycl_decls
 397               tyinst_decls = tyinst_decls1 ++ instDeclATs inst_decls
 398
 399             -- process all type/class decls except family instances
 400         ; tc_names  <- mapM new_tc tycl_decls_noinsts
 401
 402             -- create a temporary rdr env of the type binders
 403         ; let tc_gres     = gresFromAvails LocalDef tc_names
 404               tc_name_env = foldl extendGlobalRdrEnv emptyGlobalRdrEnv tc_gres
 405
 406             -- process all family instances
 407         ; ti_names  <- mapM (new_ti tc_name_env) tyinst_decls
 408
 409             -- finish off with value binder in case of a hs-boot file
 410         ; val_names <- mapM new_simple val_bndrs
 411         ; return (val_names ++ tc_names ++ ti_names) }
 412   where
 413     is_hs_boot = isHsBoot (tcg_src gbl_env) ;
 414
 415     for_hs_bndrs :: [Located RdrName]
 416     for_hs_bndrs = [nm | L _ (ForeignImport nm _ _) <- foreign_decls]
 417
 418     -- In a hs-boot file, the value binders come from the
 419     --  *signatures*, and there should be no foreign binders
 420     val_bndrs :: [Located RdrName]
 421     val_bndrs | is_hs_boot = [nm | L _ (TypeSig nm _) <- val_sigs]
 422               | otherwise  = for_hs_bndrs
 423
 424     new_simple :: Located RdrName -> RnM (GenAvailInfo Name)
 425     new_simple rdr_name = do
 426         nm <- newTopSrcBinder rdr_name
 427         return (Avail nm)
 428
 429     new_tc tc_decl              -- NOT for type/data instances
 430         = do { main_name <- newTopSrcBinder main_rdr
 431              ; sub_names <- mapM newTopSrcBinder sub_rdrs
 432              ; return (AvailTC main_name (main_name : sub_names)) }
 433       where
 434         (main_rdr : sub_rdrs) = hsTyClDeclBinders tc_decl
 435
 436     new_ti tc_name_env ti_decl  -- ONLY for type/data instances
 437         = do { main_name <- lookupFamInstDeclBndr tc_name_env main_rdr
 438              ; sub_names <- mapM newTopSrcBinder sub_rdrs
 439              ; return (AvailTC main_name sub_names) }
 440                         -- main_name is not bound here!
 441       where
 442         (main_rdr : sub_rdrs) = hsTyClDeclBinders ti_decl
 443
 444 get_local_binders _ g = pprPanic "get_local_binders" (ppr g)
 445 \end{code}
 446
 447
 448 %************************************************************************
 449 %*                                                                      *
 450 \subsection{Filtering imports}
 451 %*                                                                      *
 452 %************************************************************************
 453
 454 @filterImports@ takes the @ExportEnv@ telling what the imported module makes
 455 available, and filters it through the import spec (if any).
 456
 457 \begin{code}
 458 filterImports :: ModIface
 459               -> ImpDeclSpec                    -- The span for the entire import decl
 460               -> Maybe (Bool, [LIE RdrName])    -- Import spec; True => hiding
 461               -> [AvailInfo]                    -- What's available
 462               -> RnM (Maybe (Bool, [LIE Name]), -- Import spec w/ Names
 463                       GlobalRdrEnv)             -- Same again, but in GRE form
 464 filterImports _ decl_spec Nothing all_avails
 465   = return (Nothing, mkGlobalRdrEnv (gresFromAvails prov all_avails))
 466   where
 467     prov = Imported [ImpSpec { is_decl = decl_spec, is_item = ImpAll }]
 468
 469
 470 filterImports iface decl_spec (Just (want_hiding, import_items)) all_avails
 471   = do   -- check for errors, convert RdrNames to Names
 472         opt_typeFamilies <- doptM Opt_TypeFamilies
 473         items1 <- mapM (lookup_lie opt_typeFamilies) import_items
 474
 475         let items2 :: [(LIE Name, AvailInfo)]
 476             items2 = concat items1
 477                 -- NB the AvailInfo may have duplicates, and several items
 478                 --    for the same parent; e.g N(x) and N(y)
 479
 480             names  = availsToNameSet (map snd items2)
 481             keep n = not (n `elemNameSet` names)
 482             pruned_avails = filterAvails keep all_avails
 483             hiding_prov = Imported [ImpSpec { is_decl = decl_spec, is_item = ImpAll }]
 484
 485             gres | want_hiding = gresFromAvails hiding_prov pruned_avails
 486                  | otherwise   = concatMap (gresFromIE decl_spec) items2
 487
 488         return (Just (want_hiding, map fst items2), mkGlobalRdrEnv gres)
 489   where
 490         -- This environment is how we map names mentioned in the import
 491         -- list to the actual Name they correspond to, and the name family
 492         -- that the Name belongs to (the AvailInfo).  The situation is
 493         -- complicated by associated families, which introduce a three-level
 494         -- hierachy, where class = grand parent, assoc family = parent, and
 495         -- data constructors = children.  The occ_env entries for associated
 496         -- families needs to capture all this information; hence, we have the
 497         -- third component of the environment that gives the class name (=
 498         -- grand parent) in case of associated families.
 499         --
 500         -- This env will have entries for data constructors too,
 501         -- they won't make any difference because naked entities like T
 502         -- in an import list map to TcOccs, not VarOccs.
 503     occ_env :: OccEnv (Name,        -- the name
 504                        AvailInfo,   -- the export item providing the name
 505                        Maybe Name)  -- the parent of associated types
 506     occ_env = mkOccEnv_C combine [ (nameOccName n, (n, a, Nothing))
 507                                  | a <- all_avails, n <- availNames a]
 508       where
 509         -- we know that (1) there are at most entries for one name, (2) their
 510         -- first component is identical, (3) they are for tys/cls, and (4) one
 511         -- entry has the name in its parent position (the other doesn't)
 512         combine (name, AvailTC p1 subs1, Nothing)
 513                 (_   , AvailTC p2 subs2, Nothing)
 514           = let
 515               (parent, subs) = if p1 == name then (p2, subs1) else (p1, subs2)
 516             in
 517             (name, AvailTC name subs, Just parent)
 518         combine x y = pprPanic "filterImports/combine" (ppr x $$ ppr y)
 519
 520     lookup_lie :: Bool -> LIE RdrName -> TcRn [(LIE Name, AvailInfo)]
 521     lookup_lie opt_typeFamilies (L loc ieRdr)
 522         = do
 523              stuff <- setSrcSpan loc $
 524                       case lookup_ie opt_typeFamilies ieRdr of
 525                             Failed err  -> addErr err >> return []
 526                             Succeeded a -> return a
 527              checkDodgyImport stuff
 528              return [ (L loc ie, avail) | (ie,avail) <- stuff ]
 529         where
 530                 -- Warn when importing T(..) if T was exported abstractly
 531             checkDodgyImport stuff
 532                 | IEThingAll n <- ieRdr, (_, AvailTC _ [_]):_ <- stuff
 533                 = ifOptM Opt_WarnDodgyImports (addWarn (dodgyImportWarn n))
 534                 -- NB. use the RdrName for reporting the warning
 535             checkDodgyImport _
 536                 = return ()
 537
 538         -- For each import item, we convert its RdrNames to Names,
 539         -- and at the same time construct an AvailInfo corresponding
 540         -- to what is actually imported by this item.
 541         -- Returns Nothing on error.
 542         -- We return a list here, because in the case of an import
 543         -- item like C, if we are hiding, then C refers to *both* a
 544         -- type/class and a data constructor.  Moreover, when we import
 545         -- data constructors of an associated family, we need separate
 546         -- AvailInfos for the data constructors and the family (as they have
 547         -- different parents).  See the discussion at occ_env.
 548     lookup_ie :: Bool -> IE RdrName -> MaybeErr Message [(IE Name,AvailInfo)]
 549     lookup_ie opt_typeFamilies ie
 550       = let bad_ie = Failed (badImportItemErr iface decl_spec ie)
 551
 552             lookup_name rdr
 553               | isQual rdr = Failed (qualImportItemErr rdr)
 554               | Just nm <- lookupOccEnv occ_env (rdrNameOcc rdr) = return nm
 555               | otherwise                                        = bad_ie
 556         in
 557         case ie of
 558          IEVar n -> do
 559              (name, avail, _) <- lookup_name n
 560              return [(IEVar name, trimAvail avail name)]
 561
 562          IEThingAll tc -> do
 563              (name, avail@(AvailTC name2 subs), mb_parent) <- lookup_name tc
 564              case mb_parent of
 565                -- non-associated ty/cls
 566                Nothing     -> return [(IEThingAll name, avail)]
 567                -- associated ty
 568                Just parent -> return [(IEThingAll name,
 569                                        AvailTC name2 (subs \\ [name])),
 570                                       (IEThingAll name, AvailTC parent [name])]
 571
 572          IEThingAbs tc
 573              | want_hiding   -- hiding ( C )
 574                         -- Here the 'C' can be a data constructor
 575                         --  *or* a type/class, or even both
 576              -> let tc_name = lookup_name tc
 577                     dc_name = lookup_name (setRdrNameSpace tc srcDataName)
 578                 in
 579                 case catMaybeErr [ tc_name, dc_name ] of
 580                   []    -> bad_ie
 581                   names -> return [mkIEThingAbs name | name <- names]
 582              | otherwise
 583              -> do nameAvail <- lookup_name tc
 584                    return [mkIEThingAbs nameAvail]
 585
 586          IEThingWith tc ns -> do
 587             (name, AvailTC _ subnames, mb_parent) <- lookup_name tc
 588             let
 589               env         = mkOccEnv [(nameOccName s, s) | s <- subnames]
 590               mb_children = map (lookupOccEnv env . rdrNameOcc) ns
 591             children <- if any isNothing mb_children
 592                         then bad_ie
 593                         else return (catMaybes mb_children)
 594               -- check for proper import of type families
 595             when (not opt_typeFamilies && any isTyConName children) $
 596               Failed (typeItemErr (head . filter isTyConName $ children)
 597                                   (text "in import list"))
 598             case mb_parent of
 599                -- non-associated ty/cls
 600               Nothing     -> return [(IEThingWith name children,
 601                                       AvailTC name (name:children))]
 602                -- associated ty
 603               Just parent -> return [(IEThingWith name children,
 604                                       AvailTC name children),
 605                                      (IEThingWith name children,
 606                                       AvailTC parent [name])]
 607
 608          _other -> Failed illegalImportItemErr
 609          -- could be IEModuleContents, IEGroup, IEDoc, IEDocNamed
 610          -- all errors.
 611
 612       where
 613         mkIEThingAbs (n, av, Nothing    ) = (IEThingAbs n, trimAvail av n)
 614         mkIEThingAbs (n, _,  Just parent) = (IEThingAbs n, AvailTC parent [n])
 615
 616
 617 catMaybeErr :: [MaybeErr err a] -> [a]
 618 catMaybeErr ms =  [ a | Succeeded a <- ms ]
 619 \end{code}
 620
 621 %************************************************************************
 622 %*                                                                      *
 623         Import/Export Utils
 624 %*                                                                      *
 625 %************************************************************************
 626
 627 \begin{code}
 628 -- | make a 'GlobalRdrEnv' where all the elements point to the same
 629 -- import declaration (useful for "hiding" imports, or imports with
 630 -- no details).
 631 gresFromAvails :: Provenance -> [AvailInfo] -> [GlobalRdrElt]
 632 gresFromAvails prov avails
 633   = concatMap (gresFromAvail (const prov)) avails
 634
 635 gresFromAvail :: (Name -> Provenance) -> AvailInfo -> [GlobalRdrElt]
 636 gresFromAvail prov_fn avail
 637   = [ GRE {gre_name = n,
 638            gre_par = availParent n avail,
 639            gre_prov = prov_fn n}
 640     | n <- availNames avail ]
 641
 642 greAvail :: GlobalRdrElt -> AvailInfo
 643 greAvail gre = mkUnitAvail (gre_name gre) (gre_par gre)
 644
 645 mkUnitAvail :: Name -> Parent -> AvailInfo
 646 mkUnitAvail me (ParentIs p)              = AvailTC p  [me]
 647 mkUnitAvail me NoParent | isTyConName me = AvailTC me [me]
 648                         | otherwise      = Avail me
 649
 650 plusAvail :: GenAvailInfo Name -> GenAvailInfo Name -> GenAvailInfo Name
 651 plusAvail (Avail n1)      (Avail _)        = Avail n1
 652 plusAvail (AvailTC _ ns1) (AvailTC n2 ns2) = AvailTC n2 (ns1 `unionLists` ns2)
 653 plusAvail a1 a2 = pprPanic "RnEnv.plusAvail" (hsep [ppr a1,ppr a2])
 654
 655 availParent :: Name -> AvailInfo -> Parent
 656 availParent _ (Avail _)                 = NoParent
 657 availParent n (AvailTC m _) | n == m    = NoParent
 658                             | otherwise = ParentIs m
 659
 660 trimAvail :: AvailInfo -> Name -> AvailInfo
 661 trimAvail (Avail n)      _ = Avail n
 662 trimAvail (AvailTC n ns) m = ASSERT( m `elem` ns) AvailTC n [m]
 663
 664 -- | filters 'AvailInfo's by the given predicate
 665 filterAvails  :: (Name -> Bool) -> [AvailInfo] -> [AvailInfo]
 666 filterAvails keep avails = foldr (filterAvail keep) [] avails
 667
 668 -- | filters an 'AvailInfo' by the given predicate
 669 filterAvail :: (Name -> Bool) -> AvailInfo -> [AvailInfo] -> [AvailInfo]
 670 filterAvail keep ie rest =
 671   case ie of
 672     Avail n | keep n    -> ie : rest
 673             | otherwise -> rest
 674     AvailTC tc ns ->
 675         let left = filter keep ns in
 676         if null left then rest else AvailTC tc left : rest
 677
 678 -- | Given an import\/export spec, construct the appropriate 'GlobalRdrElt's.
 679 gresFromIE :: ImpDeclSpec -> (LIE Name, AvailInfo) -> [GlobalRdrElt]
 680 gresFromIE decl_spec (L loc ie, avail)
 681   = gresFromAvail prov_fn avail
 682   where
 683     is_explicit = case ie of
 684                     IEThingAll name -> \n -> n == name
 685                     _               -> \_ -> True
 686     prov_fn name = Imported [imp_spec]
 687         where
 688           imp_spec  = ImpSpec { is_decl = decl_spec, is_item = item_spec }
 689           item_spec = ImpSome { is_explicit = is_explicit name, is_iloc = loc }
 690
 691 mkChildEnv :: [GlobalRdrElt] -> NameEnv [Name]
 692 mkChildEnv gres = foldr add emptyNameEnv gres
 693     where
 694         add (GRE { gre_name = n, gre_par = ParentIs p }) env = extendNameEnv_Acc (:) singleton env p n
 695         add _                                            env = env
 696
 697 findChildren :: NameEnv [Name] -> Name -> [Name]
 698 findChildren env n = lookupNameEnv env n `orElse` []
 699 \end{code}
 700
 701 ---------------------------------------
 702         AvailEnv and friends
 703
 704 All this AvailEnv stuff is hardly used; only in a very small
 705 part of RnNames.  Todo: remove?
 706 ---------------------------------------
 707
 708 \begin{code}
 709 type AvailEnv = NameEnv AvailInfo       -- Maps a Name to the AvailInfo that contains it
 710
 711 emptyAvailEnv :: AvailEnv
 712 emptyAvailEnv = emptyNameEnv
 713
 714 {- Dead code
 715 unitAvailEnv :: AvailInfo -> AvailEnv
 716 unitAvailEnv a = unitNameEnv (availName a) a
 717
 718 plusAvailEnv :: AvailEnv -> AvailEnv -> AvailEnv
 719 plusAvailEnv = plusNameEnv_C plusAvail
 720
 721 availEnvElts :: AvailEnv -> [AvailInfo]
 722 availEnvElts = nameEnvElts
 723 -}
 724
 725 addAvail :: AvailEnv -> AvailInfo -> AvailEnv
 726 addAvail avails avail = extendNameEnv_C plusAvail avails (availName avail) avail
 727
 728 mkAvailEnv :: [AvailInfo] -> AvailEnv
 729         -- 'avails' may have several items with the same availName
 730         -- E.g  import Ix( Ix(..), index )
 731         -- will give Ix(Ix,index,range) and Ix(index)
 732         -- We want to combine these; addAvail does that
 733 mkAvailEnv avails = foldl addAvail emptyAvailEnv avails
 734
 735 -- After combining the avails, we need to ensure that the parent name is the
 736 -- first entry in the list of subnames, if it is included at all.  (Subsequent
 737 -- functions rely on that.)
 738 normaliseAvail :: AvailInfo -> AvailInfo
 739 normaliseAvail avail@(Avail _)     = avail
 740 normaliseAvail (AvailTC name subs) = AvailTC name subs'
 741   where
 742     subs' = if name `elem` subs then name : (delete name subs) else subs
 743
 744 -- | combines 'AvailInfo's from the same family
 745 nubAvails :: [AvailInfo] -> [AvailInfo]
 746 nubAvails avails = map normaliseAvail . nameEnvElts . mkAvailEnv $ avails
 747 \end{code}
 748
 749
 750 %************************************************************************
 751 %*                                                                      *
 752 \subsection{Export list processing}
 753 %*                                                                      *
 754 %************************************************************************
 755
 756 Processing the export list.
 757
 758 You might think that we should record things that appear in the export
 759 list as ``occurrences'' (using @addOccurrenceName@), but you'd be
 760 wrong.  We do check (here) that they are in scope, but there is no
 761 need to slurp in their actual declaration (which is what
 762 @addOccurrenceName@ forces).
 763
 764 Indeed, doing so would big trouble when compiling @PrelBase@, because
 765 it re-exports @GHC@, which includes @takeMVar#@, whose type includes
 766 @ConcBase.StateAndSynchVar#@, and so on...
 767
 768 \begin{code}
 769 type ExportAccum        -- The type of the accumulating parameter of
 770                         -- the main worker function in rnExports
 771      = ([LIE Name],             -- Export items with Names
 772         ExportOccMap,           -- Tracks exported occurrence names
 773         [AvailInfo])            -- The accumulated exported stuff
 774                                 --   Not nub'd!
 775
 776 emptyExportAccum :: ExportAccum
 777 emptyExportAccum = ([], emptyOccEnv, [])
 778
 779 type ExportOccMap = OccEnv (Name, IE RdrName)
 780         -- Tracks what a particular exported OccName
 781         --   in an export list refers to, and which item
 782         --   it came from.  It's illegal to export two distinct things
 783         --   that have the same occurrence name
 784
 785 rnExports :: Bool       -- False => no 'module M(..) where' header at all
 786           -> Maybe [LIE RdrName]        -- Nothing => no explicit export list
 787           -> TcGblEnv
 788           -> RnM TcGblEnv
 789
 790         -- Complains if two distinct exports have same OccName
 791         -- Warns about identical exports.
 792         -- Complains about exports items not in scope
 793
 794 rnExports explicit_mod exports
 795           tcg_env@(TcGblEnv { tcg_mod     = this_mod,
 796                               tcg_rdr_env = rdr_env,
 797                               tcg_imports = imports })
 798  = do   {
 799         -- If the module header is omitted altogether, then behave
 800         -- as if the user had written "module Main(main) where..."
 801         -- EXCEPT in interactive mode, when we behave as if he had
 802         -- written "module Main where ..."
 803         -- Reason: don't want to complain about 'main' not in scope
 804         --         in interactive mode
 805         ; dflags <- getDOpts
 806         ; let real_exports
 807                  | explicit_mod = exports
 808                  | ghcLink dflags == LinkInMemory = Nothing
 809                  | otherwise = Just ([noLoc (IEVar main_RDR_Unqual)])
 810                         -- ToDo: the 'noLoc' here is unhelpful if 'main'
 811                         --       turns out to be out of scope
 812
 813         ; (rn_exports, avails) <- exports_from_avail real_exports rdr_env imports this_mod
 814         ; let final_avails = nubAvails avails        -- Combine families
 815
 816         ; return (tcg_env { tcg_exports    = final_avails,
 817                             tcg_rn_exports = case tcg_rn_exports tcg_env of
 818                                                 Nothing -> Nothing
 819                                                 Just _  -> rn_exports,
 820                             tcg_dus = tcg_dus tcg_env `plusDU`
 821                                       usesOnly (availsToNameSet final_avails) }) }
 822
 823 exports_from_avail :: Maybe [LIE RdrName]
 824                          -- Nothing => no explicit export list
 825                    -> GlobalRdrEnv
 826                    -> ImportAvails
 827                    -> Module
 828                    -> RnM (Maybe [LIE Name], [AvailInfo])
 829
 830 exports_from_avail Nothing rdr_env _imports _this_mod
 831  = -- The same as (module M) where M is the current module name,
 832    -- so that's how we handle it.
 833    let
 834        avails = [ greAvail gre | gre <- globalRdrEnvElts rdr_env,
 835                                  isLocalGRE gre ]
 836    in
 837    return (Nothing, avails)
 838
 839 exports_from_avail (Just rdr_items) rdr_env imports this_mod
 840   = do (ie_names, _, exports) <- foldlM do_litem emptyExportAccum rdr_items
 841
 842        return (Just ie_names, exports)
 843   where
 844     do_litem :: ExportAccum -> LIE RdrName -> RnM ExportAccum
 845     do_litem acc lie = setSrcSpan (getLoc lie) (exports_from_item acc lie)
 846
 847     kids_env :: NameEnv [Name]  -- Maps a parent to its in-scope children
 848     kids_env = mkChildEnv (globalRdrEnvElts rdr_env)
 849
 850     imported_modules = [ qual_name
 851                        | xs <- moduleEnvElts $ imp_mods imports,
 852                          (qual_name, _, _) <- xs ]
 853
 854     exports_from_item :: ExportAccum -> LIE RdrName -> RnM ExportAccum
 855     exports_from_item acc@(ie_names, occs, exports)
 856                       (L loc ie@(IEModuleContents mod))
 857         | let earlier_mods = [ mod | (L _ (IEModuleContents mod)) <- ie_names ]
 858         , mod `elem` earlier_mods       -- Duplicate export of M
 859         = do { warn_dup_exports <- doptM Opt_WarnDuplicateExports ;
 860                warnIf warn_dup_exports (dupModuleExport mod) ;
 861                return acc }
 862
 863         | otherwise
 864         = do { implicit_prelude <- doptM Opt_ImplicitPrelude
 865              ; warnDodgyExports <- doptM Opt_WarnDodgyExports
 866              ; let { exportValid = (mod `elem` imported_modules)
 867                             || (moduleName this_mod == mod)
 868                    ; gres = filter (isModuleExported implicit_prelude mod)
 869                                    (globalRdrEnvElts rdr_env)
 870                    ; names = map gre_name gres
 871                    }
 872
 873              ; checkErr exportValid (moduleNotImported mod)
 874              ; warnIf (warnDodgyExports && exportValid && null gres) (nullModuleExport mod)
 875
 876              ; addUsedRdrNames (concat [ [mkRdrQual mod occ, mkRdrUnqual occ]
 877                                        | occ <- map nameOccName names ])
 878                         -- The qualified and unqualified version of all of
 879                         -- these names are, in effect, used by this export
 880
 881              ; occs' <- check_occs ie occs names
 882                       -- This check_occs not only finds conflicts
 883                       -- between this item and others, but also
 884                       -- internally within this item.  That is, if
 885                       -- 'M.x' is in scope in several ways, we'll have
 886                       -- several members of mod_avails with the same
 887                       -- OccName.
 888              ; return (L loc (IEModuleContents mod) : ie_names,
 889                        occs', map greAvail gres ++ exports) }
 890
 891     exports_from_item acc@(lie_names, occs, exports) (L loc ie)
 892         | isDoc ie
 893         = do new_ie <- lookup_doc_ie ie
 894              return (L loc new_ie : lie_names, occs, exports)
 895
 896         | otherwise
 897         = do (new_ie, avail) <- lookup_ie ie
 898              if isUnboundName (ieName new_ie)
 899                   then return acc       -- Avoid error cascade
 900                   else do
 901
 902              occs' <- check_occs ie occs (availNames avail)
 903
 904              return (L loc new_ie : lie_names, occs', avail : exports)
 905
 906     -------------
 907     lookup_ie :: IE RdrName -> RnM (IE Name, AvailInfo)
 908     lookup_ie (IEVar rdr)
 909         = do gre <- lookupGreRn rdr
 910              return (IEVar (gre_name gre), greAvail gre)
 911
 912     lookup_ie (IEThingAbs rdr)
 913         = do gre <- lookupGreRn rdr
 914              let name = gre_name gre
 915              case gre_par gre of
 916                 NoParent   -> return (IEThingAbs name,
 917                                       AvailTC name [name])
 918                 ParentIs p -> return (IEThingAbs name,
 919                                       AvailTC p [name])
 920
 921     lookup_ie ie@(IEThingAll rdr)
 922         = do name <- lookupGlobalOccRn rdr
 923              let kids = findChildren kids_env name
 924                  mkKidRdrName = case isQual_maybe rdr of
 925                                 Nothing -> mkRdrUnqual
 926                                 Just (modName, _) -> mkRdrQual modName
 927              addUsedRdrNames $ map (mkKidRdrName . nameOccName) kids
 928              warnDodgyExports <- doptM Opt_WarnDodgyExports
 929              when (null kids) $
 930                   if isTyConName name
 931                   then when warnDodgyExports $ addWarn (dodgyExportWarn name)
 932                   else -- This occurs when you export T(..), but
 933                        -- only import T abstractly, or T is a synonym.
 934                        addErr (exportItemErr ie)
 935
 936              return (IEThingAll name, AvailTC name (name:kids))
 937
 938     lookup_ie ie@(IEThingWith rdr sub_rdrs)
 939         = do name <- lookupGlobalOccRn rdr
 940              if isUnboundName name
 941                 then return (IEThingWith name [], AvailTC name [name])
 942                 else do
 943              let env = mkOccEnv [ (nameOccName s, s)
 944                                 | s <- findChildren kids_env name ]
 945                  mb_names = map (lookupOccEnv env . rdrNameOcc) sub_rdrs
 946              if any isNothing mb_names
 947                 then do addErr (exportItemErr ie)
 948                         return (IEThingWith name [], AvailTC name [name])
 949                 else do let names = catMaybes mb_names
 950                         optTyFam <- doptM Opt_TypeFamilies
 951                         when (not optTyFam && any isTyConName names) $
 952                           addErr (typeItemErr ( head
 953                                               . filter isTyConName
 954                                               $ names )
 955                                               (text "in export list"))
 956                         return (IEThingWith name names, AvailTC name (name:names))
 957
 958     lookup_ie _ = panic "lookup_ie"     -- Other cases covered earlier
 959
 960     -------------
 961     lookup_doc_ie :: IE RdrName -> RnM (IE Name)
 962     lookup_doc_ie (IEGroup lev doc) = do rn_doc <- rnHsDoc doc
 963                                          return (IEGroup lev rn_doc)
 964     lookup_doc_ie (IEDoc doc)       = do rn_doc <- rnHsDoc doc
 965                                          return (IEDoc rn_doc)
 966     lookup_doc_ie (IEDocNamed str)  = return (IEDocNamed str)
 967     lookup_doc_ie _ = panic "lookup_doc_ie"     -- Other cases covered earlier
 968
 969
 970 isDoc :: IE RdrName -> Bool
 971 isDoc (IEDoc _)      = True
 972 isDoc (IEDocNamed _) = True
 973 isDoc (IEGroup _ _)  = True
 974 isDoc _ = False
 975
 976 -------------------------------
 977 isModuleExported :: Bool -> ModuleName -> GlobalRdrElt -> Bool
 978 -- True if the thing is in scope *both* unqualified, *and* with qualifier M
 979 isModuleExported implicit_prelude mod (GRE { gre_name = name, gre_prov = prov })
 980   | implicit_prelude && isBuiltInSyntax name = False
 981         -- Optimisation: filter out names for built-in syntax
 982         -- They just clutter up the environment (esp tuples), and the parser
 983         -- will generate Exact RdrNames for them, so the cluttered
 984         -- envt is no use.  To avoid doing this filter all the time,
 985         -- we use -XNoImplicitPrelude as a clue that the filter is
 986         -- worth while.  Really, it's only useful for GHC.Base and GHC.Tuple.
 987         --
 988         -- It's worth doing because it makes the environment smaller for
 989         -- every module that imports the Prelude
 990   | otherwise
 991   = case prov of
 992         LocalDef | Just name_mod <- nameModule_maybe name
 993                  -> moduleName name_mod == mod
 994                  | otherwise -> False
 995         Imported is -> any unQualSpecOK is && any (qualSpecOK mod) is
 996
 997 -------------------------------
 998 check_occs :: IE RdrName -> ExportOccMap -> [Name] -> RnM ExportOccMap
 999 check_occs ie occs names
1000   = foldlM check occs names
1001   where
1002     check occs name
1003       = case lookupOccEnv occs name_occ of
1004           Nothing -> return (extendOccEnv occs name_occ (name, ie))
1005
1006           Just (name', ie')
1007             | name == name'     -- Duplicate export
1008             ->  do { warn_dup_exports <- doptM Opt_WarnDuplicateExports ;
1009                      warnIf warn_dup_exports (dupExportWarn name_occ ie ie') ;
1010                      return occs }
1011
1012             | otherwise         -- Same occ name but different names: an error
1013             ->  do { global_env <- getGlobalRdrEnv ;
1014                      addErr (exportClashErr global_env name' name ie' ie) ;
1015                      return occs }
1016       where
1017         name_occ = nameOccName name
1018 \end{code}
1019
1020 %*********************************************************
1021 %*                                                       *
1022                 Deprecations
1023 %*                                                       *
1024 %*********************************************************
1025
1026 \begin{code}
1027 finishWarnings :: DynFlags -> Maybe WarningTxt
1028                -> TcGblEnv -> RnM TcGblEnv
1029 -- (a) Report usage of imports that are deprecated or have other warnings
1030 -- (b) If the whole module is warned about or deprecated, update tcg_warns
1031 --     All this happens only once per module
1032 finishWarnings dflags mod_warn tcg_env
1033   = do  { (eps,hpt) <- getEpsAndHpt
1034         ; ifOptM Opt_WarnWarningsDeprecations $
1035           mapM_ (check hpt (eps_PIT eps)) all_gres
1036                 -- By this time, typechecking is complete,
1037                 -- so the PIT is fully populated
1038
1039         -- Deal with a module deprecation; it overrides all existing warns
1040         ; let new_warns = case mod_warn of
1041                                 Just txt -> WarnAll txt
1042                                 Nothing  -> tcg_warns tcg_env
1043         ; return (tcg_env { tcg_warns = new_warns }) }
1044   where
1045     used_names = allUses (tcg_dus tcg_env)
1046         -- Report on all deprecated uses; hence allUses
1047     all_gres   = globalRdrEnvElts (tcg_rdr_env tcg_env)
1048
1049     check hpt pit gre@(GRE {gre_name = name, gre_prov = Imported (imp_spec:_)})
1050       | name `elemNameSet` used_names
1051       , Just deprec_txt <- lookupImpDeprec dflags hpt pit gre
1052       = addWarnAt (importSpecLoc imp_spec)
1053                   (sep [ptext (sLit "In the use of") <+>
1054                         pprNonVarNameSpace (occNameSpace (nameOccName name)) <+>
1055                         quotes (ppr name),
1056                       (parens imp_msg) <> colon,
1057                       (ppr deprec_txt) ])
1058         where
1059           name_mod = ASSERT2( isExternalName name, ppr name ) nameModule name
1060           imp_mod  = importSpecModule imp_spec
1061           imp_msg  = ptext (sLit "imported from") <+> ppr imp_mod <> extra
1062           extra | imp_mod == moduleName name_mod = empty
1063                 | otherwise = ptext (sLit ", but defined in") <+> ppr name_mod
1064
1065     check _ _ _ = return ()     -- Local, or not used, or not deprectated
1066             -- The Imported pattern-match: don't deprecate locally defined names
1067             -- For a start, we may be exporting a deprecated thing
1068             -- Also we may use a deprecated thing in the defn of another
1069             -- deprecated things.  We may even use a deprecated thing in
1070             -- the defn of a non-deprecated thing, when changing a module's
1071             -- interface
1072
1073 lookupImpDeprec :: DynFlags -> HomePackageTable -> PackageIfaceTable
1074                 -> GlobalRdrElt -> Maybe WarningTxt
1075 -- The name is definitely imported, so look in HPT, PIT
1076 lookupImpDeprec dflags hpt pit gre
1077   = case lookupIfaceByModule dflags hpt pit mod of
1078         Just iface -> mi_warn_fn iface name `mplus`     -- Bleat if the thing, *or
1079                       case gre_par gre of
1080                         ParentIs p -> mi_warn_fn iface p        -- its parent*, is warn'd
1081                         NoParent   -> Nothing
1082
1083         Nothing -> Nothing      -- See Note [Used names with interface not loaded]
1084   where
1085     name = gre_name gre
1086     mod = ASSERT2( isExternalName name, ppr name ) nameModule name
1087 \end{code}
1088
1089 Note [Used names with interface not loaded]
1090 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1091 By now all the interfaces should have been loaded,
1092 because reportDeprecations happens after typechecking.
1093 However, it's still (just) possible to to find a used
1094 Name whose interface hasn't been loaded:
1095
1096 a) It might be a WiredInName; in that case we may not load
1097    its interface (although we could).
1098
1099 b) It might be GHC.Real.fromRational, or GHC.Num.fromInteger
1100    These are seen as "used" by the renamer (if -XNoImplicitPrelude)
1101    is on), but the typechecker may discard their uses
1102    if in fact the in-scope fromRational is GHC.Read.fromRational,
1103    (see tcPat.tcOverloadedLit), and the typechecker sees that the type
1104    is fixed, say, to GHC.Base.Float (see Inst.lookupSimpleInst).
1105    In that obscure case it won't force the interface in.
1106
1107 In both cases we simply don't permit deprecations;
1108 this is, after all, wired-in stuff.
1109
1110
1111 %*********************************************************
1112 %*                                                       *
1113                 Unused names
1114 %*                                                       *
1115 %*********************************************************
1116
1117 \begin{code}
1118 reportUnusedNames :: Maybe [LIE RdrName]        -- Export list
1119                   -> TcGblEnv -> RnM ()
1120 reportUnusedNames _export_decls gbl_env
1121   = do  { traceRn ((text "RUN") <+> (ppr (tcg_dus gbl_env)))
1122         ; warnUnusedImportDecls gbl_env
1123         ; warnUnusedTopBinds   unused_locals }
1124   where
1125     used_names :: NameSet
1126     used_names = findUses (tcg_dus gbl_env) emptyNameSet
1127         -- NB: currently, if f x = g, we only treat 'g' as used if 'f' is used
1128         -- Hence findUses
1129
1130         -- Collect the defined names from the in-scope environment
1131     defined_names :: [GlobalRdrElt]
1132     defined_names = globalRdrEnvElts (tcg_rdr_env gbl_env)
1133
1134         -- Note that defined_and_used, defined_but_not_used
1135         -- are both [GRE]; that's why we need defined_and_used
1136         -- rather than just used_names
1137     _defined_and_used, defined_but_not_used :: [GlobalRdrElt]
1138     (_defined_and_used, defined_but_not_used)
1139         = partition (gre_is_used used_names) defined_names
1140
1141     kids_env = mkChildEnv defined_names
1142         -- This is done in mkExports too; duplicated work
1143
1144     gre_is_used :: NameSet -> GlobalRdrElt -> Bool
1145     gre_is_used used_names (GRE {gre_name = name})
1146         = name `elemNameSet` used_names
1147           || any (`elemNameSet` used_names) (findChildren kids_env name)
1148                 -- A use of C implies a use of T,
1149                 -- if C was brought into scope by T(..) or T(C)
1150
1151         -- Filter out the ones that are
1152         --  (a) defined in this module, and
1153         --  (b) not defined by a 'deriving' clause
1154         -- The latter have an Internal Name, so we can filter them out easily
1155     unused_locals :: [GlobalRdrElt]
1156     unused_locals = filter is_unused_local defined_but_not_used
1157     is_unused_local :: GlobalRdrElt -> Bool
1158     is_unused_local gre = isLocalGRE gre && isExternalName (gre_name gre)
1159 \end{code}
1160
1161 %*********************************************************
1162 %*                                                       *
1163                 Unused imports
1164 %*                                                       *
1165 %*********************************************************
1166
1167 This code finds which import declarations are unused.  The
1168 specification and implementation notes are here:
1169   http://hackage.haskell.org/trac/ghc/wiki/Commentary/Compiler/UnusedImports
1170
1171 \begin{code}
1172 type ImportDeclUsage
1173    = ( LImportDecl Name   -- The import declaration
1174      , [AvailInfo]        -- What *is* used (normalised)
1175      , [Name] )           -- What is imported but *not* used
1176 \end{code}
1177
1178 \begin{code}
1179 warnUnusedImportDecls :: TcGblEnv -> RnM ()
1180 warnUnusedImportDecls gbl_env
1181   = do { uses <- readMutVar (tcg_used_rdrnames gbl_env)
1182        ; let imports = filter explicit_import (tcg_rn_imports gbl_env)
1183              rdr_env = tcg_rdr_env gbl_env
1184
1185        ; let usage :: [ImportDeclUsage]
1186              usage = findImportUsage imports rdr_env (Set.elems uses)
1187
1188        ; ifOptM Opt_WarnUnusedImports $
1189          mapM_ warnUnusedImport usage
1190
1191        ; ifOptM Opt_D_dump_minimal_imports $
1192          printMinimalImports usage }
1193   where
1194     explicit_import (L loc _) = isGoodSrcSpan loc
1195         -- Filter out the implicit Prelude import
1196         -- which we do not want to bleat about
1197 \end{code}
1198
1199 \begin{code}
1200 findImportUsage :: [LImportDecl Name]
1201                 -> GlobalRdrEnv
1202                 -> [RdrName]
1203                 -> [ImportDeclUsage]
1204
1205 type ImportMap = FiniteMap SrcLoc [AvailInfo]
1206   -- The intermediate data struture records, for each import
1207   -- declaration, what stuff brought into scope by that
1208   -- declaration is actually used in the module.
1209   --
1210   -- The SrcLoc is the location of the start
1211   -- of a particular 'import' declaration
1212   --
1213   -- The AvailInfos are the things imported from that decl
1214   -- (just a list, not normalised)
1215
1216 findImportUsage imports rdr_env rdrs
1217   = map unused_decl imports
1218   where
1219     import_usage :: ImportMap
1220     import_usage = foldr add_rdr emptyFM rdrs
1221
1222     unused_decl decl@(L loc (ImportDecl { ideclHiding = imps }))
1223       = (decl, nubAvails used_avails, unused_imps)
1224       where
1225         used_avails = lookupFM import_usage (srcSpanStart loc) `orElse` []
1226         used_names = availsToNameSet used_avails
1227
1228         unused_imps = case imps of
1229                         Just (False, imp_ies) -> nameSetToList unused_imps
1230                           where
1231                             imp_names = mkNameSet (concatMap (ieNames . unLoc) imp_ies)
1232                             unused_imps = imp_names `minusNameSet` used_names
1233
1234                         _other -> []    -- No explicit import list => no unused-name list
1235
1236     add_rdr :: RdrName -> ImportMap -> ImportMap
1237     add_rdr rdr iu
1238       = case lookupGRE_RdrName rdr rdr_env of
1239           [gre]   | Imported imps <- gre_prov gre
1240                   -> add_imp gre (bestImport imps) iu
1241           _other  -> iu
1242
1243     add_imp :: GlobalRdrElt -> ImportSpec -> ImportMap -> ImportMap
1244     add_imp gre (ImpSpec { is_decl = imp_decl_spec }) iu
1245       = addToFM_C add iu decl_loc [avail]
1246       where
1247         add avails _ = avail : avails
1248         decl_loc = srcSpanStart (is_dloc imp_decl_spec)
1249         name     = gre_name gre
1250         avail    = case gre_par gre of
1251                       ParentIs p                  -> AvailTC p [p,name]
1252                       NoParent | isTyConName name -> AvailTC name [name]
1253                                | otherwise        -> Avail name
1254                 -- If you use (+) from Num, then for this purpose we want
1255                 -- to say that Num is used as well.  That is why in the
1256                 -- ParentIs case we have [p,name] in the ParentIs case
1257
1258 bestImport :: [ImportSpec] -> ImportSpec
1259 bestImport iss
1260   = case partition isImpAll iss of
1261       ([], imp_somes) -> textuallyFirst imp_somes
1262       (imp_alls, _)   -> textuallyFirst imp_alls
1263
1264 textuallyFirst :: [ImportSpec] -> ImportSpec
1265 textuallyFirst iss = case sortWith (is_dloc . is_decl) iss of
1266                         []     -> pprPanic "textuallyFirst" (ppr iss)
1267                         (is:_) -> is
1268
1269 isImpAll :: ImportSpec -> Bool
1270 isImpAll (ImpSpec { is_item = ImpAll }) = True
1271 isImpAll _other                         = False
1272 \end{code}
1273
1274 \begin{code}
1275 warnUnusedImport :: ImportDeclUsage -> RnM ()
1276 warnUnusedImport (L loc decl, used, unused)
1277   | Just (False,[]) <- ideclHiding decl
1278                 = return ()            -- Do not warn for 'import M()'
1279   | null used   = addWarnAt loc msg1   -- Nothing used; drop entire decl
1280   | null unused = return ()            -- Everything imported is used; nop
1281   | otherwise   = addWarnAt loc msg2   -- Some imports are unused
1282   where
1283     msg1 = vcat [pp_herald <+> quotes pp_mod <+> pp_not_used,
1284                  nest 2 (ptext (sLit "except perhaps to import instances from")
1285                                    <+> quotes pp_mod),
1286                  ptext (sLit "To import instances alone, use:")
1287                                    <+> ptext (sLit "import") <+> pp_mod <> parens empty ]
1288     msg2 = sep [pp_herald <+> quotes (pprWithCommas ppr unused),
1289                     text "from module" <+> quotes pp_mod <+> pp_not_used]
1290     pp_herald   = text "The import of"
1291     pp_mod      = ppr (unLoc (ideclName decl))
1292     pp_not_used = text "is redundant"
1293 \end{code}
1294
1295 To print the minimal imports we walk over the user-supplied import
1296 decls, and simply trim their import lists.  NB that
1297
1298   * We do *not* change the 'qualified' or 'as' parts!
1299
1300   * We do not disard a decl altogether; we might need instances
1301     from it.  Instead we just trim to an empty import list
1302
1303 \begin{code}
1304 printMinimalImports :: [ImportDeclUsage] -> RnM ()
1305 printMinimalImports imports_w_usage
1306   = do { imports' <- mapM mk_minimal imports_w_usage
1307        ; this_mod <- getModule
1308        ; liftIO $
1309          do { h <- openFile (mkFilename this_mod) WriteMode
1310             ; printForUser h neverQualify (vcat (map ppr imports')) }
1311                 -- The neverQualify is important.  We are printing Names
1312                 -- but they are in the context of an 'import' decl, and
1313                 -- we never qualify things inside there
1314                 -- E.g.   import Blag( f, b )
1315                 -- not    import Blag( Blag.f, Blag.g )!
1316        }
1317   where
1318     mkFilename this_mod = moduleNameString (moduleName this_mod) ++ ".imports"
1319
1320     mk_minimal (L l decl, used, unused)
1321       | null unused
1322       , Just (False, _) <- ideclHiding decl
1323       = return (L l decl)
1324       | otherwise
1325       = do { ies <- initIfaceTcRn $ mapM to_ie used
1326            ; return (L l (decl { ideclHiding = Just (False, map (L l) ies)  })) }
1327
1328     to_ie :: AvailInfo -> IfG (IE Name)
1329         -- The main trick here is that if we're importing all the constructors
1330         -- we want to say "T(..)", but if we're importing only a subset we want
1331         -- to say "T(A,B,C)".  So we have to find out what the module exports.
1332     to_ie (Avail n)       = return (IEVar n)
1333     to_ie (AvailTC n [m]) = ASSERT( n==m )
1334                             return (IEThingAbs n)
1335     to_ie (AvailTC n ns)  = do
1336           iface <- loadSysInterface doc n_mod
1337           case [xs | (m,as) <- mi_exports iface,
1338                      m == n_mod,
1339                      AvailTC x xs <- as,
1340                      x == nameOccName n] of
1341               [xs] | all_used xs -> return (IEThingAll n)
1342                    | otherwise   -> return (IEThingWith n (filter (/= n) ns))
1343               other              -> pprTrace "to_ie" (ppr n <+> ppr n_mod <+> ppr other) $
1344                                     return (IEVar n)
1345         where
1346           all_used avail_occs = all (`elem` map nameOccName ns) avail_occs
1347           doc = text "Compute minimal imports from" <+> ppr n
1348           n_mod = ASSERT( isExternalName n ) nameModule n
1349 \end{code}
1350
1351 %************************************************************************
1352 %*                                                                      *
1353 \subsection{Errors}
1354 %*                                                                      *
1355 %************************************************************************
1356
1357 \begin{code}
1358 qualImportItemErr :: RdrName -> SDoc
1359 qualImportItemErr rdr
1360   = hang (ptext (sLit "Illegal qualified name in import item:"))
1361        2 (ppr rdr)
1362
1363 badImportItemErr :: ModIface -> ImpDeclSpec -> IE RdrName -> SDoc
1364 badImportItemErr iface decl_spec ie
1365   = sep [ptext (sLit "Module"), quotes (ppr (is_mod decl_spec)), source_import,
1366          ptext (sLit "does not export"), quotes (ppr ie)]
1367   where
1368     source_import | mi_boot iface = ptext (sLit "(hi-boot interface)")
1369                   | otherwise     = empty
1370
1371 illegalImportItemErr :: SDoc
1372 illegalImportItemErr = ptext (sLit "Illegal import item")
1373
1374 dodgyImportWarn :: RdrName -> SDoc
1375 dodgyImportWarn item = dodgyMsg (ptext (sLit "import")) item
1376 dodgyExportWarn :: Name -> SDoc
1377 dodgyExportWarn item = dodgyMsg (ptext (sLit "export")) item
1378
1379 dodgyMsg :: OutputableBndr n => SDoc -> n -> SDoc
1380 dodgyMsg kind tc
1381   = sep [ ptext (sLit "The") <+> kind <+> ptext (sLit "item") <+> quotes (ppr (IEThingAll tc))
1382                 <+> ptext (sLit "suggests that"),
1383           quotes (ppr tc) <+> ptext (sLit "has (in-scope) constructors or class methods,"),
1384           ptext (sLit "but it has none") ]
1385
1386 exportItemErr :: IE RdrName -> SDoc
1387 exportItemErr export_item
1388   = sep [ ptext (sLit "The export item") <+> quotes (ppr export_item),
1389           ptext (sLit "attempts to export constructors or class methods that are not visible here") ]
1390
1391 typeItemErr :: Name -> SDoc -> SDoc
1392 typeItemErr name wherestr
1393   = sep [ ptext (sLit "Using 'type' tag on") <+> quotes (ppr name) <+> wherestr,
1394           ptext (sLit "Use -XTypeFamilies to enable this extension") ]
1395
1396 exportClashErr :: GlobalRdrEnv -> Name -> Name -> IE RdrName -> IE RdrName
1397                -> Message
1398 exportClashErr global_env name1 name2 ie1 ie2
1399   = vcat [ ptext (sLit "Conflicting exports for") <+> quotes (ppr occ) <> colon
1400          , ppr_export ie1' name1'
1401          , ppr_export ie2' name2' ]
1402   where
1403     occ = nameOccName name1
1404     ppr_export ie name = nest 2 (quotes (ppr ie) <+> ptext (sLit "exports") <+>
1405                                  quotes (ppr name) <+> pprNameProvenance (get_gre name))
1406
1407         -- get_gre finds a GRE for the Name, so that we can show its provenance
1408     get_gre name
1409         = case lookupGRE_Name global_env name of
1410              (gre:_) -> gre
1411              []      -> pprPanic "exportClashErr" (ppr name)
1412     get_loc name = nameSrcLoc $ gre_name $ get_gre name
1413     (name1', ie1', name2', ie2') = if get_loc name1 < get_loc name2
1414                                    then (name1, ie1, name2, ie2)
1415                                    else (name2, ie2, name1, ie1)
1416
1417 addDupDeclErr :: [Name] -> TcRn ()
1418 addDupDeclErr []
1419   = panic "addDupDeclErr: empty list"
1420 addDupDeclErr names@(name : _)
1421   = addErrAt (getSrcSpan (last sorted_names)) $
1422         -- Report the error at the later location
1423     vcat [ptext (sLit "Multiple declarations of") <+> quotes (ppr name),
1424           ptext (sLit "Declared at:") <+> vcat (map (ppr . nameSrcLoc) sorted_names)]
1425   where
1426     sorted_names = sortWith nameSrcLoc names
1427
1428 dupExportWarn :: OccName -> IE RdrName -> IE RdrName -> SDoc
1429 dupExportWarn occ_name ie1 ie2
1430   = hsep [quotes (ppr occ_name),
1431           ptext (sLit "is exported by"), quotes (ppr ie1),
1432           ptext (sLit "and"),            quotes (ppr ie2)]
1433
1434 dupModuleExport :: ModuleName -> SDoc
1435 dupModuleExport mod
1436   = hsep [ptext (sLit "Duplicate"),
1437           quotes (ptext (sLit "Module") <+> ppr mod),
1438           ptext (sLit "in export list")]
1439
1440 moduleNotImported :: ModuleName -> SDoc
1441 moduleNotImported mod
1442   = ptext (sLit "The export item `module") <+> ppr mod <>
1443     ptext (sLit "' is not imported")
1444
1445 nullModuleExport :: ModuleName -> SDoc
1446 nullModuleExport mod
1447   = ptext (sLit "The export item `module") <+> ppr mod <> ptext (sLit "' exports nothing")
1448
1449 moduleWarn :: ModuleName -> WarningTxt -> SDoc
1450 moduleWarn mod (WarningTxt txt)
1451   = sep [ ptext (sLit "Module") <+> quotes (ppr mod) <> ptext (sLit ":"),
1452           nest 2 (vcat (map ppr txt)) ]
1453 moduleWarn mod (DeprecatedTxt txt)
1454   = sep [ ptext (sLit "Module") <+> quotes (ppr mod)
1455                                 <+> ptext (sLit "is deprecated:"),
1456           nest 2 (vcat (map ppr txt)) ]
1457
1458 implicitPreludeWarn :: SDoc
1459 implicitPreludeWarn
1460   = ptext (sLit "Module `Prelude' implicitly imported")
1461
1462 packageImportErr :: SDoc
1463 packageImportErr
1464   = ptext (sLit "Package-qualified imports are not enabled; use -XPackageImports")
1465 \end{code}