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 PrelNames ( mAIN_Name, pREL_MAIN_Name, pRELUDE_Name,
53 unpackCString_RDR, unpackCStringFoldr_RDR, unpackCStringUtf8_RDR,
56 import PrelInfo ( fractionalClassKeys, derivingOccurrences )
57 import Type ( namesOfType, funTyCon )
58 import ErrUtils ( printErrorsAndWarnings, dumpIfSet, ghcExit )
59 import BasicTypes ( Version, initialVersion )
60 import Bag ( isEmptyBag, bagToList )
61 import FiniteMap ( FiniteMap, eltsFM, fmToList, emptyFM, lookupFM,
62 addToFM_C, elemFM, addToFM
64 import UniqSupply ( UniqSupply )
65 import UniqFM ( lookupUFM )
66 import SrcLoc ( noSrcLoc )
67 import Maybes ( maybeToBool, expectJust )
69 import IO ( openFile, IOMode(..) )
75 type RenameResult = ( Module -- This module
76 , RenamedHsModule -- Renamed module
77 , Maybe ParsedIface -- The existing interface file, if any
78 , ParsedIface -- The new interface
79 , RnNameSupply -- Final env; for renaming derivings
80 , FixityEnv -- The fixity environment; for derivings
81 , [Module]) -- Imported modules
83 renameModule :: PersistentCompilerState -> RdrNameHsModule -> IO (Maybe RenameResult)
84 renameModule pcs this_mod@(HsModule mod_name vers exports imports local_decls _ loc)
85 = -- Initialise the renamer monad
87 ((maybe_rn_stuff, dump_action), rn_errs_bag, rn_warns_bag)
89 (mkThisModule mod_name)
90 (mkSearchPath opt_HiMap) loc
94 printErrorsAndWarnings rn_errs_bag rn_warns_bag ;
96 -- Dump any debugging output
100 if not (isEmptyBag rn_errs_bag) then
101 do { ghcExit 1 ; return Nothing }
103 return maybe_rn_stuff
108 rename :: RdrNameHsModule -> RnMG (Maybe RenameResult, IO ())
109 rename this_mod@(HsModule mod_name vers exports imports local_decls mod_deprec loc)
110 = -- FIND THE GLOBAL NAME ENVIRONMENT
111 getGlobalNames this_mod `thenRn` \ maybe_stuff ->
113 -- CHECK FOR EARLY EXIT
114 case maybe_stuff of {
115 Nothing -> -- Everything is up to date; no need to recompile further
116 rnDump [] [] `thenRn` \ dump_action ->
117 returnRn (Nothing, dump_action) ;
119 Just (gbl_env, local_gbl_env, export_avails, global_avail_env, old_iface) ->
121 -- DEAL WITH DEPRECATIONS
122 rnDeprecs local_gbl_env mod_deprec local_decls `thenRn` \ my_deprecs ->
124 -- DEAL WITH LOCAL FIXITIES
125 fixitiesFromLocalDecls local_gbl_env local_decls `thenRn` \ local_fixity_env ->
128 initRnMS gbl_env local_fixity_env SourceMode (
129 rnSourceDecls local_decls
130 ) `thenRn` \ (rn_local_decls, source_fvs) ->
132 -- SLURP IN ALL THE NEEDED DECLARATIONS
133 implicitFVs mod_name rn_local_decls `thenRn` \ implicit_fvs ->
135 -- The export_fvs make the exported names look just as if they
136 -- occurred in the source program. For the reasoning, see the
137 -- comments with RnIfaces.getImportVersions.
138 -- We only need the 'parent name' of the avail;
139 -- that's enough to suck in the declaration.
140 export_fvs = mkNameSet (map availName export_avails)
141 real_source_fvs = source_fvs `plusFV` export_fvs
143 slurp_fvs = implicit_fvs `plusFV` real_source_fvs
144 -- It's important to do the "plus" this way round, so that
145 -- when compiling the prelude, locally-defined (), Bool, etc
146 -- override the implicit ones.
148 loadBuiltinRules builtinRules `thenRn_`
149 slurpImpDecls slurp_fvs `thenRn` \ rn_imp_decls ->
151 -- EXIT IF ERRORS FOUND
152 rnDump rn_imp_decls rn_local_decls `thenRn` \ dump_action ->
153 checkErrsRn `thenRn` \ no_errs_so_far ->
154 if not no_errs_so_far then
155 -- Found errors already, so exit now
156 returnRn (Nothing, dump_action)
159 -- GENERATE THE VERSION/USAGE INFO
160 mkImportExportInfo mod_name export_avails exports `thenRn` \ (my_exports, my_usages) ->
162 -- RETURN THE RENAMED MODULE
163 getNameSupplyRn `thenRn` \ name_supply ->
164 getIfacesRn `thenRn` \ ifaces ->
166 direct_import_mods :: [Module]
167 direct_import_mods = [m | (_, _, Just (m, _, _, _, imp, _))
168 <- eltsFM (iImpModInfo ifaces), user_import imp]
170 -- *don't* just pick the forward edges. It's entirely possible
171 -- that a module is only reachable via back edges.
172 user_import ImportByUser = True
173 user_import ImportByUserSource = True
174 user_import _ = False
176 this_module = mkThisModule mod_name
178 -- Export only those fixities that are for names that are
179 -- (a) defined in this module
182 = [ FixitySig (toRdrName name) fixity loc
183 | FixitySig name fixity loc <- nameEnvElts local_fixity_env,
184 isUserExportedName name
187 new_iface = ParsedIface { pi_mod = this_module
188 , pi_vers = initialVersion
189 , pi_orphan = any isOrphanDecl rn_local_decls
190 , pi_exports = my_exports
191 , pi_usages = my_usages
192 , pi_fixity = (initialVersion, exported_fixities)
193 , pi_deprecs = my_deprecs
194 -- These ones get filled in later
195 , pi_insts = [], pi_decls = []
196 , pi_rules = (initialVersion, [])
199 renamed_module = HsModule mod_name vers
200 trashed_exports trashed_imports
201 (rn_local_decls ++ rn_imp_decls)
205 result = (this_module, renamed_module,
206 old_iface, new_iface,
207 name_supply, local_fixity_env,
211 -- REPORT UNUSED NAMES, AND DEBUG DUMP
212 reportUnusedNames mod_name direct_import_mods
213 gbl_env global_avail_env
214 export_avails source_fvs
215 rn_imp_decls `thenRn_`
217 returnRn (Just result, dump_action) }
219 trashed_exports = {-trace "rnSource:trashed_exports"-} Nothing
220 trashed_imports = {-trace "rnSource:trashed_imports"-} []
223 @implicitFVs@ forces the renamer to slurp in some things which aren't
224 mentioned explicitly, but which might be needed by the type checker.
227 implicitFVs mod_name decls
228 = lookupOrigNames implicit_occs `thenRn` \ implicit_names ->
229 returnRn (mkNameSet (map getName default_tycons) `plusFV`
232 -- Add occurrences for Int, and (), because they
233 -- are the types to which ambigious type variables may be defaulted by
234 -- the type checker; so they won't always appear explicitly.
235 -- [The () one is a GHC extension for defaulting CCall results.]
236 -- ALSO: funTyCon, since it occurs implicitly everywhere!
237 -- (we don't want to be bothered with making funTyCon a
238 -- free var at every function application!)
239 -- Double is dealt with separately in getGates
240 default_tycons = [unitTyCon, funTyCon, boolTyCon, intTyCon]
242 -- Add occurrences for IO or PrimIO
243 implicit_main | mod_name == mAIN_Name
244 || mod_name == pREL_MAIN_Name = [ioTyCon_RDR]
247 -- Now add extra "occurrences" for things that
248 -- the deriving mechanism, or defaulting, will later need in order to
250 implicit_occs = string_occs ++ foldr ((++) . get) implicit_main decls
252 -- Virtually every program has error messages in it somewhere
253 string_occs = [unpackCString_RDR, unpackCStringFoldr_RDR, unpackCStringUtf8_RDR,
256 get (TyClD (TyData _ _ _ _ _ _ (Just deriv_classes) _ _ _ _))
257 = concat (map get_deriv deriv_classes)
260 get_deriv cls = case lookupUFM derivingOccurrences cls of
266 isOrphanDecl (InstD (InstDecl inst_ty _ _ _ _))
267 = not (foldNameSet ((||) . isLocallyDefined) False (extractHsTyNames (removeContext inst_ty)))
268 -- The 'removeContext' is because of
269 -- instance Foo a => Baz T where ...
270 -- The decl is an orphan if Baz and T are both not locally defined,
271 -- even if Foo *is* locally defined
273 isOrphanDecl (RuleD (HsRule _ _ _ lhs _ _))
276 -- At the moment we just check for common LHS forms
277 -- Expand as necessary. Getting it wrong just means
278 -- more orphans than necessary
279 check (HsVar v) = not (isLocallyDefined v)
280 check (HsApp f a) = check f && check a
281 check (HsLit _) = False
282 check (HsOverLit _) = False
283 check (OpApp l o _ r) = check l && check o && check r
284 check (NegApp e _) = check e
285 check (HsPar e) = check e
286 check (SectionL e o) = check e && check o
287 check (SectionR o e) = check e && check o
289 check other = True -- Safe fall through
291 isOrphanDecl other = False
296 dupDefaultDeclErrRn (DefaultDecl _ locn1 : dup_things)
297 = pushSrcLocRn locn1 $
300 msg = hang (ptext SLIT("Multiple default declarations"))
301 4 (vcat (map pp dup_things))
302 pp (DefaultDecl _ locn) = ptext SLIT("here was another default declaration") <+> ppr locn
306 %*********************************************************
308 \subsection{Slurping declarations}
310 %*********************************************************
313 -------------------------------------------------------
314 slurpImpDecls source_fvs
315 = traceRn (text "slurpImp" <+> fsep (map ppr (nameSetToList source_fvs))) `thenRn_`
317 -- The current slurped-set records all local things
318 getSlurped `thenRn` \ source_binders ->
319 slurpSourceRefs source_binders source_fvs `thenRn` \ (decls, needed) ->
321 -- Then get everything else
322 closeDecls decls needed `thenRn` \ decls1 ->
324 -- Finally, get any deferred data type decls
325 slurpDeferredDecls decls1 `thenRn` \ final_decls ->
329 -------------------------------------------------------
330 slurpSourceRefs :: NameSet -- Variables defined in source
331 -> FreeVars -- Variables referenced in source
332 -> RnMG ([RenamedHsDecl],
333 FreeVars) -- Un-satisfied needs
334 -- The declaration (and hence home module) of each gate has
335 -- already been loaded
337 slurpSourceRefs source_binders source_fvs
338 = go_outer [] -- Accumulating decls
339 emptyFVs -- Unsatisfied needs
340 emptyFVs -- Accumulating gates
341 (nameSetToList source_fvs) -- Things whose defn hasn't been loaded yet
343 -- The outer loop repeatedly slurps the decls for the current gates
344 -- and the instance decls
346 -- The outer loop is needed because consider
347 -- instance Foo a => Baz (Maybe a) where ...
348 -- It may be that @Baz@ and @Maybe@ are used in the source module,
349 -- but not @Foo@; so we need to chase @Foo@ too.
351 -- We also need to follow superclass refs. In particular, 'chasing @Foo@' must
352 -- include actually getting in Foo's class decl
353 -- class Wib a => Foo a where ..
354 -- so that its superclasses are discovered. The point is that Wib is a gate too.
355 -- We do this for tycons too, so that we look through type synonyms.
357 go_outer decls fvs all_gates []
358 = returnRn (decls, fvs)
360 go_outer decls fvs all_gates refs -- refs are not necessarily slurped yet
361 = traceRn (text "go_outer" <+> ppr refs) `thenRn_`
362 foldlRn go_inner (decls, fvs, emptyFVs) refs `thenRn` \ (decls1, fvs1, gates1) ->
363 getImportedInstDecls (all_gates `plusFV` gates1) `thenRn` \ inst_decls ->
364 rnInstDecls decls1 fvs1 gates1 inst_decls `thenRn` \ (decls2, fvs2, gates2) ->
365 go_outer decls2 fvs2 (all_gates `plusFV` gates2)
366 (nameSetToList (gates2 `minusNameSet` all_gates))
367 -- Knock out the all_gates because even if we don't slurp any new
368 -- decls we can get some apparently-new gates from wired-in names
370 go_inner (decls, fvs, gates) wanted_name
371 = importDecl wanted_name `thenRn` \ import_result ->
372 case import_result of
373 AlreadySlurped -> returnRn (decls, fvs, gates)
374 WiredIn -> returnRn (decls, fvs, gates `plusFV` getWiredInGates wanted_name)
375 Deferred -> returnRn (decls, fvs, gates `addOneFV` wanted_name) -- It's a type constructor
377 HereItIs decl -> rnIfaceDecl decl `thenRn` \ (new_decl, fvs1) ->
378 returnRn (new_decl : decls,
380 gates `plusFV` getGates source_fvs new_decl)
382 rnInstDecls decls fvs gates []
383 = returnRn (decls, fvs, gates)
384 rnInstDecls decls fvs gates (d:ds)
385 = rnIfaceDecl d `thenRn` \ (new_decl, fvs1) ->
386 rnInstDecls (new_decl:decls)
388 (gates `plusFV` getInstDeclGates new_decl)
394 -------------------------------------------------------
395 -- closeDecls keeps going until the free-var set is empty
396 closeDecls decls needed
397 | not (isEmptyFVs needed)
398 = slurpDecls decls needed `thenRn` \ (decls1, needed1) ->
399 closeDecls decls1 needed1
402 = getImportedRules `thenRn` \ rule_decls ->
404 [] -> returnRn decls -- No new rules, so we are done
405 other -> rnIfaceDecls decls emptyFVs rule_decls `thenRn` \ (decls1, needed1) ->
406 closeDecls decls1 needed1
409 -------------------------------------------------------
410 -- Augment decls with any decls needed by needed.
411 -- Return also free vars of the new decls (only)
412 slurpDecls decls needed
413 = go decls emptyFVs (nameSetToList needed)
415 go decls fvs [] = returnRn (decls, fvs)
416 go decls fvs (ref:refs) = slurpDecl decls fvs ref `thenRn` \ (decls1, fvs1) ->
419 -------------------------------------------------------
420 slurpDecl decls fvs wanted_name
421 = importDecl wanted_name `thenRn` \ import_result ->
422 case import_result of
423 -- Found a declaration... rename it
424 HereItIs decl -> rnIfaceDecl decl `thenRn` \ (new_decl, fvs1) ->
425 returnRn (new_decl:decls, fvs1 `plusFV` fvs)
427 -- No declaration... (wired in thing, or deferred, or already slurped)
428 other -> returnRn (decls, fvs)
431 -------------------------------------------------------
432 rnIfaceDecls :: [RenamedHsDecl] -> FreeVars
433 -> [(Module, RdrNameHsDecl)]
434 -> RnM d ([RenamedHsDecl], FreeVars)
435 rnIfaceDecls decls fvs [] = returnRn (decls, fvs)
436 rnIfaceDecls decls fvs (d:ds) = rnIfaceDecl d `thenRn` \ (new_decl, fvs1) ->
437 rnIfaceDecls (new_decl:decls) (fvs1 `plusFV` fvs) ds
439 rnIfaceDecl (mod, decl) = initIfaceRnMS mod (rnDecl decl)
443 %*********************************************************
445 \subsection{Deferred declarations}
447 %*********************************************************
449 The idea of deferred declarations is this. Suppose we have a function
454 Then we don't want to load T and all its constructors, and all
455 the types those constructors refer to, and all the types *those*
456 constructors refer to, and so on. That might mean loading many more
457 interface files than is really necessary. So we 'defer' loading T.
459 But f might be strict, and the calling convention for evaluating
460 values of type T depends on how many constructors T has, so
461 we do need to load T, but not the full details of the type T.
462 So we load the full decl for T, but only skeleton decls for A and B:
464 data T = {- 2 constructors -}
466 Whether all this is worth it is moot.
469 slurpDeferredDecls :: [RenamedHsDecl] -> RnMG [RenamedHsDecl]
470 slurpDeferredDecls decls
471 = getDeferredDecls `thenRn` \ def_decls ->
472 rnIfaceDecls decls emptyFVs (map stripDecl def_decls) `thenRn` \ (decls1, fvs) ->
473 ASSERT( isEmptyFVs fvs )
476 stripDecl (mod, TyClD (TyData dt _ tc tvs _ nconstrs _ _ loc name1 name2))
477 = (mod, TyClD (TyData dt [] tc tvs [] nconstrs Nothing NoDataPragmas loc
479 -- Nuke the context and constructors
480 -- But retain the *number* of constructors!
481 -- Also the tvs will have kinds on them.
485 %*********************************************************
487 \subsection{Extracting the `gates'}
489 %*********************************************************
491 When we import a declaration like
493 data T = T1 Wibble | T2 Wobble
495 we don't want to treat @Wibble@ and @Wobble@ as gates
496 {\em unless} @T1@, @T2@ respectively are mentioned by the user program.
497 If only @T@ is mentioned
498 we want only @T@ to be a gate;
499 that way we don't suck in useless instance
500 decls for (say) @Eq Wibble@, when they can't possibly be useful.
502 @getGates@ takes a newly imported (and renamed) decl, and the free
503 vars of the source program, and extracts from the decl the gate names.
506 getGates source_fvs (SigD (IfaceSig _ ty _ _))
507 = extractHsTyNames ty
509 getGates source_fvs (TyClD (ClassDecl ctxt cls tvs _ sigs _ _ _ _ ))
510 = (delListFromNameSet (foldr (plusFV . get) (extractHsCtxtTyNames ctxt) sigs)
512 `addOneToNameSet` cls)
513 `plusFV` maybe_double
515 get (ClassOpSig n _ ty _)
516 | n `elemNameSet` source_fvs = extractHsTyNames ty
517 | otherwise = emptyFVs
519 -- If we load any numeric class that doesn't have
520 -- Int as an instance, add Double to the gates.
521 -- This takes account of the fact that Double might be needed for
522 -- defaulting, but we don't want to load Double (and all its baggage)
523 -- if the more exotic classes aren't used at all.
524 maybe_double | nameUnique cls `elem` fractionalClassKeys
525 = unitFV (getName doubleTyCon)
529 getGates source_fvs (TyClD (TySynonym tycon tvs ty _))
530 = delListFromNameSet (extractHsTyNames ty)
532 -- A type synonym type constructor isn't a "gate" for instance decls
534 getGates source_fvs (TyClD (TyData _ ctxt tycon tvs cons _ _ _ _ _ _))
535 = delListFromNameSet (foldr (plusFV . get) (extractHsCtxtTyNames ctxt) cons)
537 `addOneToNameSet` tycon
539 get (ConDecl n _ tvs ctxt details _)
540 | n `elemNameSet` source_fvs
541 -- If the constructor is method, get fvs from all its fields
542 = delListFromNameSet (get_details details `plusFV`
543 extractHsCtxtTyNames ctxt)
545 get (ConDecl n _ tvs ctxt (RecCon fields) _)
546 -- Even if the constructor isn't mentioned, the fields
547 -- might be, as selectors. They can't mention existentially
548 -- bound tyvars (typechecker checks for that) so no need for
549 -- the deleteListFromNameSet part
550 = foldr (plusFV . get_field) emptyFVs fields
552 get other_con = emptyFVs
554 get_details (VanillaCon tys) = plusFVs (map get_bang tys)
555 get_details (InfixCon t1 t2) = get_bang t1 `plusFV` get_bang t2
556 get_details (RecCon fields) = plusFVs [get_bang t | (_, t) <- fields]
558 get_field (fs,t) | any (`elemNameSet` source_fvs) fs = get_bang t
559 | otherwise = emptyFVs
561 get_bang bty = extractHsTyNames (getBangType bty)
563 getGates source_fvs other_decl = emptyFVs
566 @getWiredInGates@ is just like @getGates@, but it sees a wired-in @Name@
567 rather than a declaration.
570 getWiredInGates :: Name -> FreeVars
571 getWiredInGates name -- No classes are wired in
572 | is_id = getWiredInGates_s (namesOfType (idType the_id))
573 | isSynTyCon the_tycon = getWiredInGates_s
574 (delListFromNameSet (namesOfType ty) (map getName tyvars))
575 | otherwise = unitFV name
577 maybe_wired_in_id = maybeWiredInIdName name
578 is_id = maybeToBool maybe_wired_in_id
579 maybe_wired_in_tycon = maybeWiredInTyConName name
580 Just the_id = maybe_wired_in_id
581 Just the_tycon = maybe_wired_in_tycon
582 (tyvars,ty) = getSynTyConDefn the_tycon
584 getWiredInGates_s names = foldr (plusFV . getWiredInGates) emptyFVs (nameSetToList names)
588 getInstDeclGates (InstD (InstDecl inst_ty _ _ _ _)) = extractHsTyNames inst_ty
589 getInstDeclGates other = emptyFVs
593 %*********************************************************
595 \subsection{Fixities}
597 %*********************************************************
600 fixitiesFromLocalDecls :: GlobalRdrEnv -> [RdrNameHsDecl] -> RnMG FixityEnv
601 fixitiesFromLocalDecls gbl_env decls
602 = foldlRn getFixities emptyNameEnv decls `thenRn` \ env ->
603 traceRn (text "fixity env" <+> vcat (map ppr (nameEnvElts env))) `thenRn_`
606 getFixities :: FixityEnv -> RdrNameHsDecl -> RnMG FixityEnv
607 getFixities acc (FixD fix)
610 getFixities acc (TyClD (ClassDecl _ _ _ _ sigs _ _ _ _ ))
611 = foldlRn fix_decl acc [sig | FixSig sig <- sigs]
612 -- Get fixities from class decl sigs too.
613 getFixities acc other_decl
616 fix_decl acc sig@(FixitySig rdr_name fixity loc)
617 = -- Check for fixity decl for something not declared
618 case lookupRdrEnv gbl_env rdr_name of {
619 Nothing | opt_WarnUnusedBinds
620 -> pushSrcLocRn loc (addWarnRn (unusedFixityDecl rdr_name fixity))
621 `thenRn_` returnRn acc
622 | otherwise -> returnRn acc ;
626 -- Check for duplicate fixity decl
627 case lookupNameEnv acc name of {
628 Just (FixitySig _ _ loc') -> addErrRn (dupFixityDecl rdr_name loc loc')
629 `thenRn_` returnRn acc ;
631 Nothing -> returnRn (extendNameEnv acc name (FixitySig name fixity loc))
636 %*********************************************************
638 \subsection{Deprecations}
640 %*********************************************************
642 For deprecations, all we do is check that the names are in scope.
643 It's only imported deprecations, dealt with in RnIfaces, that we
644 gather them together.
647 rnDeprecs :: GlobalRdrEnv -> Maybe DeprecTxt
648 -> [RdrNameHsDecl] -> RnMG [RdrNameDeprecation]
649 rnDeprecs gbl_env mod_deprec decls
650 = mapRn rn_deprec deprecs `thenRn_`
651 returnRn (extra_deprec ++ deprecs)
653 deprecs = [d | DeprecD d <- decls]
654 extra_deprec = case mod_deprec of
656 Just txt -> [Deprecation (IEModuleContents undefined) txt noSrcLoc]
658 rn_deprec (Deprecation ie txt loc)
660 mapRn check (ieNames ie)
662 check n = case lookupRdrEnv gbl_env n of
663 Nothing -> addErrRn (unknownNameErr n)
664 Just _ -> returnRn ()
668 %*********************************************************
670 \subsection{Unused names}
672 %*********************************************************
675 reportUnusedNames :: ModuleName -> [Module]
676 -> GlobalRdrEnv -> AvailEnv
677 -> Avails -> NameSet -> [RenamedHsDecl]
679 reportUnusedNames mod_name direct_import_mods
681 export_avails mentioned_names
684 used_names = mentioned_names `unionNameSets` availsToNameSet export_avails
686 -- Now, a use of C implies a use of T,
687 -- if C was brought into scope by T(..) or T(C)
688 really_used_names = used_names `unionNameSets`
689 mkNameSet [ availName parent_avail
690 | sub_name <- nameSetToList used_names
691 , isValOcc (getOccName sub_name)
693 -- Usually, every used name will appear in avail_env, but there
694 -- is one time when it doesn't: tuples and other built in syntax. When you
695 -- write (a,b) that gives rise to a *use* of "(,)", so that the
696 -- instances will get pulled in, but the tycon "(,)" isn't actually
697 -- in scope. Hence the isValOcc filter.
699 -- Also, (-x) gives rise to an implicit use of 'negate'; similarly,
700 -- 3.5 gives rise to an implcit use of :%
701 -- hence the isUserImportedName filter on the warning
704 = case lookupNameEnv avail_env sub_name of
706 Nothing -> WARN( isUserImportedName sub_name,
707 text "reportUnusedName: not in avail_env" <+>
711 , case parent_avail of { AvailTC _ _ -> True; other -> False }
714 defined_names = mkNameSet (concat (rdrEnvElts gbl_env))
715 defined_but_not_used =
716 nameSetToList (defined_names `minusNameSet` really_used_names)
718 -- Filter out the ones only defined implicitly
719 bad_locals = [n | n <- defined_but_not_used, isLocallyDefined n]
720 bad_imp_names = [n | n <- defined_but_not_used, isUserImportedExplicitlyName n,
721 not (module_unused n)]
723 deprec_used deprec_env = [ (n,txt)
724 | n <- nameSetToList mentioned_names,
725 not (isLocallyDefined n),
726 Just txt <- [lookupNameEnv deprec_env n] ]
728 -- inst_mods are directly-imported modules that
729 -- contain instance decl(s) that the renamer decided to suck in
730 -- It's not necessarily redundant to import such modules.
736 -- The import M() is not *necessarily* redundant, even if
737 -- we suck in no instance decls from M (e.g. it contains
738 -- no instance decls, or This contains no code). It may be
739 -- that we import M solely to ensure that M's orphan instance
740 -- decls (or those in its imports) are visible to people who
741 -- import This. Sigh.
742 -- There's really no good way to detect this, so the error message
743 -- in RnEnv.warnUnusedModules is weakened instead
744 inst_mods = [m | InstD (InstDecl _ _ _ (Just dfun) _) <- imported_decls,
745 let m = nameModule dfun,
746 m `elem` direct_import_mods
749 minimal_imports :: FiniteMap Module AvailEnv
750 minimal_imports0 = emptyFM
751 minimal_imports1 = foldNameSet add_name minimal_imports0 really_used_names
752 minimal_imports = foldr add_inst_mod minimal_imports1 inst_mods
754 add_name n acc = case maybeUserImportedFrom n of
756 Just m -> addToFM_C plusAvailEnv acc m
757 (unitAvailEnv (mk_avail n))
759 | m `elemFM` acc = acc -- We import something already
760 | otherwise = addToFM acc m emptyAvailEnv
761 -- Add an empty collection of imports for a module
762 -- from which we have sucked only instance decls
764 mk_avail n = case lookupNameEnv avail_env n of
765 Just (AvailTC m _) | n==m -> AvailTC n [n]
766 | otherwise -> AvailTC m [n,m]
767 Just avail -> Avail n
768 Nothing -> pprPanic "mk_avail" (ppr n)
770 -- unused_imp_mods are the directly-imported modules
771 -- that are not mentioned in minimal_imports
772 unused_imp_mods = [m | m <- direct_import_mods,
773 not (maybeToBool (lookupFM minimal_imports m)),
774 moduleName m /= pRELUDE_Name]
776 module_unused :: Name -> Bool
777 -- Name is imported from a module that's completely unused,
778 -- so don't report stuff about the name (the module covers it)
779 module_unused n = expectJust "module_unused" (maybeUserImportedFrom n)
780 `elem` unused_imp_mods
781 -- module_unused is only called if it's user-imported
783 warnUnusedModules unused_imp_mods `thenRn_`
784 warnUnusedLocalBinds bad_locals `thenRn_`
785 warnUnusedImports bad_imp_names `thenRn_`
786 printMinimalImports mod_name minimal_imports `thenRn_`
787 getIfacesRn `thenRn` \ ifaces ->
788 (if opt_WarnDeprecations
789 then mapRn_ warnDeprec (deprec_used (iDeprecs ifaces))
792 -- ToDo: deal with original imports with 'qualified' and 'as M' clauses
793 printMinimalImports mod_name imps
794 | not opt_D_dump_minimal_imports
797 = mapRn to_ies (fmToList imps) `thenRn` \ mod_ies ->
798 ioToRnM (do { h <- openFile filename WriteMode ;
799 printForUser h (vcat (map ppr_mod_ie mod_ies))
803 filename = moduleNameUserString mod_name ++ ".imports"
804 ppr_mod_ie (mod_name, ies)
805 | mod_name == pRELUDE_Name
808 = ptext SLIT("import") <+> ppr mod_name <>
809 parens (fsep (punctuate comma (map ppr ies)))
811 to_ies (mod, avail_env) = mapRn to_ie (availEnvElts avail_env) `thenRn` \ ies ->
812 returnRn (moduleName mod, ies)
814 to_ie :: AvailInfo -> RnMG (IE Name)
815 to_ie (Avail n) = returnRn (IEVar n)
816 to_ie (AvailTC n [m]) = ASSERT( n==m )
817 returnRn (IEThingAbs n)
818 to_ie (AvailTC n ns) = getInterfaceExports (moduleName (nameModule n))
819 ImportBySystem `thenRn` \ (_, avails) ->
820 case [ms | AvailTC m ms <- avails, m == n] of
821 [ms] | all (`elem` ns) ms -> returnRn (IEThingAll n)
822 | otherwise -> returnRn (IEThingWith n (filter (/= n) ns))
823 other -> pprTrace "to_ie" (ppr n <+> ppr (nameModule n) <+> ppr other) $
826 rnDump :: [RenamedHsDecl] -- Renamed imported decls
827 -> [RenamedHsDecl] -- Renamed local decls
829 rnDump imp_decls local_decls
830 | opt_D_dump_rn_trace ||
831 opt_D_dump_rn_stats ||
833 = getRnStats imp_decls `thenRn` \ stats_msg ->
835 returnRn (printErrs stats_msg >>
836 dumpIfSet opt_D_dump_rn "Renamer:"
837 (vcat (map ppr (local_decls ++ imp_decls))))
839 | otherwise = returnRn (return ())
843 %*********************************************************
845 \subsection{Statistics}
847 %*********************************************************
850 getRnStats :: [RenamedHsDecl] -> RnMG SDoc
851 getRnStats imported_decls
852 = getIfacesRn `thenRn` \ ifaces ->
854 n_mods = length [() | (_, _, Just _) <- eltsFM (iImpModInfo ifaces)]
856 decls_read = [decl | (_, avail, True, (_,decl)) <- nameEnvElts (iDecls ifaces),
857 -- Data, newtype, and class decls are in the decls_fm
858 -- under multiple names; the tycon/class, and each
859 -- constructor/class op too.
860 -- The 'True' selects just the 'main' decl
861 not (isLocallyDefined (availName avail))
864 (cd_rd, dd_rd, nd_rd, sd_rd, vd_rd, _) = count_decls decls_read
865 (cd_sp, dd_sp, nd_sp, sd_sp, vd_sp, id_sp) = count_decls imported_decls
867 unslurped_insts = iInsts ifaces
868 inst_decls_unslurped = length (bagToList unslurped_insts)
869 inst_decls_read = id_sp + inst_decls_unslurped
872 [int n_mods <+> text "interfaces read",
873 hsep [ int cd_sp, text "class decls imported, out of",
874 int cd_rd, text "read"],
875 hsep [ int dd_sp, text "data decls imported, out of",
876 int dd_rd, text "read"],
877 hsep [ int nd_sp, text "newtype decls imported, out of",
878 int nd_rd, text "read"],
879 hsep [int sd_sp, text "type synonym decls imported, out of",
880 int sd_rd, text "read"],
881 hsep [int vd_sp, text "value signatures imported, out of",
882 int vd_rd, text "read"],
883 hsep [int id_sp, text "instance decls imported, out of",
884 int inst_decls_read, text "read"],
885 text "cls dcls slurp" <+> fsep (map (ppr . tyClDeclName)
886 [d | TyClD d <- imported_decls, isClassDecl d]),
887 text "cls dcls read" <+> fsep (map (ppr . tyClDeclName)
888 [d | TyClD d <- decls_read, isClassDecl d])]
890 returnRn (hcat [text "Renamer stats: ", stats])
900 tycl_decls = [d | TyClD d <- decls]
901 (class_decls, data_decls, newtype_decls, syn_decls) = countTyClDecls tycl_decls
903 val_decls = length [() | SigD _ <- decls]
904 inst_decls = length [() | InstD _ <- decls]
908 %************************************************************************
910 \subsection{Errors and warnings}
912 %************************************************************************
915 warnDeprec :: (Name, DeprecTxt) -> RnM d ()
916 warnDeprec (name, txt)
917 = pushSrcLocRn (getSrcLoc name) $
919 sep [ text (occNameFlavour (nameOccName name)) <+> ppr name <+>
920 text "is deprecated:", nest 4 (ppr txt) ]
923 unusedFixityDecl rdr_name fixity
924 = hsep [ptext SLIT("Unused fixity declaration for"), quotes (ppr rdr_name)]
926 dupFixityDecl rdr_name loc1 loc2
927 = vcat [ptext SLIT("Multiple fixity declarations for") <+> quotes (ppr rdr_name),
928 ptext SLIT("at ") <+> ppr loc1,
929 ptext SLIT("and") <+> ppr loc2]