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 ->
196 let rdr_env = mi_globals iface
197 print_unqual = unQualInScope rdr_env
199 checkErrsRn `thenRn` \ no_errs_so_far ->
200 if not no_errs_so_far then
201 returnRn (print_unqual, Nothing)
203 thing_inside (rdr_env, print_unqual)
206 %*********************************************************
208 \subsection{The main function: rename}
210 %*********************************************************
213 renameSource :: DynFlags
214 -> HomeIfaceTable -> HomeSymbolTable
215 -> PersistentCompilerState
217 -> RnMG (PrintUnqualified, Maybe r)
218 -> IO (PersistentCompilerState, PrintUnqualified, Maybe r)
219 -- Nothing => some error occurred in the renamer
221 renameSource dflags hit hst old_pcs this_module thing_inside
222 = do { showPass dflags "Renamer"
224 -- Initialise the renamer monad
225 ; (new_pcs, msgs, (print_unqual, maybe_rn_stuff))
226 <- initRn dflags hit hst old_pcs this_module thing_inside
228 -- Print errors from renaming
229 ; printErrorsAndWarnings print_unqual msgs ;
231 -- Return results. No harm in updating the PCS
232 ; if errorsFound msgs then
233 return (new_pcs, print_unqual, Nothing)
235 return (new_pcs, print_unqual, maybe_rn_stuff)
240 rename :: Module -> RdrNameHsModule
241 -> RnMG (PrintUnqualified, Maybe (IsExported, ModIface, [RenamedHsDecl]))
242 rename this_module contents@(HsModule _ _ exports imports local_decls mod_deprec loc)
245 -- FIND THE GLOBAL NAME ENVIRONMENT
246 getGlobalNames this_module contents `thenRn` \ (gbl_env, local_gbl_env,
247 (mod_avail_env, global_avail_env)) ->
249 print_unqualified = unQualInScope gbl_env
251 full_avail_env :: NameEnv AvailInfo
252 -- The domain of global_avail_env is just the 'major' things;
253 -- variables, type constructors, classes.
254 -- E.g. Functor |-> Functor( Functor, fmap )
255 -- The domain of full_avail_env is everything in scope
256 -- E.g. Functor |-> Functor( Functor, fmap )
257 -- fmap |-> Functor( Functor, fmap )
259 -- This filled-out avail_env is needed to generate
260 -- exports (mkExportAvails), and for generating minimal
261 -- exports (reportUnusedNames)
262 full_avail_env = mkNameEnv [ (name,avail)
263 | avail <- availEnvElts global_avail_env,
264 name <- availNames avail]
266 -- Exit if we've found any errors
267 checkErrsRn `thenRn` \ no_errs_so_far ->
268 if not no_errs_so_far then
269 -- Found errors already, so exit now
270 rnDump [] [] `thenRn_`
271 returnRn (print_unqualified, Nothing)
274 -- PROCESS EXPORT LIST
275 exportsFromAvail mod_name exports mod_avail_env
276 full_avail_env gbl_env `thenRn` \ export_avails ->
278 traceRn (text "Local top-level environment" $$
279 nest 4 (pprGlobalRdrEnv local_gbl_env)) `thenRn_`
281 -- DEAL WITH DEPRECATIONS
282 rnDeprecs local_gbl_env mod_deprec
283 [d | DeprecD d <- local_decls] `thenRn` \ my_deprecs ->
285 -- DEAL WITH LOCAL FIXITIES
286 fixitiesFromLocalDecls local_gbl_env local_decls `thenRn` \ local_fixity_env ->
289 rnSourceDecls gbl_env global_avail_env
290 local_fixity_env local_decls `thenRn` \ (rn_local_decls, source_fvs) ->
292 -- EXIT IF ERRORS FOUND
293 -- We exit here if there are any errors in the source, *before*
294 -- we attempt to slurp the decls from the interfaces, otherwise
295 -- the slurped decls may get lost when we return up the stack
296 -- to hscMain/hscExpr.
297 checkErrsRn `thenRn` \ no_errs_so_far ->
298 if not no_errs_so_far then
299 -- Found errors already, so exit now
300 rnDump [] rn_local_decls `thenRn_`
301 returnRn (print_unqualified, Nothing)
304 -- SLURP IN ALL THE NEEDED DECLARATIONS
305 -- Find out what re-bindable names to use for desugaring
306 getImplicitModuleFVs mod_name rn_local_decls `thenRn` \ implicit_fvs ->
308 export_fvs = availsToNameSet export_avails
309 source_fvs2 = source_fvs `plusFV` export_fvs
310 -- The export_fvs make the exported names look just as if they
311 -- occurred in the source program. For the reasoning, see the
312 -- comments with RnIfaces.mkImportInfo
313 -- It also helps reportUnusedNames, which of course must not complain
314 -- that 'f' isn't mentioned if it is mentioned in the export list
316 source_fvs3 = implicit_fvs `plusFV` source_fvs2
317 -- It's important to do the "plus" this way round, so that
318 -- when compiling the prelude, locally-defined (), Bool, etc
319 -- override the implicit ones.
322 traceRn (text "Source FVs:" <+> fsep (map ppr (nameSetToList source_fvs3))) `thenRn_`
323 slurpImpDecls source_fvs3 `thenRn` \ rn_imp_decls ->
324 rnDump rn_imp_decls rn_local_decls `thenRn_`
326 -- GENERATE THE VERSION/USAGE INFO
327 mkImportInfo mod_name imports `thenRn` \ my_usages ->
329 -- BUILD THE MODULE INTERFACE
331 -- We record fixities even for things that aren't exported,
332 -- so that we can change into the context of this moodule easily
333 fixities = mkNameEnv [ (name, fixity)
334 | FixitySig name fixity loc <- nameEnvElts local_fixity_env
337 -- Sort the exports to make them easier to compare for versions
338 my_exports = groupAvails this_module export_avails
340 final_decls = rn_local_decls ++ rn_imp_decls
342 mod_iface = ModIface { mi_module = this_module,
343 mi_version = initialVersionInfo,
344 mi_usages = my_usages,
346 mi_orphan = panic "is_orphan",
347 mi_exports = my_exports,
348 mi_globals = gbl_env,
349 mi_fixities = fixities,
350 mi_deprecs = my_deprecs,
351 mi_decls = panic "mi_decls"
354 is_exported name = name `elemNameSet` exported_names
355 exported_names = availsToNameSet export_avails
358 -- REPORT UNUSED NAMES, AND DEBUG DUMP
359 reportUnusedNames mod_iface print_unqualified
360 imports full_avail_env
361 source_fvs2 rn_imp_decls `thenRn_`
362 -- NB: source_fvs2: include exports (else we get bogus
363 -- warnings of unused things) but not implicit FVs.
365 returnRn (print_unqualified, Just (is_exported, mod_iface, final_decls))
367 mod_name = moduleName this_module
372 %*********************************************************
374 \subsection{Fixities}
376 %*********************************************************
379 fixitiesFromLocalDecls :: GlobalRdrEnv -> [RdrNameHsDecl] -> RnMG LocalFixityEnv
380 fixitiesFromLocalDecls gbl_env decls
381 = foldlRn getFixities emptyNameEnv decls `thenRn` \ env ->
382 traceRn (text "fixity env" <+> vcat (map ppr (nameEnvElts env))) `thenRn_`
385 getFixities :: LocalFixityEnv -> RdrNameHsDecl -> RnMG LocalFixityEnv
386 getFixities acc (FixD fix)
389 getFixities acc (TyClD (ClassDecl { tcdSigs = sigs}))
390 = foldlRn fix_decl acc [sig | FixSig sig <- sigs]
391 -- Get fixities from class decl sigs too.
392 getFixities acc other_decl
395 fix_decl acc sig@(FixitySig rdr_name fixity loc)
396 = -- Check for fixity decl for something not declared
398 lookupSrcName gbl_env rdr_name `thenRn` \ name ->
400 -- Check for duplicate fixity decl
401 case lookupNameEnv acc name of
402 Just (FixitySig _ _ loc') -> addErrRn (dupFixityDecl rdr_name loc loc') `thenRn_`
405 Nothing -> returnRn (extendNameEnv acc name (FixitySig name fixity loc))
409 %*********************************************************
411 \subsection{Deprecations}
413 %*********************************************************
415 For deprecations, all we do is check that the names are in scope.
416 It's only imported deprecations, dealt with in RnIfaces, that we
417 gather them together.
420 rnDeprecs :: GlobalRdrEnv -> Maybe DeprecTxt
421 -> [RdrNameDeprecation] -> RnMG Deprecations
422 rnDeprecs gbl_env Nothing []
425 rnDeprecs gbl_env (Just txt) decls
426 = mapRn (addErrRn . badDeprec) decls `thenRn_`
427 returnRn (DeprecAll txt)
429 rnDeprecs gbl_env Nothing decls
430 = mapRn rn_deprec decls `thenRn` \ pairs ->
431 returnRn (DeprecSome (mkNameEnv (catMaybes pairs)))
433 rn_deprec (Deprecation rdr_name txt loc)
435 lookupSrcName gbl_env rdr_name `thenRn` \ name ->
436 returnRn (Just (name, (name,txt)))
440 %************************************************************************
442 \subsection{Grabbing the old interface file and checking versions}
444 %************************************************************************
447 checkOldIface :: GhciMode
449 -> HomeIfaceTable -> HomeSymbolTable
450 -> PersistentCompilerState
452 -> Bool -- Source unchanged
453 -> Maybe ModIface -- Old interface from compilation manager, if any
454 -> IO (PersistentCompilerState, Bool, (RecompileRequired, Maybe ModIface))
455 -- True <=> errors happened
457 checkOldIface ghci_mode dflags hit hst pcs iface_path source_unchanged maybe_iface
458 = runRn dflags hit hst pcs (panic "Bogus module") $
460 -- CHECK WHETHER THE SOURCE HAS CHANGED
461 ( if not source_unchanged then
462 traceHiDiffsRn (nest 4 (text "Source file changed or recompilation check turned off"))
463 else returnRn () ) `thenRn_`
465 -- If the source has changed and we're in interactive mode, avoid reading
466 -- an interface; just return the one we might have been supplied with.
467 if ghci_mode == Interactive && not source_unchanged then
468 returnRn (outOfDate, maybe_iface)
472 Just old_iface -> -- Use the one we already have
473 setModuleRn (mi_module old_iface) (check_versions old_iface)
475 Nothing -- try and read it from a file
476 -> readIface iface_path `thenRn` \ read_result ->
478 Left err -> -- Old interface file not found, or garbled; give up
480 text "Cannot read old interface file:"
481 $$ nest 4 err) `thenRn_`
482 returnRn (outOfDate, Nothing)
485 -> setModuleRn (pi_mod parsed_iface) $
486 loadOldIface parsed_iface `thenRn` \ m_iface ->
487 check_versions m_iface
489 check_versions :: ModIface -> RnMG (RecompileRequired, Maybe ModIface)
491 | not source_unchanged
492 = returnRn (outOfDate, Just iface)
495 recompileRequired iface_path iface `thenRn` \ recompile ->
496 returnRn (recompile, Just iface)
499 I think the following function should now have a more representative name,
503 loadOldIface :: ParsedIface -> RnMG ModIface
505 loadOldIface parsed_iface
506 = let iface = parsed_iface
510 loadHomeDecls (pi_decls iface) `thenRn` \ decls ->
511 loadHomeRules (pi_rules iface) `thenRn` \ rules ->
512 loadHomeInsts (pi_insts iface) `thenRn` \ insts ->
513 returnRn (decls, rules, insts)
515 `thenRn` \ ((decls_vers, new_decls), (rule_vers, new_rules), new_insts) ->
517 mapRn loadHomeUsage (pi_usages iface) `thenRn` \ usages ->
518 loadExports (pi_exports iface) `thenRn` \ (export_vers, avails) ->
519 loadFixDecls mod (pi_fixity iface) `thenRn` \ fix_env ->
520 loadDeprecs mod (pi_deprecs iface) `thenRn` \ deprec_env ->
522 version = VersionInfo { vers_module = pi_vers iface,
523 vers_exports = export_vers,
524 vers_rules = rule_vers,
525 vers_decls = decls_vers }
527 decls = mkIfaceDecls new_decls new_rules new_insts
529 mod_iface = ModIface { mi_module = mod, mi_version = version,
530 mi_exports = avails, mi_usages = usages,
531 mi_boot = False, mi_orphan = pi_orphan iface,
532 mi_fixities = fix_env, mi_deprecs = deprec_env,
534 mi_globals = mkIfaceGlobalRdrEnv avails
541 loadHomeDecls :: [(Version, RdrNameTyClDecl)]
542 -> RnMS (NameEnv Version, [RenamedTyClDecl])
543 loadHomeDecls decls = foldlRn loadHomeDecl (emptyNameEnv, []) decls
545 loadHomeDecl :: (NameEnv Version, [RenamedTyClDecl])
546 -> (Version, RdrNameTyClDecl)
547 -> RnMS (NameEnv Version, [RenamedTyClDecl])
548 loadHomeDecl (version_map, decls) (version, decl)
549 = rnTyClDecl decl `thenRn` \ decl' ->
550 returnRn (extendNameEnv version_map (tyClDeclName decl') version, decl':decls)
553 loadHomeRules :: (Version, [RdrNameRuleDecl])
554 -> RnMS (Version, [RenamedRuleDecl])
555 loadHomeRules (version, rules)
556 = mapRn rnIfaceRuleDecl rules `thenRn` \ rules' ->
557 returnRn (version, rules')
560 loadHomeInsts :: [RdrNameInstDecl]
561 -> RnMS [RenamedInstDecl]
562 loadHomeInsts insts = mapRn rnInstDecl insts
565 loadHomeUsage :: ImportVersion OccName
566 -> RnMG (ImportVersion Name)
567 loadHomeUsage (mod_name, orphans, is_boot, whats_imported)
568 = rn_imps whats_imported `thenRn` \ whats_imported' ->
569 returnRn (mod_name, orphans, is_boot, whats_imported')
571 rn_imps NothingAtAll = returnRn NothingAtAll
572 rn_imps (Everything v) = returnRn (Everything v)
573 rn_imps (Specifically mv ev items rv) = mapRn rn_imp items `thenRn` \ items' ->
574 returnRn (Specifically mv ev items' rv)
575 rn_imp (occ,vers) = newGlobalName mod_name occ `thenRn` \ name ->
581 %*********************************************************
583 \subsection{Closing up the interface decls}
585 %*********************************************************
587 Suppose we discover we don't need to recompile. Then we start from the
588 IfaceDecls in the ModIface, and fluff them up by sucking in all the decls they need.
591 closeIfaceDecls :: DynFlags
592 -> HomeIfaceTable -> HomeSymbolTable
593 -> PersistentCompilerState
594 -> ModIface -- Get the decls from here
595 -> IO (PersistentCompilerState, Bool, [RenamedHsDecl])
596 -- True <=> errors happened
597 closeIfaceDecls dflags hit hst pcs
598 mod_iface@(ModIface { mi_module = mod, mi_decls = iface_decls })
599 = runRn dflags hit hst pcs mod $
602 rule_decls = dcl_rules iface_decls
603 inst_decls = dcl_insts iface_decls
604 tycl_decls = dcl_tycl iface_decls
605 decls = map RuleD rule_decls ++
606 map InstD inst_decls ++
608 needed = unionManyNameSets (map ruleDeclFVs rule_decls) `unionNameSets`
609 unionManyNameSets (map instDeclFVs inst_decls) `unionNameSets`
610 unionManyNameSets (map tyClDeclFVs tycl_decls)
611 local_names = foldl add emptyNameSet tycl_decls
612 add names decl = addListToNameSet names (map fst (tyClDeclSysNames decl ++ tyClDeclNames decl))
615 recordLocalSlurps local_names `thenRn_`
617 -- Do the transitive closure
618 closeDecls decls (needed `plusFV` implicit_fvs) `thenRn` \closed_decls ->
619 rnDump [] closed_decls `thenRn_`
620 returnRn closed_decls
622 implicit_fvs = ubiquitousNames -- Data type decls with record selectors,
623 -- which may appear in the decls, need unpackCString
624 -- and friends. It's easier to just grab them right now.
627 %*********************************************************
629 \subsection{Unused names}
631 %*********************************************************
634 reportUnusedNames :: ModIface -> PrintUnqualified
635 -> [RdrNameImportDecl]
637 -> NameSet -- Used in this module
640 reportUnusedNames my_mod_iface unqual imports avail_env
641 used_names imported_decls
642 = warnUnusedModules unused_imp_mods `thenRn_`
643 warnUnusedLocalBinds bad_locals `thenRn_`
644 warnUnusedImports bad_imp_names `thenRn_`
645 printMinimalImports this_mod unqual minimal_imports
647 this_mod = mi_module my_mod_iface
648 gbl_env = mi_globals my_mod_iface
650 -- Now, a use of C implies a use of T,
651 -- if C was brought into scope by T(..) or T(C)
652 really_used_names = used_names `unionNameSets`
653 mkNameSet [ parent_name
654 | sub_name <- nameSetToList used_names
656 -- Usually, every used name will appear in avail_env, but there
657 -- is one time when it doesn't: tuples and other built in syntax. When you
658 -- write (a,b) that gives rise to a *use* of "(,)", so that the
659 -- instances will get pulled in, but the tycon "(,)" isn't actually
660 -- in scope. Also, (-x) gives rise to an implicit use of 'negate';
661 -- similarly, 3.5 gives rise to an implcit use of :%
662 -- Hence the silent 'False' in all other cases
664 , Just parent_name <- [case lookupNameEnv avail_env sub_name of
665 Just (AvailTC n _) -> Just n
669 -- Collect the defined names from the in-scope environment
670 -- Look for the qualified ones only, else get duplicates
671 defined_names :: [GlobalRdrElt]
672 defined_names = foldRdrEnv add [] gbl_env
673 add rdr_name ns acc | isQual rdr_name = ns ++ acc
676 defined_and_used, defined_but_not_used :: [GlobalRdrElt]
677 (defined_and_used, defined_but_not_used) = partition used defined_names
678 used (GRE name _ _) = name `elemNameSet` really_used_names
680 -- Filter out the ones only defined implicitly
682 bad_locals = [n | (GRE n LocalDef _) <- defined_but_not_used]
684 bad_imp_names :: [(Name,Provenance)]
685 bad_imp_names = [(n,p) | GRE n p@(NonLocalDef (UserImport mod _ True)) _ <- defined_but_not_used,
686 not (module_unused mod)]
688 -- inst_mods are directly-imported modules that
689 -- contain instance decl(s) that the renamer decided to suck in
690 -- It's not necessarily redundant to import such modules.
696 -- The import M() is not *necessarily* redundant, even if
697 -- we suck in no instance decls from M (e.g. it contains
698 -- no instance decls, or This contains no code). It may be
699 -- that we import M solely to ensure that M's orphan instance
700 -- decls (or those in its imports) are visible to people who
701 -- import This. Sigh.
702 -- There's really no good way to detect this, so the error message
703 -- in RnEnv.warnUnusedModules is weakened instead
704 inst_mods :: [ModuleName]
705 inst_mods = [m | InstD (InstDecl _ _ _ (Just dfun) _) <- imported_decls,
706 let m = moduleName (nameModule dfun),
707 m `elem` direct_import_mods
710 -- To figure out the minimal set of imports, start with the things
711 -- that are in scope (i.e. in gbl_env). Then just combine them
712 -- into a bunch of avails, so they are properly grouped
713 minimal_imports :: FiniteMap ModuleName AvailEnv
714 minimal_imports0 = emptyFM
715 minimal_imports1 = foldr add_name minimal_imports0 defined_and_used
716 minimal_imports = foldr add_inst_mod minimal_imports1 inst_mods
718 -- We've carefully preserved the provenance so that we can
719 -- construct minimal imports that import the name by (one of)
720 -- the same route(s) as the programmer originally did.
721 add_name (GRE n (NonLocalDef (UserImport m _ _)) _) acc = addToFM_C plusAvailEnv acc (moduleName m)
722 (unitAvailEnv (mk_avail n))
723 add_name (GRE n other_prov _) acc = acc
725 mk_avail n = case lookupNameEnv avail_env n of
726 Just (AvailTC m _) | n==m -> AvailTC n [n]
727 | otherwise -> AvailTC m [n,m]
728 Just avail -> Avail n
729 Nothing -> pprPanic "mk_avail" (ppr n)
732 | m `elemFM` acc = acc -- We import something already
733 | otherwise = addToFM acc m emptyAvailEnv
734 -- Add an empty collection of imports for a module
735 -- from which we have sucked only instance decls
737 direct_import_mods :: [ModuleName]
738 direct_import_mods = nub [m | ImportDecl m _ _ _ _ _ <- imports]
740 -- unused_imp_mods are the directly-imported modules
741 -- that are not mentioned in minimal_imports
742 unused_imp_mods = [m | m <- direct_import_mods,
743 not (maybeToBool (lookupFM minimal_imports m)),
746 module_unused :: Module -> Bool
747 module_unused mod = moduleName mod `elem` unused_imp_mods
750 -- ToDo: deal with original imports with 'qualified' and 'as M' clauses
751 printMinimalImports :: Module -- This module
753 -> FiniteMap ModuleName AvailEnv -- Minimal imports
755 printMinimalImports this_mod unqual imps
756 = ifOptRn Opt_D_dump_minimal_imports $
758 mapRn to_ies (fmToList imps) `thenRn` \ mod_ies ->
759 ioToRnM (do { h <- openFile filename WriteMode ;
760 printForUser h unqual (vcat (map ppr_mod_ie mod_ies))
764 filename = moduleNameUserString (moduleName this_mod) ++ ".imports"
765 ppr_mod_ie (mod_name, ies)
766 | mod_name == pRELUDE_Name
769 = ptext SLIT("import") <+> ppr mod_name <>
770 parens (fsep (punctuate comma (map ppr ies)))
772 to_ies (mod, avail_env) = mapRn to_ie (availEnvElts avail_env) `thenRn` \ ies ->
775 to_ie :: AvailInfo -> RnMG (IE Name)
776 -- The main trick here is that if we're importing all the constructors
777 -- we want to say "T(..)", but if we're importing only a subset we want
778 -- to say "T(A,B,C)". So we have to find out what the module exports.
779 to_ie (Avail n) = returnRn (IEVar n)
780 to_ie (AvailTC n [m]) = ASSERT( n==m )
781 returnRn (IEThingAbs n)
783 = loadInterface (text "Compute minimal imports from" <+> ppr n_mod)
784 n_mod ImportBySystem `thenRn` \ iface ->
785 case [xs | (m,as) <- mi_exports iface,
789 [xs] | all (`elem` ns) xs -> returnRn (IEThingAll n)
790 | otherwise -> returnRn (IEThingWith n (filter (/= n) ns))
791 other -> pprTrace "to_ie" (ppr n <+> ppr (nameModule n) <+> ppr other) $
794 n_mod = moduleName (nameModule n)
796 rnDump :: [RenamedHsDecl] -- Renamed imported decls
797 -> [RenamedHsDecl] -- Renamed local decls
799 rnDump imp_decls local_decls
800 = doptRn Opt_D_dump_rn_trace `thenRn` \ dump_rn_trace ->
801 doptRn Opt_D_dump_rn_stats `thenRn` \ dump_rn_stats ->
802 doptRn Opt_D_dump_rn `thenRn` \ dump_rn ->
803 getIfacesRn `thenRn` \ ifaces ->
805 ioToRnM (do { dumpIfSet (dump_rn_trace || dump_rn_stats || dump_rn)
807 (getRnStats imp_decls ifaces) ;
809 dumpIfSet dump_rn "Renamer:"
810 (vcat (map ppr (local_decls ++ imp_decls)))
817 %*********************************************************
819 \subsection{Statistics}
821 %*********************************************************
824 getRnStats :: [RenamedHsDecl] -> Ifaces -> SDoc
825 getRnStats imported_decls ifaces
826 = hcat [text "Renamer stats: ", stats]
828 n_mods = length [() | _ <- moduleEnvElts (iPIT ifaces)]
829 -- This is really only right for a one-shot compile
831 (decls_map, n_decls_slurped) = iDecls ifaces
833 n_decls_left = length [decl | (avail, True, (_,decl)) <- nameEnvElts decls_map
834 -- Data, newtype, and class decls are in the decls_fm
835 -- under multiple names; the tycon/class, and each
836 -- constructor/class op too.
837 -- The 'True' selects just the 'main' decl
840 (insts_left, n_insts_slurped) = iInsts ifaces
841 n_insts_left = length (bagToList insts_left)
843 (rules_left, n_rules_slurped) = iRules ifaces
844 n_rules_left = length (bagToList rules_left)
847 [int n_mods <+> text "interfaces read",
848 hsep [ int n_decls_slurped, text "type/class/variable imported, out of",
849 int (n_decls_slurped + n_decls_left), text "read"],
850 hsep [ int n_insts_slurped, text "instance decls imported, out of",
851 int (n_insts_slurped + n_insts_left), text "read"],
852 hsep [ int n_rules_slurped, text "rule decls imported, out of",
853 int (n_rules_slurped + n_rules_left), text "read"]
858 %************************************************************************
860 \subsection{Errors and warnings}
862 %************************************************************************
865 dupFixityDecl rdr_name loc1 loc2
866 = vcat [ptext SLIT("Multiple fixity declarations for") <+> quotes (ppr rdr_name),
867 ptext SLIT("at ") <+> ppr loc1,
868 ptext SLIT("and") <+> ppr loc2]
871 = sep [ptext SLIT("Illegal deprecation when whole module is deprecated"),