RnNames.hs 83.5 KB
Newer Older
Austin Seipp's avatar
Austin Seipp committed
1 2 3
{-
(c) The GRASP/AQUA Project, Glasgow University, 1992-1998

4
\section[RnNames]{Extracting imported and top-level names in scope}
Austin Seipp's avatar
Austin Seipp committed
5
-}
6

7 8
{-# LANGUAGE CPP, NondecreasingIndentation #-}

9
module RnNames (
Matthew Pickering's avatar
Matthew Pickering committed
10
        rnImports, getLocalNonValBinders, newRecordSelector,
11
        rnExports, extendGlobalRdrEnvRn,
Erik de Castro Lopo's avatar
Erik de Castro Lopo committed
12
        gresFromAvails,
13
        calculateAvails,
Erik de Castro Lopo's avatar
Erik de Castro Lopo committed
14
        reportUnusedNames,
cactus's avatar
cactus committed
15
        checkConName
16 17 18 19
    ) where

#include "HsVersions.h"

20
import DynFlags
Ian Lynagh's avatar
Ian Lynagh committed
21
import HsSyn
Adam Gundry's avatar
Adam Gundry committed
22
import TcEnv
23
import RnEnv
24
import RnHsDoc          ( rnHsDoc )
25
import LoadIface        ( loadSrcInterface )
26
import TcRnMonad
Simon Marlow's avatar
Simon Marlow committed
27 28
import PrelNames
import Module
29
import Name
30
import NameEnv
31
import NameSet
32
import Avail
Adam Gundry's avatar
Adam Gundry committed
33
import FieldLabel
34 35
import HscTypes
import RdrName
36
import RdrHsSyn        ( setRdrNameSpace )
37
import Outputable
38
import Maybes
39
import SrcLoc
40
import BasicTypes      ( TopLevelFlag(..), StringLiteral(..) )
41
import ErrUtils
42
import Util
43
import FastString
Adam Gundry's avatar
Adam Gundry committed
44
import FastStringEnv
45
import ListSetOps
dterei's avatar
dterei committed
46

Ian Lynagh's avatar
Ian Lynagh committed
47
import Control.Monad
Adam Gundry's avatar
Adam Gundry committed
48 49
import Data.Either      ( partitionEithers, isRight, rights )
import qualified Data.Foldable as Foldable
50
import Data.Map         ( Map )
51
import qualified Data.Map as Map
Adam Gundry's avatar
Adam Gundry committed
52 53
import Data.Ord         ( comparing )
import Data.List        ( partition, (\\), find, sortBy )
dterei's avatar
dterei committed
54
import qualified Data.Set as Set
55
import System.FilePath  ((</>))
dterei's avatar
dterei committed
56
import System.IO
57

Austin Seipp's avatar
Austin Seipp committed
58 59 60
{-
************************************************************************
*                                                                      *
61
\subsection{rnImports}
Austin Seipp's avatar
Austin Seipp committed
62 63
*                                                                      *
************************************************************************
64

65 66 67 68 69 70 71 72 73
Note [Tracking Trust Transitively]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
When we import a package as well as checking that the direct imports are safe
according to the rules outlined in the Note [HscMain . Safe Haskell Trust Check]
we must also check that these rules hold transitively for all dependent modules
and packages. Doing this without caching any trust information would be very
slow as we would need to touch all packages and interface files a module depends
on. To avoid this we make use of the property that if a modules Safe Haskell
mode changes, this triggers a recompilation from that module in the dependcy
dterei's avatar
dterei committed
74 75 76 77 78 79 80 81
graph. So we can just worry mostly about direct imports.

There is one trust property that can change for a package though without
recompliation being triggered: package trust. So we must check that all
packages a module tranitively depends on to be trusted are still trusted when
we are compiling this module (as due to recompilation avoidance some modules
below may not be considered trusted any more without recompilation being
triggered).
82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115

We handle this by augmenting the existing transitive list of packages a module M
depends on with a bool for each package that says if it must be trusted when the
module M is being checked for trust. This list of trust required packages for a
single import is gathered in the rnImportDecl function and stored in an
ImportAvails data structure. The union of these trust required packages for all
imports is done by the rnImports function using the combine function which calls
the plusImportAvails function that is a union operation for the ImportAvails
type. This gives us in an ImportAvails structure all packages required to be
trusted for the module we are currently compiling. Checking that these packages
are still trusted (and that direct imports are trusted) is done in
HscMain.checkSafeImports.

See the note below, [Trust Own Package] for a corner case in this method and
how its handled.


Note [Trust Own Package]
~~~~~~~~~~~~~~~~~~~~~~~~
There is a corner case of package trust checking that the usual transitive check
doesn't cover. (For how the usual check operates see the Note [Tracking Trust
Transitively] below). The case is when you import a -XSafe module M and M
imports a -XTrustworthy module N. If N resides in a different package than M,
then the usual check works as M will record a package dependency on N's package
and mark it as required to be trusted. If N resides in the same package as M
though, then importing M should require its own package be trusted due to N
(since M is -XSafe so doesn't create this requirement by itself). The usual
check fails as a module doesn't record a package dependency of its own package.
So instead we now have a bool field in a modules interface file that simply
states if the module requires its own package to be trusted. This field avoids
us having to load all interface files that the module depends on to see if one
is trustworthy.


116 117 118 119 120 121 122 123 124 125
Note [Trust Transitive Property]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
So there is an interesting design question in regards to transitive trust
checking. Say I have a module B compiled with -XSafe. B is dependent on a bunch
of modules and packages, some packages it requires to be trusted as its using
-XTrustworthy modules from them. Now if I have a module A that doesn't use safe
haskell at all and simply imports B, should A inherit all the the trust
requirements from B? Should A now also require that a package p is trusted since
B required it?

dterei's avatar
dterei committed
126
We currently say no but saying yes also makes sense. The difference is, if a
127
module M that doesn't use Safe Haskell imports a module N that does, should all
128 129 130 131 132 133 134
the trusted package requirements be dropped since M didn't declare that it cares
about Safe Haskell (so -XSafe is more strongly associated with the module doing
the importing) or should it be done still since the author of the module N that
uses Safe Haskell said they cared (so -XSafe is more strongly associated with
the module that was compiled that used it).

Going with yes is a simpler semantics we think and harder for the user to stuff
135 136
up but it does mean that Safe Haskell will affect users who don't care about
Safe Haskell as they might grab a package from Cabal which uses safe haskell (say
137 138 139 140 141 142
network) and that packages imports -XTrustworthy modules from another package
(say bytestring), so requires that package is trusted. The user may now get
compilation errors in code that doesn't do anything with Safe Haskell simply
because they are using the network package. They will have to call 'ghc-pkg
trust network' to get everything working. Due to this invasive nature of going
with yes we have gone with no for now.
Austin Seipp's avatar
Austin Seipp committed
143
-}
144

