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, loadHomeInterface, getSlurped, removeContext,
27 loadBuiltinRules, getDeferredDecls, ImportDeclResult(..)
29 import RnEnv ( availName, availsToNameSet, unitAvailEnv, availEnvElts, plusAvailEnv,
30 warnUnusedImports, warnUnusedLocalBinds, warnUnusedModules,
31 lookupImplicitOccsRn, pprAvail, unknownNameErr,
32 FreeVars, plusFVs, plusFV, unitFV, emptyFVs, isEmptyFVs, addOneFV
34 import Module ( Module, ModuleName, WhereFrom(..),
35 moduleNameUserString, mkSearchPath, moduleName, mkThisModule
37 import Name ( Name, isLocallyDefined, NamedThing(..), getSrcLoc,
38 nameOccName, nameUnique, nameModule, maybeUserImportedFrom,
39 isUserImportedExplicitlyName, isUserImportedName,
40 maybeWiredInTyConName, maybeWiredInIdName, isWiredInName,
41 isUserExportedName, toRdrName
43 import OccName ( occNameFlavour, isValOcc )
45 import TyCon ( isSynTyCon, getSynTyConDefn )
47 import TysWiredIn ( unitTyCon, intTyCon, doubleTyCon, boolTyCon )
48 import PrelRules ( builtinRules )
49 import PrelInfo ( mAIN_Name, pREL_MAIN_Name, pRELUDE_Name,
50 ioTyCon_RDR, unpackCString_RDR, unpackCString2_RDR, unpackCStringFoldr_RDR,
51 fractionalClassKeys, derivingOccurrences
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, addToFM_C )
58 import UniqSupply ( UniqSupply )
59 import UniqFM ( lookupUFM )
60 import SrcLoc ( noSrcLoc )
61 import Maybes ( maybeToBool, expectJust )
63 import IO ( openFile, IOMode(..) )
69 type RenameResult = ( Module -- This module
70 , RenamedHsModule -- Renamed module
71 , Maybe ParsedIface -- The existing interface file, if any
72 , ParsedIface -- The new interface
73 , RnNameSupply -- Final env; for renaming derivings
74 , FixityEnv -- The fixity environment; for derivings
75 , [ModuleName]) -- Imported modules; for profiling
77 renameModule :: UniqSupply -> RdrNameHsModule -> IO (Maybe RenameResult)
78 renameModule us this_mod@(HsModule mod_name vers exports imports local_decls _ loc)
79 = -- Initialise the renamer monad
81 ((maybe_rn_stuff, dump_action), rn_errs_bag, rn_warns_bag)
82 <- initRn mod_name us (mkSearchPath opt_HiMap) loc (rename this_mod) ;
85 printErrorsAndWarnings rn_errs_bag rn_warns_bag ;
87 -- Dump any debugging output
91 if not (isEmptyBag rn_errs_bag) then
92 do { ghcExit 1 ; return Nothing }
99 rename :: RdrNameHsModule -> RnMG (Maybe RenameResult, IO ())
100 rename this_mod@(HsModule mod_name vers exports imports local_decls mod_deprec loc)
101 = -- FIND THE GLOBAL NAME ENVIRONMENT
102 getGlobalNames this_mod `thenRn` \ maybe_stuff ->
104 -- CHECK FOR EARLY EXIT
105 case maybe_stuff of {
106 Nothing -> -- Everything is up to date; no need to recompile further
107 rnDump [] [] `thenRn` \ dump_action ->
108 returnRn (Nothing, dump_action) ;
110 Just (gbl_env, local_gbl_env, export_avails, global_avail_env, old_iface) ->
112 -- DEAL WITH DEPRECATIONS
113 rnDeprecs local_gbl_env mod_deprec local_decls `thenRn` \ my_deprecs ->
115 -- DEAL WITH LOCAL FIXITIES
116 fixitiesFromLocalDecls local_gbl_env local_decls `thenRn` \ local_fixity_env ->
119 initRnMS gbl_env local_fixity_env SourceMode (
120 rnSourceDecls local_decls
121 ) `thenRn` \ (rn_local_decls, source_fvs) ->
123 -- SLURP IN ALL THE NEEDED DECLARATIONS
124 implicitFVs mod_name rn_local_decls `thenRn` \ implicit_fvs ->
126 -- The export_fvs make the exported names look just as if they
127 -- occurred in the source program. For the reasoning, see the
128 -- comments with RnIfaces.getImportVersions.
129 -- We only need the 'parent name' of the avail;
130 -- that's enough to suck in the declaration.
131 export_fvs = mkNameSet (map availName export_avails)
132 real_source_fvs = source_fvs `plusFV` export_fvs
134 slurp_fvs = implicit_fvs `plusFV` real_source_fvs
135 -- It's important to do the "plus" this way round, so that
136 -- when compiling the prelude, locally-defined (), Bool, etc
137 -- override the implicit ones.
139 loadBuiltinRules builtinRules `thenRn_`
140 slurpImpDecls slurp_fvs `thenRn` \ rn_imp_decls ->
142 -- EXIT IF ERRORS FOUND
143 rnDump rn_imp_decls rn_local_decls `thenRn` \ dump_action ->
144 checkErrsRn `thenRn` \ no_errs_so_far ->
145 if not no_errs_so_far then
146 -- Found errors already, so exit now
147 returnRn (Nothing, dump_action)
150 -- GENERATE THE VERSION/USAGE INFO
151 mkImportExportInfo mod_name export_avails exports `thenRn` \ (my_exports, my_usages) ->
153 -- RETURN THE RENAMED MODULE
154 getNameSupplyRn `thenRn` \ name_supply ->
156 this_module = mkThisModule mod_name
157 direct_import_mods = [mod | ImportDecl mod _ _ _ _ _ <- imports]
159 -- Export only those fixities that are for names that are
160 -- (a) defined in this module
163 = [ FixitySig (toRdrName name) fixity loc
164 | FixitySig name fixity loc <- nameEnvElts local_fixity_env,
165 isUserExportedName name
168 new_iface = ParsedIface { pi_mod = this_module
169 , pi_vers = initialVersion
170 , pi_orphan = any isOrphanDecl rn_local_decls
171 , pi_exports = my_exports
172 , pi_usages = my_usages
173 , pi_fixity = (initialVersion, exported_fixities)
174 , pi_deprecs = my_deprecs
175 -- These ones get filled in later
176 , pi_insts = [], pi_decls = []
177 , pi_rules = (initialVersion, [])
180 renamed_module = HsModule mod_name vers
181 trashed_exports trashed_imports
182 (rn_local_decls ++ rn_imp_decls)
186 result = (this_module, renamed_module,
187 old_iface, new_iface,
188 name_supply, local_fixity_env,
192 -- REPORT UNUSED NAMES, AND DEBUG DUMP
193 reportUnusedNames mod_name direct_import_mods
194 gbl_env global_avail_env
195 export_avails source_fvs `thenRn_`
197 returnRn (Just result, dump_action) }
199 trashed_exports = {-trace "rnSource:trashed_exports"-} Nothing
200 trashed_imports = {-trace "rnSource:trashed_imports"-} []
203 @implicitFVs@ forces the renamer to slurp in some things which aren't
204 mentioned explicitly, but which might be needed by the type checker.
207 implicitFVs mod_name decls
208 = lookupImplicitOccsRn implicit_occs `thenRn` \ implicit_names ->
209 returnRn (mkNameSet (map getName default_tycons) `plusFV`
212 -- Add occurrences for Int, and (), because they
213 -- are the types to which ambigious type variables may be defaulted by
214 -- the type checker; so they won't always appear explicitly.
215 -- [The () one is a GHC extension for defaulting CCall results.]
216 -- ALSO: funTyCon, since it occurs implicitly everywhere!
217 -- (we don't want to be bothered with making funTyCon a
218 -- free var at every function application!)
219 -- Double is dealt with separately in getGates
220 default_tycons = [unitTyCon, funTyCon, boolTyCon, intTyCon]
222 -- Add occurrences for IO or PrimIO
223 implicit_main | mod_name == mAIN_Name
224 || mod_name == pREL_MAIN_Name = [ioTyCon_RDR]
227 -- Now add extra "occurrences" for things that
228 -- the deriving mechanism, or defaulting, will later need in order to
230 implicit_occs = string_occs ++ foldr ((++) . get) implicit_main decls
232 -- Virtually every program has error messages in it somewhere
233 string_occs = [unpackCString_RDR, unpackCString2_RDR, unpackCStringFoldr_RDR]
235 get (TyClD (TyData _ _ _ _ _ _ (Just deriv_classes) _ _))
236 = concat (map get_deriv deriv_classes)
239 get_deriv cls = case lookupUFM derivingOccurrences cls of
245 isOrphanDecl (InstD (InstDecl inst_ty _ _ _ _))
246 = not (foldNameSet ((||) . isLocallyDefined) False (extractHsTyNames (removeContext inst_ty)))
247 -- The 'removeContext' is because of
248 -- instance Foo a => Baz T where ...
249 -- The decl is an orphan if Baz and T are both not locally defined,
250 -- even if Foo *is* locally defined
252 isOrphanDecl (RuleD (HsRule _ _ _ lhs _ _))
255 -- At the moment we just check for common LHS forms
256 -- Expand as necessary. Getting it wrong just means
257 -- more orphans than necessary
258 check (HsVar v) = not (isLocallyDefined v)
259 check (HsApp f a) = check f && check a
260 check (HsLit _) = False
261 check (OpApp l o _ r) = check l && check o && check r
262 check (NegApp e _) = check e
263 check (HsPar e) = check e
264 check (SectionL e o) = check e && check o
265 check (SectionR o e) = check e && check o
267 check other = True -- Safe fall through
269 isOrphanDecl other = False
274 dupDefaultDeclErrRn (DefaultDecl _ locn1 : dup_things)
275 = pushSrcLocRn locn1 $
278 msg = hang (ptext SLIT("Multiple default declarations"))
279 4 (vcat (map pp dup_things))
280 pp (DefaultDecl _ locn) = ptext SLIT("here was another default declaration") <+> ppr locn
284 %*********************************************************
286 \subsection{Slurping declarations}
288 %*********************************************************
291 -------------------------------------------------------
292 slurpImpDecls source_fvs
293 = traceRn (text "slurpImp" <+> fsep (map ppr (nameSetToList source_fvs))) `thenRn_`
295 -- The current slurped-set records all local things
296 getSlurped `thenRn` \ source_binders ->
297 slurpSourceRefs source_binders source_fvs `thenRn` \ (decls, needed) ->
299 -- Then get everything else
300 closeDecls decls needed `thenRn` \ decls1 ->
302 -- Finally, get any deferred data type decls
303 slurpDeferredDecls decls1 `thenRn` \ final_decls ->
307 -------------------------------------------------------
308 slurpSourceRefs :: NameSet -- Variables defined in source
309 -> FreeVars -- Variables referenced in source
310 -> RnMG ([RenamedHsDecl],
311 FreeVars) -- Un-satisfied needs
312 -- The declaration (and hence home module) of each gate has
313 -- already been loaded
315 slurpSourceRefs source_binders source_fvs
316 = go_outer [] -- Accumulating decls
317 emptyFVs -- Unsatisfied needs
318 emptyFVs -- Accumulating gates
319 (nameSetToList source_fvs) -- Things whose defn hasn't been loaded yet
321 -- The outer loop repeatedly slurps the decls for the current gates
322 -- and the instance decls
324 -- The outer loop is needed because consider
325 -- instance Foo a => Baz (Maybe a) where ...
326 -- It may be that @Baz@ and @Maybe@ are used in the source module,
327 -- but not @Foo@; so we need to chase @Foo@ too.
329 -- We also need to follow superclass refs. In particular, 'chasing @Foo@' must
330 -- include actually getting in Foo's class decl
331 -- class Wib a => Foo a where ..
332 -- so that its superclasses are discovered. The point is that Wib is a gate too.
333 -- We do this for tycons too, so that we look through type synonyms.
335 go_outer decls fvs all_gates []
336 = returnRn (decls, fvs)
338 go_outer decls fvs all_gates refs -- refs are not necessarily slurped yet
339 = traceRn (text "go_outer" <+> ppr refs) `thenRn_`
340 foldlRn go_inner (decls, fvs, emptyFVs) refs `thenRn` \ (decls1, fvs1, gates1) ->
341 getImportedInstDecls (all_gates `plusFV` gates1) `thenRn` \ inst_decls ->
342 rnInstDecls decls1 fvs1 gates1 inst_decls `thenRn` \ (decls2, fvs2, gates2) ->
343 go_outer decls2 fvs2 (all_gates `plusFV` gates2)
344 (nameSetToList (gates2 `minusNameSet` all_gates))
345 -- Knock out the all_gates because even if we don't slurp any new
346 -- decls we can get some apparently-new gates from wired-in names
348 go_inner (decls, fvs, gates) wanted_name
349 = importDecl wanted_name `thenRn` \ import_result ->
350 case import_result of
351 AlreadySlurped -> returnRn (decls, fvs, gates)
352 WiredIn -> returnRn (decls, fvs, gates `plusFV` getWiredInGates wanted_name)
353 Deferred -> returnRn (decls, fvs, gates `addOneFV` wanted_name) -- It's a type constructor
355 HereItIs decl -> rnIfaceDecl decl `thenRn` \ (new_decl, fvs1) ->
356 returnRn (new_decl : decls,
358 gates `plusFV` getGates source_fvs new_decl)
360 rnInstDecls decls fvs gates []
361 = returnRn (decls, fvs, gates)
362 rnInstDecls decls fvs gates (d:ds)
363 = rnIfaceDecl d `thenRn` \ (new_decl, fvs1) ->
364 rnInstDecls (new_decl:decls)
366 (gates `plusFV` getInstDeclGates new_decl)
372 -------------------------------------------------------
373 -- closeDecls keeps going until the free-var set is empty
374 closeDecls decls needed
375 | not (isEmptyFVs needed)
376 = slurpDecls decls needed `thenRn` \ (decls1, needed1) ->
377 closeDecls decls1 needed1
380 = getImportedRules `thenRn` \ rule_decls ->
382 [] -> returnRn decls -- No new rules, so we are done
383 other -> rnIfaceDecls decls emptyFVs rule_decls `thenRn` \ (decls1, needed1) ->
384 closeDecls decls1 needed1
387 -------------------------------------------------------
388 -- Augment decls with any decls needed by needed.
389 -- Return also free vars of the new decls (only)
390 slurpDecls decls needed
391 = go decls emptyFVs (nameSetToList needed)
393 go decls fvs [] = returnRn (decls, fvs)
394 go decls fvs (ref:refs) = slurpDecl decls fvs ref `thenRn` \ (decls1, fvs1) ->
397 -------------------------------------------------------
398 slurpDecl decls fvs wanted_name
399 = importDecl wanted_name `thenRn` \ import_result ->
400 case import_result of
401 -- Found a declaration... rename it
402 HereItIs decl -> rnIfaceDecl decl `thenRn` \ (new_decl, fvs1) ->
403 returnRn (new_decl:decls, fvs1 `plusFV` fvs)
405 -- No declaration... (wired in thing, or deferred, or already slurped)
406 other -> returnRn (decls, fvs)
409 -------------------------------------------------------
410 rnIfaceDecls :: [RenamedHsDecl] -> FreeVars
411 -> [(Module, RdrNameHsDecl)]
412 -> RnM d ([RenamedHsDecl], FreeVars)
413 rnIfaceDecls decls fvs [] = returnRn (decls, fvs)
414 rnIfaceDecls decls fvs (d:ds) = rnIfaceDecl d `thenRn` \ (new_decl, fvs1) ->
415 rnIfaceDecls (new_decl:decls) (fvs1 `plusFV` fvs) ds
417 rnIfaceDecl (mod, decl) = initIfaceRnMS mod (rnDecl decl)
421 %*********************************************************
423 \subsection{Deferred declarations}
425 %*********************************************************
427 The idea of deferred declarations is this. Suppose we have a function
432 Then we don't want to load T and all its constructors, and all
433 the types those constructors refer to, and all the types *those*
434 constructors refer to, and so on. That might mean loading many more
435 interface files than is really necessary. So we 'defer' loading T.
437 But f might be strict, and the calling convention for evaluating
438 values of type T depends on how many constructors T has, so
439 we do need to load T, but not the full details of the type T.
440 So we load the full decl for T, but only skeleton decls for A and B:
442 data T = {- 2 constructors -}
444 Whether all this is worth it is moot.
447 slurpDeferredDecls :: [RenamedHsDecl] -> RnMG [RenamedHsDecl]
448 slurpDeferredDecls decls
449 = getDeferredDecls `thenRn` \ def_decls ->
450 rnIfaceDecls decls emptyFVs (map stripDecl def_decls) `thenRn` \ (decls1, fvs) ->
451 ASSERT( isEmptyFVs fvs )
454 stripDecl (mod, TyClD (TyData dt _ tc tvs _ nconstrs _ _ loc))
455 = (mod, TyClD (TyData dt [] tc tvs [] nconstrs Nothing NoDataPragmas loc))
456 -- Nuke the context and constructors
457 -- But retain the *number* of constructors!
458 -- Also the tvs will have kinds on them.
462 %*********************************************************
464 \subsection{Extracting the `gates'}
466 %*********************************************************
468 When we import a declaration like
470 data T = T1 Wibble | T2 Wobble
472 we don't want to treat @Wibble@ and @Wobble@ as gates
473 {\em unless} @T1@, @T2@ respectively are mentioned by the user program.
474 If only @T@ is mentioned
475 we want only @T@ to be a gate;
476 that way we don't suck in useless instance
477 decls for (say) @Eq Wibble@, when they can't possibly be useful.
479 @getGates@ takes a newly imported (and renamed) decl, and the free
480 vars of the source program, and extracts from the decl the gate names.
483 getGates source_fvs (SigD (IfaceSig _ ty _ _))
484 = extractHsTyNames ty
486 getGates source_fvs (TyClD (ClassDecl ctxt cls tvs _ sigs _ _ _ _ _ _ _))
487 = (delListFromNameSet (foldr (plusFV . get) (extractHsCtxtTyNames ctxt) sigs)
488 (map getTyVarName tvs)
489 `addOneToNameSet` cls)
490 `plusFV` maybe_double
492 get (ClassOpSig n _ _ ty _)
493 | n `elemNameSet` source_fvs = extractHsTyNames ty
494 | otherwise = emptyFVs
496 -- If we load any numeric class that doesn't have
497 -- Int as an instance, add Double to the gates.
498 -- This takes account of the fact that Double might be needed for
499 -- defaulting, but we don't want to load Double (and all its baggage)
500 -- if the more exotic classes aren't used at all.
501 maybe_double | nameUnique cls `elem` fractionalClassKeys
502 = unitFV (getName doubleTyCon)
506 getGates source_fvs (TyClD (TySynonym tycon tvs ty _))
507 = delListFromNameSet (extractHsTyNames ty)
508 (map getTyVarName tvs)
509 -- A type synonym type constructor isn't a "gate" for instance decls
511 getGates source_fvs (TyClD (TyData _ ctxt tycon tvs cons _ _ _ _))
512 = delListFromNameSet (foldr (plusFV . get) (extractHsCtxtTyNames ctxt) cons)
513 (map getTyVarName tvs)
514 `addOneToNameSet` tycon
516 get (ConDecl n _ tvs ctxt details _)
517 | n `elemNameSet` source_fvs
518 -- If the constructor is method, get fvs from all its fields
519 = delListFromNameSet (get_details details `plusFV`
520 extractHsCtxtTyNames ctxt)
521 (map getTyVarName tvs)
522 get (ConDecl n _ tvs ctxt (RecCon fields) _)
523 -- Even if the constructor isn't mentioned, the fields
524 -- might be, as selectors. They can't mention existentially
525 -- bound tyvars (typechecker checks for that) so no need for
526 -- the deleteListFromNameSet part
527 = foldr (plusFV . get_field) emptyFVs fields
529 get other_con = emptyFVs
531 get_details (VanillaCon tys) = plusFVs (map get_bang tys)
532 get_details (InfixCon t1 t2) = get_bang t1 `plusFV` get_bang t2
533 get_details (RecCon fields) = plusFVs [get_bang t | (_, t) <- fields]
534 get_details (NewCon t _) = extractHsTyNames t
536 get_field (fs,t) | any (`elemNameSet` source_fvs) fs = get_bang t
537 | otherwise = emptyFVs
539 get_bang (Banged t) = extractHsTyNames t
540 get_bang (Unbanged t) = extractHsTyNames t
541 get_bang (Unpacked t) = extractHsTyNames t
543 getGates source_fvs other_decl = emptyFVs
546 @getWiredInGates@ is just like @getGates@, but it sees a wired-in @Name@
547 rather than a declaration.
550 getWiredInGates :: Name -> FreeVars
551 getWiredInGates name -- No classes are wired in
552 | is_id = getWiredInGates_s (namesOfType (idType the_id))
553 | isSynTyCon the_tycon = getWiredInGates_s
554 (delListFromNameSet (namesOfType ty) (map getName tyvars))
555 | otherwise = unitFV name
557 maybe_wired_in_id = maybeWiredInIdName name
558 is_id = maybeToBool maybe_wired_in_id
559 maybe_wired_in_tycon = maybeWiredInTyConName name
560 Just the_id = maybe_wired_in_id
561 Just the_tycon = maybe_wired_in_tycon
562 (tyvars,ty) = getSynTyConDefn the_tycon
564 getWiredInGates_s names = foldr (plusFV . getWiredInGates) emptyFVs (nameSetToList names)
568 getInstDeclGates (InstD (InstDecl inst_ty _ _ _ _)) = extractHsTyNames inst_ty
569 getInstDeclGates other = emptyFVs
573 %*********************************************************
575 \subsection{Fixities}
577 %*********************************************************
580 fixitiesFromLocalDecls :: GlobalRdrEnv -> [RdrNameHsDecl] -> RnMG FixityEnv
581 fixitiesFromLocalDecls gbl_env decls
582 = foldlRn getFixities emptyNameEnv decls `thenRn` \ env ->
583 traceRn (text "fixity env" <+> vcat (map ppr (nameEnvElts env))) `thenRn_`
586 getFixities :: FixityEnv -> RdrNameHsDecl -> RnMG FixityEnv
587 getFixities acc (FixD fix)
590 getFixities acc (TyClD (ClassDecl _ _ _ _ sigs _ _ _ _ _ _ _))
591 = foldlRn fix_decl acc [sig | FixSig sig <- sigs]
592 -- Get fixities from class decl sigs too.
593 getFixities acc other_decl
596 fix_decl acc sig@(FixitySig rdr_name fixity loc)
597 = -- Check for fixity decl for something not declared
598 case lookupRdrEnv gbl_env rdr_name of {
599 Nothing | opt_WarnUnusedBinds
600 -> pushSrcLocRn loc (addWarnRn (unusedFixityDecl rdr_name fixity))
601 `thenRn_` returnRn acc
602 | otherwise -> returnRn acc ;
606 -- Check for duplicate fixity decl
607 case lookupNameEnv acc name of {
608 Just (FixitySig _ _ loc') -> addErrRn (dupFixityDecl rdr_name loc loc')
609 `thenRn_` returnRn acc ;
611 Nothing -> returnRn (addToNameEnv acc name (FixitySig name fixity loc))
616 %*********************************************************
618 \subsection{Deprecations}
620 %*********************************************************
622 For deprecations, all we do is check that the names are in scope.
623 It's only imported deprecations, dealt with in RnIfaces, that we
624 gather them together.
627 rnDeprecs :: GlobalRdrEnv -> Maybe DeprecTxt
628 -> [RdrNameHsDecl] -> RnMG [RdrNameDeprecation]
629 rnDeprecs gbl_env mod_deprec decls
630 = mapRn rn_deprec deprecs `thenRn_`
631 returnRn (extra_deprec ++ deprecs)
633 deprecs = [d | DeprecD d <- decls]
634 extra_deprec = case mod_deprec of
636 Just txt -> [Deprecation (IEModuleContents undefined) txt noSrcLoc]
638 rn_deprec (Deprecation ie txt loc)
640 mapRn check (ieNames ie)
642 check n = case lookupRdrEnv gbl_env n of
643 Nothing -> addErrRn (unknownNameErr n)
644 Just _ -> returnRn ()
648 %*********************************************************
650 \subsection{Unused names}
652 %*********************************************************
655 reportUnusedNames :: ModuleName -> [ModuleName]
656 -> GlobalRdrEnv -> AvailEnv
657 -> Avails -> NameSet -> RnMG ()
658 reportUnusedNames mod_name direct_import_mods
660 export_avails mentioned_names
662 used_names = mentioned_names `unionNameSets` availsToNameSet export_avails
664 -- Now, a use of C implies a use of T,
665 -- if C was brought into scope by T(..) or T(C)
666 really_used_names = used_names `unionNameSets`
667 mkNameSet [ availName parent_avail
668 | sub_name <- nameSetToList used_names
669 , isValOcc (getOccName sub_name)
671 -- Usually, every used name will appear in avail_env, but there
672 -- is one time when it doesn't: tuples and other built in syntax. When you
673 -- write (a,b) that gives rise to a *use* of "(,)", so that the
674 -- instances will get pulled in, but the tycon "(,)" isn't actually
675 -- in scope. Hence the isValOcc filter.
677 -- Also, (-x) gives rise to an implicit use of 'negate'; similarly,
678 -- 3.5 gives rise to an implcit use of :%
679 -- hence the isUserImportedName filter on the warning
682 = case lookupNameEnv avail_env sub_name of
684 Nothing -> WARN( isUserImportedName sub_name,
685 text "reportUnusedName: not in avail_env" <+> ppr sub_name )
688 , case parent_avail of { AvailTC _ _ -> True; other -> False }
691 defined_names = mkNameSet (concat (rdrEnvElts gbl_env))
692 defined_but_not_used =
693 nameSetToList (defined_names `minusNameSet` really_used_names)
695 -- Filter out the ones only defined implicitly
696 bad_locals = [n | n <- defined_but_not_used, isLocallyDefined n]
697 bad_imp_names = [n | n <- defined_but_not_used, isUserImportedExplicitlyName n,
698 not (module_unused n)]
700 deprec_used deprec_env = [ (n,txt)
701 | n <- nameSetToList mentioned_names,
702 not (isLocallyDefined n),
703 Just txt <- [lookupNameEnv deprec_env n] ]
705 minimal_imports :: FiniteMap ModuleName AvailEnv
706 minimal_imports = foldNameSet add emptyFM really_used_names
707 add n acc = case maybeUserImportedFrom n of
709 Just m -> addToFM_C plusAvailEnv acc (moduleName m)
710 (unitAvailEnv (mk_avail n))
711 mk_avail n = case lookupNameEnv avail_env n of
712 Just (AvailTC m _) | n==m -> AvailTC n [n]
713 | otherwise -> AvailTC m [n,m]
714 Just avail -> Avail n
715 Nothing -> pprPanic "mk_avail" (ppr n)
717 -- unused_imp_mods are the directly-imported modules
718 -- that are not mentioned in minimal_imports
719 unused_imp_mods = [m | m <- direct_import_mods,
720 not (maybeToBool (lookupFM minimal_imports m))]
722 module_unused :: Name -> Bool
723 -- Name is imported from a module that's completely unused,
724 -- so don't report stuff about the name (the module covers it)
725 module_unused n = moduleName (expectJust "module_unused" (maybeUserImportedFrom n))
726 `elem` unused_imp_mods
727 -- module_unused is only called if it's user-imported
729 warnUnusedModules unused_imp_mods `thenRn_`
730 warnUnusedLocalBinds bad_locals `thenRn_`
731 warnUnusedImports bad_imp_names `thenRn_`
732 printMinimalImports mod_name minimal_imports `thenRn_`
733 getIfacesRn `thenRn` \ ifaces ->
734 (if opt_WarnDeprecations
735 then mapRn_ warnDeprec (deprec_used (iDeprecs ifaces))
738 -- ToDo: deal with original imports with 'qualified' and 'as M' clauses
739 printMinimalImports mod_name imps
740 | not opt_D_dump_minimal_imports
743 = mapRn to_ies (fmToList imps) `thenRn` \ mod_ies ->
744 ioToRnM (do { h <- openFile filename WriteMode ;
745 printForUser h (vcat (map ppr_mod_ie mod_ies))
749 filename = moduleNameUserString mod_name ++ ".imports"
750 ppr_mod_ie (mod_name, ies)
751 | mod_name == pRELUDE_Name
754 = ptext SLIT("import") <+> ppr mod_name <>
755 parens (fsep (punctuate comma (map ppr ies)))
757 to_ies (mod, avail_env) = mapRn to_ie (availEnvElts avail_env) `thenRn` \ ies ->
760 to_ie :: AvailInfo -> RnMG (IE Name)
761 to_ie (Avail n) = returnRn (IEVar n)
762 to_ie (AvailTC n [m]) = ASSERT( n==m )
763 returnRn (IEThingAbs n)
764 to_ie (AvailTC n ns) = getInterfaceExports (moduleName (nameModule n))
765 ImportBySystem `thenRn` \ (_, avails) ->
766 case [ms | AvailTC m ms <- avails, m == n] of
767 [ms] | all (`elem` ns) ms -> returnRn (IEThingAll n)
768 | otherwise -> returnRn (IEThingWith n (filter (/= n) ns))
769 other -> pprTrace "to_ie" (ppr n <+> ppr (nameModule n) <+> ppr other) $
772 rnDump :: [RenamedHsDecl] -- Renamed imported decls
773 -> [RenamedHsDecl] -- Renamed local decls
775 rnDump imp_decls local_decls
776 | opt_D_dump_rn_trace ||
777 opt_D_dump_rn_stats ||
779 = getRnStats imp_decls `thenRn` \ stats_msg ->
781 returnRn (printErrs stats_msg >>
782 dumpIfSet opt_D_dump_rn "Renamer:"
783 (vcat (map ppr (local_decls ++ imp_decls))))
785 | otherwise = returnRn (return ())
789 %*********************************************************
791 \subsection{Statistics}
793 %*********************************************************
796 getRnStats :: [RenamedHsDecl] -> RnMG SDoc
797 getRnStats imported_decls
798 = getIfacesRn `thenRn` \ ifaces ->
800 n_mods = length [() | (_, _, Just _) <- eltsFM (iImpModInfo ifaces)]
802 decls_read = [decl | (_, avail, True, (_,decl)) <- nameEnvElts (iDecls ifaces),
803 -- Data, newtype, and class decls are in the decls_fm
804 -- under multiple names; the tycon/class, and each
805 -- constructor/class op too.
806 -- The 'True' selects just the 'main' decl
807 not (isLocallyDefined (availName avail))
810 (cd_rd, dd_rd, nd_rd, sd_rd, vd_rd, _) = count_decls decls_read
811 (cd_sp, dd_sp, nd_sp, sd_sp, vd_sp, id_sp) = count_decls imported_decls
813 unslurped_insts = iInsts ifaces
814 inst_decls_unslurped = length (bagToList unslurped_insts)
815 inst_decls_read = id_sp + inst_decls_unslurped
818 [int n_mods <+> text "interfaces read",
819 hsep [ int cd_sp, text "class decls imported, out of",
820 int cd_rd, text "read"],
821 hsep [ int dd_sp, text "data decls imported, out of",
822 int dd_rd, text "read"],
823 hsep [ int nd_sp, text "newtype decls imported, out of",
824 int nd_rd, text "read"],
825 hsep [int sd_sp, text "type synonym decls imported, out of",
826 int sd_rd, text "read"],
827 hsep [int vd_sp, text "value signatures imported, out of",
828 int vd_rd, text "read"],
829 hsep [int id_sp, text "instance decls imported, out of",
830 int inst_decls_read, text "read"],
831 text "cls dcls slurp" <+> fsep (map (ppr . tyClDeclName)
832 [d | TyClD d <- imported_decls, isClassDecl d]),
833 text "cls dcls read" <+> fsep (map (ppr . tyClDeclName)
834 [d | TyClD d <- decls_read, isClassDecl d])]
836 returnRn (hcat [text "Renamer stats: ", stats])
846 tycl_decls = [d | TyClD d <- decls]
847 (class_decls, data_decls, newtype_decls, syn_decls) = countTyClDecls tycl_decls
849 val_decls = length [() | SigD _ <- decls]
850 inst_decls = length [() | InstD _ <- decls]
854 %************************************************************************
856 \subsection{Errors and warnings}
858 %************************************************************************
861 warnDeprec :: (Name, DeprecTxt) -> RnM d ()
862 warnDeprec (name, txt)
863 = pushSrcLocRn (getSrcLoc name) $
865 sep [ text (occNameFlavour (nameOccName name)) <+> ppr name <+>
866 text "is deprecated:", nest 4 (ppr txt) ]
869 unusedFixityDecl rdr_name fixity
870 = hsep [ptext SLIT("Unused fixity declaration for"), quotes (ppr rdr_name)]
872 dupFixityDecl rdr_name loc1 loc2
873 = vcat [ptext SLIT("Multiple fixity declarations for") <+> quotes (ppr rdr_name),
874 ptext SLIT("at ") <+> ppr loc1,
875 ptext SLIT("and") <+> ppr loc2]