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, 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         is_orph    = 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 | is_orph   = 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           -> RnM (Maybe [LIE Name], [AvailInfo])
 694
 695         -- Complains if two distinct exports have same OccName
 696         -- Warns about identical exports.
 697         -- Complains about exports items not in scope
 698
 699 rnExports explicit_mod exports
 700  = do TcGblEnv { tcg_mod     = this_mod,
 701                  tcg_rdr_env = rdr_env,
 702                  tcg_imports = imports } <- getGblEnv
 703
 704         -- If the module header is omitted altogether, then behave
 705         -- as if the user had written "module Main(main) where..."
 706         -- EXCEPT in interactive mode, when we behave as if he had
 707         -- written "module Main where ..."
 708         -- Reason: don't want to complain about 'main' not in scope
 709         --         in interactive mode
 710       ghc_mode <- getGhcMode
 711       real_exports <-
 712           case () of
 713             () | explicit_mod
 714                    -> return exports
 715                | ghc_mode == Interactive
 716                    -> return Nothing
 717                | otherwise
 718                    -> do mainName <- lookupGlobalOccRn main_RDR_Unqual
 719                          return (Just ([noLoc (IEVar main_RDR_Unqual)]))
 720                 -- ToDo: the 'noLoc' here is unhelpful if 'main' turns
 721                 -- out to be out of scope
 722
 723       (exp_spec, avails) <- exports_from_avail real_exports rdr_env imports this_mod
 724
 725       return (exp_spec, nubAvails avails)     -- Combine families
 726
 727 exports_from_avail :: Maybe [LIE RdrName]
 728                          -- Nothing => no explicit export list
 729                    -> GlobalRdrEnv
 730                    -> ImportAvails
 731                    -> Module
 732                    -> RnM (Maybe [LIE Name], [AvailInfo])
 733
 734 exports_from_avail Nothing rdr_env imports this_mod
 735  = -- The same as (module M) where M is the current module name,
 736    -- so that's how we handle it.
 737    let
 738        avails = [ greAvail gre | gre <- globalRdrEnvElts rdr_env,
 739                                  isLocalGRE gre ]
 740    in
 741    return (Nothing, avails)
 742
 743 exports_from_avail (Just rdr_items) rdr_env imports this_mod
 744   = do (ie_names, _, exports) <- foldlM do_litem emptyExportAccum rdr_items
 745
 746        return (Just ie_names, exports)
 747   where
 748     do_litem :: ExportAccum -> LIE RdrName -> RnM ExportAccum
 749     do_litem acc lie = setSrcSpan (getLoc lie) (exports_from_item acc lie)
 750
 751     kids_env :: NameEnv [Name]  -- Maps a parent to its in-scope children
 752     kids_env = mkChildEnv (globalRdrEnvElts rdr_env)
 753
 754     exports_from_item :: ExportAccum -> LIE RdrName -> RnM ExportAccum
 755     exports_from_item acc@(ie_names, occs, exports)
 756                       (L loc ie@(IEModuleContents mod))
 757         | let earlier_mods = [ mod | (L _ (IEModuleContents mod)) <- ie_names ]
 758         , mod `elem` earlier_mods       -- Duplicate export of M
 759         = do { warn_dup_exports <- doptM Opt_WarnDuplicateExports ;
 760                warnIf warn_dup_exports (dupModuleExport mod) ;
 761                returnM acc }
 762
 763         | otherwise
 764         = do { implicit_prelude <- doptM Opt_ImplicitPrelude
 765              ; let gres = filter (isModuleExported implicit_prelude mod)
 766                                  (globalRdrEnvElts rdr_env)
 767
 768              ; warnIf (null gres) (nullModuleExport mod)
 769
 770              ; occs' <- check_occs ie occs (map gre_name gres)
 771                       -- This check_occs not only finds conflicts
 772                       -- between this item and others, but also
 773                       -- internally within this item.  That is, if
 774                       -- 'M.x' is in scope in several ways, we'll have
 775                       -- several members of mod_avails with the same
 776                       -- OccName.
 777              ; return (L loc (IEModuleContents mod) : ie_names,
 778                        occs', map greAvail gres ++ exports) }
 779
 780     exports_from_item acc@(lie_names, occs, exports) (L loc ie)
 781         | isDoc ie
 782         = do new_ie <- lookup_doc_ie ie
 783              return (L loc new_ie : lie_names, occs, exports)
 784
 785         | otherwise
 786         = do (new_ie, avail) <- lookup_ie ie
 787              if isUnboundName (ieName new_ie)
 788                   then return acc       -- Avoid error cascade
 789                   else do
 790
 791              occs' <- check_occs ie occs (availNames avail)
 792
 793              return (L loc new_ie : lie_names, occs', avail : exports)
 794
 795     -------------
 796     lookup_ie :: IE RdrName -> RnM (IE Name, AvailInfo)
 797     lookup_ie (IEVar rdr)
 798         = do gre <- lookupGreRn rdr
 799              return (IEVar (gre_name gre), greAvail gre)
 800
 801     lookup_ie (IEThingAbs rdr)
 802         = do gre <- lookupGreRn rdr
 803              let name = gre_name gre
 804              case gre_par gre of
 805                 NoParent   -> return (IEThingAbs name,
 806                                       AvailTC name [name])
 807                 ParentIs p -> return (IEThingAbs name,
 808                                       AvailTC p [name])
 809
 810     lookup_ie ie@(IEThingAll rdr)
 811         = do name <- lookupGlobalOccRn rdr
 812              let kids = findChildren kids_env name
 813              when (null kids)
 814                   (if (isTyConName name) then addWarn (dodgyExportWarn name)
 815                                 -- This occurs when you export T(..), but
 816                                 -- only import T abstractly, or T is a synonym.
 817                    else addErr (exportItemErr ie))
 818
 819              return (IEThingAll name, AvailTC name (name:kids))
 820
 821     lookup_ie ie@(IEThingWith rdr sub_rdrs)
 822         = do name <- lookupGlobalOccRn rdr
 823              if isUnboundName name
 824                 then return (IEThingWith name [], AvailTC name [name])
 825                 else do
 826              let env = mkOccEnv [ (nameOccName s, s)
 827                                 | s <- findChildren kids_env name ]
 828                  mb_names = map (lookupOccEnv env . rdrNameOcc) sub_rdrs
 829              if any isNothing mb_names
 830                 then do addErr (exportItemErr ie)
 831                         return (IEThingWith name [], AvailTC name [name])
 832                 else do let names = catMaybes mb_names
 833                         optIdxTypes <- doptM Opt_IndexedTypes
 834                         when (not optIdxTypes && any isTyConName names) $
 835                           addErr (typeItemErr ( head
 836                                               . filter isTyConName
 837                                               $ names )
 838                                               (text "in export list"))
 839                         return (IEThingWith name names, AvailTC name (name:names))
 840
 841     lookup_ie ie = panic "lookup_ie"    -- Other cases covered earlier
 842
 843     -------------
 844     lookup_doc_ie :: IE RdrName -> RnM (IE Name)
 845     lookup_doc_ie (IEGroup lev doc) = do rn_doc <- rnHsDoc doc
 846                                          return (IEGroup lev rn_doc)
 847     lookup_doc_ie (IEDoc doc)       = do rn_doc <- rnHsDoc doc
 848                                          return (IEDoc rn_doc)
 849     lookup_doc_ie (IEDocNamed str)  = return (IEDocNamed str)
 850     lookup_doc_ie ie = panic "lookup_doc_ie"    -- Other cases covered earlier
 851
 852
 853 isDoc (IEDoc _)      = True
 854 isDoc (IEDocNamed _) = True
 855 isDoc (IEGroup _ _)  = True
 856 isDoc _ = False
 857
 858 -------------------------------
 859 isModuleExported :: Bool -> ModuleName -> GlobalRdrElt -> Bool
 860 -- True if the thing is in scope *both* unqualified, *and* with qualifier M
 861 isModuleExported implicit_prelude mod (GRE { gre_name = name, gre_prov = prov })
 862   | implicit_prelude && isBuiltInSyntax name = False
 863         -- Optimisation: filter out names for built-in syntax
 864         -- They just clutter up the environment (esp tuples), and the parser
 865         -- will generate Exact RdrNames for them, so the cluttered
 866         -- envt is no use.  To avoid doing this filter all the time,
 867         -- we use -fno-implicit-prelude as a clue that the filter is
 868         -- worth while.  Really, it's only useful for GHC.Base and GHC.Tuple.
 869         --
 870         -- It's worth doing because it makes the environment smaller for
 871         -- every module that imports the Prelude
 872   | otherwise
 873   = case prov of
 874         LocalDef    -> moduleName (nameModule name) == mod
 875         Imported is -> any unQualSpecOK is && any (qualSpecOK mod) is
 876
 877 -------------------------------
 878 check_occs :: IE RdrName -> ExportOccMap -> [Name] -> RnM ExportOccMap
 879 check_occs ie occs names
 880   = foldlM check occs names
 881   where
 882     check occs name
 883       = case lookupOccEnv occs name_occ of
 884           Nothing -> returnM (extendOccEnv occs name_occ (name, ie))
 885
 886           Just (name', ie')
 887             | name == name'     -- Duplicate export
 888             ->  do { warn_dup_exports <- doptM Opt_WarnDuplicateExports ;
 889                      warnIf warn_dup_exports (dupExportWarn name_occ ie ie') ;
 890                      returnM occs }
 891
 892             | otherwise         -- Same occ name but different names: an error
 893             ->  do { global_env <- getGlobalRdrEnv ;
 894                      addErr (exportClashErr global_env name' name ie' ie) ;
 895                      returnM occs }
 896       where
 897         name_occ = nameOccName name
 898 \end{code}
 899
 900 %*********************************************************
 901 %*                                                       *
 902                 Deprecations
 903 %*                                                       *
 904 %*********************************************************
 905
 906 \begin{code}
 907 reportDeprecations :: DynFlags -> TcGblEnv -> RnM ()
 908 reportDeprecations dflags tcg_env
 909   = ifOptM Opt_WarnDeprecations $
 910     do  { (eps,hpt) <- getEpsAndHpt
 911                 -- By this time, typechecking is complete,
 912                 -- so the PIT is fully populated
 913         ; mapM_ (check hpt (eps_PIT eps)) all_gres }
 914   where
 915     used_names = allUses (tcg_dus tcg_env)
 916         -- Report on all deprecated uses; hence allUses
 917     all_gres   = globalRdrEnvElts (tcg_rdr_env tcg_env)
 918
 919     check hpt pit gre@(GRE {gre_name = name, gre_prov = Imported (imp_spec:_)})
 920       | name `elemNameSet` used_names
 921       , Just deprec_txt <- lookupImpDeprec dflags hpt pit gre
 922       = addWarnAt (importSpecLoc imp_spec)
 923                   (sep [ptext SLIT("Deprecated use of") <+>
 924                         pprNonVarNameSpace (occNameSpace (nameOccName name)) <+>
 925                         quotes (ppr name),
 926                       (parens imp_msg) <> colon,
 927                       (ppr deprec_txt) ])
 928         where
 929           name_mod = nameModule name
 930           imp_mod  = importSpecModule imp_spec
 931           imp_msg  = ptext SLIT("imported from") <+> ppr imp_mod <> extra
 932           extra | imp_mod == moduleName name_mod = empty
 933                 | otherwise = ptext SLIT(", but defined in") <+> ppr name_mod
 934
 935     check hpt pit ok_gre = returnM ()   -- Local, or not used, or not deprectated
 936             -- The Imported pattern-match: don't deprecate locally defined names
 937             -- For a start, we may be exporting a deprecated thing
 938             -- Also we may use a deprecated thing in the defn of another
 939             -- deprecated things.  We may even use a deprecated thing in
 940             -- the defn of a non-deprecated thing, when changing a module's
 941             -- interface
 942
 943 lookupImpDeprec :: DynFlags -> HomePackageTable -> PackageIfaceTable
 944                 -> GlobalRdrElt -> Maybe DeprecTxt
 945 -- The name is definitely imported, so look in HPT, PIT
 946 lookupImpDeprec dflags hpt pit gre
 947   = case lookupIfaceByModule dflags hpt pit (nameModule name) of
 948         Just iface -> mi_dep_fn iface name `seqMaybe`   -- Bleat if the thing, *or
 949                       case gre_par gre of
 950                         ParentIs p -> mi_dep_fn iface p -- its parent*, is deprec'd
 951                         NoParent   -> Nothing
 952         Nothing
 953           | isWiredInName name -> Nothing
 954                 -- We have not necessarily loaded the .hi file for a
 955                 -- wired-in name (yet), although we *could*.
 956                 -- And we never deprecate them
 957
 958          | otherwise -> pprPanic "lookupDeprec" (ppr name)
 959                 -- By now all the interfaces should have been loaded
 960   where
 961         name = gre_name gre
 962 \end{code}
 963
 964 %*********************************************************
 965 %*                                                       *
 966                 Unused names
 967 %*                                                       *
 968 %*********************************************************
 969
 970 \begin{code}
 971 reportUnusedNames :: Maybe [LIE RdrName]        -- Export list
 972                   -> TcGblEnv -> RnM ()
 973 reportUnusedNames export_decls gbl_env
 974   = do  { traceRn ((text "RUN") <+> (ppr (tcg_dus gbl_env)))
 975         ; warnUnusedTopBinds   unused_locals
 976         ; warnUnusedModules    unused_imp_mods
 977         ; warnUnusedImports    unused_imports
 978         ; warnDuplicateImports defined_and_used
 979         ; printMinimalImports  minimal_imports }
 980   where
 981     used_names :: NameSet
 982     used_names = findUses (tcg_dus gbl_env) emptyNameSet
 983         -- NB: currently, if f x = g, we only treat 'g' as used if 'f' is used
 984         -- Hence findUses
 985
 986         -- Collect the defined names from the in-scope environment
 987     defined_names :: [GlobalRdrElt]
 988     defined_names = globalRdrEnvElts (tcg_rdr_env gbl_env)
 989
 990         -- Note that defined_and_used, defined_but_not_used
 991         -- are both [GRE]; that's why we need defined_and_used
 992         -- rather than just used_names
 993     defined_and_used, defined_but_not_used :: [GlobalRdrElt]
 994     (defined_and_used, defined_but_not_used)
 995         = partition (gre_is_used used_names) defined_names
 996
 997     kids_env = mkChildEnv defined_names
 998         -- This is done in mkExports too; duplicated work
 999
1000     gre_is_used :: NameSet -> GlobalRdrElt -> Bool
1001     gre_is_used used_names (GRE {gre_name = name})
1002         = name `elemNameSet` used_names
1003           || any (`elemNameSet` used_names) (findChildren kids_env name)
1004                 -- A use of C implies a use of T,
1005                 -- if C was brought into scope by T(..) or T(C)
1006
1007         -- Filter out the ones that are
1008         --  (a) defined in this module, and
1009         --  (b) not defined by a 'deriving' clause
1010         -- The latter have an Internal Name, so we can filter them out easily
1011     unused_locals :: [GlobalRdrElt]
1012     unused_locals = filter is_unused_local defined_but_not_used
1013     is_unused_local :: GlobalRdrElt -> Bool
1014     is_unused_local gre = isLocalGRE gre && isExternalName (gre_name gre)
1015
1016     unused_imports :: [GlobalRdrElt]
1017     unused_imports = mapCatMaybes unused_imp defined_but_not_used
1018     unused_imp :: GlobalRdrElt -> Maybe GlobalRdrElt    -- Result has trimmed Imported provenances
1019     unused_imp gre@(GRE {gre_prov = LocalDef}) = Nothing
1020     unused_imp gre@(GRE {gre_prov = Imported imp_specs})
1021         | null trimmed_specs = Nothing
1022         | otherwise          = Just (gre {gre_prov = Imported trimmed_specs})
1023         where
1024           trimmed_specs = filter report_if_unused imp_specs
1025
1026     -- To figure out the minimal set of imports, start with the things
1027     -- that are in scope (i.e. in gbl_env).  Then just combine them
1028     -- into a bunch of avails, so they are properly grouped
1029     --
1030     -- BUG WARNING: this does not deal properly with qualified imports!
1031     minimal_imports :: FiniteMap ModuleName AvailEnv
1032     minimal_imports0 = foldr add_expall   emptyFM          expall_mods
1033     minimal_imports1 = foldr add_name     minimal_imports0 defined_and_used
1034     minimal_imports  = foldr add_inst_mod minimal_imports1 direct_import_mods
1035         -- The last line makes sure that we retain all direct imports
1036         -- even if we import nothing explicitly.
1037         -- It's not necessarily redundant to import such modules. Consider
1038         --            module This
1039         --              import M ()
1040         --
1041         -- The import M() is not *necessarily* redundant, even if
1042         -- we suck in no instance decls from M (e.g. it contains
1043         -- no instance decls, or This contains no code).  It may be
1044         -- that we import M solely to ensure that M's orphan instance
1045         -- decls (or those in its imports) are visible to people who
1046         -- import This.  Sigh.
1047         -- There's really no good way to detect this, so the error message
1048         -- in RnEnv.warnUnusedModules is weakened instead
1049
1050         -- We've carefully preserved the provenance so that we can
1051         -- construct minimal imports that import the name by (one of)
1052         -- the same route(s) as the programmer originally did.
1053     add_name gre@(GRE {gre_prov = Imported (imp_spec:_)}) acc
1054         = addToFM_C plusAvailEnv acc
1055                     (importSpecModule imp_spec) (unitAvailEnv (greAvail gre))
1056     add_name gre acc = acc      -- Local
1057
1058         -- Modules mentioned as 'module M' in the export list
1059     expall_mods = case export_decls of
1060                     Nothing -> []
1061                     Just es -> [m | L _ (IEModuleContents m) <- es]
1062
1063         -- This is really bogus.  The idea is that if we see 'module M' in
1064         -- the export list we must retain the import decls that drive it
1065         -- If we aren't careful we might see
1066         --      module A( module M ) where
1067         --        import M
1068         --        import N
1069         -- and suppose that N exports everything that M does.  Then we
1070         -- must not drop the import of M even though N brings it all into
1071         -- scope.
1072         --
1073         -- BUG WARNING: 'module M' exports aside, what if M.x is mentioned?!
1074         --
1075         -- The reason that add_expall is bogus is that it doesn't take
1076         -- qualified imports into account.  But it's an improvement.
1077     add_expall mod acc = addToFM_C plusAvailEnv acc mod emptyAvailEnv
1078
1079     add_inst_mod (mod,_,_) acc
1080       | mod_name `elemFM` acc = acc     -- We import something already
1081       | otherwise             = addToFM acc mod_name emptyAvailEnv
1082       where
1083         mod_name = moduleName mod
1084         -- Add an empty collection of imports for a module
1085         -- from which we have sucked only instance decls
1086
1087     imports = tcg_imports gbl_env
1088
1089     direct_import_mods :: [(Module, Bool, SrcSpan)]
1090         -- See the type of the imp_mods for this triple
1091     direct_import_mods = moduleEnvElts (imp_mods imports)
1092
1093     -- unused_imp_mods are the directly-imported modules
1094     -- that are not mentioned in minimal_imports1
1095     -- [Note: not 'minimal_imports', because that includes directly-imported
1096     --        modules even if we use nothing from them; see notes above]
1097     --
1098     -- BUG WARNING: does not deal correctly with multiple imports of the same module
1099     --              becuase direct_import_mods has only one entry per module
1100     unused_imp_mods :: [(ModuleName, SrcSpan)]
1101     unused_imp_mods = [(mod_name,loc) | (mod,no_imp,loc) <- direct_import_mods,
1102                        let mod_name = moduleName mod,
1103                        not (mod_name `elemFM` minimal_imports1),
1104                        mod /= pRELUDE,
1105                        not no_imp]
1106         -- The not no_imp part is not to complain about
1107         -- import M (), which is an idiom for importing
1108         -- instance declarations
1109
1110     module_unused :: ModuleName -> Bool
1111     module_unused mod = any (((==) mod) . fst) unused_imp_mods
1112
1113     report_if_unused :: ImportSpec -> Bool
1114         -- Do we want to report this as an unused import?
1115     report_if_unused (ImpSpec {is_decl = d, is_item = i})
1116         = not (module_unused (is_mod d)) -- Not if we've already said entire import is unused
1117           && isExplicitItem i            -- Only if the import was explicit
1118
1119 ---------------------
1120 warnDuplicateImports :: [GlobalRdrElt] -> RnM ()
1121 -- Given the GREs for names that are used, figure out which imports
1122 -- could be omitted without changing the top-level environment.
1123 --
1124 -- NB: Given import Foo( T )
1125 --           import qualified Foo
1126 -- we do not report a duplicate import, even though Foo.T is brought
1127 -- into scope by both, because there's nothing you can *omit* without
1128 -- changing the top-level environment.  So we complain only if it's
1129 -- explicitly named in both imports or neither.
1130 --
1131 -- Furthermore, we complain about Foo.T only if
1132 -- there is no complaint about (unqualified) T
1133
1134 warnDuplicateImports gres
1135   = ifOptM Opt_WarnUnusedImports $
1136     sequenceM_  [ warn name pr
1137                 | GRE { gre_name = name, gre_prov = Imported imps } <- gres
1138                 , pr <- redundants imps ]
1139   where
1140     warn name (red_imp, cov_imp)
1141         = addWarnAt (importSpecLoc red_imp)
1142             (vcat [ptext SLIT("Redundant import of:") <+> quotes pp_name,
1143                    ptext SLIT("It is also") <+> ppr cov_imp])
1144         where
1145           pp_name | is_qual red_decl = ppr (is_as red_decl) <> dot <> ppr occ
1146                   | otherwise       = ppr occ
1147           occ = nameOccName name
1148           red_decl = is_decl red_imp
1149
1150     redundants :: [ImportSpec] -> [(ImportSpec,ImportSpec)]
1151         -- The returned pair is (redundant-import, covering-import)
1152     redundants imps
1153         = [ (red_imp, cov_imp)
1154           | red_imp <- imps
1155           , isExplicitItem (is_item red_imp)
1156                 -- Complain only about redundant imports
1157                 -- mentioned explicitly by the user
1158           , cov_imp <- take 1 (filter (covers red_imp) imps) ]
1159                         -- The 'take 1' picks the first offending group
1160                         -- for this particular name
1161
1162         -- "red_imp" is a putative redundant import
1163         -- "cov_imp" potentially covers it
1164         -- This test decides whether red_imp could be dropped
1165         --
1166         -- NOTE: currently the test does not warn about
1167         --              import M( x )
1168         --              imoprt N( x )
1169         -- even if the same underlying 'x' is involved, because dropping
1170         -- either import would change the qualified names in scope (M.x, N.x)
1171         -- But if the qualified names aren't used, the import is indeed redundant
1172         -- Sadly we don't know that.  Oh well.
1173     covers red_imp@(ImpSpec { is_decl = red_decl, is_item = red_item })
1174            cov_imp@(ImpSpec { is_decl = cov_decl, is_item = cov_item })
1175         | red_loc == cov_loc
1176         = False         -- Ignore diagonal elements
1177         | not (is_as red_decl == is_as cov_decl)
1178         = False         -- They bring into scope different qualified names
1179         | not (is_qual red_decl) && is_qual cov_decl
1180         = False         -- Covering one doesn't bring unqualified name into scope
1181         | otherwise
1182         = not (isExplicitItem cov_item) -- Redundant one is selective and covering one isn't
1183           || red_later                  -- or both are explicit; tie-break using red_later
1184 {-
1185         | red_selective
1186         = not cov_selective     -- Redundant one is selective and covering one isn't
1187           || red_later          -- Both are explicit; tie-break using red_later
1188         | otherwise
1189         = not cov_selective     -- Neither import is selective
1190           && (is_mod red_decl == is_mod cov_decl)       -- They import the same module
1191           && red_later          -- Tie-break
1192 -}
1193         where
1194           red_loc   = importSpecLoc red_imp
1195           cov_loc   = importSpecLoc cov_imp
1196           red_later = red_loc > cov_loc
1197
1198 -- ToDo: deal with original imports with 'qualified' and 'as M' clauses
1199 printMinimalImports :: FiniteMap ModuleName AvailEnv    -- Minimal imports
1200                     -> RnM ()
1201 printMinimalImports imps
1202  = ifOptM Opt_D_dump_minimal_imports $ do {
1203
1204    mod_ies  <-  initIfaceTcRn $ mappM to_ies (fmToList imps) ;
1205    this_mod <- getModule ;
1206    rdr_env  <- getGlobalRdrEnv ;
1207    ioToTcRn (do { h <- openFile (mkFilename this_mod) WriteMode ;
1208                   printForUser h (mkPrintUnqualified rdr_env)
1209                                  (vcat (map ppr_mod_ie mod_ies)) })
1210    }
1211   where
1212     mkFilename this_mod = moduleNameString (moduleName this_mod) ++ ".imports"
1213     ppr_mod_ie (mod_name, ies)
1214         | mod_name == moduleName pRELUDE
1215         = empty
1216         | null ies      -- Nothing except instances comes from here
1217         = ptext SLIT("import") <+> ppr mod_name <> ptext SLIT("()    -- Instances only")
1218         | otherwise
1219         = ptext SLIT("import") <+> ppr mod_name <>
1220                     parens (fsep (punctuate comma (map ppr ies)))
1221
1222     to_ies (mod, avail_env) = do ies <- mapM to_ie (availEnvElts avail_env)
1223                                  returnM (mod, ies)
1224
1225     to_ie :: AvailInfo -> IfG (IE Name)
1226         -- The main trick here is that if we're importing all the constructors
1227         -- we want to say "T(..)", but if we're importing only a subset we want
1228         -- to say "T(A,B,C)".  So we have to find out what the module exports.
1229     to_ie (Avail n)       = returnM (IEVar n)
1230     to_ie (AvailTC n [m]) = ASSERT( n==m )
1231                             returnM (IEThingAbs n)
1232     to_ie (AvailTC n ns)
1233         = loadSysInterface doc n_mod                    `thenM` \ iface ->
1234           case [xs | (m,as) <- mi_exports iface,
1235                      m == n_mod,
1236                      AvailTC x xs <- as,
1237                      x == nameOccName n] of
1238               [xs] | all_used xs -> returnM (IEThingAll n)
1239                    | otherwise   -> returnM (IEThingWith n (filter (/= n) ns))
1240               other              -> pprTrace "to_ie" (ppr n <+> ppr n_mod <+> ppr other) $
1241                                     returnM (IEVar n)
1242         where
1243           all_used avail_occs = all (`elem` map nameOccName ns) avail_occs
1244           doc = text "Compute minimal imports from" <+> ppr n
1245           n_mod = nameModule n
1246 \end{code}
1247
1248
1249 %************************************************************************
1250 %*                                                                      *
1251 \subsection{Errors}
1252 %*                                                                      *
1253 %************************************************************************
1254
1255 \begin{code}
1256 badImportItemErr iface decl_spec ie
1257   = sep [ptext SLIT("Module"), quotes (ppr (is_mod decl_spec)), source_import,
1258          ptext SLIT("does not export"), quotes (ppr ie)]
1259   where
1260     source_import | mi_boot iface = ptext SLIT("(hi-boot interface)")
1261                   | otherwise     = empty
1262
1263 illegalImportItemErr = ptext SLIT("Illegal import item")
1264
1265 dodgyImportWarn item = dodgyMsg (ptext SLIT("import")) item
1266 dodgyExportWarn item = dodgyMsg (ptext SLIT("export")) item
1267
1268 dodgyMsg kind tc
1269   = sep [ ptext SLIT("The") <+> kind <+> ptext SLIT("item") <+> quotes (ppr (IEThingAll tc)),
1270           ptext SLIT("suggests that") <+> quotes (ppr tc) <+> ptext SLIT("has constructor or class methods"),
1271           ptext SLIT("but it has none; it is a type synonym or abstract type or class") ]
1272
1273 exportItemErr export_item
1274   = sep [ ptext SLIT("The export item") <+> quotes (ppr export_item),
1275           ptext SLIT("attempts to export constructors or class methods that are not visible here") ]
1276
1277 typeItemErr name wherestr
1278   = sep [ ptext SLIT("Using 'type' tag on") <+> quotes (ppr name) <+> wherestr,
1279           ptext SLIT("Use -findexed-types to enable this extension") ]
1280
1281 exportClashErr global_env name1 name2 ie1 ie2
1282   = vcat [ ptext SLIT("Conflicting exports for") <+> quotes (ppr occ) <> colon
1283          , ppr_export ie1 name1
1284          , ppr_export ie2 name2  ]
1285   where
1286     occ = nameOccName name1
1287     ppr_export ie name = nest 2 (quotes (ppr ie) <+> ptext SLIT("exports") <+>
1288                                  quotes (ppr name) <+> pprNameProvenance (get_gre name))
1289
1290         -- get_gre finds a GRE for the Name, so that we can show its provenance
1291     get_gre name
1292         = case lookupGRE_Name global_env name of
1293              (gre:_) -> gre
1294              []      -> pprPanic "exportClashErr" (ppr name)
1295
1296 addDupDeclErr :: Name -> Name -> TcRn ()
1297 addDupDeclErr name_a name_b
1298   = addErrAt (srcLocSpan loc2) $
1299     vcat [ptext SLIT("Multiple declarations of") <+> quotes (ppr name1),
1300           ptext SLIT("Declared at:") <+> vcat [ppr (nameSrcLoc name1), ppr loc2]]
1301   where
1302     loc2 = nameSrcLoc name2
1303     (name1,name2) | nameSrcLoc name_a > nameSrcLoc name_b = (name_b,name_a)
1304                   | otherwise                             = (name_a,name_b)
1305         -- Report the error at the later location
1306
1307 dupExportWarn occ_name ie1 ie2
1308   = hsep [quotes (ppr occ_name),
1309           ptext SLIT("is exported by"), quotes (ppr ie1),
1310           ptext SLIT("and"),            quotes (ppr ie2)]
1311
1312 dupModuleExport mod
1313   = hsep [ptext SLIT("Duplicate"),
1314           quotes (ptext SLIT("Module") <+> ppr mod),
1315           ptext SLIT("in export list")]
1316
1317 nullModuleExport mod
1318   = ptext SLIT("The export item `module") <+> ppr mod <> ptext SLIT("' exports nothing")
1319
1320 moduleDeprec mod txt
1321   = sep [ ptext SLIT("Module") <+> quotes (ppr mod) <+> ptext SLIT("is deprecated:"),
1322           nest 4 (ppr txt) ]
1323 \end{code}