2 % (c) The GRASP Project, Glasgow University, 1992-1998
4 \section[Rename]{Renaming and dependency analysis passes}
7 module Rename ( renameModule, renameExpr, closeIfaceDecls, checkOldIface ) where
9 #include "HsVersions.h"
12 import RdrHsSyn ( RdrNameHsModule, RdrNameHsDecl, RdrNameDeprecation, RdrNameHsExpr,
13 RdrNameTyClDecl, RdrNameRuleDecl, RdrNameInstDecl, RdrNameImportDecl
15 import RnHsSyn ( RenamedHsDecl, RenamedTyClDecl, RenamedRuleDecl, RenamedInstDecl,
16 extractHsTyNames, RenamedHsExpr,
17 instDeclFVs, tyClDeclFVs, ruleDeclFVs
20 import CmdLineOpts ( DynFlags, DynFlag(..) )
22 import RnExpr ( rnExpr )
23 import RnNames ( getGlobalNames, exportsFromAvail )
24 import RnSource ( rnSourceDecls, rnTyClDecl, rnIfaceRuleDecl, rnInstDecl )
25 import RnIfaces ( slurpImpDecls, mkImportInfo,
26 getInterfaceExports, closeDecls,
27 RecompileRequired, outOfDate, recompileRequired
29 import RnHiFiles ( readIface, removeContext, loadInterface,
30 loadExports, loadFixDecls, loadDeprecs )
31 import RnEnv ( availsToNameSet, availName,
32 emptyAvailEnv, unitAvailEnv, availEnvElts, plusAvailEnv, groupAvails,
33 warnUnusedImports, warnUnusedLocalBinds, warnUnusedModules,
34 lookupOrigNames, lookupSrcName, newGlobalName, unQualInScope
36 import Module ( Module, ModuleName, WhereFrom(..),
37 moduleNameUserString, moduleName,
38 moduleEnvElts, lookupModuleEnv
40 import Name ( Name, NamedThing(..), getSrcLoc,
41 nameIsLocalOrFrom, nameOccName, nameModule,
43 import Name ( mkNameEnv, nameEnvElts, extendNameEnv )
44 import RdrName ( elemRdrEnv, foldRdrEnv, isQual )
45 import OccName ( occNameFlavour )
47 import TysWiredIn ( unitTyCon, intTyCon, boolTyCon )
48 import PrelNames ( mAIN_Name, pREL_MAIN_Name, pRELUDE_Name,
49 ioTyCon_RDR, main_RDR_Unqual,
50 unpackCString_RDR, unpackCStringFoldr_RDR, unpackCStringUtf8_RDR,
53 import PrelInfo ( derivingOccurrences )
54 import Type ( funTyCon )
55 import ErrUtils ( dumpIfSet, showPass, printErrorsAndWarnings, errorsFound )
56 import Bag ( bagToList )
57 import FiniteMap ( FiniteMap, fmToList, emptyFM, lookupFM,
58 addToFM_C, elemFM, addToFM
60 import UniqFM ( lookupUFM )
61 import Maybes ( maybeToBool, catMaybes )
63 import IO ( openFile, IOMode(..) )
64 import HscTypes ( PersistentCompilerState, HomeIfaceTable, HomeSymbolTable,
65 ModIface(..), WhatsImported(..),
66 VersionInfo(..), ImportVersion, IsExported,
67 IfaceDecls, mkIfaceDecls, dcl_tycl, dcl_rules, dcl_insts,
68 GlobalRdrEnv, pprGlobalRdrEnv,
69 AvailEnv, GenAvailInfo(..), AvailInfo, Avails,
70 Provenance(..), ImportReason(..), initialVersionInfo,
71 Deprecations(..), lookupDeprec, lookupIface
73 import List ( partition, nub )
79 %*********************************************************
81 \subsection{The two main wrappers}
83 %*********************************************************
86 renameModule :: DynFlags
87 -> HomeIfaceTable -> HomeSymbolTable
88 -> PersistentCompilerState
89 -> Module -> RdrNameHsModule
90 -> IO (PersistentCompilerState, Maybe (PrintUnqualified, IsExported, ModIface, [RenamedHsDecl]))
91 -- Nothing => some error occurred in the renamer
93 renameModule dflags hit hst pcs this_module rdr_module
94 = renameSource dflags hit hst pcs this_module get_unqual $
95 rename this_module rdr_module
97 get_unqual (Just (unqual, _, _, _)) = unqual
98 get_unqual Nothing = alwaysQualify
103 renameExpr :: DynFlags
104 -> HomeIfaceTable -> HomeSymbolTable
105 -> PersistentCompilerState
106 -> Module -> RdrNameHsExpr
107 -> IO (PersistentCompilerState, Maybe RenamedHsExpr)
109 renameExpr dflags hit hst pcs this_module expr
110 | Just iface <- lookupModuleEnv hit this_module
111 = do { let rdr_env = mi_globals iface
112 ; let get_unqual _ = unQualInScope rdr_env
114 ; renameSource dflags hit hst pcs this_module get_unqual $
115 initRnMS rdr_env emptyLocalFixityEnv SourceMode $
116 (rnExpr expr `thenRn` \ (e,_) -> returnRn (Just e))
120 = do { printErrs alwaysQualify (ptext SLIT("renameExpr: Bad module context") <+> ppr this_module)
121 ; return (pcs, Nothing)
126 %*********************************************************
128 \subsection{The main function: rename}
130 %*********************************************************
133 renameSource :: DynFlags
134 -> HomeIfaceTable -> HomeSymbolTable
135 -> PersistentCompilerState
137 -> (Maybe r -> PrintUnqualified)
139 -> IO (PersistentCompilerState, Maybe r)
140 -- Nothing => some error occurred in the renamer
142 renameSource dflags hit hst old_pcs this_module get_unqual thing_inside
143 = do { showPass dflags "Renamer"
145 -- Initialise the renamer monad
146 ; (new_pcs, msgs, maybe_rn_stuff) <- initRn dflags hit hst old_pcs this_module thing_inside
148 -- Print errors from renaming
149 ; printErrorsAndWarnings (get_unqual maybe_rn_stuff) msgs ;
151 -- Return results. No harm in updating the PCS
152 ; if errorsFound msgs then
153 return (new_pcs, Nothing)
155 return (new_pcs, maybe_rn_stuff)
160 rename :: Module -> RdrNameHsModule -> RnMG (Maybe (PrintUnqualified, IsExported, ModIface, [RenamedHsDecl]))
161 rename this_module contents@(HsModule _ _ exports imports local_decls mod_deprec loc)
164 -- FIND THE GLOBAL NAME ENVIRONMENT
165 getGlobalNames this_module contents `thenRn` \ (gbl_env, local_gbl_env, all_avails@(_, global_avail_env)) ->
167 -- Exit if we've found any errors
168 checkErrsRn `thenRn` \ no_errs_so_far ->
169 if not no_errs_so_far then
170 -- Found errors already, so exit now
171 rnDump [] [] `thenRn_`
175 -- PROCESS EXPORT LIST
176 exportsFromAvail mod_name exports all_avails gbl_env `thenRn` \ export_avails ->
178 traceRn (text "Local top-level environment" $$
179 nest 4 (pprGlobalRdrEnv local_gbl_env)) `thenRn_`
181 -- DEAL WITH DEPRECATIONS
182 rnDeprecs local_gbl_env mod_deprec
183 [d | DeprecD d <- local_decls] `thenRn` \ my_deprecs ->
185 -- DEAL WITH LOCAL FIXITIES
186 fixitiesFromLocalDecls local_gbl_env local_decls `thenRn` \ local_fixity_env ->
189 rnSourceDecls gbl_env local_fixity_env local_decls `thenRn` \ (rn_local_decls, source_fvs) ->
191 -- CHECK THAT main IS DEFINED, IF REQUIRED
192 checkMain this_module local_gbl_env `thenRn_`
194 -- SLURP IN ALL THE NEEDED DECLARATIONS
195 implicitFVs mod_name rn_local_decls `thenRn` \ implicit_fvs ->
197 slurp_fvs = implicit_fvs `plusFV` source_fvs
198 -- It's important to do the "plus" this way round, so that
199 -- when compiling the prelude, locally-defined (), Bool, etc
200 -- override the implicit ones.
202 traceRn (text "Source FVs:" <+> fsep (map ppr (nameSetToList slurp_fvs))) `thenRn_`
203 slurpImpDecls slurp_fvs `thenRn` \ rn_imp_decls ->
205 -- EXIT IF ERRORS FOUND
206 rnDump rn_imp_decls rn_local_decls `thenRn_`
207 checkErrsRn `thenRn` \ no_errs_so_far ->
208 if not no_errs_so_far then
209 -- Found errors already, so exit now
213 -- GENERATE THE VERSION/USAGE INFO
214 mkImportInfo mod_name imports `thenRn` \ my_usages ->
216 -- BUILD THE MODULE INTERFACE
218 -- We record fixities even for things that aren't exported,
219 -- so that we can change into the context of this moodule easily
220 fixities = mkNameEnv [ (name, fixity)
221 | FixitySig name fixity loc <- nameEnvElts local_fixity_env
224 -- Sort the exports to make them easier to compare for versions
225 my_exports = groupAvails this_module export_avails
227 final_decls = rn_local_decls ++ rn_imp_decls
228 is_orphan = any (isOrphanDecl this_module) rn_local_decls
230 mod_iface = ModIface { mi_module = this_module,
231 mi_version = initialVersionInfo,
232 mi_usages = my_usages,
234 mi_orphan = is_orphan,
235 mi_exports = my_exports,
236 mi_globals = gbl_env,
237 mi_fixities = fixities,
238 mi_deprecs = my_deprecs,
239 mi_decls = panic "mi_decls"
242 print_unqualified = unQualInScope gbl_env
243 is_exported name = name `elemNameSet` exported_names
244 exported_names = availsToNameSet export_avails
247 -- REPORT UNUSED NAMES, AND DEBUG DUMP
248 reportUnusedNames mod_iface print_unqualified
249 imports global_avail_env
250 source_fvs export_avails rn_imp_decls `thenRn_`
252 returnRn (Just (print_unqualified, is_exported, mod_iface, final_decls))
254 mod_name = moduleName this_module
257 Checking that main is defined
260 checkMain :: Module -> GlobalRdrEnv -> RnMG ()
261 checkMain this_mod local_env
262 | moduleName this_mod == mAIN_Name
263 = checkRn (main_RDR_Unqual `elemRdrEnv` local_env) noMainErr
268 @implicitFVs@ forces the renamer to slurp in some things which aren't
269 mentioned explicitly, but which might be needed by the type checker.
272 implicitFVs mod_name decls
273 = lookupOrigNames implicit_occs `thenRn` \ implicit_names ->
274 returnRn (mkNameSet (map getName default_tycons) `plusFV`
277 -- Add occurrences for Int, and (), because they
278 -- are the types to which ambigious type variables may be defaulted by
279 -- the type checker; so they won't always appear explicitly.
280 -- [The () one is a GHC extension for defaulting CCall results.]
281 -- ALSO: funTyCon, since it occurs implicitly everywhere!
282 -- (we don't want to be bothered with making funTyCon a
283 -- free var at every function application!)
284 -- Double is dealt with separately in getGates
285 default_tycons = [unitTyCon, funTyCon, boolTyCon, intTyCon]
287 -- Add occurrences for IO or PrimIO
288 implicit_main | mod_name == mAIN_Name
289 || mod_name == pREL_MAIN_Name = [ioTyCon_RDR]
292 -- Now add extra "occurrences" for things that
293 -- the deriving mechanism, or defaulting, will later need in order to
295 implicit_occs = string_occs ++ foldr ((++) . get) implicit_main decls
297 -- Virtually every program has error messages in it somewhere
298 string_occs = [unpackCString_RDR, unpackCStringFoldr_RDR,
299 unpackCStringUtf8_RDR, eqString_RDR]
301 get (TyClD (TyData _ _ _ _ _ _ (Just deriv_classes) _ _ _))
302 = concat (map get_deriv deriv_classes)
305 get_deriv cls = case lookupUFM derivingOccurrences cls of
311 isOrphanDecl this_mod (InstD (InstDecl inst_ty _ _ _ _))
312 = not (foldNameSet ((||) . nameIsLocalOrFrom this_mod) False
313 (extractHsTyNames (removeContext inst_ty)))
314 -- The 'removeContext' is because of
315 -- instance Foo a => Baz T where ...
316 -- The decl is an orphan if Baz and T are both not locally defined,
317 -- even if Foo *is* locally defined
319 isOrphanDecl this_mod (RuleD (HsRule _ _ _ lhs _ _))
322 -- At the moment we just check for common LHS forms
323 -- Expand as necessary. Getting it wrong just means
324 -- more orphans than necessary
325 check (HsVar v) = not (nameIsLocalOrFrom this_mod v)
326 check (HsApp f a) = check f && check a
327 check (HsLit _) = False
328 check (HsOverLit _) = False
329 check (OpApp l o _ r) = check l && check o && check r
330 check (NegApp e _) = check e
331 check (HsPar e) = check e
332 check (SectionL e o) = check e && check o
333 check (SectionR o e) = check e && check o
335 check other = True -- Safe fall through
337 isOrphanDecl _ _ = False
341 %*********************************************************
343 \subsection{Fixities}
345 %*********************************************************
348 fixitiesFromLocalDecls :: GlobalRdrEnv -> [RdrNameHsDecl] -> RnMG LocalFixityEnv
349 fixitiesFromLocalDecls gbl_env decls
350 = foldlRn getFixities emptyNameEnv decls `thenRn` \ env ->
351 traceRn (text "fixity env" <+> vcat (map ppr (nameEnvElts env))) `thenRn_`
354 getFixities :: LocalFixityEnv -> RdrNameHsDecl -> RnMG LocalFixityEnv
355 getFixities acc (FixD fix)
358 getFixities acc (TyClD (ClassDecl _ _ _ _ sigs _ _ _ ))
359 = foldlRn fix_decl acc [sig | FixSig sig <- sigs]
360 -- Get fixities from class decl sigs too.
361 getFixities acc other_decl
364 fix_decl acc sig@(FixitySig rdr_name fixity loc)
365 = -- Check for fixity decl for something not declared
367 lookupSrcName gbl_env rdr_name `thenRn` \ name ->
369 -- Check for duplicate fixity decl
370 case lookupNameEnv acc name of
371 Just (FixitySig _ _ loc') -> addErrRn (dupFixityDecl rdr_name loc loc') `thenRn_`
374 Nothing -> returnRn (extendNameEnv acc name (FixitySig name fixity loc))
378 %*********************************************************
380 \subsection{Deprecations}
382 %*********************************************************
384 For deprecations, all we do is check that the names are in scope.
385 It's only imported deprecations, dealt with in RnIfaces, that we
386 gather them together.
389 rnDeprecs :: GlobalRdrEnv -> Maybe DeprecTxt
390 -> [RdrNameDeprecation] -> RnMG Deprecations
391 rnDeprecs gbl_env Nothing []
394 rnDeprecs gbl_env (Just txt) decls
395 = mapRn (addErrRn . badDeprec) decls `thenRn_`
396 returnRn (DeprecAll txt)
398 rnDeprecs gbl_env Nothing decls
399 = mapRn rn_deprec decls `thenRn` \ pairs ->
400 returnRn (DeprecSome (mkNameEnv (catMaybes pairs)))
402 rn_deprec (Deprecation rdr_name txt loc)
404 lookupSrcName gbl_env rdr_name `thenRn` \ name ->
405 returnRn (Just (name, (name,txt)))
409 %************************************************************************
411 \subsection{Grabbing the old interface file and checking versions}
413 %************************************************************************
416 checkOldIface :: DynFlags
417 -> HomeIfaceTable -> HomeSymbolTable
418 -> PersistentCompilerState
420 -> Bool -- Source unchanged
421 -> Maybe ModIface -- Old interface from compilation manager, if any
422 -> IO (PersistentCompilerState, Bool, (RecompileRequired, Maybe ModIface))
423 -- True <=> errors happened
425 checkOldIface dflags hit hst pcs iface_path source_unchanged maybe_iface
426 = runRn dflags hit hst pcs (panic "Bogus module") $
428 Just old_iface -> -- Use the one we already have
429 setModuleRn (mi_module old_iface) (check_versions old_iface)
431 Nothing -- try and read it from a file
432 -> readIface iface_path `thenRn` \ read_result ->
434 Left err -> -- Old interface file not found, or garbled; give up
435 traceRn (text "Bad old interface file" $$ nest 4 err) `thenRn_`
436 returnRn (outOfDate, Nothing)
439 -> setModuleRn (pi_mod parsed_iface) $
440 loadOldIface parsed_iface `thenRn` \ m_iface ->
441 check_versions m_iface
443 check_versions :: ModIface -> RnMG (RecompileRequired, Maybe ModIface)
446 recompileRequired iface_path source_unchanged iface
447 `thenRn` \ recompile ->
448 returnRn (recompile, Just iface)
451 I think the following function should now have a more representative name,
455 loadOldIface :: ParsedIface -> RnMG ModIface
457 loadOldIface parsed_iface
458 = let iface = parsed_iface
462 loadHomeDecls (pi_decls iface) `thenRn` \ decls ->
463 loadHomeRules (pi_rules iface) `thenRn` \ rules ->
464 loadHomeInsts (pi_insts iface) `thenRn` \ insts ->
465 returnRn (decls, rules, insts)
467 `thenRn` \ ((decls_vers, new_decls), (rule_vers, new_rules), new_insts) ->
469 mapRn loadHomeUsage (pi_usages iface) `thenRn` \ usages ->
470 loadExports (pi_exports iface) `thenRn` \ (export_vers, avails) ->
471 loadFixDecls mod (pi_fixity iface) `thenRn` \ fix_env ->
472 loadDeprecs mod (pi_deprecs iface) `thenRn` \ deprec_env ->
474 version = VersionInfo { vers_module = pi_vers iface,
475 vers_exports = export_vers,
476 vers_rules = rule_vers,
477 vers_decls = decls_vers }
479 decls = mkIfaceDecls new_decls new_rules new_insts
481 mod_iface = ModIface { mi_module = mod, mi_version = version,
482 mi_exports = avails, mi_usages = usages,
483 mi_boot = False, mi_orphan = pi_orphan iface,
484 mi_fixities = fix_env, mi_deprecs = deprec_env,
486 mi_globals = panic "No mi_globals in old interface"
493 loadHomeDecls :: [(Version, RdrNameTyClDecl)]
494 -> RnMS (NameEnv Version, [RenamedTyClDecl])
495 loadHomeDecls decls = foldlRn loadHomeDecl (emptyNameEnv, []) decls
497 loadHomeDecl :: (NameEnv Version, [RenamedTyClDecl])
498 -> (Version, RdrNameTyClDecl)
499 -> RnMS (NameEnv Version, [RenamedTyClDecl])
500 loadHomeDecl (version_map, decls) (version, decl)
501 = rnTyClDecl decl `thenRn` \ decl' ->
502 returnRn (extendNameEnv version_map (tyClDeclName decl') version, decl':decls)
505 loadHomeRules :: (Version, [RdrNameRuleDecl])
506 -> RnMS (Version, [RenamedRuleDecl])
507 loadHomeRules (version, rules)
508 = mapRn rnIfaceRuleDecl rules `thenRn` \ rules' ->
509 returnRn (version, rules')
512 loadHomeInsts :: [RdrNameInstDecl]
513 -> RnMS [RenamedInstDecl]
514 loadHomeInsts insts = mapRn rnInstDecl insts
517 loadHomeUsage :: ImportVersion OccName
518 -> RnMG (ImportVersion Name)
519 loadHomeUsage (mod_name, orphans, is_boot, whats_imported)
520 = rn_imps whats_imported `thenRn` \ whats_imported' ->
521 returnRn (mod_name, orphans, is_boot, whats_imported')
523 rn_imps NothingAtAll = returnRn NothingAtAll
524 rn_imps (Everything v) = returnRn (Everything v)
525 rn_imps (Specifically mv ev items rv) = mapRn rn_imp items `thenRn` \ items' ->
526 returnRn (Specifically mv ev items' rv)
527 rn_imp (occ,vers) = newGlobalName mod_name occ `thenRn` \ name ->
533 %*********************************************************
535 \subsection{Closing up the interface decls}
537 %*********************************************************
539 Suppose we discover we don't need to recompile. Then we start from the
540 IfaceDecls in the ModIface, and fluff them up by sucking in all the decls they need.
543 closeIfaceDecls :: DynFlags
544 -> HomeIfaceTable -> HomeSymbolTable
545 -> PersistentCompilerState
546 -> ModIface -- Get the decls from here
547 -> IO (PersistentCompilerState, Bool, [RenamedHsDecl])
548 -- True <=> errors happened
549 closeIfaceDecls dflags hit hst pcs
550 mod_iface@(ModIface { mi_module = mod, mi_decls = iface_decls })
551 = runRn dflags hit hst pcs mod $
554 rule_decls = dcl_rules iface_decls
555 inst_decls = dcl_insts iface_decls
556 tycl_decls = dcl_tycl iface_decls
557 decls = map RuleD rule_decls ++
558 map InstD inst_decls ++
560 needed = unionManyNameSets (map ruleDeclFVs rule_decls) `unionNameSets`
561 unionManyNameSets (map instDeclFVs inst_decls) `unionNameSets`
562 unionManyNameSets (map tyClDeclFVs tycl_decls)
564 closeDecls decls needed
567 %*********************************************************
569 \subsection{Unused names}
571 %*********************************************************
574 reportUnusedNames :: ModIface -> PrintUnqualified
575 -> [RdrNameImportDecl]
577 -> NameSet -- Used in this module
578 -> Avails -- Exported by this module
581 reportUnusedNames my_mod_iface unqual imports avail_env
582 source_fvs export_avails imported_decls
583 = warnUnusedModules unused_imp_mods `thenRn_`
584 warnUnusedLocalBinds bad_locals `thenRn_`
585 warnUnusedImports bad_imp_names `thenRn_`
586 printMinimalImports this_mod unqual minimal_imports `thenRn_`
587 warnDeprecations this_mod export_avails my_deprecs
591 this_mod = mi_module my_mod_iface
592 gbl_env = mi_globals my_mod_iface
593 my_deprecs = mi_deprecs my_mod_iface
595 -- The export_fvs make the exported names look just as if they
596 -- occurred in the source program.
597 export_fvs = availsToNameSet export_avails
598 used_names = source_fvs `plusFV` export_fvs
600 -- Now, a use of C implies a use of T,
601 -- if C was brought into scope by T(..) or T(C)
602 really_used_names = used_names `unionNameSets`
603 mkNameSet [ parent_name
604 | sub_name <- nameSetToList used_names
606 -- Usually, every used name will appear in avail_env, but there
607 -- is one time when it doesn't: tuples and other built in syntax. When you
608 -- write (a,b) that gives rise to a *use* of "(,)", so that the
609 -- instances will get pulled in, but the tycon "(,)" isn't actually
610 -- in scope. Also, (-x) gives rise to an implicit use of 'negate';
611 -- similarly, 3.5 gives rise to an implcit use of :%
612 -- Hence the silent 'False' in all other cases
614 , Just parent_name <- [case lookupNameEnv avail_env sub_name of
615 Just (AvailTC n _) -> Just n
619 -- Collect the defined names from the in-scope environment
620 -- Look for the qualified ones only, else get duplicates
621 defined_names :: [(Name,Provenance)]
622 defined_names = foldRdrEnv add [] gbl_env
623 add rdr_name ns acc | isQual rdr_name = ns ++ acc
626 defined_and_used, defined_but_not_used :: [(Name,Provenance)]
627 (defined_and_used, defined_but_not_used) = partition used defined_names
628 used (name,_) = name `elemNameSet` really_used_names
630 -- Filter out the ones only defined implicitly
632 bad_locals = [n | (n,LocalDef) <- defined_but_not_used]
634 bad_imp_names :: [(Name,Provenance)]
635 bad_imp_names = [(n,p) | (n,p@(NonLocalDef (UserImport mod _ True))) <- defined_but_not_used,
636 not (module_unused mod)]
638 -- inst_mods are directly-imported modules that
639 -- contain instance decl(s) that the renamer decided to suck in
640 -- It's not necessarily redundant to import such modules.
646 -- The import M() is not *necessarily* redundant, even if
647 -- we suck in no instance decls from M (e.g. it contains
648 -- no instance decls, or This contains no code). It may be
649 -- that we import M solely to ensure that M's orphan instance
650 -- decls (or those in its imports) are visible to people who
651 -- import This. Sigh.
652 -- There's really no good way to detect this, so the error message
653 -- in RnEnv.warnUnusedModules is weakened instead
654 inst_mods :: [ModuleName]
655 inst_mods = [m | InstD (InstDecl _ _ _ (Just dfun) _) <- imported_decls,
656 let m = moduleName (nameModule dfun),
657 m `elem` direct_import_mods
660 -- To figure out the minimal set of imports, start with the things
661 -- that are in scope (i.e. in gbl_env). Then just combine them
662 -- into a bunch of avails, so they are properly grouped
663 minimal_imports :: FiniteMap ModuleName AvailEnv
664 minimal_imports0 = emptyFM
665 minimal_imports1 = foldr add_name minimal_imports0 defined_and_used
666 minimal_imports = foldr add_inst_mod minimal_imports1 inst_mods
668 add_name (n,NonLocalDef (UserImport m _ _)) acc = addToFM_C plusAvailEnv acc (moduleName (nameModule n))
669 (unitAvailEnv (mk_avail n))
670 add_name (n,other_prov) acc = acc
672 mk_avail n = case lookupNameEnv avail_env n of
673 Just (AvailTC m _) | n==m -> AvailTC n [n]
674 | otherwise -> AvailTC m [n,m]
675 Just avail -> Avail n
676 Nothing -> pprPanic "mk_avail" (ppr n)
679 | m `elemFM` acc = acc -- We import something already
680 | otherwise = addToFM acc m emptyAvailEnv
681 -- Add an empty collection of imports for a module
682 -- from which we have sucked only instance decls
684 direct_import_mods :: [ModuleName]
685 direct_import_mods = nub [m | ImportDecl m _ _ _ _ _ <- imports]
687 -- unused_imp_mods are the directly-imported modules
688 -- that are not mentioned in minimal_imports
689 unused_imp_mods = [m | m <- direct_import_mods,
690 not (maybeToBool (lookupFM minimal_imports m)),
693 module_unused :: Module -> Bool
694 module_unused mod = moduleName mod `elem` unused_imp_mods
696 warnDeprecations this_mod export_avails my_deprecs used_names
697 = doptRn Opt_WarnDeprecations `thenRn` \ warn_drs ->
698 if not warn_drs then returnRn () else
700 -- The home modules for things in the export list
701 -- may not have been loaded yet; do it now, so
702 -- that we can see their deprecations, if any
703 mapRn_ load_home export_mods `thenRn_`
705 getIfacesRn `thenRn` \ ifaces ->
706 getHomeIfaceTableRn `thenRn` \ hit ->
710 | n <- nameSetToList used_names,
711 Just txt <- [lookup_deprec hit pit n] ]
713 mapRn_ warnDeprec deprecs
716 export_mods = nub [ moduleName (nameModule name)
717 | avail <- export_avails,
718 let name = availName avail,
719 not (nameIsLocalOrFrom this_mod name) ]
721 load_home m = loadInterface (text "Check deprecations for" <+> ppr m) m ImportBySystem
723 lookup_deprec hit pit n
724 | nameIsLocalOrFrom this_mod n
725 = lookupDeprec my_deprecs n
727 = case lookupIface hit pit n of
728 Just iface -> lookupDeprec (mi_deprecs iface) n
729 Nothing -> pprPanic "warnDeprecations:" (ppr n)
731 -- ToDo: deal with original imports with 'qualified' and 'as M' clauses
732 printMinimalImports this_mod unqual imps
733 = doptRn Opt_D_dump_minimal_imports `thenRn` \ dump_minimal ->
734 if not dump_minimal then returnRn () else
736 mapRn to_ies (fmToList imps) `thenRn` \ mod_ies ->
737 ioToRnM (do { h <- openFile filename WriteMode ;
738 printForUser h unqual (vcat (map ppr_mod_ie mod_ies))
742 filename = moduleNameUserString (moduleName this_mod) ++ ".imports"
743 ppr_mod_ie (mod_name, ies)
744 | mod_name == pRELUDE_Name
747 = ptext SLIT("import") <+> ppr mod_name <>
748 parens (fsep (punctuate comma (map ppr ies)))
750 to_ies (mod, avail_env) = mapRn to_ie (availEnvElts avail_env) `thenRn` \ ies ->
753 to_ie :: AvailInfo -> RnMG (IE Name)
754 to_ie (Avail n) = returnRn (IEVar n)
755 to_ie (AvailTC n [m]) = ASSERT( n==m )
756 returnRn (IEThingAbs n)
758 = getInterfaceExports n_mod ImportBySystem `thenRn` \ (_, avails_by_module) ->
759 case [xs | (m,as) <- avails_by_module,
763 [xs] | all (`elem` ns) xs -> returnRn (IEThingAll n)
764 | otherwise -> returnRn (IEThingWith n (filter (/= n) ns))
765 other -> pprTrace "to_ie" (ppr n <+> ppr (nameModule n) <+> ppr other) $
768 n_mod = moduleName (nameModule n)
770 rnDump :: [RenamedHsDecl] -- Renamed imported decls
771 -> [RenamedHsDecl] -- Renamed local decls
773 rnDump imp_decls local_decls
774 = doptRn Opt_D_dump_rn_trace `thenRn` \ dump_rn_trace ->
775 doptRn Opt_D_dump_rn_stats `thenRn` \ dump_rn_stats ->
776 doptRn Opt_D_dump_rn `thenRn` \ dump_rn ->
777 getIfacesRn `thenRn` \ ifaces ->
779 ioToRnM (do { dumpIfSet (dump_rn_trace || dump_rn_stats || dump_rn)
781 (getRnStats imp_decls ifaces) ;
783 dumpIfSet dump_rn "Renamer:"
784 (vcat (map ppr (local_decls ++ imp_decls)))
791 %*********************************************************
793 \subsection{Statistics}
795 %*********************************************************
798 getRnStats :: [RenamedHsDecl] -> Ifaces -> SDoc
799 getRnStats imported_decls ifaces
800 = hcat [text "Renamer stats: ", stats]
802 n_mods = length [() | _ <- moduleEnvElts (iPIT ifaces)]
803 -- This is really only right for a one-shot compile
805 (decls_map, n_decls_slurped) = iDecls ifaces
807 n_decls_left = length [decl | (avail, True, (_,decl)) <- nameEnvElts decls_map
808 -- Data, newtype, and class decls are in the decls_fm
809 -- under multiple names; the tycon/class, and each
810 -- constructor/class op too.
811 -- The 'True' selects just the 'main' decl
814 (insts_left, n_insts_slurped) = iInsts ifaces
815 n_insts_left = length (bagToList insts_left)
817 (rules_left, n_rules_slurped) = iRules ifaces
818 n_rules_left = length (bagToList rules_left)
821 [int n_mods <+> text "interfaces read",
822 hsep [ int n_decls_slurped, text "type/class/variable imported, out of",
823 int (n_decls_slurped + n_decls_left), text "read"],
824 hsep [ int n_insts_slurped, text "instance decls imported, out of",
825 int (n_insts_slurped + n_insts_left), text "read"],
826 hsep [ int n_rules_slurped, text "rule decls imported, out of",
827 int (n_rules_slurped + n_rules_left), text "read"]
832 %************************************************************************
834 \subsection{Errors and warnings}
836 %************************************************************************
839 warnDeprec :: (Name, DeprecTxt) -> RnM d ()
840 warnDeprec (name, txt)
841 = pushSrcLocRn (getSrcLoc name) $
843 sep [ text (occNameFlavour (nameOccName name)) <+> ppr name <+>
844 text "is deprecated:", nest 4 (ppr txt) ]
847 dupFixityDecl rdr_name loc1 loc2
848 = vcat [ptext SLIT("Multiple fixity declarations for") <+> quotes (ppr rdr_name),
849 ptext SLIT("at ") <+> ppr loc1,
850 ptext SLIT("and") <+> ppr loc2]
853 = sep [ptext SLIT("Illegal deprecation when whole module is deprecated"),
857 = hsep [ptext SLIT("Module"), quotes (ppr mAIN_Name),
858 ptext SLIT("must include a definition for"), quotes (ptext SLIT("main"))]