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 ( opt_HiMap, opt_D_dump_rn_trace, opt_D_dump_minimal_imports,
19 opt_D_dump_rn, opt_D_dump_rn_stats, opt_WarnDeprecations,
23 import RnNames ( getGlobalNames )
24 import RnSource ( rnSourceDecls, rnDecl )
25 import RnIfaces ( getImportedInstDecls, importDecl, mkImportExportInfo, getInterfaceExports,
26 getImportedRules, getSlurped, removeContext,
27 loadBuiltinRules, getDeferredDecls, ImportDeclResult(..)
29 import RnEnv ( availName, availsToNameSet,
30 emptyAvailEnv, unitAvailEnv, availEnvElts, plusAvailEnv,
31 warnUnusedImports, warnUnusedLocalBinds, warnUnusedModules,
32 lookupOrigNames, unknownNameErr,
33 FreeVars, plusFVs, plusFV, unitFV, emptyFVs, isEmptyFVs, addOneFV
35 import Module ( Module, ModuleName, WhereFrom(..),
36 moduleNameUserString, mkSearchPath, moduleName, mkThisModule
38 import Name ( Name, isLocallyDefined, NamedThing(..), getSrcLoc,
39 nameOccName, nameUnique, nameModule, maybeUserImportedFrom,
40 isUserImportedExplicitlyName, isUserImportedName,
41 maybeWiredInTyConName, maybeWiredInIdName,
42 isUserExportedName, toRdrName,
43 nameEnvElts, extendNameEnv
45 import OccName ( occNameFlavour, isValOcc )
47 import TyCon ( isSynTyCon, getSynTyConDefn )
49 import TysWiredIn ( unitTyCon, intTyCon, doubleTyCon, boolTyCon )
50 import PrelRules ( builtinRules )
51 import PrelInfo ( mAIN_Name, pREL_MAIN_Name, pRELUDE_Name,
52 ioTyCon_RDR, unpackCString_RDR, unpackCString2_RDR, unpackCStringFoldr_RDR,
53 fractionalClassKeys, derivingOccurrences
55 import Type ( namesOfType, funTyCon )
56 import ErrUtils ( printErrorsAndWarnings, dumpIfSet, ghcExit )
57 import BasicTypes ( Version, initialVersion )
58 import Bag ( isEmptyBag, bagToList )
59 import FiniteMap ( FiniteMap, eltsFM, fmToList, emptyFM, lookupFM,
60 addToFM_C, elemFM, addToFM
62 import UniqSupply ( UniqSupply )
63 import UniqFM ( lookupUFM )
64 import SrcLoc ( noSrcLoc )
65 import Maybes ( maybeToBool, expectJust )
67 import IO ( openFile, IOMode(..) )
73 type RenameResult = ( Module -- This module
74 , RenamedHsModule -- Renamed module
75 , Maybe ParsedIface -- The existing interface file, if any
76 , ParsedIface -- The new interface
77 , RnNameSupply -- Final env; for renaming derivings
78 , FixityEnv -- The fixity environment; for derivings
79 , [Module]) -- Imported modules
81 renameModule :: UniqSupply -> RdrNameHsModule -> IO (Maybe RenameResult)
82 renameModule us this_mod@(HsModule mod_name vers exports imports local_decls _ loc)
83 = -- Initialise the renamer monad
85 ((maybe_rn_stuff, dump_action), rn_errs_bag, rn_warns_bag)
86 <- initRn (mkThisModule mod_name) us
87 (mkSearchPath opt_HiMap) loc
91 printErrorsAndWarnings rn_errs_bag rn_warns_bag ;
93 -- Dump any debugging output
97 if not (isEmptyBag rn_errs_bag) then
98 do { ghcExit 1 ; return Nothing }
100 return maybe_rn_stuff
105 rename :: RdrNameHsModule -> RnMG (Maybe RenameResult, IO ())
106 rename this_mod@(HsModule mod_name vers exports imports local_decls mod_deprec loc)
107 = -- FIND THE GLOBAL NAME ENVIRONMENT
108 getGlobalNames this_mod `thenRn` \ maybe_stuff ->
110 -- CHECK FOR EARLY EXIT
111 case maybe_stuff of {
112 Nothing -> -- Everything is up to date; no need to recompile further
113 rnDump [] [] `thenRn` \ dump_action ->
114 returnRn (Nothing, dump_action) ;
116 Just (gbl_env, local_gbl_env, export_avails, global_avail_env, old_iface) ->
118 -- DEAL WITH DEPRECATIONS
119 rnDeprecs local_gbl_env mod_deprec 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 loadBuiltinRules builtinRules `thenRn_`
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 mkImportExportInfo mod_name export_avails exports `thenRn` \ (my_exports, my_usages) ->
159 -- RETURN THE RENAMED MODULE
160 getNameSupplyRn `thenRn` \ name_supply ->
161 getIfacesRn `thenRn` \ ifaces ->
163 direct_import_mods :: [Module]
164 direct_import_mods = [m | (_, _, Just (m, _, _, _, ImportByUser, _))
165 <- eltsFM (iImpModInfo ifaces)]
166 -- Pick just the non-back-edge imports
167 -- (Back edges are ImportByUserSource)
169 this_module = mkThisModule mod_name
171 -- Export only those fixities that are for names that are
172 -- (a) defined in this module
175 = [ FixitySig (toRdrName name) fixity loc
176 | FixitySig name fixity loc <- nameEnvElts local_fixity_env,
177 isUserExportedName name
180 new_iface = ParsedIface { pi_mod = this_module
181 , pi_vers = initialVersion
182 , pi_orphan = any isOrphanDecl rn_local_decls
183 , pi_exports = my_exports
184 , pi_usages = my_usages
185 , pi_fixity = (initialVersion, exported_fixities)
186 , pi_deprecs = my_deprecs
187 -- These ones get filled in later
188 , pi_insts = [], pi_decls = []
189 , pi_rules = (initialVersion, [])
192 renamed_module = HsModule mod_name vers
193 trashed_exports trashed_imports
194 (rn_local_decls ++ rn_imp_decls)
198 result = (this_module, renamed_module,
199 old_iface, new_iface,
200 name_supply, local_fixity_env,
204 -- REPORT UNUSED NAMES, AND DEBUG DUMP
205 reportUnusedNames mod_name direct_import_mods
206 gbl_env global_avail_env
207 export_avails source_fvs
208 rn_imp_decls `thenRn_`
210 returnRn (Just result, dump_action) }
212 trashed_exports = {-trace "rnSource:trashed_exports"-} Nothing
213 trashed_imports = {-trace "rnSource:trashed_imports"-} []
216 @implicitFVs@ forces the renamer to slurp in some things which aren't
217 mentioned explicitly, but which might be needed by the type checker.
220 implicitFVs mod_name decls
221 = lookupOrigNames implicit_occs `thenRn` \ implicit_names ->
222 returnRn (mkNameSet (map getName default_tycons) `plusFV`
225 -- Add occurrences for Int, and (), because they
226 -- are the types to which ambigious type variables may be defaulted by
227 -- the type checker; so they won't always appear explicitly.
228 -- [The () one is a GHC extension for defaulting CCall results.]
229 -- ALSO: funTyCon, since it occurs implicitly everywhere!
230 -- (we don't want to be bothered with making funTyCon a
231 -- free var at every function application!)
232 -- Double is dealt with separately in getGates
233 default_tycons = [unitTyCon, funTyCon, boolTyCon, intTyCon]
235 -- Add occurrences for IO or PrimIO
236 implicit_main | mod_name == mAIN_Name
237 || mod_name == pREL_MAIN_Name = [ioTyCon_RDR]
240 -- Now add extra "occurrences" for things that
241 -- the deriving mechanism, or defaulting, will later need in order to
243 implicit_occs = string_occs ++ foldr ((++) . get) implicit_main decls
245 -- Virtually every program has error messages in it somewhere
246 string_occs = [unpackCString_RDR, unpackCString2_RDR, unpackCStringFoldr_RDR]
248 get (TyClD (TyData _ _ _ _ _ _ (Just deriv_classes) _ _))
249 = concat (map get_deriv deriv_classes)
252 get_deriv cls = case lookupUFM derivingOccurrences cls of
258 isOrphanDecl (InstD (InstDecl inst_ty _ _ _ _))
259 = not (foldNameSet ((||) . isLocallyDefined) False (extractHsTyNames (removeContext inst_ty)))
260 -- The 'removeContext' is because of
261 -- instance Foo a => Baz T where ...
262 -- The decl is an orphan if Baz and T are both not locally defined,
263 -- even if Foo *is* locally defined
265 isOrphanDecl (RuleD (HsRule _ _ _ lhs _ _))
268 -- At the moment we just check for common LHS forms
269 -- Expand as necessary. Getting it wrong just means
270 -- more orphans than necessary
271 check (HsVar v) = not (isLocallyDefined v)
272 check (HsApp f a) = check f && check a
273 check (HsLit _) = False
274 check (OpApp l o _ r) = check l && check o && check r
275 check (NegApp e _) = check e
276 check (HsPar e) = check e
277 check (SectionL e o) = check e && check o
278 check (SectionR o e) = check e && check o
280 check other = True -- Safe fall through
282 isOrphanDecl other = False
287 dupDefaultDeclErrRn (DefaultDecl _ locn1 : dup_things)
288 = pushSrcLocRn locn1 $
291 msg = hang (ptext SLIT("Multiple default declarations"))
292 4 (vcat (map pp dup_things))
293 pp (DefaultDecl _ locn) = ptext SLIT("here was another default declaration") <+> ppr locn
297 %*********************************************************
299 \subsection{Slurping declarations}
301 %*********************************************************
304 -------------------------------------------------------
305 slurpImpDecls source_fvs
306 = traceRn (text "slurpImp" <+> fsep (map ppr (nameSetToList source_fvs))) `thenRn_`
308 -- The current slurped-set records all local things
309 getSlurped `thenRn` \ source_binders ->
310 slurpSourceRefs source_binders source_fvs `thenRn` \ (decls, needed) ->
312 -- Then get everything else
313 closeDecls decls needed `thenRn` \ decls1 ->
315 -- Finally, get any deferred data type decls
316 slurpDeferredDecls decls1 `thenRn` \ final_decls ->
320 -------------------------------------------------------
321 slurpSourceRefs :: NameSet -- Variables defined in source
322 -> FreeVars -- Variables referenced in source
323 -> RnMG ([RenamedHsDecl],
324 FreeVars) -- Un-satisfied needs
325 -- The declaration (and hence home module) of each gate has
326 -- already been loaded
328 slurpSourceRefs source_binders source_fvs
329 = go_outer [] -- Accumulating decls
330 emptyFVs -- Unsatisfied needs
331 emptyFVs -- Accumulating gates
332 (nameSetToList source_fvs) -- Things whose defn hasn't been loaded yet
334 -- The outer loop repeatedly slurps the decls for the current gates
335 -- and the instance decls
337 -- The outer loop is needed because consider
338 -- instance Foo a => Baz (Maybe a) where ...
339 -- It may be that @Baz@ and @Maybe@ are used in the source module,
340 -- but not @Foo@; so we need to chase @Foo@ too.
342 -- We also need to follow superclass refs. In particular, 'chasing @Foo@' must
343 -- include actually getting in Foo's class decl
344 -- class Wib a => Foo a where ..
345 -- so that its superclasses are discovered. The point is that Wib is a gate too.
346 -- We do this for tycons too, so that we look through type synonyms.
348 go_outer decls fvs all_gates []
349 = returnRn (decls, fvs)
351 go_outer decls fvs all_gates refs -- refs are not necessarily slurped yet
352 = traceRn (text "go_outer" <+> ppr refs) `thenRn_`
353 foldlRn go_inner (decls, fvs, emptyFVs) refs `thenRn` \ (decls1, fvs1, gates1) ->
354 getImportedInstDecls (all_gates `plusFV` gates1) `thenRn` \ inst_decls ->
355 rnInstDecls decls1 fvs1 gates1 inst_decls `thenRn` \ (decls2, fvs2, gates2) ->
356 go_outer decls2 fvs2 (all_gates `plusFV` gates2)
357 (nameSetToList (gates2 `minusNameSet` all_gates))
358 -- Knock out the all_gates because even if we don't slurp any new
359 -- decls we can get some apparently-new gates from wired-in names
361 go_inner (decls, fvs, gates) wanted_name
362 = importDecl wanted_name `thenRn` \ import_result ->
363 case import_result of
364 AlreadySlurped -> returnRn (decls, fvs, gates)
365 WiredIn -> returnRn (decls, fvs, gates `plusFV` getWiredInGates wanted_name)
366 Deferred -> returnRn (decls, fvs, gates `addOneFV` wanted_name) -- It's a type constructor
368 HereItIs decl -> rnIfaceDecl decl `thenRn` \ (new_decl, fvs1) ->
369 returnRn (new_decl : decls,
371 gates `plusFV` getGates source_fvs new_decl)
373 rnInstDecls decls fvs gates []
374 = returnRn (decls, fvs, gates)
375 rnInstDecls decls fvs gates (d:ds)
376 = rnIfaceDecl d `thenRn` \ (new_decl, fvs1) ->
377 rnInstDecls (new_decl:decls)
379 (gates `plusFV` getInstDeclGates new_decl)
385 -------------------------------------------------------
386 -- closeDecls keeps going until the free-var set is empty
387 closeDecls decls needed
388 | not (isEmptyFVs needed)
389 = slurpDecls decls needed `thenRn` \ (decls1, needed1) ->
390 closeDecls decls1 needed1
393 = getImportedRules `thenRn` \ rule_decls ->
395 [] -> returnRn decls -- No new rules, so we are done
396 other -> rnIfaceDecls decls emptyFVs rule_decls `thenRn` \ (decls1, needed1) ->
397 closeDecls decls1 needed1
400 -------------------------------------------------------
401 -- Augment decls with any decls needed by needed.
402 -- Return also free vars of the new decls (only)
403 slurpDecls decls needed
404 = go decls emptyFVs (nameSetToList needed)
406 go decls fvs [] = returnRn (decls, fvs)
407 go decls fvs (ref:refs) = slurpDecl decls fvs ref `thenRn` \ (decls1, fvs1) ->
410 -------------------------------------------------------
411 slurpDecl decls fvs wanted_name
412 = importDecl wanted_name `thenRn` \ import_result ->
413 case import_result of
414 -- Found a declaration... rename it
415 HereItIs decl -> rnIfaceDecl decl `thenRn` \ (new_decl, fvs1) ->
416 returnRn (new_decl:decls, fvs1 `plusFV` fvs)
418 -- No declaration... (wired in thing, or deferred, or already slurped)
419 other -> returnRn (decls, fvs)
422 -------------------------------------------------------
423 rnIfaceDecls :: [RenamedHsDecl] -> FreeVars
424 -> [(Module, RdrNameHsDecl)]
425 -> RnM d ([RenamedHsDecl], FreeVars)
426 rnIfaceDecls decls fvs [] = returnRn (decls, fvs)
427 rnIfaceDecls decls fvs (d:ds) = rnIfaceDecl d `thenRn` \ (new_decl, fvs1) ->
428 rnIfaceDecls (new_decl:decls) (fvs1 `plusFV` fvs) ds
430 rnIfaceDecl (mod, decl) = initIfaceRnMS mod (rnDecl decl)
434 %*********************************************************
436 \subsection{Deferred declarations}
438 %*********************************************************
440 The idea of deferred declarations is this. Suppose we have a function
445 Then we don't want to load T and all its constructors, and all
446 the types those constructors refer to, and all the types *those*
447 constructors refer to, and so on. That might mean loading many more
448 interface files than is really necessary. So we 'defer' loading T.
450 But f might be strict, and the calling convention for evaluating
451 values of type T depends on how many constructors T has, so
452 we do need to load T, but not the full details of the type T.
453 So we load the full decl for T, but only skeleton decls for A and B:
455 data T = {- 2 constructors -}
457 Whether all this is worth it is moot.
460 slurpDeferredDecls :: [RenamedHsDecl] -> RnMG [RenamedHsDecl]
461 slurpDeferredDecls decls
462 = getDeferredDecls `thenRn` \ def_decls ->
463 rnIfaceDecls decls emptyFVs (map stripDecl def_decls) `thenRn` \ (decls1, fvs) ->
464 ASSERT( isEmptyFVs fvs )
467 stripDecl (mod, TyClD (TyData dt _ tc tvs _ nconstrs _ _ loc))
468 = (mod, TyClD (TyData dt [] tc tvs [] nconstrs Nothing NoDataPragmas loc))
469 -- Nuke the context and constructors
470 -- But retain the *number* of constructors!
471 -- 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]
547 get_details (NewCon t _) = extractHsTyNames t
549 get_field (fs,t) | any (`elemNameSet` source_fvs) fs = get_bang t
550 | otherwise = emptyFVs
552 get_bang bty = extractHsTyNames (getBangType bty)
554 getGates source_fvs other_decl = emptyFVs
557 @getWiredInGates@ is just like @getGates@, but it sees a wired-in @Name@
558 rather than a declaration.
561 getWiredInGates :: Name -> FreeVars
562 getWiredInGates name -- No classes are wired in
563 | is_id = getWiredInGates_s (namesOfType (idType the_id))
564 | isSynTyCon the_tycon = getWiredInGates_s
565 (delListFromNameSet (namesOfType ty) (map getName tyvars))
566 | otherwise = unitFV name
568 maybe_wired_in_id = maybeWiredInIdName name
569 is_id = maybeToBool maybe_wired_in_id
570 maybe_wired_in_tycon = maybeWiredInTyConName name
571 Just the_id = maybe_wired_in_id
572 Just the_tycon = maybe_wired_in_tycon
573 (tyvars,ty) = getSynTyConDefn the_tycon
575 getWiredInGates_s names = foldr (plusFV . getWiredInGates) emptyFVs (nameSetToList names)
579 getInstDeclGates (InstD (InstDecl inst_ty _ _ _ _)) = extractHsTyNames inst_ty
580 getInstDeclGates other = emptyFVs
584 %*********************************************************
586 \subsection{Fixities}
588 %*********************************************************
591 fixitiesFromLocalDecls :: GlobalRdrEnv -> [RdrNameHsDecl] -> RnMG FixityEnv
592 fixitiesFromLocalDecls gbl_env decls
593 = foldlRn getFixities emptyNameEnv decls `thenRn` \ env ->
594 traceRn (text "fixity env" <+> vcat (map ppr (nameEnvElts env))) `thenRn_`
597 getFixities :: FixityEnv -> RdrNameHsDecl -> RnMG FixityEnv
598 getFixities acc (FixD fix)
601 getFixities acc (TyClD (ClassDecl _ _ _ _ sigs _ _ _ _ _ _ _))
602 = foldlRn fix_decl acc [sig | FixSig sig <- sigs]
603 -- Get fixities from class decl sigs too.
604 getFixities acc other_decl
607 fix_decl acc sig@(FixitySig rdr_name fixity loc)
608 = -- Check for fixity decl for something not declared
609 case lookupRdrEnv gbl_env rdr_name of {
610 Nothing | opt_WarnUnusedBinds
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 -> [Module]
667 -> GlobalRdrEnv -> AvailEnv
668 -> Avails -> NameSet -> [RenamedHsDecl]
670 reportUnusedNames mod_name direct_import_mods
672 export_avails mentioned_names
675 used_names = mentioned_names `unionNameSets` availsToNameSet export_avails
677 -- Now, a use of C implies a use of T,
678 -- if C was brought into scope by T(..) or T(C)
679 really_used_names = used_names `unionNameSets`
680 mkNameSet [ availName parent_avail
681 | sub_name <- nameSetToList used_names
682 , isValOcc (getOccName sub_name)
684 -- Usually, every used name will appear in avail_env, but there
685 -- is one time when it doesn't: tuples and other built in syntax. When you
686 -- write (a,b) that gives rise to a *use* of "(,)", so that the
687 -- instances will get pulled in, but the tycon "(,)" isn't actually
688 -- in scope. Hence the isValOcc filter.
690 -- Also, (-x) gives rise to an implicit use of 'negate'; similarly,
691 -- 3.5 gives rise to an implcit use of :%
692 -- hence the isUserImportedName filter on the warning
695 = case lookupNameEnv avail_env sub_name of
697 Nothing -> WARN( isUserImportedName sub_name,
698 text "reportUnusedName: not in avail_env" <+>
702 , case parent_avail of { AvailTC _ _ -> True; other -> False }
705 defined_names = mkNameSet (concat (rdrEnvElts gbl_env))
706 defined_but_not_used =
707 nameSetToList (defined_names `minusNameSet` really_used_names)
709 -- Filter out the ones only defined implicitly
710 bad_locals = [n | n <- defined_but_not_used, isLocallyDefined n]
711 bad_imp_names = [n | n <- defined_but_not_used, isUserImportedExplicitlyName n,
712 not (module_unused n)]
714 deprec_used deprec_env = [ (n,txt)
715 | n <- nameSetToList mentioned_names,
716 not (isLocallyDefined n),
717 Just txt <- [lookupNameEnv deprec_env n] ]
719 -- inst_mods are directly-imported modules that
720 -- contain instance decl(s) that the renamer decided to suck in
721 -- It's not necessarily redundant to import such modules.
727 -- The import M() is not *necessarily* redundant, even if
728 -- we suck in no instance decls from M (e.g. it contains
729 -- no instance decls, or This contains no code). It may be
730 -- that we import M solely to ensure that M's orphan instance
731 -- decls (or those in its imports) are visible to people who
732 -- import This. Sigh.
733 -- There's really no good way to detect this, so the error message
734 -- in RnEnv.warnUnusedModules is weakened instead
735 inst_mods = [m | InstD (InstDecl _ _ _ (Just dfun) _) <- imported_decls,
736 let m = nameModule dfun,
737 m `elem` direct_import_mods
740 minimal_imports :: FiniteMap Module AvailEnv
741 minimal_imports0 = emptyFM
742 minimal_imports1 = foldNameSet add_name minimal_imports0 really_used_names
743 minimal_imports = foldr add_inst_mod minimal_imports1 inst_mods
745 add_name n acc = case maybeUserImportedFrom n of
747 Just m -> addToFM_C plusAvailEnv acc m
748 (unitAvailEnv (mk_avail n))
750 | m `elemFM` acc = acc -- We import something already
751 | otherwise = addToFM acc m emptyAvailEnv
752 -- Add an empty collection of imports for a module
753 -- from which we have sucked only instance decls
755 mk_avail n = case lookupNameEnv avail_env n of
756 Just (AvailTC m _) | n==m -> AvailTC n [n]
757 | otherwise -> AvailTC m [n,m]
758 Just avail -> Avail n
759 Nothing -> pprPanic "mk_avail" (ppr n)
761 -- unused_imp_mods are the directly-imported modules
762 -- that are not mentioned in minimal_imports
763 unused_imp_mods = [m | m <- direct_import_mods,
764 not (maybeToBool (lookupFM minimal_imports m))]
766 module_unused :: Name -> Bool
767 -- Name is imported from a module that's completely unused,
768 -- so don't report stuff about the name (the module covers it)
769 module_unused n = expectJust "module_unused" (maybeUserImportedFrom n)
770 `elem` unused_imp_mods
771 -- module_unused is only called if it's user-imported
773 warnUnusedModules unused_imp_mods `thenRn_`
774 warnUnusedLocalBinds bad_locals `thenRn_`
775 warnUnusedImports bad_imp_names `thenRn_`
776 printMinimalImports mod_name minimal_imports `thenRn_`
777 getIfacesRn `thenRn` \ ifaces ->
778 (if opt_WarnDeprecations
779 then mapRn_ warnDeprec (deprec_used (iDeprecs ifaces))
782 -- ToDo: deal with original imports with 'qualified' and 'as M' clauses
783 printMinimalImports mod_name imps
784 | not opt_D_dump_minimal_imports
787 = mapRn to_ies (fmToList imps) `thenRn` \ mod_ies ->
788 ioToRnM (do { h <- openFile filename WriteMode ;
789 printForUser h (vcat (map ppr_mod_ie mod_ies))
793 filename = moduleNameUserString mod_name ++ ".imports"
794 ppr_mod_ie (mod_name, ies)
795 | mod_name == pRELUDE_Name
798 = ptext SLIT("import") <+> ppr mod_name <>
799 parens (fsep (punctuate comma (map ppr ies)))
801 to_ies (mod, avail_env) = mapRn to_ie (availEnvElts avail_env) `thenRn` \ ies ->
802 returnRn (moduleName mod, ies)
804 to_ie :: AvailInfo -> RnMG (IE Name)
805 to_ie (Avail n) = returnRn (IEVar n)
806 to_ie (AvailTC n [m]) = ASSERT( n==m )
807 returnRn (IEThingAbs n)
808 to_ie (AvailTC n ns) = getInterfaceExports (moduleName (nameModule n))
809 ImportBySystem `thenRn` \ (_, avails) ->
810 case [ms | AvailTC m ms <- avails, m == n] of
811 [ms] | all (`elem` ns) ms -> returnRn (IEThingAll n)
812 | otherwise -> returnRn (IEThingWith n (filter (/= n) ns))
813 other -> pprTrace "to_ie" (ppr n <+> ppr (nameModule n) <+> ppr other) $
816 rnDump :: [RenamedHsDecl] -- Renamed imported decls
817 -> [RenamedHsDecl] -- Renamed local decls
819 rnDump imp_decls local_decls
820 | opt_D_dump_rn_trace ||
821 opt_D_dump_rn_stats ||
823 = getRnStats imp_decls `thenRn` \ stats_msg ->
825 returnRn (printErrs stats_msg >>
826 dumpIfSet opt_D_dump_rn "Renamer:"
827 (vcat (map ppr (local_decls ++ imp_decls))))
829 | otherwise = returnRn (return ())
833 %*********************************************************
835 \subsection{Statistics}
837 %*********************************************************
840 getRnStats :: [RenamedHsDecl] -> RnMG SDoc
841 getRnStats imported_decls
842 = getIfacesRn `thenRn` \ ifaces ->
844 n_mods = length [() | (_, _, Just _) <- eltsFM (iImpModInfo ifaces)]
846 decls_read = [decl | (_, avail, True, (_,decl)) <- nameEnvElts (iDecls ifaces),
847 -- Data, newtype, and class decls are in the decls_fm
848 -- under multiple names; the tycon/class, and each
849 -- constructor/class op too.
850 -- The 'True' selects just the 'main' decl
851 not (isLocallyDefined (availName avail))
854 (cd_rd, dd_rd, nd_rd, sd_rd, vd_rd, _) = count_decls decls_read
855 (cd_sp, dd_sp, nd_sp, sd_sp, vd_sp, id_sp) = count_decls imported_decls
857 unslurped_insts = iInsts ifaces
858 inst_decls_unslurped = length (bagToList unslurped_insts)
859 inst_decls_read = id_sp + inst_decls_unslurped
862 [int n_mods <+> text "interfaces read",
863 hsep [ int cd_sp, text "class decls imported, out of",
864 int cd_rd, text "read"],
865 hsep [ int dd_sp, text "data decls imported, out of",
866 int dd_rd, text "read"],
867 hsep [ int nd_sp, text "newtype decls imported, out of",
868 int nd_rd, text "read"],
869 hsep [int sd_sp, text "type synonym decls imported, out of",
870 int sd_rd, text "read"],
871 hsep [int vd_sp, text "value signatures imported, out of",
872 int vd_rd, text "read"],
873 hsep [int id_sp, text "instance decls imported, out of",
874 int inst_decls_read, text "read"],
875 text "cls dcls slurp" <+> fsep (map (ppr . tyClDeclName)
876 [d | TyClD d <- imported_decls, isClassDecl d]),
877 text "cls dcls read" <+> fsep (map (ppr . tyClDeclName)
878 [d | TyClD d <- decls_read, isClassDecl d])]
880 returnRn (hcat [text "Renamer stats: ", stats])
890 tycl_decls = [d | TyClD d <- decls]
891 (class_decls, data_decls, newtype_decls, syn_decls) = countTyClDecls tycl_decls
893 val_decls = length [() | SigD _ <- decls]
894 inst_decls = length [() | InstD _ <- decls]
898 %************************************************************************
900 \subsection{Errors and warnings}
902 %************************************************************************
905 warnDeprec :: (Name, DeprecTxt) -> RnM d ()
906 warnDeprec (name, txt)
907 = pushSrcLocRn (getSrcLoc name) $
909 sep [ text (occNameFlavour (nameOccName name)) <+> ppr name <+>
910 text "is deprecated:", nest 4 (ppr txt) ]
913 unusedFixityDecl rdr_name fixity
914 = hsep [ptext SLIT("Unused fixity declaration for"), quotes (ppr rdr_name)]
916 dupFixityDecl rdr_name loc1 loc2
917 = vcat [ptext SLIT("Multiple fixity declarations for") <+> quotes (ppr rdr_name),
918 ptext SLIT("at ") <+> ppr loc1,
919 ptext SLIT("and") <+> ppr loc2]