RnNames.hs 82.4 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,
Gergő Érdi's avatar
Gergő Érdi 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
import Data.Either      ( partitionEithers, isRight, rights )
49
-- 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 )
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
268
269
270
    -- for certain error messages, we’d like to know what could be imported
    -- here, if everything were imported
    potential_gres <- mkGlobalRdrEnv . snd <$> filterImports iface imp_spec Nothing

271
    let gbl_env = mkGlobalRdrEnv gres
272

273
274
        is_hiding | Just (True,_) <- imp_details = True
                  | otherwise                    = False
275

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

281
282
283
284
285
286
287
    let imv = ImportedModsVal
            { imv_name        = qual_mod_name
            , imv_span        = loc
            , imv_is_safe     = mod_safe'
            , imv_is_hiding   = is_hiding
            , imv_all_exports = potential_gres
            }
288
    let imports
289
290
          = (calculateAvails dflags iface mod_safe' want_boot)
                { imp_mods = unitModuleEnv (mi_module iface) [imv] }
291

292
    -- Complain if we import a deprecated module
ian@well-typed.com's avatar
ian@well-typed.com committed
293
    whenWOptM Opt_WarnWarningsDeprecations (
294
       case (mi_warns iface) of
dterei's avatar
dterei committed
295
          WarnAll txt -> addWarn $ moduleWarn imp_mod_name txt
296
          _           -> return ()
297
298
     )

299
300
    let new_imp_decl = L loc (decl { ideclSafe = mod_safe'
                                   , ideclHiding = new_imp_details })
301

302
    return (new_imp_decl, gbl_env, imports, mi_hpc iface)
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
340
341
342
343
344
345
346
347
-- | 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

348
      pkg = moduleUnitId (mi_module iface)
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
389
390
391
392
393
394
395
396

      -- 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
397
warnRedundantSourceImport :: ModuleName -> SDoc
398
warnRedundantSourceImport mod_name
Ian Lynagh's avatar
Ian Lynagh committed
399
  = ptext (sLit "Unnecessary {-# SOURCE #-} in the import of module")
400
          <+> quotes (ppr mod_name)
401

Austin Seipp's avatar
Austin Seipp committed
402
403
404
{-
************************************************************************
*                                                                      *
405
\subsection{importsFromLocalDecls}
Austin Seipp's avatar
Austin Seipp committed
406
407
*                                                                      *
************************************************************************
408
409

From the top-level declarations of this module produce
410
411
412
413
        * the lexical environment
        * the ImportAvails
created by its bindings.

414
415
Note [Top-level Names in Template Haskell decl quotes]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
416
See also: Note [Interactively-bound Ids in GHCi] in HscTypes
417
          Note [Looking up Exact RdrNames] in RnEnv
418

419
420
Consider a Template Haskell declaration quotation like this:
      module M where
421
        f x = h [d| f = 3 |]
422
423
When renaming the declarations inside [d| ...|], we treat the
top level binders specially in two ways
424

425
426
1.  We give them an Internal Name, not (as usual) an External one.
    This is done by RnEnv.newTopSrcBinder.
427

428
429
2.  We make them *shadow* the outer bindings.
    See Note [GlobalRdrEnv shadowing]
430
431
432
433
434

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
435
-}
436

437
extendGlobalRdrEnvRn :: [AvailInfo]
438
439
440
441
442
443
                     -> 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]
444

