2 % (c) The GRASP Project, Glasgow University, 1992-1998
4 \section[Rename]{Renaming and dependency analysis passes}
8 renameModule, renameStmt, renameRdrName,
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, mkIfaceGlobalRdrEnv,
37 unitAvailEnv, availEnvElts, availNames,
38 plusAvailEnv, groupAvails, warnUnusedImports,
39 warnUnusedLocalBinds, warnUnusedModules,
40 lookupSrcName, getImplicitStmtFVs,
41 getImplicitModuleFVs, newGlobalName, unQualInScope,
42 ubiquitousNames, lookupOccRn
44 import Module ( Module, ModuleName, WhereFrom(..),
45 moduleNameUserString, moduleName,
48 import Name ( Name, nameModule )
51 import RdrName ( foldRdrEnv, isQual )
52 import PrelNames ( pRELUDE_Name )
53 import ErrUtils ( dumpIfSet, dumpIfSet_dyn, showPass,
54 printErrorsAndWarnings, errorsFound )
55 import Bag ( bagToList )
56 import FiniteMap ( FiniteMap, fmToList, emptyFM, lookupFM,
57 addToFM_C, elemFM, addToFM
59 import Maybes ( maybeToBool, catMaybes )
61 import IO ( openFile, IOMode(..) )
62 import HscTypes -- lots of it
63 import List ( partition, nub )
69 %*********************************************************
71 \subsection{The main wrappers}
73 %*********************************************************
76 renameModule :: DynFlags
77 -> HomeIfaceTable -> HomeSymbolTable
78 -> PersistentCompilerState
79 -> Module -> RdrNameHsModule
80 -> IO (PersistentCompilerState, PrintUnqualified,
81 Maybe (IsExported, ModIface, [RenamedHsDecl]))
82 -- Nothing => some error occurred in the renamer
84 renameModule dflags hit hst pcs this_module rdr_module
85 = renameSource dflags hit hst pcs this_module $
86 rename this_module rdr_module
90 renameStmt :: DynFlags
91 -> HomeIfaceTable -> HomeSymbolTable
92 -> PersistentCompilerState
93 -> Module -- current module
95 -> RdrNameStmt -- parsed stmt
96 -> IO ( PersistentCompilerState,
98 Maybe ([Name], (RenamedStmt, [RenamedHsDecl]))
101 renameStmt dflags hit hst pcs this_module ic stmt
102 = renameSource dflags hit hst pcs this_module $
103 extendTypeEnvRn (ic_type_env ic) $
105 -- load the context module
106 loadContextModule (ic_module ic) $ \ (rdr_env, print_unqual) ->
109 initRnMS rdr_env emptyAvailEnv (ic_rn_env ic) emptyLocalFixityEnv CmdLineMode (
110 rnStmt stmt $ \ stmt' ->
111 returnRn (([], stmt'), emptyFVs)
112 ) `thenRn` \ ((binders, stmt), fvs) ->
114 -- Bale out if we fail
115 checkErrsRn `thenRn` \ no_errs_so_far ->
116 if not no_errs_so_far then
117 doDump dflags [] stmt [] `thenRn_` returnRn (print_unqual, Nothing)
120 -- Add implicit free vars, and close decls
121 getImplicitStmtFVs `thenRn` \ implicit_fvs ->
122 slurpImpDecls (fvs `plusFV` implicit_fvs) `thenRn` \ decls ->
123 -- NB: an earlier version deleted (rdrEnvElts local_env) from
124 -- the fvs. But (a) that isn't necessary, because previously
125 -- bound things in the local_env will be in the TypeEnv, and
126 -- the renamer doesn't re-slurp such things, and
127 -- (b) it's WRONG to delete them. Consider in GHCi:
128 -- Mod> let x = e :: T
129 -- Mod> let y = x + 3
130 -- We need to pass 'x' among the fvs to slurpImpDecls, so that
131 -- the latter can see that T is a gate, and hence import the Num T
132 -- instance decl. (See the InTypEnv case in RnIfaces.slurpSourceRefs.)
134 doDump dflags binders stmt decls `thenRn_`
135 returnRn (print_unqual, Just (binders, (stmt, decls)))
138 doDump :: DynFlags -> [Name] -> RenamedStmt -> [RenamedHsDecl]
139 -> RnMG (Either IOError ())
140 doDump dflags bndrs stmt decls
141 = ioToRnM (dumpIfSet_dyn dflags Opt_D_dump_rn "Renamer:"
142 (vcat [text "Binders:" <+> ppr bndrs,
144 vcat (map ppr decls)]))
149 -> HomeIfaceTable -> HomeSymbolTable
150 -> PersistentCompilerState
151 -> Module -- current module
152 -> InteractiveContext
153 -> [RdrName] -- name to rename
154 -> IO ( PersistentCompilerState,
156 Maybe ([Name], [RenamedHsDecl])
159 renameRdrName dflags hit hst pcs this_module ic rdr_names =
160 renameSource dflags hit hst pcs this_module $
161 extendTypeEnvRn (ic_type_env ic) $
162 loadContextModule (ic_module ic) $ \ (rdr_env, print_unqual) ->
164 -- rename the rdr_name
165 initRnMS rdr_env emptyAvailEnv (ic_rn_env ic) emptyLocalFixityEnv CmdLineMode
166 (mapRn (tryRn.lookupOccRn) rdr_names) `thenRn` \ maybe_names ->
168 ok_names = [ a | Right a <- maybe_names ]
171 then let errs = head [ e | Left e <- maybe_names ]
172 in setErrsRn errs `thenRn_`
173 doDump dflags ok_names [] `thenRn_`
174 returnRn (print_unqual, Nothing)
177 slurpImpDecls (mkNameSet ok_names) `thenRn` \ decls ->
179 doDump dflags ok_names decls `thenRn_`
180 returnRn (print_unqual, Just (ok_names, decls))
182 doDump :: DynFlags -> [Name] -> [RenamedHsDecl] -> RnMG (Either IOError ())
183 doDump dflags names decls
184 = ioToRnM (dumpIfSet_dyn dflags Opt_D_dump_rn "Renamer:"
185 (vcat [ppr names, text "",
186 vcat (map ppr decls)]))
189 -- Load the interface for the context module, so
190 -- that we can get its top-level lexical environment
191 -- Bale out if we fail to do this
192 loadContextModule scope_module thing_inside
193 = let doc = text "context for compiling expression"
195 loadInterface doc (moduleName scope_module) ImportByUser `thenRn` \ iface ->
197 -- If this is a module we previously compiled, then mi_globals will
198 -- have its top-level environment. If it is an imported module, then
199 -- we must invent a top-level environment from its exports.
200 let rdr_env | Just env <- mi_globals iface = env
201 | otherwise = mkIfaceGlobalRdrEnv (mi_exports iface)
203 print_unqual = unQualInScope rdr_env
205 checkErrsRn `thenRn` \ no_errs_so_far ->
206 if not no_errs_so_far then
207 returnRn (print_unqual, Nothing)
209 thing_inside (rdr_env, print_unqual)
212 %*********************************************************
214 \subsection{The main function: rename}
216 %*********************************************************
219 renameSource :: DynFlags
220 -> HomeIfaceTable -> HomeSymbolTable
221 -> PersistentCompilerState
223 -> RnMG (PrintUnqualified, Maybe r)
224 -> IO (PersistentCompilerState, PrintUnqualified, Maybe r)
225 -- Nothing => some error occurred in the renamer
227 renameSource dflags hit hst old_pcs this_module thing_inside
228 = do { showPass dflags "Renamer"
230 -- Initialise the renamer monad
231 ; (new_pcs, msgs, (print_unqual, maybe_rn_stuff))
232 <- initRn dflags hit hst old_pcs this_module thing_inside
234 -- Print errors from renaming
235 ; printErrorsAndWarnings print_unqual msgs ;
237 -- Return results. No harm in updating the PCS
238 ; if errorsFound msgs then
239 return (new_pcs, print_unqual, Nothing)
241 return (new_pcs, print_unqual, maybe_rn_stuff)
246 rename :: Module -> RdrNameHsModule
247 -> RnMG (PrintUnqualified, Maybe (IsExported, ModIface, [RenamedHsDecl]))
248 rename this_module contents@(HsModule _ _ exports imports local_decls mod_deprec loc)
251 -- FIND THE GLOBAL NAME ENVIRONMENT
252 getGlobalNames this_module contents `thenRn` \ (gbl_env, local_gbl_env,
253 (mod_avail_env, global_avail_env)) ->
255 print_unqualified = unQualInScope gbl_env
257 full_avail_env :: NameEnv AvailInfo
258 -- The domain of global_avail_env is just the 'major' things;
259 -- variables, type constructors, classes.
260 -- E.g. Functor |-> Functor( Functor, fmap )
261 -- The domain of full_avail_env is everything in scope
262 -- E.g. Functor |-> Functor( Functor, fmap )
263 -- fmap |-> Functor( Functor, fmap )
265 -- This filled-out avail_env is needed to generate
266 -- exports (mkExportAvails), and for generating minimal
267 -- exports (reportUnusedNames)
268 full_avail_env = mkNameEnv [ (name,avail)
269 | avail <- availEnvElts global_avail_env,
270 name <- availNames avail]
272 -- Exit if we've found any errors
273 checkErrsRn `thenRn` \ no_errs_so_far ->
274 if not no_errs_so_far then
275 -- Found errors already, so exit now
276 rnDump [] [] `thenRn_`
277 returnRn (print_unqualified, Nothing)
280 -- PROCESS EXPORT LIST
281 exportsFromAvail mod_name exports mod_avail_env
282 full_avail_env gbl_env `thenRn` \ export_avails ->
284 traceRn (text "Local top-level environment" $$
285 nest 4 (pprGlobalRdrEnv local_gbl_env)) `thenRn_`
287 -- DEAL WITH DEPRECATIONS
288 rnDeprecs local_gbl_env mod_deprec
289 [d | DeprecD d <- local_decls] `thenRn` \ my_deprecs ->
291 -- DEAL WITH LOCAL FIXITIES
292 fixitiesFromLocalDecls local_gbl_env local_decls `thenRn` \ local_fixity_env ->
295 rnSourceDecls gbl_env global_avail_env
296 local_fixity_env local_decls `thenRn` \ (rn_local_decls, source_fvs) ->
298 -- EXIT IF ERRORS FOUND
299 -- We exit here if there are any errors in the source, *before*
300 -- we attempt to slurp the decls from the interfaces, otherwise
301 -- the slurped decls may get lost when we return up the stack
302 -- to hscMain/hscExpr.
303 checkErrsRn `thenRn` \ no_errs_so_far ->
304 if not no_errs_so_far then
305 -- Found errors already, so exit now
306 rnDump [] rn_local_decls `thenRn_`
307 returnRn (print_unqualified, Nothing)
310 -- SLURP IN ALL THE NEEDED DECLARATIONS
311 -- Find out what re-bindable names to use for desugaring
312 getImplicitModuleFVs mod_name rn_local_decls `thenRn` \ implicit_fvs ->
314 export_fvs = availsToNameSet export_avails
315 source_fvs2 = source_fvs `plusFV` export_fvs
316 -- The export_fvs make the exported names look just as if they
317 -- occurred in the source program. For the reasoning, see the
318 -- comments with RnIfaces.mkImportInfo
319 -- It also helps reportUnusedNames, which of course must not complain
320 -- that 'f' isn't mentioned if it is mentioned in the export list
322 source_fvs3 = implicit_fvs `plusFV` source_fvs2
323 -- It's important to do the "plus" this way round, so that
324 -- when compiling the prelude, locally-defined (), Bool, etc
325 -- override the implicit ones.
328 traceRn (text "Source FVs:" <+> fsep (map ppr (nameSetToList source_fvs3))) `thenRn_`
329 slurpImpDecls source_fvs3 `thenRn` \ rn_imp_decls ->
330 rnDump rn_imp_decls rn_local_decls `thenRn_`
332 -- GENERATE THE VERSION/USAGE INFO
333 mkImportInfo mod_name imports `thenRn` \ my_usages ->
335 -- BUILD THE MODULE INTERFACE
337 -- We record fixities even for things that aren't exported,
338 -- so that we can change into the context of this moodule easily
339 fixities = mkNameEnv [ (name, fixity)
340 | FixitySig name fixity loc <- nameEnvElts local_fixity_env
343 -- Sort the exports to make them easier to compare for versions
344 my_exports = groupAvails this_module export_avails
346 final_decls = rn_local_decls ++ rn_imp_decls
348 mod_iface = ModIface { mi_module = this_module,
349 mi_version = initialVersionInfo,
350 mi_usages = my_usages,
352 mi_orphan = panic "is_orphan",
353 mi_exports = my_exports,
354 mi_globals = Just gbl_env,
355 mi_fixities = fixities,
356 mi_deprecs = my_deprecs,
357 mi_decls = panic "mi_decls"
360 is_exported name = name `elemNameSet` exported_names
361 exported_names = availsToNameSet export_avails
364 -- REPORT UNUSED NAMES, AND DEBUG DUMP
365 reportUnusedNames mod_iface print_unqualified
366 imports full_avail_env gbl_env
367 source_fvs2 rn_imp_decls `thenRn_`
368 -- NB: source_fvs2: include exports (else we get bogus
369 -- warnings of unused things) but not implicit FVs.
371 returnRn (print_unqualified, Just (is_exported, mod_iface, final_decls))
373 mod_name = moduleName this_module
378 %*********************************************************
380 \subsection{Fixities}
382 %*********************************************************
385 fixitiesFromLocalDecls :: GlobalRdrEnv -> [RdrNameHsDecl] -> RnMG LocalFixityEnv
386 fixitiesFromLocalDecls gbl_env decls
387 = foldlRn getFixities emptyNameEnv decls `thenRn` \ env ->
388 traceRn (text "fixity env" <+> vcat (map ppr (nameEnvElts env))) `thenRn_`
391 getFixities :: LocalFixityEnv -> RdrNameHsDecl -> RnMG LocalFixityEnv
392 getFixities acc (FixD fix)
395 getFixities acc (TyClD (ClassDecl { tcdSigs = sigs}))
396 = foldlRn fix_decl acc [sig | FixSig sig <- sigs]
397 -- Get fixities from class decl sigs too.
398 getFixities acc other_decl
401 fix_decl acc sig@(FixitySig rdr_name fixity loc)
402 = -- Check for fixity decl for something not declared
404 lookupSrcName gbl_env rdr_name `thenRn` \ name ->
406 -- Check for duplicate fixity decl
407 case lookupNameEnv acc name of
408 Just (FixitySig _ _ loc') -> addErrRn (dupFixityDecl rdr_name loc loc') `thenRn_`
411 Nothing -> returnRn (extendNameEnv acc name (FixitySig name fixity loc))
415 %*********************************************************
417 \subsection{Deprecations}
419 %*********************************************************
421 For deprecations, all we do is check that the names are in scope.
422 It's only imported deprecations, dealt with in RnIfaces, that we
423 gather them together.
426 rnDeprecs :: GlobalRdrEnv -> Maybe DeprecTxt
427 -> [RdrNameDeprecation] -> RnMG Deprecations
428 rnDeprecs gbl_env Nothing []
431 rnDeprecs gbl_env (Just txt) decls
432 = mapRn (addErrRn . badDeprec) decls `thenRn_`
433 returnRn (DeprecAll txt)
435 rnDeprecs gbl_env Nothing decls
436 = mapRn rn_deprec decls `thenRn` \ pairs ->
437 returnRn (DeprecSome (mkNameEnv (catMaybes pairs)))
439 rn_deprec (Deprecation rdr_name txt loc)
441 lookupSrcName gbl_env rdr_name `thenRn` \ name ->
442 returnRn (Just (name, (name,txt)))
446 %************************************************************************
448 \subsection{Grabbing the old interface file and checking versions}
450 %************************************************************************
453 checkOldIface :: GhciMode
455 -> HomeIfaceTable -> HomeSymbolTable
456 -> PersistentCompilerState
458 -> Bool -- Source unchanged
459 -> Maybe ModIface -- Old interface from compilation manager, if any
460 -> IO (PersistentCompilerState, Bool, (RecompileRequired, Maybe ModIface))
461 -- True <=> errors happened
463 checkOldIface ghci_mode dflags hit hst pcs iface_path source_unchanged maybe_iface
464 = runRn dflags hit hst pcs (panic "Bogus module") $
466 -- CHECK WHETHER THE SOURCE HAS CHANGED
467 ( if not source_unchanged then
468 traceHiDiffsRn (nest 4 (text "Source file changed or recompilation check turned off"))
469 else returnRn () ) `thenRn_`
471 -- If the source has changed and we're in interactive mode, avoid reading
472 -- an interface; just return the one we might have been supplied with.
473 if ghci_mode == Interactive && not source_unchanged then
474 returnRn (outOfDate, maybe_iface)
478 Just old_iface -> -- Use the one we already have
479 setModuleRn (mi_module old_iface) (check_versions old_iface)
481 Nothing -- try and read it from a file
482 -> readIface iface_path `thenRn` \ read_result ->
484 Left err -> -- Old interface file not found, or garbled; give up
486 text "Cannot read old interface file:"
487 $$ nest 4 err) `thenRn_`
488 returnRn (outOfDate, Nothing)
491 -> setModuleRn (pi_mod parsed_iface) $
492 loadOldIface parsed_iface `thenRn` \ m_iface ->
493 check_versions m_iface
495 check_versions :: ModIface -> RnMG (RecompileRequired, Maybe ModIface)
497 | not source_unchanged
498 = returnRn (outOfDate, Just iface)
501 recompileRequired iface_path iface `thenRn` \ recompile ->
502 returnRn (recompile, Just iface)
505 I think the following function should now have a more representative name,
509 loadOldIface :: ParsedIface -> RnMG ModIface
511 loadOldIface parsed_iface
512 = let iface = parsed_iface
516 loadHomeDecls (pi_decls iface) `thenRn` \ decls ->
517 loadHomeRules (pi_rules iface) `thenRn` \ rules ->
518 loadHomeInsts (pi_insts iface) `thenRn` \ insts ->
519 returnRn (decls, rules, insts)
521 `thenRn` \ ((decls_vers, new_decls), (rule_vers, new_rules), new_insts) ->
523 mapRn loadHomeUsage (pi_usages iface) `thenRn` \ usages ->
524 loadExports (pi_exports iface) `thenRn` \ (export_vers, avails) ->
525 loadFixDecls mod (pi_fixity iface) `thenRn` \ fix_env ->
526 loadDeprecs mod (pi_deprecs iface) `thenRn` \ deprec_env ->
528 version = VersionInfo { vers_module = pi_vers iface,
529 vers_exports = export_vers,
530 vers_rules = rule_vers,
531 vers_decls = decls_vers }
533 decls = mkIfaceDecls new_decls new_rules new_insts
535 mod_iface = ModIface { mi_module = mod, mi_version = version,
536 mi_exports = avails, mi_usages = usages,
537 mi_boot = False, mi_orphan = pi_orphan iface,
538 mi_fixities = fix_env, mi_deprecs = deprec_env,
547 loadHomeDecls :: [(Version, RdrNameTyClDecl)]
548 -> RnMS (NameEnv Version, [RenamedTyClDecl])
549 loadHomeDecls decls = foldlRn loadHomeDecl (emptyNameEnv, []) decls
551 loadHomeDecl :: (NameEnv Version, [RenamedTyClDecl])
552 -> (Version, RdrNameTyClDecl)
553 -> RnMS (NameEnv Version, [RenamedTyClDecl])
554 loadHomeDecl (version_map, decls) (version, decl)
555 = rnTyClDecl decl `thenRn` \ decl' ->
556 returnRn (extendNameEnv version_map (tyClDeclName decl') version, decl':decls)
559 loadHomeRules :: (Version, [RdrNameRuleDecl])
560 -> RnMS (Version, [RenamedRuleDecl])
561 loadHomeRules (version, rules)
562 = mapRn rnIfaceRuleDecl rules `thenRn` \ rules' ->
563 returnRn (version, rules')
566 loadHomeInsts :: [RdrNameInstDecl]
567 -> RnMS [RenamedInstDecl]
568 loadHomeInsts insts = mapRn rnInstDecl insts
571 loadHomeUsage :: ImportVersion OccName
572 -> RnMG (ImportVersion Name)
573 loadHomeUsage (mod_name, orphans, is_boot, whats_imported)
574 = rn_imps whats_imported `thenRn` \ whats_imported' ->
575 returnRn (mod_name, orphans, is_boot, whats_imported')
577 rn_imps NothingAtAll = returnRn NothingAtAll
578 rn_imps (Everything v) = returnRn (Everything v)
579 rn_imps (Specifically mv ev items rv) = mapRn rn_imp items `thenRn` \ items' ->
580 returnRn (Specifically mv ev items' rv)
581 rn_imp (occ,vers) = newGlobalName mod_name occ `thenRn` \ name ->
587 %*********************************************************
589 \subsection{Closing up the interface decls}
591 %*********************************************************
593 Suppose we discover we don't need to recompile. Then we start from the
594 IfaceDecls in the ModIface, and fluff them up by sucking in all the decls they need.
597 closeIfaceDecls :: DynFlags
598 -> HomeIfaceTable -> HomeSymbolTable
599 -> PersistentCompilerState
600 -> ModIface -- Get the decls from here
601 -> IO (PersistentCompilerState, Bool, [RenamedHsDecl])
602 -- True <=> errors happened
603 closeIfaceDecls dflags hit hst pcs
604 mod_iface@(ModIface { mi_module = mod, mi_decls = iface_decls })
605 = runRn dflags hit hst pcs mod $
608 rule_decls = dcl_rules iface_decls
609 inst_decls = dcl_insts iface_decls
610 tycl_decls = dcl_tycl iface_decls
611 decls = map RuleD rule_decls ++
612 map InstD inst_decls ++
614 needed = unionManyNameSets (map ruleDeclFVs rule_decls) `unionNameSets`
615 unionManyNameSets (map instDeclFVs inst_decls) `unionNameSets`
616 unionManyNameSets (map tyClDeclFVs tycl_decls)
617 local_names = foldl add emptyNameSet tycl_decls
618 add names decl = addListToNameSet names (map fst (tyClDeclSysNames decl ++ tyClDeclNames decl))
621 recordLocalSlurps local_names `thenRn_`
623 -- Do the transitive closure
624 closeDecls decls (needed `plusFV` implicit_fvs) `thenRn` \closed_decls ->
625 rnDump [] closed_decls `thenRn_`
626 returnRn closed_decls
628 implicit_fvs = ubiquitousNames -- Data type decls with record selectors,
629 -- which may appear in the decls, need unpackCString
630 -- and friends. It's easier to just grab them right now.
633 %*********************************************************
635 \subsection{Unused names}
637 %*********************************************************
640 reportUnusedNames :: ModIface -> PrintUnqualified
641 -> [RdrNameImportDecl]
644 -> NameSet -- Used in this module
647 reportUnusedNames my_mod_iface unqual imports avail_env gbl_env
648 used_names imported_decls
649 = warnUnusedModules unused_imp_mods `thenRn_`
650 warnUnusedLocalBinds bad_locals `thenRn_`
651 warnUnusedImports bad_imp_names `thenRn_`
652 printMinimalImports this_mod unqual minimal_imports
654 this_mod = mi_module my_mod_iface
656 -- Now, a use of C implies a use of T,
657 -- if C was brought into scope by T(..) or T(C)
658 really_used_names = used_names `unionNameSets`
659 mkNameSet [ parent_name
660 | sub_name <- nameSetToList used_names
662 -- Usually, every used name will appear in avail_env, but there
663 -- is one time when it doesn't: tuples and other built in syntax. When you
664 -- write (a,b) that gives rise to a *use* of "(,)", so that the
665 -- instances will get pulled in, but the tycon "(,)" isn't actually
666 -- in scope. Also, (-x) gives rise to an implicit use of 'negate';
667 -- similarly, 3.5 gives rise to an implcit use of :%
668 -- Hence the silent 'False' in all other cases
670 , Just parent_name <- [case lookupNameEnv avail_env sub_name of
671 Just (AvailTC n _) -> Just n
675 -- Collect the defined names from the in-scope environment
676 -- Look for the qualified ones only, else get duplicates
677 defined_names :: [GlobalRdrElt]
678 defined_names = foldRdrEnv add [] gbl_env
679 add rdr_name ns acc | isQual rdr_name = ns ++ acc
682 defined_and_used, defined_but_not_used :: [GlobalRdrElt]
683 (defined_and_used, defined_but_not_used) = partition used defined_names
684 used (GRE name _ _) = name `elemNameSet` really_used_names
686 -- Filter out the ones only defined implicitly
688 bad_locals = [n | (GRE n LocalDef _) <- defined_but_not_used]
690 bad_imp_names :: [(Name,Provenance)]
691 bad_imp_names = [(n,p) | GRE n p@(NonLocalDef (UserImport mod _ True)) _ <- defined_but_not_used,
692 not (module_unused mod)]
694 -- inst_mods are directly-imported modules that
695 -- contain instance decl(s) that the renamer decided to suck in
696 -- It's not necessarily redundant to import such modules.
702 -- The import M() is not *necessarily* redundant, even if
703 -- we suck in no instance decls from M (e.g. it contains
704 -- no instance decls, or This contains no code). It may be
705 -- that we import M solely to ensure that M's orphan instance
706 -- decls (or those in its imports) are visible to people who
707 -- import This. Sigh.
708 -- There's really no good way to detect this, so the error message
709 -- in RnEnv.warnUnusedModules is weakened instead
710 inst_mods :: [ModuleName]
711 inst_mods = [m | InstD (InstDecl _ _ _ (Just dfun) _) <- imported_decls,
712 let m = moduleName (nameModule dfun),
713 m `elem` direct_import_mods
716 -- To figure out the minimal set of imports, start with the things
717 -- that are in scope (i.e. in gbl_env). Then just combine them
718 -- into a bunch of avails, so they are properly grouped
719 minimal_imports :: FiniteMap ModuleName AvailEnv
720 minimal_imports0 = emptyFM
721 minimal_imports1 = foldr add_name minimal_imports0 defined_and_used
722 minimal_imports = foldr add_inst_mod minimal_imports1 inst_mods
724 -- We've carefully preserved the provenance so that we can
725 -- construct minimal imports that import the name by (one of)
726 -- the same route(s) as the programmer originally did.
727 add_name (GRE n (NonLocalDef (UserImport m _ _)) _) acc = addToFM_C plusAvailEnv acc (moduleName m)
728 (unitAvailEnv (mk_avail n))
729 add_name (GRE n other_prov _) acc = acc
731 mk_avail n = case lookupNameEnv avail_env n of
732 Just (AvailTC m _) | n==m -> AvailTC n [n]
733 | otherwise -> AvailTC m [n,m]
734 Just avail -> Avail n
735 Nothing -> pprPanic "mk_avail" (ppr n)
738 | m `elemFM` acc = acc -- We import something already
739 | otherwise = addToFM acc m emptyAvailEnv
740 -- Add an empty collection of imports for a module
741 -- from which we have sucked only instance decls
743 direct_import_mods :: [ModuleName]
744 direct_import_mods = nub [m | ImportDecl m _ _ _ _ _ <- imports]
746 -- unused_imp_mods are the directly-imported modules
747 -- that are not mentioned in minimal_imports
748 unused_imp_mods = [m | m <- direct_import_mods,
749 not (maybeToBool (lookupFM minimal_imports m)),
752 module_unused :: Module -> Bool
753 module_unused mod = moduleName mod `elem` unused_imp_mods
756 -- ToDo: deal with original imports with 'qualified' and 'as M' clauses
757 printMinimalImports :: Module -- This module
759 -> FiniteMap ModuleName AvailEnv -- Minimal imports
761 printMinimalImports this_mod unqual imps
762 = ifOptRn Opt_D_dump_minimal_imports $
764 mapRn to_ies (fmToList imps) `thenRn` \ mod_ies ->
765 ioToRnM (do { h <- openFile filename WriteMode ;
766 printForUser h unqual (vcat (map ppr_mod_ie mod_ies))
770 filename = moduleNameUserString (moduleName this_mod) ++ ".imports"
771 ppr_mod_ie (mod_name, ies)
772 | mod_name == pRELUDE_Name
775 = ptext SLIT("import") <+> ppr mod_name <>
776 parens (fsep (punctuate comma (map ppr ies)))
778 to_ies (mod, avail_env) = mapRn to_ie (availEnvElts avail_env) `thenRn` \ ies ->
781 to_ie :: AvailInfo -> RnMG (IE Name)
782 -- The main trick here is that if we're importing all the constructors
783 -- we want to say "T(..)", but if we're importing only a subset we want
784 -- to say "T(A,B,C)". So we have to find out what the module exports.
785 to_ie (Avail n) = returnRn (IEVar n)
786 to_ie (AvailTC n [m]) = ASSERT( n==m )
787 returnRn (IEThingAbs n)
789 = loadInterface (text "Compute minimal imports from" <+> ppr n_mod)
790 n_mod ImportBySystem `thenRn` \ iface ->
791 case [xs | (m,as) <- mi_exports iface,
795 [xs] | all (`elem` ns) xs -> returnRn (IEThingAll n)
796 | otherwise -> returnRn (IEThingWith n (filter (/= n) ns))
797 other -> pprTrace "to_ie" (ppr n <+> ppr (nameModule n) <+> ppr other) $
800 n_mod = moduleName (nameModule n)
802 rnDump :: [RenamedHsDecl] -- Renamed imported decls
803 -> [RenamedHsDecl] -- Renamed local decls
805 rnDump imp_decls local_decls
806 = doptRn Opt_D_dump_rn_trace `thenRn` \ dump_rn_trace ->
807 doptRn Opt_D_dump_rn_stats `thenRn` \ dump_rn_stats ->
808 doptRn Opt_D_dump_rn `thenRn` \ dump_rn ->
809 getIfacesRn `thenRn` \ ifaces ->
811 ioToRnM (do { dumpIfSet (dump_rn_trace || dump_rn_stats || dump_rn)
813 (getRnStats imp_decls ifaces) ;
815 dumpIfSet dump_rn "Renamer:"
816 (vcat (map ppr (local_decls ++ imp_decls)))
823 %*********************************************************
825 \subsection{Statistics}
827 %*********************************************************
830 getRnStats :: [RenamedHsDecl] -> Ifaces -> SDoc
831 getRnStats imported_decls ifaces
832 = hcat [text "Renamer stats: ", stats]
834 n_mods = length [() | _ <- moduleEnvElts (iPIT ifaces)]
835 -- This is really only right for a one-shot compile
837 (decls_map, n_decls_slurped) = iDecls ifaces
839 n_decls_left = length [decl | (avail, True, (_,decl)) <- nameEnvElts decls_map
840 -- Data, newtype, and class decls are in the decls_fm
841 -- under multiple names; the tycon/class, and each
842 -- constructor/class op too.
843 -- The 'True' selects just the 'main' decl
846 (insts_left, n_insts_slurped) = iInsts ifaces
847 n_insts_left = length (bagToList insts_left)
849 (rules_left, n_rules_slurped) = iRules ifaces
850 n_rules_left = length (bagToList rules_left)
853 [int n_mods <+> text "interfaces read",
854 hsep [ int n_decls_slurped, text "type/class/variable imported, out of",
855 int (n_decls_slurped + n_decls_left), text "read"],
856 hsep [ int n_insts_slurped, text "instance decls imported, out of",
857 int (n_insts_slurped + n_insts_left), text "read"],
858 hsep [ int n_rules_slurped, text "rule decls imported, out of",
859 int (n_rules_slurped + n_rules_left), text "read"]
864 %************************************************************************
866 \subsection{Errors and warnings}
868 %************************************************************************
871 dupFixityDecl rdr_name loc1 loc2
872 = vcat [ptext SLIT("Multiple fixity declarations for") <+> quotes (ppr rdr_name),
873 ptext SLIT("at ") <+> ppr loc1,
874 ptext SLIT("and") <+> ppr loc2]
877 = sep [ptext SLIT("Illegal deprecation when whole module is deprecated"),