compiler/rename/RnNames.lhs

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