445
extendGlobalRdrEnvRn avails new_fixities
446
  = do  { (gbl_env, lcl_env) <- getEnvs
447
        ; stage <- getStage
448
        ; isGHCi <- getIsGHCi
449
450
451
452
        ; 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
453
454
455
456

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

460
              lcl_env_TH = lcl_env { tcl_rdr = delLocalRdrEnvList (tcl_rdr lcl_env) new_occs }
461
                           -- See Note [GlobalRdrEnv shadowing]
462

463
464
465
              lcl_env2 | inBracket = lcl_env_TH
                       | otherwise = lcl_env

466
467
468
469
              -- Deal with shadowing: see Note [GlobalRdrEnv shadowing]
              want_shadowing = isGHCi || inBracket
              rdr_env1 | want_shadowing = shadowNames rdr_env new_names
                       | otherwise      = rdr_env
470

471
472
473
              lcl_env3 = lcl_env2 { tcl_th_bndrs = extendNameEnvList th_bndrs
                                                       [ (n, (TopLevel, th_lvl))
                                                       | n <- new_names ] }
474

475
        ; rdr_env2 <- foldlM add_gre rdr_env1 new_gres
476

477
478
        ; 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' }
479

480
        ; traceRn (text "extendGlobalRdrEnvRn 2" <+> (pprGlobalRdrEnv True rdr_env2))
481
        ; return (gbl_env', lcl_env3) }
482
  where
483
    new_names = concatMap availNames avails
484
    new_occs  = map nameOccName new_names
485

486
    -- If there is a fixity decl for the gre, add it to the fixity env
487
    extend_fix_env fix_env name
488
489
490
491
492
      | Just (L _ fi) <- lookupFsEnv new_fixities (occNameFS occ)
      = extendNameEnv fix_env name (FixItem occ fi)
      | otherwise
      = fix_env
      where
493
        occ  = nameOccName name
494

495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
    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.
519

520
        *** See "THE NAMING STORY" in HsDecls ****
521
522
*                                                                      *
********************************************************************* -}
523

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

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

          -- Process all family instances
dterei's avatar
dterei committed
551
          -- to bring new data constructors into scope
Adam Gundry's avatar
Adam Gundry committed
552
553
        ; (nti_availss, nti_fldss) <- mapAndUnzipM (new_assoc overload_ok)
                                                   inst_decls
554
555

          -- Finish off with value binders:
556
          --    foreign decls and pattern synonyms for an ordinary module
dterei's avatar
dterei committed
557
          --    type sigs in case of a hs-boot file only
558
        ; is_boot <- tcIsHsBootOrSig
559
        ; let val_bndrs | is_boot   = hs_boot_sig_bndrs
560
                        | otherwise = for_hs_bndrs
561
        ; val_avails <- mapM new_simple val_bndrs
562

Adam Gundry's avatar
Adam Gundry committed
563
        ; let avails    = concat nti_availss ++ val_avails
564
              new_bndrs = availsToNameSet avails `unionNameSet`
565
                          availsToNameSet tc_avails
Adam Gundry's avatar
Adam Gundry committed
566
              flds      = concat nti_fldss ++ concat tc_fldss
567
        ; traceRn (text "getLocalNonValBinders 2" <+> ppr avails)
Adam Gundry's avatar
Adam Gundry committed
568
569
570
571
572
573
574
        ; (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)

575
576
        ; return (envs, new_bndrs) } }
  where
577
    ValBindsIn _val_binds val_sigs = binds
578

579
    for_hs_bndrs :: [Located RdrName]
580
581
    for_hs_bndrs = hsForeignDeclsBinders foreign_decls

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

eir@cis.upenn.edu's avatar
eir@cis.upenn.edu committed
587
588
      -- the SrcSpan attached to the input should be the span of the
      -- declaration, not just the name
589
    new_simple :: Located RdrName -> RnM AvailInfo
590
    new_simple rdr_name = do{ nm <- newTopSrcBinder rdr_name
591
                            ; return (avail nm) }
592

Adam Gundry's avatar
Adam Gundry committed
593
594
595
596
597
    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
598
             ; flds' <- mapM (newRecordSelector overload_ok sub_names) flds
Adam Gundry's avatar
Adam Gundry committed
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
             ; 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
631
632
      -- type instances don't bind new names

Adam Gundry's avatar
Adam Gundry committed
633
634
635
636
637
    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 })))
638
639
      | Just (_, _, L loc cls_rdr, _) <-
                   splitLHsInstDeclTy_maybe (flattenTopLevelLHsForAllTy inst_ty)
640
      = do { cls_nm <- setSrcSpan loc $ lookupGlobalOccRn cls_rdr
Adam Gundry's avatar
Adam Gundry committed
641
642
643
           ; (avails, fldss)
                    <- mapAndUnzipM (new_loc_di overload_ok (Just cls_nm)) adts
           ; return (avails, concat fldss) }
644
      | otherwise
Adam Gundry's avatar
Adam Gundry committed
645
646
      = return ([], [])    -- Do not crash on ill-formed instances
                           -- Eg   instance !Show Int   Trac #3811c
647

Adam Gundry's avatar
Adam Gundry committed
648
649
650
    new_di :: Bool -> Maybe Name -> DataFamInstDecl RdrName
                   -> RnM (AvailInfo, [(Name, [FieldLabel])])
    new_di overload_ok mb_cls ti_decl
