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 HsPragmas ( DataPragmas(..) )
13 import RdrHsSyn ( RdrNameHsModule, RdrNameHsDecl, RdrNameDeprecation )
14 import RnHsSyn ( RenamedHsModule, RenamedHsDecl,
15 extractHsTyNames, extractHsCtxtTyNames
18 import CmdLineOpts ( DynFlags, DynFlag(..) )
20 import RnNames ( getGlobalNames )
21 import RnSource ( rnSourceDecls, rnDecl )
22 import RnIfaces ( getImportedInstDecls, importDecl, mkImportInfo,
24 getImportedRules, getSlurped, removeContext,
25 ImportDeclResult(..), findAndReadIface
27 import RnEnv ( availName, availsToNameSet,
28 emptyAvailEnv, unitAvailEnv, availEnvElts, plusAvailEnv, sortAvails,
29 warnUnusedImports, warnUnusedLocalBinds, warnUnusedModules,
30 lookupOrigNames, unknownNameErr,
31 FreeVars, plusFVs, plusFV, unitFV, emptyFVs, isEmptyFVs, addOneFV
33 import Module ( Module, ModuleName, WhereFrom(..),
34 moduleNameUserString, moduleName, mkModuleInThisPackage,
37 import Name ( Name, isLocallyDefined, NamedThing(..), getSrcLoc,
38 nameOccName, nameUnique, nameModule,
39 isUserExportedName, toRdrName,
40 mkNameEnv, nameEnvElts, extendNameEnv
42 import OccName ( occNameFlavour, isValOcc )
44 import TyCon ( isSynTyCon, getSynTyConDefn )
46 import TysWiredIn ( unitTyCon, intTyCon, doubleTyCon, boolTyCon )
47 import PrelNames ( mAIN_Name, pREL_MAIN_Name, pRELUDE_Name,
49 unpackCString_RDR, unpackCStringFoldr_RDR, unpackCStringUtf8_RDR,
52 import PrelInfo ( fractionalClassKeys, derivingOccurrences, wiredInThingEnv )
53 import Type ( namesOfType, funTyCon )
54 import ErrUtils ( printErrorsAndWarnings, dumpIfSet, ghcExit )
55 import BasicTypes ( Version, initialVersion )
56 import Bag ( isEmptyBag, bagToList )
57 import FiniteMap ( FiniteMap, eltsFM, fmToList, emptyFM, lookupFM,
58 addToFM_C, elemFM, addToFM
60 import UniqSupply ( UniqSupply )
61 import UniqFM ( lookupUFM )
62 import SrcLoc ( noSrcLoc )
63 import Maybes ( maybeToBool, expectJust )
65 import IO ( openFile, IOMode(..) )
66 import HscTypes ( Finder, PersistentCompilerState, HomeIfaceTable, HomeSymbolTable,
67 ModIface(..), TyThing(..),
68 GlobalRdrEnv, AvailEnv, Avails, GenAvailInfo(..), AvailInfo,
69 Provenance(..), pprNameProvenance, ImportReason(..) )
70 import List ( partition, nub )
76 renameModule :: DynFlags -> Finder
77 -> HomeIfaceTable -> HomeSymbolTable
78 -> PersistentCompilerState
79 -> Module -> RdrNameHsModule
80 -> IO (PersistentCompilerState, Maybe ModIface)
81 -- The mi_decls in the ModIface include
82 -- ones imported from packages too
84 renameModule dflags finder hit hst old_pcs this_module
85 this_mod@(HsModule _ _ _ _ _ _ loc)
86 = -- Initialise the renamer monad
88 ((maybe_rn_stuff, dump_action), (rn_warns_bag, rn_errs_bag), new_pcs)
89 <- initRn dflags finder hit hst old_pcs this_module loc (rename this_module this_mod) ;
92 printErrorsAndWarnings (rn_warns_bag, rn_errs_bag) ;
94 -- Dump any debugging output
98 if not (isEmptyBag rn_errs_bag) then
99 return (old_pcs, Nothing)
101 return (new_pcs, maybe_rn_stuff)
106 rename :: Module -> RdrNameHsModule -> RnMG (Maybe ModIface, IO ())
107 rename this_module this_mod@(HsModule mod_name vers exports imports local_decls mod_deprec loc)
108 = -- FIND THE GLOBAL NAME ENVIRONMENT
109 getGlobalNames this_mod `thenRn` \ maybe_stuff ->
111 -- CHECK FOR EARLY EXIT
112 case maybe_stuff of {
113 Nothing -> -- Everything is up to date; no need to recompile further
114 rnDump [] [] `thenRn` \ dump_action ->
115 returnRn (Nothing, dump_action) ;
117 Just (gbl_env, local_gbl_env, export_avails, global_avail_env) ->
119 -- DEAL WITH DEPRECATIONS
120 rnDeprecs local_gbl_env mod_deprec local_decls `thenRn` \ my_deprecs ->
122 -- DEAL WITH LOCAL FIXITIES
123 fixitiesFromLocalDecls local_gbl_env local_decls `thenRn` \ local_fixity_env ->
126 initRnMS gbl_env local_fixity_env SourceMode (
127 rnSourceDecls local_decls
128 ) `thenRn` \ (rn_local_decls, source_fvs) ->
130 -- SLURP IN ALL THE NEEDED DECLARATIONS
131 implicitFVs mod_name rn_local_decls `thenRn` \ implicit_fvs ->
133 -- The export_fvs make the exported names look just as if they
134 -- occurred in the source program. For the reasoning, see the
135 -- comments with RnIfaces.getImportVersions.
136 -- We only need the 'parent name' of the avail;
137 -- that's enough to suck in the declaration.
138 export_fvs = mkNameSet (map availName export_avails)
139 real_source_fvs = source_fvs `plusFV` export_fvs
141 slurp_fvs = implicit_fvs `plusFV` real_source_fvs
142 -- It's important to do the "plus" this way round, so that
143 -- when compiling the prelude, locally-defined (), Bool, etc
144 -- override the implicit ones.
146 slurpImpDecls slurp_fvs `thenRn` \ rn_imp_decls ->
148 -- EXIT IF ERRORS FOUND
149 rnDump rn_imp_decls rn_local_decls `thenRn` \ dump_action ->
150 checkErrsRn `thenRn` \ no_errs_so_far ->
151 if not no_errs_so_far then
152 -- Found errors already, so exit now
153 returnRn (Nothing, dump_action)
156 -- GENERATE THE VERSION/USAGE INFO
157 mkImportInfo mod_name imports `thenRn` \ my_usages ->
159 -- RETURN THE RENAMED MODULE
160 getNameSupplyRn `thenRn` \ name_supply ->
161 getIfacesRn `thenRn` \ ifaces ->
163 direct_import_mods :: [ModuleName]
164 direct_import_mods = nub [m | ImportDecl m _ _ _ _ _ <- imports]
166 -- *don't* just pick the forward edges. It's entirely possible
167 -- that a module is only reachable via back edges.
168 user_import ImportByUser = True
169 user_import ImportByUserSource = True
170 user_import _ = False
172 -- Export only those fixities that are for names that are
173 -- (a) defined in this module
176 = mkNameEnv [ (name, fixity)
177 | FixitySig name fixity loc <- nameEnvElts local_fixity_env,
178 isUserExportedName name
182 -- Sort the exports to make them easier to compare for versions
183 my_exports = sortAvails export_avails
185 mod_iface = ModIface { mi_module = this_module,
186 mi_version = panic "mi_version: not filled in yet",
187 mi_orphan = any isOrphanDecl rn_local_decls,
188 mi_exports = my_exports,
189 mi_usages = my_usages,
190 mi_fixities = exported_fixities,
191 mi_deprecs = my_deprecs,
192 mi_decls = rn_local_decls ++ rn_imp_decls
196 -- REPORT UNUSED NAMES, AND DEBUG DUMP
197 reportUnusedNames mod_name direct_import_mods
198 gbl_env global_avail_env
199 export_avails source_fvs
200 rn_imp_decls `thenRn_`
202 returnRn (Just mod_iface, dump_action) }
204 trashed_exports = {-trace "rnSource:trashed_exports"-} Nothing
205 trashed_imports = {-trace "rnSource:trashed_imports"-} []
208 @implicitFVs@ forces the renamer to slurp in some things which aren't
209 mentioned explicitly, but which might be needed by the type checker.
212 implicitFVs mod_name decls
213 = lookupOrigNames implicit_occs `thenRn` \ implicit_names ->
214 returnRn (mkNameSet (map getName default_tycons) `plusFV`
217 -- Add occurrences for Int, and (), because they
218 -- are the types to which ambigious type variables may be defaulted by
219 -- the type checker; so they won't always appear explicitly.
220 -- [The () one is a GHC extension for defaulting CCall results.]
221 -- ALSO: funTyCon, since it occurs implicitly everywhere!
222 -- (we don't want to be bothered with making funTyCon a
223 -- free var at every function application!)
224 -- Double is dealt with separately in getGates
225 default_tycons = [unitTyCon, funTyCon, boolTyCon, intTyCon]
227 -- Add occurrences for IO or PrimIO
228 implicit_main | mod_name == mAIN_Name
229 || mod_name == pREL_MAIN_Name = [ioTyCon_RDR]
232 -- Now add extra "occurrences" for things that
233 -- the deriving mechanism, or defaulting, will later need in order to
235 implicit_occs = string_occs ++ foldr ((++) . get) implicit_main decls
237 -- Virtually every program has error messages in it somewhere
238 string_occs = [unpackCString_RDR, unpackCStringFoldr_RDR, unpackCStringUtf8_RDR,
241 get (TyClD (TyData _ _ _ _ _ _ (Just deriv_classes) _ _ _ _))
242 = concat (map get_deriv deriv_classes)
245 get_deriv cls = case lookupUFM derivingOccurrences cls of
251 isOrphanDecl (InstD (InstDecl inst_ty _ _ _ _))
252 = not (foldNameSet ((||) . isLocallyDefined) False (extractHsTyNames (removeContext inst_ty)))
253 -- The 'removeContext' is because of
254 -- instance Foo a => Baz T where ...
255 -- The decl is an orphan if Baz and T are both not locally defined,
256 -- even if Foo *is* locally defined
258 isOrphanDecl (RuleD (HsRule _ _ _ lhs _ _))
261 -- At the moment we just check for common LHS forms
262 -- Expand as necessary. Getting it wrong just means
263 -- more orphans than necessary
264 check (HsVar v) = not (isLocallyDefined v)
265 check (HsApp f a) = check f && check a
266 check (HsLit _) = False
267 check (HsOverLit _) = False
268 check (OpApp l o _ r) = check l && check o && check r
269 check (NegApp e _) = check e
270 check (HsPar e) = check e
271 check (SectionL e o) = check e && check o
272 check (SectionR o e) = check e && check o
274 check other = True -- Safe fall through
276 isOrphanDecl other = False
281 dupDefaultDeclErrRn (DefaultDecl _ locn1 : dup_things)
282 = pushSrcLocRn locn1 $
285 msg = hang (ptext SLIT("Multiple default declarations"))
286 4 (vcat (map pp dup_things))
287 pp (DefaultDecl _ locn) = ptext SLIT("here was another default declaration") <+> ppr locn
291 %*********************************************************
293 \subsection{Slurping declarations}
295 %*********************************************************
298 -------------------------------------------------------
299 slurpImpDecls source_fvs
300 = traceRn (text "slurpImp" <+> fsep (map ppr (nameSetToList source_fvs))) `thenRn_`
302 -- The current slurped-set records all local things
303 getSlurped `thenRn` \ source_binders ->
304 slurpSourceRefs source_binders source_fvs `thenRn` \ (decls, needed) ->
306 -- Then get everything else
307 closeDecls decls needed `thenRn` \ decls1 ->
309 -- Finally, get any deferred data type decls
310 slurpDeferredDecls decls1 `thenRn` \ final_decls ->
314 -------------------------------------------------------
315 slurpSourceRefs :: NameSet -- Variables defined in source
316 -> FreeVars -- Variables referenced in source
317 -> RnMG ([RenamedHsDecl],
318 FreeVars) -- Un-satisfied needs
319 -- The declaration (and hence home module) of each gate has
320 -- already been loaded
322 slurpSourceRefs source_binders source_fvs
323 = go_outer [] -- Accumulating decls
324 emptyFVs -- Unsatisfied needs
325 emptyFVs -- Accumulating gates
326 (nameSetToList source_fvs) -- Things whose defn hasn't been loaded yet
328 -- The outer loop repeatedly slurps the decls for the current gates
329 -- and the instance decls
331 -- The outer loop is needed because consider
332 -- instance Foo a => Baz (Maybe a) where ...
333 -- It may be that @Baz@ and @Maybe@ are used in the source module,
334 -- but not @Foo@; so we need to chase @Foo@ too.
336 -- We also need to follow superclass refs. In particular, 'chasing @Foo@' must
337 -- include actually getting in Foo's class decl
338 -- class Wib a => Foo a where ..
339 -- so that its superclasses are discovered. The point is that Wib is a gate too.
340 -- We do this for tycons too, so that we look through type synonyms.
342 go_outer decls fvs all_gates []
343 = returnRn (decls, fvs)
345 go_outer decls fvs all_gates refs -- refs are not necessarily slurped yet
346 = traceRn (text "go_outer" <+> ppr refs) `thenRn_`
347 foldlRn go_inner (decls, fvs, emptyFVs) refs `thenRn` \ (decls1, fvs1, gates1) ->
348 getImportedInstDecls (all_gates `plusFV` gates1) `thenRn` \ inst_decls ->
349 rnInstDecls decls1 fvs1 gates1 inst_decls `thenRn` \ (decls2, fvs2, gates2) ->
350 go_outer decls2 fvs2 (all_gates `plusFV` gates2)
351 (nameSetToList (gates2 `minusNameSet` all_gates))
352 -- Knock out the all_gates because even if we don't slurp any new
353 -- decls we can get some apparently-new gates from wired-in names
355 go_inner (decls, fvs, gates) wanted_name
356 = importDecl wanted_name `thenRn` \ import_result ->
357 case import_result of
358 AlreadySlurped -> returnRn (decls, fvs, gates)
359 WiredIn -> returnRn (decls, fvs, gates `plusFV` getWiredInGates wanted_name)
360 Deferred -> returnRn (decls, fvs, gates `addOneFV` wanted_name) -- It's a type constructor
362 HereItIs decl -> rnIfaceDecl decl `thenRn` \ (new_decl, fvs1) ->
363 returnRn (new_decl : decls,
365 gates `plusFV` getGates source_fvs new_decl)
367 rnInstDecls decls fvs gates []
368 = returnRn (decls, fvs, gates)
369 rnInstDecls decls fvs gates (d:ds)
370 = rnIfaceDecl d `thenRn` \ (new_decl, fvs1) ->
371 rnInstDecls (new_decl:decls)
373 (gates `plusFV` getInstDeclGates new_decl)
379 -------------------------------------------------------
380 -- closeDecls keeps going until the free-var set is empty
381 closeDecls decls needed
382 | not (isEmptyFVs needed)
383 = slurpDecls decls needed `thenRn` \ (decls1, needed1) ->
384 closeDecls decls1 needed1
387 = getImportedRules `thenRn` \ rule_decls ->
389 [] -> returnRn decls -- No new rules, so we are done
390 other -> rnIfaceDecls decls emptyFVs rule_decls `thenRn` \ (decls1, needed1) ->
391 closeDecls decls1 needed1
394 -------------------------------------------------------
395 -- Augment decls with any decls needed by needed.
396 -- Return also free vars of the new decls (only)
397 slurpDecls decls needed
398 = go decls emptyFVs (nameSetToList needed)
400 go decls fvs [] = returnRn (decls, fvs)
401 go decls fvs (ref:refs) = slurpDecl decls fvs ref `thenRn` \ (decls1, fvs1) ->
404 -------------------------------------------------------
405 slurpDecl decls fvs wanted_name
406 = importDecl wanted_name `thenRn` \ import_result ->
407 case import_result of
408 -- Found a declaration... rename it
409 HereItIs decl -> rnIfaceDecl decl `thenRn` \ (new_decl, fvs1) ->
410 returnRn (new_decl:decls, fvs1 `plusFV` fvs)
412 -- No declaration... (wired in thing, or deferred, or already slurped)
413 other -> returnRn (decls, fvs)
416 -------------------------------------------------------
417 rnIfaceDecls :: [RenamedHsDecl] -> FreeVars
418 -> [(Module, RdrNameHsDecl)]
419 -> RnM d ([RenamedHsDecl], FreeVars)
420 rnIfaceDecls decls fvs [] = returnRn (decls, fvs)
421 rnIfaceDecls decls fvs (d:ds) = rnIfaceDecl d `thenRn` \ (new_decl, fvs1) ->
422 rnIfaceDecls (new_decl:decls) (fvs1 `plusFV` fvs) ds
424 rnIfaceDecl (mod, decl) = initIfaceRnMS mod (rnDecl decl)
428 %*********************************************************
430 \subsection{Deferred declarations}
432 %*********************************************************
434 The idea of deferred declarations is this. Suppose we have a function
439 Then we don't want to load T and all its constructors, and all
440 the types those constructors refer to, and all the types *those*
441 constructors refer to, and so on. That might mean loading many more
442 interface files than is really necessary. So we 'defer' loading T.
444 But f might be strict, and the calling convention for evaluating
445 values of type T depends on how many constructors T has, so
446 we do need to load T, but not the full details of the type T.
447 So we load the full decl for T, but only skeleton decls for A and B:
449 data T = {- 2 constructors -}
451 Whether all this is worth it is moot.
454 slurpDeferredDecls :: [RenamedHsDecl] -> RnMG [RenamedHsDecl]
455 slurpDeferredDecls decls = returnRn decls
458 slurpDeferredDecls :: [RenamedHsDecl] -> RnMG [RenamedHsDecl]
459 slurpDeferredDecls decls
460 = getDeferredDecls `thenRn` \ def_decls ->
461 rnIfaceDecls decls emptyFVs (map stripDecl def_decls) `thenRn` \ (decls1, fvs) ->
462 ASSERT( isEmptyFVs fvs )
465 stripDecl (mod, TyClD (TyData dt _ tc tvs _ nconstrs _ _ loc name1 name2))
466 = (mod, TyClD (TyData dt [] tc tvs [] nconstrs Nothing NoDataPragmas loc
468 -- Nuke the context and constructors
469 -- But retain the *number* of constructors!
470 -- Also the tvs will have kinds on them.
475 %*********************************************************
477 \subsection{Extracting the `gates'}
479 %*********************************************************
481 When we import a declaration like
483 data T = T1 Wibble | T2 Wobble
485 we don't want to treat @Wibble@ and @Wobble@ as gates
486 {\em unless} @T1@, @T2@ respectively are mentioned by the user program.
487 If only @T@ is mentioned
488 we want only @T@ to be a gate;
489 that way we don't suck in useless instance
490 decls for (say) @Eq Wibble@, when they can't possibly be useful.
492 @getGates@ takes a newly imported (and renamed) decl, and the free
493 vars of the source program, and extracts from the decl the gate names.
496 getGates source_fvs (SigD (IfaceSig _ ty _ _))
497 = extractHsTyNames ty
499 getGates source_fvs (TyClD (ClassDecl ctxt cls tvs _ sigs _ _ _ _ ))
500 = (delListFromNameSet (foldr (plusFV . get) (extractHsCtxtTyNames ctxt) sigs)
502 `addOneToNameSet` cls)
503 `plusFV` maybe_double
505 get (ClassOpSig n _ ty _)
506 | n `elemNameSet` source_fvs = extractHsTyNames ty
507 | otherwise = emptyFVs
509 -- If we load any numeric class that doesn't have
510 -- Int as an instance, add Double to the gates.
511 -- This takes account of the fact that Double might be needed for
512 -- defaulting, but we don't want to load Double (and all its baggage)
513 -- if the more exotic classes aren't used at all.
514 maybe_double | nameUnique cls `elem` fractionalClassKeys
515 = unitFV (getName doubleTyCon)
519 getGates source_fvs (TyClD (TySynonym tycon tvs ty _))
520 = delListFromNameSet (extractHsTyNames ty)
522 -- A type synonym type constructor isn't a "gate" for instance decls
524 getGates source_fvs (TyClD (TyData _ ctxt tycon tvs cons _ _ _ _ _ _))
525 = delListFromNameSet (foldr (plusFV . get) (extractHsCtxtTyNames ctxt) cons)
527 `addOneToNameSet` tycon
529 get (ConDecl n _ tvs ctxt details _)
530 | n `elemNameSet` source_fvs
531 -- If the constructor is method, get fvs from all its fields
532 = delListFromNameSet (get_details details `plusFV`
533 extractHsCtxtTyNames ctxt)
535 get (ConDecl n _ tvs ctxt (RecCon fields) _)
536 -- Even if the constructor isn't mentioned, the fields
537 -- might be, as selectors. They can't mention existentially
538 -- bound tyvars (typechecker checks for that) so no need for
539 -- the deleteListFromNameSet part
540 = foldr (plusFV . get_field) emptyFVs fields
542 get other_con = emptyFVs
544 get_details (VanillaCon tys) = plusFVs (map get_bang tys)
545 get_details (InfixCon t1 t2) = get_bang t1 `plusFV` get_bang t2
546 get_details (RecCon fields) = plusFVs [get_bang t | (_, t) <- fields]
548 get_field (fs,t) | any (`elemNameSet` source_fvs) fs = get_bang t
549 | otherwise = emptyFVs
551 get_bang bty = extractHsTyNames (getBangType bty)
553 getGates source_fvs other_decl = emptyFVs
556 @getWiredInGates@ is just like @getGates@, but it sees a wired-in @Name@
557 rather than a declaration.
560 getWiredInGates :: Name -> FreeVars
561 getWiredInGates name -- No classes are wired in
562 = case lookupNameEnv wiredInThingEnv name of
563 Just (AnId the_id) -> getWiredInGates_s (namesOfType (idType the_id))
567 -> getWiredInGates_s (delListFromNameSet (namesOfType ty) (map getName tyvars))
569 (tyvars,ty) = getSynTyConDefn tc
573 getWiredInGates_s names = foldr (plusFV . getWiredInGates) emptyFVs (nameSetToList names)
577 getInstDeclGates (InstD (InstDecl inst_ty _ _ _ _)) = extractHsTyNames inst_ty
578 getInstDeclGates other = emptyFVs
582 %*********************************************************
584 \subsection{Fixities}
586 %*********************************************************
589 fixitiesFromLocalDecls :: GlobalRdrEnv -> [RdrNameHsDecl] -> RnMG LocalFixityEnv
590 fixitiesFromLocalDecls gbl_env decls
591 = doptRn Opt_WarnUnusedBinds `thenRn` \ warn_unused ->
592 foldlRn (getFixities warn_unused) emptyNameEnv decls `thenRn` \ env ->
593 traceRn (text "fixity env" <+> vcat (map ppr (nameEnvElts env)))
597 getFixities :: Bool -> LocalFixityEnv -> RdrNameHsDecl -> RnMG LocalFixityEnv
598 getFixities warn_uu acc (FixD fix)
599 = fix_decl warn_uu acc fix
601 getFixities warn_uu acc (TyClD (ClassDecl _ _ _ _ sigs _ _ _ _ ))
602 = foldlRn (fix_decl warn_uu) acc [sig | FixSig sig <- sigs]
603 -- Get fixities from class decl sigs too.
604 getFixities warn_uu acc other_decl
607 fix_decl warn_uu acc sig@(FixitySig rdr_name fixity loc)
608 = -- Check for fixity decl for something not declared
609 case lookupRdrEnv gbl_env rdr_name of {
611 -> pushSrcLocRn loc (addWarnRn (unusedFixityDecl rdr_name fixity))
612 `thenRn_` returnRn acc
613 | otherwise -> returnRn acc ;
617 -- Check for duplicate fixity decl
618 case lookupNameEnv acc name of {
619 Just (FixitySig _ _ loc') -> addErrRn (dupFixityDecl rdr_name loc loc')
620 `thenRn_` returnRn acc ;
622 Nothing -> returnRn (extendNameEnv acc name (FixitySig name fixity loc))
627 %*********************************************************
629 \subsection{Deprecations}
631 %*********************************************************
633 For deprecations, all we do is check that the names are in scope.
634 It's only imported deprecations, dealt with in RnIfaces, that we
635 gather them together.
638 rnDeprecs :: GlobalRdrEnv -> Maybe DeprecTxt
639 -> [RdrNameHsDecl] -> RnMG [RdrNameDeprecation]
640 rnDeprecs gbl_env mod_deprec decls
641 = mapRn rn_deprec deprecs `thenRn_`
642 returnRn (extra_deprec ++ deprecs)
644 deprecs = [d | DeprecD d <- decls]
645 extra_deprec = case mod_deprec of
647 Just txt -> [Deprecation (IEModuleContents undefined) txt noSrcLoc]
649 rn_deprec (Deprecation ie txt loc)
651 mapRn check (ieNames ie)
653 check n = case lookupRdrEnv gbl_env n of
654 Nothing -> addErrRn (unknownNameErr n)
655 Just _ -> returnRn ()
659 %*********************************************************
661 \subsection{Unused names}
663 %*********************************************************
666 reportUnusedNames :: ModuleName -> [ModuleName]
667 -> GlobalRdrEnv -> AvailEnv
668 -> Avails -> NameSet -> [RenamedHsDecl]
670 reportUnusedNames mod_name direct_import_mods
672 export_avails mentioned_names
674 = warnUnusedModules unused_imp_mods `thenRn_`
675 warnUnusedLocalBinds bad_locals `thenRn_`
676 warnUnusedImports bad_imp_names `thenRn_`
677 printMinimalImports mod_name minimal_imports `thenRn_`
678 warnDeprecations really_used_names `thenRn_`
682 used_names = mentioned_names `unionNameSets` availsToNameSet export_avails
684 -- Now, a use of C implies a use of T,
685 -- if C was brought into scope by T(..) or T(C)
686 really_used_names = used_names `unionNameSets`
687 mkNameSet [ parent_name
688 | sub_name <- nameSetToList used_names
690 -- Usually, every used name will appear in avail_env, but there
691 -- is one time when it doesn't: tuples and other built in syntax. When you
692 -- write (a,b) that gives rise to a *use* of "(,)", so that the
693 -- instances will get pulled in, but the tycon "(,)" isn't actually
694 -- in scope. Also, (-x) gives rise to an implicit use of 'negate';
695 -- similarly, 3.5 gives rise to an implcit use of :%
696 -- Hence the silent 'False' in all other cases
698 , Just parent_name <- [case lookupNameEnv avail_env sub_name of
699 Just (AvailTC n _) -> Just n
703 defined_names, defined_and_used, defined_but_not_used :: [(Name,Provenance)]
704 defined_names = concat (rdrEnvElts gbl_env)
705 (defined_and_used, defined_but_not_used) = partition used defined_names
706 used (name,_) = not (name `elemNameSet` really_used_names)
708 -- Filter out the ones only defined implicitly
710 bad_locals = [n | (n,LocalDef) <- defined_but_not_used]
712 bad_imp_names :: [(Name,Provenance)]
713 bad_imp_names = [(n,p) | (n,p@(NonLocalDef (UserImport mod _ True) _)) <- defined_but_not_used,
714 not (module_unused mod)]
716 -- inst_mods are directly-imported modules that
717 -- contain instance decl(s) that the renamer decided to suck in
718 -- It's not necessarily redundant to import such modules.
724 -- The import M() is not *necessarily* redundant, even if
725 -- we suck in no instance decls from M (e.g. it contains
726 -- no instance decls, or This contains no code). It may be
727 -- that we import M solely to ensure that M's orphan instance
728 -- decls (or those in its imports) are visible to people who
729 -- import This. Sigh.
730 -- There's really no good way to detect this, so the error message
731 -- in RnEnv.warnUnusedModules is weakened instead
732 inst_mods :: [ModuleName]
733 inst_mods = [m | InstD (InstDecl _ _ _ (Just dfun) _) <- imported_decls,
734 let m = moduleName (nameModule dfun),
735 m `elem` direct_import_mods
738 -- To figure out the minimal set of imports, start with the things
739 -- that are in scope (i.e. in gbl_env). Then just combine them
740 -- into a bunch of avails, so they are properly grouped
741 minimal_imports :: FiniteMap ModuleName AvailEnv
742 minimal_imports0 = emptyFM
743 minimal_imports1 = foldr add_name minimal_imports0 defined_and_used
744 minimal_imports = foldr add_inst_mod minimal_imports1 inst_mods
746 add_name (n,NonLocalDef (UserImport m _ _) _) acc = addToFM_C plusAvailEnv acc (moduleName (nameModule n))
747 (unitAvailEnv (mk_avail n))
748 add_name (n,other_prov) acc = acc
750 mk_avail n = case lookupNameEnv avail_env n of
751 Just (AvailTC m _) | n==m -> AvailTC n [n]
752 | otherwise -> AvailTC m [n,m]
753 Just avail -> Avail n
754 Nothing -> pprPanic "mk_avail" (ppr n)
757 | m `elemFM` acc = acc -- We import something already
758 | otherwise = addToFM acc m emptyAvailEnv
759 -- Add an empty collection of imports for a module
760 -- from which we have sucked only instance decls
762 -- unused_imp_mods are the directly-imported modules
763 -- that are not mentioned in minimal_imports
764 unused_imp_mods = [m | m <- direct_import_mods,
765 not (maybeToBool (lookupFM minimal_imports m)),
768 module_unused :: ModuleName -> Bool
769 module_unused mod = mod `elem` unused_imp_mods
772 warnDeprecations used_names
773 = doptRn Opt_WarnDeprecations `thenRn` \ warn_drs ->
774 if not warn_drs then returnRn () else
776 getIfacesRn `thenRn` \ ifaces ->
777 getHomeIfaceTableRn `thenRn` \ hit ->
781 | n <- nameSetToList used_names,
782 Just txt <- [lookup_deprec hit pit n] ]
784 mapRn_ warnDeprec deprecs
787 lookup_deprec hit pit n
788 = case lookupModuleEnv hit mod of
789 Just iface -> lookup_iface iface n
790 Nothing -> case lookupModuleEnv pit mod of
791 Just iface -> lookup_iface iface n
792 Nothing -> pprPanic "warnDeprecations:" (ppr n)
796 lookup_iface iface n = lookupNameEnv (mi_deprecs iface) n
798 -- ToDo: deal with original imports with 'qualified' and 'as M' clauses
799 printMinimalImports mod_name imps
800 = doptRn Opt_D_dump_minimal_imports `thenRn` \ dump_minimal ->
801 if not dump_minimal then returnRn () else
803 mapRn to_ies (fmToList imps) `thenRn` \ mod_ies ->
804 ioToRnM (do { h <- openFile filename WriteMode ;
805 printForUser h (vcat (map ppr_mod_ie mod_ies))
809 filename = moduleNameUserString mod_name ++ ".imports"
810 ppr_mod_ie (mod_name, ies)
811 | mod_name == pRELUDE_Name
814 = ptext SLIT("import") <+> ppr mod_name <>
815 parens (fsep (punctuate comma (map ppr ies)))
817 to_ies (mod, avail_env) = mapRn to_ie (availEnvElts avail_env) `thenRn` \ ies ->
820 to_ie :: AvailInfo -> RnMG (IE Name)
821 to_ie (Avail n) = returnRn (IEVar n)
822 to_ie (AvailTC n [m]) = ASSERT( n==m )
823 returnRn (IEThingAbs n)
824 to_ie (AvailTC n ns) = getInterfaceExports (moduleName (nameModule n))
825 ImportBySystem `thenRn` \ (_, avails) ->
826 case [ms | AvailTC m ms <- avails, m == n] of
827 [ms] | all (`elem` ns) ms -> returnRn (IEThingAll n)
828 | otherwise -> returnRn (IEThingWith n (filter (/= n) ns))
829 other -> pprTrace "to_ie" (ppr n <+> ppr (nameModule n) <+> ppr other) $
832 rnDump :: [RenamedHsDecl] -- Renamed imported decls
833 -> [RenamedHsDecl] -- Renamed local decls
835 rnDump imp_decls local_decls
836 = doptRn Opt_D_dump_rn_trace `thenRn` \ dump_rn_trace ->
837 doptRn Opt_D_dump_rn_stats `thenRn` \ dump_rn_stats ->
838 doptRn Opt_D_dump_rn `thenRn` \ dump_rn ->
839 if dump_rn_trace || dump_rn_stats || dump_rn then
840 getRnStats imp_decls `thenRn` \ stats_msg ->
841 returnRn (printErrs stats_msg >>
842 dumpIfSet dump_rn "Renamer:"
843 (vcat (map ppr (local_decls ++ imp_decls))))
849 %*********************************************************
851 \subsection{Statistics}
853 %*********************************************************
856 getRnStats :: [RenamedHsDecl] -> RnMG SDoc
857 getRnStats imported_decls
858 = getIfacesRn `thenRn` \ ifaces ->
860 n_mods = length [() | (_, _, True) <- eltsFM (iImpModInfo ifaces)]
862 decls_read = [decl | (avail, True, (_,decl)) <- nameEnvElts (iDecls ifaces),
863 -- Data, newtype, and class decls are in the decls_fm
864 -- under multiple names; the tycon/class, and each
865 -- constructor/class op too.
866 -- The 'True' selects just the 'main' decl
867 not (isLocallyDefined (availName avail))
870 (cd_rd, dd_rd, nd_rd, sd_rd, vd_rd, _) = count_decls decls_read
871 (cd_sp, dd_sp, nd_sp, sd_sp, vd_sp, id_sp) = count_decls imported_decls
873 unslurped_insts = iInsts ifaces
874 inst_decls_unslurped = length (bagToList unslurped_insts)
875 inst_decls_read = id_sp + inst_decls_unslurped
878 [int n_mods <+> text "interfaces read",
879 hsep [ int cd_sp, text "class decls imported, out of",
880 int cd_rd, text "read"],
881 hsep [ int dd_sp, text "data decls imported, out of",
882 int dd_rd, text "read"],
883 hsep [ int nd_sp, text "newtype decls imported, out of",
884 int nd_rd, text "read"],
885 hsep [int sd_sp, text "type synonym decls imported, out of",
886 int sd_rd, text "read"],
887 hsep [int vd_sp, text "value signatures imported, out of",
888 int vd_rd, text "read"],
889 hsep [int id_sp, text "instance decls imported, out of",
890 int inst_decls_read, text "read"],
891 text "cls dcls slurp" <+> fsep (map (ppr . tyClDeclName)
892 [d | TyClD d <- imported_decls, isClassDecl d]),
893 text "cls dcls read" <+> fsep (map (ppr . tyClDeclName)
894 [d | TyClD d <- decls_read, isClassDecl d])]
896 returnRn (hcat [text "Renamer stats: ", stats])
906 tycl_decls = [d | TyClD d <- decls]
907 (class_decls, data_decls, newtype_decls, syn_decls) = countTyClDecls tycl_decls
909 val_decls = length [() | SigD _ <- decls]
910 inst_decls = length [() | InstD _ <- decls]
914 %************************************************************************
916 \subsection{Errors and warnings}
918 %************************************************************************
921 warnDeprec :: (Name, DeprecTxt) -> RnM d ()
922 warnDeprec (name, txt)
923 = pushSrcLocRn (getSrcLoc name) $
925 sep [ text (occNameFlavour (nameOccName name)) <+> ppr name <+>
926 text "is deprecated:", nest 4 (ppr txt) ]
929 unusedFixityDecl rdr_name fixity
930 = hsep [ptext SLIT("Unused fixity declaration for"), quotes (ppr rdr_name)]
932 dupFixityDecl rdr_name loc1 loc2
933 = vcat [ptext SLIT("Multiple fixity declarations for") <+> quotes (ppr rdr_name),
934 ptext SLIT("at ") <+> ppr loc1,
935 ptext SLIT("and") <+> ppr loc2]
939 %********************************************************
941 \subsection{Checking usage information}
943 %********************************************************
947 checkEarlyExit mod_name
948 = traceRn (text "Considering whether compilation is required...") `thenRn_`
950 -- Read the old interface file, if any, for the module being compiled
951 findAndReadIface doc_str mod_name False {- Not hi-boot -} `thenRn` \ maybe_iface ->
953 -- CHECK WHETHER WE HAVE IT ALREADY
955 Left err -> -- Old interface file not found, so we'd better bail out
956 traceRn (vcat [ptext SLIT("No old interface file for") <+> ppr mod_name,
958 returnRn (outOfDate, Nothing)
961 | panic "checkEarlyExit: ???: not opt_SourceUnchanged"
962 -> -- Source code changed
963 traceRn (nest 4 (text "source file changed or recompilation check turned off")) `thenRn_`
964 returnRn (False, Just iface)
967 -> -- Source code unchanged and no errors yet... carry on
968 checkModUsage (pi_usages iface) `thenRn` \ up_to_date ->
969 returnRn (up_to_date, Just iface)
971 -- Only look in current directory, with suffix .hi
972 doc_str = sep [ptext SLIT("need usage info from"), ppr mod_name]
979 checkModUsage :: [ImportVersion OccName] -> RnMG Bool
980 -- Given the usage information extracted from the old
981 -- M.hi file for the module being compiled, figure out
982 -- whether M needs to be recompiled.
984 checkModUsage [] = returnRn upToDate -- Yes! Everything is up to date!
986 checkModUsage ((mod_name, _, _, NothingAtAll) : rest)
987 -- If CurrentModule.hi contains
989 -- then that simply records that Foo lies below CurrentModule in the
990 -- hierarchy, but CurrentModule doesn't depend in any way on Foo.
991 -- In this case we don't even want to open Foo's interface.
992 = traceRn (ptext SLIT("Nothing used from:") <+> ppr mod_name) `thenRn_`
993 checkModUsage rest -- This one's ok, so check the rest
995 checkModUsage ((mod_name, _, _, whats_imported) : rest)
996 = tryLoadInterface doc_str mod_name ImportBySystem `thenRn` \ (ifaces, maybe_err) ->
998 Just err -> out_of_date (sep [ptext SLIT("Can't find version number for module"),
1000 -- Couldn't find or parse a module mentioned in the
1001 -- old interface file. Don't complain -- it might just be that
1002 -- the current module doesn't need that import and it's been deleted
1006 (_, new_mod_vers, new_fix_vers, new_rule_vers, _, _)
1007 = case lookupFM (iImpModInfo ifaces) mod_name of
1008 Just (_, _, Just stuff) -> stuff
1010 old_mod_vers = case whats_imported of
1012 Specifically v _ _ _ -> v
1013 -- NothingAtAll case dealt with by previous eqn for checkModUsage
1015 -- If the module version hasn't changed, just move on
1016 if new_mod_vers == old_mod_vers then
1017 traceRn (sep [ptext SLIT("Module version unchanged:"), ppr mod_name])
1018 `thenRn_` checkModUsage rest
1020 traceRn (sep [ptext SLIT("Module version has changed:"), ppr mod_name])
1022 -- Module version changed, so check entities inside
1024 -- If the usage info wants to say "I imported everything from this module"
1025 -- it does so by making whats_imported equal to Everything
1026 -- In that case, we must recompile
1027 case whats_imported of { -- NothingAtAll dealt with earlier
1030 -> out_of_date (ptext SLIT("...and I needed the whole module")) ;
1032 Specifically _ old_fix_vers old_rule_vers old_local_vers ->
1034 if old_fix_vers /= new_fix_vers then
1035 out_of_date (ptext SLIT("Fixities changed"))
1036 else if old_rule_vers /= new_rule_vers then
1037 out_of_date (ptext SLIT("Rules changed"))
1039 -- Non-empty usage list, so check item by item
1040 checkEntityUsage mod_name (iDecls ifaces) old_local_vers `thenRn` \ up_to_date ->
1042 traceRn (ptext SLIT("...but the bits I use haven't.")) `thenRn_`
1043 checkModUsage rest -- This one's ok, so check the rest
1045 returnRn outOfDate -- This one failed, so just bail out now
1048 doc_str = sep [ptext SLIT("need version info for"), ppr mod_name]
1051 checkEntityUsage mod decls []
1052 = returnRn upToDate -- Yes! All up to date!
1054 checkEntityUsage mod decls ((occ_name,old_vers) : rest)
1055 = newGlobalName mod occ_name `thenRn` \ name ->
1056 case lookupNameEnv decls name of
1058 Nothing -> -- We used it before, but it ain't there now
1059 out_of_date (sep [ptext SLIT("No longer exported:"), ppr name])
1061 Just (new_vers,_,_,_) -- It's there, but is it up to date?
1062 | new_vers == old_vers
1063 -- Up to date, so check the rest
1064 -> checkEntityUsage mod decls rest
1067 -- Out of date, so bale out
1068 -> out_of_date (sep [ptext SLIT("Out of date:"), ppr name])
1070 out_of_date msg = traceRn msg `thenRn_` returnRn outOfDate