Improve printing of pattern synonym types
[ghc.git] / compiler / rename / RnNames.hs
1 {-
2 (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
3
4 \section[RnNames]{Extracting imported and top-level names in scope}
5 -}
6
7 {-# LANGUAGE CPP, NondecreasingIndentation #-}
8
9 module RnNames (
10 rnImports, getLocalNonValBinders, newRecordSelector,
11 rnExports, extendGlobalRdrEnvRn,
12 gresFromAvails,
13 calculateAvails,
14 reportUnusedNames,
15 checkConName
16 ) where
17
18 #include "HsVersions.h"
19
20 import DynFlags
21 import HsSyn
22 import TcEnv
23 import RnEnv
24 import RnHsDoc ( rnHsDoc )
25 import LoadIface ( loadSrcInterface )
26 import TcRnMonad
27 import PrelNames
28 import Module
29 import Name
30 import NameEnv
31 import NameSet
32 import Avail
33 import FieldLabel
34 import HscTypes
35 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
44 import FastStringEnv
45 import ListSetOps
46 import Id
47 import Type
48 import PatSyn
49 import qualified GHC.LanguageExtensions as LangExt
50
51 import Control.Monad
52 import Data.Either ( partitionEithers, isRight, rights )
53 -- import qualified Data.Foldable as Foldable
54 import Data.Map ( Map )
55 import qualified Data.Map as Map
56 import Data.Ord ( comparing )
57 import Data.List ( partition, (\\), find, sortBy )
58 -- import qualified Data.Set as Set
59 import System.FilePath ((</>))
60 import System.IO
61
62 {-
63 ************************************************************************
64 * *
65 \subsection{rnImports}
66 * *
67 ************************************************************************
68
69 Note [Tracking Trust Transitively]
70 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
71 When we import a package as well as checking that the direct imports are safe
72 according to the rules outlined in the Note [HscMain . Safe Haskell Trust Check]
73 we must also check that these rules hold transitively for all dependent modules
74 and packages. Doing this without caching any trust information would be very
75 slow as we would need to touch all packages and interface files a module depends
76 on. To avoid this we make use of the property that if a modules Safe Haskell
77 mode changes, this triggers a recompilation from that module in the dependcy
78 graph. So we can just worry mostly about direct imports.
79
80 There is one trust property that can change for a package though without
81 recompliation being triggered: package trust. So we must check that all
82 packages a module tranitively depends on to be trusted are still trusted when
83 we are compiling this module (as due to recompilation avoidance some modules
84 below may not be considered trusted any more without recompilation being
85 triggered).
86
87 We handle this by augmenting the existing transitive list of packages a module M
88 depends on with a bool for each package that says if it must be trusted when the
89 module M is being checked for trust. This list of trust required packages for a
90 single import is gathered in the rnImportDecl function and stored in an
91 ImportAvails data structure. The union of these trust required packages for all
92 imports is done by the rnImports function using the combine function which calls
93 the plusImportAvails function that is a union operation for the ImportAvails
94 type. This gives us in an ImportAvails structure all packages required to be
95 trusted for the module we are currently compiling. Checking that these packages
96 are still trusted (and that direct imports are trusted) is done in
97 HscMain.checkSafeImports.
98
99 See the note below, [Trust Own Package] for a corner case in this method and
100 how its handled.
101
102
103 Note [Trust Own Package]
104 ~~~~~~~~~~~~~~~~~~~~~~~~
105 There is a corner case of package trust checking that the usual transitive check
106 doesn't cover. (For how the usual check operates see the Note [Tracking Trust
107 Transitively] below). The case is when you import a -XSafe module M and M
108 imports a -XTrustworthy module N. If N resides in a different package than M,
109 then the usual check works as M will record a package dependency on N's package
110 and mark it as required to be trusted. If N resides in the same package as M
111 though, then importing M should require its own package be trusted due to N
112 (since M is -XSafe so doesn't create this requirement by itself). The usual
113 check fails as a module doesn't record a package dependency of its own package.
114 So instead we now have a bool field in a modules interface file that simply
115 states if the module requires its own package to be trusted. This field avoids
116 us having to load all interface files that the module depends on to see if one
117 is trustworthy.
118
119
120 Note [Trust Transitive Property]
121 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
122 So there is an interesting design question in regards to transitive trust
123 checking. Say I have a module B compiled with -XSafe. B is dependent on a bunch
124 of modules and packages, some packages it requires to be trusted as its using
125 -XTrustworthy modules from them. Now if I have a module A that doesn't use safe
126 haskell at all and simply imports B, should A inherit all the the trust
127 requirements from B? Should A now also require that a package p is trusted since
128 B required it?
129
130 We currently say no but saying yes also makes sense. The difference is, if a
131 module M that doesn't use Safe Haskell imports a module N that does, should all
132 the trusted package requirements be dropped since M didn't declare that it cares
133 about Safe Haskell (so -XSafe is more strongly associated with the module doing
134 the importing) or should it be done still since the author of the module N that
135 uses Safe Haskell said they cared (so -XSafe is more strongly associated with
136 the module that was compiled that used it).
137
138 Going with yes is a simpler semantics we think and harder for the user to stuff
139 up but it does mean that Safe Haskell will affect users who don't care about
140 Safe Haskell as they might grab a package from Cabal which uses safe haskell (say
141 network) and that packages imports -XTrustworthy modules from another package
142 (say bytestring), so requires that package is trusted. The user may now get
143 compilation errors in code that doesn't do anything with Safe Haskell simply
144 because they are using the network package. They will have to call 'ghc-pkg
145 trust network' to get everything working. Due to this invasive nature of going
146 with yes we have gone with no for now.
147 -}
148
149 -- | Process Import Decls. See 'rnImportDecl' for a description of what
150 -- the return types represent.
151 -- Note: Do the non SOURCE ones first, so that we get a helpful warning
152 -- for SOURCE ones that are unnecessary
153 rnImports :: [LImportDecl RdrName]
154 -> RnM ([LImportDecl Name], GlobalRdrEnv, ImportAvails, AnyHpcUsage)
155 rnImports imports = do
156 this_mod <- getModule
157 let (source, ordinary) = partition is_source_import imports
158 is_source_import d = ideclSource (unLoc d)
159 stuff1 <- mapAndReportM (rnImportDecl this_mod) ordinary
160 stuff2 <- mapAndReportM (rnImportDecl this_mod) source
161 -- Safe Haskell: See Note [Tracking Trust Transitively]
162 let (decls, rdr_env, imp_avails, hpc_usage) = combine (stuff1 ++ stuff2)
163 return (decls, rdr_env, imp_avails, hpc_usage)
164
165 where
166 combine :: [(LImportDecl Name, GlobalRdrEnv, ImportAvails, AnyHpcUsage)]
167 -> ([LImportDecl Name], GlobalRdrEnv, ImportAvails, AnyHpcUsage)
168 combine = foldr plus ([], emptyGlobalRdrEnv, emptyImportAvails, False)
169
170 plus (decl, gbl_env1, imp_avails1,hpc_usage1)
171 (decls, gbl_env2, imp_avails2,hpc_usage2)
172 = ( decl:decls,
173 gbl_env1 `plusGlobalRdrEnv` gbl_env2,
174 imp_avails1 `plusImportAvails` imp_avails2,
175 hpc_usage1 || hpc_usage2 )
176
177 -- | Given a located import declaration @decl@ from @this_mod@,
178 -- calculate the following pieces of information:
179 --
180 -- 1. An updated 'LImportDecl', where all unresolved 'RdrName' in
181 -- the entity lists have been resolved into 'Name's,
182 --
183 -- 2. A 'GlobalRdrEnv' representing the new identifiers that were
184 -- brought into scope (taking into account module qualification
185 -- and hiding),
186 --
187 -- 3. 'ImportAvails' summarizing the identifiers that were imported
188 -- by this declaration, and
189 --
190 -- 4. A boolean 'AnyHpcUsage' which is true if the imported module
191 -- used HPC.
192 rnImportDecl :: Module -> LImportDecl RdrName
193 -> RnM (LImportDecl Name, GlobalRdrEnv, ImportAvails, AnyHpcUsage)
194 rnImportDecl this_mod
195 (L loc decl@(ImportDecl { ideclName = loc_imp_mod_name, ideclPkgQual = mb_pkg
196 , ideclSource = want_boot, ideclSafe = mod_safe
197 , ideclQualified = qual_only, ideclImplicit = implicit
198 , ideclAs = as_mod, ideclHiding = imp_details }))
199 = setSrcSpan loc $ do
200
201 when (isJust mb_pkg) $ do
202 pkg_imports <- xoptM LangExt.PackageImports
203 when (not pkg_imports) $ addErr packageImportErr
204
205 -- If there's an error in loadInterface, (e.g. interface
206 -- file not found) we get lots of spurious errors from 'filterImports'
207 let imp_mod_name = unLoc loc_imp_mod_name
208 doc = ppr imp_mod_name <+> text "is directly imported"
209
210 -- Check for self-import, which confuses the typechecker (Trac #9032)
211 -- ghc --make rejects self-import cycles already, but batch-mode may not
212 -- at least not until TcIface.tcHiBootIface, which is too late to avoid
213 -- typechecker crashes. (Indirect self imports are not caught until
214 -- TcIface, see #10337 tracking how to make this error better.)
215 --
216 -- Originally, we also allowed 'import {-# SOURCE #-} M', but this
217 -- caused bug #10182: in one-shot mode, we should never load an hs-boot
218 -- file for the module we are compiling into the EPS. In principle,
219 -- it should be possible to support this mode of use, but we would have to
220 -- extend Provenance to support a local definition in a qualified location.
221 -- For now, we don't support it, but see #10336
222 when (imp_mod_name == moduleName this_mod &&
223 (case mb_pkg of -- If we have import "<pkg>" M, then we should
224 -- check that "<pkg>" is "this" (which is magic)
225 -- or the name of this_mod's package. Yurgh!
226 -- c.f. GHC.findModule, and Trac #9997
227 Nothing -> True
228 Just (StringLiteral _ pkg_fs) -> pkg_fs == fsLit "this" ||
229 fsToUnitId pkg_fs == moduleUnitId this_mod))
230 (addErr (text "A module cannot import itself:" <+> ppr imp_mod_name))
231
232 -- Check for a missing import list (Opt_WarnMissingImportList also
233 -- checks for T(..) items but that is done in checkDodgyImport below)
234 case imp_details of
235 Just (False, _) -> return () -- Explicit import list
236 _ | implicit -> return () -- Do not bleat for implicit imports
237 | qual_only -> return ()
238 | otherwise -> whenWOptM Opt_WarnMissingImportList $
239 addWarn (Reason Opt_WarnMissingImportList)
240 (missingImportListWarn imp_mod_name)
241
242 iface <- loadSrcInterface doc imp_mod_name want_boot (fmap sl_fs mb_pkg)
243
244 -- Compiler sanity check: if the import didn't say
245 -- {-# SOURCE #-} we should not get a hi-boot file
246 WARN( not want_boot && mi_boot iface, ppr imp_mod_name ) do
247
248 -- Issue a user warning for a redundant {- SOURCE -} import
249 -- NB that we arrange to read all the ordinary imports before
250 -- any of the {- SOURCE -} imports.
251 --
252 -- in --make and GHCi, the compilation manager checks for this,
253 -- and indeed we shouldn't do it here because the existence of
254 -- the non-boot module depends on the compilation order, which
255 -- is not deterministic. The hs-boot test can show this up.
256 dflags <- getDynFlags
257 warnIf NoReason
258 (want_boot && not (mi_boot iface) && isOneShot (ghcMode dflags))
259 (warnRedundantSourceImport imp_mod_name)
260 when (mod_safe && not (safeImportsOn dflags)) $
261 addErr (text "safe import can't be used as Safe Haskell isn't on!"
262 $+$ ptext (sLit $ "please enable Safe Haskell through either "
263 ++ "Safe, Trustworthy or Unsafe"))
264
265 let
266 qual_mod_name = as_mod `orElse` imp_mod_name
267 imp_spec = ImpDeclSpec { is_mod = imp_mod_name, is_qual = qual_only,
268 is_dloc = loc, is_as = qual_mod_name }
269
270 -- filter the imports according to the import declaration
271 (new_imp_details, gres) <- filterImports iface imp_spec imp_details
272
273 -- for certain error messages, we’d like to know what could be imported
274 -- here, if everything were imported
275 potential_gres <- mkGlobalRdrEnv . snd <$> filterImports iface imp_spec Nothing
276
277 let gbl_env = mkGlobalRdrEnv gres
278
279 is_hiding | Just (True,_) <- imp_details = True
280 | otherwise = False
281
282 -- should the import be safe?
283 mod_safe' = mod_safe
284 || (not implicit && safeDirectImpsReq dflags)
285 || (implicit && safeImplicitImpsReq dflags)
286
287 let imv = ImportedModsVal
288 { imv_name = qual_mod_name
289 , imv_span = loc
290 , imv_is_safe = mod_safe'
291 , imv_is_hiding = is_hiding
292 , imv_all_exports = potential_gres
293 , imv_qualified = qual_only
294 }
295 let imports
296 = (calculateAvails dflags iface mod_safe' want_boot)
297 { imp_mods = unitModuleEnv (mi_module iface) [imv] }
298
299 -- Complain if we import a deprecated module
300 whenWOptM Opt_WarnWarningsDeprecations (
301 case (mi_warns iface) of
302 WarnAll txt -> addWarn (Reason Opt_WarnWarningsDeprecations)
303 (moduleWarn imp_mod_name txt)
304 _ -> return ()
305 )
306
307 let new_imp_decl = L loc (decl { ideclSafe = mod_safe'
308 , ideclHiding = new_imp_details })
309
310 return (new_imp_decl, gbl_env, imports, mi_hpc iface)
311
312 -- | Calculate the 'ImportAvails' induced by an import of a particular
313 -- interface, but without 'imp_mods'.
314 calculateAvails :: DynFlags
315 -> ModIface
316 -> IsSafeImport
317 -> IsBootInterface
318 -> ImportAvails
319 calculateAvails dflags iface mod_safe' want_boot =
320 let imp_mod = mi_module iface
321 orph_iface = mi_orphan iface
322 has_finsts = mi_finsts iface
323 deps = mi_deps iface
324 trust = getSafeMode $ mi_trust iface
325 trust_pkg = mi_trust_pkg iface
326
327 -- If the module exports anything defined in this module, just
328 -- ignore it. Reason: otherwise it looks as if there are two
329 -- local definition sites for the thing, and an error gets
330 -- reported. Easiest thing is just to filter them out up
331 -- front. This situation only arises if a module imports
332 -- itself, or another module that imported it. (Necessarily,
333 -- this invoves a loop.)
334 --
335 -- We do this *after* filterImports, so that if you say
336 -- module A where
337 -- import B( AType )
338 -- type AType = ...
339 --
340 -- module B( AType ) where
341 -- import {-# SOURCE #-} A( AType )
342 --
343 -- then you won't get a 'B does not export AType' message.
344
345
346 -- Compute new transitive dependencies
347
348 orphans | orph_iface = ASSERT( not (imp_mod `elem` dep_orphs deps) )
349 imp_mod : dep_orphs deps
350 | otherwise = dep_orphs deps
351
352 finsts | has_finsts = ASSERT( not (imp_mod `elem` dep_finsts deps) )
353 imp_mod : dep_finsts deps
354 | otherwise = dep_finsts deps
355
356 pkg = moduleUnitId (mi_module iface)
357
358 -- Does this import mean we now require our own pkg
359 -- to be trusted? See Note [Trust Own Package]
360 ptrust = trust == Sf_Trustworthy || trust_pkg
361
362 (dependent_mods, dependent_pkgs, pkg_trust_req)
363 | pkg == thisPackage dflags =
364 -- Imported module is from the home package
365 -- Take its dependent modules and add imp_mod itself
366 -- Take its dependent packages unchanged
367 --
368 -- NB: (dep_mods deps) might include a hi-boot file
369 -- for the module being compiled, CM. Do *not* filter
370 -- this out (as we used to), because when we've
371 -- finished dealing with the direct imports we want to
372 -- know if any of them depended on CM.hi-boot, in
373 -- which case we should do the hi-boot consistency
374 -- check. See LoadIface.loadHiBootInterface
375 ((moduleName imp_mod,want_boot):dep_mods deps,dep_pkgs deps,ptrust)
376
377 | otherwise =
378 -- Imported module is from another package
379 -- Dump the dependent modules
380 -- Add the package imp_mod comes from to the dependent packages
381 ASSERT2( not (pkg `elem` (map fst $ dep_pkgs deps))
382 , ppr pkg <+> ppr (dep_pkgs deps) )
383 ([], (pkg, False) : dep_pkgs deps, False)
384
385 in ImportAvails {
386 imp_mods = emptyModuleEnv, -- this gets filled in later
387 imp_orphs = orphans,
388 imp_finsts = finsts,
389 imp_dep_mods = mkModDeps dependent_mods,
390 imp_dep_pkgs = map fst $ dependent_pkgs,
391 -- Add in the imported modules trusted package
392 -- requirements. ONLY do this though if we import the
393 -- module as a safe import.
394 -- See Note [Tracking Trust Transitively]
395 -- and Note [Trust Transitive Property]
396 imp_trust_pkgs = if mod_safe'
397 then map fst $ filter snd dependent_pkgs
398 else [],
399 -- Do we require our own pkg to be trusted?
400 -- See Note [Trust Own Package]
401 imp_trust_own_pkg = pkg_trust_req
402 }
403
404
405 warnRedundantSourceImport :: ModuleName -> SDoc
406 warnRedundantSourceImport mod_name
407 = text "Unnecessary {-# SOURCE #-} in the import of module"
408 <+> quotes (ppr mod_name)
409
410 {-
411 ************************************************************************
412 * *
413 \subsection{importsFromLocalDecls}
414 * *
415 ************************************************************************
416
417 From the top-level declarations of this module produce
418 * the lexical environment
419 * the ImportAvails
420 created by its bindings.
421
422 Note [Top-level Names in Template Haskell decl quotes]
423 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
424 See also: Note [Interactively-bound Ids in GHCi] in HscTypes
425 Note [Looking up Exact RdrNames] in RnEnv
426
427 Consider a Template Haskell declaration quotation like this:
428 module M where
429 f x = h [d| f = 3 |]
430 When renaming the declarations inside [d| ...|], we treat the
431 top level binders specially in two ways
432
433 1. We give them an Internal Name, not (as usual) an External one.
434 This is done by RnEnv.newTopSrcBinder.
435
436 2. We make them *shadow* the outer bindings.
437 See Note [GlobalRdrEnv shadowing]
438
439 3. We find out whether we are inside a [d| ... |] by testing the TH
440 stage. This is a slight hack, because the stage field was really
441 meant for the type checker, and here we are not interested in the
442 fields of Brack, hence the error thunks in thRnBrack.
443 -}
444
445 extendGlobalRdrEnvRn :: [AvailInfo]
446 -> MiniFixityEnv
447 -> RnM (TcGblEnv, TcLclEnv)
448 -- Updates both the GlobalRdrEnv and the FixityEnv
449 -- We return a new TcLclEnv only because we might have to
450 -- delete some bindings from it;
451 -- see Note [Top-level Names in Template Haskell decl quotes]
452
453 extendGlobalRdrEnvRn avails new_fixities
454 = do { (gbl_env, lcl_env) <- getEnvs
455 ; stage <- getStage
456 ; isGHCi <- getIsGHCi
457 ; let rdr_env = tcg_rdr_env gbl_env
458 fix_env = tcg_fix_env gbl_env
459 th_bndrs = tcl_th_bndrs lcl_env
460 th_lvl = thLevel stage
461
462 -- Delete new_occs from global and local envs
463 -- If we are in a TemplateHaskell decl bracket,
464 -- we are going to shadow them
465 -- See Note [GlobalRdrEnv shadowing]
466 inBracket = isBrackStage stage
467
468 lcl_env_TH = lcl_env { tcl_rdr = delLocalRdrEnvList (tcl_rdr lcl_env) new_occs }
469 -- See Note [GlobalRdrEnv shadowing]
470
471 lcl_env2 | inBracket = lcl_env_TH
472 | otherwise = lcl_env
473
474 -- Deal with shadowing: see Note [GlobalRdrEnv shadowing]
475 want_shadowing = isGHCi || inBracket
476 rdr_env1 | want_shadowing = shadowNames rdr_env new_names
477 | otherwise = rdr_env
478
479 lcl_env3 = lcl_env2 { tcl_th_bndrs = extendNameEnvList th_bndrs
480 [ (n, (TopLevel, th_lvl))
481 | n <- new_names ] }
482
483 ; rdr_env2 <- foldlM add_gre rdr_env1 new_gres
484
485 ; let fix_env' = foldl extend_fix_env fix_env new_gres
486 gbl_env' = gbl_env { tcg_rdr_env = rdr_env2, tcg_fix_env = fix_env' }
487
488 ; traceRn (text "extendGlobalRdrEnvRn 2" <+> (pprGlobalRdrEnv True rdr_env2))
489 ; return (gbl_env', lcl_env3) }
490 where
491 new_names = concatMap availNames avails
492 new_occs = map nameOccName new_names
493
494 -- If there is a fixity decl for the gre, add it to the fixity env
495 extend_fix_env fix_env gre
496 | Just (L _ fi) <- lookupFsEnv new_fixities (occNameFS occ)
497 = extendNameEnv fix_env name (FixItem occ fi)
498 | otherwise
499 = fix_env
500 where
501 name = gre_name gre
502 occ = greOccName gre
503
504 new_gres :: [GlobalRdrElt] -- New LocalDef GREs, derived from avails
505 new_gres = concatMap localGREsFromAvail avails
506
507 add_gre :: GlobalRdrEnv -> GlobalRdrElt -> RnM GlobalRdrEnv
508 -- Extend the GlobalRdrEnv with a LocalDef GRE
509 -- If there is already a LocalDef GRE with the same OccName,
510 -- report an error and discard the new GRE
511 -- This establishes INVARIANT 1 of GlobalRdrEnvs
512 add_gre env gre
513 | not (null dups) -- Same OccName defined twice
514 = do { addDupDeclErr (gre : dups); return env }
515
516 | otherwise
517 = return (extendGlobalRdrEnv env gre)
518 where
519 name = gre_name gre
520 occ = nameOccName name
521 dups = filter isLocalGRE (lookupGlobalRdrEnv env occ)
522
523
524 {- *********************************************************************
525 * *
526 getLocalDeclBindersd@ returns the names for an HsDecl
527 It's used for source code.
528
529 *** See "THE NAMING STORY" in HsDecls ****
530 * *
531 ********************************************************************* -}
532
533 getLocalNonValBinders :: MiniFixityEnv -> HsGroup RdrName
534 -> RnM ((TcGblEnv, TcLclEnv), NameSet)
535 -- Get all the top-level binders bound the group *except*
536 -- for value bindings, which are treated separately
537 -- Specifically we return AvailInfo for
538 -- * type decls (incl constructors and record selectors)
539 -- * class decls (including class ops)
540 -- * associated types
541 -- * foreign imports
542 -- * value signatures (in hs-boot files only)
543
544 getLocalNonValBinders fixity_env
545 (HsGroup { hs_valds = binds,
546 hs_tyclds = tycl_decls,
547 hs_instds = inst_decls,
548 hs_fords = foreign_decls })
549 = do { -- Process all type/class decls *except* family instances
550 ; overload_ok <- xoptM LangExt.DuplicateRecordFields
551 ; (tc_avails, tc_fldss) <- fmap unzip $ mapM (new_tc overload_ok)
552 (tyClGroupConcat tycl_decls)
553 ; traceRn (text "getLocalNonValBinders 1" <+> ppr tc_avails)
554 ; envs <- extendGlobalRdrEnvRn tc_avails fixity_env
555 ; setEnvs envs $ do {
556 -- Bring these things into scope first
557 -- See Note [Looking up family names in family instances]
558
559 -- Process all family instances
560 -- to bring new data constructors into scope
561 ; (nti_availss, nti_fldss) <- mapAndUnzipM (new_assoc overload_ok)
562 inst_decls
563
564 -- Finish off with value binders:
565 -- foreign decls and pattern synonyms for an ordinary module
566 -- type sigs in case of a hs-boot file only
567 ; is_boot <- tcIsHsBootOrSig
568 ; let val_bndrs | is_boot = hs_boot_sig_bndrs
569 | otherwise = for_hs_bndrs
570 ; val_avails <- mapM new_simple val_bndrs
571
572 ; let avails = concat nti_availss ++ val_avails
573 new_bndrs = availsToNameSetWithSelectors avails `unionNameSet`
574 availsToNameSetWithSelectors tc_avails
575 flds = concat nti_fldss ++ concat tc_fldss
576 ; traceRn (text "getLocalNonValBinders 2" <+> ppr avails)
577 ; (tcg_env, tcl_env) <- extendGlobalRdrEnvRn avails fixity_env
578
579 -- Extend tcg_field_env with new fields (this used to be the
580 -- work of extendRecordFieldEnv)
581 ; let field_env = extendNameEnvList (tcg_field_env tcg_env) flds
582 envs = (tcg_env { tcg_field_env = field_env }, tcl_env)
583
584 ; traceRn (text "getLocalNonValBinders 3" <+> vcat [ppr flds, ppr field_env])
585 ; return (envs, new_bndrs) } }
586 where
587 ValBindsIn _val_binds val_sigs = binds
588
589 for_hs_bndrs :: [Located RdrName]
590 for_hs_bndrs = hsForeignDeclsBinders foreign_decls
591
592 -- In a hs-boot file, the value binders come from the
593 -- *signatures*, and there should be no foreign binders
594 hs_boot_sig_bndrs = [ L decl_loc (unLoc n)
595 | L decl_loc (TypeSig ns _) <- val_sigs, n <- ns]
596
597 -- the SrcSpan attached to the input should be the span of the
598 -- declaration, not just the name
599 new_simple :: Located RdrName -> RnM AvailInfo
600 new_simple rdr_name = do{ nm <- newTopSrcBinder rdr_name
601 ; return (avail nm) }
602
603 new_tc :: Bool -> LTyClDecl RdrName
604 -> RnM (AvailInfo, [(Name, [FieldLabel])])
605 new_tc overload_ok tc_decl -- NOT for type/data instances
606 = do { let (bndrs, flds) = hsLTyClDeclBinders tc_decl
607 ; names@(main_name : sub_names) <- mapM newTopSrcBinder bndrs
608 ; flds' <- mapM (newRecordSelector overload_ok sub_names) flds
609 ; let fld_env = case unLoc tc_decl of
610 DataDecl { tcdDataDefn = d } -> mk_fld_env d names flds'
611 _ -> []
612 ; return (AvailTC main_name names flds', fld_env) }
613
614
615 -- Calculate the mapping from constructor names to fields, which
616 -- will go in tcg_field_env. It's convenient to do this here where
617 -- we are working with a single datatype definition.
618 mk_fld_env :: HsDataDefn RdrName -> [Name] -> [FieldLabel] -> [(Name, [FieldLabel])]
619 mk_fld_env d names flds = concatMap find_con_flds (dd_cons d)
620 where
621 find_con_flds (L _ (ConDeclH98 { con_name = L _ rdr
622 , con_details = RecCon cdflds }))
623 = [( find_con_name rdr
624 , concatMap find_con_decl_flds (unLoc cdflds) )]
625 find_con_flds (L _ (ConDeclGADT
626 { con_names = rdrs
627 , con_type = (HsIB { hsib_body = res_ty})}))
628 = map (\ (L _ rdr) -> ( find_con_name rdr
629 , concatMap find_con_decl_flds cdflds))
630 rdrs
631 where
632 (_tvs, _cxt, tau) = splitLHsSigmaTy res_ty
633 cdflds = case tau of
634 L _ (HsFunTy
635 (L _ (HsAppsTy
636 [L _ (HsAppPrefix (L _ (HsRecTy flds)))])) _) -> flds
637 L _ (HsFunTy (L _ (HsRecTy flds)) _) -> flds
638 _ -> []
639 find_con_flds _ = []
640
641 find_con_name rdr
642 = expectJust "getLocalNonValBinders/find_con_name" $
643 find (\ n -> nameOccName n == rdrNameOcc rdr) names
644 find_con_decl_flds (L _ x)
645 = map find_con_decl_fld (cd_fld_names x)
646 find_con_decl_fld (L _ (FieldOcc (L _ rdr) _))
647 = expectJust "getLocalNonValBinders/find_con_decl_fld" $
648 find (\ fl -> flLabel fl == lbl) flds
649 where lbl = occNameFS (rdrNameOcc rdr)
650
651 new_assoc :: Bool -> LInstDecl RdrName
652 -> RnM ([AvailInfo], [(Name, [FieldLabel])])
653 new_assoc _ (L _ (TyFamInstD {})) = return ([], [])
654 -- type instances don't bind new names
655
656 new_assoc overload_ok (L _ (DataFamInstD d))
657 = do { (avail, flds) <- new_di overload_ok Nothing d
658 ; return ([avail], flds) }
659 new_assoc overload_ok (L _ (ClsInstD (ClsInstDecl { cid_poly_ty = inst_ty
660 , cid_datafam_insts = adts })))
661 | Just (L loc cls_rdr) <- getLHsInstDeclClass_maybe inst_ty
662 = do { cls_nm <- setSrcSpan loc $ lookupGlobalOccRn cls_rdr
663 ; (avails, fldss)
664 <- mapAndUnzipM (new_loc_di overload_ok (Just cls_nm)) adts
665 ; return (avails, concat fldss) }
666 | otherwise
667 = return ([], []) -- Do not crash on ill-formed instances
668 -- Eg instance !Show Int Trac #3811c
669
670 new_di :: Bool -> Maybe Name -> DataFamInstDecl RdrName
671 -> RnM (AvailInfo, [(Name, [FieldLabel])])
672 new_di overload_ok mb_cls ti_decl
673 = do { main_name <- lookupFamInstName mb_cls (dfid_tycon ti_decl)
674 ; let (bndrs, flds) = hsDataFamInstBinders ti_decl
675 ; sub_names <- mapM newTopSrcBinder bndrs
676 ; flds' <- mapM (newRecordSelector overload_ok sub_names) flds
677 ; let avail = AvailTC (unLoc main_name) sub_names flds'
678 -- main_name is not bound here!
679 fld_env = mk_fld_env (dfid_defn ti_decl) sub_names flds'
680 ; return (avail, fld_env) }
681
682 new_loc_di :: Bool -> Maybe Name -> LDataFamInstDecl RdrName
683 -> RnM (AvailInfo, [(Name, [FieldLabel])])
684 new_loc_di overload_ok mb_cls (L _ d) = new_di overload_ok mb_cls d
685
686 newRecordSelector :: Bool -> [Name] -> LFieldOcc RdrName -> RnM FieldLabel
687 newRecordSelector _ [] _ = error "newRecordSelector: datatype has no constructors!"
688 newRecordSelector overload_ok (dc:_) (L loc (FieldOcc (L _ fld) _)) =
689 do { sel_name <- newTopSrcBinder $ L loc $ mkRdrUnqual sel_occ
690 ; return $ fl { flSelector = sel_name } }
691 where
692 lbl = occNameFS $ rdrNameOcc fld
693 fl = mkFieldLabelOccs lbl (nameOccName dc) overload_ok
694 sel_occ = flSelector fl
695
696 {-
697 Note [Looking up family names in family instances]
698 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
699 Consider
700
701 module M where
702 type family T a :: *
703 type instance M.T Int = Bool
704
705 We might think that we can simply use 'lookupOccRn' when processing the type
706 instance to look up 'M.T'. Alas, we can't! The type family declaration is in
707 the *same* HsGroup as the type instance declaration. Hence, as we are
708 currently collecting the binders declared in that HsGroup, these binders will
709 not have been added to the global environment yet.
710
711 Solution is simple: process the type family declarations first, extend
712 the environment, and then process the type instances.
713
714
715 ************************************************************************
716 * *
717 \subsection{Filtering imports}
718 * *
719 ************************************************************************
720
721 @filterImports@ takes the @ExportEnv@ telling what the imported module makes
722 available, and filters it through the import spec (if any).
723
724 Note [Dealing with imports]
725 ~~~~~~~~~~~~~~~~~~~~~~~~~~~
726 For import M( ies ), we take the mi_exports of M, and make
727 imp_occ_env :: OccEnv (Name, AvailInfo, Maybe Name)
728 One entry for each Name that M exports; the AvailInfo describes just
729 that Name.
730
731 The situation is made more complicated by associated types. E.g.
732 module M where
733 class C a where { data T a }
734 instance C Int where { data T Int = T1 | T2 }
735 instance C Bool where { data T Int = T3 }
736 Then M's export_avails are (recall the AvailTC invariant from Avails.hs)
737 C(C,T), T(T,T1,T2,T3)
738 Notice that T appears *twice*, once as a child and once as a parent.
739 From this we construct the imp_occ_env
740 C -> (C, C(C,T), Nothing)
741 T -> (T, T(T,T1,T2,T3), Just C)
742 T1 -> (T1, T(T1,T2,T3), Nothing) -- similarly T2,T3
743
744 If we say
745 import M( T(T1,T2) )
746 then we get *two* Avails: C(T), T(T1,T2)
747
748 Note that the imp_occ_env will have entries for data constructors too,
749 although we never look up data constructors.
750 -}
751
752 filterImports
753 :: ModIface
754 -> ImpDeclSpec -- The span for the entire import decl
755 -> Maybe (Bool, Located [LIE RdrName]) -- Import spec; True => hiding
756 -> RnM (Maybe (Bool, Located [LIE Name]), -- Import spec w/ Names
757 [GlobalRdrElt]) -- Same again, but in GRE form
758 filterImports iface decl_spec Nothing
759 = return (Nothing, gresFromAvails (Just imp_spec) (mi_exports iface))
760 where
761 imp_spec = ImpSpec { is_decl = decl_spec, is_item = ImpAll }
762
763
764 filterImports iface decl_spec (Just (want_hiding, L l import_items))
765 = do -- check for errors, convert RdrNames to Names
766 items1 <- mapM lookup_lie import_items
767
768 let items2 :: [(LIE Name, AvailInfo)]
769 items2 = concat items1
770 -- NB the AvailInfo may have duplicates, and several items
771 -- for the same parent; e.g N(x) and N(y)
772
773 names = availsToNameSet (map snd items2)
774 keep n = not (n `elemNameSet` names)
775 pruned_avails = filterAvails keep all_avails
776 hiding_spec = ImpSpec { is_decl = decl_spec, is_item = ImpAll }
777
778 gres | want_hiding = gresFromAvails (Just hiding_spec) pruned_avails
779 | otherwise = concatMap (gresFromIE decl_spec) items2
780
781 return (Just (want_hiding, L l (map fst items2)), gres)
782 where
783 all_avails = mi_exports iface
784
785 -- See Note [Dealing with imports]
786 imp_occ_env :: OccEnv (Name, -- the name
787 AvailInfo, -- the export item providing the name
788 Maybe Name) -- the parent of associated types
789 imp_occ_env = mkOccEnv_C combine [ (nameOccName n, (n, a, Nothing))
790 | a <- all_avails, n <- availNames a]
791 where
792 -- See example in Note [Dealing with imports]
793 -- 'combine' is only called for associated types which appear twice
794 -- in the all_avails. In the example, we combine
795 -- T(T,T1,T2,T3) and C(C,T) to give (T, T(T,T1,T2,T3), Just C)
796 combine (name1, a1@(AvailTC p1 _ []), mp1)
797 (name2, a2@(AvailTC p2 _ []), mp2)
798 = ASSERT( name1 == name2 && isNothing mp1 && isNothing mp2 )
799 if p1 == name1 then (name1, a1, Just p2)
800 else (name1, a2, Just p1)
801 combine x y = pprPanic "filterImports/combine" (ppr x $$ ppr y)
802
803 lookup_name :: RdrName -> IELookupM (Name, AvailInfo, Maybe Name)
804 lookup_name rdr | isQual rdr = failLookupWith (QualImportError rdr)
805 | Just succ <- mb_success = return succ
806 | otherwise = failLookupWith BadImport
807 where
808 mb_success = lookupOccEnv imp_occ_env (rdrNameOcc rdr)
809
810 lookup_lie :: LIE RdrName -> TcRn [(LIE Name, AvailInfo)]
811 lookup_lie (L loc ieRdr)
812 = do (stuff, warns) <- setSrcSpan loc $
813 liftM (fromMaybe ([],[])) $
814 run_lookup (lookup_ie ieRdr)
815 mapM_ emit_warning warns
816 return [ (L loc ie, avail) | (ie,avail) <- stuff ]
817 where
818 -- Warn when importing T(..) if T was exported abstractly
819 emit_warning (DodgyImport n) = whenWOptM Opt_WarnDodgyImports $
820 addWarn (Reason Opt_WarnDodgyImports) (dodgyImportWarn n)
821 emit_warning MissingImportList = whenWOptM Opt_WarnMissingImportList $
822 addWarn (Reason Opt_WarnMissingImportList) (missingImportListItem ieRdr)
823 emit_warning BadImportW = whenWOptM Opt_WarnDodgyImports $
824 addWarn (Reason Opt_WarnDodgyImports) (lookup_err_msg BadImport)
825
826 run_lookup :: IELookupM a -> TcRn (Maybe a)
827 run_lookup m = case m of
828 Failed err -> addErr (lookup_err_msg err) >> return Nothing
829 Succeeded a -> return (Just a)
830
831 lookup_err_msg err = case err of
832 BadImport -> badImportItemErr iface decl_spec ieRdr all_avails
833 IllegalImport -> illegalImportItemErr
834 QualImportError rdr -> qualImportItemErr rdr
835
836 -- For each import item, we convert its RdrNames to Names,
837 -- and at the same time construct an AvailInfo corresponding
838 -- to what is actually imported by this item.
839 -- Returns Nothing on error.
840 -- We return a list here, because in the case of an import
841 -- item like C, if we are hiding, then C refers to *both* a
842 -- type/class and a data constructor. Moreover, when we import
843 -- data constructors of an associated family, we need separate
844 -- AvailInfos for the data constructors and the family (as they have
845 -- different parents). See Note [Dealing with imports]
846 lookup_ie :: IE RdrName -> IELookupM ([(IE Name, AvailInfo)], [IELookupWarning])
847 lookup_ie ie = handle_bad_import $ do
848 case ie of
849 IEVar (L l n) -> do
850 (name, avail, _) <- lookup_name n
851 return ([(IEVar (L l name), trimAvail avail name)], [])
852
853 IEThingAll (L l tc) -> do
854 (name, avail, mb_parent) <- lookup_name tc
855 let warns = case avail of
856 Avail {} -- e.g. f(..)
857 -> [DodgyImport tc]
858
859 AvailTC _ subs fs
860 | null (drop 1 subs) && null fs -- e.g. T(..) where T is a synonym
861 -> [DodgyImport tc]
862
863 | not (is_qual decl_spec) -- e.g. import M( T(..) )
864 -> [MissingImportList]
865
866 | otherwise
867 -> []
868
869 renamed_ie = IEThingAll (L l name)
870 sub_avails = case avail of
871 Avail {} -> []
872 AvailTC name2 subs fs -> [(renamed_ie, AvailTC name2 (subs \\ [name]) fs)]
873 case mb_parent of
874 Nothing -> return ([(renamed_ie, avail)], warns)
875 -- non-associated ty/cls
876 Just parent -> return ((renamed_ie, AvailTC parent [name] []) : sub_avails, warns)
877 -- associated type
878
879 IEThingAbs (L l tc)
880 | want_hiding -- hiding ( C )
881 -- Here the 'C' can be a data constructor
882 -- *or* a type/class, or even both
883 -> let tc_name = lookup_name tc
884 dc_name = lookup_name (setRdrNameSpace tc srcDataName)
885 in
886 case catIELookupM [ tc_name, dc_name ] of
887 [] -> failLookupWith BadImport
888 names -> return ([mkIEThingAbs l name | name <- names], [])
889 | otherwise
890 -> do nameAvail <- lookup_name tc
891 return ([mkIEThingAbs l nameAvail], [])
892
893 IEThingWith (L l rdr_tc) wc rdr_ns rdr_fs ->
894 ASSERT2(null rdr_fs, ppr rdr_fs) do
895 (name, AvailTC _ ns subflds, mb_parent) <- lookup_name rdr_tc
896
897 -- Look up the children in the sub-names of the parent
898 let subnames = case ns of -- The tc is first in ns,
899 [] -> [] -- if it is there at all
900 -- See the AvailTC Invariant in Avail.hs
901 (n1:ns1) | n1 == name -> ns1
902 | otherwise -> ns
903 case lookupChildren (map Left subnames ++ map Right subflds) rdr_ns of
904 Nothing -> failLookupWith BadImport
905 Just (childnames, childflds) ->
906 case mb_parent of
907 -- non-associated ty/cls
908 Nothing
909 -> return ([(IEThingWith (L l name) wc childnames childflds,
910 AvailTC name (name:map unLoc childnames) (map unLoc childflds))],
911 [])
912 -- associated ty
913 Just parent
914 -> return ([(IEThingWith (L l name) wc childnames childflds,
915 AvailTC name (map unLoc childnames) (map unLoc childflds)),
916 (IEThingWith (L l name) wc childnames childflds,
917 AvailTC parent [name] [])],
918 [])
919
920 _other -> failLookupWith IllegalImport
921 -- could be IEModuleContents, IEGroup, IEDoc, IEDocNamed
922 -- all errors.
923
924 where
925 mkIEThingAbs l (n, av, Nothing ) = (IEThingAbs (L l n),
926 trimAvail av n)
927 mkIEThingAbs l (n, _, Just parent) = (IEThingAbs (L l n),
928 AvailTC parent [n] [])
929
930 handle_bad_import m = catchIELookup m $ \err -> case err of
931 BadImport | want_hiding -> return ([], [BadImportW])
932 _ -> failLookupWith err
933
934 type IELookupM = MaybeErr IELookupError
935
936 data IELookupWarning
937 = BadImportW
938 | MissingImportList
939 | DodgyImport RdrName
940 -- NB. use the RdrName for reporting a "dodgy" import
941
942 data IELookupError
943 = QualImportError RdrName
944 | BadImport
945 | IllegalImport
946
947 failLookupWith :: IELookupError -> IELookupM a
948 failLookupWith err = Failed err
949
950 catchIELookup :: IELookupM a -> (IELookupError -> IELookupM a) -> IELookupM a
951 catchIELookup m h = case m of
952 Succeeded r -> return r
953 Failed err -> h err
954
955 catIELookupM :: [IELookupM a] -> [a]
956 catIELookupM ms = [ a | Succeeded a <- ms ]
957
958 {-
959 ************************************************************************
960 * *
961 \subsection{Import/Export Utils}
962 * *
963 ************************************************************************
964 -}
965
966 plusAvail :: AvailInfo -> AvailInfo -> AvailInfo
967 plusAvail a1 a2
968 | debugIsOn && availName a1 /= availName a2
969 = pprPanic "RnEnv.plusAvail names differ" (hsep [ppr a1,ppr a2])
970 plusAvail a1@(Avail {}) (Avail {}) = a1
971 plusAvail (AvailTC _ [] []) a2@(AvailTC {}) = a2
972 plusAvail a1@(AvailTC {}) (AvailTC _ [] []) = a1
973 plusAvail (AvailTC n1 (s1:ss1) fs1) (AvailTC n2 (s2:ss2) fs2)
974 = case (n1==s1, n2==s2) of -- Maintain invariant the parent is first
975 (True,True) -> AvailTC n1 (s1 : (ss1 `unionLists` ss2))
976 (fs1 `unionLists` fs2)
977 (True,False) -> AvailTC n1 (s1 : (ss1 `unionLists` (s2:ss2)))
978 (fs1 `unionLists` fs2)
979 (False,True) -> AvailTC n1 (s2 : ((s1:ss1) `unionLists` ss2))
980 (fs1 `unionLists` fs2)
981 (False,False) -> AvailTC n1 ((s1:ss1) `unionLists` (s2:ss2))
982 (fs1 `unionLists` fs2)
983 plusAvail (AvailTC n1 ss1 fs1) (AvailTC _ [] fs2)
984 = AvailTC n1 ss1 (fs1 `unionLists` fs2)
985 plusAvail (AvailTC n1 [] fs1) (AvailTC _ ss2 fs2)
986 = AvailTC n1 ss2 (fs1 `unionLists` fs2)
987 plusAvail a1 a2 = pprPanic "RnEnv.plusAvail" (hsep [ppr a1,ppr a2])
988
989 -- | trims an 'AvailInfo' to keep only a single name
990 trimAvail :: AvailInfo -> Name -> AvailInfo
991 trimAvail (Avail b n) _ = Avail b n
992 trimAvail (AvailTC n ns fs) m = case find ((== m) . flSelector) fs of
993 Just x -> AvailTC n [] [x]
994 Nothing -> ASSERT( m `elem` ns ) AvailTC n [m] []
995
996 -- | filters 'AvailInfo's by the given predicate
997 filterAvails :: (Name -> Bool) -> [AvailInfo] -> [AvailInfo]
998 filterAvails keep avails = foldr (filterAvail keep) [] avails
999
1000 -- | filters an 'AvailInfo' by the given predicate
1001 filterAvail :: (Name -> Bool) -> AvailInfo -> [AvailInfo] -> [AvailInfo]
1002 filterAvail keep ie rest =
1003 case ie of
1004 Avail _ n | keep n -> ie : rest
1005 | otherwise -> rest
1006 AvailTC tc ns fs ->
1007 let ns' = filter keep ns
1008 fs' = filter (keep . flSelector) fs in
1009 if null ns' && null fs' then rest else AvailTC tc ns' fs' : rest
1010
1011 -- | Given an import\/export spec, construct the appropriate 'GlobalRdrElt's.
1012 gresFromIE :: ImpDeclSpec -> (LIE Name, AvailInfo) -> [GlobalRdrElt]
1013 gresFromIE decl_spec (L loc ie, avail)
1014 = gresFromAvail prov_fn avail
1015 where
1016 is_explicit = case ie of
1017 IEThingAll (L _ name) -> \n -> n == name
1018 _ -> \_ -> True
1019 prov_fn name
1020 = Just (ImpSpec { is_decl = decl_spec, is_item = item_spec })
1021 where
1022 item_spec = ImpSome { is_explicit = is_explicit name, is_iloc = loc }
1023
1024
1025 {-
1026 Note [Children for duplicate record fields]
1027 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1028 Consider the module
1029
1030 {-# LANGUAGE DuplicateRecordFields #-}
1031 module M (F(foo, MkFInt, MkFBool)) where
1032 data family F a
1033 data instance F Int = MkFInt { foo :: Int }
1034 data instance F Bool = MkFBool { foo :: Bool }
1035
1036 The `foo` in the export list refers to *both* selectors! For this
1037 reason, lookupChildren builds an environment that maps the FastString
1038 to a list of items, rather than a single item.
1039 -}
1040
1041 mkChildEnv :: [GlobalRdrElt] -> NameEnv [GlobalRdrElt]
1042 mkChildEnv gres = foldr add emptyNameEnv gres
1043 where
1044 add gre env = case gre_par gre of
1045 FldParent p _ -> extendNameEnv_Acc (:) singleton env p gre
1046 ParentIs p -> extendNameEnv_Acc (:) singleton env p gre
1047 NoParent -> env
1048 PatternSynonym -> env
1049
1050 findPatSyns :: [GlobalRdrElt] -> [GlobalRdrElt]
1051 findPatSyns gres = foldr add [] gres
1052 where
1053 add g@(GRE { gre_par = PatternSynonym }) ps =
1054 g:ps
1055 add _ ps = ps
1056
1057 findChildren :: NameEnv [a] -> Name -> [a]
1058 findChildren env n = lookupNameEnv env n `orElse` []
1059
1060 lookupChildren :: [Either Name FieldLabel] -> [Located RdrName]
1061 -> Maybe ([Located Name], [Located FieldLabel])
1062 -- (lookupChildren all_kids rdr_items) maps each rdr_item to its
1063 -- corresponding Name all_kids, if the former exists
1064 -- The matching is done by FastString, not OccName, so that
1065 -- Cls( meth, AssocTy )
1066 -- will correctly find AssocTy among the all_kids of Cls, even though
1067 -- the RdrName for AssocTy may have a (bogus) DataName namespace
1068 -- (Really the rdr_items should be FastStrings in the first place.)
1069 lookupChildren all_kids rdr_items
1070 = do xs <- mapM doOne rdr_items
1071 return (fmap concat (partitionEithers xs))
1072 where
1073 doOne (L l r) = case (lookupFsEnv kid_env . occNameFS . rdrNameOcc) r of
1074 Just [Left n] -> Just (Left (L l n))
1075 Just rs | all isRight rs -> Just (Right (map (L l) (rights rs)))
1076 _ -> Nothing
1077
1078 -- See Note [Children for duplicate record fields]
1079 kid_env = extendFsEnvList_C (++) emptyFsEnv
1080 [(either (occNameFS . nameOccName) flLabel x, [x]) | x <- all_kids]
1081
1082
1083 classifyGREs :: [GlobalRdrElt] -> ([Name], [FieldLabel])
1084 classifyGREs = partitionEithers . map classifyGRE
1085
1086 classifyGRE :: GlobalRdrElt -> Either Name FieldLabel
1087 classifyGRE gre = case gre_par gre of
1088 FldParent _ Nothing -> Right (FieldLabel (occNameFS (nameOccName n)) False n)
1089 FldParent _ (Just lbl) -> Right (FieldLabel lbl True n)
1090 _ -> Left n
1091 where
1092 n = gre_name gre
1093
1094 -- | Combines 'AvailInfo's from the same family
1095 -- 'avails' may have several items with the same availName
1096 -- E.g import Ix( Ix(..), index )
1097 -- will give Ix(Ix,index,range) and Ix(index)
1098 -- We want to combine these; addAvail does that
1099 nubAvails :: [AvailInfo] -> [AvailInfo]
1100 nubAvails avails = nameEnvElts (foldl add emptyNameEnv avails)
1101 where
1102 add env avail = extendNameEnv_C plusAvail env (availName avail) avail
1103
1104 {-
1105 ************************************************************************
1106 * *
1107 \subsection{Export list processing}
1108 * *
1109 ************************************************************************
1110
1111 Processing the export list.
1112
1113 You might think that we should record things that appear in the export
1114 list as ``occurrences'' (using @addOccurrenceName@), but you'd be
1115 wrong. We do check (here) that they are in scope, but there is no
1116 need to slurp in their actual declaration (which is what
1117 @addOccurrenceName@ forces).
1118
1119 Indeed, doing so would big trouble when compiling @PrelBase@, because
1120 it re-exports @GHC@, which includes @takeMVar#@, whose type includes
1121 @ConcBase.StateAndSynchVar#@, and so on...
1122
1123 Note [Exports of data families]
1124 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1125 Suppose you see (Trac #5306)
1126 module M where
1127 import X( F )
1128 data instance F Int = FInt
1129 What does M export? AvailTC F [FInt]
1130 or AvailTC F [F,FInt]?
1131 The former is strictly right because F isn't defined in this module.
1132 But then you can never do an explicit import of M, thus
1133 import M( F( FInt ) )
1134 because F isn't exported by M. Nor can you import FInt alone from here
1135 import M( FInt )
1136 because we don't have syntax to support that. (It looks like an import of
1137 the type FInt.)
1138
1139 At one point I implemented a compromise:
1140 * When constructing exports with no export list, or with module M(
1141 module M ), we add the parent to the exports as well.
1142 * But not when you see module M( f ), even if f is a
1143 class method with a parent.
1144 * Nor when you see module M( module N ), with N /= M.
1145
1146 But the compromise seemed too much of a hack, so we backed it out.
1147 You just have to use an explicit export list:
1148 module M( F(..) ) where ...
1149 -}
1150
1151 type ExportAccum -- The type of the accumulating parameter of
1152 -- the main worker function in rnExports
1153 = ([LIE Name], -- Export items with Names
1154 ExportOccMap, -- Tracks exported occurrence names
1155 [AvailInfo]) -- The accumulated exported stuff
1156 -- Not nub'd!
1157
1158 emptyExportAccum :: ExportAccum
1159 emptyExportAccum = ([], emptyOccEnv, [])
1160
1161 type ExportOccMap = OccEnv (Name, IE RdrName)
1162 -- Tracks what a particular exported OccName
1163 -- in an export list refers to, and which item
1164 -- it came from. It's illegal to export two distinct things
1165 -- that have the same occurrence name
1166
1167 rnExports :: Bool -- False => no 'module M(..) where' header at all
1168 -> Maybe (Located [LIE RdrName]) -- Nothing => no explicit export list
1169 -> TcGblEnv
1170 -> RnM (Maybe [LIE Name], TcGblEnv)
1171
1172 -- Complains if two distinct exports have same OccName
1173 -- Warns about identical exports.
1174 -- Complains about exports items not in scope
1175
1176 rnExports explicit_mod exports
1177 tcg_env@(TcGblEnv { tcg_mod = this_mod,
1178 tcg_rdr_env = rdr_env,
1179 tcg_imports = imports })
1180 = unsetWOptM Opt_WarnWarningsDeprecations $
1181 -- Do not report deprecations arising from the export
1182 -- list, to avoid bleating about re-exporting a deprecated
1183 -- thing (especially via 'module Foo' export item)
1184 do {
1185 -- If the module header is omitted altogether, then behave
1186 -- as if the user had written "module Main(main) where..."
1187 -- EXCEPT in interactive mode, when we behave as if he had
1188 -- written "module Main where ..."
1189 -- Reason: don't want to complain about 'main' not in scope
1190 -- in interactive mode
1191 ; dflags <- getDynFlags
1192 ; let real_exports
1193 | explicit_mod = exports
1194 | ghcLink dflags == LinkInMemory = Nothing
1195 | otherwise
1196 = Just (noLoc [noLoc (IEVar (noLoc main_RDR_Unqual))])
1197 -- ToDo: the 'noLoc' here is unhelpful if 'main'
1198 -- turns out to be out of scope
1199
1200 ; (rn_exports, avails) <- exports_from_avail real_exports rdr_env imports this_mod
1201 ; traceRn (ppr avails)
1202 ; let final_avails = nubAvails avails -- Combine families
1203 final_ns = availsToNameSetWithSelectors final_avails
1204
1205 ; traceRn (text "rnExports: Exports:" <+> ppr final_avails)
1206
1207 ; let new_tcg_env =
1208 (tcg_env { tcg_exports = final_avails,
1209 tcg_rn_exports = case tcg_rn_exports tcg_env of
1210 Nothing -> Nothing
1211 Just _ -> rn_exports,
1212 tcg_dus = tcg_dus tcg_env `plusDU`
1213 usesOnly final_ns })
1214 ; return (rn_exports, new_tcg_env) }
1215
1216 exports_from_avail :: Maybe (Located [LIE RdrName])
1217 -- Nothing => no explicit export list
1218 -> GlobalRdrEnv
1219 -> ImportAvails
1220 -> Module
1221 -> RnM (Maybe [LIE Name], [AvailInfo])
1222
1223 exports_from_avail Nothing rdr_env _imports _this_mod
1224 -- The same as (module M) where M is the current module name,
1225 -- so that's how we handle it, except we also export the data family
1226 -- when a data instance is exported.
1227 = let avails = [ fix_faminst $ availFromGRE gre
1228 | gre <- globalRdrEnvElts rdr_env
1229 , isLocalGRE gre ]
1230 in return (Nothing, avails)
1231 where
1232 -- #11164: when we define a data instance
1233 -- but not data family, re-export the family
1234 -- Even though we don't check whether this is actually a data family
1235 -- only data families can locally define subordinate things (`ns` here)
1236 -- without locally defining (and instead importing) the parent (`n`)
1237 fix_faminst (AvailTC n ns flds)
1238 | not (n `elem` ns)
1239 = AvailTC n (n:ns) flds
1240
1241 fix_faminst avail = avail
1242
1243
1244 exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod
1245 = do (ie_names, _, exports) <- foldlM do_litem emptyExportAccum rdr_items
1246 return (Just ie_names, exports)
1247 where
1248 do_litem :: ExportAccum -> LIE RdrName -> RnM ExportAccum
1249 do_litem acc lie = setSrcSpan (getLoc lie) (exports_from_item acc lie)
1250
1251 -- Maps a parent to its in-scope children
1252 kids_env :: NameEnv [GlobalRdrElt]
1253 kids_env = mkChildEnv (globalRdrEnvElts rdr_env)
1254
1255 pat_syns :: [GlobalRdrElt]
1256 pat_syns = findPatSyns (globalRdrEnvElts rdr_env)
1257
1258 imported_modules = [ imv_name imv
1259 | xs <- moduleEnvElts $ imp_mods imports, imv <- xs ]
1260
1261 exports_from_item :: ExportAccum -> LIE RdrName -> RnM ExportAccum
1262 exports_from_item acc@(ie_names, occs, exports)
1263 (L loc (IEModuleContents (L lm mod)))
1264 | let earlier_mods = [ mod
1265 | (L _ (IEModuleContents (L _ mod))) <- ie_names ]
1266 , mod `elem` earlier_mods -- Duplicate export of M
1267 = do { warn_dup_exports <- woptM Opt_WarnDuplicateExports ;
1268 warnIf (Reason Opt_WarnDuplicateExports) warn_dup_exports
1269 (dupModuleExport mod) ;
1270 return acc }
1271
1272 | otherwise
1273 = do { warnDodgyExports <- woptM Opt_WarnDodgyExports
1274 ; let { exportValid = (mod `elem` imported_modules)
1275 || (moduleName this_mod == mod)
1276 ; gre_prs = pickGREsModExp mod (globalRdrEnvElts rdr_env)
1277 ; new_exports = map (availFromGRE . fst) gre_prs
1278 ; names = map (gre_name . fst) gre_prs
1279 ; all_gres = foldr (\(gre1,gre2) gres -> gre1 : gre2 : gres) [] gre_prs
1280 }
1281
1282 ; checkErr exportValid (moduleNotImported mod)
1283 ; warnIf (Reason Opt_WarnDodgyExports)
1284 (warnDodgyExports && exportValid && null gre_prs)
1285 (nullModuleExport mod)
1286
1287 ; traceRn (text "efa" <+> (ppr mod $$ ppr all_gres))
1288 ; addUsedGREs all_gres
1289
1290 ; occs' <- check_occs (IEModuleContents (noLoc mod)) occs names
1291 -- This check_occs not only finds conflicts
1292 -- between this item and others, but also
1293 -- internally within this item. That is, if
1294 -- 'M.x' is in scope in several ways, we'll have
1295 -- several members of mod_avails with the same
1296 -- OccName.
1297 ; traceRn (vcat [ text "export mod" <+> ppr mod
1298 , ppr new_exports ])
1299 ; return (L loc (IEModuleContents (L lm mod)) : ie_names,
1300 occs', new_exports ++ exports) }
1301
1302 exports_from_item acc@(lie_names, occs, exports) (L loc ie)
1303 | isDoc ie
1304 = do new_ie <- lookup_doc_ie ie
1305 return (L loc new_ie : lie_names, occs, exports)
1306
1307 | otherwise
1308 = do (new_ie, avail) <- lookup_ie ie
1309 if isUnboundName (ieName new_ie)
1310 then return acc -- Avoid error cascade
1311 else do
1312
1313 occs' <- check_occs ie occs (availNames avail)
1314
1315 return (L loc new_ie : lie_names, occs', avail : exports)
1316
1317 -------------
1318 lookup_ie :: IE RdrName -> RnM (IE Name, AvailInfo)
1319 lookup_ie (IEVar (L l rdr))
1320 = do (name, avail) <- lookupGreAvailRn rdr
1321 return (IEVar (L l name), avail)
1322
1323 lookup_ie (IEThingAbs (L l rdr))
1324 = do (name, avail) <- lookupGreAvailRn rdr
1325 return (IEThingAbs (L l name), avail)
1326
1327 lookup_ie ie@(IEThingAll n)
1328 = do
1329 (n, avail, flds) <- lookup_ie_all ie n
1330 let name = unLoc n
1331 return (IEThingAll n, AvailTC name (name:avail) flds)
1332
1333
1334 lookup_ie ie@(IEThingWith l wc sub_rdrs _)
1335 = do
1336 (lname, subs, avails, flds) <- lookup_ie_with ie l sub_rdrs
1337 (_, all_avail, all_flds) <-
1338 case wc of
1339 NoIEWildcard -> return (lname, [], [])
1340 IEWildcard _ -> lookup_ie_all ie l
1341 let name = unLoc lname
1342 return (IEThingWith lname wc subs [],
1343 AvailTC name (name : avails ++ all_avail)
1344 (flds ++ all_flds))
1345
1346
1347
1348
1349 lookup_ie _ = panic "lookup_ie" -- Other cases covered earlier
1350
1351 lookup_ie_with :: IE RdrName -> Located RdrName -> [Located RdrName]
1352 -> RnM (Located Name, [Located Name], [Name], [FieldLabel])
1353 lookup_ie_with ie (L l rdr) sub_rdrs
1354 = do name <- lookupGlobalOccRnExport rdr
1355 let gres = findChildren kids_env name
1356 mchildren =
1357 lookupChildren (map classifyGRE (gres ++ pat_syns)) sub_rdrs
1358 addUsedKids rdr gres
1359 if isUnboundName name
1360 then return (L l name, [], [name], [])
1361 else
1362 case mchildren of
1363 Nothing -> do
1364 addErr (exportItemErr ie)
1365 return (L l name, [], [name], [])
1366 Just (non_flds, flds) -> do
1367 addUsedKids rdr gres
1368 return (L l name, non_flds
1369 , map unLoc non_flds
1370 , map unLoc flds)
1371 lookup_ie_all :: IE RdrName -> Located RdrName
1372 -> RnM (Located Name, [Name], [FieldLabel])
1373 lookup_ie_all ie (L l rdr) =
1374 do name <- lookupGlobalOccRnExport rdr
1375 let gres = findChildren kids_env name
1376 (non_flds, flds) = classifyGREs gres
1377 addUsedKids rdr gres
1378 warnDodgyExports <- woptM Opt_WarnDodgyExports
1379 when (null gres) $
1380 if isTyConName name
1381 then when warnDodgyExports $
1382 addWarn (Reason Opt_WarnDodgyExports)
1383 (dodgyExportWarn name)
1384 else -- This occurs when you export T(..), but
1385 -- only import T abstractly, or T is a synonym.
1386 addErr (exportItemErr ie)
1387 return (L l name, non_flds, flds)
1388
1389 -------------
1390 lookup_doc_ie :: IE RdrName -> RnM (IE Name)
1391 lookup_doc_ie (IEGroup lev doc) = do rn_doc <- rnHsDoc doc
1392 return (IEGroup lev rn_doc)
1393 lookup_doc_ie (IEDoc doc) = do rn_doc <- rnHsDoc doc
1394 return (IEDoc rn_doc)
1395 lookup_doc_ie (IEDocNamed str) = return (IEDocNamed str)
1396 lookup_doc_ie _ = panic "lookup_doc_ie" -- Other cases covered earlier
1397
1398 -- In an export item M.T(A,B,C), we want to treat the uses of
1399 -- A,B,C as if they were M.A, M.B, M.C
1400 -- Happily pickGREs does just the right thing
1401 addUsedKids :: RdrName -> [GlobalRdrElt] -> RnM ()
1402 addUsedKids parent_rdr kid_gres = addUsedGREs (pickGREs parent_rdr kid_gres)
1403
1404 isDoc :: IE RdrName -> Bool
1405 isDoc (IEDoc _) = True
1406 isDoc (IEDocNamed _) = True
1407 isDoc (IEGroup _ _) = True
1408 isDoc _ = False
1409
1410
1411 -------------------------------
1412 check_occs :: IE RdrName -> ExportOccMap -> [Name] -> RnM ExportOccMap
1413 check_occs ie occs names -- 'names' are the entities specifed by 'ie'
1414 = foldlM check occs names
1415 where
1416 check occs name
1417 = case lookupOccEnv occs name_occ of
1418 Nothing -> return (extendOccEnv occs name_occ (name, ie))
1419
1420 Just (name', ie')
1421 | name == name' -- Duplicate export
1422 -- But we don't want to warn if the same thing is exported
1423 -- by two different module exports. See ticket #4478.
1424 -> do unless (dupExport_ok name ie ie') $ do
1425 warn_dup_exports <- woptM Opt_WarnDuplicateExports
1426 warnIf (Reason Opt_WarnDuplicateExports) warn_dup_exports
1427 (dupExportWarn name_occ ie ie')
1428 return occs
1429
1430 | otherwise -- Same occ name but different names: an error
1431 -> do { global_env <- getGlobalRdrEnv ;
1432 addErr (exportClashErr global_env name' name ie' ie) ;
1433 return occs }
1434 where
1435 name_occ = nameOccName name
1436
1437
1438 dupExport_ok :: Name -> IE RdrName -> IE RdrName -> Bool
1439 -- The Name is exported by both IEs. Is that ok?
1440 -- "No" iff the name is mentioned explicitly in both IEs
1441 -- or one of the IEs mentions the name *alone*
1442 -- "Yes" otherwise
1443 --
1444 -- Examples of "no": module M( f, f )
1445 -- module M( fmap, Functor(..) )
1446 -- module M( module Data.List, head )
1447 --
1448 -- Example of "yes"
1449 -- module M( module A, module B ) where
1450 -- import A( f )
1451 -- import B( f )
1452 --
1453 -- Example of "yes" (Trac #2436)
1454 -- module M( C(..), T(..) ) where
1455 -- class C a where { data T a }
1456 -- instace C Int where { data T Int = TInt }
1457 --
1458 -- Example of "yes" (Trac #2436)
1459 -- module Foo ( T ) where
1460 -- data family T a
1461 -- module Bar ( T(..), module Foo ) where
1462 -- import Foo
1463 -- data instance T Int = TInt
1464
1465 dupExport_ok n ie1 ie2
1466 = not ( single ie1 || single ie2
1467 || (explicit_in ie1 && explicit_in ie2) )
1468 where
1469 explicit_in (IEModuleContents _) = False -- module M
1470 explicit_in (IEThingAll r) = nameOccName n == rdrNameOcc (unLoc r) -- T(..)
1471 explicit_in _ = True
1472
1473 single (IEVar {}) = True
1474 single (IEThingAbs {}) = True
1475 single _ = False
1476
1477 {-
1478 *********************************************************
1479 * *
1480 \subsection{Unused names}
1481 * *
1482 *********************************************************
1483 -}
1484
1485 reportUnusedNames :: Maybe (Located [LIE RdrName]) -- Export list
1486 -> TcGblEnv -> RnM ()
1487 reportUnusedNames _export_decls gbl_env
1488 = do { traceRn ((text "RUN") <+> (ppr (tcg_dus gbl_env)))
1489 ; warnUnusedImportDecls gbl_env
1490 ; warnUnusedTopBinds unused_locals
1491 ; warnMissingSignatures gbl_env }
1492 where
1493 used_names :: NameSet
1494 used_names = findUses (tcg_dus gbl_env) emptyNameSet
1495 -- NB: currently, if f x = g, we only treat 'g' as used if 'f' is used
1496 -- Hence findUses
1497
1498 -- Collect the defined names from the in-scope environment
1499 defined_names :: [GlobalRdrElt]
1500 defined_names = globalRdrEnvElts (tcg_rdr_env gbl_env)
1501
1502 -- Note that defined_and_used, defined_but_not_used
1503 -- are both [GRE]; that's why we need defined_and_used
1504 -- rather than just used_names
1505 _defined_and_used, defined_but_not_used :: [GlobalRdrElt]
1506 (_defined_and_used, defined_but_not_used)
1507 = partition (gre_is_used used_names) defined_names
1508
1509 kids_env = mkChildEnv defined_names
1510 -- This is done in mkExports too; duplicated work
1511
1512 gre_is_used :: NameSet -> GlobalRdrElt -> Bool
1513 gre_is_used used_names (GRE {gre_name = name})
1514 = name `elemNameSet` used_names
1515 || any (\ gre -> gre_name gre `elemNameSet` used_names) (findChildren kids_env name)
1516 -- A use of C implies a use of T,
1517 -- if C was brought into scope by T(..) or T(C)
1518
1519 -- Filter out the ones that are
1520 -- (a) defined in this module, and
1521 -- (b) not defined by a 'deriving' clause
1522 -- The latter have an Internal Name, so we can filter them out easily
1523 unused_locals :: [GlobalRdrElt]
1524 unused_locals = filter is_unused_local defined_but_not_used
1525 is_unused_local :: GlobalRdrElt -> Bool
1526 is_unused_local gre = isLocalGRE gre && isExternalName (gre_name gre)
1527
1528 {-
1529 *********************************************************
1530 * *
1531 \subsection{Unused imports}
1532 * *
1533 *********************************************************
1534
1535 This code finds which import declarations are unused. The
1536 specification and implementation notes are here:
1537 http://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/UnusedImports
1538 -}
1539
1540 type ImportDeclUsage
1541 = ( LImportDecl Name -- The import declaration
1542 , [AvailInfo] -- What *is* used (normalised)
1543 , [Name] ) -- What is imported but *not* used
1544
1545 warnUnusedImportDecls :: TcGblEnv -> RnM ()
1546 warnUnusedImportDecls gbl_env
1547 = do { uses <- readMutVar (tcg_used_gres gbl_env)
1548 ; let user_imports = filterOut (ideclImplicit . unLoc) (tcg_rn_imports gbl_env)
1549 -- This whole function deals only with *user* imports
1550 -- both for warning about unnecessary ones, and for
1551 -- deciding the minimal ones
1552 rdr_env = tcg_rdr_env gbl_env
1553 fld_env = mkFieldEnv rdr_env
1554
1555 ; let usage :: [ImportDeclUsage]
1556 usage = findImportUsage user_imports uses
1557
1558 ; traceRn (vcat [ text "Uses:" <+> ppr uses
1559 , text "Import usage" <+> ppr usage])
1560 ; whenWOptM Opt_WarnUnusedImports $
1561 mapM_ (warnUnusedImport Opt_WarnUnusedImports fld_env) usage
1562
1563 ; whenGOptM Opt_D_dump_minimal_imports $
1564 printMinimalImports usage }
1565
1566 -- | Warn the user about top level binders that lack type signatures.
1567 warnMissingSignatures :: TcGblEnv -> RnM ()
1568 warnMissingSignatures gbl_env
1569 = do { let exports = availsToNameSet (tcg_exports gbl_env)
1570 sig_ns = tcg_sigs gbl_env
1571 -- We use sig_ns to exclude top-level bindings that are generated by GHC
1572 binds = collectHsBindsBinders $ tcg_binds gbl_env
1573 pat_syns = tcg_patsyns gbl_env
1574
1575 -- Warn about missing signatures
1576 -- Do this only when we we have a type to offer
1577 ; warn_missing_sigs <- woptM Opt_WarnMissingSignatures
1578 ; warn_only_exported <- woptM Opt_WarnMissingExportedSignatures
1579 ; warn_pat_syns <- woptM Opt_WarnMissingPatternSynonymSignatures
1580
1581 ; let add_sig_warns
1582 | warn_only_exported = add_warns Opt_WarnMissingExportedSignatures
1583 | warn_missing_sigs = add_warns Opt_WarnMissingSignatures
1584 | warn_pat_syns = add_warns Opt_WarnMissingPatternSynonymSignatures
1585 | otherwise = return ()
1586
1587 add_warns flag
1588 = when warn_pat_syns
1589 (mapM_ add_pat_syn_warn pat_syns) >>
1590 when (warn_missing_sigs || warn_only_exported)
1591 (mapM_ add_bind_warn binds)
1592 where
1593 add_pat_syn_warn p
1594 = add_warn (patSynName p) (pprPatSynType p)
1595
1596 add_bind_warn id
1597 = do { env <- tcInitTidyEnv -- Why not use emptyTidyEnv?
1598 ; let name = idName id
1599 (_, ty) = tidyOpenType env (idType id)
1600 ty_msg = ppr ty
1601 ; add_warn name ty_msg }
1602
1603 add_warn name ty_msg
1604 = when (name `elemNameSet` sig_ns && export_check name)
1605 (addWarnAt (Reason flag) (getSrcSpan name)
1606 (get_msg name ty_msg))
1607
1608 export_check name
1609 = not warn_only_exported || name `elemNameSet` exports
1610
1611 get_msg name ty_msg
1612 = sep [ text "Top-level binding with no type signature:",
1613 nest 2 $ pprPrefixName name <+> dcolon <+> ty_msg ]
1614
1615 ; add_sig_warns }
1616
1617 {-
1618 Note [The ImportMap]
1619 ~~~~~~~~~~~~~~~~~~~~
1620 The ImportMap is a short-lived intermediate data struture records, for
1621 each import declaration, what stuff brought into scope by that
1622 declaration is actually used in the module.
1623
1624 The SrcLoc is the location of the END of a particular 'import'
1625 declaration. Why *END*? Because we don't want to get confused
1626 by the implicit Prelude import. Consider (Trac #7476) the module
1627 import Foo( foo )
1628 main = print foo
1629 There is an implicit 'import Prelude(print)', and it gets a SrcSpan
1630 of line 1:1 (just the point, not a span). If we use the *START* of
1631 the SrcSpan to identify the import decl, we'll confuse the implicit
1632 import Prelude with the explicit 'import Foo'. So we use the END.
1633 It's just a cheap hack; we could equally well use the Span too.
1634
1635 The AvailInfos are the things imported from that decl (just a list,
1636 not normalised).
1637 -}
1638
1639 type ImportMap = Map SrcLoc [AvailInfo] -- See [The ImportMap]
1640
1641 findImportUsage :: [LImportDecl Name]
1642 -> [GlobalRdrElt]
1643 -> [ImportDeclUsage]
1644
1645 findImportUsage imports used_gres
1646 = map unused_decl imports
1647 where
1648 import_usage :: ImportMap
1649 import_usage
1650 = foldr extendImportMap Map.empty used_gres
1651
1652 unused_decl decl@(L loc (ImportDecl { ideclHiding = imps }))
1653 = (decl, nubAvails used_avails, nameSetElems unused_imps)
1654 where
1655 used_avails = Map.lookup (srcSpanEnd loc) import_usage `orElse` []
1656 -- srcSpanEnd: see Note [The ImportMap]
1657 used_names = availsToNameSetWithSelectors used_avails
1658 used_parents = mkNameSet [n | AvailTC n _ _ <- used_avails]
1659
1660 unused_imps -- Not trivial; see eg Trac #7454
1661 = case imps of
1662 Just (False, L _ imp_ies) ->
1663 foldr (add_unused . unLoc) emptyNameSet imp_ies
1664 _other -> emptyNameSet -- No explicit import list => no unused-name list
1665
1666 add_unused :: IE Name -> NameSet -> NameSet
1667 add_unused (IEVar (L _ n)) acc = add_unused_name n acc
1668 add_unused (IEThingAbs (L _ n)) acc = add_unused_name n acc
1669 add_unused (IEThingAll (L _ n)) acc = add_unused_all n acc
1670 add_unused (IEThingWith (L _ p) wc ns fs) acc =
1671 add_wc_all (add_unused_with p xs acc)
1672 where xs = map unLoc ns ++ map (flSelector . unLoc) fs
1673 add_wc_all = case wc of
1674 NoIEWildcard -> id
1675 IEWildcard _ -> add_unused_all p
1676 add_unused _ acc = acc
1677
1678 add_unused_name n acc
1679 | n `elemNameSet` used_names = acc
1680 | otherwise = acc `extendNameSet` n
1681 add_unused_all n acc
1682 | n `elemNameSet` used_names = acc
1683 | n `elemNameSet` used_parents = acc
1684 | otherwise = acc `extendNameSet` n
1685 add_unused_with p ns acc
1686 | all (`elemNameSet` acc1) ns = add_unused_name p acc1
1687 | otherwise = acc1
1688 where
1689 acc1 = foldr add_unused_name acc ns
1690 -- If you use 'signum' from Num, then the user may well have
1691 -- imported Num(signum). We don't want to complain that
1692 -- Num is not itself mentioned. Hence the two cases in add_unused_with.
1693
1694 extendImportMap :: GlobalRdrElt -> ImportMap -> ImportMap
1695 -- For each of a list of used GREs, find all the import decls that brought
1696 -- it into scope; choose one of them (bestImport), and record
1697 -- the RdrName in that import decl's entry in the ImportMap
1698 extendImportMap gre imp_map
1699 = add_imp gre (bestImport (gre_imp gre)) imp_map
1700 where
1701 add_imp :: GlobalRdrElt -> ImportSpec -> ImportMap -> ImportMap
1702 add_imp gre (ImpSpec { is_decl = imp_decl_spec }) imp_map
1703 = Map.insertWith add decl_loc [avail] imp_map
1704 where
1705 add _ avails = avail : avails -- add is really just a specialised (++)
1706 decl_loc = srcSpanEnd (is_dloc imp_decl_spec)
1707 -- For srcSpanEnd see Note [The ImportMap]
1708 avail = availFromGRE gre
1709
1710 warnUnusedImport :: WarningFlag -> NameEnv (FieldLabelString, Name)
1711 -> ImportDeclUsage -> RnM ()
1712 warnUnusedImport flag fld_env (L loc decl, used, unused)
1713 | Just (False,L _ []) <- ideclHiding decl
1714 = return () -- Do not warn for 'import M()'
1715
1716 | Just (True, L _ hides) <- ideclHiding decl
1717 , not (null hides)
1718 , pRELUDE_NAME == unLoc (ideclName decl)
1719 = return () -- Note [Do not warn about Prelude hiding]
1720 | null used = addWarnAt (Reason flag) loc msg1 -- Nothing used; drop entire decl
1721 | null unused = return () -- Everything imported is used; nop
1722 | otherwise = addWarnAt (Reason flag) loc msg2 -- Some imports are unused
1723 where
1724 msg1 = vcat [pp_herald <+> quotes pp_mod <+> pp_not_used,
1725 nest 2 (text "except perhaps to import instances from"
1726 <+> quotes pp_mod),
1727 text "To import instances alone, use:"
1728 <+> text "import" <+> pp_mod <> parens Outputable.empty ]
1729 msg2 = sep [pp_herald <+> quotes sort_unused,
1730 text "from module" <+> quotes pp_mod <+> pp_not_used]
1731 pp_herald = text "The" <+> pp_qual <+> text "import of"
1732 pp_qual
1733 | ideclQualified decl = text "qualified"
1734 | otherwise = Outputable.empty
1735 pp_mod = ppr (unLoc (ideclName decl))
1736 pp_not_used = text "is redundant"
1737
1738 ppr_possible_field n = case lookupNameEnv fld_env n of
1739 Just (fld, p) -> ppr p <> parens (ppr fld)
1740 Nothing -> ppr n
1741
1742 -- Print unused names in a deterministic (lexicographic) order
1743 sort_unused = pprWithCommas ppr_possible_field $
1744 sortBy (comparing nameOccName) unused
1745
1746 {-
1747 Note [Do not warn about Prelude hiding]
1748 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1749 We do not warn about
1750 import Prelude hiding( x, y )
1751 because even if nothing else from Prelude is used, it may be essential to hide
1752 x,y to avoid name-shadowing warnings. Example (Trac #9061)
1753 import Prelude hiding( log )
1754 f x = log where log = ()
1755
1756
1757
1758 Note [Printing minimal imports]
1759 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1760 To print the minimal imports we walk over the user-supplied import
1761 decls, and simply trim their import lists. NB that
1762
1763 * We do *not* change the 'qualified' or 'as' parts!
1764
1765 * We do not disard a decl altogether; we might need instances
1766 from it. Instead we just trim to an empty import list
1767 -}
1768
1769 printMinimalImports :: [ImportDeclUsage] -> RnM ()
1770 -- See Note [Printing minimal imports]
1771 printMinimalImports imports_w_usage
1772 = do { imports' <- mapM mk_minimal imports_w_usage
1773 ; this_mod <- getModule
1774 ; dflags <- getDynFlags
1775 ; liftIO $
1776 do { h <- openFile (mkFilename dflags this_mod) WriteMode
1777 ; printForUser dflags h neverQualify (vcat (map ppr imports')) }
1778 -- The neverQualify is important. We are printing Names
1779 -- but they are in the context of an 'import' decl, and
1780 -- we never qualify things inside there
1781 -- E.g. import Blag( f, b )
1782 -- not import Blag( Blag.f, Blag.g )!
1783 }
1784 where
1785 mkFilename dflags this_mod
1786 | Just d <- dumpDir dflags = d </> basefn
1787 | otherwise = basefn
1788 where
1789 basefn = moduleNameString (moduleName this_mod) ++ ".imports"
1790
1791 mk_minimal (L l decl, used, unused)
1792 | null unused
1793 , Just (False, _) <- ideclHiding decl
1794 = return (L l decl)
1795 | otherwise
1796 = do { let ImportDecl { ideclName = L _ mod_name
1797 , ideclSource = is_boot
1798 , ideclPkgQual = mb_pkg } = decl
1799 ; iface <- loadSrcInterface doc mod_name is_boot (fmap sl_fs mb_pkg)
1800 ; let lies = map (L l) (concatMap (to_ie iface) used)
1801 ; return (L l (decl { ideclHiding = Just (False, L l lies) })) }
1802 where
1803 doc = text "Compute minimal imports for" <+> ppr decl
1804
1805 to_ie :: ModIface -> AvailInfo -> [IE Name]
1806 -- The main trick here is that if we're importing all the constructors
1807 -- we want to say "T(..)", but if we're importing only a subset we want
1808 -- to say "T(A,B,C)". So we have to find out what the module exports.
1809 to_ie _ (Avail _ n)
1810 = [IEVar (noLoc n)]
1811 to_ie _ (AvailTC n [m] [])
1812 | n==m = [IEThingAbs (noLoc n)]
1813 to_ie iface (AvailTC n ns fs)
1814 = case [(xs,gs) | AvailTC x xs gs <- mi_exports iface
1815 , x == n
1816 , x `elem` xs -- Note [Partial export]
1817 ] of
1818 [xs] | all_used xs -> [IEThingAll (noLoc n)]
1819 | otherwise -> [IEThingWith (noLoc n) NoIEWildcard
1820 (map noLoc (filter (/= n) ns))
1821 (map noLoc fs)]
1822 -- Note [Overloaded field import]
1823 _other | all_non_overloaded fs
1824 -> map (IEVar . noLoc) $ ns ++ map flSelector fs
1825 | otherwise -> [IEThingWith (noLoc n) NoIEWildcard
1826 (map noLoc (filter (/= n) ns)) (map noLoc fs)]
1827 where
1828 fld_lbls = map flLabel fs
1829
1830 all_used (avail_occs, avail_flds)
1831 = all (`elem` ns) avail_occs
1832 && all (`elem` fld_lbls) (map flLabel avail_flds)
1833
1834 all_non_overloaded = all (not . flIsOverloaded)
1835
1836 {-
1837 Note [Partial export]
1838 ~~~~~~~~~~~~~~~~~~~~~
1839 Suppose we have
1840
1841 module A( op ) where
1842 class C a where
1843 op :: a -> a
1844
1845 module B where
1846 import A
1847 f = ..op...
1848
1849 Then the minimal import for module B is
1850 import A( op )
1851 not
1852 import A( C( op ) )
1853 which we would usually generate if C was exported from B. Hence
1854 the (x `elem` xs) test when deciding what to generate.
1855
1856
1857 Note [Overloaded field import]
1858 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1859 On the other hand, if we have
1860
1861 {-# LANGUAGE DuplicateRecordFields #-}
1862 module A where
1863 data T = MkT { foo :: Int }
1864
1865 module B where
1866 import A
1867 f = ...foo...
1868
1869 then the minimal import for module B must be
1870 import A ( T(foo) )
1871 because when DuplicateRecordFields is enabled, field selectors are
1872 not in scope without their enclosing datatype.
1873
1874
1875 ************************************************************************
1876 * *
1877 \subsection{Errors}
1878 * *
1879 ************************************************************************
1880 -}
1881
1882 qualImportItemErr :: RdrName -> SDoc
1883 qualImportItemErr rdr
1884 = hang (text "Illegal qualified name in import item:")
1885 2 (ppr rdr)
1886
1887 badImportItemErrStd :: ModIface -> ImpDeclSpec -> IE RdrName -> SDoc
1888 badImportItemErrStd iface decl_spec ie
1889 = sep [text "Module", quotes (ppr (is_mod decl_spec)), source_import,
1890 text "does not export", quotes (ppr ie)]
1891 where
1892 source_import | mi_boot iface = text "(hi-boot interface)"
1893 | otherwise = Outputable.empty
1894
1895 badImportItemErrDataCon :: OccName -> ModIface -> ImpDeclSpec -> IE RdrName -> SDoc
1896 badImportItemErrDataCon dataType_occ iface decl_spec ie
1897 = vcat [ text "In module"
1898 <+> quotes (ppr (is_mod decl_spec))
1899 <+> source_import <> colon
1900 , nest 2 $ quotes datacon
1901 <+> text "is a data constructor of"
1902 <+> quotes dataType
1903 , text "To import it use"
1904 , nest 2 $ quotes (text "import")
1905 <+> ppr (is_mod decl_spec)
1906 <> parens_sp (dataType <> parens_sp datacon)
1907 , text "or"
1908 , nest 2 $ quotes (text "import")
1909 <+> ppr (is_mod decl_spec)
1910 <> parens_sp (dataType <> text "(..)")
1911 ]
1912 where
1913 datacon_occ = rdrNameOcc $ ieName ie
1914 datacon = parenSymOcc datacon_occ (ppr datacon_occ)
1915 dataType = parenSymOcc dataType_occ (ppr dataType_occ)
1916 source_import | mi_boot iface = text "(hi-boot interface)"
1917 | otherwise = Outputable.empty
1918 parens_sp d = parens (space <> d <> space) -- T( f,g )
1919
1920 badImportItemErr :: ModIface -> ImpDeclSpec -> IE RdrName -> [AvailInfo] -> SDoc
1921 badImportItemErr iface decl_spec ie avails
1922 = case find checkIfDataCon avails of
1923 Just con -> badImportItemErrDataCon (availOccName con) iface decl_spec ie
1924 Nothing -> badImportItemErrStd iface decl_spec ie
1925 where
1926 checkIfDataCon (AvailTC _ ns _) =
1927 case find (\n -> importedFS == nameOccNameFS n) ns of
1928 Just n -> isDataConName n
1929 Nothing -> False
1930 checkIfDataCon _ = False
1931 availOccName = nameOccName . availName
1932 nameOccNameFS = occNameFS . nameOccName
1933 importedFS = occNameFS . rdrNameOcc $ ieName ie
1934
1935 illegalImportItemErr :: SDoc
1936 illegalImportItemErr = text "Illegal import item"
1937
1938 dodgyImportWarn :: RdrName -> SDoc
1939 dodgyImportWarn item = dodgyMsg (text "import") item
1940 dodgyExportWarn :: Name -> SDoc
1941 dodgyExportWarn item = dodgyMsg (text "export") item
1942
1943 dodgyMsg :: (OutputableBndr n, HasOccName n) => SDoc -> n -> SDoc
1944 dodgyMsg kind tc
1945 = sep [ text "The" <+> kind <+> ptext (sLit "item")
1946 <+> quotes (ppr (IEThingAll (noLoc tc)))
1947 <+> text "suggests that",
1948 quotes (ppr tc) <+> text "has (in-scope) constructors or class methods,",
1949 text "but it has none" ]
1950
1951 exportItemErr :: IE RdrName -> SDoc
1952 exportItemErr export_item
1953 = sep [ text "The export item" <+> quotes (ppr export_item),
1954 text "attempts to export constructors or class methods that are not visible here" ]
1955
1956 exportClashErr :: GlobalRdrEnv -> Name -> Name -> IE RdrName -> IE RdrName
1957 -> MsgDoc
1958 exportClashErr global_env name1 name2 ie1 ie2
1959 = vcat [ text "Conflicting exports for" <+> quotes (ppr occ) <> colon
1960 , ppr_export ie1' name1'
1961 , ppr_export ie2' name2' ]
1962 where
1963 occ = nameOccName name1
1964 ppr_export ie name = nest 3 (hang (quotes (ppr ie) <+> text "exports" <+>
1965 quotes (ppr name))
1966 2 (pprNameProvenance (get_gre name)))
1967
1968 -- get_gre finds a GRE for the Name, so that we can show its provenance
1969 get_gre name
1970 = case lookupGRE_Name global_env name of
1971 (gre:_) -> gre
1972 [] -> pprPanic "exportClashErr" (ppr name)
1973 get_loc name = greSrcSpan (get_gre name)
1974 (name1', ie1', name2', ie2') = if get_loc name1 < get_loc name2
1975 then (name1, ie1, name2, ie2)
1976 else (name2, ie2, name1, ie1)
1977
1978 addDupDeclErr :: [GlobalRdrElt] -> TcRn ()
1979 addDupDeclErr [] = panic "addDupDeclErr: empty list"
1980 addDupDeclErr gres@(gre : _)
1981 = addErrAt (getSrcSpan (last sorted_names)) $
1982 -- Report the error at the later location
1983 vcat [text "Multiple declarations of" <+>
1984 quotes (ppr (nameOccName name)),
1985 -- NB. print the OccName, not the Name, because the
1986 -- latter might not be in scope in the RdrEnv and so will
1987 -- be printed qualified.
1988 text "Declared at:" <+>
1989 vcat (map (ppr . nameSrcLoc) sorted_names)]
1990 where
1991 name = gre_name gre
1992 sorted_names = sortWith nameSrcLoc (map gre_name gres)
1993
1994 dupExportWarn :: OccName -> IE RdrName -> IE RdrName -> SDoc
1995 dupExportWarn occ_name ie1 ie2
1996 = hsep [quotes (ppr occ_name),
1997 text "is exported by", quotes (ppr ie1),
1998 text "and", quotes (ppr ie2)]
1999
2000 dupModuleExport :: ModuleName -> SDoc
2001 dupModuleExport mod
2002 = hsep [text "Duplicate",
2003 quotes (text "Module" <+> ppr mod),
2004 text "in export list"]
2005
2006 moduleNotImported :: ModuleName -> SDoc
2007 moduleNotImported mod
2008 = text "The export item `module" <+> ppr mod <>
2009 text "' is not imported"
2010
2011 nullModuleExport :: ModuleName -> SDoc
2012 nullModuleExport mod
2013 = text "The export item `module" <+> ppr mod <> ptext (sLit "' exports nothing")
2014
2015 missingImportListWarn :: ModuleName -> SDoc
2016 missingImportListWarn mod
2017 = text "The module" <+> quotes (ppr mod) <+> ptext (sLit "does not have an explicit import list")
2018
2019 missingImportListItem :: IE RdrName -> SDoc
2020 missingImportListItem ie
2021 = text "The import item" <+> quotes (ppr ie) <+> ptext (sLit "does not have an explicit import list")
2022
2023 moduleWarn :: ModuleName -> WarningTxt -> SDoc
2024 moduleWarn mod (WarningTxt _ txt)
2025 = sep [ text "Module" <+> quotes (ppr mod) <> ptext (sLit ":"),
2026 nest 2 (vcat (map (ppr . sl_fs . unLoc) txt)) ]
2027 moduleWarn mod (DeprecatedTxt _ txt)
2028 = sep [ text "Module" <+> quotes (ppr mod)
2029 <+> text "is deprecated:",
2030 nest 2 (vcat (map (ppr . sl_fs . unLoc) txt)) ]
2031
2032 packageImportErr :: SDoc
2033 packageImportErr
2034 = text "Package-qualified imports are not enabled; use PackageImports"
2035
2036 -- This data decl will parse OK
2037 -- data T = a Int
2038 -- treating "a" as the constructor.
2039 -- It is really hard to make the parser spot this malformation.
2040 -- So the renamer has to check that the constructor is legal
2041 --
2042 -- We can get an operator as the constructor, even in the prefix form:
2043 -- data T = :% Int Int
2044 -- from interface files, which always print in prefix form
2045
2046 checkConName :: RdrName -> TcRn ()
2047 checkConName name = checkErr (isRdrDataCon name) (badDataCon name)
2048
2049 badDataCon :: RdrName -> SDoc
2050 badDataCon name
2051 = hsep [text "Illegal data constructor name", quotes (ppr name)]