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