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, recordLocalSlurps,
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 $
95 rename this_module rdr_module
100 renameExpr :: DynFlags
101 -> HomeIfaceTable -> HomeSymbolTable
102 -> PersistentCompilerState
103 -> Module -> RdrNameHsExpr
104 -> IO (PersistentCompilerState, Maybe (PrintUnqualified, (RenamedHsExpr, [RenamedHsDecl])))
106 renameExpr dflags hit hst pcs this_module expr
107 | Just iface <- lookupModuleEnv hit this_module
108 = do { let rdr_env = mi_globals iface
109 ; let print_unqual = unQualInScope rdr_env
111 ; renameSource dflags hit hst pcs this_module $
112 initRnMS rdr_env emptyLocalFixityEnv SourceMode (rnExpr expr) `thenRn` \ (e,fvs) ->
113 slurpImpDecls fvs `thenRn` \ decls ->
114 doptRn Opt_D_dump_rn `thenRn` \ dump_rn ->
115 ioToRnM (dumpIfSet dump_rn "Renamer:" (ppr e)) `thenRn_`
116 returnRn (Just (print_unqual, (e, decls)))
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 -> RnMG (Maybe (PrintUnqualified, r))
138 -> IO (PersistentCompilerState, Maybe (PrintUnqualified, r))
139 -- Nothing => some error occurred in the renamer
141 renameSource dflags hit hst old_pcs this_module thing_inside
142 = do { showPass dflags "Renamer"
144 -- Initialise the renamer monad
145 ; (new_pcs, msgs, maybe_rn_stuff) <- initRn dflags hit hst old_pcs this_module thing_inside
147 -- Print errors from renaming
148 ; let print_unqual = case maybe_rn_stuff of
149 Just (unqual, _) -> unqual
150 Nothing -> alwaysQualify
152 ; printErrorsAndWarnings print_unqual msgs ;
154 -- Return results. No harm in updating the PCS
155 ; if errorsFound msgs then
156 return (new_pcs, Nothing)
158 return (new_pcs, maybe_rn_stuff)
163 rename :: Module -> RdrNameHsModule -> RnMG (Maybe (PrintUnqualified, (IsExported, ModIface, [RenamedHsDecl])))
164 rename this_module contents@(HsModule _ _ exports imports local_decls mod_deprec loc)
167 -- FIND THE GLOBAL NAME ENVIRONMENT
168 getGlobalNames this_module contents `thenRn` \ (gbl_env, local_gbl_env, all_avails@(_, global_avail_env)) ->
170 -- Exit if we've found any errors
171 checkErrsRn `thenRn` \ no_errs_so_far ->
172 if not no_errs_so_far then
173 -- Found errors already, so exit now
174 rnDump [] [] `thenRn_`
178 -- PROCESS EXPORT LIST
179 exportsFromAvail mod_name exports all_avails gbl_env `thenRn` \ export_avails ->
181 traceRn (text "Local top-level environment" $$
182 nest 4 (pprGlobalRdrEnv local_gbl_env)) `thenRn_`
184 -- DEAL WITH DEPRECATIONS
185 rnDeprecs local_gbl_env mod_deprec
186 [d | DeprecD d <- local_decls] `thenRn` \ my_deprecs ->
188 -- DEAL WITH LOCAL FIXITIES
189 fixitiesFromLocalDecls local_gbl_env local_decls `thenRn` \ local_fixity_env ->
192 rnSourceDecls gbl_env local_fixity_env local_decls `thenRn` \ (rn_local_decls, source_fvs) ->
194 -- CHECK THAT main IS DEFINED, IF REQUIRED
195 checkMain this_module local_gbl_env `thenRn_`
197 -- SLURP IN ALL THE NEEDED DECLARATIONS
198 implicitFVs mod_name rn_local_decls `thenRn` \ implicit_fvs ->
200 slurp_fvs = implicit_fvs `plusFV` source_fvs
201 -- It's important to do the "plus" this way round, so that
202 -- when compiling the prelude, locally-defined (), Bool, etc
203 -- override the implicit ones.
205 traceRn (text "Source FVs:" <+> fsep (map ppr (nameSetToList slurp_fvs))) `thenRn_`
206 slurpImpDecls slurp_fvs `thenRn` \ rn_imp_decls ->
208 -- EXIT IF ERRORS FOUND
209 rnDump rn_imp_decls rn_local_decls `thenRn_`
210 checkErrsRn `thenRn` \ no_errs_so_far ->
211 if not no_errs_so_far then
212 -- Found errors already, so exit now
216 -- GENERATE THE VERSION/USAGE INFO
217 mkImportInfo mod_name imports `thenRn` \ my_usages ->
219 -- BUILD THE MODULE INTERFACE
221 -- We record fixities even for things that aren't exported,
222 -- so that we can change into the context of this moodule easily
223 fixities = mkNameEnv [ (name, fixity)
224 | FixitySig name fixity loc <- nameEnvElts local_fixity_env
227 -- Sort the exports to make them easier to compare for versions
228 my_exports = groupAvails this_module export_avails
230 final_decls = rn_local_decls ++ rn_imp_decls
231 is_orphan = any (isOrphanDecl this_module) rn_local_decls
233 mod_iface = ModIface { mi_module = this_module,
234 mi_version = initialVersionInfo,
235 mi_usages = my_usages,
237 mi_orphan = is_orphan,
238 mi_exports = my_exports,
239 mi_globals = gbl_env,
240 mi_fixities = fixities,
241 mi_deprecs = my_deprecs,
242 mi_decls = panic "mi_decls"
245 print_unqualified = unQualInScope gbl_env
246 is_exported name = name `elemNameSet` exported_names
247 exported_names = availsToNameSet export_avails
250 -- REPORT UNUSED NAMES, AND DEBUG DUMP
251 reportUnusedNames mod_iface print_unqualified
252 imports global_avail_env
253 source_fvs export_avails rn_imp_decls `thenRn_`
255 returnRn (Just (print_unqualified, (is_exported, mod_iface, final_decls)))
257 mod_name = moduleName this_module
260 Checking that main is defined
263 checkMain :: Module -> GlobalRdrEnv -> RnMG ()
264 checkMain this_mod local_env
265 | moduleName this_mod == mAIN_Name
266 = checkRn (main_RDR_Unqual `elemRdrEnv` local_env) noMainErr
271 @implicitFVs@ forces the renamer to slurp in some things which aren't
272 mentioned explicitly, but which might be needed by the type checker.
275 implicitFVs mod_name decls
276 = lookupOrigNames implicit_occs `thenRn` \ implicit_names ->
277 returnRn (mkNameSet (map getName default_tycons) `plusFV`
280 -- Add occurrences for Int, and (), because they
281 -- are the types to which ambigious type variables may be defaulted by
282 -- the type checker; so they won't always appear explicitly.
283 -- [The () one is a GHC extension for defaulting CCall results.]
284 -- ALSO: funTyCon, since it occurs implicitly everywhere!
285 -- (we don't want to be bothered with making funTyCon a
286 -- free var at every function application!)
287 -- Double is dealt with separately in getGates
288 default_tycons = [unitTyCon, funTyCon, boolTyCon, intTyCon]
290 -- Add occurrences for IO or PrimIO
291 implicit_main | mod_name == mAIN_Name
292 || mod_name == pREL_MAIN_Name = [ioTyCon_RDR]
295 -- Now add extra "occurrences" for things that
296 -- the deriving mechanism, or defaulting, will later need in order to
298 implicit_occs = string_occs ++ foldr ((++) . get) implicit_main decls
300 -- Virtually every program has error messages in it somewhere
301 string_occs = [unpackCString_RDR, unpackCStringFoldr_RDR,
302 unpackCStringUtf8_RDR, eqString_RDR]
304 get (TyClD (TyData _ _ _ _ _ _ (Just deriv_classes) _ _ _))
305 = concat (map get_deriv deriv_classes)
308 get_deriv cls = case lookupUFM derivingOccurrences cls of
314 isOrphanDecl this_mod (InstD (InstDecl inst_ty _ _ _ _))
315 = not (foldNameSet ((||) . nameIsLocalOrFrom this_mod) False
316 (extractHsTyNames (removeContext inst_ty)))
317 -- The 'removeContext' is because of
318 -- instance Foo a => Baz T where ...
319 -- The decl is an orphan if Baz and T are both not locally defined,
320 -- even if Foo *is* locally defined
322 isOrphanDecl this_mod (RuleD (HsRule _ _ _ lhs _ _))
325 -- At the moment we just check for common LHS forms
326 -- Expand as necessary. Getting it wrong just means
327 -- more orphans than necessary
328 check (HsVar v) = not (nameIsLocalOrFrom this_mod v)
329 check (HsApp f a) = check f && check a
330 check (HsLit _) = False
331 check (HsOverLit _) = False
332 check (OpApp l o _ r) = check l && check o && check r
333 check (NegApp e _) = check e
334 check (HsPar e) = check e
335 check (SectionL e o) = check e && check o
336 check (SectionR o e) = check e && check o
338 check other = True -- Safe fall through
340 isOrphanDecl _ _ = False
344 %*********************************************************
346 \subsection{Fixities}
348 %*********************************************************
351 fixitiesFromLocalDecls :: GlobalRdrEnv -> [RdrNameHsDecl] -> RnMG LocalFixityEnv
352 fixitiesFromLocalDecls gbl_env decls
353 = foldlRn getFixities emptyNameEnv decls `thenRn` \ env ->
354 traceRn (text "fixity env" <+> vcat (map ppr (nameEnvElts env))) `thenRn_`
357 getFixities :: LocalFixityEnv -> RdrNameHsDecl -> RnMG LocalFixityEnv
358 getFixities acc (FixD fix)
361 getFixities acc (TyClD (ClassDecl _ _ _ _ sigs _ _ _ ))
362 = foldlRn fix_decl acc [sig | FixSig sig <- sigs]
363 -- Get fixities from class decl sigs too.
364 getFixities acc other_decl
367 fix_decl acc sig@(FixitySig rdr_name fixity loc)
368 = -- Check for fixity decl for something not declared
370 lookupSrcName gbl_env rdr_name `thenRn` \ name ->
372 -- Check for duplicate fixity decl
373 case lookupNameEnv acc name of
374 Just (FixitySig _ _ loc') -> addErrRn (dupFixityDecl rdr_name loc loc') `thenRn_`
377 Nothing -> returnRn (extendNameEnv acc name (FixitySig name fixity loc))
381 %*********************************************************
383 \subsection{Deprecations}
385 %*********************************************************
387 For deprecations, all we do is check that the names are in scope.
388 It's only imported deprecations, dealt with in RnIfaces, that we
389 gather them together.
392 rnDeprecs :: GlobalRdrEnv -> Maybe DeprecTxt
393 -> [RdrNameDeprecation] -> RnMG Deprecations
394 rnDeprecs gbl_env Nothing []
397 rnDeprecs gbl_env (Just txt) decls
398 = mapRn (addErrRn . badDeprec) decls `thenRn_`
399 returnRn (DeprecAll txt)
401 rnDeprecs gbl_env Nothing decls
402 = mapRn rn_deprec decls `thenRn` \ pairs ->
403 returnRn (DeprecSome (mkNameEnv (catMaybes pairs)))
405 rn_deprec (Deprecation rdr_name txt loc)
407 lookupSrcName gbl_env rdr_name `thenRn` \ name ->
408 returnRn (Just (name, (name,txt)))
412 %************************************************************************
414 \subsection{Grabbing the old interface file and checking versions}
416 %************************************************************************
419 checkOldIface :: DynFlags
420 -> HomeIfaceTable -> HomeSymbolTable
421 -> PersistentCompilerState
423 -> Bool -- Source unchanged
424 -> Maybe ModIface -- Old interface from compilation manager, if any
425 -> IO (PersistentCompilerState, Bool, (RecompileRequired, Maybe ModIface))
426 -- True <=> errors happened
428 checkOldIface dflags hit hst pcs iface_path source_unchanged maybe_iface
429 = runRn dflags hit hst pcs (panic "Bogus module") $
431 Just old_iface -> -- Use the one we already have
432 setModuleRn (mi_module old_iface) (check_versions old_iface)
434 Nothing -- try and read it from a file
435 -> readIface iface_path `thenRn` \ read_result ->
437 Left err -> -- Old interface file not found, or garbled; give up
438 traceRn (text "Bad old interface file" $$ nest 4 err) `thenRn_`
439 returnRn (outOfDate, Nothing)
442 -> setModuleRn (pi_mod parsed_iface) $
443 loadOldIface parsed_iface `thenRn` \ m_iface ->
444 check_versions m_iface
446 check_versions :: ModIface -> RnMG (RecompileRequired, Maybe ModIface)
449 recompileRequired iface_path source_unchanged iface
450 `thenRn` \ recompile ->
451 returnRn (recompile, Just iface)
454 I think the following function should now have a more representative name,
458 loadOldIface :: ParsedIface -> RnMG ModIface
460 loadOldIface parsed_iface
461 = let iface = parsed_iface
465 loadHomeDecls (pi_decls iface) `thenRn` \ decls ->
466 loadHomeRules (pi_rules iface) `thenRn` \ rules ->
467 loadHomeInsts (pi_insts iface) `thenRn` \ insts ->
468 returnRn (decls, rules, insts)
470 `thenRn` \ ((decls_vers, new_decls), (rule_vers, new_rules), new_insts) ->
472 mapRn loadHomeUsage (pi_usages iface) `thenRn` \ usages ->
473 loadExports (pi_exports iface) `thenRn` \ (export_vers, avails) ->
474 loadFixDecls mod (pi_fixity iface) `thenRn` \ fix_env ->
475 loadDeprecs mod (pi_deprecs iface) `thenRn` \ deprec_env ->
477 version = VersionInfo { vers_module = pi_vers iface,
478 vers_exports = export_vers,
479 vers_rules = rule_vers,
480 vers_decls = decls_vers }
482 decls = mkIfaceDecls new_decls new_rules new_insts
484 mod_iface = ModIface { mi_module = mod, mi_version = version,
485 mi_exports = avails, mi_usages = usages,
486 mi_boot = False, mi_orphan = pi_orphan iface,
487 mi_fixities = fix_env, mi_deprecs = deprec_env,
489 mi_globals = panic "No mi_globals in old interface"
496 loadHomeDecls :: [(Version, RdrNameTyClDecl)]
497 -> RnMS (NameEnv Version, [RenamedTyClDecl])
498 loadHomeDecls decls = foldlRn loadHomeDecl (emptyNameEnv, []) decls
500 loadHomeDecl :: (NameEnv Version, [RenamedTyClDecl])
501 -> (Version, RdrNameTyClDecl)
502 -> RnMS (NameEnv Version, [RenamedTyClDecl])
503 loadHomeDecl (version_map, decls) (version, decl)
504 = rnTyClDecl decl `thenRn` \ decl' ->
505 returnRn (extendNameEnv version_map (tyClDeclName decl') version, decl':decls)
508 loadHomeRules :: (Version, [RdrNameRuleDecl])
509 -> RnMS (Version, [RenamedRuleDecl])
510 loadHomeRules (version, rules)
511 = mapRn rnIfaceRuleDecl rules `thenRn` \ rules' ->
512 returnRn (version, rules')
515 loadHomeInsts :: [RdrNameInstDecl]
516 -> RnMS [RenamedInstDecl]
517 loadHomeInsts insts = mapRn rnInstDecl insts
520 loadHomeUsage :: ImportVersion OccName
521 -> RnMG (ImportVersion Name)
522 loadHomeUsage (mod_name, orphans, is_boot, whats_imported)
523 = rn_imps whats_imported `thenRn` \ whats_imported' ->
524 returnRn (mod_name, orphans, is_boot, whats_imported')
526 rn_imps NothingAtAll = returnRn NothingAtAll
527 rn_imps (Everything v) = returnRn (Everything v)
528 rn_imps (Specifically mv ev items rv) = mapRn rn_imp items `thenRn` \ items' ->
529 returnRn (Specifically mv ev items' rv)
530 rn_imp (occ,vers) = newGlobalName mod_name occ `thenRn` \ name ->
536 %*********************************************************
538 \subsection{Closing up the interface decls}
540 %*********************************************************
542 Suppose we discover we don't need to recompile. Then we start from the
543 IfaceDecls in the ModIface, and fluff them up by sucking in all the decls they need.
546 closeIfaceDecls :: DynFlags
547 -> HomeIfaceTable -> HomeSymbolTable
548 -> PersistentCompilerState
549 -> ModIface -- Get the decls from here
550 -> IO (PersistentCompilerState, Bool, [RenamedHsDecl])
551 -- True <=> errors happened
552 closeIfaceDecls dflags hit hst pcs
553 mod_iface@(ModIface { mi_module = mod, mi_decls = iface_decls })
554 = runRn dflags hit hst pcs mod $
557 rule_decls = dcl_rules iface_decls
558 inst_decls = dcl_insts iface_decls
559 tycl_decls = dcl_tycl iface_decls
560 decls = map RuleD rule_decls ++
561 map InstD inst_decls ++
563 needed = unionManyNameSets (map ruleDeclFVs rule_decls) `unionNameSets`
564 unionManyNameSets (map instDeclFVs inst_decls) `unionNameSets`
565 unionManyNameSets (map tyClDeclFVs tycl_decls)
566 local_names = foldl add emptyNameSet tycl_decls
567 add names decl = addListToNameSet names (map fst (tyClDeclSysNames decl ++ tyClDeclNames decl))
569 recordLocalSlurps local_names `thenRn_`
570 closeDecls decls needed
573 %*********************************************************
575 \subsection{Unused names}
577 %*********************************************************
580 reportUnusedNames :: ModIface -> PrintUnqualified
581 -> [RdrNameImportDecl]
583 -> NameSet -- Used in this module
584 -> Avails -- Exported by this module
587 reportUnusedNames my_mod_iface unqual imports avail_env
588 source_fvs export_avails imported_decls
589 = warnUnusedModules unused_imp_mods `thenRn_`
590 warnUnusedLocalBinds bad_locals `thenRn_`
591 warnUnusedImports bad_imp_names `thenRn_`
592 printMinimalImports this_mod unqual minimal_imports `thenRn_`
593 warnDeprecations this_mod export_avails my_deprecs
597 this_mod = mi_module my_mod_iface
598 gbl_env = mi_globals my_mod_iface
599 my_deprecs = mi_deprecs my_mod_iface
601 -- The export_fvs make the exported names look just as if they
602 -- occurred in the source program.
603 export_fvs = availsToNameSet export_avails
604 used_names = source_fvs `plusFV` export_fvs
606 -- Now, a use of C implies a use of T,
607 -- if C was brought into scope by T(..) or T(C)
608 really_used_names = used_names `unionNameSets`
609 mkNameSet [ parent_name
610 | sub_name <- nameSetToList used_names
612 -- Usually, every used name will appear in avail_env, but there
613 -- is one time when it doesn't: tuples and other built in syntax. When you
614 -- write (a,b) that gives rise to a *use* of "(,)", so that the
615 -- instances will get pulled in, but the tycon "(,)" isn't actually
616 -- in scope. Also, (-x) gives rise to an implicit use of 'negate';
617 -- similarly, 3.5 gives rise to an implcit use of :%
618 -- Hence the silent 'False' in all other cases
620 , Just parent_name <- [case lookupNameEnv avail_env sub_name of
621 Just (AvailTC n _) -> Just n
625 -- Collect the defined names from the in-scope environment
626 -- Look for the qualified ones only, else get duplicates
627 defined_names :: [(Name,Provenance)]
628 defined_names = foldRdrEnv add [] gbl_env
629 add rdr_name ns acc | isQual rdr_name = ns ++ acc
632 defined_and_used, defined_but_not_used :: [(Name,Provenance)]
633 (defined_and_used, defined_but_not_used) = partition used defined_names
634 used (name,_) = name `elemNameSet` really_used_names
636 -- Filter out the ones only defined implicitly
638 bad_locals = [n | (n,LocalDef) <- defined_but_not_used]
640 bad_imp_names :: [(Name,Provenance)]
641 bad_imp_names = [(n,p) | (n,p@(NonLocalDef (UserImport mod _ True))) <- defined_but_not_used,
642 not (module_unused mod)]
644 -- inst_mods are directly-imported modules that
645 -- contain instance decl(s) that the renamer decided to suck in
646 -- It's not necessarily redundant to import such modules.
652 -- The import M() is not *necessarily* redundant, even if
653 -- we suck in no instance decls from M (e.g. it contains
654 -- no instance decls, or This contains no code). It may be
655 -- that we import M solely to ensure that M's orphan instance
656 -- decls (or those in its imports) are visible to people who
657 -- import This. Sigh.
658 -- There's really no good way to detect this, so the error message
659 -- in RnEnv.warnUnusedModules is weakened instead
660 inst_mods :: [ModuleName]
661 inst_mods = [m | InstD (InstDecl _ _ _ (Just dfun) _) <- imported_decls,
662 let m = moduleName (nameModule dfun),
663 m `elem` direct_import_mods
666 -- To figure out the minimal set of imports, start with the things
667 -- that are in scope (i.e. in gbl_env). Then just combine them
668 -- into a bunch of avails, so they are properly grouped
669 minimal_imports :: FiniteMap ModuleName AvailEnv
670 minimal_imports0 = emptyFM
671 minimal_imports1 = foldr add_name minimal_imports0 defined_and_used
672 minimal_imports = foldr add_inst_mod minimal_imports1 inst_mods
674 add_name (n,NonLocalDef (UserImport m _ _)) acc = addToFM_C plusAvailEnv acc (moduleName (nameModule n))
675 (unitAvailEnv (mk_avail n))
676 add_name (n,other_prov) acc = acc
678 mk_avail n = case lookupNameEnv avail_env n of
679 Just (AvailTC m _) | n==m -> AvailTC n [n]
680 | otherwise -> AvailTC m [n,m]
681 Just avail -> Avail n
682 Nothing -> pprPanic "mk_avail" (ppr n)
685 | m `elemFM` acc = acc -- We import something already
686 | otherwise = addToFM acc m emptyAvailEnv
687 -- Add an empty collection of imports for a module
688 -- from which we have sucked only instance decls
690 direct_import_mods :: [ModuleName]
691 direct_import_mods = nub [m | ImportDecl m _ _ _ _ _ <- imports]
693 -- unused_imp_mods are the directly-imported modules
694 -- that are not mentioned in minimal_imports
695 unused_imp_mods = [m | m <- direct_import_mods,
696 not (maybeToBool (lookupFM minimal_imports m)),
699 module_unused :: Module -> Bool
700 module_unused mod = moduleName mod `elem` unused_imp_mods
702 warnDeprecations this_mod export_avails my_deprecs used_names
703 = doptRn Opt_WarnDeprecations `thenRn` \ warn_drs ->
704 if not warn_drs then returnRn () else
706 -- The home modules for things in the export list
707 -- may not have been loaded yet; do it now, so
708 -- that we can see their deprecations, if any
709 mapRn_ load_home export_mods `thenRn_`
711 getIfacesRn `thenRn` \ ifaces ->
712 getHomeIfaceTableRn `thenRn` \ hit ->
716 | n <- nameSetToList used_names,
717 Just txt <- [lookup_deprec hit pit n] ]
719 mapRn_ warnDeprec deprecs
722 export_mods = nub [ moduleName (nameModule name)
723 | avail <- export_avails,
724 let name = availName avail,
725 not (nameIsLocalOrFrom this_mod name) ]
727 load_home m = loadInterface (text "Check deprecations for" <+> ppr m) m ImportBySystem
729 lookup_deprec hit pit n
730 | nameIsLocalOrFrom this_mod n
731 = lookupDeprec my_deprecs n
733 = case lookupIface hit pit n of
734 Just iface -> lookupDeprec (mi_deprecs iface) n
735 Nothing -> pprPanic "warnDeprecations:" (ppr n)
737 -- ToDo: deal with original imports with 'qualified' and 'as M' clauses
738 printMinimalImports this_mod unqual imps
739 = doptRn Opt_D_dump_minimal_imports `thenRn` \ dump_minimal ->
740 if not dump_minimal then returnRn () else
742 mapRn to_ies (fmToList imps) `thenRn` \ mod_ies ->
743 ioToRnM (do { h <- openFile filename WriteMode ;
744 printForUser h unqual (vcat (map ppr_mod_ie mod_ies))
748 filename = moduleNameUserString (moduleName this_mod) ++ ".imports"
749 ppr_mod_ie (mod_name, ies)
750 | mod_name == pRELUDE_Name
753 = ptext SLIT("import") <+> ppr mod_name <>
754 parens (fsep (punctuate comma (map ppr ies)))
756 to_ies (mod, avail_env) = mapRn to_ie (availEnvElts avail_env) `thenRn` \ ies ->
759 to_ie :: AvailInfo -> RnMG (IE Name)
760 to_ie (Avail n) = returnRn (IEVar n)
761 to_ie (AvailTC n [m]) = ASSERT( n==m )
762 returnRn (IEThingAbs n)
764 = getInterfaceExports n_mod ImportBySystem `thenRn` \ (_, avails_by_module) ->
765 case [xs | (m,as) <- avails_by_module,
769 [xs] | all (`elem` ns) xs -> returnRn (IEThingAll n)
770 | otherwise -> returnRn (IEThingWith n (filter (/= n) ns))
771 other -> pprTrace "to_ie" (ppr n <+> ppr (nameModule n) <+> ppr other) $
774 n_mod = moduleName (nameModule n)
776 rnDump :: [RenamedHsDecl] -- Renamed imported decls
777 -> [RenamedHsDecl] -- Renamed local decls
779 rnDump imp_decls local_decls
780 = doptRn Opt_D_dump_rn_trace `thenRn` \ dump_rn_trace ->
781 doptRn Opt_D_dump_rn_stats `thenRn` \ dump_rn_stats ->
782 doptRn Opt_D_dump_rn `thenRn` \ dump_rn ->
783 getIfacesRn `thenRn` \ ifaces ->
785 ioToRnM (do { dumpIfSet (dump_rn_trace || dump_rn_stats || dump_rn)
787 (getRnStats imp_decls ifaces) ;
789 dumpIfSet dump_rn "Renamer:"
790 (vcat (map ppr (local_decls ++ imp_decls)))
797 %*********************************************************
799 \subsection{Statistics}
801 %*********************************************************
804 getRnStats :: [RenamedHsDecl] -> Ifaces -> SDoc
805 getRnStats imported_decls ifaces
806 = hcat [text "Renamer stats: ", stats]
808 n_mods = length [() | _ <- moduleEnvElts (iPIT ifaces)]
809 -- This is really only right for a one-shot compile
811 (decls_map, n_decls_slurped) = iDecls ifaces
813 n_decls_left = length [decl | (avail, True, (_,decl)) <- nameEnvElts decls_map
814 -- Data, newtype, and class decls are in the decls_fm
815 -- under multiple names; the tycon/class, and each
816 -- constructor/class op too.
817 -- The 'True' selects just the 'main' decl
820 (insts_left, n_insts_slurped) = iInsts ifaces
821 n_insts_left = length (bagToList insts_left)
823 (rules_left, n_rules_slurped) = iRules ifaces
824 n_rules_left = length (bagToList rules_left)
827 [int n_mods <+> text "interfaces read",
828 hsep [ int n_decls_slurped, text "type/class/variable imported, out of",
829 int (n_decls_slurped + n_decls_left), text "read"],
830 hsep [ int n_insts_slurped, text "instance decls imported, out of",
831 int (n_insts_slurped + n_insts_left), text "read"],
832 hsep [ int n_rules_slurped, text "rule decls imported, out of",
833 int (n_rules_slurped + n_rules_left), text "read"]
838 %************************************************************************
840 \subsection{Errors and warnings}
842 %************************************************************************
845 warnDeprec :: (Name, DeprecTxt) -> RnM d ()
846 warnDeprec (name, txt)
847 = pushSrcLocRn (getSrcLoc name) $
849 sep [ text (occNameFlavour (nameOccName name)) <+> ppr name <+>
850 text "is deprecated:", nest 4 (ppr txt) ]
853 dupFixityDecl rdr_name loc1 loc2
854 = vcat [ptext SLIT("Multiple fixity declarations for") <+> quotes (ppr rdr_name),
855 ptext SLIT("at ") <+> ppr loc1,
856 ptext SLIT("and") <+> ppr loc2]
859 = sep [ptext SLIT("Illegal deprecation when whole module is deprecated"),
863 = hsep [ptext SLIT("Module"), quotes (ppr mAIN_Name),
864 ptext SLIT("must include a definition for"), quotes (ptext SLIT("main"))]