2 % (c) The GRASP Project, Glasgow University, 1992-1998
4 \section[Rename]{Renaming and dependency analysis passes}
8 renameModule, renameStmt, renameRdrName, mkGlobalContext,
9 closeIfaceDecls, checkOldIface
12 #include "HsVersions.h"
15 import RdrHsSyn ( RdrNameHsModule, RdrNameHsDecl, RdrNameDeprecation,
16 RdrNameTyClDecl, RdrNameRuleDecl, RdrNameInstDecl, RdrNameImportDecl,
19 import RnHsSyn ( RenamedHsDecl, RenamedTyClDecl, RenamedRuleDecl, RenamedInstDecl,
21 instDeclFVs, tyClDeclFVs, ruleDeclFVs
24 import CmdLineOpts ( DynFlags, DynFlag(..) )
26 import RnExpr ( rnStmt )
27 import RnNames ( getGlobalNames, exportsFromAvail )
28 import RnSource ( rnSourceDecls, rnTyClDecl, rnIfaceRuleDecl, rnInstDecl )
29 import RnIfaces ( slurpImpDecls, mkImportInfo, recordLocalSlurps,
31 RecompileRequired, outOfDate, recompileRequired
33 import RnHiFiles ( readIface, loadInterface,
34 loadExports, loadFixDecls, loadDeprecs,
36 import RnEnv ( availsToNameSet,
37 unitAvailEnv, availEnvElts, availNames,
38 plusAvailEnv, groupAvails, warnUnusedImports,
39 warnUnusedLocalBinds, warnUnusedModules,
40 lookupSrcName, getImplicitStmtFVs,
41 getImplicitModuleFVs, newGlobalName, unQualInScope,
42 ubiquitousNames, lookupOccRn,
43 plusGlobalRdrEnv, mkGlobalRdrEnv
45 import Module ( Module, ModuleName, WhereFrom(..),
46 moduleNameUserString, moduleName,
49 import Name ( Name, nameModule )
52 import RdrName ( foldRdrEnv, isQual )
53 import PrelNames ( iNTERACTIVE, pRELUDE_Name )
54 import ErrUtils ( dumpIfSet, dumpIfSet_dyn, showPass,
55 printErrorsAndWarnings, errorsFound )
56 import Bag ( bagToList )
57 import FiniteMap ( FiniteMap, fmToList, emptyFM, lookupFM,
58 addToFM_C, elemFM, addToFM
60 import Maybes ( maybeToBool, catMaybes )
62 import IO ( openFile, IOMode(..) )
63 import HscTypes -- lots of it
64 import List ( partition, nub )
68 %*********************************************************
70 \subsection{The main wrappers}
72 %*********************************************************
75 renameModule :: DynFlags
76 -> HomeIfaceTable -> HomeSymbolTable
77 -> PersistentCompilerState
78 -> Module -> RdrNameHsModule
79 -> IO (PersistentCompilerState, PrintUnqualified,
80 Maybe (IsExported, ModIface, [RenamedHsDecl]))
81 -- Nothing => some error occurred in the renamer
83 renameModule dflags hit hst pcs this_module rdr_module
84 = renameSource dflags hit hst pcs this_module $
85 rename this_module rdr_module
89 renameStmt :: DynFlags
90 -> HomeIfaceTable -> HomeSymbolTable
91 -> PersistentCompilerState
93 -> RdrNameStmt -- parsed stmt
94 -> IO ( PersistentCompilerState,
96 Maybe ([Name], (RenamedStmt, [RenamedHsDecl]))
99 renameStmt dflags hit hst pcs ic stmt
100 = renameSource dflags hit hst pcs iNTERACTIVE $
102 -- load the context module
103 let InteractiveContext{ ic_rn_gbl_env = rdr_env,
104 ic_print_unqual = print_unqual,
105 ic_rn_local_env = local_rdr_env,
106 ic_type_env = type_env } = ic
109 extendTypeEnvRn type_env $
112 initRnMS rdr_env emptyAvailEnv local_rdr_env emptyLocalFixityEnv CmdLineMode (
113 rnStmt stmt $ \ stmt' ->
114 returnRn (([], stmt'), emptyFVs)
115 ) `thenRn` \ ((binders, stmt), fvs) ->
117 -- Bale out if we fail
118 checkErrsRn `thenRn` \ no_errs_so_far ->
119 if not no_errs_so_far then
120 doDump dflags [] stmt [] `thenRn_` returnRn (print_unqual, Nothing)
123 -- Add implicit free vars, and close decls
124 getImplicitStmtFVs `thenRn` \ implicit_fvs ->
125 slurpImpDecls (fvs `plusFV` implicit_fvs) `thenRn` \ decls ->
126 -- NB: an earlier version deleted (rdrEnvElts local_env) from
127 -- the fvs. But (a) that isn't necessary, because previously
128 -- bound things in the local_env will be in the TypeEnv, and
129 -- the renamer doesn't re-slurp such things, and
130 -- (b) it's WRONG to delete them. Consider in GHCi:
131 -- Mod> let x = e :: T
132 -- Mod> let y = x + 3
133 -- We need to pass 'x' among the fvs to slurpImpDecls, so that
134 -- the latter can see that T is a gate, and hence import the Num T
135 -- instance decl. (See the InTypEnv case in RnIfaces.slurpSourceRefs.)
137 doDump dflags binders stmt decls `thenRn_`
138 returnRn (print_unqual, Just (binders, (stmt, decls)))
141 doDump :: DynFlags -> [Name] -> RenamedStmt -> [RenamedHsDecl]
142 -> RnMG (Either IOError ())
143 doDump dflags bndrs stmt decls
144 = ioToRnM (dumpIfSet_dyn dflags Opt_D_dump_rn "Renamer:"
145 (vcat [text "Binders:" <+> ppr bndrs,
147 vcat (map ppr decls)]))
152 -> HomeIfaceTable -> HomeSymbolTable
153 -> PersistentCompilerState
154 -> InteractiveContext
155 -> [RdrName] -- name to rename
156 -> IO ( PersistentCompilerState,
158 Maybe ([Name], [RenamedHsDecl])
161 renameRdrName dflags hit hst pcs ic rdr_names =
162 renameSource dflags hit hst pcs iNTERACTIVE $
164 -- load the context module
165 let InteractiveContext{ ic_rn_gbl_env = rdr_env,
166 ic_print_unqual = print_unqual,
167 ic_rn_local_env = local_rdr_env,
168 ic_type_env = type_env } = ic
171 extendTypeEnvRn type_env $
173 -- rename the rdr_name
174 initRnMS rdr_env emptyAvailEnv local_rdr_env emptyLocalFixityEnv CmdLineMode
175 (mapRn (tryRn.lookupOccRn) rdr_names) `thenRn` \ maybe_names ->
177 ok_names = [ a | Right a <- maybe_names ]
180 then let errs = head [ e | Left e <- maybe_names ]
181 in setErrsRn errs `thenRn_`
182 doDump dflags ok_names [] `thenRn_`
183 returnRn (print_unqual, Nothing)
186 slurpImpDecls (mkNameSet ok_names) `thenRn` \ decls ->
188 doDump dflags ok_names decls `thenRn_`
189 returnRn (print_unqual, Just (ok_names, decls))
191 doDump :: DynFlags -> [Name] -> [RenamedHsDecl] -> RnMG (Either IOError ())
192 doDump dflags names decls
193 = ioToRnM (dumpIfSet_dyn dflags Opt_D_dump_rn "Renamer:"
194 (vcat [ppr names, text "",
195 vcat (map ppr decls)]))
198 %*********************************************************
200 \subsection{Make up an interactive context}
202 %*********************************************************
206 :: DynFlags -> HomeIfaceTable -> HomeSymbolTable
207 -> PersistentCompilerState
208 -> [Module] -> [Module]
209 -> IO (PersistentCompilerState, PrintUnqualified, Maybe GlobalRdrEnv)
210 mkGlobalContext dflags hit hst pcs toplevs exports
211 = renameSource dflags hit hst pcs iNTERACTIVE $
213 mapRn getTopLevScope toplevs `thenRn` \ toplev_envs ->
214 mapRn getModuleExports exports `thenRn` \ export_envs ->
215 let full_env = foldr plusGlobalRdrEnv emptyRdrEnv
216 (toplev_envs ++ export_envs)
217 print_unqual = unQualInScope full_env
219 checkErrsRn `thenRn` \ no_errs_so_far ->
220 if not no_errs_so_far then
221 returnRn (print_unqual, Nothing)
223 returnRn (print_unqual, Just full_env)
225 contextDoc = text "context for compiling statements"
227 getTopLevScope :: Module -> RnM d GlobalRdrEnv
229 loadInterface contextDoc (moduleName mod) ImportByUser `thenRn` \ iface ->
230 case mi_globals iface of
231 Nothing -> panic "getTopLevScope"
232 Just env -> returnRn env
234 getModuleExports :: Module -> RnM d GlobalRdrEnv
235 getModuleExports mod =
236 loadInterface contextDoc (moduleName mod) ImportByUser `thenRn` \ iface ->
237 returnRn (foldl add emptyRdrEnv (mi_exports iface))
239 prov_fn n = NonLocalDef ImplicitImport
240 add env (mod,avails) =
241 plusGlobalRdrEnv env (mkGlobalRdrEnv mod True prov_fn avails NoDeprecs)
244 %*********************************************************
246 \subsection{The main function: rename}
248 %*********************************************************
251 renameSource :: DynFlags
252 -> HomeIfaceTable -> HomeSymbolTable
253 -> PersistentCompilerState
255 -> RnMG (PrintUnqualified, Maybe r)
256 -> IO (PersistentCompilerState, PrintUnqualified, Maybe r)
257 -- Nothing => some error occurred in the renamer
259 renameSource dflags hit hst old_pcs this_module thing_inside
260 = do { showPass dflags "Renamer"
262 -- Initialise the renamer monad
263 ; (new_pcs, msgs, (print_unqual, maybe_rn_stuff))
264 <- initRn dflags hit hst old_pcs this_module thing_inside
266 -- Print errors from renaming
267 ; printErrorsAndWarnings print_unqual msgs ;
269 -- Return results. No harm in updating the PCS
270 ; if errorsFound msgs then
271 return (new_pcs, print_unqual, Nothing)
273 return (new_pcs, print_unqual, maybe_rn_stuff)
278 rename :: Module -> RdrNameHsModule
279 -> RnMG (PrintUnqualified, Maybe (IsExported, ModIface, [RenamedHsDecl]))
280 rename this_module contents@(HsModule _ _ exports imports local_decls mod_deprec loc)
283 -- FIND THE GLOBAL NAME ENVIRONMENT
284 getGlobalNames this_module contents `thenRn` \ (gbl_env, local_gbl_env,
285 (mod_avail_env, global_avail_env)) ->
287 print_unqualified = unQualInScope gbl_env
289 full_avail_env :: NameEnv AvailInfo
290 -- The domain of global_avail_env is just the 'major' things;
291 -- variables, type constructors, classes.
292 -- E.g. Functor |-> Functor( Functor, fmap )
293 -- The domain of full_avail_env is everything in scope
294 -- E.g. Functor |-> Functor( Functor, fmap )
295 -- fmap |-> Functor( Functor, fmap )
297 -- This filled-out avail_env is needed to generate
298 -- exports (mkExportAvails), and for generating minimal
299 -- exports (reportUnusedNames)
300 full_avail_env = mkNameEnv [ (name,avail)
301 | avail <- availEnvElts global_avail_env,
302 name <- availNames avail]
304 -- Exit if we've found any errors
305 checkErrsRn `thenRn` \ no_errs_so_far ->
306 if not no_errs_so_far then
307 -- Found errors already, so exit now
308 rnDump [] [] `thenRn_`
309 returnRn (print_unqualified, Nothing)
312 -- PROCESS EXPORT LIST
313 exportsFromAvail mod_name exports mod_avail_env
314 full_avail_env gbl_env `thenRn` \ export_avails ->
316 traceRn (text "Local top-level environment" $$
317 nest 4 (pprGlobalRdrEnv local_gbl_env)) `thenRn_`
319 -- DEAL WITH DEPRECATIONS
320 rnDeprecs local_gbl_env mod_deprec
321 [d | DeprecD d <- local_decls] `thenRn` \ my_deprecs ->
323 -- DEAL WITH LOCAL FIXITIES
324 fixitiesFromLocalDecls local_gbl_env local_decls `thenRn` \ local_fixity_env ->
327 rnSourceDecls gbl_env global_avail_env
328 local_fixity_env local_decls `thenRn` \ (rn_local_decls, source_fvs) ->
330 -- EXIT IF ERRORS FOUND
331 -- We exit here if there are any errors in the source, *before*
332 -- we attempt to slurp the decls from the interfaces, otherwise
333 -- the slurped decls may get lost when we return up the stack
334 -- to hscMain/hscExpr.
335 checkErrsRn `thenRn` \ no_errs_so_far ->
336 if not no_errs_so_far then
337 -- Found errors already, so exit now
338 rnDump [] rn_local_decls `thenRn_`
339 returnRn (print_unqualified, Nothing)
342 -- SLURP IN ALL THE NEEDED DECLARATIONS
343 -- Find out what re-bindable names to use for desugaring
344 getImplicitModuleFVs mod_name rn_local_decls `thenRn` \ implicit_fvs ->
346 export_fvs = availsToNameSet export_avails
347 source_fvs2 = source_fvs `plusFV` export_fvs
348 -- The export_fvs make the exported names look just as if they
349 -- occurred in the source program. For the reasoning, see the
350 -- comments with RnIfaces.mkImportInfo
351 -- It also helps reportUnusedNames, which of course must not complain
352 -- that 'f' isn't mentioned if it is mentioned in the export list
354 source_fvs3 = implicit_fvs `plusFV` source_fvs2
355 -- It's important to do the "plus" this way round, so that
356 -- when compiling the prelude, locally-defined (), Bool, etc
357 -- override the implicit ones.
360 traceRn (text "Source FVs:" <+> fsep (map ppr (nameSetToList source_fvs3))) `thenRn_`
361 slurpImpDecls source_fvs3 `thenRn` \ rn_imp_decls ->
362 rnDump rn_imp_decls rn_local_decls `thenRn_`
364 -- GENERATE THE VERSION/USAGE INFO
365 mkImportInfo mod_name imports `thenRn` \ my_usages ->
367 -- BUILD THE MODULE INTERFACE
369 -- We record fixities even for things that aren't exported,
370 -- so that we can change into the context of this moodule easily
371 fixities = mkNameEnv [ (name, fixity)
372 | FixitySig name fixity loc <- nameEnvElts local_fixity_env
375 -- Sort the exports to make them easier to compare for versions
376 my_exports = groupAvails this_module export_avails
378 final_decls = rn_local_decls ++ rn_imp_decls
380 mod_iface = ModIface { mi_module = this_module,
381 mi_version = initialVersionInfo,
382 mi_usages = my_usages,
384 mi_orphan = panic "is_orphan",
385 mi_exports = my_exports,
386 mi_globals = Just gbl_env,
387 mi_fixities = fixities,
388 mi_deprecs = my_deprecs,
389 mi_decls = panic "mi_decls"
392 is_exported name = name `elemNameSet` exported_names
393 exported_names = availsToNameSet export_avails
396 -- REPORT UNUSED NAMES, AND DEBUG DUMP
397 reportUnusedNames mod_iface print_unqualified
398 imports full_avail_env gbl_env
399 source_fvs2 rn_imp_decls `thenRn_`
400 -- NB: source_fvs2: include exports (else we get bogus
401 -- warnings of unused things) but not implicit FVs.
403 returnRn (print_unqualified, Just (is_exported, mod_iface, final_decls))
405 mod_name = moduleName this_module
410 %*********************************************************
412 \subsection{Fixities}
414 %*********************************************************
417 fixitiesFromLocalDecls :: GlobalRdrEnv -> [RdrNameHsDecl] -> RnMG LocalFixityEnv
418 fixitiesFromLocalDecls gbl_env decls
419 = foldlRn getFixities emptyNameEnv decls `thenRn` \ env ->
420 traceRn (text "fixity env" <+> vcat (map ppr (nameEnvElts env))) `thenRn_`
423 getFixities :: LocalFixityEnv -> RdrNameHsDecl -> RnMG LocalFixityEnv
424 getFixities acc (FixD fix)
427 getFixities acc (TyClD (ClassDecl { tcdSigs = sigs}))
428 = foldlRn fix_decl acc [sig | FixSig sig <- sigs]
429 -- Get fixities from class decl sigs too.
430 getFixities acc other_decl
433 fix_decl acc sig@(FixitySig rdr_name fixity loc)
434 = -- Check for fixity decl for something not declared
436 lookupSrcName gbl_env rdr_name `thenRn` \ name ->
438 -- Check for duplicate fixity decl
439 case lookupNameEnv acc name of
440 Just (FixitySig _ _ loc') -> addErrRn (dupFixityDecl rdr_name loc loc') `thenRn_`
443 Nothing -> returnRn (extendNameEnv acc name (FixitySig name fixity loc))
447 %*********************************************************
449 \subsection{Deprecations}
451 %*********************************************************
453 For deprecations, all we do is check that the names are in scope.
454 It's only imported deprecations, dealt with in RnIfaces, that we
455 gather them together.
458 rnDeprecs :: GlobalRdrEnv -> Maybe DeprecTxt
459 -> [RdrNameDeprecation] -> RnMG Deprecations
460 rnDeprecs gbl_env Nothing []
463 rnDeprecs gbl_env (Just txt) decls
464 = mapRn (addErrRn . badDeprec) decls `thenRn_`
465 returnRn (DeprecAll txt)
467 rnDeprecs gbl_env Nothing decls
468 = mapRn rn_deprec decls `thenRn` \ pairs ->
469 returnRn (DeprecSome (mkNameEnv (catMaybes pairs)))
471 rn_deprec (Deprecation rdr_name txt loc)
473 lookupSrcName gbl_env rdr_name `thenRn` \ name ->
474 returnRn (Just (name, (name,txt)))
478 %************************************************************************
480 \subsection{Grabbing the old interface file and checking versions}
482 %************************************************************************
485 checkOldIface :: GhciMode
487 -> HomeIfaceTable -> HomeSymbolTable
488 -> PersistentCompilerState
490 -> Bool -- Source unchanged
491 -> Maybe ModIface -- Old interface from compilation manager, if any
492 -> IO (PersistentCompilerState, Bool, (RecompileRequired, Maybe ModIface))
493 -- True <=> errors happened
495 checkOldIface ghci_mode dflags hit hst pcs iface_path source_unchanged maybe_iface
496 = runRn dflags hit hst pcs (panic "Bogus module") $
498 -- CHECK WHETHER THE SOURCE HAS CHANGED
499 ( if not source_unchanged then
500 traceHiDiffsRn (nest 4 (text "Source file changed or recompilation check turned off"))
501 else returnRn () ) `thenRn_`
503 -- If the source has changed and we're in interactive mode, avoid reading
504 -- an interface; just return the one we might have been supplied with.
505 if ghci_mode == Interactive && not source_unchanged then
506 returnRn (outOfDate, maybe_iface)
510 Just old_iface -> -- Use the one we already have
511 setModuleRn (mi_module old_iface) (check_versions old_iface)
513 Nothing -- try and read it from a file
514 -> readIface iface_path `thenRn` \ read_result ->
516 Left err -> -- Old interface file not found, or garbled; give up
518 text "Cannot read old interface file:"
519 $$ nest 4 err) `thenRn_`
520 returnRn (outOfDate, Nothing)
523 -> setModuleRn (pi_mod parsed_iface) $
524 loadOldIface parsed_iface `thenRn` \ m_iface ->
525 check_versions m_iface
527 check_versions :: ModIface -> RnMG (RecompileRequired, Maybe ModIface)
529 | not source_unchanged
530 = returnRn (outOfDate, Just iface)
533 recompileRequired iface_path iface `thenRn` \ recompile ->
534 returnRn (recompile, Just iface)
537 I think the following function should now have a more representative name,
541 loadOldIface :: ParsedIface -> RnMG ModIface
543 loadOldIface parsed_iface
544 = let iface = parsed_iface
548 loadHomeDecls (pi_decls iface) `thenRn` \ decls ->
549 loadHomeRules (pi_rules iface) `thenRn` \ rules ->
550 loadHomeInsts (pi_insts iface) `thenRn` \ insts ->
551 returnRn (decls, rules, insts)
553 `thenRn` \ ((decls_vers, new_decls), (rule_vers, new_rules), new_insts) ->
555 mapRn loadHomeUsage (pi_usages iface) `thenRn` \ usages ->
556 loadExports (pi_exports iface) `thenRn` \ (export_vers, avails) ->
557 loadFixDecls mod (pi_fixity iface) `thenRn` \ fix_env ->
558 loadDeprecs mod (pi_deprecs iface) `thenRn` \ deprec_env ->
560 version = VersionInfo { vers_module = pi_vers iface,
561 vers_exports = export_vers,
562 vers_rules = rule_vers,
563 vers_decls = decls_vers }
565 decls = mkIfaceDecls new_decls new_rules new_insts
567 mod_iface = ModIface { mi_module = mod, mi_version = version,
568 mi_exports = avails, mi_usages = usages,
569 mi_boot = False, mi_orphan = pi_orphan iface,
570 mi_fixities = fix_env, mi_deprecs = deprec_env,
579 loadHomeDecls :: [(Version, RdrNameTyClDecl)]
580 -> RnMS (NameEnv Version, [RenamedTyClDecl])
581 loadHomeDecls decls = foldlRn loadHomeDecl (emptyNameEnv, []) decls
583 loadHomeDecl :: (NameEnv Version, [RenamedTyClDecl])
584 -> (Version, RdrNameTyClDecl)
585 -> RnMS (NameEnv Version, [RenamedTyClDecl])
586 loadHomeDecl (version_map, decls) (version, decl)
587 = rnTyClDecl decl `thenRn` \ decl' ->
588 returnRn (extendNameEnv version_map (tyClDeclName decl') version, decl':decls)
591 loadHomeRules :: (Version, [RdrNameRuleDecl])
592 -> RnMS (Version, [RenamedRuleDecl])
593 loadHomeRules (version, rules)
594 = mapRn rnIfaceRuleDecl rules `thenRn` \ rules' ->
595 returnRn (version, rules')
598 loadHomeInsts :: [RdrNameInstDecl]
599 -> RnMS [RenamedInstDecl]
600 loadHomeInsts insts = mapRn rnInstDecl insts
603 loadHomeUsage :: ImportVersion OccName
604 -> RnMG (ImportVersion Name)
605 loadHomeUsage (mod_name, orphans, is_boot, whats_imported)
606 = rn_imps whats_imported `thenRn` \ whats_imported' ->
607 returnRn (mod_name, orphans, is_boot, whats_imported')
609 rn_imps NothingAtAll = returnRn NothingAtAll
610 rn_imps (Everything v) = returnRn (Everything v)
611 rn_imps (Specifically mv ev items rv) = mapRn rn_imp items `thenRn` \ items' ->
612 returnRn (Specifically mv ev items' rv)
613 rn_imp (occ,vers) = newGlobalName mod_name occ `thenRn` \ name ->
619 %*********************************************************
621 \subsection{Closing up the interface decls}
623 %*********************************************************
625 Suppose we discover we don't need to recompile. Then we start from the
626 IfaceDecls in the ModIface, and fluff them up by sucking in all the decls they need.
629 closeIfaceDecls :: DynFlags
630 -> HomeIfaceTable -> HomeSymbolTable
631 -> PersistentCompilerState
632 -> ModIface -- Get the decls from here
633 -> IO (PersistentCompilerState, Bool, [RenamedHsDecl])
634 -- True <=> errors happened
635 closeIfaceDecls dflags hit hst pcs
636 mod_iface@(ModIface { mi_module = mod, mi_decls = iface_decls })
637 = runRn dflags hit hst pcs mod $
640 rule_decls = dcl_rules iface_decls
641 inst_decls = dcl_insts iface_decls
642 tycl_decls = dcl_tycl iface_decls
643 decls = map RuleD rule_decls ++
644 map InstD inst_decls ++
646 needed = unionManyNameSets (map ruleDeclFVs rule_decls) `unionNameSets`
647 unionManyNameSets (map instDeclFVs inst_decls) `unionNameSets`
648 unionManyNameSets (map tyClDeclFVs tycl_decls)
649 local_names = foldl add emptyNameSet tycl_decls
650 add names decl = addListToNameSet names (map fst (tyClDeclSysNames decl ++ tyClDeclNames decl))
653 recordLocalSlurps local_names `thenRn_`
655 -- Do the transitive closure
656 closeDecls decls (needed `plusFV` implicit_fvs) `thenRn` \closed_decls ->
657 rnDump [] closed_decls `thenRn_`
658 returnRn closed_decls
660 implicit_fvs = ubiquitousNames -- Data type decls with record selectors,
661 -- which may appear in the decls, need unpackCString
662 -- and friends. It's easier to just grab them right now.
665 %*********************************************************
667 \subsection{Unused names}
669 %*********************************************************
672 reportUnusedNames :: ModIface -> PrintUnqualified
673 -> [RdrNameImportDecl]
676 -> NameSet -- Used in this module
679 reportUnusedNames my_mod_iface unqual imports avail_env gbl_env
680 used_names imported_decls
681 = warnUnusedModules unused_imp_mods `thenRn_`
682 warnUnusedLocalBinds bad_locals `thenRn_`
683 warnUnusedImports bad_imp_names `thenRn_`
684 printMinimalImports this_mod unqual minimal_imports
686 this_mod = mi_module my_mod_iface
688 -- Now, a use of C implies a use of T,
689 -- if C was brought into scope by T(..) or T(C)
690 really_used_names = used_names `unionNameSets`
691 mkNameSet [ parent_name
692 | sub_name <- nameSetToList used_names
694 -- Usually, every used name will appear in avail_env, but there
695 -- is one time when it doesn't: tuples and other built in syntax. When you
696 -- write (a,b) that gives rise to a *use* of "(,)", so that the
697 -- instances will get pulled in, but the tycon "(,)" isn't actually
698 -- in scope. Also, (-x) gives rise to an implicit use of 'negate';
699 -- similarly, 3.5 gives rise to an implcit use of :%
700 -- Hence the silent 'False' in all other cases
702 , Just parent_name <- [case lookupNameEnv avail_env sub_name of
703 Just (AvailTC n _) -> Just n
707 -- Collect the defined names from the in-scope environment
708 -- Look for the qualified ones only, else get duplicates
709 defined_names :: [GlobalRdrElt]
710 defined_names = foldRdrEnv add [] gbl_env
711 add rdr_name ns acc | isQual rdr_name = ns ++ acc
714 defined_and_used, defined_but_not_used :: [GlobalRdrElt]
715 (defined_and_used, defined_but_not_used) = partition used defined_names
716 used (GRE name _ _) = name `elemNameSet` really_used_names
718 -- Filter out the ones only defined implicitly
720 bad_locals = [n | (GRE n LocalDef _) <- defined_but_not_used]
722 bad_imp_names :: [(Name,Provenance)]
723 bad_imp_names = [(n,p) | GRE n p@(NonLocalDef (UserImport mod _ True)) _ <- defined_but_not_used,
724 not (module_unused mod)]
726 -- inst_mods are directly-imported modules that
727 -- contain instance decl(s) that the renamer decided to suck in
728 -- It's not necessarily redundant to import such modules.
734 -- The import M() is not *necessarily* redundant, even if
735 -- we suck in no instance decls from M (e.g. it contains
736 -- no instance decls, or This contains no code). It may be
737 -- that we import M solely to ensure that M's orphan instance
738 -- decls (or those in its imports) are visible to people who
739 -- import This. Sigh.
740 -- There's really no good way to detect this, so the error message
741 -- in RnEnv.warnUnusedModules is weakened instead
742 inst_mods :: [ModuleName]
743 inst_mods = [m | InstD (InstDecl _ _ _ (Just dfun) _) <- imported_decls,
744 let m = moduleName (nameModule dfun),
745 m `elem` direct_import_mods
748 -- To figure out the minimal set of imports, start with the things
749 -- that are in scope (i.e. in gbl_env). Then just combine them
750 -- into a bunch of avails, so they are properly grouped
751 minimal_imports :: FiniteMap ModuleName AvailEnv
752 minimal_imports0 = emptyFM
753 minimal_imports1 = foldr add_name minimal_imports0 defined_and_used
754 minimal_imports = foldr add_inst_mod minimal_imports1 inst_mods
756 -- We've carefully preserved the provenance so that we can
757 -- construct minimal imports that import the name by (one of)
758 -- the same route(s) as the programmer originally did.
759 add_name (GRE n (NonLocalDef (UserImport m _ _)) _) acc = addToFM_C plusAvailEnv acc (moduleName m)
760 (unitAvailEnv (mk_avail n))
761 add_name (GRE n other_prov _) acc = acc
763 mk_avail n = case lookupNameEnv avail_env n of
764 Just (AvailTC m _) | n==m -> AvailTC n [n]
765 | otherwise -> AvailTC m [n,m]
766 Just avail -> Avail n
767 Nothing -> pprPanic "mk_avail" (ppr n)
770 | m `elemFM` acc = acc -- We import something already
771 | otherwise = addToFM acc m emptyAvailEnv
772 -- Add an empty collection of imports for a module
773 -- from which we have sucked only instance decls
775 direct_import_mods :: [ModuleName]
776 direct_import_mods = nub [m | ImportDecl m _ _ _ _ _ <- imports]
778 -- unused_imp_mods are the directly-imported modules
779 -- that are not mentioned in minimal_imports
780 unused_imp_mods = [m | m <- direct_import_mods,
781 not (maybeToBool (lookupFM minimal_imports m)),
784 module_unused :: Module -> Bool
785 module_unused mod = moduleName mod `elem` unused_imp_mods
788 -- ToDo: deal with original imports with 'qualified' and 'as M' clauses
789 printMinimalImports :: Module -- This module
791 -> FiniteMap ModuleName AvailEnv -- Minimal imports
793 printMinimalImports this_mod unqual imps
794 = ifOptRn Opt_D_dump_minimal_imports $
796 mapRn to_ies (fmToList imps) `thenRn` \ mod_ies ->
797 ioToRnM (do { h <- openFile filename WriteMode ;
798 printForUser h unqual (vcat (map ppr_mod_ie mod_ies))
802 filename = moduleNameUserString (moduleName this_mod) ++ ".imports"
803 ppr_mod_ie (mod_name, ies)
804 | mod_name == pRELUDE_Name
807 = ptext SLIT("import") <+> ppr mod_name <>
808 parens (fsep (punctuate comma (map ppr ies)))
810 to_ies (mod, avail_env) = mapRn to_ie (availEnvElts avail_env) `thenRn` \ ies ->
813 to_ie :: AvailInfo -> RnMG (IE Name)
814 -- The main trick here is that if we're importing all the constructors
815 -- we want to say "T(..)", but if we're importing only a subset we want
816 -- to say "T(A,B,C)". So we have to find out what the module exports.
817 to_ie (Avail n) = returnRn (IEVar n)
818 to_ie (AvailTC n [m]) = ASSERT( n==m )
819 returnRn (IEThingAbs n)
821 = loadInterface (text "Compute minimal imports from" <+> ppr n_mod)
822 n_mod ImportBySystem `thenRn` \ iface ->
823 case [xs | (m,as) <- mi_exports iface,
827 [xs] | all (`elem` ns) xs -> returnRn (IEThingAll n)
828 | otherwise -> returnRn (IEThingWith n (filter (/= n) ns))
829 other -> pprTrace "to_ie" (ppr n <+> ppr (nameModule n) <+> ppr other) $
832 n_mod = moduleName (nameModule n)
834 rnDump :: [RenamedHsDecl] -- Renamed imported decls
835 -> [RenamedHsDecl] -- Renamed local decls
837 rnDump imp_decls local_decls
838 = doptRn Opt_D_dump_rn_trace `thenRn` \ dump_rn_trace ->
839 doptRn Opt_D_dump_rn_stats `thenRn` \ dump_rn_stats ->
840 doptRn Opt_D_dump_rn `thenRn` \ dump_rn ->
841 getIfacesRn `thenRn` \ ifaces ->
843 ioToRnM (do { dumpIfSet (dump_rn_trace || dump_rn_stats || dump_rn)
845 (getRnStats imp_decls ifaces) ;
847 dumpIfSet dump_rn "Renamer:"
848 (vcat (map ppr (local_decls ++ imp_decls)))
855 %*********************************************************
857 \subsection{Statistics}
859 %*********************************************************
862 getRnStats :: [RenamedHsDecl] -> Ifaces -> SDoc
863 getRnStats imported_decls ifaces
864 = hcat [text "Renamer stats: ", stats]
866 n_mods = length [() | _ <- moduleEnvElts (iPIT ifaces)]
867 -- This is really only right for a one-shot compile
869 (decls_map, n_decls_slurped) = iDecls ifaces
871 n_decls_left = length [decl | (avail, True, (_,decl)) <- nameEnvElts decls_map
872 -- Data, newtype, and class decls are in the decls_fm
873 -- under multiple names; the tycon/class, and each
874 -- constructor/class op too.
875 -- The 'True' selects just the 'main' decl
878 (insts_left, n_insts_slurped) = iInsts ifaces
879 n_insts_left = length (bagToList insts_left)
881 (rules_left, n_rules_slurped) = iRules ifaces
882 n_rules_left = length (bagToList rules_left)
885 [int n_mods <+> text "interfaces read",
886 hsep [ int n_decls_slurped, text "type/class/variable imported, out of",
887 int (n_decls_slurped + n_decls_left), text "read"],
888 hsep [ int n_insts_slurped, text "instance decls imported, out of",
889 int (n_insts_slurped + n_insts_left), text "read"],
890 hsep [ int n_rules_slurped, text "rule decls imported, out of",
891 int (n_rules_slurped + n_rules_left), text "read"]
896 %************************************************************************
898 \subsection{Errors and warnings}
900 %************************************************************************
903 dupFixityDecl rdr_name loc1 loc2
904 = vcat [ptext SLIT("Multiple fixity declarations for") <+> quotes (ppr rdr_name),
905 ptext SLIT("at ") <+> ppr loc1,
906 ptext SLIT("and") <+> ppr loc2]
909 = sep [ptext SLIT("Illegal deprecation when whole module is deprecated"),