ghc/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, exportsFromAvail,
   9         reportUnusedNames
  10     ) where
  11
  12 #include "HsVersions.h"
  13
  14 import {-# SOURCE #-} RnHiFiles ( loadInterface )
  15
  16 import CmdLineOpts      ( DynFlag(..) )
  17
  18 import HsSyn            ( HsDecl(..), IE(..), ieName, ImportDecl(..),
  19                           ForeignDecl(..),
  20                           collectLocatedHsBinders, tyClDeclNames
  21                         )
  22 import RdrHsSyn         ( RdrNameIE, RdrNameImportDecl, RdrNameHsDecl )
  23 import RnEnv
  24 import TcRnMonad
  25
  26 import FiniteMap
  27 import PrelNames        ( pRELUDE_Name, mAIN_Name, isBuiltInSyntaxName )
  28 import Module           ( Module, ModuleName, moduleName,
  29                           moduleNameUserString,
  30                           unitModuleEnvByName, lookupModuleEnvByName,
  31                           moduleEnvElts )
  32 import Name             ( Name, nameSrcLoc, nameOccName, nameModule )
  33 import NameSet
  34 import NameEnv
  35 import OccName          ( OccName, dataName, isTcOcc )
  36 import HscTypes         ( Provenance(..), ImportReason(..), GlobalRdrEnv,
  37                           GenAvailInfo(..), AvailInfo, Avails, IsBootInterface,
  38                           availName, availNames, availsToNameSet,
  39                           Deprecations(..), ModIface(..),
  40                           GlobalRdrElt(..), unQualInScope, isLocalGRE
  41                         )
  42 import RdrName          ( rdrNameOcc, setRdrNameSpace, emptyRdrEnv, foldRdrEnv, isQual )
  43 import Outputable
  44 import Maybes           ( maybeToBool, catMaybes )
  45 import ListSetOps       ( removeDups )
  46 import Util             ( sortLt, notNull )
  47 import List             ( partition )
  48 import IO               ( openFile, IOMode(..) )
  49 \end{code}
  50
  51
  52
  53 %************************************************************************
  54 %*                                                                      *
  55                 rnImports
  56 %*                                                                      *
  57 %************************************************************************
  58
  59 \begin{code}
  60 rnImports :: [RdrNameImportDecl]
  61           -> TcRn m (GlobalRdrEnv, ImportAvails)
  62
  63 rnImports imports
  64   =             -- PROCESS IMPORT DECLS
  65                 -- Do the non {- SOURCE -} ones first, so that we get a helpful
  66                 -- warning for {- SOURCE -} ones that are unnecessary
  67         getModule                               `thenM` \ this_mod ->
  68         getSrcLocM                              `thenM` \ loc ->
  69         doptM Opt_NoImplicitPrelude             `thenM` \ opt_no_prelude ->
  70         let
  71           all_imports        = mk_prel_imports this_mod loc opt_no_prelude ++ imports
  72           (source, ordinary) = partition is_source_import all_imports
  73           is_source_import (ImportDecl _ is_boot _ _ _ _) = is_boot
  74
  75           get_imports = importsFromImportDecl (moduleName this_mod)
  76         in
  77         mappM get_imports ordinary      `thenM` \ stuff1 ->
  78         mappM get_imports source        `thenM` \ stuff2 ->
  79
  80                 -- COMBINE RESULTS
  81         let
  82             (imp_gbl_envs, imp_avails) = unzip (stuff1 ++ stuff2)
  83             gbl_env :: GlobalRdrEnv
  84             gbl_env = foldr plusGlobalRdrEnv emptyRdrEnv imp_gbl_envs
  85
  86             all_avails :: ImportAvails
  87             all_avails = foldr plusImportAvails emptyImportAvails imp_avails
  88         in
  89                 -- ALL DONE
  90         returnM (gbl_env, all_avails)
  91   where
  92         -- NB: opt_NoImplicitPrelude is slightly different to import Prelude ();
  93         -- because the former doesn't even look at Prelude.hi for instance
  94         -- declarations, whereas the latter does.
  95     mk_prel_imports this_mod loc no_prelude
  96         |  moduleName this_mod == pRELUDE_Name
  97         || explicit_prelude_import
  98         || no_prelude
  99         = []
 100
 101         | otherwise = [preludeImportDecl loc]
 102
 103     explicit_prelude_import
 104       = notNull [ () | (ImportDecl mod _ _ _ _ _) <- imports,
 105                        mod == pRELUDE_Name ]
 106
 107 preludeImportDecl loc
 108   = ImportDecl pRELUDE_Name
 109                False {- Not a boot interface -}
 110                False    {- Not qualified -}
 111                Nothing  {- No "as" -}
 112                Nothing  {- No import list -}
 113                loc
 114 \end{code}
 115
 116 \begin{code}
 117 importsFromImportDecl :: ModuleName
 118                       -> RdrNameImportDecl
 119                       -> TcRn m (GlobalRdrEnv, ImportAvails)
 120
 121 importsFromImportDecl this_mod_name
 122         (ImportDecl imp_mod_name is_boot qual_only as_mod import_spec iloc)
 123   = addSrcLoc iloc $
 124     let
 125         doc     = ppr imp_mod_name <+> ptext SLIT("is directly imported")
 126     in
 127
 128         -- If there's an error in loadInterface, (e.g. interface
 129         -- file not found) we get lots of spurious errors from 'filterImports'
 130     recoverM (returnM Nothing)
 131              (loadInterface doc imp_mod_name (ImportByUser is_boot)     `thenM` \ iface ->
 132               returnM (Just iface))                                     `thenM` \ mb_iface ->
 133
 134     case mb_iface of {
 135         Nothing    -> returnM (emptyRdrEnv, emptyImportAvails ) ;
 136         Just iface ->
 137
 138     let
 139         imp_mod          = mi_module iface
 140         avails_by_module = mi_exports iface
 141         deprecs          = mi_deprecs iface
 142         dir_imp          = unitModuleEnvByName imp_mod_name (imp_mod, import_all import_spec)
 143
 144         avails :: Avails
 145         avails = [ avail | (mod_name, avails) <- avails_by_module,
 146                            mod_name /= this_mod_name,
 147                            avail <- avails ]
 148         -- If the module exports anything defined in this module, just ignore it.
 149         -- Reason: otherwise it looks as if there are two local definition sites
 150         -- for the thing, and an error gets reported.  Easiest thing is just to
 151         -- filter them out up front. This situation only arises if a module
 152         -- imports itself, or another module that imported it.  (Necessarily,
 153         -- this invoves a loop.)
 154         --
 155         -- Tiresome consequence: if you say
 156         --      module A where
 157         --         import B( AType )
 158         --         type AType = ...
 159         --
 160         --      module B( AType ) where
 161         --         import {-# SOURCE #-} A( AType )
 162         --
 163         -- then you'll get a 'B does not export AType' message.  Oh well.
 164
 165     in
 166         -- Complain if we import a deprecated module
 167     ifOptM Opt_WarnDeprecations (
 168        case deprecs of
 169           DeprecAll txt -> addWarn (moduleDeprec imp_mod_name txt)
 170           other         -> returnM ()
 171     )                                                   `thenM_`
 172
 173         -- Filter the imports according to the import list
 174     filterImports imp_mod_name is_boot import_spec avails       `thenM` \ (filtered_avails, explicits) ->
 175
 176     let
 177         unqual_imp = not qual_only      -- Maybe want unqualified names
 178         qual_mod   = case as_mod of
 179                         Nothing           -> imp_mod_name
 180                         Just another_name -> another_name
 181
 182         mk_prov name = NonLocalDef (UserImport imp_mod iloc (name `elemNameSet` explicits))
 183         gbl_env      = mkGlobalRdrEnv qual_mod unqual_imp mk_prov filtered_avails deprecs
 184         imports      = mkImportAvails qual_mod unqual_imp gbl_env filtered_avails
 185     in
 186     returnM (gbl_env, imports { imp_mods = dir_imp})
 187     }
 188
 189 import_all (Just (False, _)) = False    -- Imports are spec'd explicitly
 190 import_all other             = True     -- Everything is imported
 191 \end{code}
 192
 193
 194 %************************************************************************
 195 %*                                                                      *
 196                 importsFromLocalDecls
 197 %*                                                                      *
 198 %************************************************************************
 199
 200 From the top-level declarations of this module produce
 201         * the lexical environment
 202         * the ImportAvails
 203 created by its bindings.
 204
 205 Complain about duplicate bindings
 206
 207 \begin{code}
 208 importsFromLocalDecls :: [RdrNameHsDecl]
 209                       -> TcRn m (GlobalRdrEnv, ImportAvails)
 210 importsFromLocalDecls decls
 211   = getModule                                   `thenM` \ this_mod ->
 212     mappM (getLocalDeclBinders this_mod) decls  `thenM` \ avails_s ->
 213         -- The avails that are returned don't include the "system" names
 214     let
 215         avails = concat avails_s
 216
 217         all_names :: [Name]     -- All the defns; no dups eliminated
 218         all_names = [name | avail <- avails, name <- availNames avail]
 219
 220         dups :: [[Name]]
 221         (_, dups) = removeDups compare all_names
 222     in
 223         -- Check for duplicate definitions
 224         -- The complaint will come out as "Multiple declarations of Foo.f" because
 225         -- since 'f' is in the env twice, the unQualInScope used by the error-msg
 226         -- printer returns False.  It seems awkward to fix, unfortunately.
 227     mappM_ (addErr . dupDeclErr) dups                   `thenM_`
 228
 229     doptM Opt_NoImplicitPrelude                 `thenM` \ implicit_prelude ->
 230     let
 231         mod_name   = moduleName this_mod
 232         unqual_imp = True       -- Want unqualified names
 233         mk_prov n  = LocalDef   -- Provenance is local
 234
 235         gbl_env = mkGlobalRdrEnv mod_name unqual_imp mk_prov avails NoDeprecs
 236             -- NoDeprecs: don't complain about locally defined names
 237             -- For a start, we may be exporting a deprecated thing
 238             -- Also we may use a deprecated thing in the defn of another
 239             -- deprecated things.  We may even use a deprecated thing in
 240             -- the defn of a non-deprecated thing, when changing a module's
 241             -- interface
 242
 243
 244             -- Optimisation: filter out names for built-in syntax
 245             -- They just clutter up the environment (esp tuples), and the parser
 246             -- will generate Exact RdrNames for them, so the cluttered
 247             -- envt is no use.  To avoid doing this filter all the type,
 248             -- we use -fno-implicit-prelude as a clue that the filter is
 249             -- worth while.  Really, it's only useful for Base and Tuple.
 250             --
 251             -- It's worth doing because it makes the environment smaller for
 252             -- every module that imports the Prelude
 253             --
 254             -- Note: don't filter the gbl_env (hence avails, not avails' in
 255             -- defn of gbl_env above).      Stupid reason: when parsing
 256             -- data type decls, the constructors start as Exact tycon-names,
 257             -- and then get turned into data con names by zapping the name space;
 258             -- but that stops them being Exact, so they get looked up.  Sigh.
 259             -- It doesn't matter because it only affects the Data.Tuple really.
 260             -- The important thing is to trim down the exports.
 261         imports = mkImportAvails mod_name unqual_imp gbl_env avails'
 262         avails' | implicit_prelude = filter not_built_in_syntax avails
 263                 | otherwise        = avails
 264         not_built_in_syntax a = not (all isBuiltInSyntaxName (availNames a))
 265                 -- Only filter it if all the names of the avail are built-in
 266                 -- In particular, lists have (:) which is not built in syntax
 267                 -- so we don't filter it out.
 268     in
 269     returnM (gbl_env, imports)
 270 \end{code}
 271
 272
 273 %*********************************************************
 274 %*                                                      *
 275 \subsection{Getting binders out of a declaration}
 276 %*                                                      *
 277 %*********************************************************
 278
 279 @getLocalDeclBinders@ returns the names for a @RdrNameHsDecl@.  It's
 280 used for both source code (from @importsFromLocalDecls@) and interface
 281 files (@loadDecl@ calls @getTyClDeclBinders@).
 282
 283         *** See "THE NAMING STORY" in HsDecls ****
 284
 285 \begin{code}
 286 getLocalDeclBinders :: Module -> RdrNameHsDecl -> TcRn m [AvailInfo]
 287 getLocalDeclBinders mod (TyClD tycl_decl)
 288   =     -- For type and class decls, we generate Global names, with
 289         -- no export indicator.  They need to be global because they get
 290         -- permanently bound into the TyCons and Classes.  They don't need
 291         -- an export indicator because they are all implicitly exported.
 292     mapM new (tyClDeclNames tycl_decl)  `thenM` \ names@(main_name:_) ->
 293     returnM [AvailTC main_name names]
 294   where
 295     new (nm,loc) = newTopBinder mod nm loc
 296
 297 getLocalDeclBinders mod (ValD binds)
 298   = mappM new (collectLocatedHsBinders binds)           `thenM` \ avails ->
 299     returnM avails
 300   where
 301     new (rdr_name, loc) = newTopBinder mod rdr_name loc         `thenM` \ name ->
 302                           returnM (Avail name)
 303
 304 getLocalDeclBinders mod (ForD (ForeignImport nm _ _ _ loc))
 305   = newTopBinder mod nm loc         `thenM` \ name ->
 306     returnM [Avail name]
 307 getLocalDeclBinders mod (ForD _)
 308   = returnM []
 309
 310 getLocalDeclBinders mod (FixD _)    = returnM []
 311 getLocalDeclBinders mod (DeprecD _) = returnM []
 312 getLocalDeclBinders mod (DefD _)    = returnM []
 313 getLocalDeclBinders mod (InstD _)   = returnM []
 314 getLocalDeclBinders mod (RuleD _)   = returnM []
 315 \end{code}
 316
 317
 318 %************************************************************************
 319 %*                                                                      *
 320 \subsection{Filtering imports}
 321 %*                                                                      *
 322 %************************************************************************
 323
 324 @filterImports@ takes the @ExportEnv@ telling what the imported module makes
 325 available, and filters it through the import spec (if any).
 326
 327 \begin{code}
 328 filterImports :: ModuleName                     -- The module being imported
 329               -> IsBootInterface                -- Tells whether it's a {-# SOURCE #-} import
 330               -> Maybe (Bool, [RdrNameIE])      -- Import spec; True => hiding
 331               -> [AvailInfo]                    -- What's available
 332               -> TcRn m ([AvailInfo],           -- What's imported
 333                        NameSet)                 -- What was imported explicitly
 334
 335         -- Complains if import spec mentions things that the module doesn't export
 336         -- Warns/informs if import spec contains duplicates.
 337 filterImports mod from Nothing imports
 338   = returnM (imports, emptyNameSet)
 339
 340 filterImports mod from (Just (want_hiding, import_items)) total_avails
 341   = mappM get_item import_items         `thenM` \ avails_w_explicits_s ->
 342     let
 343         (item_avails, explicits_s) = unzip (concat avails_w_explicits_s)
 344         explicits                  = foldl addListToNameSet emptyNameSet explicits_s
 345     in
 346     if want_hiding then
 347         let     -- All imported; item_avails to be hidden
 348            hidden = availsToNameSet item_avails
 349            keep n = not (n `elemNameSet` hidden)
 350         in
 351         returnM (pruneAvails keep total_avails, emptyNameSet)
 352     else
 353         -- Just item_avails imported; nothing to be hidden
 354         returnM (item_avails, explicits)
 355   where
 356     import_fm :: FiniteMap OccName AvailInfo
 357     import_fm = listToFM [ (nameOccName name, avail)
 358                          | avail <- total_avails,
 359                            name  <- availNames avail]
 360         -- Even though availNames returns data constructors too,
 361         -- they won't make any difference because naked entities like T
 362         -- in an import list map to TcOccs, not VarOccs.
 363
 364     bale_out item = addErr (badImportItemErr mod from item)     `thenM_`
 365                     returnM []
 366
 367     get_item :: RdrNameIE -> TcRn m [(AvailInfo, [Name])]
 368         -- Empty list for a bad item.
 369         -- Singleton is typical case.
 370         -- Can have two when we are hiding, and mention C which might be
 371         --      both a class and a data constructor.
 372         -- The [Name] is the list of explicitly-mentioned names
 373     get_item item@(IEModuleContents _) = bale_out item
 374
 375     get_item item@(IEThingAll _)
 376       = case check_item item of
 377           Nothing                    -> bale_out item
 378           Just avail@(AvailTC _ [n]) ->         -- This occurs when you import T(..), but
 379                                                 -- only export T abstractly.  The single [n]
 380                                                 -- in the AvailTC is the type or class itself
 381                                         ifOptM Opt_WarnMisc (addWarn (dodgyImportWarn mod item))        `thenM_`
 382                                         returnM [(avail, [availName avail])]
 383           Just avail                 -> returnM [(avail, [availName avail])]
 384
 385     get_item item@(IEThingAbs n)
 386       | want_hiding     -- hiding( C )
 387                         -- Here the 'C' can be a data constructor *or* a type/class
 388       = case catMaybes [check_item item, check_item (IEVar data_n)] of
 389                 []     -> bale_out item
 390                 avails -> returnM [(a, []) | a <- avails]
 391                                 -- The 'explicits' list is irrelevant when hiding
 392       where
 393         data_n = setRdrNameSpace n dataName
 394
 395     get_item item
 396       = case check_item item of
 397           Nothing    -> bale_out item
 398           Just avail -> returnM [(avail, availNames avail)]
 399
 400     check_item item
 401       | not (maybeToBool maybe_in_import_avails) ||
 402         not (maybeToBool maybe_filtered_avail)
 403       = Nothing
 404
 405       | otherwise
 406       = Just filtered_avail
 407
 408       where
 409         wanted_occ             = rdrNameOcc (ieName item)
 410         maybe_in_import_avails = lookupFM import_fm wanted_occ
 411
 412         Just avail             = maybe_in_import_avails
 413         maybe_filtered_avail   = filterAvail item avail
 414         Just filtered_avail    = maybe_filtered_avail
 415 \end{code}
 416
 417 \begin{code}
 418 filterAvail :: RdrNameIE        -- Wanted
 419             -> AvailInfo        -- Available
 420             -> Maybe AvailInfo  -- Resulting available;
 421                                 -- Nothing if (any of the) wanted stuff isn't there
 422
 423 filterAvail ie@(IEThingWith want wants) avail@(AvailTC n ns)
 424   | sub_names_ok = Just (AvailTC n (filter is_wanted ns))
 425   | otherwise    = Nothing
 426   where
 427     is_wanted name = nameOccName name `elem` wanted_occs
 428     sub_names_ok   = all (`elem` avail_occs) wanted_occs
 429     avail_occs     = map nameOccName ns
 430     wanted_occs    = map rdrNameOcc (want:wants)
 431
 432 filterAvail (IEThingAbs _) (AvailTC n ns)       = ASSERT( n `elem` ns )
 433                                                   Just (AvailTC n [n])
 434
 435 filterAvail (IEThingAbs _) avail@(Avail n)      = Just avail            -- Type synonyms
 436
 437 filterAvail (IEVar _)      avail@(Avail n)      = Just avail
 438 filterAvail (IEVar v)      avail@(AvailTC n ns) = Just (AvailTC n (filter wanted ns))
 439                                                 where
 440                                                   wanted n = nameOccName n == occ
 441                                                   occ      = rdrNameOcc v
 442         -- The second equation happens if we import a class op, thus
 443         --      import A( op )
 444         -- where op is a class operation
 445
 446 filterAvail (IEThingAll _) avail@(AvailTC _ _)   = Just avail
 447         -- We don't complain even if the IE says T(..), but
 448         -- no constrs/class ops of T are available
 449         -- Instead that's caught with a warning by the caller
 450
 451 filterAvail ie avail = Nothing
 452 \end{code}
 453
 454
 455 %************************************************************************
 456 %*                                                                      *
 457 \subsection{Export list processing}
 458 %*                                                                      *
 459 %************************************************************************
 460
 461 Processing the export list.
 462
 463 You might think that we should record things that appear in the export
 464 list as ``occurrences'' (using @addOccurrenceName@), but you'd be
 465 wrong.  We do check (here) that they are in scope, but there is no
 466 need to slurp in their actual declaration (which is what
 467 @addOccurrenceName@ forces).
 468
 469 Indeed, doing so would big trouble when compiling @PrelBase@, because
 470 it re-exports @GHC@, which includes @takeMVar#@, whose type includes
 471 @ConcBase.StateAndSynchVar#@, and so on...
 472
 473 \begin{code}
 474 type ExportAccum        -- The type of the accumulating parameter of
 475                         -- the main worker function in exportsFromAvail
 476      = ([ModuleName],           -- 'module M's seen so far
 477         ExportOccMap,           -- Tracks exported occurrence names
 478         AvailEnv)               -- The accumulated exported stuff, kept in an env
 479                                 --   so we can common-up related AvailInfos
 480 emptyExportAccum = ([], emptyFM, emptyAvailEnv)
 481
 482 type ExportOccMap = FiniteMap OccName (Name, RdrNameIE)
 483         -- Tracks what a particular exported OccName
 484         --   in an export list refers to, and which item
 485         --   it came from.  It's illegal to export two distinct things
 486         --   that have the same occurrence name
 487
 488
 489 exportsFromAvail :: Maybe [RdrNameIE] -> TcRn m Avails
 490         -- Complains if two distinct exports have same OccName
 491         -- Warns about identical exports.
 492         -- Complains about exports items not in scope
 493 exportsFromAvail Nothing
 494  = do { this_mod <- getModule ;
 495         if moduleName this_mod == mAIN_Name then
 496            return []
 497               -- Export nothing; Main.$main is automatically exported
 498         else
 499           exportsFromAvail (Just [IEModuleContents (moduleName this_mod)])
 500               -- but for all other modules export everything.
 501     }
 502
 503 exportsFromAvail (Just exports)
 504  = do { TcGblEnv { tcg_imports = imports } <- getGblEnv ;
 505         warn_dup_exports <- doptM Opt_WarnDuplicateExports ;
 506         exports_from_avail exports warn_dup_exports imports }
 507
 508 exports_from_avail export_items warn_dup_exports
 509                    (ImportAvails { imp_unqual = mod_avail_env,
 510                                    imp_env = entity_avail_env })
 511   = foldlM exports_from_item emptyExportAccum
 512             export_items                        `thenM` \ (_, _, export_avail_map) ->
 513     returnM (nameEnvElts export_avail_map)
 514
 515   where
 516     exports_from_item :: ExportAccum -> RdrNameIE -> TcRn m ExportAccum
 517
 518     exports_from_item acc@(mods, occs, avails) ie@(IEModuleContents mod)
 519         | mod `elem` mods       -- Duplicate export of M
 520         = warnIf warn_dup_exports (dupModuleExport mod) `thenM_`
 521           returnM acc
 522
 523         | otherwise
 524         = case lookupModuleEnvByName mod_avail_env mod of
 525             Nothing             -> addErr (modExportErr mod)    `thenM_`
 526                                    returnM acc
 527             Just mod_avails
 528                 -> foldlM (check_occs warn_dup_exports ie)
 529                           occs mod_avails                  `thenM` \ occs' ->
 530                    let
 531                         avails' = foldl addAvail avails mod_avails
 532                    in
 533                    returnM (mod:mods, occs', avails')
 534
 535     exports_from_item acc@(mods, occs, avails) ie
 536         = lookupGRE (ieName ie)                 `thenM` \ mb_gre ->
 537           case mb_gre of {
 538                 Nothing -> addErr (unknownNameErr (ieName ie))  `thenM_`
 539                            returnM acc ;
 540                 Just gre ->
 541
 542                 -- Get the AvailInfo for the parent of the specified name
 543           case lookupAvailEnv entity_avail_env (gre_parent gre) of {
 544              Nothing -> pprPanic "exportsFromAvail"
 545                                 ((ppr (ieName ie)) <+> ppr gre) ;
 546              Just avail ->
 547
 548                 -- Filter out the bits we want
 549           case filterAvail ie avail of {
 550             Nothing ->  -- Not enough availability
 551                         addErr (exportItemErr ie) `thenM_`
 552                         returnM acc ;
 553
 554             Just export_avail ->
 555
 556                 -- Phew!  It's OK!  Now to check the occurrence stuff!
 557           warnIf (not (ok_item ie avail)) (dodgyExportWarn ie)  `thenM_`
 558           check_occs warn_dup_exports ie occs export_avail      `thenM` \ occs' ->
 559           returnM (mods, occs', addAvail avails export_avail)
 560           }}}
 561
 562
 563
 564 ok_item (IEThingAll _) (AvailTC _ [n]) = False
 565   -- This occurs when you import T(..), but
 566   -- only export T abstractly.  The single [n]
 567   -- in the AvailTC is the type or class itself
 568 ok_item _ _ = True
 569
 570 check_occs :: Bool -> RdrNameIE -> ExportOccMap -> AvailInfo -> TcRn m ExportOccMap
 571 check_occs warn_dup_exports ie occs avail
 572   = foldlM check occs (availNames avail)
 573   where
 574     check occs name
 575       = case lookupFM occs name_occ of
 576           Nothing           -> returnM (addToFM occs name_occ (name, ie))
 577           Just (name', ie')
 578             | name == name' ->  -- Duplicate export
 579                                 warnIf warn_dup_exports
 580                                         (dupExportWarn name_occ ie ie')
 581                                 `thenM_` returnM occs
 582
 583             | otherwise     ->  -- Same occ name but different names: an error
 584                                 addErr (exportClashErr name_occ ie ie') `thenM_`
 585                                 returnM occs
 586       where
 587         name_occ = nameOccName name
 588 \end{code}
 589
 590 %*********************************************************
 591 %*                                                       *
 592 \subsection{Unused names}
 593 %*                                                       *
 594 %*********************************************************
 595
 596 \begin{code}
 597 reportUnusedNames :: TcGblEnv
 598                   -> NameSet            -- Used in this module
 599                   -> TcRn m ()
 600 reportUnusedNames gbl_env used_names
 601   = warnUnusedModules unused_imp_mods                   `thenM_`
 602     warnUnusedTopBinds bad_locals                       `thenM_`
 603     warnUnusedImports bad_imports                       `thenM_`
 604     printMinimalImports minimal_imports
 605   where
 606     direct_import_mods :: [ModuleName]
 607     direct_import_mods = map (moduleName . fst)
 608                              (moduleEnvElts (imp_mods (tcg_imports gbl_env)))
 609
 610     -- Now, a use of C implies a use of T,
 611     -- if C was brought into scope by T(..) or T(C)
 612     really_used_names :: NameSet
 613     really_used_names = used_names `unionNameSets`
 614                         mkNameSet [ gre_parent gre
 615                                   | gre <- defined_names,
 616                                     gre_name gre `elemNameSet` used_names]
 617
 618         -- Collect the defined names from the in-scope environment
 619         -- Look for the qualified ones only, else get duplicates
 620     defined_names :: [GlobalRdrElt]
 621     defined_names = foldRdrEnv add [] (tcg_rdr_env gbl_env)
 622     add rdr_name ns acc | isQual rdr_name = ns ++ acc
 623                         | otherwise       = acc
 624
 625     defined_and_used, defined_but_not_used :: [GlobalRdrElt]
 626     (defined_and_used, defined_but_not_used) = partition used defined_names
 627     used gre = gre_name gre `elemNameSet` really_used_names
 628
 629     -- Filter out the ones only defined implicitly
 630     bad_locals :: [GlobalRdrElt]
 631     bad_locals = filter isLocalGRE defined_but_not_used
 632
 633     bad_imports :: [GlobalRdrElt]
 634     bad_imports = filter bad_imp defined_but_not_used
 635     bad_imp (GRE {gre_prov = NonLocalDef (UserImport mod _ True)}) = not (module_unused mod)
 636     bad_imp other                                                  = False
 637
 638     -- To figure out the minimal set of imports, start with the things
 639     -- that are in scope (i.e. in gbl_env).  Then just combine them
 640     -- into a bunch of avails, so they are properly grouped
 641     minimal_imports :: FiniteMap ModuleName AvailEnv
 642     minimal_imports0 = emptyFM
 643     minimal_imports1 = foldr add_name     minimal_imports0 defined_and_used
 644     minimal_imports  = foldr add_inst_mod minimal_imports1 direct_import_mods
 645         -- The last line makes sure that we retain all direct imports
 646         -- even if we import nothing explicitly.
 647         -- It's not necessarily redundant to import such modules. Consider
 648         --            module This
 649         --              import M ()
 650         --
 651         -- The import M() is not *necessarily* redundant, even if
 652         -- we suck in no instance decls from M (e.g. it contains
 653         -- no instance decls, or This contains no code).  It may be
 654         -- that we import M solely to ensure that M's orphan instance
 655         -- decls (or those in its imports) are visible to people who
 656         -- import This.  Sigh.
 657         -- There's really no good way to detect this, so the error message
 658         -- in RnEnv.warnUnusedModules is weakened instead
 659
 660
 661         -- We've carefully preserved the provenance so that we can
 662         -- construct minimal imports that import the name by (one of)
 663         -- the same route(s) as the programmer originally did.
 664     add_name (GRE {gre_name = n, gre_parent = p,
 665                    gre_prov = NonLocalDef (UserImport m _ _)}) acc
 666         = addToFM_C plusAvailEnv acc (moduleName m)
 667                     (unitAvailEnv (mk_avail n p))
 668     add_name other acc
 669         = acc
 670
 671         -- n is the name of the thing, p is the name of its parent
 672     mk_avail n p | n/=p                    = AvailTC p [p,n]
 673                  | isTcOcc (nameOccName p) = AvailTC n [n]
 674                  | otherwise               = Avail n
 675
 676     add_inst_mod m acc
 677       | m `elemFM` acc = acc    -- We import something already
 678       | otherwise      = addToFM acc m emptyAvailEnv
 679         -- Add an empty collection of imports for a module
 680         -- from which we have sucked only instance decls
 681
 682     -- unused_imp_mods are the directly-imported modules
 683     -- that are not mentioned in minimal_imports1
 684     -- [Note: not 'minimal_imports', because that includes direcly-imported
 685     --        modules even if we use nothing from them; see notes above]
 686     unused_imp_mods = [m | m <- direct_import_mods,
 687                        not (maybeToBool (lookupFM minimal_imports1 m)),
 688                        m /= pRELUDE_Name]
 689
 690     module_unused :: Module -> Bool
 691     module_unused mod = moduleName mod `elem` unused_imp_mods
 692
 693
 694 -- ToDo: deal with original imports with 'qualified' and 'as M' clauses
 695 printMinimalImports :: FiniteMap ModuleName AvailEnv    -- Minimal imports
 696                     -> TcRn m ()
 697 printMinimalImports imps
 698  = ifOptM Opt_D_dump_minimal_imports $ do {
 699
 700    mod_ies  <-  mappM to_ies (fmToList imps) ;
 701    this_mod <- getModule ;
 702    rdr_env  <- getGlobalRdrEnv ;
 703    ioToTcRn (do { h <- openFile (mkFilename this_mod) WriteMode ;
 704                   printForUser h (unQualInScope rdr_env)
 705                                  (vcat (map ppr_mod_ie mod_ies)) })
 706    }
 707   where
 708     mkFilename this_mod = moduleNameUserString (moduleName this_mod) ++ ".imports"
 709     ppr_mod_ie (mod_name, ies)
 710         | mod_name == pRELUDE_Name
 711         = empty
 712         | null ies      -- Nothing except instances comes from here
 713         = ptext SLIT("import") <+> ppr mod_name <> ptext SLIT("()    -- Instances only")
 714         | otherwise
 715         = ptext SLIT("import") <+> ppr mod_name <>
 716                     parens (fsep (punctuate comma (map ppr ies)))
 717
 718     to_ies (mod, avail_env) = mappM to_ie (availEnvElts avail_env)      `thenM` \ ies ->
 719                               returnM (mod, ies)
 720
 721     to_ie :: AvailInfo -> TcRn m (IE Name)
 722         -- The main trick here is that if we're importing all the constructors
 723         -- we want to say "T(..)", but if we're importing only a subset we want
 724         -- to say "T(A,B,C)".  So we have to find out what the module exports.
 725     to_ie (Avail n)       = returnM (IEVar n)
 726     to_ie (AvailTC n [m]) = ASSERT( n==m )
 727                             returnM (IEThingAbs n)
 728     to_ie (AvailTC n ns)
 729         = loadInterface (text "Compute minimal imports from" <+> ppr n_mod)
 730                         n_mod ImportBySystem                            `thenM` \ iface ->
 731           case [xs | (m,as) <- mi_exports iface,
 732                      m == n_mod,
 733                      AvailTC x xs <- as,
 734                      x == n] of
 735               [xs] | all (`elem` ns) xs -> returnM (IEThingAll n)
 736                    | otherwise          -> returnM (IEThingWith n (filter (/= n) ns))
 737               other                     -> pprTrace "to_ie" (ppr n <+> ppr (nameModule n) <+> ppr other) $
 738                                            returnM (IEVar n)
 739         where
 740           n_mod = moduleName (nameModule n)
 741 \end{code}
 742
 743
 744 %************************************************************************
 745 %*                                                                      *
 746 \subsection{Errors}
 747 %*                                                                      *
 748 %************************************************************************
 749
 750 \begin{code}
 751 badImportItemErr mod from ie
 752   = sep [ptext SLIT("Module"), quotes (ppr mod), source_import,
 753          ptext SLIT("does not export"), quotes (ppr ie)]
 754   where
 755     source_import = case from of
 756                       True  -> ptext SLIT("(hi-boot interface)")
 757                       other -> empty
 758
 759 dodgyImportWarn mod item = dodgyMsg (ptext SLIT("import")) item
 760 dodgyExportWarn     item = dodgyMsg (ptext SLIT("export")) item
 761
 762 dodgyMsg kind item@(IEThingAll tc)
 763   = sep [ ptext SLIT("The") <+> kind <+> ptext SLIT("item") <+> quotes (ppr item),
 764           ptext SLIT("suggests that") <+> quotes (ppr tc) <+> ptext SLIT("has constructor or class methods"),
 765           ptext SLIT("but it has none; it is a type synonym or abstract type or class") ]
 766
 767 modExportErr mod
 768   = hsep [ ptext SLIT("Unknown module in export list: module"), quotes (ppr mod)]
 769
 770 exportItemErr export_item
 771   = sep [ ptext SLIT("The export item") <+> quotes (ppr export_item),
 772           ptext SLIT("attempts to export constructors or class methods that are not visible here") ]
 773
 774 exportClashErr occ_name ie1 ie2
 775   = hsep [ptext SLIT("The export items"), quotes (ppr ie1)
 776          ,ptext SLIT("and"), quotes (ppr ie2)
 777          ,ptext SLIT("create conflicting exports for"), quotes (ppr occ_name)]
 778
 779 dupDeclErr (n:ns)
 780   = vcat [ptext SLIT("Multiple declarations of") <+> quotes (ppr n),
 781           nest 4 (vcat (map ppr sorted_locs))]
 782   where
 783     sorted_locs = sortLt occ'ed_before (map nameSrcLoc (n:ns))
 784     occ'ed_before a b = LT == compare a b
 785
 786 dupExportWarn occ_name ie1 ie2
 787   = hsep [quotes (ppr occ_name),
 788           ptext SLIT("is exported by"), quotes (ppr ie1),
 789           ptext SLIT("and"),            quotes (ppr ie2)]
 790
 791 dupModuleExport mod
 792   = hsep [ptext SLIT("Duplicate"),
 793           quotes (ptext SLIT("Module") <+> ppr mod),
 794           ptext SLIT("in export list")]
 795
 796 moduleDeprec mod txt
 797   = sep [ ptext SLIT("Module") <+> quotes (ppr mod) <+> ptext SLIT("is deprecated:"),
 798           nest 4 (ppr txt) ]
 799 \end{code}