2 % (c) The GRASP Project, Glasgow University, 1992-1998
4 \section[Rename]{Renaming and dependency analysis passes}
7 module Rename ( renameModule ) where
9 #include "HsVersions.h"
12 import HsPragmas ( DataPragmas(..) )
13 import RdrHsSyn ( RdrNameHsModule, RdrNameHsDecl, RdrNameDeprecation )
14 import RnHsSyn ( RenamedHsModule, RenamedHsDecl,
15 extractHsTyNames, extractHsCtxtTyNames
18 import CmdLineOpts ( DynFlags, DynFlag(..) )
20 import Finder ( Finder )
21 import RnNames ( getGlobalNames )
22 import RnSource ( rnSourceDecls, rnDecl )
23 import RnIfaces ( getImportedInstDecls, importDecl, mkImportExportInfo,
25 getImportedRules, getSlurped, removeContext,
26 loadBuiltinRules, getDeferredDecls, ImportDeclResult(..)
28 import RnEnv ( availName, availsToNameSet,
29 emptyAvailEnv, unitAvailEnv, availEnvElts, plusAvailEnv,
30 warnUnusedImports, warnUnusedLocalBinds, warnUnusedModules,
31 lookupOrigNames, unknownNameErr,
32 FreeVars, plusFVs, plusFV, unitFV, emptyFVs, isEmptyFVs, addOneFV
34 import Module ( Module, ModuleName, WhereFrom(..),
35 moduleNameUserString, moduleName, mkModuleInThisPackage
37 import Name ( Name, isLocallyDefined, NamedThing(..), getSrcLoc,
38 nameOccName, nameUnique, nameModule,
39 -- 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 maybeWiredInTyConName, maybeWiredInIdName )
58 import Type ( namesOfType, funTyCon )
59 import ErrUtils ( printErrorsAndWarnings, dumpIfSet, ghcExit )
60 import BasicTypes ( Version, initialVersion )
61 import Bag ( isEmptyBag, bagToList )
62 import FiniteMap ( FiniteMap, eltsFM, fmToList, emptyFM, lookupFM,
63 addToFM_C, elemFM, addToFM
65 import UniqSupply ( UniqSupply )
66 import UniqFM ( lookupUFM )
67 import SrcLoc ( noSrcLoc )
68 import Maybes ( maybeToBool, expectJust )
70 import IO ( openFile, IOMode(..) )
71 import HscTypes ( PersistentCompilerState, HomeSymbolTable, GlobalRdrEnv,
72 AvailEnv, Avails, GenAvailInfo(..), AvailInfo,
73 Provenance(..), ImportReason(..) )
76 maybeUserImportedFrom = panic "maybeUserImportedFrom"
77 isUserImportedExplicitlyName = panic "isUserImportedExplicitlyName"
78 isUserImportedName = panic "isUserImportedName"
79 iDeprecs = panic "iDeprecs"
80 type FixityEnv = LocalFixityEnv
86 type RenameResult = ( PersistentCompilerState
87 , ModIface -- The mi_decls in here include
88 -- ones imported from packages too
91 renameModule :: DynFlags -> Finder
92 -> PersistentCompilerState -> HomeSymbolTable
93 -> RdrNameHsModule -> IO (Maybe RenameResult)
94 renameModule dflags finder old_pcs hst
95 this_mod@(HsModule mod_name vers exports imports local_decls _ loc)
96 = -- Initialise the renamer monad
98 ((maybe_rn_stuff, dump_action), (rn_warns_bag, rn_errs_bag), new_pcs)
99 <- initRn dflags finder old_pcs hst loc (rename this_mod) ;
101 -- Check for warnings
102 printErrorsAndWarnings (rn_warns_bag, rn_errs_bag) ;
104 -- Dump any debugging output
108 if not (isEmptyBag rn_errs_bag) then
109 return (old_pcs, Nothing)
111 return (new_pcs, maybe_rn_stuff)
116 rename :: RdrNameHsModule -> RnMG (Maybe RenameResult, IO ())
117 rename this_mod@(HsModule mod_name vers exports imports local_decls mod_deprec loc)
118 = -- FIND THE GLOBAL NAME ENVIRONMENT
119 getGlobalNames this_mod `thenRn` \ maybe_stuff ->
121 -- CHECK FOR EARLY EXIT
122 case maybe_stuff of {
123 Nothing -> -- Everything is up to date; no need to recompile further
124 rnDump [] [] `thenRn` \ dump_action ->
125 returnRn (Nothing, dump_action) ;
127 Just (gbl_env, local_gbl_env, export_avails, global_avail_env, old_iface) ->
129 -- DEAL WITH DEPRECATIONS
130 rnDeprecs local_gbl_env mod_deprec local_decls `thenRn` \ my_deprecs ->
132 -- DEAL WITH LOCAL FIXITIES
133 fixitiesFromLocalDecls local_gbl_env local_decls `thenRn` \ local_fixity_env ->
136 initRnMS gbl_env local_fixity_env SourceMode (
137 rnSourceDecls local_decls
138 ) `thenRn` \ (rn_local_decls, source_fvs) ->
140 -- SLURP IN ALL THE NEEDED DECLARATIONS
141 implicitFVs mod_name rn_local_decls `thenRn` \ implicit_fvs ->
143 -- The export_fvs make the exported names look just as if they
144 -- occurred in the source program. For the reasoning, see the
145 -- comments with RnIfaces.getImportVersions.
146 -- We only need the 'parent name' of the avail;
147 -- that's enough to suck in the declaration.
148 export_fvs = mkNameSet (map availName export_avails)
149 real_source_fvs = source_fvs `plusFV` export_fvs
151 slurp_fvs = implicit_fvs `plusFV` real_source_fvs
152 -- It's important to do the "plus" this way round, so that
153 -- when compiling the prelude, locally-defined (), Bool, etc
154 -- override the implicit ones.
156 loadBuiltinRules builtinRules `thenRn_`
157 slurpImpDecls slurp_fvs `thenRn` \ rn_imp_decls ->
159 -- EXIT IF ERRORS FOUND
160 rnDump rn_imp_decls rn_local_decls `thenRn` \ dump_action ->
161 checkErrsRn `thenRn` \ no_errs_so_far ->
162 if not no_errs_so_far then
163 -- Found errors already, so exit now
164 returnRn (Nothing, dump_action)
167 -- GENERATE THE VERSION/USAGE INFO
168 mkImportExportInfo mod_name export_avails exports `thenRn` \ (my_exports, my_usages) ->
170 -- RETURN THE RENAMED MODULE
171 getNameSupplyRn `thenRn` \ name_supply ->
172 getIfacesRn `thenRn` \ ifaces ->
174 direct_import_mods :: [Module]
175 direct_import_mods = [m | (_, _, Just (m, _, _, _, imp, _))
176 <- eltsFM (iImpModInfo ifaces), user_import imp]
178 -- *don't* just pick the forward edges. It's entirely possible
179 -- that a module is only reachable via back edges.
180 user_import ImportByUser = True
181 user_import ImportByUserSource = True
182 user_import _ = False
184 this_module = mkModuleInThisPackage mod_name
186 -- Export only those fixities that are for names that are
187 -- (a) defined in this module
190 = [ FixitySig (toRdrName name) fixity loc
191 | FixitySig name fixity loc <- nameEnvElts local_fixity_env,
192 isUserExportedName name
195 new_iface = ParsedIface { pi_mod = this_module
196 , pi_vers = initialVersion
197 , pi_orphan = any isOrphanDecl rn_local_decls
198 , pi_exports = my_exports
199 , pi_usages = my_usages
200 , pi_fixity = (initialVersion, exported_fixities)
201 , pi_deprecs = my_deprecs
202 -- These ones get filled in later
203 , pi_insts = [], pi_decls = []
204 , pi_rules = (initialVersion, [])
207 renamed_module = HsModule mod_name vers
208 trashed_exports trashed_imports
209 (rn_local_decls ++ rn_imp_decls)
213 result = (this_module, renamed_module,
214 old_iface, new_iface,
215 name_supply, local_fixity_env,
219 -- REPORT UNUSED NAMES, AND DEBUG DUMP
220 reportUnusedNames mod_name direct_import_mods
221 gbl_env global_avail_env
222 export_avails source_fvs
223 rn_imp_decls `thenRn_`
225 returnRn (Just result, dump_action) }
227 trashed_exports = {-trace "rnSource:trashed_exports"-} Nothing
228 trashed_imports = {-trace "rnSource:trashed_imports"-} []
231 @implicitFVs@ forces the renamer to slurp in some things which aren't
232 mentioned explicitly, but which might be needed by the type checker.
235 implicitFVs mod_name decls
236 = lookupOrigNames implicit_occs `thenRn` \ implicit_names ->
237 returnRn (mkNameSet (map getName default_tycons) `plusFV`
240 -- Add occurrences for Int, and (), because they
241 -- are the types to which ambigious type variables may be defaulted by
242 -- the type checker; so they won't always appear explicitly.
243 -- [The () one is a GHC extension for defaulting CCall results.]
244 -- ALSO: funTyCon, since it occurs implicitly everywhere!
245 -- (we don't want to be bothered with making funTyCon a
246 -- free var at every function application!)
247 -- Double is dealt with separately in getGates
248 default_tycons = [unitTyCon, funTyCon, boolTyCon, intTyCon]
250 -- Add occurrences for IO or PrimIO
251 implicit_main | mod_name == mAIN_Name
252 || mod_name == pREL_MAIN_Name = [ioTyCon_RDR]
255 -- Now add extra "occurrences" for things that
256 -- the deriving mechanism, or defaulting, will later need in order to
258 implicit_occs = string_occs ++ foldr ((++) . get) implicit_main decls
260 -- Virtually every program has error messages in it somewhere
261 string_occs = [unpackCString_RDR, unpackCStringFoldr_RDR, unpackCStringUtf8_RDR,
264 get (TyClD (TyData _ _ _ _ _ _ (Just deriv_classes) _ _ _ _))
265 = concat (map get_deriv deriv_classes)
268 get_deriv cls = case lookupUFM derivingOccurrences cls of
274 isOrphanDecl (InstD (InstDecl inst_ty _ _ _ _))
275 = not (foldNameSet ((||) . isLocallyDefined) False (extractHsTyNames (removeContext inst_ty)))
276 -- The 'removeContext' is because of
277 -- instance Foo a => Baz T where ...
278 -- The decl is an orphan if Baz and T are both not locally defined,
279 -- even if Foo *is* locally defined
281 isOrphanDecl (RuleD (HsRule _ _ _ lhs _ _))
284 -- At the moment we just check for common LHS forms
285 -- Expand as necessary. Getting it wrong just means
286 -- more orphans than necessary
287 check (HsVar v) = not (isLocallyDefined v)
288 check (HsApp f a) = check f && check a
289 check (HsLit _) = False
290 check (HsOverLit _) = False
291 check (OpApp l o _ r) = check l && check o && check r
292 check (NegApp e _) = check e
293 check (HsPar e) = check e
294 check (SectionL e o) = check e && check o
295 check (SectionR o e) = check e && check o
297 check other = True -- Safe fall through
299 isOrphanDecl other = False
304 dupDefaultDeclErrRn (DefaultDecl _ locn1 : dup_things)
305 = pushSrcLocRn locn1 $
308 msg = hang (ptext SLIT("Multiple default declarations"))
309 4 (vcat (map pp dup_things))
310 pp (DefaultDecl _ locn) = ptext SLIT("here was another default declaration") <+> ppr locn
314 %*********************************************************
316 \subsection{Slurping declarations}
318 %*********************************************************
321 -------------------------------------------------------
322 slurpImpDecls source_fvs
323 = traceRn (text "slurpImp" <+> fsep (map ppr (nameSetToList source_fvs))) `thenRn_`
325 -- The current slurped-set records all local things
326 getSlurped `thenRn` \ source_binders ->
327 slurpSourceRefs source_binders source_fvs `thenRn` \ (decls, needed) ->
329 -- Then get everything else
330 closeDecls decls needed `thenRn` \ decls1 ->
332 -- Finally, get any deferred data type decls
333 slurpDeferredDecls decls1 `thenRn` \ final_decls ->
337 -------------------------------------------------------
338 slurpSourceRefs :: NameSet -- Variables defined in source
339 -> FreeVars -- Variables referenced in source
340 -> RnMG ([RenamedHsDecl],
341 FreeVars) -- Un-satisfied needs
342 -- The declaration (and hence home module) of each gate has
343 -- already been loaded
345 slurpSourceRefs source_binders source_fvs
346 = go_outer [] -- Accumulating decls
347 emptyFVs -- Unsatisfied needs
348 emptyFVs -- Accumulating gates
349 (nameSetToList source_fvs) -- Things whose defn hasn't been loaded yet
351 -- The outer loop repeatedly slurps the decls for the current gates
352 -- and the instance decls
354 -- The outer loop is needed because consider
355 -- instance Foo a => Baz (Maybe a) where ...
356 -- It may be that @Baz@ and @Maybe@ are used in the source module,
357 -- but not @Foo@; so we need to chase @Foo@ too.
359 -- We also need to follow superclass refs. In particular, 'chasing @Foo@' must
360 -- include actually getting in Foo's class decl
361 -- class Wib a => Foo a where ..
362 -- so that its superclasses are discovered. The point is that Wib is a gate too.
363 -- We do this for tycons too, so that we look through type synonyms.
365 go_outer decls fvs all_gates []
366 = returnRn (decls, fvs)
368 go_outer decls fvs all_gates refs -- refs are not necessarily slurped yet
369 = traceRn (text "go_outer" <+> ppr refs) `thenRn_`
370 foldlRn go_inner (decls, fvs, emptyFVs) refs `thenRn` \ (decls1, fvs1, gates1) ->
371 getImportedInstDecls (all_gates `plusFV` gates1) `thenRn` \ inst_decls ->
372 rnInstDecls decls1 fvs1 gates1 inst_decls `thenRn` \ (decls2, fvs2, gates2) ->
373 go_outer decls2 fvs2 (all_gates `plusFV` gates2)
374 (nameSetToList (gates2 `minusNameSet` all_gates))
375 -- Knock out the all_gates because even if we don't slurp any new
376 -- decls we can get some apparently-new gates from wired-in names
378 go_inner (decls, fvs, gates) wanted_name
379 = importDecl wanted_name `thenRn` \ import_result ->
380 case import_result of
381 AlreadySlurped -> returnRn (decls, fvs, gates)
382 WiredIn -> returnRn (decls, fvs, gates `plusFV` getWiredInGates wanted_name)
383 Deferred -> returnRn (decls, fvs, gates `addOneFV` wanted_name) -- It's a type constructor
385 HereItIs decl -> rnIfaceDecl decl `thenRn` \ (new_decl, fvs1) ->
386 returnRn (new_decl : decls,
388 gates `plusFV` getGates source_fvs new_decl)
390 rnInstDecls decls fvs gates []
391 = returnRn (decls, fvs, gates)
392 rnInstDecls decls fvs gates (d:ds)
393 = rnIfaceDecl d `thenRn` \ (new_decl, fvs1) ->
394 rnInstDecls (new_decl:decls)
396 (gates `plusFV` getInstDeclGates new_decl)
402 -------------------------------------------------------
403 -- closeDecls keeps going until the free-var set is empty
404 closeDecls decls needed
405 | not (isEmptyFVs needed)
406 = slurpDecls decls needed `thenRn` \ (decls1, needed1) ->
407 closeDecls decls1 needed1
410 = getImportedRules `thenRn` \ rule_decls ->
412 [] -> returnRn decls -- No new rules, so we are done
413 other -> rnIfaceDecls decls emptyFVs rule_decls `thenRn` \ (decls1, needed1) ->
414 closeDecls decls1 needed1
417 -------------------------------------------------------
418 -- Augment decls with any decls needed by needed.
419 -- Return also free vars of the new decls (only)
420 slurpDecls decls needed
421 = go decls emptyFVs (nameSetToList needed)
423 go decls fvs [] = returnRn (decls, fvs)
424 go decls fvs (ref:refs) = slurpDecl decls fvs ref `thenRn` \ (decls1, fvs1) ->
427 -------------------------------------------------------
428 slurpDecl decls fvs wanted_name
429 = importDecl wanted_name `thenRn` \ import_result ->
430 case import_result of
431 -- Found a declaration... rename it
432 HereItIs decl -> rnIfaceDecl decl `thenRn` \ (new_decl, fvs1) ->
433 returnRn (new_decl:decls, fvs1 `plusFV` fvs)
435 -- No declaration... (wired in thing, or deferred, or already slurped)
436 other -> returnRn (decls, fvs)
439 -------------------------------------------------------
440 rnIfaceDecls :: [RenamedHsDecl] -> FreeVars
441 -> [(Module, RdrNameHsDecl)]
442 -> RnM d ([RenamedHsDecl], FreeVars)
443 rnIfaceDecls decls fvs [] = returnRn (decls, fvs)
444 rnIfaceDecls decls fvs (d:ds) = rnIfaceDecl d `thenRn` \ (new_decl, fvs1) ->
445 rnIfaceDecls (new_decl:decls) (fvs1 `plusFV` fvs) ds
447 rnIfaceDecl (mod, decl) = initIfaceRnMS mod (rnDecl decl)
451 %*********************************************************
453 \subsection{Deferred declarations}
455 %*********************************************************
457 The idea of deferred declarations is this. Suppose we have a function
462 Then we don't want to load T and all its constructors, and all
463 the types those constructors refer to, and all the types *those*
464 constructors refer to, and so on. That might mean loading many more
465 interface files than is really necessary. So we 'defer' loading T.
467 But f might be strict, and the calling convention for evaluating
468 values of type T depends on how many constructors T has, so
469 we do need to load T, but not the full details of the type T.
470 So we load the full decl for T, but only skeleton decls for A and B:
472 data T = {- 2 constructors -}
474 Whether all this is worth it is moot.
477 slurpDeferredDecls :: [RenamedHsDecl] -> RnMG [RenamedHsDecl]
478 slurpDeferredDecls decls
479 = getDeferredDecls `thenRn` \ def_decls ->
480 rnIfaceDecls decls emptyFVs (map stripDecl def_decls) `thenRn` \ (decls1, fvs) ->
481 ASSERT( isEmptyFVs fvs )
484 stripDecl (mod, TyClD (TyData dt _ tc tvs _ nconstrs _ _ loc name1 name2))
485 = (mod, TyClD (TyData dt [] tc tvs [] nconstrs Nothing NoDataPragmas loc
487 -- Nuke the context and constructors
488 -- But retain the *number* of constructors!
489 -- Also the tvs will have kinds on them.
493 %*********************************************************
495 \subsection{Extracting the `gates'}
497 %*********************************************************
499 When we import a declaration like
501 data T = T1 Wibble | T2 Wobble
503 we don't want to treat @Wibble@ and @Wobble@ as gates
504 {\em unless} @T1@, @T2@ respectively are mentioned by the user program.
505 If only @T@ is mentioned
506 we want only @T@ to be a gate;
507 that way we don't suck in useless instance
508 decls for (say) @Eq Wibble@, when they can't possibly be useful.
510 @getGates@ takes a newly imported (and renamed) decl, and the free
511 vars of the source program, and extracts from the decl the gate names.
514 getGates source_fvs (SigD (IfaceSig _ ty _ _))
515 = extractHsTyNames ty
517 getGates source_fvs (TyClD (ClassDecl ctxt cls tvs _ sigs _ _ _ _ ))
518 = (delListFromNameSet (foldr (plusFV . get) (extractHsCtxtTyNames ctxt) sigs)
520 `addOneToNameSet` cls)
521 `plusFV` maybe_double
523 get (ClassOpSig n _ ty _)
524 | n `elemNameSet` source_fvs = extractHsTyNames ty
525 | otherwise = emptyFVs
527 -- If we load any numeric class that doesn't have
528 -- Int as an instance, add Double to the gates.
529 -- This takes account of the fact that Double might be needed for
530 -- defaulting, but we don't want to load Double (and all its baggage)
531 -- if the more exotic classes aren't used at all.
532 maybe_double | nameUnique cls `elem` fractionalClassKeys
533 = unitFV (getName doubleTyCon)
537 getGates source_fvs (TyClD (TySynonym tycon tvs ty _))
538 = delListFromNameSet (extractHsTyNames ty)
540 -- A type synonym type constructor isn't a "gate" for instance decls
542 getGates source_fvs (TyClD (TyData _ ctxt tycon tvs cons _ _ _ _ _ _))
543 = delListFromNameSet (foldr (plusFV . get) (extractHsCtxtTyNames ctxt) cons)
545 `addOneToNameSet` tycon
547 get (ConDecl n _ tvs ctxt details _)
548 | n `elemNameSet` source_fvs
549 -- If the constructor is method, get fvs from all its fields
550 = delListFromNameSet (get_details details `plusFV`
551 extractHsCtxtTyNames ctxt)
553 get (ConDecl n _ tvs ctxt (RecCon fields) _)
554 -- Even if the constructor isn't mentioned, the fields
555 -- might be, as selectors. They can't mention existentially
556 -- bound tyvars (typechecker checks for that) so no need for
557 -- the deleteListFromNameSet part
558 = foldr (plusFV . get_field) emptyFVs fields
560 get other_con = emptyFVs
562 get_details (VanillaCon tys) = plusFVs (map get_bang tys)
563 get_details (InfixCon t1 t2) = get_bang t1 `plusFV` get_bang t2
564 get_details (RecCon fields) = plusFVs [get_bang t | (_, t) <- fields]
566 get_field (fs,t) | any (`elemNameSet` source_fvs) fs = get_bang t
567 | otherwise = emptyFVs
569 get_bang bty = extractHsTyNames (getBangType bty)
571 getGates source_fvs other_decl = emptyFVs
574 @getWiredInGates@ is just like @getGates@, but it sees a wired-in @Name@
575 rather than a declaration.
578 getWiredInGates :: Name -> FreeVars
579 getWiredInGates name -- No classes are wired in
580 | is_id = getWiredInGates_s (namesOfType (idType the_id))
581 | isSynTyCon the_tycon = getWiredInGates_s
582 (delListFromNameSet (namesOfType ty) (map getName tyvars))
583 | otherwise = unitFV name
585 maybe_wired_in_id = maybeWiredInIdName name
586 is_id = maybeToBool maybe_wired_in_id
587 maybe_wired_in_tycon = maybeWiredInTyConName name
588 Just the_id = maybe_wired_in_id
589 Just the_tycon = maybe_wired_in_tycon
590 (tyvars,ty) = getSynTyConDefn the_tycon
592 getWiredInGates_s names = foldr (plusFV . getWiredInGates) emptyFVs (nameSetToList names)
596 getInstDeclGates (InstD (InstDecl inst_ty _ _ _ _)) = extractHsTyNames inst_ty
597 getInstDeclGates other = emptyFVs
601 %*********************************************************
603 \subsection{Fixities}
605 %*********************************************************
608 fixitiesFromLocalDecls :: GlobalRdrEnv -> [RdrNameHsDecl] -> RnMG FixityEnv
609 fixitiesFromLocalDecls gbl_env decls
610 = doptRn Opt_WarnUnusedBinds `thenRn` \ warn_unused ->
611 foldlRn (getFixities warn_unused) emptyNameEnv decls `thenRn` \ env ->
612 traceRn (text "fixity env" <+> vcat (map ppr (nameEnvElts env)))
616 getFixities :: Bool -> FixityEnv -> RdrNameHsDecl -> RnMG FixityEnv
617 getFixities warn_uu acc (FixD fix)
618 = fix_decl warn_uu acc fix
620 getFixities warn_uu acc (TyClD (ClassDecl _ _ _ _ sigs _ _ _ _ ))
621 = foldlRn (fix_decl warn_uu) acc [sig | FixSig sig <- sigs]
622 -- Get fixities from class decl sigs too.
623 getFixities warn_uu acc other_decl
626 fix_decl warn_uu acc sig@(FixitySig rdr_name fixity loc)
627 = -- Check for fixity decl for something not declared
628 case lookupRdrEnv gbl_env rdr_name of {
630 -> pushSrcLocRn loc (addWarnRn (unusedFixityDecl rdr_name fixity))
631 `thenRn_` returnRn acc
632 | otherwise -> returnRn acc ;
636 -- Check for duplicate fixity decl
637 case lookupNameEnv acc name of {
638 Just (FixitySig _ _ loc') -> addErrRn (dupFixityDecl rdr_name loc loc')
639 `thenRn_` returnRn acc ;
641 Nothing -> returnRn (extendNameEnv acc name (FixitySig name fixity loc))
646 %*********************************************************
648 \subsection{Deprecations}
650 %*********************************************************
652 For deprecations, all we do is check that the names are in scope.
653 It's only imported deprecations, dealt with in RnIfaces, that we
654 gather them together.
657 rnDeprecs :: GlobalRdrEnv -> Maybe DeprecTxt
658 -> [RdrNameHsDecl] -> RnMG [RdrNameDeprecation]
659 rnDeprecs gbl_env mod_deprec decls
660 = mapRn rn_deprec deprecs `thenRn_`
661 returnRn (extra_deprec ++ deprecs)
663 deprecs = [d | DeprecD d <- decls]
664 extra_deprec = case mod_deprec of
666 Just txt -> [Deprecation (IEModuleContents undefined) txt noSrcLoc]
668 rn_deprec (Deprecation ie txt loc)
670 mapRn check (ieNames ie)
672 check n = case lookupRdrEnv gbl_env n of
673 Nothing -> addErrRn (unknownNameErr n)
674 Just _ -> returnRn ()
678 %*********************************************************
680 \subsection{Unused names}
682 %*********************************************************
685 reportUnusedNames :: ModuleName -> [Module]
686 -> GlobalRdrEnv -> AvailEnv
687 -> Avails -> NameSet -> [RenamedHsDecl]
689 reportUnusedNames mod_name direct_import_mods
691 export_avails mentioned_names
694 used_names = mentioned_names `unionNameSets` availsToNameSet export_avails
696 -- Now, a use of C implies a use of T,
697 -- if C was brought into scope by T(..) or T(C)
698 really_used_names = used_names `unionNameSets`
699 mkNameSet [ availName parent_avail
700 | sub_name <- nameSetToList used_names
701 , isValOcc (getOccName sub_name)
703 -- Usually, every used name will appear in avail_env, but there
704 -- is one time when it doesn't: tuples and other built in syntax. When you
705 -- write (a,b) that gives rise to a *use* of "(,)", so that the
706 -- instances will get pulled in, but the tycon "(,)" isn't actually
707 -- in scope. Hence the isValOcc filter.
709 -- Also, (-x) gives rise to an implicit use of 'negate'; similarly,
710 -- 3.5 gives rise to an implcit use of :%
711 -- hence the isUserImportedName filter on the warning
714 = case lookupNameEnv avail_env sub_name of
716 Nothing -> WARN( isUserImportedName sub_name,
717 text "reportUnusedName: not in avail_env" <+>
721 , case parent_avail of { AvailTC _ _ -> True; other -> False }
724 defined_names, defined_but_not_used :: [(Name,Provenance)]
725 defined_names = concat (rdrEnvElts gbl_env)
726 defined_but_not_used = filter not_used defined_names
727 not_used name = not (name `elemNameSet` really_used_names)
729 -- Filter out the ones only defined implicitly
731 bad_locals = [n | (n,LocalDef) <- defined_but_not_used]
733 bad_imp_names :: [(Name,Provenance)]
734 bad_imp_names = [(n,p) | (n,p@(UserImport mod _ True)) <- defined_but_not_used,
735 not (module_unused mod)]
737 deprec_used deprec_env = [ (n,txt)
738 | n <- nameSetToList mentioned_names,
739 not (isLocallyDefined n),
740 Just txt <- [lookupNameEnv deprec_env n] ]
742 -- inst_mods are directly-imported modules that
743 -- contain instance decl(s) that the renamer decided to suck in
744 -- It's not necessarily redundant to import such modules.
750 -- The import M() is not *necessarily* redundant, even if
751 -- we suck in no instance decls from M (e.g. it contains
752 -- no instance decls, or This contains no code). It may be
753 -- that we import M solely to ensure that M's orphan instance
754 -- decls (or those in its imports) are visible to people who
755 -- import This. Sigh.
756 -- There's really no good way to detect this, so the error message
757 -- in RnEnv.warnUnusedModules is weakened instead
758 inst_mods = [m | InstD (InstDecl _ _ _ (Just dfun) _) <- imported_decls,
759 let m = nameModule dfun,
760 m `elem` direct_import_mods
763 minimal_imports :: FiniteMap Module AvailEnv
764 minimal_imports0 = emptyFM
765 minimal_imports1 = foldNameSet add_name minimal_imports0 really_used_names
766 minimal_imports = foldr add_inst_mod minimal_imports1 inst_mods
768 add_name n acc = case maybeUserImportedFrom n of
770 Just m -> addToFM_C plusAvailEnv acc m
771 (unitAvailEnv (mk_avail n))
773 | m `elemFM` acc = acc -- We import something already
774 | otherwise = addToFM acc m emptyAvailEnv
775 -- Add an empty collection of imports for a module
776 -- from which we have sucked only instance decls
778 mk_avail n = case lookupNameEnv avail_env n of
779 Just (AvailTC m _) | n==m -> AvailTC n [n]
780 | otherwise -> AvailTC m [n,m]
781 Just avail -> Avail n
782 Nothing -> pprPanic "mk_avail" (ppr n)
784 -- unused_imp_mods are the directly-imported modules
785 -- that are not mentioned in minimal_imports
786 unused_imp_mods = [m | m <- direct_import_mods,
787 not (maybeToBool (lookupFM minimal_imports m)),
788 moduleName m /= pRELUDE_Name]
790 module_unused :: Module -> Bool
791 module_unused mod = mod `elem` unused_imp_mods
794 warnUnusedModules unused_imp_mods `thenRn_`
795 warnUnusedLocalBinds bad_locals `thenRn_`
796 warnUnusedImports bad_imp_names `thenRn_`
797 printMinimalImports mod_name minimal_imports `thenRn_`
798 getIfacesRn `thenRn` \ ifaces ->
799 doptRn Opt_WarnDeprecations `thenRn` \ warn_drs ->
801 then mapRn_ warnDeprec (deprec_used (iDeprecs ifaces))
804 -- ToDo: deal with original imports with 'qualified' and 'as M' clauses
805 printMinimalImports mod_name imps
806 = doptRn Opt_D_dump_minimal_imports `thenRn` \ dump_minimal ->
807 printMinimalImports_wrk dump_minimal mod_name imps
809 printMinimalImports_wrk dump_minimal mod_name imps
813 = mapRn to_ies (fmToList imps) `thenRn` \ mod_ies ->
814 ioToRnM (do { h <- openFile filename WriteMode ;
815 printForUser h (vcat (map ppr_mod_ie mod_ies))
819 filename = moduleNameUserString mod_name ++ ".imports"
820 ppr_mod_ie (mod_name, ies)
821 | mod_name == pRELUDE_Name
824 = ptext SLIT("import") <+> ppr mod_name <>
825 parens (fsep (punctuate comma (map ppr ies)))
827 to_ies (mod, avail_env) = mapRn to_ie (availEnvElts avail_env) `thenRn` \ ies ->
828 returnRn (moduleName mod, ies)
830 to_ie :: AvailInfo -> RnMG (IE Name)
831 to_ie (Avail n) = returnRn (IEVar n)
832 to_ie (AvailTC n [m]) = ASSERT( n==m )
833 returnRn (IEThingAbs n)
834 to_ie (AvailTC n ns) = getInterfaceExports (moduleName (nameModule n))
835 ImportBySystem `thenRn` \ (_, avails) ->
836 case [ms | AvailTC m ms <- avails, m == n] of
837 [ms] | all (`elem` ns) ms -> returnRn (IEThingAll n)
838 | otherwise -> returnRn (IEThingWith n (filter (/= n) ns))
839 other -> pprTrace "to_ie" (ppr n <+> ppr (nameModule n) <+> ppr other) $
842 rnDump :: [RenamedHsDecl] -- Renamed imported decls
843 -> [RenamedHsDecl] -- Renamed local decls
845 rnDump imp_decls local_decls
846 = doptRn Opt_D_dump_rn_trace `thenRn` \ dump_rn_trace ->
847 doptRn Opt_D_dump_rn_stats `thenRn` \ dump_rn_stats ->
848 doptRn Opt_D_dump_rn `thenRn` \ dump_rn ->
849 if dump_rn_trace || dump_rn_stats || dump_rn then
850 getRnStats imp_decls `thenRn` \ stats_msg ->
851 returnRn (printErrs stats_msg >>
852 dumpIfSet dump_rn "Renamer:"
853 (vcat (map ppr (local_decls ++ imp_decls))))
859 %*********************************************************
861 \subsection{Statistics}
863 %*********************************************************
866 getRnStats :: [RenamedHsDecl] -> RnMG SDoc
867 getRnStats imported_decls
868 = getIfacesRn `thenRn` \ ifaces ->
870 n_mods = length [() | (_, _, Just _) <- eltsFM (iImpModInfo ifaces)]
872 decls_read = [decl | (_, avail, True, (_,decl)) <- nameEnvElts (iDecls ifaces),
873 -- Data, newtype, and class decls are in the decls_fm
874 -- under multiple names; the tycon/class, and each
875 -- constructor/class op too.
876 -- The 'True' selects just the 'main' decl
877 not (isLocallyDefined (availName avail))
880 (cd_rd, dd_rd, nd_rd, sd_rd, vd_rd, _) = count_decls decls_read
881 (cd_sp, dd_sp, nd_sp, sd_sp, vd_sp, id_sp) = count_decls imported_decls
883 unslurped_insts = iInsts ifaces
884 inst_decls_unslurped = length (bagToList unslurped_insts)
885 inst_decls_read = id_sp + inst_decls_unslurped
888 [int n_mods <+> text "interfaces read",
889 hsep [ int cd_sp, text "class decls imported, out of",
890 int cd_rd, text "read"],
891 hsep [ int dd_sp, text "data decls imported, out of",
892 int dd_rd, text "read"],
893 hsep [ int nd_sp, text "newtype decls imported, out of",
894 int nd_rd, text "read"],
895 hsep [int sd_sp, text "type synonym decls imported, out of",
896 int sd_rd, text "read"],
897 hsep [int vd_sp, text "value signatures imported, out of",
898 int vd_rd, text "read"],
899 hsep [int id_sp, text "instance decls imported, out of",
900 int inst_decls_read, text "read"],
901 text "cls dcls slurp" <+> fsep (map (ppr . tyClDeclName)
902 [d | TyClD d <- imported_decls, isClassDecl d]),
903 text "cls dcls read" <+> fsep (map (ppr . tyClDeclName)
904 [d | TyClD d <- decls_read, isClassDecl d])]
906 returnRn (hcat [text "Renamer stats: ", stats])
916 tycl_decls = [d | TyClD d <- decls]
917 (class_decls, data_decls, newtype_decls, syn_decls) = countTyClDecls tycl_decls
919 val_decls = length [() | SigD _ <- decls]
920 inst_decls = length [() | InstD _ <- decls]
924 %************************************************************************
926 \subsection{Errors and warnings}
928 %************************************************************************
931 warnDeprec :: (Name, DeprecTxt) -> RnM d ()
932 warnDeprec (name, txt)
933 = pushSrcLocRn (getSrcLoc name) $
935 sep [ text (occNameFlavour (nameOccName name)) <+> ppr name <+>
936 text "is deprecated:", nest 4 (ppr txt) ]
939 unusedFixityDecl rdr_name fixity
940 = hsep [ptext SLIT("Unused fixity declaration for"), quotes (ppr rdr_name)]
942 dupFixityDecl rdr_name loc1 loc2
943 = vcat [ptext SLIT("Multiple fixity declarations for") <+> quotes (ppr rdr_name),
944 ptext SLIT("at ") <+> ppr loc1,
945 ptext SLIT("and") <+> ppr loc2]