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 lookupImplicitOccsRn, 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 , [ModuleName]) -- Imported modules; for profiling
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 mod_name us (mkSearchPath opt_HiMap) loc (rename this_mod) ;
89 printErrorsAndWarnings rn_errs_bag rn_warns_bag ;
91 -- Dump any debugging output
95 if not (isEmptyBag rn_errs_bag) then
96 do { ghcExit 1 ; return Nothing }
103 rename :: RdrNameHsModule -> RnMG (Maybe RenameResult, IO ())
104 rename this_mod@(HsModule mod_name vers exports imports local_decls mod_deprec loc)
105 = -- FIND THE GLOBAL NAME ENVIRONMENT
106 getGlobalNames this_mod `thenRn` \ maybe_stuff ->
108 -- CHECK FOR EARLY EXIT
109 case maybe_stuff of {
110 Nothing -> -- Everything is up to date; no need to recompile further
111 rnDump [] [] `thenRn` \ dump_action ->
112 returnRn (Nothing, dump_action) ;
114 Just (gbl_env, local_gbl_env, export_avails, global_avail_env, old_iface) ->
116 -- DEAL WITH DEPRECATIONS
117 rnDeprecs local_gbl_env mod_deprec local_decls `thenRn` \ my_deprecs ->
119 -- DEAL WITH LOCAL FIXITIES
120 fixitiesFromLocalDecls local_gbl_env local_decls `thenRn` \ local_fixity_env ->
123 initRnMS gbl_env local_fixity_env SourceMode (
124 rnSourceDecls local_decls
125 ) `thenRn` \ (rn_local_decls, source_fvs) ->
127 -- SLURP IN ALL THE NEEDED DECLARATIONS
128 implicitFVs mod_name rn_local_decls `thenRn` \ implicit_fvs ->
130 -- The export_fvs make the exported names look just as if they
131 -- occurred in the source program. For the reasoning, see the
132 -- comments with RnIfaces.getImportVersions.
133 -- We only need the 'parent name' of the avail;
134 -- that's enough to suck in the declaration.
135 export_fvs = mkNameSet (map availName export_avails)
136 real_source_fvs = source_fvs `plusFV` export_fvs
138 slurp_fvs = implicit_fvs `plusFV` real_source_fvs
139 -- It's important to do the "plus" this way round, so that
140 -- when compiling the prelude, locally-defined (), Bool, etc
141 -- override the implicit ones.
143 loadBuiltinRules builtinRules `thenRn_`
144 slurpImpDecls slurp_fvs `thenRn` \ rn_imp_decls ->
146 -- EXIT IF ERRORS FOUND
147 rnDump rn_imp_decls rn_local_decls `thenRn` \ dump_action ->
148 checkErrsRn `thenRn` \ no_errs_so_far ->
149 if not no_errs_so_far then
150 -- Found errors already, so exit now
151 returnRn (Nothing, dump_action)
154 -- GENERATE THE VERSION/USAGE INFO
155 mkImportExportInfo mod_name export_avails exports `thenRn` \ (my_exports, my_usages) ->
157 -- RETURN THE RENAMED MODULE
158 getNameSupplyRn `thenRn` \ name_supply ->
160 this_module = mkThisModule mod_name
161 direct_import_mods = [mod | ImportDecl mod _ _ _ _ _ <- imports]
163 -- Export only those fixities that are for names that are
164 -- (a) defined in this module
167 = [ FixitySig (toRdrName name) fixity loc
168 | FixitySig name fixity loc <- nameEnvElts local_fixity_env,
169 isUserExportedName name
172 new_iface = ParsedIface { pi_mod = this_module
173 , pi_vers = initialVersion
174 , pi_orphan = any isOrphanDecl rn_local_decls
175 , pi_exports = my_exports
176 , pi_usages = my_usages
177 , pi_fixity = (initialVersion, exported_fixities)
178 , pi_deprecs = my_deprecs
179 -- These ones get filled in later
180 , pi_insts = [], pi_decls = []
181 , pi_rules = (initialVersion, [])
184 renamed_module = HsModule mod_name vers
185 trashed_exports trashed_imports
186 (rn_local_decls ++ rn_imp_decls)
190 result = (this_module, renamed_module,
191 old_iface, new_iface,
192 name_supply, local_fixity_env,
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 result, 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 = lookupImplicitOccsRn 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, unpackCString2_RDR, unpackCStringFoldr_RDR]
240 get (TyClD (TyData _ _ _ _ _ _ (Just deriv_classes) _ _))
241 = concat (map get_deriv deriv_classes)
244 get_deriv cls = case lookupUFM derivingOccurrences cls of
250 isOrphanDecl (InstD (InstDecl inst_ty _ _ _ _))
251 = not (foldNameSet ((||) . isLocallyDefined) False (extractHsTyNames (removeContext inst_ty)))
252 -- The 'removeContext' is because of
253 -- instance Foo a => Baz T where ...
254 -- The decl is an orphan if Baz and T are both not locally defined,
255 -- even if Foo *is* locally defined
257 isOrphanDecl (RuleD (HsRule _ _ _ lhs _ _))
260 -- At the moment we just check for common LHS forms
261 -- Expand as necessary. Getting it wrong just means
262 -- more orphans than necessary
263 check (HsVar v) = not (isLocallyDefined v)
264 check (HsApp f a) = check f && check a
265 check (HsLit _) = False
266 check (OpApp l o _ r) = check l && check o && check r
267 check (NegApp e _) = check e
268 check (HsPar e) = check e
269 check (SectionL e o) = check e && check o
270 check (SectionR o e) = check e && check o
272 check other = True -- Safe fall through
274 isOrphanDecl other = False
279 dupDefaultDeclErrRn (DefaultDecl _ locn1 : dup_things)
280 = pushSrcLocRn locn1 $
283 msg = hang (ptext SLIT("Multiple default declarations"))
284 4 (vcat (map pp dup_things))
285 pp (DefaultDecl _ locn) = ptext SLIT("here was another default declaration") <+> ppr locn
289 %*********************************************************
291 \subsection{Slurping declarations}
293 %*********************************************************
296 -------------------------------------------------------
297 slurpImpDecls source_fvs
298 = traceRn (text "slurpImp" <+> fsep (map ppr (nameSetToList source_fvs))) `thenRn_`
300 -- The current slurped-set records all local things
301 getSlurped `thenRn` \ source_binders ->
302 slurpSourceRefs source_binders source_fvs `thenRn` \ (decls, needed) ->
304 -- Then get everything else
305 closeDecls decls needed `thenRn` \ decls1 ->
307 -- Finally, get any deferred data type decls
308 slurpDeferredDecls decls1 `thenRn` \ final_decls ->
312 -------------------------------------------------------
313 slurpSourceRefs :: NameSet -- Variables defined in source
314 -> FreeVars -- Variables referenced in source
315 -> RnMG ([RenamedHsDecl],
316 FreeVars) -- Un-satisfied needs
317 -- The declaration (and hence home module) of each gate has
318 -- already been loaded
320 slurpSourceRefs source_binders source_fvs
321 = go_outer [] -- Accumulating decls
322 emptyFVs -- Unsatisfied needs
323 emptyFVs -- Accumulating gates
324 (nameSetToList source_fvs) -- Things whose defn hasn't been loaded yet
326 -- The outer loop repeatedly slurps the decls for the current gates
327 -- and the instance decls
329 -- The outer loop is needed because consider
330 -- instance Foo a => Baz (Maybe a) where ...
331 -- It may be that @Baz@ and @Maybe@ are used in the source module,
332 -- but not @Foo@; so we need to chase @Foo@ too.
334 -- We also need to follow superclass refs. In particular, 'chasing @Foo@' must
335 -- include actually getting in Foo's class decl
336 -- class Wib a => Foo a where ..
337 -- so that its superclasses are discovered. The point is that Wib is a gate too.
338 -- We do this for tycons too, so that we look through type synonyms.
340 go_outer decls fvs all_gates []
341 = returnRn (decls, fvs)
343 go_outer decls fvs all_gates refs -- refs are not necessarily slurped yet
344 = traceRn (text "go_outer" <+> ppr refs) `thenRn_`
345 foldlRn go_inner (decls, fvs, emptyFVs) refs `thenRn` \ (decls1, fvs1, gates1) ->
346 getImportedInstDecls (all_gates `plusFV` gates1) `thenRn` \ inst_decls ->
347 rnInstDecls decls1 fvs1 gates1 inst_decls `thenRn` \ (decls2, fvs2, gates2) ->
348 go_outer decls2 fvs2 (all_gates `plusFV` gates2)
349 (nameSetToList (gates2 `minusNameSet` all_gates))
350 -- Knock out the all_gates because even if we don't slurp any new
351 -- decls we can get some apparently-new gates from wired-in names
353 go_inner (decls, fvs, gates) wanted_name
354 = importDecl wanted_name `thenRn` \ import_result ->
355 case import_result of
356 AlreadySlurped -> returnRn (decls, fvs, gates)
357 WiredIn -> returnRn (decls, fvs, gates `plusFV` getWiredInGates wanted_name)
358 Deferred -> returnRn (decls, fvs, gates `addOneFV` wanted_name) -- It's a type constructor
360 HereItIs decl -> rnIfaceDecl decl `thenRn` \ (new_decl, fvs1) ->
361 returnRn (new_decl : decls,
363 gates `plusFV` getGates source_fvs new_decl)
365 rnInstDecls decls fvs gates []
366 = returnRn (decls, fvs, gates)
367 rnInstDecls decls fvs gates (d:ds)
368 = rnIfaceDecl d `thenRn` \ (new_decl, fvs1) ->
369 rnInstDecls (new_decl:decls)
371 (gates `plusFV` getInstDeclGates new_decl)
377 -------------------------------------------------------
378 -- closeDecls keeps going until the free-var set is empty
379 closeDecls decls needed
380 | not (isEmptyFVs needed)
381 = slurpDecls decls needed `thenRn` \ (decls1, needed1) ->
382 closeDecls decls1 needed1
385 = getImportedRules `thenRn` \ rule_decls ->
387 [] -> returnRn decls -- No new rules, so we are done
388 other -> rnIfaceDecls decls emptyFVs rule_decls `thenRn` \ (decls1, needed1) ->
389 closeDecls decls1 needed1
392 -------------------------------------------------------
393 -- Augment decls with any decls needed by needed.
394 -- Return also free vars of the new decls (only)
395 slurpDecls decls needed
396 = go decls emptyFVs (nameSetToList needed)
398 go decls fvs [] = returnRn (decls, fvs)
399 go decls fvs (ref:refs) = slurpDecl decls fvs ref `thenRn` \ (decls1, fvs1) ->
402 -------------------------------------------------------
403 slurpDecl decls fvs wanted_name
404 = importDecl wanted_name `thenRn` \ import_result ->
405 case import_result of
406 -- Found a declaration... rename it
407 HereItIs decl -> rnIfaceDecl decl `thenRn` \ (new_decl, fvs1) ->
408 returnRn (new_decl:decls, fvs1 `plusFV` fvs)
410 -- No declaration... (wired in thing, or deferred, or already slurped)
411 other -> returnRn (decls, fvs)
414 -------------------------------------------------------
415 rnIfaceDecls :: [RenamedHsDecl] -> FreeVars
416 -> [(Module, RdrNameHsDecl)]
417 -> RnM d ([RenamedHsDecl], FreeVars)
418 rnIfaceDecls decls fvs [] = returnRn (decls, fvs)
419 rnIfaceDecls decls fvs (d:ds) = rnIfaceDecl d `thenRn` \ (new_decl, fvs1) ->
420 rnIfaceDecls (new_decl:decls) (fvs1 `plusFV` fvs) ds
422 rnIfaceDecl (mod, decl) = initIfaceRnMS mod (rnDecl decl)
426 %*********************************************************
428 \subsection{Deferred declarations}
430 %*********************************************************
432 The idea of deferred declarations is this. Suppose we have a function
437 Then we don't want to load T and all its constructors, and all
438 the types those constructors refer to, and all the types *those*
439 constructors refer to, and so on. That might mean loading many more
440 interface files than is really necessary. So we 'defer' loading T.
442 But f might be strict, and the calling convention for evaluating
443 values of type T depends on how many constructors T has, so
444 we do need to load T, but not the full details of the type T.
445 So we load the full decl for T, but only skeleton decls for A and B:
447 data T = {- 2 constructors -}
449 Whether all this is worth it is moot.
452 slurpDeferredDecls :: [RenamedHsDecl] -> RnMG [RenamedHsDecl]
453 slurpDeferredDecls decls
454 = getDeferredDecls `thenRn` \ def_decls ->
455 rnIfaceDecls decls emptyFVs (map stripDecl def_decls) `thenRn` \ (decls1, fvs) ->
456 ASSERT( isEmptyFVs fvs )
459 stripDecl (mod, TyClD (TyData dt _ tc tvs _ nconstrs _ _ loc))
460 = (mod, TyClD (TyData dt [] tc tvs [] nconstrs Nothing NoDataPragmas loc))
461 -- Nuke the context and constructors
462 -- But retain the *number* of constructors!
463 -- Also the tvs will have kinds on them.
467 %*********************************************************
469 \subsection{Extracting the `gates'}
471 %*********************************************************
473 When we import a declaration like
475 data T = T1 Wibble | T2 Wobble
477 we don't want to treat @Wibble@ and @Wobble@ as gates
478 {\em unless} @T1@, @T2@ respectively are mentioned by the user program.
479 If only @T@ is mentioned
480 we want only @T@ to be a gate;
481 that way we don't suck in useless instance
482 decls for (say) @Eq Wibble@, when they can't possibly be useful.
484 @getGates@ takes a newly imported (and renamed) decl, and the free
485 vars of the source program, and extracts from the decl the gate names.
488 getGates source_fvs (SigD (IfaceSig _ ty _ _))
489 = extractHsTyNames ty
491 getGates source_fvs (TyClD (ClassDecl ctxt cls tvs _ sigs _ _ _ _ _ _ _))
492 = (delListFromNameSet (foldr (plusFV . get) (extractHsCtxtTyNames ctxt) sigs)
494 `addOneToNameSet` cls)
495 `plusFV` maybe_double
497 get (ClassOpSig n _ _ ty _)
498 | n `elemNameSet` source_fvs = extractHsTyNames ty
499 | otherwise = emptyFVs
501 -- If we load any numeric class that doesn't have
502 -- Int as an instance, add Double to the gates.
503 -- This takes account of the fact that Double might be needed for
504 -- defaulting, but we don't want to load Double (and all its baggage)
505 -- if the more exotic classes aren't used at all.
506 maybe_double | nameUnique cls `elem` fractionalClassKeys
507 = unitFV (getName doubleTyCon)
511 getGates source_fvs (TyClD (TySynonym tycon tvs ty _))
512 = delListFromNameSet (extractHsTyNames ty)
514 -- A type synonym type constructor isn't a "gate" for instance decls
516 getGates source_fvs (TyClD (TyData _ ctxt tycon tvs cons _ _ _ _))
517 = delListFromNameSet (foldr (plusFV . get) (extractHsCtxtTyNames ctxt) cons)
519 `addOneToNameSet` tycon
521 get (ConDecl n _ tvs ctxt details _)
522 | n `elemNameSet` source_fvs
523 -- If the constructor is method, get fvs from all its fields
524 = delListFromNameSet (get_details details `plusFV`
525 extractHsCtxtTyNames ctxt)
527 get (ConDecl n _ tvs ctxt (RecCon fields) _)
528 -- Even if the constructor isn't mentioned, the fields
529 -- might be, as selectors. They can't mention existentially
530 -- bound tyvars (typechecker checks for that) so no need for
531 -- the deleteListFromNameSet part
532 = foldr (plusFV . get_field) emptyFVs fields
534 get other_con = emptyFVs
536 get_details (VanillaCon tys) = plusFVs (map get_bang tys)
537 get_details (InfixCon t1 t2) = get_bang t1 `plusFV` get_bang t2
538 get_details (RecCon fields) = plusFVs [get_bang t | (_, t) <- fields]
539 get_details (NewCon t _) = extractHsTyNames t
541 get_field (fs,t) | any (`elemNameSet` source_fvs) fs = get_bang t
542 | otherwise = emptyFVs
544 get_bang bty = extractHsTyNames (getBangType bty)
546 getGates source_fvs other_decl = emptyFVs
549 @getWiredInGates@ is just like @getGates@, but it sees a wired-in @Name@
550 rather than a declaration.
553 getWiredInGates :: Name -> FreeVars
554 getWiredInGates name -- No classes are wired in
555 | is_id = getWiredInGates_s (namesOfType (idType the_id))
556 | isSynTyCon the_tycon = getWiredInGates_s
557 (delListFromNameSet (namesOfType ty) (map getName tyvars))
558 | otherwise = unitFV name
560 maybe_wired_in_id = maybeWiredInIdName name
561 is_id = maybeToBool maybe_wired_in_id
562 maybe_wired_in_tycon = maybeWiredInTyConName name
563 Just the_id = maybe_wired_in_id
564 Just the_tycon = maybe_wired_in_tycon
565 (tyvars,ty) = getSynTyConDefn the_tycon
567 getWiredInGates_s names = foldr (plusFV . getWiredInGates) emptyFVs (nameSetToList names)
571 getInstDeclGates (InstD (InstDecl inst_ty _ _ _ _)) = extractHsTyNames inst_ty
572 getInstDeclGates other = emptyFVs
576 %*********************************************************
578 \subsection{Fixities}
580 %*********************************************************
583 fixitiesFromLocalDecls :: GlobalRdrEnv -> [RdrNameHsDecl] -> RnMG FixityEnv
584 fixitiesFromLocalDecls gbl_env decls
585 = foldlRn getFixities emptyNameEnv decls `thenRn` \ env ->
586 traceRn (text "fixity env" <+> vcat (map ppr (nameEnvElts env))) `thenRn_`
589 getFixities :: FixityEnv -> RdrNameHsDecl -> RnMG FixityEnv
590 getFixities acc (FixD fix)
593 getFixities acc (TyClD (ClassDecl _ _ _ _ sigs _ _ _ _ _ _ _))
594 = foldlRn fix_decl acc [sig | FixSig sig <- sigs]
595 -- Get fixities from class decl sigs too.
596 getFixities acc other_decl
599 fix_decl acc sig@(FixitySig rdr_name fixity loc)
600 = -- Check for fixity decl for something not declared
601 case lookupRdrEnv gbl_env rdr_name of {
602 Nothing | opt_WarnUnusedBinds
603 -> pushSrcLocRn loc (addWarnRn (unusedFixityDecl rdr_name fixity))
604 `thenRn_` returnRn acc
605 | otherwise -> returnRn acc ;
609 -- Check for duplicate fixity decl
610 case lookupNameEnv acc name of {
611 Just (FixitySig _ _ loc') -> addErrRn (dupFixityDecl rdr_name loc loc')
612 `thenRn_` returnRn acc ;
614 Nothing -> returnRn (extendNameEnv acc name (FixitySig name fixity loc))
619 %*********************************************************
621 \subsection{Deprecations}
623 %*********************************************************
625 For deprecations, all we do is check that the names are in scope.
626 It's only imported deprecations, dealt with in RnIfaces, that we
627 gather them together.
630 rnDeprecs :: GlobalRdrEnv -> Maybe DeprecTxt
631 -> [RdrNameHsDecl] -> RnMG [RdrNameDeprecation]
632 rnDeprecs gbl_env mod_deprec decls
633 = mapRn rn_deprec deprecs `thenRn_`
634 returnRn (extra_deprec ++ deprecs)
636 deprecs = [d | DeprecD d <- decls]
637 extra_deprec = case mod_deprec of
639 Just txt -> [Deprecation (IEModuleContents undefined) txt noSrcLoc]
641 rn_deprec (Deprecation ie txt loc)
643 mapRn check (ieNames ie)
645 check n = case lookupRdrEnv gbl_env n of
646 Nothing -> addErrRn (unknownNameErr n)
647 Just _ -> returnRn ()
651 %*********************************************************
653 \subsection{Unused names}
655 %*********************************************************
658 reportUnusedNames :: ModuleName -> [ModuleName]
659 -> GlobalRdrEnv -> AvailEnv
660 -> Avails -> NameSet -> [RenamedHsDecl]
662 reportUnusedNames mod_name direct_import_mods
664 export_avails mentioned_names
667 used_names = mentioned_names `unionNameSets` availsToNameSet export_avails
669 -- Now, a use of C implies a use of T,
670 -- if C was brought into scope by T(..) or T(C)
671 really_used_names = used_names `unionNameSets`
672 mkNameSet [ availName parent_avail
673 | sub_name <- nameSetToList used_names
674 , isValOcc (getOccName sub_name)
676 -- Usually, every used name will appear in avail_env, but there
677 -- is one time when it doesn't: tuples and other built in syntax. When you
678 -- write (a,b) that gives rise to a *use* of "(,)", so that the
679 -- instances will get pulled in, but the tycon "(,)" isn't actually
680 -- in scope. Hence the isValOcc filter.
682 -- Also, (-x) gives rise to an implicit use of 'negate'; similarly,
683 -- 3.5 gives rise to an implcit use of :%
684 -- hence the isUserImportedName filter on the warning
687 = case lookupNameEnv avail_env sub_name of
689 Nothing -> WARN( isUserImportedName sub_name,
690 text "reportUnusedName: not in avail_env" <+>
694 , case parent_avail of { AvailTC _ _ -> True; other -> False }
697 defined_names = mkNameSet (concat (rdrEnvElts gbl_env))
698 defined_but_not_used =
699 nameSetToList (defined_names `minusNameSet` really_used_names)
701 -- Filter out the ones only defined implicitly
702 bad_locals = [n | n <- defined_but_not_used, isLocallyDefined n]
703 bad_imp_names = [n | n <- defined_but_not_used, isUserImportedExplicitlyName n,
704 not (module_unused n)]
706 deprec_used deprec_env = [ (n,txt)
707 | n <- nameSetToList mentioned_names,
708 not (isLocallyDefined n),
709 Just txt <- [lookupNameEnv deprec_env n] ]
711 -- inst_mods are directly-imported modules that
712 -- contain instance decl(s) that the renamer decided to suck in
713 -- It's not necessarily redundant to import such modules.
719 -- The import M() is not *necessarily* redundant, even if
720 -- we suck in no instance decls from M (e.g. it contains
721 -- no instance decls, or This contains no code). It may be
722 -- that we import M solely to ensure that M's orphan instance
723 -- decls (or those in its imports) are visible to people who
724 -- import This. Sigh.
725 -- There's really no good way to detect this, so the error message
726 -- in RnEnv.warnUnusedModules is weakened instead
727 inst_mods = [m | InstD (InstDecl _ _ _ dfun _) <- imported_decls,
728 let m = moduleName (nameModule dfun),
729 m `elem` direct_import_mods
732 minimal_imports :: FiniteMap ModuleName AvailEnv
733 minimal_imports0 = emptyFM
734 minimal_imports1 = foldNameSet add_name minimal_imports0 really_used_names
735 minimal_imports = foldr add_inst_mod minimal_imports1 inst_mods
737 add_name n acc = case maybeUserImportedFrom n of
739 Just m -> addToFM_C plusAvailEnv acc (moduleName m)
740 (unitAvailEnv (mk_avail n))
742 | m `elemFM` acc = acc -- We import something already
743 | otherwise = addToFM acc m emptyAvailEnv
744 -- Add an empty collection of imports for a module
745 -- from which we have sucked only instance decls
747 mk_avail n = case lookupNameEnv avail_env n of
748 Just (AvailTC m _) | n==m -> AvailTC n [n]
749 | otherwise -> AvailTC m [n,m]
750 Just avail -> Avail n
751 Nothing -> pprPanic "mk_avail" (ppr n)
753 -- unused_imp_mods are the directly-imported modules
754 -- that are not mentioned in minimal_imports
755 unused_imp_mods = [m | m <- direct_import_mods,
756 not (maybeToBool (lookupFM minimal_imports m))]
758 module_unused :: Name -> Bool
759 -- Name is imported from a module that's completely unused,
760 -- so don't report stuff about the name (the module covers it)
761 module_unused n = moduleName (expectJust "module_unused" (maybeUserImportedFrom n))
762 `elem` unused_imp_mods
763 -- module_unused is only called if it's user-imported
765 warnUnusedModules unused_imp_mods `thenRn_`
766 warnUnusedLocalBinds bad_locals `thenRn_`
767 warnUnusedImports bad_imp_names `thenRn_`
768 printMinimalImports mod_name minimal_imports `thenRn_`
769 getIfacesRn `thenRn` \ ifaces ->
770 (if opt_WarnDeprecations
771 then mapRn_ warnDeprec (deprec_used (iDeprecs ifaces))
774 -- ToDo: deal with original imports with 'qualified' and 'as M' clauses
775 printMinimalImports mod_name imps
776 | not opt_D_dump_minimal_imports
779 = mapRn to_ies (fmToList imps) `thenRn` \ mod_ies ->
780 ioToRnM (do { h <- openFile filename WriteMode ;
781 printForUser h (vcat (map ppr_mod_ie mod_ies))
785 filename = moduleNameUserString mod_name ++ ".imports"
786 ppr_mod_ie (mod_name, ies)
787 | mod_name == pRELUDE_Name
790 = ptext SLIT("import") <+> ppr mod_name <>
791 parens (fsep (punctuate comma (map ppr ies)))
793 to_ies (mod, avail_env) = mapRn to_ie (availEnvElts avail_env) `thenRn` \ ies ->
796 to_ie :: AvailInfo -> RnMG (IE Name)
797 to_ie (Avail n) = returnRn (IEVar n)
798 to_ie (AvailTC n [m]) = ASSERT( n==m )
799 returnRn (IEThingAbs n)
800 to_ie (AvailTC n ns) = getInterfaceExports (moduleName (nameModule n))
801 ImportBySystem `thenRn` \ (_, avails) ->
802 case [ms | AvailTC m ms <- avails, m == n] of
803 [ms] | all (`elem` ns) ms -> returnRn (IEThingAll n)
804 | otherwise -> returnRn (IEThingWith n (filter (/= n) ns))
805 other -> pprTrace "to_ie" (ppr n <+> ppr (nameModule n) <+> ppr other) $
808 rnDump :: [RenamedHsDecl] -- Renamed imported decls
809 -> [RenamedHsDecl] -- Renamed local decls
811 rnDump imp_decls local_decls
812 | opt_D_dump_rn_trace ||
813 opt_D_dump_rn_stats ||
815 = getRnStats imp_decls `thenRn` \ stats_msg ->
817 returnRn (printErrs stats_msg >>
818 dumpIfSet opt_D_dump_rn "Renamer:"
819 (vcat (map ppr (local_decls ++ imp_decls))))
821 | otherwise = returnRn (return ())
825 %*********************************************************
827 \subsection{Statistics}
829 %*********************************************************
832 getRnStats :: [RenamedHsDecl] -> RnMG SDoc
833 getRnStats imported_decls
834 = getIfacesRn `thenRn` \ ifaces ->
836 n_mods = length [() | (_, _, Just _) <- eltsFM (iImpModInfo ifaces)]
838 decls_read = [decl | (_, avail, True, (_,decl)) <- nameEnvElts (iDecls ifaces),
839 -- Data, newtype, and class decls are in the decls_fm
840 -- under multiple names; the tycon/class, and each
841 -- constructor/class op too.
842 -- The 'True' selects just the 'main' decl
843 not (isLocallyDefined (availName avail))
846 (cd_rd, dd_rd, nd_rd, sd_rd, vd_rd, _) = count_decls decls_read
847 (cd_sp, dd_sp, nd_sp, sd_sp, vd_sp, id_sp) = count_decls imported_decls
849 unslurped_insts = iInsts ifaces
850 inst_decls_unslurped = length (bagToList unslurped_insts)
851 inst_decls_read = id_sp + inst_decls_unslurped
854 [int n_mods <+> text "interfaces read",
855 hsep [ int cd_sp, text "class decls imported, out of",
856 int cd_rd, text "read"],
857 hsep [ int dd_sp, text "data decls imported, out of",
858 int dd_rd, text "read"],
859 hsep [ int nd_sp, text "newtype decls imported, out of",
860 int nd_rd, text "read"],
861 hsep [int sd_sp, text "type synonym decls imported, out of",
862 int sd_rd, text "read"],
863 hsep [int vd_sp, text "value signatures imported, out of",
864 int vd_rd, text "read"],
865 hsep [int id_sp, text "instance decls imported, out of",
866 int inst_decls_read, text "read"],
867 text "cls dcls slurp" <+> fsep (map (ppr . tyClDeclName)
868 [d | TyClD d <- imported_decls, isClassDecl d]),
869 text "cls dcls read" <+> fsep (map (ppr . tyClDeclName)
870 [d | TyClD d <- decls_read, isClassDecl d])]
872 returnRn (hcat [text "Renamer stats: ", stats])
882 tycl_decls = [d | TyClD d <- decls]
883 (class_decls, data_decls, newtype_decls, syn_decls) = countTyClDecls tycl_decls
885 val_decls = length [() | SigD _ <- decls]
886 inst_decls = length [() | InstD _ <- decls]
890 %************************************************************************
892 \subsection{Errors and warnings}
894 %************************************************************************
897 warnDeprec :: (Name, DeprecTxt) -> RnM d ()
898 warnDeprec (name, txt)
899 = pushSrcLocRn (getSrcLoc name) $
901 sep [ text (occNameFlavour (nameOccName name)) <+> ppr name <+>
902 text "is deprecated:", nest 4 (ppr txt) ]
905 unusedFixityDecl rdr_name fixity
906 = hsep [ptext SLIT("Unused fixity declaration for"), quotes (ppr rdr_name)]
908 dupFixityDecl rdr_name loc1 loc2
909 = vcat [ptext SLIT("Multiple fixity declarations for") <+> quotes (ppr rdr_name),
910 ptext SLIT("at ") <+> ppr loc1,
911 ptext SLIT("and") <+> ppr loc2]