145 146 147 148
-- | Process Import Decls.  See 'rnImportDecl' for a description of what
-- the return types represent.
-- Note: Do the non SOURCE ones first, so that we get a helpful warning
-- for SOURCE ones that are unnecessary
149 150
rnImports :: [LImportDecl RdrName]
          -> RnM ([LImportDecl Name], GlobalRdrEnv, ImportAvails, AnyHpcUsage)
dterei's avatar
dterei committed
151 152 153 154
rnImports imports = do
    this_mod <- getModule
    let (source, ordinary) = partition is_source_import imports
        is_source_import d = ideclSource (unLoc d)
155 156
    stuff1 <- mapAndReportM (rnImportDecl this_mod) ordinary
    stuff2 <- mapAndReportM (rnImportDecl this_mod) source
dterei's avatar
dterei committed
157 158 159 160 161 162 163 164
    -- Safe Haskell: See Note [Tracking Trust Transitively]
    let (decls, rdr_env, imp_avails, hpc_usage) = combine (stuff1 ++ stuff2)
    return (decls, rdr_env, imp_avails, hpc_usage)

  where
    combine :: [(LImportDecl Name,  GlobalRdrEnv, ImportAvails, AnyHpcUsage)]
            -> ([LImportDecl Name], GlobalRdrEnv, ImportAvails, AnyHpcUsage)
    combine = foldr plus ([], emptyGlobalRdrEnv, emptyImportAvails, False)
Erik de Castro Lopo's avatar
Erik de Castro Lopo committed
165

dterei's avatar
dterei committed
166 167 168 169 170 171 172
    plus (decl,  gbl_env1, imp_avails1,hpc_usage1)
         (decls, gbl_env2, imp_avails2,hpc_usage2)
      = ( decl:decls,
          gbl_env1 `plusGlobalRdrEnv` gbl_env2,
          imp_avails1 `plusImportAvails` imp_avails2,
          hpc_usage1 || hpc_usage2 )

173 174 175 176 177 178 179 180 181 182 183 184 185 186 187
-- | Given a located import declaration @decl@ from @this_mod@,
-- calculate the following pieces of information:
--
--  1. An updated 'LImportDecl', where all unresolved 'RdrName' in
--     the entity lists have been resolved into 'Name's,
--
--  2. A 'GlobalRdrEnv' representing the new identifiers that were
--     brought into scope (taking into account module qualification
--     and hiding),
--
--  3. 'ImportAvails' summarizing the identifiers that were imported
--     by this declaration, and
--
--  4. A boolean 'AnyHpcUsage' which is true if the imported module
--     used HPC.
dterei's avatar
dterei committed
188
rnImportDecl  :: Module -> LImportDecl RdrName
dterei's avatar
dterei committed
189
              -> RnM (LImportDecl Name, GlobalRdrEnv, ImportAvails, AnyHpcUsage)
Erik de Castro Lopo's avatar
Erik de Castro Lopo committed
190
rnImportDecl this_mod
191 192 193 194
             (L loc decl@(ImportDecl { ideclName = loc_imp_mod_name, ideclPkgQual = mb_pkg
                                     , ideclSource = want_boot, ideclSafe = mod_safe
                                     , ideclQualified = qual_only, ideclImplicit = implicit
                                     , ideclAs = as_mod, ideclHiding = imp_details }))
195
  = setSrcSpan loc $ do
196

197
    when (isJust mb_pkg) $ do
198
        pkg_imports <- xoptM Opt_PackageImports
199 200
        when (not pkg_imports) $ addErr packageImportErr

dterei's avatar
dterei committed
201 202 203
    -- If there's an error in loadInterface, (e.g. interface
    -- file not found) we get lots of spurious errors from 'filterImports'
    let imp_mod_name = unLoc loc_imp_mod_name
204
        doc = ppr imp_mod_name <+> ptext (sLit "is directly imported")
205

