2 % (c) The GRASP Project, Glasgow University, 1992-1998
4 \section[Rename]{Renaming and dependency analysis passes}
7 module Rename ( renameModule ) where
9 #include "HsVersions.h"
12 import RdrHsSyn ( RdrNameHsModule, RdrNameHsDecl, RdrNameDeprecation )
13 import RnHsSyn ( RenamedHsDecl,
14 extractHsTyNames, extractHsCtxtTyNames
17 import CmdLineOpts ( DynFlags, DynFlag(..) )
19 import RnNames ( getGlobalNames )
20 import RnSource ( rnSourceDecls, rnDecl )
21 import RnIfaces ( getImportedInstDecls, importDecl, mkImportInfo,
23 getImportedRules, getSlurped,
26 import RnHiFiles ( removeContext )
27 import RnEnv ( availName, availsToNameSet,
28 emptyAvailEnv, unitAvailEnv, availEnvElts, plusAvailEnv, sortAvails,
29 warnUnusedImports, warnUnusedLocalBinds, warnUnusedModules,
30 lookupOrigNames, lookupGlobalRn,
31 FreeVars, plusFVs, plusFV, unitFV, emptyFVs, isEmptyFVs, addOneFV
33 import Module ( Module, ModuleName, WhereFrom(..),
34 moduleNameUserString, moduleName,
37 import Name ( Name, isLocallyDefined, NamedThing(..), getSrcLoc,
38 nameOccName, nameUnique, nameModule,
39 mkNameEnv, nameEnvElts, extendNameEnv
41 import OccName ( occNameFlavour )
43 import TyCon ( isSynTyCon, getSynTyConDefn )
45 import TysWiredIn ( unitTyCon, intTyCon, doubleTyCon, boolTyCon )
46 import PrelNames ( mAIN_Name, pREL_MAIN_Name, pRELUDE_Name,
48 unpackCString_RDR, unpackCStringFoldr_RDR, unpackCStringUtf8_RDR,
51 import PrelInfo ( fractionalClassKeys, derivingOccurrences, wiredInThingEnv )
52 import Type ( namesOfType, funTyCon )
53 import ErrUtils ( printErrorsAndWarnings, dumpIfSet )
54 import Bag ( isEmptyBag, bagToList )
55 import FiniteMap ( FiniteMap, eltsFM, fmToList, emptyFM, lookupFM,
56 addToFM_C, elemFM, addToFM
58 import UniqFM ( lookupUFM )
59 import Maybes ( maybeToBool, catMaybes )
61 import IO ( openFile, IOMode(..) )
62 import HscTypes ( Finder, PersistentCompilerState, HomeIfaceTable, HomeSymbolTable,
63 ModIface(..), TyThing(..),
64 GlobalRdrEnv, AvailEnv, Avails, GenAvailInfo(..), AvailInfo,
65 Provenance(..), ImportReason(..), initialVersionInfo,
66 Deprecations(..), lookupDeprec
68 import List ( partition, nub )
74 renameModule :: DynFlags -> Finder
75 -> HomeIfaceTable -> HomeSymbolTable
76 -> PersistentCompilerState
77 -> Module -> RdrNameHsModule
78 -> IO (PersistentCompilerState, Maybe (ModIface, [RenamedHsDecl]))
80 renameModule dflags finder hit hst old_pcs this_module
81 this_mod@(HsModule _ _ _ _ _ _ loc)
82 = -- Initialise the renamer monad
84 ((maybe_rn_stuff, dump_action), (rn_warns_bag, rn_errs_bag), new_pcs)
85 <- initRn dflags finder hit hst old_pcs this_module loc (rename this_module this_mod) ;
88 printErrorsAndWarnings (rn_warns_bag, rn_errs_bag) ;
90 -- Dump any debugging output
94 if not (isEmptyBag rn_errs_bag) then
95 return (old_pcs, Nothing)
97 return (new_pcs, maybe_rn_stuff)
102 rename :: Module -> RdrNameHsModule -> RnMG (Maybe (ModIface, [RenamedHsDecl]), IO ())
103 rename this_module this_mod@(HsModule mod_name vers exports imports local_decls mod_deprec loc)
104 = -- FIND THE GLOBAL NAME ENVIRONMENT
105 getGlobalNames this_mod `thenRn` \ maybe_stuff ->
107 -- CHECK FOR EARLY EXIT
108 case maybe_stuff of {
109 Nothing -> -- Everything is up to date; no need to recompile further
110 rnDump [] [] `thenRn` \ dump_action ->
111 returnRn (Nothing, dump_action) ;
113 Just (gbl_env, local_gbl_env, export_avails, global_avail_env) ->
115 -- DEAL WITH DEPRECATIONS
116 rnDeprecs local_gbl_env mod_deprec
117 [d | DeprecD d <- local_decls] `thenRn` \ my_deprecs ->
119 -- DEAL WITH LOCAL FIXITIES
120 fixitiesFromLocalDecls local_gbl_env local_decls `thenRn` \ local_fixity_env ->
123 initRnMS gbl_env local_fixity_env SourceMode (
124 rnSourceDecls local_decls
125 ) `thenRn` \ (rn_local_decls, source_fvs) ->
127 -- SLURP IN ALL THE NEEDED DECLARATIONS
128 implicitFVs mod_name rn_local_decls `thenRn` \ implicit_fvs ->
130 -- The export_fvs make the exported names look just as if they
131 -- occurred in the source program. For the reasoning, see the
132 -- comments with RnIfaces.getImportVersions.
133 -- We only need the 'parent name' of the avail;
134 -- that's enough to suck in the declaration.
135 export_fvs = mkNameSet (map availName export_avails)
136 real_source_fvs = source_fvs `plusFV` export_fvs
138 slurp_fvs = implicit_fvs `plusFV` real_source_fvs
139 -- It's important to do the "plus" this way round, so that
140 -- when compiling the prelude, locally-defined (), Bool, etc
141 -- override the implicit ones.
143 slurpImpDecls slurp_fvs `thenRn` \ rn_imp_decls ->
145 -- EXIT IF ERRORS FOUND
146 rnDump rn_imp_decls rn_local_decls `thenRn` \ dump_action ->
147 checkErrsRn `thenRn` \ no_errs_so_far ->
148 if not no_errs_so_far then
149 -- Found errors already, so exit now
150 returnRn (Nothing, dump_action)
153 -- GENERATE THE VERSION/USAGE INFO
154 mkImportInfo mod_name imports `thenRn` \ my_usages ->
156 -- RETURN THE RENAMED MODULE
157 getNameSupplyRn `thenRn` \ name_supply ->
158 getIfacesRn `thenRn` \ ifaces ->
160 direct_import_mods :: [ModuleName]
161 direct_import_mods = nub [m | ImportDecl m _ _ _ _ _ <- imports]
163 -- We record fixities even for things that aren't exported,
164 -- so that we can change into the context of this moodule easily
165 fixities = mkNameEnv [ (name, fixity)
166 | FixitySig name fixity loc <- nameEnvElts local_fixity_env
170 -- Sort the exports to make them easier to compare for versions
171 my_exports = sortAvails export_avails
173 mod_iface = ModIface { mi_module = this_module,
174 mi_version = initialVersionInfo,
175 mi_orphan = any isOrphanDecl rn_local_decls,
176 mi_exports = my_exports,
177 mi_globals = gbl_env,
178 mi_usages = my_usages,
179 mi_fixities = fixities,
180 mi_deprecs = my_deprecs,
181 mi_decls = panic "mi_decls"
184 final_decls = rn_local_decls ++ rn_imp_decls
187 -- REPORT UNUSED NAMES, AND DEBUG DUMP
188 reportUnusedNames mod_name direct_import_mods
189 gbl_env global_avail_env
190 export_avails source_fvs
191 rn_imp_decls `thenRn_`
193 returnRn (Just (mod_iface, final_decls), dump_action) }
196 @implicitFVs@ forces the renamer to slurp in some things which aren't
197 mentioned explicitly, but which might be needed by the type checker.
200 implicitFVs mod_name decls
201 = lookupOrigNames implicit_occs `thenRn` \ implicit_names ->
202 returnRn (mkNameSet (map getName default_tycons) `plusFV`
205 -- Add occurrences for Int, and (), because they
206 -- are the types to which ambigious type variables may be defaulted by
207 -- the type checker; so they won't always appear explicitly.
208 -- [The () one is a GHC extension for defaulting CCall results.]
209 -- ALSO: funTyCon, since it occurs implicitly everywhere!
210 -- (we don't want to be bothered with making funTyCon a
211 -- free var at every function application!)
212 -- Double is dealt with separately in getGates
213 default_tycons = [unitTyCon, funTyCon, boolTyCon, intTyCon]
215 -- Add occurrences for IO or PrimIO
216 implicit_main | mod_name == mAIN_Name
217 || mod_name == pREL_MAIN_Name = [ioTyCon_RDR]
220 -- Now add extra "occurrences" for things that
221 -- the deriving mechanism, or defaulting, will later need in order to
223 implicit_occs = string_occs ++ foldr ((++) . get) implicit_main decls
225 -- Virtually every program has error messages in it somewhere
226 string_occs = [unpackCString_RDR, unpackCStringFoldr_RDR, unpackCStringUtf8_RDR,
229 get (TyClD (TyData _ _ _ _ _ _ (Just deriv_classes) _ _ _))
230 = concat (map get_deriv deriv_classes)
233 get_deriv cls = case lookupUFM derivingOccurrences cls of
239 isOrphanDecl (InstD (InstDecl inst_ty _ _ _ _))
240 = not (foldNameSet ((||) . isLocallyDefined) False (extractHsTyNames (removeContext inst_ty)))
241 -- The 'removeContext' is because of
242 -- instance Foo a => Baz T where ...
243 -- The decl is an orphan if Baz and T are both not locally defined,
244 -- even if Foo *is* locally defined
246 isOrphanDecl (RuleD (HsRule _ _ _ lhs _ _))
249 -- At the moment we just check for common LHS forms
250 -- Expand as necessary. Getting it wrong just means
251 -- more orphans than necessary
252 check (HsVar v) = not (isLocallyDefined v)
253 check (HsApp f a) = check f && check a
254 check (HsLit _) = False
255 check (HsOverLit _) = False
256 check (OpApp l o _ r) = check l && check o && check r
257 check (NegApp e _) = check e
258 check (HsPar e) = check e
259 check (SectionL e o) = check e && check o
260 check (SectionR o e) = check e && check o
262 check other = True -- Safe fall through
264 isOrphanDecl other = False
268 %*********************************************************
270 \subsection{Slurping declarations}
272 %*********************************************************
275 -------------------------------------------------------
276 slurpImpDecls source_fvs
277 = traceRn (text "slurpImp" <+> fsep (map ppr (nameSetToList source_fvs))) `thenRn_`
279 -- The current slurped-set records all local things
280 getSlurped `thenRn` \ source_binders ->
281 slurpSourceRefs source_binders source_fvs `thenRn` \ (decls, needed) ->
283 -- Then get everything else
284 closeDecls decls needed `thenRn` \ decls1 ->
286 -- Finally, get any deferred data type decls
287 slurpDeferredDecls decls1 `thenRn` \ final_decls ->
291 -------------------------------------------------------
292 slurpSourceRefs :: NameSet -- Variables defined in source
293 -> FreeVars -- Variables referenced in source
294 -> RnMG ([RenamedHsDecl],
295 FreeVars) -- Un-satisfied needs
296 -- The declaration (and hence home module) of each gate has
297 -- already been loaded
299 slurpSourceRefs source_binders source_fvs
300 = go_outer [] -- Accumulating decls
301 emptyFVs -- Unsatisfied needs
302 emptyFVs -- Accumulating gates
303 (nameSetToList source_fvs) -- Things whose defn hasn't been loaded yet
305 -- The outer loop repeatedly slurps the decls for the current gates
306 -- and the instance decls
308 -- The outer loop is needed because consider
309 -- instance Foo a => Baz (Maybe a) where ...
310 -- It may be that @Baz@ and @Maybe@ are used in the source module,
311 -- but not @Foo@; so we need to chase @Foo@ too.
313 -- We also need to follow superclass refs. In particular, 'chasing @Foo@' must
314 -- include actually getting in Foo's class decl
315 -- class Wib a => Foo a where ..
316 -- so that its superclasses are discovered. The point is that Wib is a gate too.
317 -- We do this for tycons too, so that we look through type synonyms.
319 go_outer decls fvs all_gates []
320 = returnRn (decls, fvs)
322 go_outer decls fvs all_gates refs -- refs are not necessarily slurped yet
323 = traceRn (text "go_outer" <+> ppr refs) `thenRn_`
324 foldlRn go_inner (decls, fvs, emptyFVs) refs `thenRn` \ (decls1, fvs1, gates1) ->
325 getImportedInstDecls (all_gates `plusFV` gates1) `thenRn` \ inst_decls ->
326 rnInstDecls decls1 fvs1 gates1 inst_decls `thenRn` \ (decls2, fvs2, gates2) ->
327 go_outer decls2 fvs2 (all_gates `plusFV` gates2)
328 (nameSetToList (gates2 `minusNameSet` all_gates))
329 -- Knock out the all_gates because even if we don't slurp any new
330 -- decls we can get some apparently-new gates from wired-in names
332 go_inner (decls, fvs, gates) wanted_name
333 = importDecl wanted_name `thenRn` \ import_result ->
334 case import_result of
335 AlreadySlurped -> returnRn (decls, fvs, gates)
336 WiredIn -> returnRn (decls, fvs, gates `plusFV` getWiredInGates wanted_name)
337 Deferred -> returnRn (decls, fvs, gates `addOneFV` wanted_name) -- It's a type constructor
339 HereItIs decl -> rnIfaceDecl decl `thenRn` \ (new_decl, fvs1) ->
340 returnRn (new_decl : decls,
342 gates `plusFV` getGates source_fvs new_decl)
344 rnInstDecls decls fvs gates []
345 = returnRn (decls, fvs, gates)
346 rnInstDecls decls fvs gates (d:ds)
347 = rnIfaceDecl d `thenRn` \ (new_decl, fvs1) ->
348 rnInstDecls (new_decl:decls)
350 (gates `plusFV` getInstDeclGates new_decl)
356 -------------------------------------------------------
357 -- closeDecls keeps going until the free-var set is empty
358 closeDecls decls needed
359 | not (isEmptyFVs needed)
360 = slurpDecls decls needed `thenRn` \ (decls1, needed1) ->
361 closeDecls decls1 needed1
364 = getImportedRules `thenRn` \ rule_decls ->
366 [] -> returnRn decls -- No new rules, so we are done
367 other -> rnIfaceDecls decls emptyFVs rule_decls `thenRn` \ (decls1, needed1) ->
368 closeDecls decls1 needed1
371 -------------------------------------------------------
372 -- Augment decls with any decls needed by needed.
373 -- Return also free vars of the new decls (only)
374 slurpDecls decls needed
375 = go decls emptyFVs (nameSetToList needed)
377 go decls fvs [] = returnRn (decls, fvs)
378 go decls fvs (ref:refs) = slurpDecl decls fvs ref `thenRn` \ (decls1, fvs1) ->
381 -------------------------------------------------------
382 slurpDecl decls fvs wanted_name
383 = importDecl wanted_name `thenRn` \ import_result ->
384 case import_result of
385 -- Found a declaration... rename it
386 HereItIs decl -> rnIfaceDecl decl `thenRn` \ (new_decl, fvs1) ->
387 returnRn (new_decl:decls, fvs1 `plusFV` fvs)
389 -- No declaration... (wired in thing, or deferred, or already slurped)
390 other -> returnRn (decls, fvs)
393 -------------------------------------------------------
394 rnIfaceDecls :: [RenamedHsDecl] -> FreeVars
395 -> [(Module, RdrNameHsDecl)]
396 -> RnM d ([RenamedHsDecl], FreeVars)
397 rnIfaceDecls decls fvs [] = returnRn (decls, fvs)
398 rnIfaceDecls decls fvs (d:ds) = rnIfaceDecl d `thenRn` \ (new_decl, fvs1) ->
399 rnIfaceDecls (new_decl:decls) (fvs1 `plusFV` fvs) ds
401 rnIfaceDecl (mod, decl) = initIfaceRnMS mod (rnDecl decl)
405 %*********************************************************
407 \subsection{Deferred declarations}
409 %*********************************************************
411 The idea of deferred declarations is this. Suppose we have a function
416 Then we don't want to load T and all its constructors, and all
417 the types those constructors refer to, and all the types *those*
418 constructors refer to, and so on. That might mean loading many more
419 interface files than is really necessary. So we 'defer' loading T.
421 But f might be strict, and the calling convention for evaluating
422 values of type T depends on how many constructors T has, so
423 we do need to load T, but not the full details of the type T.
424 So we load the full decl for T, but only skeleton decls for A and B:
426 data T = {- 2 constructors -}
428 Whether all this is worth it is moot.
431 slurpDeferredDecls :: [RenamedHsDecl] -> RnMG [RenamedHsDecl]
432 slurpDeferredDecls decls = returnRn decls
435 slurpDeferredDecls :: [RenamedHsDecl] -> RnMG [RenamedHsDecl]
436 slurpDeferredDecls decls
437 = getDeferredDecls `thenRn` \ def_decls ->
438 rnIfaceDecls decls emptyFVs (map stripDecl def_decls) `thenRn` \ (decls1, fvs) ->
439 ASSERT( isEmptyFVs fvs )
442 stripDecl (mod, TyClD (TyData dt _ tc tvs _ nconstrs _ loc name1 name2))
443 = (mod, TyClD (TyData dt [] tc tvs [] nconstrs Nothing loc
445 -- Nuke the context and constructors
446 -- But retain the *number* of constructors!
447 -- Also the tvs will have kinds on them.
452 %*********************************************************
454 \subsection{Extracting the `gates'}
456 %*********************************************************
458 When we import a declaration like
460 data T = T1 Wibble | T2 Wobble
462 we don't want to treat @Wibble@ and @Wobble@ as gates
463 {\em unless} @T1@, @T2@ respectively are mentioned by the user program.
464 If only @T@ is mentioned
465 we want only @T@ to be a gate;
466 that way we don't suck in useless instance
467 decls for (say) @Eq Wibble@, when they can't possibly be useful.
469 @getGates@ takes a newly imported (and renamed) decl, and the free
470 vars of the source program, and extracts from the decl the gate names.
473 getGates source_fvs (SigD (IfaceSig _ ty _ _))
474 = extractHsTyNames ty
476 getGates source_fvs (TyClD (ClassDecl ctxt cls tvs _ sigs _ _ _ ))
477 = (delListFromNameSet (foldr (plusFV . get) (extractHsCtxtTyNames ctxt) sigs)
479 `addOneToNameSet` cls)
480 `plusFV` maybe_double
482 get (ClassOpSig n _ ty _)
483 | n `elemNameSet` source_fvs = extractHsTyNames ty
484 | otherwise = emptyFVs
486 -- If we load any numeric class that doesn't have
487 -- Int as an instance, add Double to the gates.
488 -- This takes account of the fact that Double might be needed for
489 -- defaulting, but we don't want to load Double (and all its baggage)
490 -- if the more exotic classes aren't used at all.
491 maybe_double | nameUnique cls `elem` fractionalClassKeys
492 = unitFV (getName doubleTyCon)
496 getGates source_fvs (TyClD (TySynonym tycon tvs ty _))
497 = delListFromNameSet (extractHsTyNames ty)
499 -- A type synonym type constructor isn't a "gate" for instance decls
501 getGates source_fvs (TyClD (TyData _ ctxt tycon tvs cons _ _ _ _ _))
502 = delListFromNameSet (foldr (plusFV . get) (extractHsCtxtTyNames ctxt) cons)
504 `addOneToNameSet` tycon
506 get (ConDecl n _ tvs ctxt details _)
507 | n `elemNameSet` source_fvs
508 -- If the constructor is method, get fvs from all its fields
509 = delListFromNameSet (get_details details `plusFV`
510 extractHsCtxtTyNames ctxt)
512 get (ConDecl n _ tvs ctxt (RecCon fields) _)
513 -- Even if the constructor isn't mentioned, the fields
514 -- might be, as selectors. They can't mention existentially
515 -- bound tyvars (typechecker checks for that) so no need for
516 -- the deleteListFromNameSet part
517 = foldr (plusFV . get_field) emptyFVs fields
519 get other_con = emptyFVs
521 get_details (VanillaCon tys) = plusFVs (map get_bang tys)
522 get_details (InfixCon t1 t2) = get_bang t1 `plusFV` get_bang t2
523 get_details (RecCon fields) = plusFVs [get_bang t | (_, t) <- fields]
525 get_field (fs,t) | any (`elemNameSet` source_fvs) fs = get_bang t
526 | otherwise = emptyFVs
528 get_bang bty = extractHsTyNames (getBangType bty)
530 getGates source_fvs other_decl = emptyFVs
533 @getWiredInGates@ is just like @getGates@, but it sees a wired-in @Name@
534 rather than a declaration.
537 getWiredInGates :: Name -> FreeVars
538 getWiredInGates name -- No classes are wired in
539 = case lookupNameEnv wiredInThingEnv name of
540 Just (AnId the_id) -> getWiredInGates_s (namesOfType (idType the_id))
544 -> getWiredInGates_s (delListFromNameSet (namesOfType ty) (map getName tyvars))
546 (tyvars,ty) = getSynTyConDefn tc
550 getWiredInGates_s names = foldr (plusFV . getWiredInGates) emptyFVs (nameSetToList names)
554 getInstDeclGates (InstD (InstDecl inst_ty _ _ _ _)) = extractHsTyNames inst_ty
555 getInstDeclGates other = emptyFVs
559 %*********************************************************
561 \subsection{Fixities}
563 %*********************************************************
566 fixitiesFromLocalDecls :: GlobalRdrEnv -> [RdrNameHsDecl] -> RnMG LocalFixityEnv
567 fixitiesFromLocalDecls gbl_env decls
568 = doptRn Opt_WarnUnusedBinds `thenRn` \ warn_unused ->
569 foldlRn (getFixities warn_unused) emptyNameEnv decls `thenRn` \ env ->
570 traceRn (text "fixity env" <+> vcat (map ppr (nameEnvElts env)))
574 getFixities :: Bool -> LocalFixityEnv -> RdrNameHsDecl -> RnMG LocalFixityEnv
575 getFixities warn_uu acc (FixD fix)
576 = fix_decl warn_uu acc fix
578 getFixities warn_uu acc (TyClD (ClassDecl _ _ _ _ sigs _ _ _ ))
579 = foldlRn (fix_decl warn_uu) acc [sig | FixSig sig <- sigs]
580 -- Get fixities from class decl sigs too.
581 getFixities warn_uu acc other_decl
584 fix_decl warn_uu acc sig@(FixitySig rdr_name fixity loc)
585 = -- Check for fixity decl for something not declared
587 lookupGlobalRn gbl_env rdr_name `thenRn` \ maybe_name ->
589 Nothing -> checkRn (not warn_uu) (unusedFixityDecl rdr_name fixity) `thenRn_`
594 -- Check for duplicate fixity decl
595 case lookupNameEnv acc name of {
596 Just (FixitySig _ _ loc') -> addErrRn (dupFixityDecl rdr_name loc loc')
597 `thenRn_` returnRn acc ;
599 Nothing -> returnRn (extendNameEnv acc name (FixitySig name fixity loc))
604 %*********************************************************
606 \subsection{Deprecations}
608 %*********************************************************
610 For deprecations, all we do is check that the names are in scope.
611 It's only imported deprecations, dealt with in RnIfaces, that we
612 gather them together.
615 rnDeprecs :: GlobalRdrEnv -> Maybe DeprecTxt
616 -> [RdrNameDeprecation] -> RnMG Deprecations
617 rnDeprecs gbl_env Nothing []
620 rnDeprecs gbl_env (Just txt) decls
621 = mapRn (addErrRn . badDeprec) decls `thenRn_`
622 returnRn (DeprecAll txt)
624 rnDeprecs gbl_env Nothing decls
625 = mapRn rn_deprec decls `thenRn` \ pairs ->
626 returnRn (DeprecSome (mkNameEnv (catMaybes pairs)))
628 rn_deprec (Deprecation rdr_name txt loc)
630 lookupGlobalRn gbl_env rdr_name `thenRn` \ maybe_name ->
632 Just n -> returnRn (Just (n,txt))
633 Nothing -> returnRn Nothing
637 %*********************************************************
639 \subsection{Unused names}
641 %*********************************************************
644 reportUnusedNames :: ModuleName -> [ModuleName]
645 -> GlobalRdrEnv -> AvailEnv
646 -> Avails -> NameSet -> [RenamedHsDecl]
648 reportUnusedNames mod_name direct_import_mods
650 export_avails mentioned_names
652 = warnUnusedModules unused_imp_mods `thenRn_`
653 warnUnusedLocalBinds bad_locals `thenRn_`
654 warnUnusedImports bad_imp_names `thenRn_`
655 printMinimalImports mod_name minimal_imports `thenRn_`
656 warnDeprecations really_used_names `thenRn_`
660 used_names = mentioned_names `unionNameSets` availsToNameSet export_avails
662 -- Now, a use of C implies a use of T,
663 -- if C was brought into scope by T(..) or T(C)
664 really_used_names = used_names `unionNameSets`
665 mkNameSet [ parent_name
666 | sub_name <- nameSetToList used_names
668 -- Usually, every used name will appear in avail_env, but there
669 -- is one time when it doesn't: tuples and other built in syntax. When you
670 -- write (a,b) that gives rise to a *use* of "(,)", so that the
671 -- instances will get pulled in, but the tycon "(,)" isn't actually
672 -- in scope. Also, (-x) gives rise to an implicit use of 'negate';
673 -- similarly, 3.5 gives rise to an implcit use of :%
674 -- Hence the silent 'False' in all other cases
676 , Just parent_name <- [case lookupNameEnv avail_env sub_name of
677 Just (AvailTC n _) -> Just n
681 defined_names, defined_and_used, defined_but_not_used :: [(Name,Provenance)]
682 defined_names = concat (rdrEnvElts gbl_env)
683 (defined_and_used, defined_but_not_used) = partition used defined_names
684 used (name,_) = not (name `elemNameSet` really_used_names)
686 -- Filter out the ones only defined implicitly
688 bad_locals = [n | (n,LocalDef) <- defined_but_not_used]
690 bad_imp_names :: [(Name,Provenance)]
691 bad_imp_names = [(n,p) | (n,p@(NonLocalDef (UserImport mod _ True) _)) <- defined_but_not_used,
692 not (module_unused mod)]
694 -- inst_mods are directly-imported modules that
695 -- contain instance decl(s) that the renamer decided to suck in
696 -- It's not necessarily redundant to import such modules.
702 -- The import M() is not *necessarily* redundant, even if
703 -- we suck in no instance decls from M (e.g. it contains
704 -- no instance decls, or This contains no code). It may be
705 -- that we import M solely to ensure that M's orphan instance
706 -- decls (or those in its imports) are visible to people who
707 -- import This. Sigh.
708 -- There's really no good way to detect this, so the error message
709 -- in RnEnv.warnUnusedModules is weakened instead
710 inst_mods :: [ModuleName]
711 inst_mods = [m | InstD (InstDecl _ _ _ (Just dfun) _) <- imported_decls,
712 let m = moduleName (nameModule dfun),
713 m `elem` direct_import_mods
716 -- To figure out the minimal set of imports, start with the things
717 -- that are in scope (i.e. in gbl_env). Then just combine them
718 -- into a bunch of avails, so they are properly grouped
719 minimal_imports :: FiniteMap ModuleName AvailEnv
720 minimal_imports0 = emptyFM
721 minimal_imports1 = foldr add_name minimal_imports0 defined_and_used
722 minimal_imports = foldr add_inst_mod minimal_imports1 inst_mods
724 add_name (n,NonLocalDef (UserImport m _ _) _) acc = addToFM_C plusAvailEnv acc (moduleName (nameModule n))
725 (unitAvailEnv (mk_avail n))
726 add_name (n,other_prov) acc = acc
728 mk_avail n = case lookupNameEnv avail_env n of
729 Just (AvailTC m _) | n==m -> AvailTC n [n]
730 | otherwise -> AvailTC m [n,m]
731 Just avail -> Avail n
732 Nothing -> pprPanic "mk_avail" (ppr n)
735 | m `elemFM` acc = acc -- We import something already
736 | otherwise = addToFM acc m emptyAvailEnv
737 -- Add an empty collection of imports for a module
738 -- from which we have sucked only instance decls
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 warnDeprecations used_names
751 = doptRn Opt_WarnDeprecations `thenRn` \ warn_drs ->
752 if not warn_drs then returnRn () else
754 getIfacesRn `thenRn` \ ifaces ->
755 getHomeIfaceTableRn `thenRn` \ hit ->
759 | n <- nameSetToList used_names,
760 Just txt <- [lookup_deprec hit pit n] ]
762 mapRn_ warnDeprec deprecs
765 lookup_deprec hit pit n
766 = case lookupModuleEnv hit mod of
767 Just iface -> lookupDeprec iface n
768 Nothing -> case lookupModuleEnv pit mod of
769 Just iface -> lookupDeprec iface n
770 Nothing -> pprPanic "warnDeprecations:" (ppr n)
774 -- ToDo: deal with original imports with 'qualified' and 'as M' clauses
775 printMinimalImports mod_name imps
776 = doptRn Opt_D_dump_minimal_imports `thenRn` \ dump_minimal ->
777 if not dump_minimal then returnRn () else
779 mapRn to_ies (fmToList imps) `thenRn` \ mod_ies ->
780 ioToRnM (do { h <- openFile filename WriteMode ;
781 printForUser h (vcat (map ppr_mod_ie mod_ies))
785 filename = moduleNameUserString mod_name ++ ".imports"
786 ppr_mod_ie (mod_name, ies)
787 | mod_name == pRELUDE_Name
790 = ptext SLIT("import") <+> ppr mod_name <>
791 parens (fsep (punctuate comma (map ppr ies)))
793 to_ies (mod, avail_env) = mapRn to_ie (availEnvElts avail_env) `thenRn` \ ies ->
796 to_ie :: AvailInfo -> RnMG (IE Name)
797 to_ie (Avail n) = returnRn (IEVar n)
798 to_ie (AvailTC n [m]) = ASSERT( n==m )
799 returnRn (IEThingAbs n)
800 to_ie (AvailTC n ns) = getInterfaceExports (moduleName (nameModule n))
801 ImportBySystem `thenRn` \ (_, avails) ->
802 case [ms | AvailTC m ms <- avails, m == n] of
803 [ms] | all (`elem` ns) ms -> returnRn (IEThingAll n)
804 | otherwise -> returnRn (IEThingWith n (filter (/= n) ns))
805 other -> pprTrace "to_ie" (ppr n <+> ppr (nameModule n) <+> ppr other) $
808 rnDump :: [RenamedHsDecl] -- Renamed imported decls
809 -> [RenamedHsDecl] -- Renamed local decls
811 rnDump imp_decls local_decls
812 = doptRn Opt_D_dump_rn_trace `thenRn` \ dump_rn_trace ->
813 doptRn Opt_D_dump_rn_stats `thenRn` \ dump_rn_stats ->
814 doptRn Opt_D_dump_rn `thenRn` \ dump_rn ->
815 if dump_rn_trace || dump_rn_stats || dump_rn then
816 getRnStats imp_decls `thenRn` \ stats_msg ->
817 returnRn (printErrs stats_msg >>
818 dumpIfSet dump_rn "Renamer:"
819 (vcat (map ppr (local_decls ++ imp_decls))))
825 %*********************************************************
827 \subsection{Statistics}
829 %*********************************************************
832 getRnStats :: [RenamedHsDecl] -> RnMG SDoc
833 getRnStats imported_decls
834 = getIfacesRn `thenRn` \ ifaces ->
836 n_mods = length [() | (_, _, True) <- eltsFM (iImpModInfo ifaces)]
838 decls_read = [decl | (avail, True, (_,decl)) <- nameEnvElts (iDecls ifaces),
839 -- Data, newtype, and class decls are in the decls_fm
840 -- under multiple names; the tycon/class, and each
841 -- constructor/class op too.
842 -- The 'True' selects just the 'main' decl
843 not (isLocallyDefined (availName avail))
846 (cd_rd, dd_rd, nd_rd, sd_rd, vd_rd, _) = count_decls decls_read
847 (cd_sp, dd_sp, nd_sp, sd_sp, vd_sp, id_sp) = count_decls imported_decls
849 unslurped_insts = iInsts ifaces
850 inst_decls_unslurped = length (bagToList unslurped_insts)
851 inst_decls_read = id_sp + inst_decls_unslurped
854 [int n_mods <+> text "interfaces read",
855 hsep [ int cd_sp, text "class decls imported, out of",
856 int cd_rd, text "read"],
857 hsep [ int dd_sp, text "data decls imported, out of",
858 int dd_rd, text "read"],
859 hsep [ int nd_sp, text "newtype decls imported, out of",
860 int nd_rd, text "read"],
861 hsep [int sd_sp, text "type synonym decls imported, out of",
862 int sd_rd, text "read"],
863 hsep [int vd_sp, text "value signatures imported, out of",
864 int vd_rd, text "read"],
865 hsep [int id_sp, text "instance decls imported, out of",
866 int inst_decls_read, text "read"],
867 text "cls dcls slurp" <+> fsep (map (ppr . tyClDeclName)
868 [d | TyClD d <- imported_decls, isClassDecl d]),
869 text "cls dcls read" <+> fsep (map (ppr . tyClDeclName)
870 [d | TyClD d <- decls_read, isClassDecl d])]
872 returnRn (hcat [text "Renamer stats: ", stats])
882 tycl_decls = [d | TyClD d <- decls]
883 (class_decls, data_decls, newtype_decls, syn_decls) = countTyClDecls tycl_decls
885 val_decls = length [() | SigD _ <- decls]
886 inst_decls = length [() | InstD _ <- decls]
890 %************************************************************************
892 \subsection{Errors and warnings}
894 %************************************************************************
897 warnDeprec :: (Name, DeprecTxt) -> RnM d ()
898 warnDeprec (name, txt)
899 = pushSrcLocRn (getSrcLoc name) $
901 sep [ text (occNameFlavour (nameOccName name)) <+> ppr name <+>
902 text "is deprecated:", nest 4 (ppr txt) ]
905 unusedFixityDecl rdr_name fixity
906 = hsep [ptext SLIT("Unused fixity declaration for"), quotes (ppr rdr_name)]
908 dupFixityDecl rdr_name loc1 loc2
909 = vcat [ptext SLIT("Multiple fixity declarations for") <+> quotes (ppr rdr_name),
910 ptext SLIT("at ") <+> ppr loc1,
911 ptext SLIT("and") <+> ppr loc2]
914 = sep [ptext SLIT("Illegal deprecation when whole module is deprecated"),