RnNames.lhs 67.7 KB
Newer Older
1 2 3 4 5 6 7
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
\section[RnNames]{Extracting imported and top-level names in scope}

\begin{code}
module RnNames (
8 9
        rnImports, getLocalNonValBinders,
        rnExports, extendGlobalRdrEnvRn,
10
        gresFromAvails,
11
        reportUnusedNames, finishWarnings,
12 13 14 15
    ) where

#include "HsVersions.h"

16
import DynFlags
Ian Lynagh's avatar
Ian Lynagh committed
17
import HsSyn
18
import TcEnv            ( isBrackStage )
19
import RnEnv
20
import RnHsDoc          ( rnHsDoc )
21
import IfaceEnv		( ifaceExportNames )
22
import LoadIface        ( loadSrcInterface )
23
import TcRnMonad
24

25
import HeaderInfo       ( mkPrelImports )
Simon Marlow's avatar
Simon Marlow committed
26 27
import PrelNames
import Module
28
import Name
29
import NameEnv
30
import NameSet
31 32
import HscTypes
import RdrName
33
import Outputable
34
import Maybes
35
import SrcLoc
36
import ErrUtils
37
import Util
38
import FastString
39
import ListSetOps
40
import Data.List        ( partition, (\\), delete, find )
41
import qualified Data.Set as Set
Ian Lynagh's avatar
Ian Lynagh committed
42 43
import System.IO
import Control.Monad
44
import Data.Map         ( Map )
45
import qualified Data.Map as Map
46 47 48 49 50
\end{code}



%************************************************************************
51 52 53
%*                                                                      *
\subsection{rnImports}
%*                                                                      *
54 55 56
%************************************************************************

\begin{code}
57
rnImports :: [LImportDecl RdrName]
58
           -> RnM ([LImportDecl Name], GlobalRdrEnv, ImportAvails,AnyHpcUsage)
59

60
rnImports imports
61 62 63 64
         -- PROCESS IMPORT DECLS
         -- Do the non {- SOURCE -} ones first, so that we get a helpful
         -- warning for {- SOURCE -} ones that are unnecessary
    = do this_mod <- getModule
65
         implicit_prelude <- xoptM Opt_ImplicitPrelude
66
         let prel_imports       = mkPrelImports (moduleName this_mod) implicit_prelude imports
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
67
             (source, ordinary) = partition is_source_import imports
68
             is_source_import (L _ (ImportDecl _ _ is_boot _ _ _)) = is_boot
69

70
         ifDOptM Opt_WarnImplicitPrelude (
71 72 73
            when (notNull prel_imports) $ addWarn (implicitPreludeWarn)
          )

Ian Lynagh's avatar
Ian Lynagh committed
74 75 76 77 78
         stuff1 <- mapM (rnImportDecl this_mod True)  prel_imports
         stuff2 <- mapM (rnImportDecl this_mod False) ordinary
         stuff3 <- mapM (rnImportDecl this_mod False) source
         let (decls, rdr_env, imp_avails, hpc_usage) = combine (stuff1 ++ stuff2 ++ stuff3)
         return (decls, rdr_env, imp_avails, hpc_usage)
79

80
    where
81 82 83 84 85
   combine :: [(LImportDecl Name,  GlobalRdrEnv, ImportAvails,AnyHpcUsage)]
           -> ([LImportDecl Name], GlobalRdrEnv, ImportAvails,AnyHpcUsage)
   combine = foldr plus ([], emptyGlobalRdrEnv, emptyImportAvails,False)
        where plus (decl,  gbl_env1, imp_avails1,hpc_usage1)
                   (decls, gbl_env2, imp_avails2,hpc_usage2)
86
                = (decl:decls,
87
                   gbl_env1 `plusGlobalRdrEnv` gbl_env2,
88
                   imp_avails1 `plusImportAvails` imp_avails2,
89
                   hpc_usage1 || hpc_usage2)
90

91
rnImportDecl  :: Module -> Bool
92 93
              -> LImportDecl RdrName
              -> RnM (LImportDecl Name, GlobalRdrEnv, ImportAvails,AnyHpcUsage)
94

95
rnImportDecl this_mod implicit_prelude
96 97 98
             (L loc (ImportDecl { ideclName = loc_imp_mod_name, ideclPkgQual = mb_pkg
                                , ideclSource = want_boot, ideclQualified = qual_only
                                , ideclAs = as_mod, ideclHiding = imp_details }))
99
  = setSrcSpan loc $ do
100

101
    when (isJust mb_pkg) $ do
102
        pkg_imports <- xoptM Opt_PackageImports
103 104
        when (not pkg_imports) $ addErr packageImportErr

105 106
        -- If there's an error in loadInterface, (e.g. interface
        -- file not found) we get lots of spurious errors from 'filterImports'
107
    let
108 109
        imp_mod_name = unLoc loc_imp_mod_name
        doc = ppr imp_mod_name <+> ptext (sLit "is directly imported")
110

111 112 113
	-- Check for a missing import list
	-- (Opt_WarnMissingImportList also checks for T(..) items
	--  but that is done in checkDodgyImport below)
114
    case imp_details of
115
        Just (False, _)       -> return ()	-- Explicit import list
116
        _  | implicit_prelude -> return ()
117
           | qual_only	      -> return ()
118 119
           | otherwise        -> ifDOptM Opt_WarnMissingImportList $
                                 addWarn (missingImportListWarn imp_mod_name)
120

121
    iface <- loadSrcInterface doc imp_mod_name want_boot mb_pkg
122