651
        = do { main_name <- lookupFamInstName mb_cls (dfid_tycon ti_decl)
Adam Gundry's avatar
Adam Gundry committed
652
653
             ; let (bndrs, flds) = hsDataFamInstBinders ti_decl
             ; sub_names <- mapM newTopSrcBinder bndrs
Matthew Pickering's avatar
Matthew Pickering committed
654
             ; flds' <- mapM (newRecordSelector overload_ok sub_names) flds
Adam Gundry's avatar
Adam Gundry committed
655
656
657
658
659
660
661
662
             ; 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
663

Matthew Pickering's avatar
Matthew Pickering committed
664
665
666
667
668
669
670
671
672
673
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
674
{-
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
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
693
694
************************************************************************
*                                                                      *
695
\subsection{Filtering imports}
Austin Seipp's avatar
Austin Seipp committed
696
697
*                                                                      *
************************************************************************
698
699
700
701

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

702
703
Note [Dealing with imports]
~~~~~~~~~~~~~~~~~~~~~~~~~~~
Austin Seipp's avatar
Austin Seipp committed
704
705
For import M( ies ), we take the mi_exports of M, and make
   imp_occ_env :: OccEnv (Name, AvailInfo, Maybe Name)
706
One entry for each Name that M exports; the AvailInfo describes just
Austin Seipp's avatar
Austin Seipp committed
707
that Name.
708
709
710
711
712
713
714
715
716
717

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
718
   C  -> (C,  C(C,T),        Nothing)
719
720
721
   T  -> (T,  T(T,T1,T2,T3), Just C)
   T1 -> (T1, T(T1,T2,T3),   Nothing)   -- similarly T2,T3

722
723
724
725
If we say
   import M( T(T1,T2) )
then we get *two* Avails:  C(T), T(T1,T2)

726
727
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
728
-}
729

730
filterImports
731
    :: ModIface
732
733
734
735
    -> 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
736
filterImports iface decl_spec Nothing
737
  = return (Nothing, gresFromAvails (Just imp_spec) (mi_exports iface))
738
  where
739
    imp_spec = ImpSpec { is_decl = decl_spec, is_item = ImpAll }
740

741

742
filterImports iface decl_spec (Just (want_hiding, L l import_items))
743
  = do  -- check for errors, convert RdrNames to Names
744
        items1 <- mapM lookup_lie import_items
745
746
747

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

            names  = availsToNameSet (map snd items2)
752
753
            keep n = not (n `elemNameSet` names)
            pruned_avails = filterAvails keep all_avails
754
            hiding_spec = ImpSpec { is_decl = decl_spec, is_item = ImpAll }
755

756
            gres | want_hiding = gresFromAvails (Just hiding_spec) pruned_avails
757
                 | otherwise   = concatMap (gresFromIE decl_spec) items2
758

759
        return (Just (want_hiding, L l (map fst items2)), gres)
760
  where
761
    all_avails = mi_exports iface
762

763
764
765
766
767
768
        -- 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]
769
      where
770
771
772
773
        -- 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
774
775
        combine (name1, a1@(AvailTC p1 _ []), mp1)
                (name2, a2@(AvailTC p2 _ []), mp2)
776
777
778
          = 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
779
        combine x y = pprPanic "filterImports/combine" (ppr x $$ ppr y)
780

781
782
783
784
785
    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
786
        mb_success = lookupOccEnv imp_occ_env (rdrNameOcc rdr)
787

788
789
790
791
792
    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)
793
             mapM_ emit_warning warns
794
795
             return [ (L loc ie, avail) | (ie,avail) <- stuff ]
        where
796
            -- Warn when importing T(..) if T was exported abstractly
ian@well-typed.com's avatar
ian@well-typed.com committed
797
            emit_warning (DodgyImport n) = whenWOptM Opt_WarnDodgyImports $
798
              addWarn (dodgyImportWarn n)
ian@well-typed.com's avatar
ian@well-typed.com committed
799
            emit_warning MissingImportList = whenWOptM Opt_WarnMissingImportList $
800
              addWarn (missingImportListItem ieRdr)
ian@well-typed.com's avatar
ian@well-typed.com committed
801
            emit_warning BadImportW = whenWOptM Opt_WarnDodgyImports $
802
803
804
805
806
807
808
809
              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
810
              BadImport -> badImportItemErr iface decl_spec ieRdr all_avails
811
812
              IllegalImport -> illegalImportItemErr
              QualImportError rdr -> qualImportItemErr rdr
813
814
815
816
817
818
819
820

        -- 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
821
822
        -- data constructors of an associated family, we need separate
        -- AvailInfos for the data constructors and the family (as they have
823
        -- different parents).  See Note [Dealing with imports]
824
825
    lookup_ie :: IE RdrName -> IELookupM ([(IE Name, AvailInfo)], [IELookupWarning])
    lookup_ie ie = handle_bad_import $ do
