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,
32 import RnEnv ( availsToNameSet, availName, mkIfaceGlobalRdrEnv,
33 emptyAvailEnv, unitAvailEnv, availEnvElts,
34 plusAvailEnv, groupAvails, warnUnusedImports,
35 warnUnusedLocalBinds, warnUnusedModules,
36 lookupOrigNames, lookupSrcName,
37 newGlobalName, unQualInScope
39 import Module ( Module, ModuleName, WhereFrom(..),
40 moduleNameUserString, moduleName,
43 import Name ( Name, NamedThing(..), getSrcLoc,
44 nameIsLocalOrFrom, nameOccName, nameModule,
46 import Name ( mkNameEnv, nameEnvElts, extendNameEnv )
47 import RdrName ( elemRdrEnv, foldRdrEnv, isQual )
48 import OccName ( occNameFlavour )
50 import TysWiredIn ( unitTyCon, intTyCon, boolTyCon )
51 import PrelNames ( mAIN_Name, pREL_MAIN_Name, pRELUDE_Name,
52 ioTyCon_RDR, main_RDR_Unqual,
53 unpackCString_RDR, unpackCStringFoldr_RDR, unpackCStringUtf8_RDR,
56 import PrelInfo ( derivingOccurrences )
57 import Type ( funTyCon )
58 import ErrUtils ( dumpIfSet, dumpIfSet_dyn, showPass,
59 printErrorsAndWarnings, errorsFound )
60 import Bag ( bagToList )
61 import FiniteMap ( FiniteMap, fmToList, emptyFM, lookupFM,
62 addToFM_C, elemFM, addToFM
64 import UniqFM ( lookupUFM )
65 import Maybes ( maybeToBool, catMaybes )
67 import IO ( openFile, IOMode(..) )
68 import HscTypes ( PersistentCompilerState, HomeIfaceTable, HomeSymbolTable,
69 ModIface(..), WhatsImported(..),
70 VersionInfo(..), ImportVersion, IsExported,
71 IfaceDecls, mkIfaceDecls, dcl_tycl, dcl_rules, dcl_insts,
72 GlobalRdrEnv, pprGlobalRdrEnv,
73 AvailEnv, GenAvailInfo(..), AvailInfo, Avails,
74 Provenance(..), ImportReason(..), initialVersionInfo,
75 Deprecations(..), lookupDeprec, lookupIface
77 import CmStaticInfo ( GhciMode(..) )
78 import List ( partition, nub )
84 %*********************************************************
86 \subsection{The two main wrappers}
88 %*********************************************************
91 renameModule :: DynFlags
92 -> HomeIfaceTable -> HomeSymbolTable
93 -> PersistentCompilerState
94 -> Module -> RdrNameHsModule
95 -> IO (PersistentCompilerState, Maybe (PrintUnqualified, (IsExported, ModIface, [RenamedHsDecl])))
96 -- Nothing => some error occurred in the renamer
98 renameModule dflags hit hst pcs this_module rdr_module
99 = renameSource dflags hit hst pcs this_module $
100 rename this_module rdr_module
105 renameExpr :: DynFlags
106 -> HomeIfaceTable -> HomeSymbolTable
107 -> PersistentCompilerState
108 -> Module -> RdrNameHsExpr
109 -> IO ( PersistentCompilerState,
110 Maybe (PrintUnqualified, (RenamedHsExpr, [RenamedHsDecl]))
113 renameExpr dflags hit hst pcs this_module expr
114 = do { renameSource dflags hit hst pcs this_module $
115 tryLoadInterface doc (moduleName this_module) ImportByUser
116 `thenRn` \ (iface, maybe_err) ->
118 Just msg -> ioToRnM (printErrs alwaysQualify
119 (ptext SLIT("failed to load interface for")
120 <+> quotes (ppr this_module)
121 <> char ':' <+> msg)) `thenRn_`
125 let rdr_env = mi_globals iface
126 print_unqual = unQualInScope rdr_env
129 initRnMS rdr_env emptyLocalFixityEnv CmdLineMode (rnExpr expr)
130 `thenRn` \ (e,fvs) ->
132 checkErrsRn `thenRn` \ no_errs_so_far ->
133 if not no_errs_so_far then
134 -- Found errors already, so exit now
135 doDump e [] `thenRn_`
139 lookupOrigNames implicit_occs `thenRn` \ implicit_names ->
140 slurpImpDecls (fvs `plusFV` implicit_names) `thenRn` \ decls ->
142 doDump e decls `thenRn_`
143 returnRn (Just (print_unqual, (e, decls)))
146 implicit_occs = string_occs
147 doc = text "context for compiling expression"
149 doDump :: RenamedHsExpr -> [RenamedHsDecl] -> RnMG (Either IOError ())
151 getDOptsRn `thenRn` \ dflags ->
152 ioToRnM (dumpIfSet_dyn dflags Opt_D_dump_rn "Renamer:"
153 (vcat (ppr e : map ppr decls)))
157 %*********************************************************
159 \subsection{The main function: rename}
161 %*********************************************************
164 renameSource :: DynFlags
165 -> HomeIfaceTable -> HomeSymbolTable
166 -> PersistentCompilerState
168 -> RnMG (Maybe (PrintUnqualified, r))
169 -> IO (PersistentCompilerState, Maybe (PrintUnqualified, r))
170 -- Nothing => some error occurred in the renamer
172 renameSource dflags hit hst old_pcs this_module thing_inside
173 = do { showPass dflags "Renamer"
175 -- Initialise the renamer monad
176 ; (new_pcs, msgs, maybe_rn_stuff) <- initRn dflags hit hst old_pcs this_module thing_inside
178 -- Print errors from renaming
179 ; let print_unqual = case maybe_rn_stuff of
180 Just (unqual, _) -> unqual
181 Nothing -> alwaysQualify
183 ; printErrorsAndWarnings print_unqual msgs ;
185 -- Return results. No harm in updating the PCS
186 ; if errorsFound msgs then
187 return (new_pcs, Nothing)
189 return (new_pcs, maybe_rn_stuff)
194 rename :: Module -> RdrNameHsModule -> RnMG (Maybe (PrintUnqualified, (IsExported, ModIface, [RenamedHsDecl])))
195 rename this_module contents@(HsModule _ _ exports imports local_decls mod_deprec loc)
198 -- FIND THE GLOBAL NAME ENVIRONMENT
199 getGlobalNames this_module contents `thenRn` \ (gbl_env, local_gbl_env, all_avails@(_, global_avail_env)) ->
201 -- Exit if we've found any errors
202 checkErrsRn `thenRn` \ no_errs_so_far ->
203 if not no_errs_so_far then
204 -- Found errors already, so exit now
205 rnDump [] [] `thenRn_`
209 -- PROCESS EXPORT LIST
210 exportsFromAvail mod_name exports all_avails gbl_env `thenRn` \ export_avails ->
212 traceRn (text "Local top-level environment" $$
213 nest 4 (pprGlobalRdrEnv local_gbl_env)) `thenRn_`
215 -- DEAL WITH DEPRECATIONS
216 rnDeprecs local_gbl_env mod_deprec
217 [d | DeprecD d <- local_decls] `thenRn` \ my_deprecs ->
219 -- DEAL WITH LOCAL FIXITIES
220 fixitiesFromLocalDecls local_gbl_env local_decls `thenRn` \ local_fixity_env ->
223 rnSourceDecls gbl_env local_fixity_env local_decls `thenRn` \ (rn_local_decls, source_fvs) ->
225 -- CHECK THAT main IS DEFINED, IF REQUIRED
226 checkMain this_module local_gbl_env `thenRn_`
228 -- EXIT IF ERRORS FOUND
229 -- We exit here if there are any errors in the source, *before*
230 -- we attempt to slurp the decls from the interfaces, otherwise
231 -- the slurped decls may get lost when we return up the stack
232 -- to hscMain/hscExpr.
233 checkErrsRn `thenRn` \ no_errs_so_far ->
234 if not no_errs_so_far then
235 -- Found errors already, so exit now
236 rnDump [] rn_local_decls `thenRn_`
240 -- SLURP IN ALL THE NEEDED DECLARATIONS
241 implicitFVs mod_name rn_local_decls `thenRn` \ implicit_fvs ->
243 slurp_fvs = implicit_fvs `plusFV` source_fvs
244 -- It's important to do the "plus" this way round, so that
245 -- when compiling the prelude, locally-defined (), Bool, etc
246 -- override the implicit ones.
248 traceRn (text "Source FVs:" <+> fsep (map ppr (nameSetToList slurp_fvs))) `thenRn_`
249 slurpImpDecls slurp_fvs `thenRn` \ rn_imp_decls ->
251 rnDump rn_imp_decls rn_local_decls `thenRn_`
253 -- GENERATE THE VERSION/USAGE INFO
254 mkImportInfo mod_name imports `thenRn` \ my_usages ->
256 -- BUILD THE MODULE INTERFACE
258 -- We record fixities even for things that aren't exported,
259 -- so that we can change into the context of this moodule easily
260 fixities = mkNameEnv [ (name, fixity)
261 | FixitySig name fixity loc <- nameEnvElts local_fixity_env
264 -- Sort the exports to make them easier to compare for versions
265 my_exports = groupAvails this_module export_avails
267 final_decls = rn_local_decls ++ rn_imp_decls
268 is_orphan = any (isOrphanDecl this_module) rn_local_decls
270 mod_iface = ModIface { mi_module = this_module,
271 mi_version = initialVersionInfo,
272 mi_usages = my_usages,
274 mi_orphan = is_orphan,
275 mi_exports = my_exports,
276 mi_globals = gbl_env,
277 mi_fixities = fixities,
278 mi_deprecs = my_deprecs,
279 mi_decls = panic "mi_decls"
282 print_unqualified = unQualInScope gbl_env
283 is_exported name = name `elemNameSet` exported_names
284 exported_names = availsToNameSet export_avails
287 -- REPORT UNUSED NAMES, AND DEBUG DUMP
288 reportUnusedNames mod_iface print_unqualified
289 imports global_avail_env
290 source_fvs export_avails rn_imp_decls `thenRn_`
292 returnRn (Just (print_unqualified, (is_exported, mod_iface, final_decls)))
294 mod_name = moduleName this_module
297 Checking that main is defined
300 checkMain :: Module -> GlobalRdrEnv -> RnMG ()
301 checkMain this_mod local_env
302 | moduleName this_mod == mAIN_Name
303 = checkRn (main_RDR_Unqual `elemRdrEnv` local_env) noMainErr
308 @implicitFVs@ forces the renamer to slurp in some things which aren't
309 mentioned explicitly, but which might be needed by the type checker.
312 implicitFVs mod_name decls
313 = lookupOrigNames implicit_occs `thenRn` \ implicit_names ->
314 returnRn (mkNameSet (map getName default_tycons) `plusFV`
317 -- Add occurrences for Int, and (), because they
318 -- are the types to which ambigious type variables may be defaulted by
319 -- the type checker; so they won't always appear explicitly.
320 -- [The () one is a GHC extension for defaulting CCall results.]
321 -- ALSO: funTyCon, since it occurs implicitly everywhere!
322 -- (we don't want to be bothered with making funTyCon a
323 -- free var at every function application!)
324 -- Double is dealt with separately in getGates
325 default_tycons = [unitTyCon, funTyCon, boolTyCon, intTyCon]
327 -- Add occurrences for IO or PrimIO
328 implicit_main | mod_name == mAIN_Name
329 || mod_name == pREL_MAIN_Name = [ioTyCon_RDR]
332 -- Now add extra "occurrences" for things that
333 -- the deriving mechanism, or defaulting, will later need in order to
335 implicit_occs = string_occs ++ foldr ((++) . get) implicit_main decls
338 get (TyClD (TyData {tcdDerivs = Just deriv_classes})) = concat (map get_deriv deriv_classes)
341 get_deriv cls = case lookupUFM derivingOccurrences cls of
345 -- Virtually every program has error messages in it somewhere
346 string_occs = [unpackCString_RDR, unpackCStringFoldr_RDR,
347 unpackCStringUtf8_RDR, eqString_RDR]
351 isOrphanDecl this_mod (InstD (InstDecl inst_ty _ _ _ _))
352 = not (foldNameSet ((||) . nameIsLocalOrFrom this_mod) False
353 (extractHsTyNames (removeContext inst_ty)))
354 -- The 'removeContext' is because of
355 -- instance Foo a => Baz T where ...
356 -- The decl is an orphan if Baz and T are both not locally defined,
357 -- even if Foo *is* locally defined
359 isOrphanDecl this_mod (RuleD (HsRule _ _ _ lhs _ _))
362 -- At the moment we just check for common LHS forms
363 -- Expand as necessary. Getting it wrong just means
364 -- more orphans than necessary
365 check (HsVar v) = not (nameIsLocalOrFrom this_mod v)
366 check (HsApp f a) = check f && check a
367 check (HsLit _) = False
368 check (HsOverLit _) = False
369 check (OpApp l o _ r) = check l && check o && check r
370 check (NegApp e _) = check e
371 check (HsPar e) = check e
372 check (SectionL e o) = check e && check o
373 check (SectionR o e) = check e && check o
375 check other = True -- Safe fall through
377 isOrphanDecl _ _ = False
381 %*********************************************************
383 \subsection{Fixities}
385 %*********************************************************
388 fixitiesFromLocalDecls :: GlobalRdrEnv -> [RdrNameHsDecl] -> RnMG LocalFixityEnv
389 fixitiesFromLocalDecls gbl_env decls
390 = foldlRn getFixities emptyNameEnv decls `thenRn` \ env ->
391 traceRn (text "fixity env" <+> vcat (map ppr (nameEnvElts env))) `thenRn_`
394 getFixities :: LocalFixityEnv -> RdrNameHsDecl -> RnMG LocalFixityEnv
395 getFixities acc (FixD fix)
398 getFixities acc (TyClD (ClassDecl { tcdSigs = sigs}))
399 = foldlRn fix_decl acc [sig | FixSig sig <- sigs]
400 -- Get fixities from class decl sigs too.
401 getFixities acc other_decl
404 fix_decl acc sig@(FixitySig rdr_name fixity loc)
405 = -- Check for fixity decl for something not declared
407 lookupSrcName gbl_env rdr_name `thenRn` \ name ->
409 -- Check for duplicate fixity decl
410 case lookupNameEnv acc name of
411 Just (FixitySig _ _ loc') -> addErrRn (dupFixityDecl rdr_name loc loc') `thenRn_`
414 Nothing -> returnRn (extendNameEnv acc name (FixitySig name fixity loc))
418 %*********************************************************
420 \subsection{Deprecations}
422 %*********************************************************
424 For deprecations, all we do is check that the names are in scope.
425 It's only imported deprecations, dealt with in RnIfaces, that we
426 gather them together.
429 rnDeprecs :: GlobalRdrEnv -> Maybe DeprecTxt
430 -> [RdrNameDeprecation] -> RnMG Deprecations
431 rnDeprecs gbl_env Nothing []
434 rnDeprecs gbl_env (Just txt) decls
435 = mapRn (addErrRn . badDeprec) decls `thenRn_`
436 returnRn (DeprecAll txt)
438 rnDeprecs gbl_env Nothing decls
439 = mapRn rn_deprec decls `thenRn` \ pairs ->
440 returnRn (DeprecSome (mkNameEnv (catMaybes pairs)))
442 rn_deprec (Deprecation rdr_name txt loc)
444 lookupSrcName gbl_env rdr_name `thenRn` \ name ->
445 returnRn (Just (name, (name,txt)))
449 %************************************************************************
451 \subsection{Grabbing the old interface file and checking versions}
453 %************************************************************************
456 checkOldIface :: GhciMode
458 -> HomeIfaceTable -> HomeSymbolTable
459 -> PersistentCompilerState
461 -> Bool -- Source unchanged
462 -> Maybe ModIface -- Old interface from compilation manager, if any
463 -> IO (PersistentCompilerState, Bool, (RecompileRequired, Maybe ModIface))
464 -- True <=> errors happened
466 checkOldIface ghci_mode dflags hit hst pcs iface_path source_unchanged maybe_iface
468 -- If the source has changed and we're in interactive mode, avoid reading
469 -- an interface; just return the one we might have been supplied with.
470 | ghci_mode == Interactive && not source_unchanged
471 = return (pcs, False, (outOfDate, maybe_iface))
474 = runRn dflags hit hst pcs (panic "Bogus module") $
476 Just old_iface -> -- Use the one we already have
477 setModuleRn (mi_module old_iface) (check_versions old_iface)
479 Nothing -- try and read it from a file
480 -> readIface iface_path `thenRn` \ read_result ->
482 Left err -> -- Old interface file not found, or garbled; give up
483 traceRn (text "Bad old interface file" $$ nest 4 err) `thenRn_`
484 returnRn (outOfDate, Nothing)
487 -> setModuleRn (pi_mod parsed_iface) $
488 loadOldIface parsed_iface `thenRn` \ m_iface ->
489 check_versions m_iface
491 check_versions :: ModIface -> RnMG (RecompileRequired, Maybe ModIface)
494 recompileRequired iface_path source_unchanged iface
495 `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))
614 -- Record that we have now got declarations for local_names
615 recordLocalSlurps local_names `thenRn_`
617 -- Do the transitive closure
618 lookupOrigNames implicit_occs `thenRn` \ implicit_names ->
619 closeDecls decls (needed `plusFV` implicit_names) `thenRn` \closed_decls ->
620 rnDump [] closed_decls `thenRn_`
621 returnRn closed_decls
623 implicit_occs = string_occs -- Data type decls with record selectors,
624 -- which may appear in the decls, need unpackCString
625 -- and friends. It's easier to just grab them right now.
628 %*********************************************************
630 \subsection{Unused names}
632 %*********************************************************
635 reportUnusedNames :: ModIface -> PrintUnqualified
636 -> [RdrNameImportDecl]
638 -> NameSet -- Used in this module
639 -> Avails -- Exported by this module
642 reportUnusedNames my_mod_iface unqual imports avail_env
643 source_fvs export_avails imported_decls
644 = warnUnusedModules unused_imp_mods `thenRn_`
645 warnUnusedLocalBinds bad_locals `thenRn_`
646 warnUnusedImports bad_imp_names `thenRn_`
647 printMinimalImports this_mod unqual minimal_imports `thenRn_`
648 warnDeprecations this_mod export_avails my_deprecs
652 this_mod = mi_module my_mod_iface
653 gbl_env = mi_globals my_mod_iface
654 my_deprecs = mi_deprecs my_mod_iface
656 -- The export_fvs make the exported names look just as if they
657 -- occurred in the source program.
658 export_fvs = availsToNameSet export_avails
659 used_names = source_fvs `plusFV` export_fvs
661 -- Now, a use of C implies a use of T,
662 -- if C was brought into scope by T(..) or T(C)
663 really_used_names = used_names `unionNameSets`
664 mkNameSet [ parent_name
665 | sub_name <- nameSetToList used_names
667 -- Usually, every used name will appear in avail_env, but there
668 -- is one time when it doesn't: tuples and other built in syntax. When you
669 -- write (a,b) that gives rise to a *use* of "(,)", so that the
670 -- instances will get pulled in, but the tycon "(,)" isn't actually
671 -- in scope. Also, (-x) gives rise to an implicit use of 'negate';
672 -- similarly, 3.5 gives rise to an implcit use of :%
673 -- Hence the silent 'False' in all other cases
675 , Just parent_name <- [case lookupNameEnv avail_env sub_name of
676 Just (AvailTC n _) -> Just n
680 -- Collect the defined names from the in-scope environment
681 -- Look for the qualified ones only, else get duplicates
682 defined_names :: [(Name,Provenance)]
683 defined_names = foldRdrEnv add [] gbl_env
684 add rdr_name ns acc | isQual rdr_name = ns ++ acc
687 defined_and_used, defined_but_not_used :: [(Name,Provenance)]
688 (defined_and_used, defined_but_not_used) = partition used defined_names
689 used (name,_) = name `elemNameSet` really_used_names
691 -- Filter out the ones only defined implicitly
693 bad_locals = [n | (n,LocalDef) <- defined_but_not_used]
695 bad_imp_names :: [(Name,Provenance)]
696 bad_imp_names = [(n,p) | (n,p@(NonLocalDef (UserImport mod _ True))) <- defined_but_not_used,
697 not (module_unused mod)]
699 -- inst_mods are directly-imported modules that
700 -- contain instance decl(s) that the renamer decided to suck in
701 -- It's not necessarily redundant to import such modules.
707 -- The import M() is not *necessarily* redundant, even if
708 -- we suck in no instance decls from M (e.g. it contains
709 -- no instance decls, or This contains no code). It may be
710 -- that we import M solely to ensure that M's orphan instance
711 -- decls (or those in its imports) are visible to people who
712 -- import This. Sigh.
713 -- There's really no good way to detect this, so the error message
714 -- in RnEnv.warnUnusedModules is weakened instead
715 inst_mods :: [ModuleName]
716 inst_mods = [m | InstD (InstDecl _ _ _ (Just dfun) _) <- imported_decls,
717 let m = moduleName (nameModule dfun),
718 m `elem` direct_import_mods
721 -- To figure out the minimal set of imports, start with the things
722 -- that are in scope (i.e. in gbl_env). Then just combine them
723 -- into a bunch of avails, so they are properly grouped
724 minimal_imports :: FiniteMap ModuleName AvailEnv
725 minimal_imports0 = emptyFM
726 minimal_imports1 = foldr add_name minimal_imports0 defined_and_used
727 minimal_imports = foldr add_inst_mod minimal_imports1 inst_mods
729 -- We've carefully preserved the provenance so that we can
730 -- construct minimal imports that import the name by (one of)
731 -- the same route(s) as the programmer originally did.
732 add_name (n,NonLocalDef (UserImport m _ _)) acc = addToFM_C plusAvailEnv acc (moduleName m)
733 (unitAvailEnv (mk_avail n))
734 add_name (n,other_prov) acc = acc
736 mk_avail n = case lookupNameEnv avail_env n of
737 Just (AvailTC m _) | n==m -> AvailTC n [n]
738 | otherwise -> AvailTC m [n,m]
739 Just avail -> Avail n
740 Nothing -> pprPanic "mk_avail" (ppr n)
743 | m `elemFM` acc = acc -- We import something already
744 | otherwise = addToFM acc m emptyAvailEnv
745 -- Add an empty collection of imports for a module
746 -- from which we have sucked only instance decls
748 direct_import_mods :: [ModuleName]
749 direct_import_mods = nub [m | ImportDecl m _ _ _ _ _ <- imports]
751 -- unused_imp_mods are the directly-imported modules
752 -- that are not mentioned in minimal_imports
753 unused_imp_mods = [m | m <- direct_import_mods,
754 not (maybeToBool (lookupFM minimal_imports m)),
757 module_unused :: Module -> Bool
758 module_unused mod = moduleName mod `elem` unused_imp_mods
760 warnDeprecations this_mod export_avails my_deprecs used_names
761 = doptRn Opt_WarnDeprecations `thenRn` \ warn_drs ->
762 if not warn_drs then returnRn () else
764 -- The home modules for things in the export list
765 -- may not have been loaded yet; do it now, so
766 -- that we can see their deprecations, if any
767 mapRn_ load_home export_mods `thenRn_`
769 getIfacesRn `thenRn` \ ifaces ->
770 getHomeIfaceTableRn `thenRn` \ hit ->
774 | n <- nameSetToList used_names,
775 not (nameIsLocalOrFrom this_mod n),
776 Just txt <- [lookup_deprec hit pit n] ]
777 -- nameIsLocalOrFrom: don't complain about locally defined names
778 -- For a start, we may be exporting a deprecated thing
779 -- Also we may use a deprecated thing in the defn of another
780 -- deprecated things. We may even use a deprecated thing in
781 -- the defn of a non-deprecated thing, when changing a module's
784 mapRn_ warnDeprec deprecs
787 export_mods = nub [ moduleName mod
788 | avail <- export_avails,
789 let mod = nameModule (availName avail),
792 load_home m = loadInterface (text "Check deprecations for" <+> ppr m) m ImportBySystem
794 lookup_deprec hit pit n
795 = case lookupIface hit pit n of
796 Just iface -> lookupDeprec (mi_deprecs iface) n
797 Nothing -> pprPanic "warnDeprecations:" (ppr n)
799 -- ToDo: deal with original imports with 'qualified' and 'as M' clauses
800 printMinimalImports this_mod unqual imps
801 = doptRn Opt_D_dump_minimal_imports `thenRn` \ dump_minimal ->
802 if not dump_minimal then returnRn () else
804 mapRn to_ies (fmToList imps) `thenRn` \ mod_ies ->
805 ioToRnM (do { h <- openFile filename WriteMode ;
806 printForUser h unqual (vcat (map ppr_mod_ie mod_ies))
810 filename = moduleNameUserString (moduleName this_mod) ++ ".imports"
811 ppr_mod_ie (mod_name, ies)
812 | mod_name == pRELUDE_Name
815 = ptext SLIT("import") <+> ppr mod_name <>
816 parens (fsep (punctuate comma (map ppr ies)))
818 to_ies (mod, avail_env) = mapRn to_ie (availEnvElts avail_env) `thenRn` \ ies ->
821 to_ie :: AvailInfo -> RnMG (IE Name)
822 to_ie (Avail n) = returnRn (IEVar n)
823 to_ie (AvailTC n [m]) = ASSERT( n==m )
824 returnRn (IEThingAbs n)
826 = getInterfaceExports n_mod ImportBySystem `thenRn` \ (_, avails_by_module) ->
827 case [xs | (m,as) <- avails_by_module,
831 [xs] | all (`elem` ns) xs -> returnRn (IEThingAll n)
832 | otherwise -> returnRn (IEThingWith n (filter (/= n) ns))
833 other -> pprTrace "to_ie" (ppr n <+> ppr (nameModule n) <+> ppr other) $
836 n_mod = moduleName (nameModule n)
838 rnDump :: [RenamedHsDecl] -- Renamed imported decls
839 -> [RenamedHsDecl] -- Renamed local decls
841 rnDump imp_decls local_decls
842 = doptRn Opt_D_dump_rn_trace `thenRn` \ dump_rn_trace ->
843 doptRn Opt_D_dump_rn_stats `thenRn` \ dump_rn_stats ->
844 doptRn Opt_D_dump_rn `thenRn` \ dump_rn ->
845 getIfacesRn `thenRn` \ ifaces ->
847 ioToRnM (do { dumpIfSet (dump_rn_trace || dump_rn_stats || dump_rn)
849 (getRnStats imp_decls ifaces) ;
851 dumpIfSet dump_rn "Renamer:"
852 (vcat (map ppr (local_decls ++ imp_decls)))
859 %*********************************************************
861 \subsection{Statistics}
863 %*********************************************************
866 getRnStats :: [RenamedHsDecl] -> Ifaces -> SDoc
867 getRnStats imported_decls ifaces
868 = hcat [text "Renamer stats: ", stats]
870 n_mods = length [() | _ <- moduleEnvElts (iPIT ifaces)]
871 -- This is really only right for a one-shot compile
873 (decls_map, n_decls_slurped) = iDecls ifaces
875 n_decls_left = length [decl | (avail, True, (_,decl)) <- nameEnvElts decls_map
876 -- Data, newtype, and class decls are in the decls_fm
877 -- under multiple names; the tycon/class, and each
878 -- constructor/class op too.
879 -- The 'True' selects just the 'main' decl
882 (insts_left, n_insts_slurped) = iInsts ifaces
883 n_insts_left = length (bagToList insts_left)
885 (rules_left, n_rules_slurped) = iRules ifaces
886 n_rules_left = length (bagToList rules_left)
889 [int n_mods <+> text "interfaces read",
890 hsep [ int n_decls_slurped, text "type/class/variable imported, out of",
891 int (n_decls_slurped + n_decls_left), text "read"],
892 hsep [ int n_insts_slurped, text "instance decls imported, out of",
893 int (n_insts_slurped + n_insts_left), text "read"],
894 hsep [ int n_rules_slurped, text "rule decls imported, out of",
895 int (n_rules_slurped + n_rules_left), text "read"]
900 %************************************************************************
902 \subsection{Errors and warnings}
904 %************************************************************************
907 warnDeprec :: (Name, DeprecTxt) -> RnM d ()
908 warnDeprec (name, txt)
909 = pushSrcLocRn (getSrcLoc name) $
911 sep [ text (occNameFlavour (nameOccName name)) <+> ppr name <+>
912 text "is deprecated:", nest 4 (ppr txt) ]
915 dupFixityDecl rdr_name loc1 loc2
916 = vcat [ptext SLIT("Multiple fixity declarations for") <+> quotes (ppr rdr_name),
917 ptext SLIT("at ") <+> ppr loc1,
918 ptext SLIT("and") <+> ppr loc2]
921 = sep [ptext SLIT("Illegal deprecation when whole module is deprecated"),
925 = hsep [ptext SLIT("Module"), quotes (ppr mAIN_Name),
926 ptext SLIT("must include a definition for"), quotes (ptext SLIT("main"))]