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, removeContext,
26 import RnEnv ( availName, availsToNameSet,
27 emptyAvailEnv, unitAvailEnv, availEnvElts, plusAvailEnv, sortAvails,
28 warnUnusedImports, warnUnusedLocalBinds, warnUnusedModules,
29 lookupOrigNames, lookupGlobalRn,
30 FreeVars, plusFVs, plusFV, unitFV, emptyFVs, isEmptyFVs, addOneFV
32 import Module ( Module, ModuleName, WhereFrom(..),
33 moduleNameUserString, moduleName,
36 import Name ( Name, isLocallyDefined, NamedThing(..), getSrcLoc,
37 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)
79 -- The mi_decls in the ModIface include
80 -- ones imported from packages too
82 renameModule dflags finder hit hst old_pcs this_module
83 this_mod@(HsModule _ _ _ _ _ _ loc)
84 = -- Initialise the renamer monad
86 ((maybe_rn_stuff, dump_action), (rn_warns_bag, rn_errs_bag), new_pcs)
87 <- initRn dflags finder hit hst old_pcs this_module loc (rename this_module this_mod) ;
90 printErrorsAndWarnings (rn_warns_bag, rn_errs_bag) ;
92 -- Dump any debugging output
96 if not (isEmptyBag rn_errs_bag) then
97 return (old_pcs, Nothing)
99 return (new_pcs, maybe_rn_stuff)
104 rename :: Module -> RdrNameHsModule -> RnMG (Maybe (ModIface, [RenamedHsDecl]), IO ())
105 rename this_module this_mod@(HsModule mod_name vers exports imports local_decls mod_deprec loc)
106 = -- FIND THE GLOBAL NAME ENVIRONMENT
107 getGlobalNames this_mod `thenRn` \ maybe_stuff ->
109 -- CHECK FOR EARLY EXIT
110 case maybe_stuff of {
111 Nothing -> -- Everything is up to date; no need to recompile further
112 rnDump [] [] `thenRn` \ dump_action ->
113 returnRn (Nothing, [], dump_action) ;
115 Just (gbl_env, local_gbl_env, export_avails, global_avail_env) ->
117 -- DEAL WITH DEPRECATIONS
118 rnDeprecs local_gbl_env mod_deprec
119 [d | DeprecD d <- local_decls] `thenRn` \ my_deprecs ->
121 -- DEAL WITH LOCAL FIXITIES
122 fixitiesFromLocalDecls local_gbl_env local_decls `thenRn` \ local_fixity_env ->
125 initRnMS gbl_env local_fixity_env SourceMode (
126 rnSourceDecls local_decls
127 ) `thenRn` \ (rn_local_decls, source_fvs) ->
129 -- SLURP IN ALL THE NEEDED DECLARATIONS
130 implicitFVs mod_name rn_local_decls `thenRn` \ implicit_fvs ->
132 -- The export_fvs make the exported names look just as if they
133 -- occurred in the source program. For the reasoning, see the
134 -- comments with RnIfaces.getImportVersions.
135 -- We only need the 'parent name' of the avail;
136 -- that's enough to suck in the declaration.
137 export_fvs = mkNameSet (map availName export_avails)
138 real_source_fvs = source_fvs `plusFV` export_fvs
140 slurp_fvs = implicit_fvs `plusFV` real_source_fvs
141 -- It's important to do the "plus" this way round, so that
142 -- when compiling the prelude, locally-defined (), Bool, etc
143 -- override the implicit ones.
145 slurpImpDecls slurp_fvs `thenRn` \ rn_imp_decls ->
147 -- EXIT IF ERRORS FOUND
148 rnDump rn_imp_decls rn_local_decls `thenRn` \ dump_action ->
149 checkErrsRn `thenRn` \ no_errs_so_far ->
150 if not no_errs_so_far then
151 -- Found errors already, so exit now
152 returnRn (Nothing, dump_action)
155 -- GENERATE THE VERSION/USAGE INFO
156 mkImportInfo mod_name imports `thenRn` \ my_usages ->
158 -- RETURN THE RENAMED MODULE
159 getNameSupplyRn `thenRn` \ name_supply ->
160 getIfacesRn `thenRn` \ ifaces ->
162 direct_import_mods :: [ModuleName]
163 direct_import_mods = nub [m | ImportDecl m _ _ _ _ _ <- imports]
165 -- We record fixities even for things that aren't exported,
166 -- so that we can change into the context of this moodule easily
167 fixities = mkNameEnv [ (name, fixity)
168 | FixitySig name fixity loc <- nameEnvElts local_fixity_env
172 -- Sort the exports to make them easier to compare for versions
173 my_exports = sortAvails export_avails
175 mod_iface = ModIface { mi_module = this_module,
176 mi_version = initialVersionInfo,
177 mi_orphan = any isOrphanDecl rn_local_decls,
178 mi_exports = my_exports,
179 mi_globals = gbl_env,
180 mi_usages = my_usages,
181 mi_fixities = fixities,
182 mi_deprecs = my_deprecs,
183 mi_decls = panic "mi_decls"
186 final_decls = rn_local_decls ++ rn_imp_decls
189 -- REPORT UNUSED NAMES, AND DEBUG DUMP
190 reportUnusedNames mod_name direct_import_mods
191 gbl_env global_avail_env
192 export_avails source_fvs
193 rn_imp_decls `thenRn_`
195 returnRn (Just (mod_iface, final_decls), dump_action) }
198 @implicitFVs@ forces the renamer to slurp in some things which aren't
199 mentioned explicitly, but which might be needed by the type checker.
202 implicitFVs mod_name decls
203 = lookupOrigNames implicit_occs `thenRn` \ implicit_names ->
204 returnRn (mkNameSet (map getName default_tycons) `plusFV`
207 -- Add occurrences for Int, and (), because they
208 -- are the types to which ambigious type variables may be defaulted by
209 -- the type checker; so they won't always appear explicitly.
210 -- [The () one is a GHC extension for defaulting CCall results.]
211 -- ALSO: funTyCon, since it occurs implicitly everywhere!
212 -- (we don't want to be bothered with making funTyCon a
213 -- free var at every function application!)
214 -- Double is dealt with separately in getGates
215 default_tycons = [unitTyCon, funTyCon, boolTyCon, intTyCon]
217 -- Add occurrences for IO or PrimIO
218 implicit_main | mod_name == mAIN_Name
219 || mod_name == pREL_MAIN_Name = [ioTyCon_RDR]
222 -- Now add extra "occurrences" for things that
223 -- the deriving mechanism, or defaulting, will later need in order to
225 implicit_occs = string_occs ++ foldr ((++) . get) implicit_main decls
227 -- Virtually every program has error messages in it somewhere
228 string_occs = [unpackCString_RDR, unpackCStringFoldr_RDR, unpackCStringUtf8_RDR,
231 get (TyClD (TyData _ _ _ _ _ _ (Just deriv_classes) _ _ _))
232 = concat (map get_deriv deriv_classes)
235 get_deriv cls = case lookupUFM derivingOccurrences cls of
241 isOrphanDecl (InstD (InstDecl inst_ty _ _ _ _))
242 = not (foldNameSet ((||) . isLocallyDefined) False (extractHsTyNames (removeContext inst_ty)))
243 -- The 'removeContext' is because of
244 -- instance Foo a => Baz T where ...
245 -- The decl is an orphan if Baz and T are both not locally defined,
246 -- even if Foo *is* locally defined
248 isOrphanDecl (RuleD (HsRule _ _ _ lhs _ _))
251 -- At the moment we just check for common LHS forms
252 -- Expand as necessary. Getting it wrong just means
253 -- more orphans than necessary
254 check (HsVar v) = not (isLocallyDefined v)
255 check (HsApp f a) = check f && check a
256 check (HsLit _) = False
257 check (HsOverLit _) = False
258 check (OpApp l o _ r) = check l && check o && check r
259 check (NegApp e _) = check e
260 check (HsPar e) = check e
261 check (SectionL e o) = check e && check o
262 check (SectionR o e) = check e && check o
264 check other = True -- Safe fall through
266 isOrphanDecl other = False
270 %*********************************************************
272 \subsection{Slurping declarations}
274 %*********************************************************
277 -------------------------------------------------------
278 slurpImpDecls source_fvs
279 = traceRn (text "slurpImp" <+> fsep (map ppr (nameSetToList source_fvs))) `thenRn_`
281 -- The current slurped-set records all local things
282 getSlurped `thenRn` \ source_binders ->
283 slurpSourceRefs source_binders source_fvs `thenRn` \ (decls, needed) ->
285 -- Then get everything else
286 closeDecls decls needed `thenRn` \ decls1 ->
288 -- Finally, get any deferred data type decls
289 slurpDeferredDecls decls1 `thenRn` \ final_decls ->
293 -------------------------------------------------------
294 slurpSourceRefs :: NameSet -- Variables defined in source
295 -> FreeVars -- Variables referenced in source
296 -> RnMG ([RenamedHsDecl],
297 FreeVars) -- Un-satisfied needs
298 -- The declaration (and hence home module) of each gate has
299 -- already been loaded
301 slurpSourceRefs source_binders source_fvs
302 = go_outer [] -- Accumulating decls
303 emptyFVs -- Unsatisfied needs
304 emptyFVs -- Accumulating gates
305 (nameSetToList source_fvs) -- Things whose defn hasn't been loaded yet
307 -- The outer loop repeatedly slurps the decls for the current gates
308 -- and the instance decls
310 -- The outer loop is needed because consider
311 -- instance Foo a => Baz (Maybe a) where ...
312 -- It may be that @Baz@ and @Maybe@ are used in the source module,
313 -- but not @Foo@; so we need to chase @Foo@ too.
315 -- We also need to follow superclass refs. In particular, 'chasing @Foo@' must
316 -- include actually getting in Foo's class decl
317 -- class Wib a => Foo a where ..
318 -- so that its superclasses are discovered. The point is that Wib is a gate too.
319 -- We do this for tycons too, so that we look through type synonyms.
321 go_outer decls fvs all_gates []
322 = returnRn (decls, fvs)
324 go_outer decls fvs all_gates refs -- refs are not necessarily slurped yet
325 = traceRn (text "go_outer" <+> ppr refs) `thenRn_`
326 foldlRn go_inner (decls, fvs, emptyFVs) refs `thenRn` \ (decls1, fvs1, gates1) ->
327 getImportedInstDecls (all_gates `plusFV` gates1) `thenRn` \ inst_decls ->
328 rnInstDecls decls1 fvs1 gates1 inst_decls `thenRn` \ (decls2, fvs2, gates2) ->
329 go_outer decls2 fvs2 (all_gates `plusFV` gates2)
330 (nameSetToList (gates2 `minusNameSet` all_gates))
331 -- Knock out the all_gates because even if we don't slurp any new
332 -- decls we can get some apparently-new gates from wired-in names
334 go_inner (decls, fvs, gates) wanted_name
335 = importDecl wanted_name `thenRn` \ import_result ->
336 case import_result of
337 AlreadySlurped -> returnRn (decls, fvs, gates)
338 WiredIn -> returnRn (decls, fvs, gates `plusFV` getWiredInGates wanted_name)
339 Deferred -> returnRn (decls, fvs, gates `addOneFV` wanted_name) -- It's a type constructor
341 HereItIs decl -> rnIfaceDecl decl `thenRn` \ (new_decl, fvs1) ->
342 returnRn (new_decl : decls,
344 gates `plusFV` getGates source_fvs new_decl)
346 rnInstDecls decls fvs gates []
347 = returnRn (decls, fvs, gates)
348 rnInstDecls decls fvs gates (d:ds)
349 = rnIfaceDecl d `thenRn` \ (new_decl, fvs1) ->
350 rnInstDecls (new_decl:decls)
352 (gates `plusFV` getInstDeclGates new_decl)
358 -------------------------------------------------------
359 -- closeDecls keeps going until the free-var set is empty
360 closeDecls decls needed
361 | not (isEmptyFVs needed)
362 = slurpDecls decls needed `thenRn` \ (decls1, needed1) ->
363 closeDecls decls1 needed1
366 = getImportedRules `thenRn` \ rule_decls ->
368 [] -> returnRn decls -- No new rules, so we are done
369 other -> rnIfaceDecls decls emptyFVs rule_decls `thenRn` \ (decls1, needed1) ->
370 closeDecls decls1 needed1
373 -------------------------------------------------------
374 -- Augment decls with any decls needed by needed.
375 -- Return also free vars of the new decls (only)
376 slurpDecls decls needed
377 = go decls emptyFVs (nameSetToList needed)
379 go decls fvs [] = returnRn (decls, fvs)
380 go decls fvs (ref:refs) = slurpDecl decls fvs ref `thenRn` \ (decls1, fvs1) ->
383 -------------------------------------------------------
384 slurpDecl decls fvs wanted_name
385 = importDecl wanted_name `thenRn` \ import_result ->
386 case import_result of
387 -- Found a declaration... rename it
388 HereItIs decl -> rnIfaceDecl decl `thenRn` \ (new_decl, fvs1) ->
389 returnRn (new_decl:decls, fvs1 `plusFV` fvs)
391 -- No declaration... (wired in thing, or deferred, or already slurped)
392 other -> returnRn (decls, fvs)
395 -------------------------------------------------------
396 rnIfaceDecls :: [RenamedHsDecl] -> FreeVars
397 -> [(Module, RdrNameHsDecl)]
398 -> RnM d ([RenamedHsDecl], FreeVars)
399 rnIfaceDecls decls fvs [] = returnRn (decls, fvs)
400 rnIfaceDecls decls fvs (d:ds) = rnIfaceDecl d `thenRn` \ (new_decl, fvs1) ->
401 rnIfaceDecls (new_decl:decls) (fvs1 `plusFV` fvs) ds
403 rnIfaceDecl (mod, decl) = initIfaceRnMS mod (rnDecl decl)
407 %*********************************************************
409 \subsection{Deferred declarations}
411 %*********************************************************
413 The idea of deferred declarations is this. Suppose we have a function
418 Then we don't want to load T and all its constructors, and all
419 the types those constructors refer to, and all the types *those*
420 constructors refer to, and so on. That might mean loading many more
421 interface files than is really necessary. So we 'defer' loading T.
423 But f might be strict, and the calling convention for evaluating
424 values of type T depends on how many constructors T has, so
425 we do need to load T, but not the full details of the type T.
426 So we load the full decl for T, but only skeleton decls for A and B:
428 data T = {- 2 constructors -}
430 Whether all this is worth it is moot.
433 slurpDeferredDecls :: [RenamedHsDecl] -> RnMG [RenamedHsDecl]
434 slurpDeferredDecls decls = returnRn decls
437 slurpDeferredDecls :: [RenamedHsDecl] -> RnMG [RenamedHsDecl]
438 slurpDeferredDecls decls
439 = getDeferredDecls `thenRn` \ def_decls ->
440 rnIfaceDecls decls emptyFVs (map stripDecl def_decls) `thenRn` \ (decls1, fvs) ->
441 ASSERT( isEmptyFVs fvs )
444 stripDecl (mod, TyClD (TyData dt _ tc tvs _ nconstrs _ loc name1 name2))
445 = (mod, TyClD (TyData dt [] tc tvs [] nconstrs Nothing loc
447 -- Nuke the context and constructors
448 -- But retain the *number* of constructors!
449 -- Also the tvs will have kinds on them.
454 %*********************************************************
456 \subsection{Extracting the `gates'}
458 %*********************************************************
460 When we import a declaration like
462 data T = T1 Wibble | T2 Wobble
464 we don't want to treat @Wibble@ and @Wobble@ as gates
465 {\em unless} @T1@, @T2@ respectively are mentioned by the user program.
466 If only @T@ is mentioned
467 we want only @T@ to be a gate;
468 that way we don't suck in useless instance
469 decls for (say) @Eq Wibble@, when they can't possibly be useful.
471 @getGates@ takes a newly imported (and renamed) decl, and the free
472 vars of the source program, and extracts from the decl the gate names.
475 getGates source_fvs (SigD (IfaceSig _ ty _ _))
476 = extractHsTyNames ty
478 getGates source_fvs (TyClD (ClassDecl ctxt cls tvs _ sigs _ _ _ ))
479 = (delListFromNameSet (foldr (plusFV . get) (extractHsCtxtTyNames ctxt) sigs)
481 `addOneToNameSet` cls)
482 `plusFV` maybe_double
484 get (ClassOpSig n _ ty _)
485 | n `elemNameSet` source_fvs = extractHsTyNames ty
486 | otherwise = emptyFVs
488 -- If we load any numeric class that doesn't have
489 -- Int as an instance, add Double to the gates.
490 -- This takes account of the fact that Double might be needed for
491 -- defaulting, but we don't want to load Double (and all its baggage)
492 -- if the more exotic classes aren't used at all.
493 maybe_double | nameUnique cls `elem` fractionalClassKeys
494 = unitFV (getName doubleTyCon)
498 getGates source_fvs (TyClD (TySynonym tycon tvs ty _))
499 = delListFromNameSet (extractHsTyNames ty)
501 -- A type synonym type constructor isn't a "gate" for instance decls
503 getGates source_fvs (TyClD (TyData _ ctxt tycon tvs cons _ _ _ _ _))
504 = delListFromNameSet (foldr (plusFV . get) (extractHsCtxtTyNames ctxt) cons)
506 `addOneToNameSet` tycon
508 get (ConDecl n _ tvs ctxt details _)
509 | n `elemNameSet` source_fvs
510 -- If the constructor is method, get fvs from all its fields
511 = delListFromNameSet (get_details details `plusFV`
512 extractHsCtxtTyNames ctxt)
514 get (ConDecl n _ tvs ctxt (RecCon fields) _)
515 -- Even if the constructor isn't mentioned, the fields
516 -- might be, as selectors. They can't mention existentially
517 -- bound tyvars (typechecker checks for that) so no need for
518 -- the deleteListFromNameSet part
519 = foldr (plusFV . get_field) emptyFVs fields
521 get other_con = emptyFVs
523 get_details (VanillaCon tys) = plusFVs (map get_bang tys)
524 get_details (InfixCon t1 t2) = get_bang t1 `plusFV` get_bang t2
525 get_details (RecCon fields) = plusFVs [get_bang t | (_, t) <- fields]
527 get_field (fs,t) | any (`elemNameSet` source_fvs) fs = get_bang t
528 | otherwise = emptyFVs
530 get_bang bty = extractHsTyNames (getBangType bty)
532 getGates source_fvs other_decl = emptyFVs
535 @getWiredInGates@ is just like @getGates@, but it sees a wired-in @Name@
536 rather than a declaration.
539 getWiredInGates :: Name -> FreeVars
540 getWiredInGates name -- No classes are wired in
541 = case lookupNameEnv wiredInThingEnv name of
542 Just (AnId the_id) -> getWiredInGates_s (namesOfType (idType the_id))
546 -> getWiredInGates_s (delListFromNameSet (namesOfType ty) (map getName tyvars))
548 (tyvars,ty) = getSynTyConDefn tc
552 getWiredInGates_s names = foldr (plusFV . getWiredInGates) emptyFVs (nameSetToList names)
556 getInstDeclGates (InstD (InstDecl inst_ty _ _ _ _)) = extractHsTyNames inst_ty
557 getInstDeclGates other = emptyFVs
561 %*********************************************************
563 \subsection{Fixities}
565 %*********************************************************
568 fixitiesFromLocalDecls :: GlobalRdrEnv -> [RdrNameHsDecl] -> RnMG LocalFixityEnv
569 fixitiesFromLocalDecls gbl_env decls
570 = doptRn Opt_WarnUnusedBinds `thenRn` \ warn_unused ->
571 foldlRn (getFixities warn_unused) emptyNameEnv decls `thenRn` \ env ->
572 traceRn (text "fixity env" <+> vcat (map ppr (nameEnvElts env)))
576 getFixities :: Bool -> LocalFixityEnv -> RdrNameHsDecl -> RnMG LocalFixityEnv
577 getFixities warn_uu acc (FixD fix)
578 = fix_decl warn_uu acc fix
580 getFixities warn_uu acc (TyClD (ClassDecl _ _ _ _ sigs _ _ _ ))
581 = foldlRn (fix_decl warn_uu) acc [sig | FixSig sig <- sigs]
582 -- Get fixities from class decl sigs too.
583 getFixities warn_uu acc other_decl
586 fix_decl warn_uu acc sig@(FixitySig rdr_name fixity loc)
587 = -- Check for fixity decl for something not declared
589 lookupGlobalRn gbl_env rdr_name `thenRn` \ maybe_name ->
591 Nothing -> checkRn (not warn_uu) (unusedFixityDecl rdr_name fixity) `thenRn_`
596 -- Check for duplicate fixity decl
597 case lookupNameEnv acc name of {
598 Just (FixitySig _ _ loc') -> addErrRn (dupFixityDecl rdr_name loc loc')
599 `thenRn_` returnRn acc ;
601 Nothing -> returnRn (extendNameEnv acc name (FixitySig name fixity loc))
606 %*********************************************************
608 \subsection{Deprecations}
610 %*********************************************************
612 For deprecations, all we do is check that the names are in scope.
613 It's only imported deprecations, dealt with in RnIfaces, that we
614 gather them together.
617 rnDeprecs :: GlobalRdrEnv -> Maybe DeprecTxt
618 -> [RdrNameDeprecation] -> RnMG Deprecations
619 rnDeprecs gbl_env Nothing []
622 rnDeprecs gbl_env (Just txt) decls
623 = mapRn (addErrRn . badDeprec) decls `thenRn_`
624 returnRn (DeprecAll txt)
626 rnDeprecs gbl_env Nothing decls
627 = mapRn rn_deprec decls `thenRn` \ pairs ->
628 returnRn (DeprecSome (mkNameEnv (catMaybes pairs)))
630 rn_deprec (Deprecation rdr_name txt loc)
632 lookupGlobalRn gbl_env rdr_name `thenRn` \ maybe_name ->
634 Just n -> returnRn (Just (n,txt))
635 Nothing -> returnRn Nothing
639 %*********************************************************
641 \subsection{Unused names}
643 %*********************************************************
646 reportUnusedNames :: ModuleName -> [ModuleName]
647 -> GlobalRdrEnv -> AvailEnv
648 -> Avails -> NameSet -> [RenamedHsDecl]
650 reportUnusedNames mod_name direct_import_mods
652 export_avails mentioned_names
654 = warnUnusedModules unused_imp_mods `thenRn_`
655 warnUnusedLocalBinds bad_locals `thenRn_`
656 warnUnusedImports bad_imp_names `thenRn_`
657 printMinimalImports mod_name minimal_imports `thenRn_`
658 warnDeprecations really_used_names `thenRn_`
662 used_names = mentioned_names `unionNameSets` availsToNameSet export_avails
664 -- Now, a use of C implies a use of T,
665 -- if C was brought into scope by T(..) or T(C)
666 really_used_names = used_names `unionNameSets`
667 mkNameSet [ parent_name
668 | sub_name <- nameSetToList used_names
670 -- Usually, every used name will appear in avail_env, but there
671 -- is one time when it doesn't: tuples and other built in syntax. When you
672 -- write (a,b) that gives rise to a *use* of "(,)", so that the
673 -- instances will get pulled in, but the tycon "(,)" isn't actually
674 -- in scope. Also, (-x) gives rise to an implicit use of 'negate';
675 -- similarly, 3.5 gives rise to an implcit use of :%
676 -- Hence the silent 'False' in all other cases
678 , Just parent_name <- [case lookupNameEnv avail_env sub_name of
679 Just (AvailTC n _) -> Just n
683 defined_names, defined_and_used, defined_but_not_used :: [(Name,Provenance)]
684 defined_names = concat (rdrEnvElts gbl_env)
685 (defined_and_used, defined_but_not_used) = partition used defined_names
686 used (name,_) = not (name `elemNameSet` really_used_names)
688 -- Filter out the ones only defined implicitly
690 bad_locals = [n | (n,LocalDef) <- defined_but_not_used]
692 bad_imp_names :: [(Name,Provenance)]
693 bad_imp_names = [(n,p) | (n,p@(NonLocalDef (UserImport mod _ True) _)) <- defined_but_not_used,
694 not (module_unused mod)]
696 -- inst_mods are directly-imported modules that
697 -- contain instance decl(s) that the renamer decided to suck in
698 -- It's not necessarily redundant to import such modules.
704 -- The import M() is not *necessarily* redundant, even if
705 -- we suck in no instance decls from M (e.g. it contains
706 -- no instance decls, or This contains no code). It may be
707 -- that we import M solely to ensure that M's orphan instance
708 -- decls (or those in its imports) are visible to people who
709 -- import This. Sigh.
710 -- There's really no good way to detect this, so the error message
711 -- in RnEnv.warnUnusedModules is weakened instead
712 inst_mods :: [ModuleName]
713 inst_mods = [m | InstD (InstDecl _ _ _ (Just dfun) _) <- imported_decls,
714 let m = moduleName (nameModule dfun),
715 m `elem` direct_import_mods
718 -- To figure out the minimal set of imports, start with the things
719 -- that are in scope (i.e. in gbl_env). Then just combine them
720 -- into a bunch of avails, so they are properly grouped
721 minimal_imports :: FiniteMap ModuleName AvailEnv
722 minimal_imports0 = emptyFM
723 minimal_imports1 = foldr add_name minimal_imports0 defined_and_used
724 minimal_imports = foldr add_inst_mod minimal_imports1 inst_mods
726 add_name (n,NonLocalDef (UserImport m _ _) _) acc = addToFM_C plusAvailEnv acc (moduleName (nameModule n))
727 (unitAvailEnv (mk_avail n))
728 add_name (n,other_prov) acc = acc
730 mk_avail n = case lookupNameEnv avail_env n of
731 Just (AvailTC m _) | n==m -> AvailTC n [n]
732 | otherwise -> AvailTC m [n,m]
733 Just avail -> Avail n
734 Nothing -> pprPanic "mk_avail" (ppr n)
737 | m `elemFM` acc = acc -- We import something already
738 | otherwise = addToFM acc m emptyAvailEnv
739 -- Add an empty collection of imports for a module
740 -- from which we have sucked only instance decls
742 -- unused_imp_mods are the directly-imported modules
743 -- that are not mentioned in minimal_imports
744 unused_imp_mods = [m | m <- direct_import_mods,
745 not (maybeToBool (lookupFM minimal_imports m)),
748 module_unused :: Module -> Bool
749 module_unused mod = moduleName mod `elem` unused_imp_mods
752 warnDeprecations used_names
753 = doptRn Opt_WarnDeprecations `thenRn` \ warn_drs ->
754 if not warn_drs then returnRn () else
756 getIfacesRn `thenRn` \ ifaces ->
757 getHomeIfaceTableRn `thenRn` \ hit ->
761 | n <- nameSetToList used_names,
762 Just txt <- [lookup_deprec hit pit n] ]
764 mapRn_ warnDeprec deprecs
767 lookup_deprec hit pit n
768 = case lookupModuleEnv hit mod of
769 Just iface -> lookupDeprec iface n
770 Nothing -> case lookupModuleEnv pit mod of
771 Just iface -> lookupDeprec iface n
772 Nothing -> pprPanic "warnDeprecations:" (ppr n)
776 -- ToDo: deal with original imports with 'qualified' and 'as M' clauses
777 printMinimalImports mod_name imps
778 = doptRn Opt_D_dump_minimal_imports `thenRn` \ dump_minimal ->
779 if not dump_minimal then returnRn () else
781 mapRn to_ies (fmToList imps) `thenRn` \ mod_ies ->
782 ioToRnM (do { h <- openFile filename WriteMode ;
783 printForUser h (vcat (map ppr_mod_ie mod_ies))
787 filename = moduleNameUserString mod_name ++ ".imports"
788 ppr_mod_ie (mod_name, ies)
789 | mod_name == pRELUDE_Name
792 = ptext SLIT("import") <+> ppr mod_name <>
793 parens (fsep (punctuate comma (map ppr ies)))
795 to_ies (mod, avail_env) = mapRn to_ie (availEnvElts avail_env) `thenRn` \ ies ->
798 to_ie :: AvailInfo -> RnMG (IE Name)
799 to_ie (Avail n) = returnRn (IEVar n)
800 to_ie (AvailTC n [m]) = ASSERT( n==m )
801 returnRn (IEThingAbs n)
802 to_ie (AvailTC n ns) = getInterfaceExports (moduleName (nameModule n))
803 ImportBySystem `thenRn` \ (_, avails) ->
804 case [ms | AvailTC m ms <- avails, m == n] of
805 [ms] | all (`elem` ns) ms -> returnRn (IEThingAll n)
806 | otherwise -> returnRn (IEThingWith n (filter (/= n) ns))
807 other -> pprTrace "to_ie" (ppr n <+> ppr (nameModule n) <+> ppr other) $
810 rnDump :: [RenamedHsDecl] -- Renamed imported decls
811 -> [RenamedHsDecl] -- Renamed local decls
813 rnDump imp_decls local_decls
814 = doptRn Opt_D_dump_rn_trace `thenRn` \ dump_rn_trace ->
815 doptRn Opt_D_dump_rn_stats `thenRn` \ dump_rn_stats ->
816 doptRn Opt_D_dump_rn `thenRn` \ dump_rn ->
817 if dump_rn_trace || dump_rn_stats || dump_rn then
818 getRnStats imp_decls `thenRn` \ stats_msg ->
819 returnRn (printErrs stats_msg >>
820 dumpIfSet dump_rn "Renamer:"
821 (vcat (map ppr (local_decls ++ imp_decls))))
827 %*********************************************************
829 \subsection{Statistics}
831 %*********************************************************
834 getRnStats :: [RenamedHsDecl] -> RnMG SDoc
835 getRnStats imported_decls
836 = getIfacesRn `thenRn` \ ifaces ->
838 n_mods = length [() | (_, _, True) <- eltsFM (iImpModInfo ifaces)]
840 decls_read = [decl | (avail, True, (_,decl)) <- nameEnvElts (iDecls ifaces),
841 -- Data, newtype, and class decls are in the decls_fm
842 -- under multiple names; the tycon/class, and each
843 -- constructor/class op too.
844 -- The 'True' selects just the 'main' decl
845 not (isLocallyDefined (availName avail))
848 (cd_rd, dd_rd, nd_rd, sd_rd, vd_rd, _) = count_decls decls_read
849 (cd_sp, dd_sp, nd_sp, sd_sp, vd_sp, id_sp) = count_decls imported_decls
851 unslurped_insts = iInsts ifaces
852 inst_decls_unslurped = length (bagToList unslurped_insts)
853 inst_decls_read = id_sp + inst_decls_unslurped
856 [int n_mods <+> text "interfaces read",
857 hsep [ int cd_sp, text "class decls imported, out of",
858 int cd_rd, text "read"],
859 hsep [ int dd_sp, text "data decls imported, out of",
860 int dd_rd, text "read"],
861 hsep [ int nd_sp, text "newtype decls imported, out of",
862 int nd_rd, text "read"],
863 hsep [int sd_sp, text "type synonym decls imported, out of",
864 int sd_rd, text "read"],
865 hsep [int vd_sp, text "value signatures imported, out of",
866 int vd_rd, text "read"],
867 hsep [int id_sp, text "instance decls imported, out of",
868 int inst_decls_read, text "read"],
869 text "cls dcls slurp" <+> fsep (map (ppr . tyClDeclName)
870 [d | TyClD d <- imported_decls, isClassDecl d]),
871 text "cls dcls read" <+> fsep (map (ppr . tyClDeclName)
872 [d | TyClD d <- decls_read, isClassDecl d])]
874 returnRn (hcat [text "Renamer stats: ", stats])
884 tycl_decls = [d | TyClD d <- decls]
885 (class_decls, data_decls, newtype_decls, syn_decls) = countTyClDecls tycl_decls
887 val_decls = length [() | SigD _ <- decls]
888 inst_decls = length [() | InstD _ <- decls]
892 %************************************************************************
894 \subsection{Errors and warnings}
896 %************************************************************************
899 warnDeprec :: (Name, DeprecTxt) -> RnM d ()
900 warnDeprec (name, txt)
901 = pushSrcLocRn (getSrcLoc name) $
903 sep [ text (occNameFlavour (nameOccName name)) <+> ppr name <+>
904 text "is deprecated:", nest 4 (ppr txt) ]
907 unusedFixityDecl rdr_name fixity
908 = hsep [ptext SLIT("Unused fixity declaration for"), quotes (ppr rdr_name)]
910 dupFixityDecl rdr_name loc1 loc2
911 = vcat [ptext SLIT("Multiple fixity declarations for") <+> quotes (ppr rdr_name),
912 ptext SLIT("at ") <+> ppr loc1,
913 ptext SLIT("and") <+> ppr loc2]
916 = sep [ptext SLIT("Illegal deprecation when whole module is deprecated"),
921 %********************************************************
923 \subsection{Checking usage information}
925 %********************************************************
929 checkEarlyExit mod_name
930 = traceRn (text "Considering whether compilation is required...") `thenRn_`
932 -- Read the old interface file, if any, for the module being compiled
933 findAndReadIface doc_str mod_name False {- Not hi-boot -} `thenRn` \ maybe_iface ->
935 -- CHECK WHETHER WE HAVE IT ALREADY
937 Left err -> -- Old interface file not found, so we'd better bail out
938 traceRn (vcat [ptext SLIT("No old interface file for") <+> ppr mod_name,
940 returnRn (outOfDate, Nothing)
943 | panic "checkEarlyExit: ???: not opt_SourceUnchanged"
944 -> -- Source code changed
945 traceRn (nest 4 (text "source file changed or recompilation check turned off")) `thenRn_`
946 returnRn (False, Just iface)
949 -> -- Source code unchanged and no errors yet... carry on
950 checkModUsage (pi_usages iface) `thenRn` \ up_to_date ->
951 returnRn (up_to_date, Just iface)
953 -- Only look in current directory, with suffix .hi
954 doc_str = sep [ptext SLIT("need usage info from"), ppr mod_name]
961 checkModUsage :: [ImportVersion OccName] -> RnMG Bool
962 -- Given the usage information extracted from the old
963 -- M.hi file for the module being compiled, figure out
964 -- whether M needs to be recompiled.
966 checkModUsage [] = returnRn upToDate -- Yes! Everything is up to date!
968 checkModUsage ((mod_name, _, _, NothingAtAll) : rest)
969 -- If CurrentModule.hi contains
971 -- then that simply records that Foo lies below CurrentModule in the
972 -- hierarchy, but CurrentModule doesn't depend in any way on Foo.
973 -- In this case we don't even want to open Foo's interface.
974 = traceRn (ptext SLIT("Nothing used from:") <+> ppr mod_name) `thenRn_`
975 checkModUsage rest -- This one's ok, so check the rest
977 checkModUsage ((mod_name, _, _, whats_imported) : rest)
978 = tryLoadInterface doc_str mod_name ImportBySystem `thenRn` \ (ifaces, maybe_err) ->
980 Just err -> out_of_date (sep [ptext SLIT("Can't find version number for module"),
982 -- Couldn't find or parse a module mentioned in the
983 -- old interface file. Don't complain -- it might just be that
984 -- the current module doesn't need that import and it's been deleted
988 (_, new_mod_vers, new_fix_vers, new_rule_vers, _, _)
989 = case lookupFM (iImpModInfo ifaces) mod_name of
990 Just (_, _, Just stuff) -> stuff
992 old_mod_vers = case whats_imported of
994 Specifically v _ _ _ -> v
995 -- NothingAtAll case dealt with by previous eqn for checkModUsage
997 -- If the module version hasn't changed, just move on
998 if new_mod_vers == old_mod_vers then
999 traceRn (sep [ptext SLIT("Module version unchanged:"), ppr mod_name])
1000 `thenRn_` checkModUsage rest
1002 traceRn (sep [ptext SLIT("Module version has changed:"), ppr mod_name])
1004 -- Module version changed, so check entities inside
1006 -- If the usage info wants to say "I imported everything from this module"
1007 -- it does so by making whats_imported equal to Everything
1008 -- In that case, we must recompile
1009 case whats_imported of { -- NothingAtAll dealt with earlier
1012 -> out_of_date (ptext SLIT("...and I needed the whole module")) ;
1014 Specifically _ old_fix_vers old_rule_vers old_local_vers ->
1016 if old_fix_vers /= new_fix_vers then
1017 out_of_date (ptext SLIT("Fixities changed"))
1018 else if old_rule_vers /= new_rule_vers then
1019 out_of_date (ptext SLIT("Rules changed"))
1021 -- Non-empty usage list, so check item by item
1022 checkEntityUsage mod_name (iDecls ifaces) old_local_vers `thenRn` \ up_to_date ->
1024 traceRn (ptext SLIT("...but the bits I use haven't.")) `thenRn_`
1025 checkModUsage rest -- This one's ok, so check the rest
1027 returnRn outOfDate -- This one failed, so just bail out now
1030 doc_str = sep [ptext SLIT("need version info for"), ppr mod_name]
1033 checkEntityUsage mod decls []
1034 = returnRn upToDate -- Yes! All up to date!
1036 checkEntityUsage mod decls ((occ_name,old_vers) : rest)
1037 = newGlobalName mod occ_name `thenRn` \ name ->
1038 case lookupNameEnv decls name of
1040 Nothing -> -- We used it before, but it ain't there now
1041 out_of_date (sep [ptext SLIT("No longer exported:"), ppr name])
1043 Just (new_vers,_,_,_) -- It's there, but is it up to date?
1044 | new_vers == old_vers
1045 -- Up to date, so check the rest
1046 -> checkEntityUsage mod decls rest
1049 -- Out of date, so bale out
1050 -> out_of_date (sep [ptext SLIT("Out of date:"), ppr name])
1052 out_of_date msg = traceRn msg `thenRn_` returnRn outOfDate