826
      case ie of
827
        IEVar (L l n) -> do
828
            (name, avail, _) <- lookup_name n
829
            return ([(IEVar (L l name), trimAvail avail name)], [])
830

831
        IEThingAll (L l tc) -> do
832
833
834
835
836
            (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
837
838
                          AvailTC _ subs fs
                            | null (drop 1 subs) && null fs -- e.g. T(..) where T is a synonym
839
840
841
842
843
844
845
846
847
848
                            -> [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
849
850
                               Avail {}              -> []
                               AvailTC name2 subs fs -> [(renamed_ie, AvailTC name2 (subs \\ [name]) fs)]
851
            case mb_parent of
852
853
              Nothing     -> return ([(renamed_ie, avail)], warns)
                             -- non-associated ty/cls
Adam Gundry's avatar
Adam Gundry committed
854
              Just parent -> return ((renamed_ie, AvailTC parent [name] []) : sub_avails, warns)
855
                             -- associated type
856

Alan Zimmerman's avatar
Alan Zimmerman committed
857
        IEThingAbs (L l tc)
858
859
860
861
862
863
864
865
            | 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
866
                 names -> return ([mkIEThingAbs l name | name <- names], [])
867
868
            | otherwise
            -> do nameAvail <- lookup_name tc
Alan Zimmerman's avatar
Alan Zimmerman committed
869
                  return ([mkIEThingAbs l nameAvail], [])
870

871
872
        IEThingWith (L l rdr_tc) wc rdr_ns rdr_fs ->
          ASSERT2(null rdr_fs, ppr rdr_fs) do
Adam Gundry's avatar
Adam Gundry committed
873
           (name, AvailTC _ ns subflds, mb_parent) <- lookup_name rdr_tc
874
875

           -- Look up the children in the sub-names of the parent
Austin Seipp's avatar
Austin Seipp committed
876
           let subnames = case ns of   -- The tc is first in ns,
877
878
879
880
                            [] -> []   -- 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
881
882
883
884
885
886
           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
887
                   -> return ([(IEThingWith (L l name) wc childnames childflds,
Adam Gundry's avatar
Adam Gundry committed
888
889
890
891
                               AvailTC name (name:map unLoc childnames) (map unLoc childflds))],
                              [])
                 -- associated ty
                 Just parent
892
                   -> return ([(IEThingWith (L l name) wc childnames childflds,
Adam Gundry's avatar
Adam Gundry committed
893
                                AvailTC name (map unLoc childnames) (map unLoc childflds)),
894
                               (IEThingWith (L l name) wc childnames childflds,
Adam Gundry's avatar
Adam Gundry committed
895
896
                                AvailTC parent [name] [])],
                              [])
897

898
899
900
        _other -> failLookupWith IllegalImport
        -- could be IEModuleContents, IEGroup, IEDoc, IEDocNamed
        -- all errors.
901
902

      where
Alan Zimmerman's avatar
Alan Zimmerman committed
903
904
905
        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
906
                                               AvailTC parent [n] [])
907

908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
        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
932

933
934
catIELookupM :: [IELookupM a] -> [a]
catIELookupM ms = [ a | Succeeded a <- ms ]
935

Austin Seipp's avatar
Austin Seipp committed
936
937
938
{-
************************************************************************
*                                                                      *
939
\subsection{Import/Export Utils}
Austin Seipp's avatar
Austin Seipp committed
940
941
942
*                                                                      *
************************************************************************
-}
943

944
945
plusAvail :: AvailInfo -> AvailInfo -> AvailInfo
plusAvail a1 a2
Erik de Castro Lopo's avatar
Erik de Castro Lopo committed
946
  | debugIsOn && availName a1 /= availName a2
947
  = pprPanic "RnEnv.plusAvail names differ" (hsep [ppr a1,ppr a2])
Adam Gundry's avatar
Adam Gundry committed
948
949
950
951
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)
952
953
  = 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
954
                                   (fs1 `unionLists` fs2)
955
       (True,False)  -> AvailTC n1 (s1 : (ss1 `unionLists` (s2:ss2)))
Adam Gundry's avatar
Adam Gundry committed
956
                                   (fs1 `unionLists` fs2)
957
       (False,True)  -> AvailTC n1 (s2 : ((s1:ss1) `unionLists` ss2))
Adam Gundry's avatar
Adam Gundry committed
958
                                   (fs1 `unionLists` fs2)
959
       (False,False) -> AvailTC n1 ((s1:ss1) `unionLists` (s2:ss2))