206 207 208
    -- Check for self-import, which confuses the typechecker (Trac #9032)
    -- ghc --make rejects self-import cycles already, but batch-mode may not
    -- at least not until TcIface.tcHiBootIface, which is too late to avoid
209 210 211 212 213 214 215 216 217 218
    -- typechecker crashes.  (Indirect self imports are not caught until
    -- TcIface, see #10337 tracking how to make this error better.)
    --
    -- Originally, we also allowed 'import {-# SOURCE #-} M', but this
    -- caused bug #10182: in one-shot mode, we should never load an hs-boot
    -- file for the module we are compiling into the EPS.  In principle,
    -- it should be possible to support this mode of use, but we would have to
    -- extend Provenance to support a local definition in a qualified location.
    -- For now, we don't support it, but see #10336
    when (imp_mod_name == moduleName this_mod &&
219 220 221 222
          (case mb_pkg of  -- If we have import "<pkg>" M, then we should
                           -- check that "<pkg>" is "this" (which is magic)
                           -- or the name of this_mod's package.  Yurgh!
                           -- c.f. GHC.findModule, and Trac #9997
223
             Nothing         -> True
224
             Just (StringLiteral _ pkg_fs) -> pkg_fs == fsLit "this" ||
225
                            fsToUnitId pkg_fs == moduleUnitId this_mod))
226 227
         (addErr (ptext (sLit "A module cannot import itself:") <+> ppr imp_mod_name))

dterei's avatar
dterei committed
228 229
    -- Check for a missing import list (Opt_WarnMissingImportList also
    -- checks for T(..) items but that is done in checkDodgyImport below)
230
    case imp_details of
231 232 233
        Just (False, _) -> return () -- Explicit import list
        _  | implicit   -> return () -- Do not bleat for implicit imports
           | qual_only  -> return ()
ian@well-typed.com's avatar
ian@well-typed.com committed
234
           | otherwise  -> whenWOptM Opt_WarnMissingImportList $
235
                           addWarn (missingImportListWarn imp_mod_name)
236

237
    iface <- loadSrcInterface doc imp_mod_name want_boot (fmap sl_fs mb_pkg)
238

dterei's avatar
dterei committed
239 240
    -- Compiler sanity check: if the import didn't say
    -- {-# SOURCE #-} we should not get a hi-boot file
241
    WARN( not want_boot && mi_boot iface, ppr imp_mod_name ) do
dterei's avatar
dterei committed
242 243 244 245 246 247 248 249 250

    -- 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.
    --
    -- 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.
251
    dflags <- getDynFlags
252
    warnIf (want_boot && not (mi_boot iface) && isOneShot (ghcMode dflags))
253
           (warnRedundantSourceImport imp_mod_name)
254
    when (mod_safe && not (safeImportsOn dflags)) $
255 256 257
        addErr (ptext (sLit "safe import can't be used as Safe Haskell isn't on!")
                $+$ ptext (sLit $ "please enable Safe Haskell through either "
                                   ++ "Safe, Trustworthy or Unsafe"))
258

259
    let
dterei's avatar
dterei committed
260
        qual_mod_name = as_mod `orElse` imp_mod_name
261 262 263 264
        imp_spec  = ImpDeclSpec { is_mod = imp_mod_name, is_qual = qual_only,
                                  is_dloc = loc, is_as = qual_mod_name }

    -- filter the imports according to the import declaration
265
    (new_imp_details, gres) <- filterImports iface imp_spec imp_details
266

267
    let gbl_env = mkGlobalRdrEnv gres
268 269 270

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

274 275
        -- should the import be safe?
        mod_safe' = mod_safe
276 277
                    || (not implicit && safeDirectImpsReq dflags)
                    || (implicit && safeImplicitImpsReq dflags)
278

279
    let imports
280
          = (calculateAvails dflags iface mod_safe' want_boot) {
281
                imp_mods = unitModuleEnv (mi_module iface)
282
                            [(qual_mod_name, import_all, loc, mod_safe')] }
283

284
    -- Complain if we import a deprecated module
ian@well-typed.com's avatar
ian@well-typed.com committed
285
    whenWOptM Opt_WarnWarningsDeprecations (
286
       case (mi_warns iface) of
dterei's avatar
dterei committed
287
          WarnAll txt -> addWarn $ moduleWarn imp_mod_name txt
288
          _           -> return ()
289 290
     )

291 292
    let new_imp_decl = L loc (decl { ideclSafe = mod_safe'
                                   , ideclHiding = new_imp_details })
293

294
    return (new_imp_decl, gbl_env, imports, mi_hpc iface)
295

296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339
-- | Calculate the 'ImportAvails' induced by an import of a particular
-- interface, but without 'imp_mods'.
calculateAvails :: DynFlags
                -> ModIface
                -> IsSafeImport
                -> IsBootInterface
                -> ImportAvails
calculateAvails dflags iface mod_safe' want_boot =
  let imp_mod    = mi_module iface
      orph_iface = mi_orphan iface
      has_finsts = mi_finsts iface
      deps       = mi_deps iface
      trust      = getSafeMode $ mi_trust iface
      trust_pkg  = mi_trust_pkg iface

      -- 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.)
      --
      -- We do this *after* filterImports, so that if you say
      --      module A where
      --         import B( AType )
      --         type AType = ...
      --
      --      module B( AType ) where
      --         import {-# SOURCE #-} A( AType )
      --
      -- then you won't get a 'B does not export AType' message.


      -- 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

340
      pkg = moduleUnitId (mi_module iface)
341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388

      -- Does this import mean we now require our own pkg
      -- to be trusted? See Note [Trust Own Package]
      ptrust = trust == Sf_Trustworthy || trust_pkg

      (dependent_mods, dependent_pkgs, pkg_trust_req)
         | 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
            ((moduleName imp_mod,want_boot):dep_mods deps,dep_pkgs deps,ptrust)

         | 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` (map fst $ dep_pkgs deps))
                   , ppr pkg <+> ppr (dep_pkgs deps) )
            ([], (pkg, False) : dep_pkgs deps, False)

  in ImportAvails {
          imp_mods       = emptyModuleEnv, -- this gets filled in later
          imp_orphs      = orphans,
          imp_finsts     = finsts,
          imp_dep_mods   = mkModDeps dependent_mods,
          imp_dep_pkgs   = map fst $ dependent_pkgs,
          -- Add in the imported modules trusted package
          -- requirements. ONLY do this though if we import the
          -- module as a safe import.
          -- See Note [Tracking Trust Transitively]
          -- and Note [Trust Transitive Property]
          imp_trust_pkgs = if mod_safe'
                               then map fst $ filter snd dependent_pkgs
                               else [],
          -- Do we require our own pkg to be trusted?
          -- See Note [Trust Own Package]
          imp_trust_own_pkg = pkg_trust_req
     }


Ian Lynagh's avatar
Ian Lynagh committed
389
warnRedundantSourceImport :: ModuleName -> SDoc
390
warnRedundantSourceImport mod_name
Ian Lynagh's avatar
Ian Lynagh committed
391
  = ptext (sLit "Unnecessary {-# SOURCE #-} in the import of module")
392
          <+> quotes (ppr mod_name)
393

Austin Seipp's avatar
Austin Seipp committed
394 395 396
{-
************************************************************************
*                                                                      *
397
\subsection{importsFromLocalDecls}
Austin Seipp's avatar
Austin Seipp committed
398 399
*                                                                      *
************************************************************************
400 401

From the top-level declarations of this module produce
402 403 404 405
        * the lexical environment
        * the ImportAvails
created by its bindings.

406 407
Note [Top-level Names in Template Haskell decl quotes]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
408
See also: Note [Interactively-bound Ids in GHCi] in HscTypes
409
          Note [Looking up Exact RdrNames] in RnEnv
410

411 412
Consider a Template Haskell declaration quotation like this:
      module M where
413
        f x = h [d| f = 3 |]
414 415
When renaming the declarations inside [d| ...|], we treat the
top level binders specially in two ways
416

417 418
1.  We give them an Internal Name, not (as usual) an External one.
    This is done by RnEnv.newTopSrcBinder.
419

420 421
2.  We make them *shadow* the outer bindings.
    See Note [GlobalRdrEnv shadowing]
422 423 424 425 426

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.
Austin Seipp's avatar
Austin Seipp committed
427
-}
428

429
extendGlobalRdrEnvRn :: [AvailInfo]
430 431 432 433 434 435
                     -> 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]
436

437
extendGlobalRdrEnvRn avails new_fixities
438
  = do  { (gbl_env, lcl_env) <- getEnvs
439
        ; stage <- getStage
440
        ; isGHCi <- getIsGHCi
441 442 443 444
        ; let rdr_env  = tcg_rdr_env gbl_env
              fix_env  = tcg_fix_env gbl_env
              th_bndrs = tcl_th_bndrs lcl_env
              th_lvl   = thLevel stage
445 446 447 448

              -- Delete new_occs from global and local envs
              -- If we are in a TemplateHaskell decl bracket,
              --    we are going to shadow them
449
              -- See Note [GlobalRdrEnv shadowing]
450
              inBracket = isBrackStage stage
451

452
              lcl_env_TH = lcl_env { tcl_rdr = delLocalRdrEnvList (tcl_rdr lcl_env) new_occs }
453
                           -- See Note [GlobalRdrEnv shadowing]
454

455 456 457
              lcl_env2 | inBracket = lcl_env_TH
                       | otherwise = lcl_env

458 459 460 461
              -- Deal with shadowing: see Note [GlobalRdrEnv shadowing]
              want_shadowing = isGHCi || inBracket
              rdr_env1 | want_shadowing = shadowNames rdr_env new_names
                       | otherwise      = rdr_env
462

463 464 465
              lcl_env3 = lcl_env2 { tcl_th_bndrs = extendNameEnvList th_bndrs
                                                       [ (n, (TopLevel, th_lvl))
                                                       | n <- new_names ] }
466

467
        ; rdr_env2 <- foldlM add_gre rdr_env1 new_gres
468

469 470
        ; let fix_env' = foldl extend_fix_env fix_env new_names
              gbl_env' = gbl_env { tcg_rdr_env = rdr_env2, tcg_fix_env = fix_env' }
471

472
        ; traceRn (text "extendGlobalRdrEnvRn 2" <+> (pprGlobalRdrEnv True rdr_env2))
473
        ; return (gbl_env', lcl_env3) }
474
  where
475
    new_names = concatMap availNames avails
476
    new_occs  = map nameOccName new_names
477

478
    -- If there is a fixity decl for the gre, add it to the fixity env
479
    extend_fix_env fix_env name
480 481 482 483 484
      | Just (L _ fi) <- lookupFsEnv new_fixities (occNameFS occ)
      = extendNameEnv fix_env name (FixItem occ fi)
      | otherwise
      = fix_env
      where
485
        occ  = nameOccName name
486

487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510
    new_gres :: [GlobalRdrElt]  -- New LocalDef GREs, derived from avails
    new_gres = concatMap localGREsFromAvail avails

    add_gre :: GlobalRdrEnv -> GlobalRdrElt -> RnM GlobalRdrEnv
    -- Extend the GlobalRdrEnv with a LocalDef GRE
    -- If there is already a LocalDef GRE with the same OccName,
    --    report an error and discard the new GRE
    -- This establishes INVARIANT 1 of GlobalRdrEnvs
    add_gre env gre
      | not (null dups)    -- Same OccName defined twice
      = do { addDupDeclErr (gre : dups); return env }

      | otherwise
      = return (extendGlobalRdrEnv env gre)
      where
        name = gre_name gre
        occ  = nameOccName name
        dups = filter isLocalGRE (lookupGlobalRdrEnv env occ)


{- *********************************************************************
*                                                                      *
    getLocalDeclBindersd@ returns the names for an HsDecl
             It's used for source code.
511

512
        *** See "THE NAMING STORY" in HsDecls ****
513 514
*                                                                      *
********************************************************************* -}
515

Erik de Castro Lopo's avatar
Erik de Castro Lopo committed
516
getLocalNonValBinders :: MiniFixityEnv -> HsGroup RdrName
Adam Gundry's avatar
Adam Gundry committed
517
    -> RnM ((TcGblEnv, TcLclEnv), NameSet)
518
-- Get all the top-level binders bound the group *except*
519
-- for value bindings, which are treated separately
Simon Peyton Jones's avatar
Simon Peyton Jones committed
520
-- Specifically we return AvailInfo for
521 522 523 524
--      * type decls (incl constructors and record selectors)
--      * class decls (including class ops)
--      * associated types
--      * foreign imports
525
--      * value signatures (in hs-boot files only)
526

Erik de Castro Lopo's avatar
Erik de Castro Lopo committed
527
getLocalNonValBinders fixity_env
528
     (HsGroup { hs_valds  = binds,
529 530 531
                hs_tyclds = tycl_decls,
                hs_instds = inst_decls,
                hs_fords  = foreign_decls })
532
  = do  { -- Process all type/class decls *except* family instances
Adam Gundry's avatar
Adam Gundry committed
533 534 535
        ; overload_ok <- xoptM Opt_DuplicateRecordFields
        ; (tc_avails, tc_fldss) <- fmap unzip $ mapM (new_tc overload_ok)
                                                    (tyClGroupConcat tycl_decls)
536
        ; traceRn (text "getLocalNonValBinders 1" <+> ppr tc_avails)
537
        ; envs <- extendGlobalRdrEnvRn tc_avails fixity_env
dterei's avatar
dterei committed
538 539
        ; setEnvs envs $ do {
            -- Bring these things into scope first
540
            -- See Note [Looking up family names in family instances]
541 542

          -- Process all family instances
dterei's avatar
dterei committed
543
          -- to bring new data constructors into scope
Adam Gundry's avatar
Adam Gundry committed
544 545
        ; (nti_availss, nti_fldss) <- mapAndUnzipM (new_assoc overload_ok)
                                                   inst_decls
546 547

          -- Finish off with value binders:
548
          --    foreign decls and pattern synonyms for an ordinary module
dterei's avatar
dterei committed
549
          --    type sigs in case of a hs-boot file only
550
        ; is_boot <- tcIsHsBootOrSig
551
        ; let val_bndrs | is_boot   = hs_boot_sig_bndrs
552
                        | otherwise = for_hs_bndrs
553
        ; val_avails <- mapM new_simple val_bndrs
554

Adam Gundry's avatar
Adam Gundry committed
555
        ; let avails    = concat nti_availss ++ val_avails
556
              new_bndrs = availsToNameSet avails `unionNameSet`
557
                          availsToNameSet tc_avails
Adam Gundry's avatar
Adam Gundry committed
558
              flds      = concat nti_fldss ++ concat tc_fldss
559
        ; traceRn (text "getLocalNonValBinders 2" <+> ppr avails)
Adam Gundry's avatar
Adam Gundry committed
560 561 562 563 564 565 566
        ; (tcg_env, tcl_env) <- extendGlobalRdrEnvRn avails fixity_env

        -- Extend tcg_field_env with new fields (this used to be the
        -- work of extendRecordFieldEnv)
        ; let field_env = extendNameEnvList (tcg_field_env tcg_env) flds
              envs      = (tcg_env { tcg_field_env = field_env }, tcl_env)

567 568
        ; return (envs, new_bndrs) } }
  where
569
    ValBindsIn _val_binds val_sigs = binds
570

571
    for_hs_bndrs :: [Located RdrName]
572 573
    for_hs_bndrs = hsForeignDeclsBinders foreign_decls

574
    -- In a hs-boot file, the value binders come from the
575
    --  *signatures*, and there should be no foreign binders
eir@cis.upenn.edu's avatar
eir@cis.upenn.edu committed
576
    hs_boot_sig_bndrs = [ L decl_loc (unLoc n)
thomasw's avatar
thomasw committed
577
                        | L decl_loc (TypeSig ns _ _) <- val_sigs, n <- ns]
578

eir@cis.upenn.edu's avatar
eir@cis.upenn.edu committed
579 580
      -- the SrcSpan attached to the input should be the span of the
      -- declaration, not just the name
581
    new_simple :: Located RdrName -> RnM AvailInfo
582 583
    new_simple rdr_name = do{ nm <- newTopSrcBinder rdr_name
                            ; return (Avail nm) }
584

Adam Gundry's avatar
Adam Gundry committed
585 586 587 588 589
    new_tc :: Bool -> LTyClDecl RdrName
           -> RnM (AvailInfo, [(Name, [FieldLabel])])
    new_tc overload_ok tc_decl -- NOT for type/data instances
        = do { let (bndrs, flds) = hsLTyClDeclBinders tc_decl
             ; names@(main_name : sub_names) <- mapM newTopSrcBinder bndrs
Matthew Pickering's avatar
Matthew Pickering committed
590
             ; flds' <- mapM (newRecordSelector overload_ok sub_names) flds
Adam Gundry's avatar
Adam Gundry committed
591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622
             ; let fld_env = case unLoc tc_decl of
                     DataDecl { tcdDataDefn = d } -> mk_fld_env d names flds'
                     _                            -> []
             ; return (AvailTC main_name names flds', fld_env) }


    -- Calculate the mapping from constructor names to fields, which
    -- will go in tcg_field_env. It's convenient to do this here where
    -- we are working with a single datatype definition.
    mk_fld_env :: HsDataDefn RdrName -> [Name] -> [FieldLabel] -> [(Name, [FieldLabel])]
    mk_fld_env d names flds = concatMap find_con_flds (dd_cons d)
      where
        find_con_flds (L _ (ConDecl { con_names   = rdrs
                                    , con_details = RecCon cdflds }))
            = map (\ (L _ rdr) -> ( find_con_name rdr
                                  , concatMap find_con_decl_flds (unLoc cdflds)))
                  rdrs
        find_con_flds _ = []

        find_con_name rdr
          = expectJust "getLocalNonValBinders/find_con_name" $
              find (\ n -> nameOccName n == rdrNameOcc rdr) names
        find_con_decl_flds (L _ x)
          = map find_con_decl_fld (cd_fld_names x)
        find_con_decl_fld  (L _ (FieldOcc rdr _))
          = expectJust "getLocalNonValBinders/find_con_decl_fld" $
              find (\ fl -> flLabel fl == lbl) flds
          where lbl = occNameFS (rdrNameOcc rdr)

    new_assoc :: Bool -> LInstDecl RdrName
              -> RnM ([AvailInfo], [(Name, [FieldLabel])])
    new_assoc _ (L _ (TyFamInstD {})) = return ([], [])
Erik de Castro Lopo's avatar
Erik de Castro Lopo committed
623 624
      -- type instances don't bind new names

Adam Gundry's avatar
Adam Gundry committed
625 626 627 628 629
    new_assoc overload_ok (L _ (DataFamInstD d))
      = do { (avail, flds) <- new_di overload_ok Nothing d
           ; return ([avail], flds) }
    new_assoc overload_ok (L _ (ClsInstD (ClsInstDecl { cid_poly_ty = inst_ty
                                                      , cid_datafam_insts = adts })))
630 631
      | Just (_, _, L loc cls_rdr, _) <-
                   splitLHsInstDeclTy_maybe (flattenTopLevelLHsForAllTy inst_ty)
632
      = do { cls_nm <- setSrcSpan loc $ lookupGlobalOccRn cls_rdr
Adam Gundry's avatar
Adam Gundry committed
633 634 635
           ; (avails, fldss)
                    <- mapAndUnzipM (new_loc_di overload_ok (Just cls_nm)) adts
           ; return (avails, concat fldss) }
636
      | otherwise
Adam Gundry's avatar
Adam Gundry committed
637 638
      = return ([], [])    -- Do not crash on ill-formed instances
                           -- Eg   instance !Show Int   Trac #3811c
639

Adam Gundry's avatar
Adam Gundry committed
640 641 642
    new_di :: Bool -> Maybe Name -> DataFamInstDecl RdrName
                   -> RnM (AvailInfo, [(Name, [FieldLabel])])
    new_di overload_ok mb_cls ti_decl
643
        = do { main_name <- lookupFamInstName mb_cls (dfid_tycon ti_decl)
Adam Gundry's avatar
Adam Gundry committed
644 645
             ; let (bndrs, flds) = hsDataFamInstBinders ti_decl
             ; sub_names <- mapM newTopSrcBinder bndrs
Matthew Pickering's avatar
Matthew Pickering committed
646
             ; flds' <- mapM (newRecordSelector overload_ok sub_names) flds
Adam Gundry's avatar
Adam Gundry committed
647 648 649 650 651 652 653 654
             ; let avail    = AvailTC (unLoc main_name) sub_names flds'
                                  -- main_name is not bound here!
                   fld_env  = mk_fld_env (dfid_defn ti_decl) sub_names flds'
             ; return (avail, fld_env) }

    new_loc_di :: Bool -> Maybe Name -> LDataFamInstDecl RdrName
                   -> RnM (AvailInfo, [(Name, [FieldLabel])])
    new_loc_di overload_ok mb_cls (L _ d) = new_di overload_ok mb_cls d
655

Matthew Pickering's avatar
Matthew Pickering committed
656 657 658 659 660 661 662 663 664 665
newRecordSelector :: Bool -> [Name] -> LFieldOcc RdrName -> RnM FieldLabel
newRecordSelector _ [] _ = error "newRecordSelector: datatype has no constructors!"
newRecordSelector overload_ok (dc:_) (L loc (FieldOcc fld _)) =
  do { sel_name <- newTopSrcBinder $ L loc $ mkRdrUnqual sel_occ
     ; return $ fl { flSelector = sel_name } }
  where
    lbl     = occNameFS $ rdrNameOcc fld
    fl      = mkFieldLabelOccs lbl (nameOccName dc) overload_ok
    sel_occ = flSelector fl

Austin Seipp's avatar
Austin Seipp committed
666
{-
667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684
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
not have been added to the global environment yet.

Solution is simple: process the type family declarations first, extend
the environment, and then process the type instances.


Austin Seipp's avatar
Austin Seipp committed
685 686
************************************************************************
*                                                                      *
687
\subsection{Filtering imports}
Austin Seipp's avatar
Austin Seipp committed
688 689
*                                                                      *
************************************************************************
690 691 692 693

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

694 695
Note [Dealing with imports]
~~~~~~~~~~~~~~~~~~~~~~~~~~~
Austin Seipp's avatar
Austin Seipp committed
696 697
For import M( ies ), we take the mi_exports of M, and make
   imp_occ_env :: OccEnv (Name, AvailInfo, Maybe Name)
698
One entry for each Name that M exports; the AvailInfo describes just
Austin Seipp's avatar
Austin Seipp committed
699
that Name.
700 701 702 703 704 705 706 707 708 709

The situation is made more complicated by associated types. E.g.
   module M where
     class    C a    where { data T a }
     instance C Int  where { data T Int = T1 | T2 }
     instance C Bool where { data T Int = T3 }
Then M's export_avails are (recall the AvailTC invariant from Avails.hs)
  C(C,T), T(T,T1,T2,T3)
Notice that T appears *twice*, once as a child and once as a parent.
From this we construct the imp_occ_env
710
   C  -> (C,  C(C,T),        Nothing)
711 712 713
   T  -> (T,  T(T,T1,T2,T3), Just C)
   T1 -> (T1, T(T1,T2,T3),   Nothing)   -- similarly T2,T3

714 715 716 717
If we say
   import M( T(T1,T2) )
then we get *two* Avails:  C(T), T(T1,T2)

718 719
Note that the imp_occ_env will have entries for data constructors too,
although we never look up data constructors.
Austin Seipp's avatar
Austin Seipp committed
720
-}
721

722
filterImports
723
    :: ModIface
724 725 726 727
    -> ImpDeclSpec                     -- The span for the entire import decl
    -> Maybe (Bool, Located [LIE RdrName])    -- Import spec; True => hiding
    -> RnM (Maybe (Bool, Located [LIE Name]), -- Import spec w/ Names
            [GlobalRdrElt])                   -- Same again, but in GRE form
728
filterImports iface decl_spec Nothing
729
  = return (Nothing, gresFromAvails (Just imp_spec) (mi_exports iface))
730
  where
731
    imp_spec = ImpSpec { is_decl = decl_spec, is_item = ImpAll }
732

733

734
filterImports iface decl_spec (Just (want_hiding, L l import_items))
735
  = do  -- check for errors, convert RdrNames to Names
736
        items1 <- mapM lookup_lie import_items
737 738 739

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

            names  = availsToNameSet (map snd items2)
744 745
            keep n = not (n `elemNameSet` names)
            pruned_avails = filterAvails keep all_avails
746
            hiding_spec = ImpSpec { is_decl = decl_spec, is_item = ImpAll }
747

748
            gres | want_hiding = gresFromAvails (Just hiding_spec) pruned_avails
749
                 | otherwise   = concatMap (gresFromIE decl_spec) items2
750

751
        return (Just (want_hiding, L l (map fst items2)), gres)
752
  where
753
    all_avails = mi_exports iface
754

755 756 757 758 759 760
        -- See Note [Dealing with imports]
    imp_occ_env :: OccEnv (Name,        -- the name
                           AvailInfo,   -- the export item providing the name
                           Maybe Name)  -- the parent of associated types
    imp_occ_env = mkOccEnv_C combine [ (nameOccName n, (n, a, Nothing))
                                     | a <- all_avails, n <- availNames a]
761
      where
762 763 764 765
        -- See example in Note [Dealing with imports]
        -- 'combine' is only called for associated types which appear twice
        -- in the all_avails. In the example, we combine
        --    T(T,T1,T2,T3) and C(C,T)  to give   (T, T(T,T1,T2,T3), Just C)
Adam Gundry's avatar
Adam Gundry committed
766 767
        combine (name1, a1@(AvailTC p1 _ []), mp1)
                (name2, a2@(AvailTC p2 _ []), mp2)
768 769 770
          = ASSERT( name1 == name2 && isNothing mp1 && isNothing mp2 )
            if p1 == name1 then (name1, a1, Just p2)
                           else (name1, a2, Just p1)
Ian Lynagh's avatar
Ian Lynagh committed
771
        combine x y = pprPanic "filterImports/combine" (ppr x $$ ppr y)
772

773 774 775 776 777
    lookup_name :: RdrName -> IELookupM (Name, AvailInfo, Maybe Name)
    lookup_name rdr | isQual rdr              = failLookupWith (QualImportError rdr)
                    | Just succ <- mb_success = return succ
                    | otherwise               = failLookupWith BadImport
      where
778
        mb_success = lookupOccEnv imp_occ_env (rdrNameOcc rdr)
779

780 781 782 783 784
    lookup_lie :: LIE RdrName -> TcRn [(LIE Name, AvailInfo)]
    lookup_lie (L loc ieRdr)
        = do (stuff, warns) <- setSrcSpan loc $
                               liftM (fromMaybe ([],[])) $
                               run_lookup (lookup_ie ieRdr)
785
             mapM_ emit_warning warns
786 787
             return [ (L loc ie, avail) | (ie,avail) <- stuff ]
        where
788
            -- Warn when importing T(..) if T was exported abstractly
ian@well-typed.com's avatar
ian@well-typed.com committed
789
            emit_warning (DodgyImport n) = whenWOptM Opt_WarnDodgyImports $
790
              addWarn (dodgyImportWarn n)
ian@well-typed.com's avatar
ian@well-typed.com committed
791
            emit_warning MissingImportList = whenWOptM Opt_WarnMissingImportList $
792
              addWarn (missingImportListItem ieRdr)
ian@well-typed.com's avatar
ian@well-typed.com committed
793
            emit_warning BadImportW = whenWOptM Opt_WarnDodgyImports $
794 795 796 797 798 799 800 801
              addWarn (lookup_err_msg BadImport)

            run_lookup :: IELookupM a -> TcRn (Maybe a)
            run_lookup m = case m of
              Failed err -> addErr (lookup_err_msg err) >> return Nothing
              Succeeded a -> return (Just a)

            lookup_err_msg err = case err of
802
              BadImport -> badImportItemErr iface decl_spec ieRdr all_avails
803 804
              IllegalImport -> illegalImportItemErr
              QualImportError rdr -> qualImportItemErr rdr
805 806 807 808 809 810 811 812

        -- 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
813 814
        -- data constructors of an associated family, we need separate
        -- AvailInfos for the data constructors and the family (as they have
815
        -- different parents).  See Note [Dealing with imports]
816 817
    lookup_ie :: IE RdrName -> IELookupM ([(IE Name, AvailInfo)], [IELookupWarning])
    lookup_ie ie = handle_bad_import $ do
818
      case ie of
819
        IEVar (L l n) -> do
820
            (name, avail, _) <- lookup_name n
821
            return ([(IEVar (L l name), trimAvail avail name)], [])
822

823
        IEThingAll (L l tc) -> do
824 825 826 827 828
            (name, avail, mb_parent) <- lookup_name tc
            let warns = case avail of
                          Avail {}                     -- e.g. f(..)
                            -> [DodgyImport tc]

Adam Gundry's avatar
Adam Gundry committed
829 830
                          AvailTC _ subs fs
                            | null (drop 1 subs) && null fs -- e.g. T(..) where T is a synonym
831 832 833 834 835 836 837 838 839 840
                            -> [DodgyImport tc]

                            | not (is_qual decl_spec)  -- e.g. import M( T(..) )
                            -> [MissingImportList]

                            | otherwise
                            -> []

                renamed_ie = IEThingAll (L l name)
                sub_avails = case avail of
Adam Gundry's avatar
Adam Gundry committed
841 842
                               Avail {}              -> []
                               AvailTC name2 subs fs -> [(renamed_ie, AvailTC name2 (subs \\ [name]) fs)]
843
            case mb_parent of
844 845
              Nothing     -> return ([(renamed_ie, avail)], warns)
                             -- non-associated ty/cls
Adam Gundry's avatar
Adam Gundry committed
846
              Just parent -> return ((renamed_ie, AvailTC parent [name] []) : sub_avails, warns)
847
                             -- associated type
848

Alan Zimmerman's avatar
Alan Zimmerman committed
849
        IEThingAbs (L l tc)
850 851 852 853 854 855 856 857
            | want_hiding   -- hiding ( C )
                       -- Here the 'C' can be a data constructor
                       --  *or* a type/class, or even both
            -> let tc_name = lookup_name tc
                   dc_name = lookup_name (setRdrNameSpace tc srcDataName)
               in
               case catIELookupM [ tc_name, dc_name ] of
                 []    -> failLookupWith BadImport
Alan Zimmerman's avatar
Alan Zimmerman committed
858
                 names -> return ([mkIEThingAbs l name | name <- names], [])
859 860
            | otherwise
            -> do nameAvail <- lookup_name tc
Alan Zimmerman's avatar
Alan Zimmerman committed
861
                  return ([mkIEThingAbs l nameAvail], [])
862

Adam Gundry's avatar
Adam Gundry committed
863 864
        IEThingWith (L l rdr_tc) rdr_ns rdr_fs -> ASSERT2(null rdr_fs, ppr rdr_fs) do
           (name, AvailTC _ ns subflds, mb_parent) <- lookup_name rdr_tc
865 866

           -- Look up the children in the sub-names of the parent
Austin Seipp's avatar
Austin Seipp committed
867
           let subnames = case ns of   -- The tc is first in ns,
868 869 870 871
                            [] -> []   -- if it is there at all
                                       -- See the AvailTC Invariant in Avail.hs
                            (n1:ns1) | n1 == name -> ns1
                                     | otherwise  -> ns
Adam Gundry's avatar
Adam Gundry committed
872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887
           case lookupChildren (map Left subnames ++ map Right subflds) rdr_ns of
             Nothing                      -> failLookupWith BadImport
             Just (childnames, childflds) ->
               case mb_parent of
                 -- non-associated ty/cls
                 Nothing
                   -> return ([(IEThingWith (L l name) childnames childflds,
                               AvailTC name (name:map unLoc childnames) (map unLoc childflds))],
                              [])
                 -- associated ty
                 Just parent
                   -> return ([(IEThingWith (L l name) childnames childflds,
                                AvailTC name (map unLoc childnames) (map unLoc childflds)),
                               (IEThingWith (L l name) childnames childflds,
                                AvailTC parent [name] [])],
                              [])
888

889 890 891
        _other -> failLookupWith IllegalImport
        -- could be IEModuleContents, IEGroup, IEDoc, IEDocNamed
        -- all errors.
892 893

      where
Alan Zimmerman's avatar
Alan Zimmerman committed
894 895 896
        mkIEThingAbs l (n, av, Nothing    ) = (IEThingAbs (L l n),
                                               trimAvail av n)
        mkIEThingAbs l (n, _,  Just parent) = (IEThingAbs (L l n),
Adam Gundry's avatar
Adam Gundry committed
897
                                               AvailTC parent [n] [])
898

899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922
        handle_bad_import m = catchIELookup m $ \err -> case err of
          BadImport | want_hiding -> return ([], [BadImportW])
          _                       -> failLookupWith err

type IELookupM = MaybeErr IELookupError

data IELookupWarning
  = BadImportW
  | MissingImportList
  | DodgyImport RdrName
  -- NB. use the RdrName for reporting a "dodgy" import

data IELookupError
  = QualImportError RdrName
  | BadImport
  | IllegalImport

failLookupWith :: IELookupError -> IELookupM a
failLookupWith err = Failed err

catchIELookup :: IELookupM a -> (IELookupError -> IELookupM a) -> IELookupM a
catchIELookup m h = case m of
  Succeeded r -> return r
  Failed err  -> h err
923

924 925
catIELookupM :: [IELookupM a] -> [a]
catIELookupM ms = [ a | Succeeded a <- ms ]
926

Austin Seipp's avatar
Austin Seipp committed
927 928 929
{-
************************************************************************
*                                                                      *
930
\subsection{Import/Export Utils}
Austin Seipp's avatar
Austin Seipp committed
931 932 933
*                                                                      *
************************************************************************
-}
934

935 936
plusAvail :: AvailInfo -> AvailInfo -> AvailInfo
plusAvail a1 a2
Erik de Castro Lopo's avatar
Erik de Castro Lopo committed
937
  | debugIsOn && availName a1 /= availName a2
938
  = pprPanic "RnEnv.plusAvail names differ" (hsep [ppr a1,ppr a2])
Adam Gundry's avatar
Adam Gundry committed
939 940 941 942
plusAvail a1@(Avail {})         (Avail {})        = a1
plusAvail (AvailTC _ [] [])     a2@(AvailTC {})   = a2
plusAvail a1@(AvailTC {})       (AvailTC _ [] []) = a1
plusAvail (AvailTC n1 (s1:ss1) fs1) (AvailTC n2 (s2:ss2) fs2)
943 944
  = case (n1==s1, n2==s2) of  -- Maintain invariant the parent is first
       (True,True)   -> AvailTC n1 (s1 : (ss1 `unionLists` ss2))
Adam Gundry's avatar
Adam Gundry committed
945
                                   (fs1 `unionLists` fs2)
946
       (True,False)  -> AvailTC n1 (s1 : (ss1 `unionLists` (s2:ss2)))
Adam Gundry's avatar
Adam Gundry committed
947
                                   (fs1 `unionLists` fs2)
948
       (False,True)  -> AvailTC n1 (s2 : ((s1:ss1) `unionLists` ss2))
Adam Gundry's avatar
Adam Gundry committed
949
                                   (fs1 `unionLists` fs2)
950
       (False,False) -> AvailTC n1 ((s1:ss1) `unionLists` (s2:ss2))
Adam Gundry's avatar
Adam Gundry committed
951 952 953 954 955
                                   (fs1 `unionLists` fs2)
plusAvail (AvailTC n1 ss1 fs1) (AvailTC _ [] fs2)
  = AvailTC n1 ss1 (fs1 `unionLists` fs2)
plusAvail (AvailTC n1 [] fs1)  (AvailTC _ ss2 fs2)
  = AvailTC n1 ss2 (fs1 `unionLists` fs2)
956 957
plusAvail a1 a2 = pprPanic "RnEnv.plusAvail" (hsep [ppr a1,ppr a2])

Adam Gundry's avatar
Adam Gundry committed
958
-- | trims an 'AvailInfo' to keep only a single name
959
trimAvail :: AvailInfo -> Name -> AvailInfo
Adam Gundry's avatar
Adam Gundry committed
960 961 962
trimAvail (Avail n)         _ = Avail n
trimAvail (AvailTC n ns fs) m = case find ((== m) . flSelector) fs of
    Just x  -> AvailTC n [] [x]
Matthew Pickering's avatar
Matthew Pickering committed
963
    Nothing -> ASSERT( m `elem` ns ) AvailTC n [m] []
964 965 966 967 968 969 970 971 972 973 974

-- | 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
Adam Gundry's avatar
Adam Gundry committed
975 976 977 978
    AvailTC tc ns fs ->
        let ns' = filter keep ns
            fs' = filter (keep . flSelector) fs in
        if null ns' && null fs' then rest else AvailTC tc ns' fs' : rest
979

Ian Lynagh's avatar
Ian Lynagh committed
980
-- | Given an import\/export spec, construct the appropriate 'GlobalRdrElt's.
981 982 983
gresFromIE :: ImpDeclSpec -> (LIE Name, AvailInfo) -> [GlobalRdrElt]
gresFromIE decl_spec (L loc ie, avail)
  = gresFromAvail prov_fn avail