123 124
        -- Compiler sanity check: if the import didn't say
        -- {-# SOURCE #-} we should not get a hi-boot file
125
    WARN( not want_boot && mi_boot iface, ppr imp_mod_name ) (do
126

127 128 129
        -- Issue a user warning for a redundant {- SOURCE -} import
        -- NB that we arrange to read all the ordinary imports before
        -- any of the {- SOURCE -} imports.
Ian Lynagh's avatar
Ian Lynagh committed
130 131 132 133 134 135 136
        --
        -- in --make and GHCi, the compilation manager checks for this,
        -- and indeed we shouldn't do it here because the existence of
        -- the non-boot module depends on the compilation order, which
        -- is not deterministic.  The hs-boot test can show this up.
    dflags <- getDOpts
    warnIf (want_boot && not (mi_boot iface) && isOneShot (ghcMode dflags))
137
           (warnRedundantSourceImport imp_mod_name)
138

139
    let
140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172
        imp_mod    = mi_module iface
        warns      = mi_warns iface
        orph_iface = mi_orphan iface
        has_finsts = mi_finsts iface
        deps       = mi_deps iface

        filtered_exports = filter not_this_mod (mi_exports iface)
        not_this_mod (mod,_) = mod /= this_mod
        -- If the module exports anything defined in this module, just
        -- ignore it.  Reason: otherwise it looks as if there are two
        -- local definition sites for the thing, and an error gets
        -- reported.  Easiest thing is just to filter them out up
        -- front. This situation only arises if a module imports
        -- itself, or another module that imported it.  (Necessarily,
        -- this invoves a loop.)
        --
        -- Tiresome consequence: if you say
        --      module A where
        --         import B( AType )
        --         type AType = ...
        --
        --      module B( AType ) where
        --         import {-# SOURCE #-} A( AType )
        --
        -- then you'll get a 'B does not export AType' message.  Oh well.

        qual_mod_name = case as_mod of
                          Nothing           -> imp_mod_name
                          Just another_name -> another_name
        imp_spec  = ImpDeclSpec { is_mod = imp_mod_name, is_qual = qual_only,
                                  is_dloc = loc, is_as = qual_mod_name }

    -- Get the total exports from this module
173 174
    total_avails <- ifaceExportNames filtered_exports

175 176
    -- filter the imports according to the import declaration
    (new_imp_details, gbl_env) <-
177
        filterImports iface imp_spec imp_details total_avails
178

179
    dflags <- getDOpts
180

181
    let
182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226
        -- Compute new transitive dependencies

        orphans | orph_iface = ASSERT( not (imp_mod `elem` dep_orphs deps) )
                               imp_mod : dep_orphs deps
                | otherwise  = dep_orphs deps

        finsts | has_finsts = ASSERT( not (imp_mod `elem` dep_finsts deps) )
                              imp_mod : dep_finsts deps
               | otherwise  = dep_finsts deps

        pkg = modulePackageId (mi_module iface)

        (dependent_mods, dependent_pkgs)
           | pkg == thisPackage dflags =
                -- Imported module is from the home package
                -- Take its dependent modules and add imp_mod itself
                -- Take its dependent packages unchanged
                --
                -- NB: (dep_mods deps) might include a hi-boot file
                -- for the module being compiled, CM. Do *not* filter
                -- this out (as we used to), because when we've
                -- finished dealing with the direct imports we want to
                -- know if any of them depended on CM.hi-boot, in
                -- which case we should do the hi-boot consistency
                -- check.  See LoadIface.loadHiBootInterface
                ((imp_mod_name, want_boot) : dep_mods deps, dep_pkgs deps)

           | otherwise =
                -- Imported module is from another package
                -- Dump the dependent modules
                -- Add the package imp_mod comes from to the dependent packages
                ASSERT2( not (pkg `elem` dep_pkgs deps), ppr pkg <+> ppr (dep_pkgs deps) )
                ([], pkg : dep_pkgs deps)

        -- True <=> import M ()
        import_all = case imp_details of
                        Just (is_hiding, ls) -> not is_hiding && null ls
                        _                    -> False

        imports   = ImportAvails {
                        imp_mods     = unitModuleEnv imp_mod [(qual_mod_name, import_all, loc)],
                        imp_orphs    = orphans,
                        imp_finsts   = finsts,
                        imp_dep_mods = mkModDeps dependent_mods,
                        imp_dep_pkgs = dependent_pkgs
227 228
                   }

229 230 231 232 233
    -- Complain if we import a deprecated module
    ifDOptM Opt_WarnWarningsDeprecations        (
       case warns of
          WarnAll txt -> addWarn (moduleWarn imp_mod_name txt)
          _           -> return ()
234 235
     )

236
    let new_imp_decl = L loc (ImportDecl loc_imp_mod_name mb_pkg want_boot
237
                                         qual_only as_mod new_imp_details)
238

239
    return (new_imp_decl, gbl_env, imports, mi_hpc iface)
240
    )
241

Ian Lynagh's avatar
Ian Lynagh committed
242
warnRedundantSourceImport :: ModuleName -> SDoc
243
warnRedundantSourceImport mod_name
Ian Lynagh's avatar
Ian Lynagh committed
244
  = ptext (sLit "Unnecessary {-# SOURCE #-} in the import of module")
245
          <+> quotes (ppr mod_name)
246 247 248
\end{code}


249
%************************************************************************
250 251 252
%*                                                                      *
\subsection{importsFromLocalDecls}
%*                                                                      *
253 254 255
%************************************************************************

From the top-level declarations of this module produce
256 257 258 259
        * the lexical environment
        * the ImportAvails
created by its bindings.

260 261 262 263
Note [Top-level Names in Template Haskell decl quotes]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider a Template Haskell declaration quotation like this:
      module M where
264
        f x = h [d| f = 3 |]
265 266
When renaming the declarations inside [d| ...|], we treat the
top level binders specially in two ways
267

268 269 270 271
1.  We give them an Internal name, not (as usual) an External one.
    Otherwise the NameCache gets confused by a second allocation of
    M.f.  (We used to invent a fake module ThFake to avoid this, but
    that had other problems, notably in getting the correct answer for
272
    nameIsLocalOrFrom in lookupFixity. So we now leave tcg_module
273 274 275 276
    unaffected.)

2.  We make them *shadow* the outer bindings. If we don't do that,
    we'll get a complaint when extending the GlobalRdrEnv, saying that
277 278 279 280 281 282
    there are two bindings for 'f'.  There are several tricky points:

    * This shadowing applies even if the binding for 'f' is in a
      where-clause, and hence is in the *local* RdrEnv not the *global*
      RdrEnv.

283 284
    * The *qualified* name M.f from the enclosing module must certainly
      still be available.  So we don't nuke it entirely; we just make
285
      it seem like qualified import.
286

287 288 289 290 291 292 293 294 295 296 297
    * We only shadow *External* names (which come from the main module)
      Do not shadow *Inernal* names because in the bracket
          [d| class C a where f :: a
              f = 4 |]
      rnSrcDecls will first call extendGlobalRdrEnvRn with C[f] from the
      class decl, and *separately* extend the envt with the value binding.

3. We find out whether we are inside a [d| ... |] by testing the TH
   stage. This is a slight hack, because the stage field was really
   meant for the type checker, and here we are not interested in the
   fields of Brack, hence the error thunks in thRnBrack.
298

299
\begin{code}
300
extendGlobalRdrEnvRn :: [AvailInfo]
301 302 303 304 305 306
                     -> MiniFixityEnv
                     -> RnM (TcGblEnv, TcLclEnv)
-- Updates both the GlobalRdrEnv and the FixityEnv
-- We return a new TcLclEnv only because we might have to
-- delete some bindings from it;
-- see Note [Top-level Names in Template Haskell decl quotes]
307

308
extendGlobalRdrEnvRn avails new_fixities
309
  = do  { (gbl_env, lcl_env) <- getEnvs
310
        ; stage <- getStage
311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334
        ; let rdr_env = tcg_rdr_env gbl_env
              fix_env = tcg_fix_env gbl_env

              -- Delete new_occs from global and local envs
              -- If we are in a TemplateHaskell decl bracket,
              --    we are going to shadow them
              -- See Note [Top-level Names in Template Haskell decl quotes]
              shadowP  = isBrackStage stage
              new_occs = map (nameOccName . gre_name) gres
              rdr_env1 = transformGREs qual_gre new_occs rdr_env
              lcl_env1 = lcl_env { tcl_rdr = delListFromOccEnv (tcl_rdr lcl_env) new_occs }
              (rdr_env2, lcl_env2) | shadowP   = (rdr_env1, lcl_env1)
                                   | otherwise = (rdr_env,  lcl_env)

              rdr_env3 = foldl extendGlobalRdrEnv rdr_env2 gres
              fix_env' = foldl extend_fix_env     fix_env  gres
              (rdr_env', dups) = findLocalDupsRdrEnv rdr_env3 new_occs

              gbl_env' = gbl_env { tcg_rdr_env = rdr_env', tcg_fix_env = fix_env' }

        ; mapM_ addDupDeclErr dups

        ; traceRn (text "extendGlobalRdrEnvRn" <+> (ppr new_fixities $$ ppr fix_env $$ ppr fix_env'))
        ; return (gbl_env', lcl_env2) }
335 336
  where
    gres = gresFromAvails LocalDef avails
337

338 339
    -- If there is a fixity decl for the gre, add it to the fixity env
    extend_fix_env fix_env gre
340 341 342 343 344
      | Just (L _ fi) <- lookupFsEnv new_fixities (occNameFS occ)
      = extendNameEnv fix_env name (FixItem occ fi)
      | otherwise
      = fix_env
      where
345
        name = gre_name gre
346
        occ  = nameOccName name
347 348 349

    qual_gre :: GlobalRdrElt -> GlobalRdrElt
    -- Transform top-level GREs from the module being compiled
350
    -- so that they are out of the way of new definitions in a Template
351 352 353 354 355 356 357 358 359 360
    -- Haskell bracket
    -- See Note [Top-level Names in Template Haskell decl quotes]
    -- Seems like 5 times as much work as it deserves!
    --
    -- For a LocalDef we make a (fake) qualified imported GRE for a
    -- local GRE so that the original *qualified* name is still in scope
    -- but the *unqualified* one no longer is.  What a hack!

    qual_gre gre@(GRE { gre_prov = LocalDef, gre_name = name })
        | isExternalName name = gre { gre_prov = Imported [imp_spec] }
361 362 363 364 365 366 367 368 369
        | otherwise           = gre
          -- Do not shadow Internal (ie Template Haskell) Names
          -- See Note [Top-level Names in Template Haskell decl quotes]
        where
          mod = ASSERT2( isExternalName name, ppr name) moduleName (nameModule name)
          imp_spec = ImpSpec { is_item = ImpAll, is_decl = decl_spec }
          decl_spec = ImpDeclSpec { is_mod = mod, is_as = mod,
                                    is_qual = True,  -- Qualified only!
                                    is_dloc = srcLocSpan (nameSrcLoc name) }
370 371

    qual_gre gre@(GRE { gre_prov = Imported specs })
372
        = gre { gre_prov = Imported (map qual_spec specs) }
373 374

    qual_spec spec@(ImpSpec { is_decl = decl_spec })
375
        = spec { is_decl = decl_spec { is_qual = True } }
376
\end{code}
377

378 379
@getLocalDeclBinders@ returns the names for an @HsDecl@.  It's
used for source code.
380

381
        *** See "THE NAMING STORY" in HsDecls ****
382

383
Instances of type families
384
~~~~~~~~~~~~~~~~~~~~~~~~~~
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
385 386 387 388 389
Family instances contain data constructors that we need to collect and we also
need to descend into the type instances of associated families in class
instances. The type constructor of a family instance is a usage occurence.
Hence, we don't return it as a subname in 'AvailInfo'; otherwise, we would get
a duplicate declaration error.
390

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
391 392 393 394 395 396 397 398 399 400 401 402
Note [Looking up family names in family instances]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider

  module M where
    type family T a :: *
    type instance M.T Int = Bool

We might think that we can simply use 'lookupOccRn' when processing the type
instance to look up 'M.T'.  Alas, we can't!  The type family declaration is in
the *same* HsGroup as the type instance declaration.  Hence, as we are
currently collecting the binders declared in that HsGroup, these binders will
403
not have been added to the global environment yet.
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423

In the case of type classes, this problem does not arise, as a class instance
does not define any binders of it's own.  So, we simply don't attempt to look
up the class names of class instances in 'get_local_binders' below.

If we don't look up class instances, can't we get away without looking up type
instances, too?  No, we can't.  Data type instances define data constructors
and we need to

  (1) collect those in 'get_local_binders' and
  (2) we need to get their parent name in 'get_local_binders', too, to
      produce an appropriate 'AvailTC'.

This parent name is exactly the family name of the type instance that is so
difficult to look up.

We solve this problem as follows:

  (a) We process all type declarations other than type instances first.
  (b) Then, we compute a 'GlobalRdrEnv' from the result of the first step.
424
  (c) Finally, we process all type instances (both those on the toplevel and
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
425 426
      those nested in class instances) and check for the family names in the
      'GlobalRdrEnv' produced in the previous step before using 'lookupOccRn'.
427

428
\begin{code}
429
getLocalNonValBinders :: HsGroup RdrName -> RnM [AvailInfo]
430
-- Get all the top-level binders bound the group *except*
431 432
-- for value bindings, which are treated separately
-- Specificaly we return AvailInfo for
433 434 435 436 437
--      type decls (incl constructors and record selectors)
--      class decls (including class ops)
--      associated types
--      foreign imports
--      (in hs-boot files) value signatures
438 439

getLocalNonValBinders group
440 441
  = do { gbl_env <- getGblEnv
       ; get_local_binders gbl_env group }
442

Ian Lynagh's avatar
Ian Lynagh committed
443
get_local_binders :: TcGblEnv -> HsGroup RdrName -> RnM [GenAvailInfo Name]
444
get_local_binders gbl_env (HsGroup {hs_valds  = ValBindsIn _ val_sigs,
445 446 447 448 449
                                    hs_tyclds = tycl_decls,
                                    hs_instds = inst_decls,
                                    hs_fords  = foreign_decls })
  = do  { -- separate out the family instance declarations
          let (tyinst_decls1, tycl_decls_noinsts)
450
                           = partition (isFamInstDecl . unLoc) (concat tycl_decls)
451
              tyinst_decls = tyinst_decls1 ++ instDeclATs inst_decls
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
452

453
          -- process all type/class decls except family instances
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
454 455
        ; tc_names  <- mapM new_tc tycl_decls_noinsts

456
          -- create a temporary rdr env of the type binders
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
457 458 459
        ; let tc_gres     = gresFromAvails LocalDef tc_names
              tc_name_env = foldl extendGlobalRdrEnv emptyGlobalRdrEnv tc_gres

460 461
          -- process all family instances
        ; ti_names  <- mapM (new_ti tc_name_env) tyinst_decls
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
462

463 464 465
          -- finish off with value binder in case of a hs-boot file
        ; val_names <- mapM new_simple val_bndrs
        ; return (val_names ++ tc_names ++ ti_names) }
466 467
  where
    is_hs_boot = isHsBoot (tcg_src gbl_env) ;
468

469
    for_hs_bndrs :: [Located RdrName]
470 471 472
    for_hs_bndrs = [nm | L _ (ForeignImport nm _ _) <- foreign_decls]

    -- In a hs-boot file, the value binders come from the
473
    --  *signatures*, and there should be no foreign binders
474
    val_bndrs :: [Located RdrName]
475 476
    val_bndrs | is_hs_boot = [nm | L _ (TypeSig nm _) <- val_sigs]
              | otherwise  = for_hs_bndrs
477

478
    new_simple :: Located RdrName -> RnM (GenAvailInfo Name)
479
    new_simple rdr_name = do
480
        nm <- newTopSrcBinder rdr_name
481
        return (Avail nm)
482

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
483
    new_tc tc_decl              -- NOT for type/data instances
484 485 486
        = do { main_name <- newTopSrcBinder main_rdr
             ; sub_names <- mapM newTopSrcBinder sub_rdrs
             ; return (AvailTC main_name (main_name : sub_names)) }
487
      where
488
        (main_rdr : sub_rdrs) = hsTyClDeclBinders tc_decl
489

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
490
    new_ti tc_name_env ti_decl  -- ONLY for type/data instances
491 492 493 494
        = do { main_name <- lookupFamInstDeclBndr tc_name_env main_rdr
             ; sub_names <- mapM newTopSrcBinder sub_rdrs
             ; return (AvailTC main_name sub_names) }
                        -- main_name is not bound here!
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
495
      where
496
        (main_rdr : sub_rdrs) = hsTyClDeclBinders ti_decl
497

Ian Lynagh's avatar
Ian Lynagh committed
498
get_local_binders _ g = pprPanic "get_local_binders" (ppr g)
499 500
\end{code}

501

502
%************************************************************************
503
%*                                                                      *
504
\subsection{Filtering imports}
505
%*                                                                      *
506 507 508 509 510 511
%************************************************************************

@filterImports@ takes the @ExportEnv@ telling what the imported module makes
available, and filters it through the import spec (if any).

\begin{code}
512
filterImports :: ModIface
513 514 515 516 517
              -> ImpDeclSpec                    -- The span for the entire import decl
              -> Maybe (Bool, [LIE RdrName])    -- Import spec; True => hiding
              -> [AvailInfo]                    -- What's available
              -> RnM (Maybe (Bool, [LIE Name]), -- Import spec w/ Names
                      GlobalRdrEnv)             -- Same again, but in GRE form
Ian Lynagh's avatar
Ian Lynagh committed
518
filterImports _ decl_spec Nothing all_avails
519 520 521 522
  = return (Nothing, mkGlobalRdrEnv (gresFromAvails prov all_avails))
  where
    prov = Imported [ImpSpec { is_decl = decl_spec, is_item = ImpAll }]

523 524

filterImports iface decl_spec (Just (want_hiding, import_items)) all_avails
525
  = do  -- check for errors, convert RdrNames to Names
526
        opt_typeFamilies <- xoptM Opt_TypeFamilies
527
        items1 <- mapM (lookup_lie opt_typeFamilies) import_items
528 529 530

        let items2 :: [(LIE Name, AvailInfo)]
            items2 = concat items1
531 532
                -- NB the AvailInfo may have duplicates, and several items
                --    for the same parent; e.g N(x) and N(y)
533 534

            names  = availsToNameSet (map snd items2)
535 536 537
            keep n = not (n `elemNameSet` names)
            pruned_avails = filterAvails keep all_avails
            hiding_prov = Imported [ImpSpec { is_decl = decl_spec, is_item = ImpAll }]
538

539 540
            gres | want_hiding = gresFromAvails hiding_prov pruned_avails
                 | otherwise   = concatMap (gresFromIE decl_spec) items2
541 542 543

        return (Just (want_hiding, map fst items2), mkGlobalRdrEnv gres)
  where
544
        -- This environment is how we map names mentioned in the import
545 546 547 548 549 550 551 552 553
        -- list to the actual Name they correspond to, and the name family
        -- that the Name belongs to (the AvailInfo).  The situation is
        -- complicated by associated families, which introduce a three-level
        -- hierachy, where class = grand parent, assoc family = parent, and
        -- data constructors = children.  The occ_env entries for associated
        -- families needs to capture all this information; hence, we have the
        -- third component of the environment that gives the class name (=
        -- grand parent) in case of associated families.
        --
554 555 556 557 558 559 560 561
        -- This env will have entries for data constructors too,
        -- they won't make any difference because naked entities like T
        -- in an import list map to TcOccs, not VarOccs.
    occ_env :: OccEnv (Name,        -- the name
                       AvailInfo,   -- the export item providing the name
                       Maybe Name)  -- the parent of associated types
    occ_env = mkOccEnv_C combine [ (nameOccName n, (n, a, Nothing))
                                 | a <- all_avails, n <- availNames a]
562 563 564 565 566
      where
        -- we know that (1) there are at most entries for one name, (2) their
        -- first component is identical, (3) they are for tys/cls, and (4) one
        -- entry has the name in its parent position (the other doesn't)
        combine (name, AvailTC p1 subs1, Nothing)
567
                (_   , AvailTC p2 subs2, Nothing)
568
          = let
569 570 571
              (parent, subs) = if p1 == name then (p2, subs1) else (p1, subs2)
            in
            (name, AvailTC name subs, Just parent)
Ian Lynagh's avatar
Ian Lynagh committed
572
        combine x y = pprPanic "filterImports/combine" (ppr x $$ ppr y)
573 574

    lookup_lie :: Bool -> LIE RdrName -> TcRn [(LIE Name, AvailInfo)]
575
    lookup_lie opt_typeFamilies (L loc ieRdr)
576 577
        = do
             stuff <- setSrcSpan loc $
578
                      case lookup_ie opt_typeFamilies ieRdr of
579 580 581 582 583
                            Failed err  -> addErr err >> return []
                            Succeeded a -> return a
             checkDodgyImport stuff
             return [ (L loc ie, avail) | (ie,avail) <- stuff ]
        where
584
            -- Warn when importing T(..) if T was exported abstractly
585
            checkDodgyImport stuff
Ian Lynagh's avatar
Ian Lynagh committed
586
                | IEThingAll n <- ieRdr, (_, AvailTC _ [_]):_ <- stuff
587
                = ifDOptM Opt_WarnDodgyImports (addWarn (dodgyImportWarn n))
588
                -- NB. use the RdrName for reporting the warning
589
		| IEThingAll {} <- ieRdr
590
		, not (is_qual decl_spec)
591 592
                = ifDOptM Opt_WarnMissingImportList $
                  addWarn (missingImportListItem ieRdr)
593 594 595 596 597 598 599 600 601 602
            checkDodgyImport _
                = return ()

        -- For each import item, we convert its RdrNames to Names,
        -- and at the same time construct an AvailInfo corresponding
        -- to what is actually imported by this item.
        -- Returns Nothing on error.
        -- We return a list here, because in the case of an import
        -- item like C, if we are hiding, then C refers to *both* a
        -- type/class and a data constructor.  Moreover, when we import
603 604 605
        -- data constructors of an associated family, we need separate
        -- AvailInfos for the data constructors and the family (as they have
        -- different parents).  See the discussion at occ_env.
606
    lookup_ie :: Bool -> IE RdrName -> MaybeErr Message [(IE Name,AvailInfo)]
607
    lookup_ie opt_typeFamilies ie
608
      = let bad_ie :: MaybeErr Message a
609
            bad_ie = Failed (badImportItemErr iface decl_spec ie all_avails)
610

611 612
            lookup_name rdr
              | isQual rdr = Failed (qualImportItemErr rdr)
613 614
              | Just nm <- lookupOccEnv occ_env (rdrNameOcc rdr) = return nm
              | otherwise                                        = bad_ie
615 616 617 618 619 620 621 622 623
        in
        case ie of
         IEVar n -> do
             (name, avail, _) <- lookup_name n
             return [(IEVar name, trimAvail avail name)]

         IEThingAll tc -> do
             (name, avail@(AvailTC name2 subs), mb_parent) <- lookup_name tc
             case mb_parent of
624 625 626 627 628 629
               -- non-associated ty/cls
               Nothing     -> return [(IEThingAll name, avail)]
               -- associated ty
               Just parent -> return [(IEThingAll name,
                                       AvailTC name2 (subs \\ [name])),
                                      (IEThingAll name, AvailTC parent [name])]
630 631 632

         IEThingAbs tc
             | want_hiding   -- hiding ( C )
633
                        -- Here the 'C' can be a data constructor
634 635 636 637 638 639 640 641 642 643 644 645
                        --  *or* a type/class, or even both
             -> let tc_name = lookup_name tc
                    dc_name = lookup_name (setRdrNameSpace tc srcDataName)
                in
                case catMaybeErr [ tc_name, dc_name ] of
                  []    -> bad_ie
                  names -> return [mkIEThingAbs name | name <- names]
             | otherwise
             -> do nameAvail <- lookup_name tc
                   return [mkIEThingAbs nameAvail]

         IEThingWith tc ns -> do
Ian Lynagh's avatar
Ian Lynagh committed
646
            (name, AvailTC _ subnames, mb_parent) <- lookup_name tc
647 648 649 650
            let
              env         = mkOccEnv [(nameOccName s, s) | s <- subnames]
              mb_children = map (lookupOccEnv env . rdrNameOcc) ns
            children <- if any isNothing mb_children
651 652
                        then bad_ie
                        else return (catMaybes mb_children)
653 654
            -- check for proper import of type families
            when (not opt_typeFamilies && any isTyConName children) $
655
              Failed (typeItemErr (head . filter isTyConName $ children)
656
                                  (text "in import list"))
657
            case mb_parent of
658 659 660 661 662 663 664 665
              -- non-associated ty/cls
              Nothing     -> return [(IEThingWith name children,
                                      AvailTC name (name:children))]
              -- associated ty
              Just parent -> return [(IEThingWith name children,
                                      AvailTC name children),
                                     (IEThingWith name children,
                                      AvailTC parent [name])]
666 667 668 669 670 671

         _other -> Failed illegalImportItemErr
         -- could be IEModuleContents, IEGroup, IEDoc, IEDocNamed
         -- all errors.

      where
672 673
        mkIEThingAbs (n, av, Nothing    ) = (IEThingAbs n, trimAvail av n)
        mkIEThingAbs (n, _,  Just parent) = (IEThingAbs n, AvailTC parent [n])
674 675 676 677 678 679


catMaybeErr :: [MaybeErr err a] -> [a]
catMaybeErr ms =  [ a | Succeeded a <- ms ]
\end{code}

680
%************************************************************************
681 682 683
%*                                                                      *
\subsection{Import/Export Utils}
%*                                                                      *
684 685 686 687 688 689
%************************************************************************

\begin{code}
-- | make a 'GlobalRdrEnv' where all the elements point to the same
-- import declaration (useful for "hiding" imports, or imports with
-- no details).
690 691 692 693 694 695
gresFromAvails :: Provenance -> [AvailInfo] -> [GlobalRdrElt]
gresFromAvails prov avails
  = concatMap (gresFromAvail (const prov)) avails

gresFromAvail :: (Name -> Provenance) -> AvailInfo -> [GlobalRdrElt]
gresFromAvail prov_fn avail
696 697 698
  = [ GRE {gre_name = n,
           gre_par = availParent n avail,
           gre_prov = prov_fn n}
699
    | n <- availNames avail ]
700

701 702 703 704
greAvail :: GlobalRdrElt -> AvailInfo
greAvail gre = mkUnitAvail (gre_name gre) (gre_par gre)

mkUnitAvail :: Name -> Parent -> AvailInfo
705
mkUnitAvail me (ParentIs p)              = AvailTC p  [me]
706
mkUnitAvail me NoParent | isTyConName me = AvailTC me [me]
707
                        | otherwise      = Avail me
708

Ian Lynagh's avatar
Ian Lynagh committed
709 710 711
plusAvail :: GenAvailInfo Name -> GenAvailInfo Name -> GenAvailInfo Name
plusAvail (Avail n1)      (Avail _)        = Avail n1
plusAvail (AvailTC _ ns1) (AvailTC n2 ns2) = AvailTC n2 (ns1 `unionLists` ns2)
712 713 714
plusAvail a1 a2 = pprPanic "RnEnv.plusAvail" (hsep [ppr a1,ppr a2])

availParent :: Name -> AvailInfo -> Parent
Ian Lynagh's avatar
Ian Lynagh committed
715 716 717
availParent _ (Avail _)                 = NoParent
availParent n (AvailTC m _) | n == m    = NoParent
                            | otherwise = ParentIs m
718 719

trimAvail :: AvailInfo -> Name -> AvailInfo
Ian Lynagh's avatar
Ian Lynagh committed
720
trimAvail (Avail n)      _ = Avail n
721
trimAvail (AvailTC n ns) m = ASSERT( m `elem` ns) AvailTC n [m]
722 723 724 725 726 727 728 729 730 731 732 733 734 735 736

-- | filters 'AvailInfo's by the given predicate
filterAvails  :: (Name -> Bool) -> [AvailInfo] -> [AvailInfo]
filterAvails keep avails = foldr (filterAvail keep) [] avails

-- | filters an 'AvailInfo' by the given predicate
filterAvail :: (Name -> Bool) -> AvailInfo -> [AvailInfo] -> [AvailInfo]
filterAvail keep ie rest =
  case ie of
    Avail n | keep n    -> ie : rest
            | otherwise -> rest
    AvailTC tc ns ->
        let left = filter keep ns in
        if null left then rest else AvailTC tc left : rest

Ian Lynagh's avatar
Ian Lynagh committed
737
-- | Given an import\/export spec, construct the appropriate 'GlobalRdrElt's.
738 739 740
gresFromIE :: ImpDeclSpec -> (LIE Name, AvailInfo) -> [GlobalRdrElt]
gresFromIE decl_spec (L loc ie, avail)
  = gresFromAvail prov_fn avail
741
  where
742
    is_explicit = case ie of
743 744
                    IEThingAll name -> \n -> n == name
                    _               -> \_ -> True
745
    prov_fn name = Imported [imp_spec]
746 747 748
        where
          imp_spec  = ImpSpec { is_decl = decl_spec, is_item = item_spec }
          item_spec = ImpSome { is_explicit = is_explicit name, is_iloc = loc }
749 750 751 752

mkChildEnv :: [GlobalRdrElt] -> NameEnv [Name]
mkChildEnv gres = foldr add emptyNameEnv gres
    where
753 754
        add (GRE { gre_name = n, gre_par = ParentIs p }) env = extendNameEnv_Acc (:) singleton env p n
        add _                                            env = env
755 756 757 758 759 760

findChildren :: NameEnv [Name] -> Name -> [Name]
findChildren env n = lookupNameEnv env n `orElse` []
\end{code}

---------------------------------------
761
        AvailEnv and friends
762 763 764 765 766 767

All this AvailEnv stuff is hardly used; only in a very small
part of RnNames.  Todo: remove?
---------------------------------------

\begin{code}
768
type AvailEnv = NameEnv AvailInfo       -- Maps a Name to the AvailInfo that contains it
769 770 771 772

emptyAvailEnv :: AvailEnv
emptyAvailEnv = emptyNameEnv

773
{- Dead code
774 775 776 777 778 779 780 781
unitAvailEnv :: AvailInfo -> AvailEnv
unitAvailEnv a = unitNameEnv (availName a) a

plusAvailEnv :: AvailEnv -> AvailEnv -> AvailEnv
plusAvailEnv = plusNameEnv_C plusAvail

availEnvElts :: AvailEnv -> [AvailInfo]
availEnvElts = nameEnvElts
782
-}
783 784 785 786 787

addAvail :: AvailEnv -> AvailInfo -> AvailEnv
addAvail avails avail = extendNameEnv_C plusAvail avails (availName avail) avail

mkAvailEnv :: [AvailInfo] -> AvailEnv
788 789 790 791
-- 'avails' may have several items with the same availName
-- E.g  import Ix( Ix(..), index )
-- will give Ix(Ix,index,range) and Ix(index)
-- We want to combine these; addAvail does that
792 793
mkAvailEnv avails = foldl addAvail emptyAvailEnv avails

794 795 796 797 798 799 800 801 802
-- After combining the avails, we need to ensure that the parent name is the
-- first entry in the list of subnames, if it is included at all.  (Subsequent
-- functions rely on that.)
normaliseAvail :: AvailInfo -> AvailInfo
normaliseAvail avail@(Avail _)     = avail
normaliseAvail (AvailTC name subs) = AvailTC name subs'
  where
    subs' = if name `elem` subs then name : (delete name subs) else subs

803 804
-- | combines 'AvailInfo's from the same family
nubAvails :: [AvailInfo] -> [AvailInfo]
805
nubAvails avails = map normaliseAvail . nameEnvElts . mkAvailEnv $ avails
806 807 808 809
\end{code}


%************************************************************************
810
%*                                                                      *
811
\subsection{Export list processing}
812
%*                                                                      *
813 814 815 816
%************************************************************************

Processing the export list.

817 818 819 820 821
You might think that we should record things that appear in the export
list as ``occurrences'' (using @addOccurrenceName@), but you'd be
wrong.  We do check (here) that they are in scope, but there is no
need to slurp in their actual declaration (which is what
@addOccurrenceName@ forces).
822

823 824 825
Indeed, doing so would big trouble when compiling @PrelBase@, because
it re-exports @GHC@, which includes @takeMVar#@, whose type includes
@ConcBase.StateAndSynchVar#@, and so on...
826 827

\begin{code}
828 829
type ExportAccum        -- The type of the accumulating parameter of
                        -- the main worker function in rnExports
830
     = ([LIE Name],             -- Export items with Names
831 832 833
        ExportOccMap,                -- Tracks exported occurrence names
        [AvailInfo])            -- The accumulated exported stuff
                                --   Not nub'd!
834

Ian Lynagh's avatar
Ian Lynagh committed
835
emptyExportAccum :: ExportAccum
836
emptyExportAccum = ([], emptyOccEnv, [])
837

838
type ExportOccMap = OccEnv (Name, IE RdrName)
839 840 841 842
        -- Tracks what a particular exported OccName
        --   in an export list refers to, and which item
        --   it came from.  It's illegal to export two distinct things
        --   that have the same occurrence name
843

844
rnExports :: Bool       -- False => no 'module M(..) where' header at all
845
          -> Maybe [LIE RdrName]        -- Nothing => no explicit export list
846
          -> TcGblEnv
847
          -> RnM TcGblEnv
848

849
        -- Complains if two distinct exports have same OccName
850
        -- Warns about identical exports.
851 852 853 854 855 856 857 858 859 860 861 862 863
        -- Complains about exports items not in scope

rnExports explicit_mod exports
          tcg_env@(TcGblEnv { tcg_mod     = this_mod,
                              tcg_rdr_env = rdr_env,
                              tcg_imports = imports })
 = do   {
        -- If the module header is omitted altogether, then behave
        -- as if the user had written "module Main(main) where..."
        -- EXCEPT in interactive mode, when we behave as if he had
        -- written "module Main where ..."
        -- Reason: don't want to complain about 'main' not in scope
        --         in interactive mode
864
        ; dflags <- getDOpts
865 866 867 868 869 870 871 872 873 874 875
        ; let real_exports
                 | explicit_mod = exports
                 | ghcLink dflags == LinkInMemory = Nothing
                 | otherwise = Just ([noLoc (IEVar main_RDR_Unqual)])
                        -- ToDo: the 'noLoc' here is unhelpful if 'main'
                        --       turns out to be out of scope

        ; (rn_exports, avails) <- exports_from_avail real_exports rdr_env imports this_mod
        ; let final_avails = nubAvails avails    -- Combine families

        ; return (tcg_env { tcg_exports    = final_avails,
876
                            tcg_rn_exports = case tcg_rn_exports tcg_env of
877 878 879 880
                                                Nothing -> Nothing
                                                Just _  -> rn_exports,
                            tcg_dus = tcg_dus tcg_env `plusDU`
                                      usesOnly (availsToNameSet final_avails) }) }
881

882 883 884 885 886 887 888
exports_from_avail :: Maybe [LIE RdrName]
                         -- Nothing => no explicit export list
                   -> GlobalRdrEnv
                   -> ImportAvails
                   -> Module
                   -> RnM (Maybe [LIE Name], [AvailInfo])

Ian Lynagh's avatar
Ian Lynagh committed
889
exports_from_avail Nothing rdr_env _imports _this_mod
890
 = -- The same as (module M) where M is the current module name,
891 892
   -- so that's how we handle it.
   let
893
       avails = [ greAvail gre | gre <- globalRdrEnvElts rdr_env,
894 895 896 897 898
                                 isLocalGRE gre ]
   in
   return (Nothing, avails)

exports_from_avail (Just rdr_items) rdr_env imports this_mod
899
  = do (ie_names, _, exports) <- foldlM do_litem emptyExportAccum rdr_items
900

901
       return (Just ie_names, exports)
902
  where
903 904
    do_litem :: ExportAccum -> LIE RdrName -> RnM ExportAccum
    do_litem acc lie = setSrcSpan (getLoc lie) (exports_from_item acc lie)
905

906
    kids_env :: NameEnv [Name]  -- Maps a parent to its in-scope children
907 908
    kids_env = mkChildEnv (globalRdrEnvElts rdr_env)

909
    imported_modules = [ qual_name
910
                       | xs <- moduleEnvElts $ imp_mods imports,
911 912
                         (qual_name, _, _) <- xs ]

913
    exports_from_item :: ExportAccum -> LIE RdrName -> RnM ExportAccum
914
    exports_from_item acc@(ie_names, occs, exports)
915
                      (L loc ie@(IEModuleContents mod))
916 917 918 919 920 921 922 923
        | let earlier_mods = [ mod | (L _ (IEModuleContents mod)) <- ie_names ]
        , mod `elem` earlier_mods    -- Duplicate export of M
        = do { warn_dup_exports <- doptM Opt_WarnDuplicateExports ;
               warnIf warn_dup_exports (dupModuleExport mod) ;
               return acc }

        | otherwise
        = do { implicit_prelude <- xoptM Opt_ImplicitPrelude
924
             ; warnDodgyExports <- doptM Opt_WarnDodgyExports
925
             ; let { exportValid = (mod `elem` imported_modules)
926
                            || (moduleName this_mod == mod)
927 928
                   ; gres = filter (isModuleExported implicit_prelude mod)
                                   (globalRdrEnvElts rdr_env)
929
                   ; names = map gre_name gres
930
                   }
931

932
             ; checkErr exportValid (moduleNotImported mod)
933
             ; warnIf (warnDodgyExports && exportValid && null gres) (nullModuleExport mod)
934

935
             ; addUsedRdrNames (concat [ [mkRdrQual mod occ, mkRdrUnqual occ]
936
                                       | occ <- map nameOccName names ])
937 938
                        -- The qualified and unqualified version of all of
                        -- these names are, in effect, used by this export
939

940
             ; occs' <- check_occs ie occs names
941 942 943 944 945 946
                      -- This check_occs not only finds conflicts
                      -- between this item and others, but also
                      -- internally within this item.  That is, if
                      -- 'M.x' is in scope in several ways, we'll have
                      -- several members of mod_avails with the same
                      -- OccName.
947
             ; return (L loc (IEModuleContents mod) : ie_names,
948
                       occs', map greAvail gres ++ exports) }
949 950

    exports_from_item acc@(lie_names, occs, exports) (L loc ie)
951 952 953
        | isDoc ie
        = do new_ie <- lookup_doc_ie ie
             return (L loc new_ie : lie_names, occs, exports)
954

955
        | otherwise
956 957
        = do (new_ie, avail) <- lookup_ie ie
             if isUnboundName (ieName new_ie)
958
                  then return acc    -- Avoid error cascade
959 960
                  else do

961
             occs' <- check_occs ie occs (availNames avail)
962

963 964 965 966
             return (L loc new_ie : lie_names, occs', avail : exports)

    -------------
    lookup_ie :: IE RdrName -> RnM (IE Name, AvailInfo)
967
    lookup_ie (IEVar rdr)
968 969
        = do gre <- lookupGreRn rdr
             return (IEVar (gre_name gre), greAvail gre)
970

971
    lookup_ie (IEThingAbs rdr)
972
        = do gre <- lookupGreRn rdr
973 974 975 976 977 978 979 980
             let name = gre_name gre
             case gre_par gre of
                NoParent   -> return (IEThingAbs name,
                                      AvailTC name [name])
                ParentIs p -> return (IEThingAbs name,
                                      AvailTC p [name])

    lookup_ie ie@(IEThingAll rdr)
981
        = do name <- lookupGlobalOccRn rdr
982
             let kids = findChildren kids_env name
983 984 985 986
                 mkKidRdrName = case isQual_maybe rdr of
                                Nothing -> mkRdrUnqual
                                Just (modName, _) -> mkRdrQual modName
             addUsedRdrNames $ map (mkKidRdrName . nameOccName) kids
987 988 989 990 991
             warnDodgyExports <- doptM Opt_WarnDodgyExports
             when (null kids) $
                  if isTyConName name
                  then when warnDodgyExports $ addWarn (dodgyExportWarn name)
                  else -- This occurs when you export T(..), but
992
                       -- only import T abstractly, or T is a synonym.
993 994
                       addErr (exportItemErr ie)

995
             return (IEThingAll name, AvailTC name (name:kids))
996 997 998 999

    lookup_ie ie@(IEThingWith rdr sub_rdrs)
        = do name <- lookupGlobalOccRn rdr
             if isUnboundName name
1000
                then return (IEThingWith name [], AvailTC name [name])
1001
                else do
1002
             let env = mkOccEnv [ (nameOccName s, s)
1003 1004
                                | s <- findChildren kids_env name ]
                 mb_names = map (lookupOccEnv env . rdrNameOcc) sub_rdrs
1005 1006
             if any isNothing mb_names
                then do addErr (exportItemErr ie)
1007
                        return (IEThingWith name [], AvailTC name [name])
1008
                else do let names = catMaybes mb_names