Adam Gundry's avatar
Adam Gundry committed
960
961
962
963
964
                                   (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)
965
966
plusAvail a1 a2 = pprPanic "RnEnv.plusAvail" (hsep [ppr a1,ppr a2])

Adam Gundry's avatar
Adam Gundry committed
967
-- | trims an 'AvailInfo' to keep only a single name
968
trimAvail :: AvailInfo -> Name -> AvailInfo
969
trimAvail (Avail b n)         _ = Avail b n
Adam Gundry's avatar
Adam Gundry committed
970
971
trimAvail (AvailTC n ns fs) m = case find ((== m) . flSelector) fs of
    Just x  -> AvailTC n [] [x]
Matthew Pickering's avatar
Matthew Pickering committed
972
    Nothing -> ASSERT( m `elem` ns ) AvailTC n [m] []
973
974
975
976
977
978
979
980
981

-- | 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
982
    Avail _ n | keep n    -> ie : rest
983
            | otherwise -> rest
Adam Gundry's avatar
Adam Gundry committed
984
985
986
987
    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
988

Ian Lynagh's avatar
Ian Lynagh committed
989
-- | Given an import\/export spec, construct the appropriate 'GlobalRdrElt's.
990
991
992
gresFromIE :: ImpDeclSpec -> (LIE Name, AvailInfo) -> [GlobalRdrElt]
gresFromIE decl_spec (L loc ie, avail)
  = gresFromAvail prov_fn avail
993
  where
994
    is_explicit = case ie of
995
996
                    IEThingAll (L _ name) -> \n -> n == name
                    _                     -> \_ -> True
997
998
999
1000
    prov_fn name
      = Just (ImpSpec { is_decl = decl_spec, is_item = item_spec })
      where
        item_spec = ImpSome { is_explicit = is_explicit name, is_iloc = loc }
1001

Adam Gundry's avatar
Adam Gundry committed
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019

{-
Note [Children for duplicate record fields]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider the module

    {-# LANGUAGE DuplicateRecordFields #-}
    module M (F(foo, MkFInt, MkFBool)) where
      data family F a
      data instance F Int = MkFInt { foo :: Int }
      data instance F Bool = MkFBool { foo :: Bool }

The `foo` in the export list refers to *both* selectors! For this
reason, lookupChildren builds an environment that maps the FastString
to a list of items, rather than a single item.
-}

mkChildEnv :: [GlobalRdrElt] -> NameEnv [GlobalRdrElt]
1020
mkChildEnv gres = foldr add emptyNameEnv gres
Adam Gundry's avatar
Adam Gundry committed
1021
1022
1023
1024
1025
  where
    add gre env = case gre_par gre of
        FldParent p _  -> extendNameEnv_Acc (:) singleton env p gre
        ParentIs  p    -> extendNameEnv_Acc (:) singleton env p gre
        NoParent       -> env
1026
1027
1028
1029
1030
1031
1032
1033
        PatternSynonym -> env

findPatSyns :: [GlobalRdrElt] -> [GlobalRdrElt]
findPatSyns gres = foldr add [] gres
  where
    add g@(GRE { gre_par = PatternSynonym }) ps =
      g:ps
    add _ ps = ps
1034

Adam Gundry's avatar
Adam Gundry committed
1035
findChildren :: NameEnv [a] -> Name -> [a]
1036
1037
findChildren env n = lookupNameEnv env n `orElse` []

Adam Gundry's avatar
Adam Gundry committed
1038
1039
lookupChildren :: [Either Name FieldLabel] -> [Located RdrName]
               -> Maybe ([Located Name], [Located FieldLabel])
1040
1041
1042
-- (lookupChildren all_kids rdr_items) maps each rdr_item to its
-- corresponding Name all_kids, if the former exists
-- The matching is done by FastString, not OccName, so that
Erik de Castro Lopo's avatar
Erik de Castro Lopo committed
1043
--    Cls( meth, AssocTy )
1044
1045
1046
1047
-- will correctly find AssocTy among the all_kids of Cls, even though
-- the RdrName for AssocTy may have a (bogus) DataName namespace
-- (Really the rdr_items should be FastStrings in the first place.)
lookupChildren all_kids rdr_items
Adam Gundry's avatar
Adam Gundry committed
1048
1049
  = do xs <- mapM doOne rdr_items
       return (fmap concat (partitionEithers xs))
1050
  where
1051
    doOne (L l r) = case (lookupFsEnv kid_env . occNameFS . rdrNameOcc) r of