compiler/rename/RnNames.lhs

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