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 RdrHsSyn ( RdrNameHsModule, RdrNameHsDecl, RdrNameDeprecation,
13 RdrNameTyClDecl, RdrNameRuleDecl, RdrNameInstDecl
15 import RnHsSyn ( RenamedHsDecl, RenamedTyClDecl, RenamedRuleDecl, RenamedInstDecl,
16 extractHsTyNames, extractHsCtxtTyNames
19 import CmdLineOpts ( DynFlags, DynFlag(..) )
21 import RnNames ( getGlobalNames )
22 import RnSource ( rnSourceDecls, rnDecl, rnTyClDecl, rnRuleDecl, rnInstDecl )
23 import RnIfaces ( getImportedInstDecls, importDecl, mkImportInfo,
25 getImportedRules, getSlurped,
27 RecompileRequired, recompileRequired
29 import RnHiFiles ( findAndReadIface, removeContext, loadExports, loadFixDecls, loadDeprecs )
30 import RnEnv ( availName, availsToNameSet,
31 emptyAvailEnv, unitAvailEnv, availEnvElts, plusAvailEnv, sortAvails,
32 warnUnusedImports, warnUnusedLocalBinds, warnUnusedModules,
33 lookupOrigNames, lookupGlobalRn, newGlobalName,
34 FreeVars, plusFVs, plusFV, unitFV, emptyFVs, isEmptyFVs, addOneFV
36 import Module ( Module, ModuleName, WhereFrom(..),
37 moduleNameUserString, moduleName,
40 import Name ( Name, isLocallyDefined, NamedThing(..), getSrcLoc,
41 nameOccName, nameUnique, nameModule,
42 mkNameEnv, nameEnvElts, extendNameEnv
44 import OccName ( occNameFlavour )
46 import TyCon ( isSynTyCon, getSynTyConDefn )
48 import TysWiredIn ( unitTyCon, intTyCon, doubleTyCon, boolTyCon )
49 import PrelNames ( mAIN_Name, pREL_MAIN_Name, pRELUDE_Name,
51 unpackCString_RDR, unpackCStringFoldr_RDR, unpackCStringUtf8_RDR,
54 import PrelInfo ( fractionalClassKeys, derivingOccurrences, wiredInThingEnv )
55 import Type ( namesOfType, funTyCon )
56 import ErrUtils ( dumpIfSet )
57 import Bag ( bagToList )
58 import FiniteMap ( FiniteMap, eltsFM, fmToList, emptyFM, lookupFM,
59 addToFM_C, elemFM, addToFM
61 import UniqFM ( lookupUFM )
62 import Maybes ( maybeToBool, catMaybes )
64 import IO ( openFile, IOMode(..) )
65 import HscTypes ( Finder, PersistentCompilerState, HomeIfaceTable, HomeSymbolTable,
66 ModIface(..), TyThing(..), WhatsImported(..),
67 VersionInfo(..), ImportVersion, IfaceDecls(..),
68 GlobalRdrEnv, AvailEnv, Avails, GenAvailInfo(..), AvailInfo,
69 Provenance(..), ImportReason(..), initialVersionInfo,
70 Deprecations(..), lookupDeprec
72 import List ( partition, nub )
77 %*********************************************************
79 \subsection{The main function: rename}
81 %*********************************************************
84 renameModule :: DynFlags -> Finder
85 -> HomeIfaceTable -> HomeSymbolTable
86 -> PersistentCompilerState
87 -> Module -> RdrNameHsModule
88 -> IO (PersistentCompilerState, Maybe (ModIface, [RenamedHsDecl]))
89 -- Nothing => some error occurred in the renamer
91 renameModule dflags finder hit hst old_pcs this_module rdr_module
92 = -- Initialise the renamer monad
94 (new_pcs, errors_found, (maybe_rn_stuff, dump_action))
95 <- initRn dflags finder hit hst old_pcs this_module (rename this_module rdr_module) ;
97 -- Dump any debugging output
100 -- Return results. No harm in updating the PCS
102 return (new_pcs, Nothing)
104 return (new_pcs, maybe_rn_stuff)
109 rename :: Module -> RdrNameHsModule -> RnMG (Maybe (ModIface, [RenamedHsDecl]), IO ())
110 rename this_module this_mod@(HsModule mod_name vers exports imports local_decls mod_deprec loc)
111 = -- FIND THE GLOBAL NAME ENVIRONMENT
112 getGlobalNames this_mod `thenRn` \ maybe_stuff ->
114 -- CHECK FOR EARLY EXIT
115 case maybe_stuff of {
116 Nothing -> -- Everything is up to date; no need to recompile further
117 rnDump [] [] `thenRn` \ dump_action ->
118 returnRn (Nothing, dump_action) ;
120 Just (gbl_env, local_gbl_env, export_avails, global_avail_env) ->
122 -- DEAL WITH DEPRECATIONS
123 rnDeprecs local_gbl_env mod_deprec
124 [d | DeprecD d <- local_decls] `thenRn` \ my_deprecs ->
126 -- DEAL WITH LOCAL FIXITIES
127 fixitiesFromLocalDecls local_gbl_env local_decls `thenRn` \ local_fixity_env ->
130 initRnMS gbl_env local_fixity_env SourceMode (
131 rnSourceDecls local_decls
132 ) `thenRn` \ (rn_local_decls, source_fvs) ->
134 -- SLURP IN ALL THE NEEDED DECLARATIONS
135 implicitFVs mod_name rn_local_decls `thenRn` \ implicit_fvs ->
137 -- The export_fvs make the exported names look just as if they
138 -- occurred in the source program. For the reasoning, see the
139 -- comments with RnIfaces.getImportVersions.
140 -- We only need the 'parent name' of the avail;
141 -- that's enough to suck in the declaration.
142 export_fvs = mkNameSet (map availName export_avails)
143 real_source_fvs = source_fvs `plusFV` export_fvs
145 slurp_fvs = implicit_fvs `plusFV` real_source_fvs
146 -- It's important to do the "plus" this way round, so that
147 -- when compiling the prelude, locally-defined (), Bool, etc
148 -- override the implicit ones.
150 slurpImpDecls slurp_fvs `thenRn` \ rn_imp_decls ->
152 -- EXIT IF ERRORS FOUND
153 rnDump rn_imp_decls rn_local_decls `thenRn` \ dump_action ->
154 checkErrsRn `thenRn` \ no_errs_so_far ->
155 if not no_errs_so_far then
156 -- Found errors already, so exit now
157 returnRn (Nothing, dump_action)
160 -- GENERATE THE VERSION/USAGE INFO
161 mkImportInfo mod_name imports `thenRn` \ my_usages ->
163 -- RETURN THE RENAMED MODULE
164 getNameSupplyRn `thenRn` \ name_supply ->
165 getIfacesRn `thenRn` \ ifaces ->
167 direct_import_mods :: [ModuleName]
168 direct_import_mods = nub [m | ImportDecl m _ _ _ _ _ <- imports]
170 -- We record fixities even for things that aren't exported,
171 -- so that we can change into the context of this moodule easily
172 fixities = mkNameEnv [ (name, fixity)
173 | FixitySig name fixity loc <- nameEnvElts local_fixity_env
177 -- Sort the exports to make them easier to compare for versions
178 my_exports = sortAvails export_avails
180 mod_iface = ModIface { mi_module = this_module,
181 mi_version = initialVersionInfo,
182 mi_orphan = any isOrphanDecl rn_local_decls,
183 mi_exports = my_exports,
184 mi_globals = gbl_env,
185 mi_usages = my_usages,
186 mi_fixities = fixities,
187 mi_deprecs = my_deprecs,
188 mi_decls = panic "mi_decls"
191 final_decls = rn_local_decls ++ rn_imp_decls
194 -- REPORT UNUSED NAMES, AND DEBUG DUMP
195 reportUnusedNames mod_name direct_import_mods
196 gbl_env global_avail_env
197 export_avails source_fvs
198 rn_imp_decls `thenRn_`
200 returnRn (Just (mod_iface, final_decls), dump_action) }
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 = lookupOrigNames 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, unpackCStringFoldr_RDR, unpackCStringUtf8_RDR,
236 get (TyClD (TyData _ _ _ _ _ _ (Just deriv_classes) _ _ _))
237 = concat (map get_deriv deriv_classes)
240 get_deriv cls = case lookupUFM derivingOccurrences cls of
246 isOrphanDecl (InstD (InstDecl inst_ty _ _ _ _))
247 = not (foldNameSet ((||) . isLocallyDefined) False (extractHsTyNames (removeContext inst_ty)))
248 -- The 'removeContext' is because of
249 -- instance Foo a => Baz T where ...
250 -- The decl is an orphan if Baz and T are both not locally defined,
251 -- even if Foo *is* locally defined
253 isOrphanDecl (RuleD (HsRule _ _ _ lhs _ _))
256 -- At the moment we just check for common LHS forms
257 -- Expand as necessary. Getting it wrong just means
258 -- more orphans than necessary
259 check (HsVar v) = not (isLocallyDefined v)
260 check (HsApp f a) = check f && check a
261 check (HsLit _) = False
262 check (HsOverLit _) = False
263 check (OpApp l o _ r) = check l && check o && check r
264 check (NegApp e _) = check e
265 check (HsPar e) = check e
266 check (SectionL e o) = check e && check o
267 check (SectionR o e) = check e && check o
269 check other = True -- Safe fall through
271 isOrphanDecl other = False
275 %*********************************************************
277 \subsection{Slurping declarations}
279 %*********************************************************
282 -------------------------------------------------------
283 slurpImpDecls source_fvs
284 = traceRn (text "slurpImp" <+> fsep (map ppr (nameSetToList source_fvs))) `thenRn_`
286 -- The current slurped-set records all local things
287 getSlurped `thenRn` \ source_binders ->
288 slurpSourceRefs source_binders source_fvs `thenRn` \ (decls, needed) ->
290 -- Then get everything else
291 closeDecls decls needed `thenRn` \ decls1 ->
293 -- Finally, get any deferred data type decls
294 slurpDeferredDecls decls1 `thenRn` \ final_decls ->
298 -------------------------------------------------------
299 slurpSourceRefs :: NameSet -- Variables defined in source
300 -> FreeVars -- Variables referenced in source
301 -> RnMG ([RenamedHsDecl],
302 FreeVars) -- Un-satisfied needs
303 -- The declaration (and hence home module) of each gate has
304 -- already been loaded
306 slurpSourceRefs source_binders source_fvs
307 = go_outer [] -- Accumulating decls
308 emptyFVs -- Unsatisfied needs
309 emptyFVs -- Accumulating gates
310 (nameSetToList source_fvs) -- Things whose defn hasn't been loaded yet
312 -- The outer loop repeatedly slurps the decls for the current gates
313 -- and the instance decls
315 -- The outer loop is needed because consider
316 -- instance Foo a => Baz (Maybe a) where ...
317 -- It may be that @Baz@ and @Maybe@ are used in the source module,
318 -- but not @Foo@; so we need to chase @Foo@ too.
320 -- We also need to follow superclass refs. In particular, 'chasing @Foo@' must
321 -- include actually getting in Foo's class decl
322 -- class Wib a => Foo a where ..
323 -- so that its superclasses are discovered. The point is that Wib is a gate too.
324 -- We do this for tycons too, so that we look through type synonyms.
326 go_outer decls fvs all_gates []
327 = returnRn (decls, fvs)
329 go_outer decls fvs all_gates refs -- refs are not necessarily slurped yet
330 = traceRn (text "go_outer" <+> ppr refs) `thenRn_`
331 foldlRn go_inner (decls, fvs, emptyFVs) refs `thenRn` \ (decls1, fvs1, gates1) ->
332 getImportedInstDecls (all_gates `plusFV` gates1) `thenRn` \ inst_decls ->
333 rnInstDecls decls1 fvs1 gates1 inst_decls `thenRn` \ (decls2, fvs2, gates2) ->
334 go_outer decls2 fvs2 (all_gates `plusFV` gates2)
335 (nameSetToList (gates2 `minusNameSet` all_gates))
336 -- Knock out the all_gates because even if we don't slurp any new
337 -- decls we can get some apparently-new gates from wired-in names
339 go_inner (decls, fvs, gates) wanted_name
340 = importDecl wanted_name `thenRn` \ import_result ->
341 case import_result of
342 AlreadySlurped -> returnRn (decls, fvs, gates)
343 WiredIn -> returnRn (decls, fvs, gates `plusFV` getWiredInGates wanted_name)
344 Deferred -> returnRn (decls, fvs, gates `addOneFV` wanted_name) -- It's a type constructor
346 HereItIs decl -> rnIfaceTyClDecl decl `thenRn` \ (new_decl, fvs1) ->
347 returnRn (TyClD new_decl : decls,
349 gates `plusFV` getGates source_fvs new_decl)
351 rnInstDecls decls fvs gates []
352 = returnRn (decls, fvs, gates)
353 rnInstDecls decls fvs gates (d:ds)
354 = rnIfaceDecl d `thenRn` \ (new_decl, fvs1) ->
355 rnInstDecls (new_decl:decls)
357 (gates `plusFV` getInstDeclGates new_decl)
363 -------------------------------------------------------
364 -- closeDecls keeps going until the free-var set is empty
365 closeDecls decls needed
366 | not (isEmptyFVs needed)
367 = slurpDecls decls needed `thenRn` \ (decls1, needed1) ->
368 closeDecls decls1 needed1
371 = getImportedRules `thenRn` \ rule_decls ->
373 [] -> returnRn decls -- No new rules, so we are done
374 other -> rnIfaceDecls decls emptyFVs rule_decls `thenRn` \ (decls1, needed1) ->
375 closeDecls decls1 needed1
378 -------------------------------------------------------
379 -- Augment decls with any decls needed by needed.
380 -- Return also free vars of the new decls (only)
381 slurpDecls decls needed
382 = go decls emptyFVs (nameSetToList needed)
384 go decls fvs [] = returnRn (decls, fvs)
385 go decls fvs (ref:refs) = slurpDecl decls fvs ref `thenRn` \ (decls1, fvs1) ->
388 -------------------------------------------------------
389 slurpDecl decls fvs wanted_name
390 = importDecl wanted_name `thenRn` \ import_result ->
391 case import_result of
392 -- Found a declaration... rename it
393 HereItIs decl -> rnIfaceTyClDecl decl `thenRn` \ (new_decl, fvs1) ->
394 returnRn (TyClD new_decl:decls, fvs1 `plusFV` fvs)
396 -- No declaration... (wired in thing, or deferred, or already slurped)
397 other -> returnRn (decls, fvs)
400 -------------------------------------------------------
401 rnIfaceDecls :: [RenamedHsDecl] -> FreeVars
402 -> [(Module, RdrNameHsDecl)]
403 -> RnM d ([RenamedHsDecl], FreeVars)
404 rnIfaceDecls decls fvs [] = returnRn (decls, fvs)
405 rnIfaceDecls decls fvs (d:ds) = rnIfaceDecl d `thenRn` \ (new_decl, fvs1) ->
406 rnIfaceDecls (new_decl:decls) (fvs1 `plusFV` fvs) ds
408 rnIfaceDecl (mod, decl) = initIfaceRnMS mod (rnDecl decl)
409 rnIfaceTyClDecl (mod, decl) = initIfaceRnMS mod (rnTyClDecl decl)
413 %*********************************************************
415 \subsection{Deferred declarations}
417 %*********************************************************
419 The idea of deferred declarations is this. Suppose we have a function
424 Then we don't want to load T and all its constructors, and all
425 the types those constructors refer to, and all the types *those*
426 constructors refer to, and so on. That might mean loading many more
427 interface files than is really necessary. So we 'defer' loading T.
429 But f might be strict, and the calling convention for evaluating
430 values of type T depends on how many constructors T has, so
431 we do need to load T, but not the full details of the type T.
432 So we load the full decl for T, but only skeleton decls for A and B:
434 data T = {- 2 constructors -}
436 Whether all this is worth it is moot.
439 slurpDeferredDecls :: [RenamedHsDecl] -> RnMG [RenamedHsDecl]
440 slurpDeferredDecls decls = returnRn decls
443 slurpDeferredDecls :: [RenamedHsDecl] -> RnMG [RenamedHsDecl]
444 slurpDeferredDecls decls
445 = getDeferredDecls `thenRn` \ def_decls ->
446 rnIfaceDecls decls emptyFVs (map stripDecl def_decls) `thenRn` \ (decls1, fvs) ->
447 ASSERT( isEmptyFVs fvs )
450 stripDecl (mod, TyClD (TyData dt _ tc tvs _ nconstrs _ loc name1 name2))
451 = (mod, TyClD (TyData dt [] tc tvs [] nconstrs Nothing loc
453 -- Nuke the context and constructors
454 -- But retain the *number* of constructors!
455 -- Also the tvs will have kinds on them.
460 %*********************************************************
462 \subsection{Extracting the `gates'}
464 %*********************************************************
466 When we import a declaration like
468 data T = T1 Wibble | T2 Wobble
470 we don't want to treat @Wibble@ and @Wobble@ as gates
471 {\em unless} @T1@, @T2@ respectively are mentioned by the user program.
472 If only @T@ is mentioned
473 we want only @T@ to be a gate;
474 that way we don't suck in useless instance
475 decls for (say) @Eq Wibble@, when they can't possibly be useful.
477 @getGates@ takes a newly imported (and renamed) decl, and the free
478 vars of the source program, and extracts from the decl the gate names.
481 getGates source_fvs (IfaceSig _ ty _ _)
482 = extractHsTyNames ty
484 getGates source_fvs (ClassDecl ctxt cls tvs _ sigs _ _ _ )
485 = (delListFromNameSet (foldr (plusFV . get) (extractHsCtxtTyNames ctxt) sigs)
487 `addOneToNameSet` cls)
488 `plusFV` maybe_double
490 get (ClassOpSig n _ ty _)
491 | n `elemNameSet` source_fvs = extractHsTyNames ty
492 | otherwise = emptyFVs
494 -- If we load any numeric class that doesn't have
495 -- Int as an instance, add Double to the gates.
496 -- This takes account of the fact that Double might be needed for
497 -- defaulting, but we don't want to load Double (and all its baggage)
498 -- if the more exotic classes aren't used at all.
499 maybe_double | nameUnique cls `elem` fractionalClassKeys
500 = unitFV (getName doubleTyCon)
504 getGates source_fvs (TySynonym tycon tvs ty _)
505 = delListFromNameSet (extractHsTyNames ty)
507 -- A type synonym type constructor isn't a "gate" for instance decls
509 getGates source_fvs (TyData _ ctxt tycon tvs cons _ _ _ _ _)
510 = delListFromNameSet (foldr (plusFV . get) (extractHsCtxtTyNames ctxt) cons)
512 `addOneToNameSet` tycon
514 get (ConDecl n _ tvs ctxt details _)
515 | n `elemNameSet` source_fvs
516 -- If the constructor is method, get fvs from all its fields
517 = delListFromNameSet (get_details details `plusFV`
518 extractHsCtxtTyNames ctxt)
520 get (ConDecl n _ tvs ctxt (RecCon fields) _)
521 -- Even if the constructor isn't mentioned, the fields
522 -- might be, as selectors. They can't mention existentially
523 -- bound tyvars (typechecker checks for that) so no need for
524 -- the deleteListFromNameSet part
525 = foldr (plusFV . get_field) emptyFVs fields
527 get other_con = emptyFVs
529 get_details (VanillaCon tys) = plusFVs (map get_bang tys)
530 get_details (InfixCon t1 t2) = get_bang t1 `plusFV` get_bang t2
531 get_details (RecCon fields) = plusFVs [get_bang t | (_, t) <- fields]
533 get_field (fs,t) | any (`elemNameSet` source_fvs) fs = get_bang t
534 | otherwise = emptyFVs
536 get_bang bty = extractHsTyNames (getBangType bty)
539 @getWiredInGates@ is just like @getGates@, but it sees a wired-in @Name@
540 rather than a declaration.
543 getWiredInGates :: Name -> FreeVars
544 getWiredInGates name -- No classes are wired in
545 = case lookupNameEnv wiredInThingEnv name of
546 Just (AnId the_id) -> getWiredInGates_s (namesOfType (idType the_id))
550 -> getWiredInGates_s (delListFromNameSet (namesOfType ty) (map getName tyvars))
552 (tyvars,ty) = getSynTyConDefn tc
556 getWiredInGates_s names = foldr (plusFV . getWiredInGates) emptyFVs (nameSetToList names)
560 getInstDeclGates (InstD (InstDecl inst_ty _ _ _ _)) = extractHsTyNames inst_ty
561 getInstDeclGates other = emptyFVs
565 %*********************************************************
567 \subsection{Fixities}
569 %*********************************************************
572 fixitiesFromLocalDecls :: GlobalRdrEnv -> [RdrNameHsDecl] -> RnMG LocalFixityEnv
573 fixitiesFromLocalDecls gbl_env decls
574 = doptRn Opt_WarnUnusedBinds `thenRn` \ warn_unused ->
575 foldlRn (getFixities warn_unused) emptyNameEnv decls `thenRn` \ env ->
576 traceRn (text "fixity env" <+> vcat (map ppr (nameEnvElts env)))
580 getFixities :: Bool -> LocalFixityEnv -> RdrNameHsDecl -> RnMG LocalFixityEnv
581 getFixities warn_uu acc (FixD fix)
582 = fix_decl warn_uu acc fix
584 getFixities warn_uu acc (TyClD (ClassDecl _ _ _ _ sigs _ _ _ ))
585 = foldlRn (fix_decl warn_uu) acc [sig | FixSig sig <- sigs]
586 -- Get fixities from class decl sigs too.
587 getFixities warn_uu acc other_decl
590 fix_decl warn_uu acc sig@(FixitySig rdr_name fixity loc)
591 = -- Check for fixity decl for something not declared
593 lookupGlobalRn gbl_env rdr_name `thenRn` \ maybe_name ->
595 Nothing -> checkRn (not warn_uu) (unusedFixityDecl rdr_name fixity) `thenRn_`
600 -- Check for duplicate fixity decl
601 case lookupNameEnv acc name of {
602 Just (FixitySig _ _ loc') -> addErrRn (dupFixityDecl rdr_name loc loc')
603 `thenRn_` returnRn acc ;
605 Nothing -> returnRn (extendNameEnv acc name (FixitySig name fixity loc))
610 %*********************************************************
612 \subsection{Deprecations}
614 %*********************************************************
616 For deprecations, all we do is check that the names are in scope.
617 It's only imported deprecations, dealt with in RnIfaces, that we
618 gather them together.
621 rnDeprecs :: GlobalRdrEnv -> Maybe DeprecTxt
622 -> [RdrNameDeprecation] -> RnMG Deprecations
623 rnDeprecs gbl_env Nothing []
626 rnDeprecs gbl_env (Just txt) decls
627 = mapRn (addErrRn . badDeprec) decls `thenRn_`
628 returnRn (DeprecAll txt)
630 rnDeprecs gbl_env Nothing decls
631 = mapRn rn_deprec decls `thenRn` \ pairs ->
632 returnRn (DeprecSome (mkNameEnv (catMaybes pairs)))
634 rn_deprec (Deprecation rdr_name txt loc)
636 lookupGlobalRn gbl_env rdr_name `thenRn` \ maybe_name ->
638 Just n -> returnRn (Just (n,txt))
639 Nothing -> returnRn Nothing
643 %************************************************************************
645 \subsection{Grabbing the old interface file and checking versions}
647 %************************************************************************
650 checkOldIface :: DynFlags -> Finder
651 -> HomeIfaceTable -> HomeSymbolTable
652 -> PersistentCompilerState
654 -> Bool -- Source unchanged
655 -> Maybe ModIface -- Old interface from compilation manager, if any
656 -> IO (PersistentCompilerState, Bool, (RecompileRequired, Maybe ModIface))
657 -- True <=> errors happened
659 checkOldIface dflags finder hit hst pcs mod source_unchanged maybe_iface
660 = initRn dflags finder hit hst pcs mod $
662 -- Load the old interface file, if we havn't already got it
663 loadOldIface mod maybe_iface `thenRn` \ maybe_iface ->
666 recompileRequired mod source_unchanged maybe_iface `thenRn` \ recompile ->
668 returnRn (recompile, maybe_iface)
673 loadOldIface :: Module -> Maybe ModIface -> RnMG (Maybe ModIface)
674 loadOldIface mod (Just iface)
675 = returnRn (Just iface)
677 loadOldIface mod Nothing
678 = -- LOAD THE OLD INTERFACE FILE
679 findAndReadIface doc_str (moduleName mod) False {- Not hi-boot -} `thenRn` \ read_result ->
680 case read_result of {
681 Left err -> -- Old interface file not found, or garbled, so we'd better bail out
682 traceRn (vcat [ptext SLIT("No old interface file:"), err]) `thenRn_`
689 loadHomeDecls (pi_decls iface) `thenRn` \ decls ->
690 loadHomeRules (pi_rules iface) `thenRn` \ rules ->
691 loadHomeInsts (pi_insts iface) `thenRn` \ insts ->
692 returnRn (decls, rules, insts)
693 ) `thenRn` \ ((decls_vers, new_decls), (rule_vers, new_rules), new_insts) ->
695 mapRn loadHomeUsage (pi_usages iface) `thenRn` \ usages ->
696 loadExports (pi_exports iface) `thenRn` \ (export_vers, avails) ->
697 loadFixDecls mod (pi_fixity iface) `thenRn` \ fix_env ->
698 loadDeprecs mod (pi_deprecs iface) `thenRn` \ deprec_env ->
700 version = VersionInfo { vers_module = pi_vers iface,
701 vers_exports = export_vers,
702 vers_rules = rule_vers,
703 vers_decls = decls_vers }
705 decls = IfaceDecls { dcl_tycl = new_decls,
706 dcl_rules = new_rules,
707 dcl_insts = new_insts }
709 mod_iface = ModIface { mi_module = mod, mi_version = version,
710 mi_exports = avails, mi_orphan = pi_orphan iface,
711 mi_fixities = fix_env, mi_deprecs = deprec_env,
714 mi_globals = panic "No mi_globals in old interface"
717 returnRn (Just mod_iface)
722 doc_str = ptext SLIT("need usage info from") <+> ppr mod
726 loadHomeDecls :: [(Version, RdrNameTyClDecl)]
727 -> RnMS (NameEnv Version, [RenamedTyClDecl])
728 loadHomeDecls decls = foldlRn loadHomeDecl (emptyNameEnv, []) decls
730 loadHomeDecl :: (NameEnv Version, [RenamedTyClDecl])
731 -> (Version, RdrNameTyClDecl)
732 -> RnMS (NameEnv Version, [RenamedTyClDecl])
733 loadHomeDecl (version_map, decls) (version, decl)
734 = rnTyClDecl decl `thenRn` \ (decl', _) ->
735 returnRn (extendNameEnv version_map (tyClDeclName decl') version, decl':decls)
738 loadHomeRules :: (Version, [RdrNameRuleDecl])
739 -> RnMS (Version, [RenamedRuleDecl])
740 loadHomeRules (version, rules)
741 = mapAndUnzipRn rnRuleDecl rules `thenRn` \ (rules', _) ->
742 returnRn (version, rules')
745 loadHomeInsts :: [RdrNameInstDecl]
746 -> RnMS [RenamedInstDecl]
747 loadHomeInsts insts = mapAndUnzipRn rnInstDecl insts `thenRn` \ (insts', _) ->
751 loadHomeUsage :: ImportVersion OccName
752 -> RnMG (ImportVersion Name)
753 loadHomeUsage (mod_name, orphans, is_boot, whats_imported)
754 = rn_imps whats_imported `thenRn` \ whats_imported' ->
755 returnRn (mod_name, orphans, is_boot, whats_imported')
757 rn_imps NothingAtAll = returnRn NothingAtAll
758 rn_imps (Everything v) = returnRn (Everything v)
759 rn_imps (Specifically mv ev items rv) = mapRn rn_imp items `thenRn` \ items' ->
760 returnRn (Specifically mv ev items' rv)
761 rn_imp (occ,vers) = newGlobalName mod_name occ `thenRn` \ name ->
766 %*********************************************************
768 \subsection{Unused names}
770 %*********************************************************
773 reportUnusedNames :: ModuleName -> [ModuleName]
774 -> GlobalRdrEnv -> AvailEnv
775 -> Avails -> NameSet -> [RenamedHsDecl]
777 reportUnusedNames mod_name direct_import_mods
779 export_avails mentioned_names
781 = warnUnusedModules unused_imp_mods `thenRn_`
782 warnUnusedLocalBinds bad_locals `thenRn_`
783 warnUnusedImports bad_imp_names `thenRn_`
784 printMinimalImports mod_name minimal_imports `thenRn_`
785 warnDeprecations really_used_names `thenRn_`
789 used_names = mentioned_names `unionNameSets` availsToNameSet export_avails
791 -- Now, a use of C implies a use of T,
792 -- if C was brought into scope by T(..) or T(C)
793 really_used_names = used_names `unionNameSets`
794 mkNameSet [ parent_name
795 | sub_name <- nameSetToList used_names
797 -- Usually, every used name will appear in avail_env, but there
798 -- is one time when it doesn't: tuples and other built in syntax. When you
799 -- write (a,b) that gives rise to a *use* of "(,)", so that the
800 -- instances will get pulled in, but the tycon "(,)" isn't actually
801 -- in scope. Also, (-x) gives rise to an implicit use of 'negate';
802 -- similarly, 3.5 gives rise to an implcit use of :%
803 -- Hence the silent 'False' in all other cases
805 , Just parent_name <- [case lookupNameEnv avail_env sub_name of
806 Just (AvailTC n _) -> Just n
810 defined_names, defined_and_used, defined_but_not_used :: [(Name,Provenance)]
811 defined_names = concat (rdrEnvElts gbl_env)
812 (defined_and_used, defined_but_not_used) = partition used defined_names
813 used (name,_) = not (name `elemNameSet` really_used_names)
815 -- Filter out the ones only defined implicitly
817 bad_locals = [n | (n,LocalDef) <- defined_but_not_used]
819 bad_imp_names :: [(Name,Provenance)]
820 bad_imp_names = [(n,p) | (n,p@(NonLocalDef (UserImport mod _ True) _)) <- defined_but_not_used,
821 not (module_unused mod)]
823 -- inst_mods are directly-imported modules that
824 -- contain instance decl(s) that the renamer decided to suck in
825 -- It's not necessarily redundant to import such modules.
831 -- The import M() is not *necessarily* redundant, even if
832 -- we suck in no instance decls from M (e.g. it contains
833 -- no instance decls, or This contains no code). It may be
834 -- that we import M solely to ensure that M's orphan instance
835 -- decls (or those in its imports) are visible to people who
836 -- import This. Sigh.
837 -- There's really no good way to detect this, so the error message
838 -- in RnEnv.warnUnusedModules is weakened instead
839 inst_mods :: [ModuleName]
840 inst_mods = [m | InstD (InstDecl _ _ _ (Just dfun) _) <- imported_decls,
841 let m = moduleName (nameModule dfun),
842 m `elem` direct_import_mods
845 -- To figure out the minimal set of imports, start with the things
846 -- that are in scope (i.e. in gbl_env). Then just combine them
847 -- into a bunch of avails, so they are properly grouped
848 minimal_imports :: FiniteMap ModuleName AvailEnv
849 minimal_imports0 = emptyFM
850 minimal_imports1 = foldr add_name minimal_imports0 defined_and_used
851 minimal_imports = foldr add_inst_mod minimal_imports1 inst_mods
853 add_name (n,NonLocalDef (UserImport m _ _) _) acc = addToFM_C plusAvailEnv acc (moduleName (nameModule n))
854 (unitAvailEnv (mk_avail n))
855 add_name (n,other_prov) acc = acc
857 mk_avail n = case lookupNameEnv avail_env n of
858 Just (AvailTC m _) | n==m -> AvailTC n [n]
859 | otherwise -> AvailTC m [n,m]
860 Just avail -> Avail n
861 Nothing -> pprPanic "mk_avail" (ppr n)
864 | m `elemFM` acc = acc -- We import something already
865 | otherwise = addToFM acc m emptyAvailEnv
866 -- Add an empty collection of imports for a module
867 -- from which we have sucked only instance decls
869 -- unused_imp_mods are the directly-imported modules
870 -- that are not mentioned in minimal_imports
871 unused_imp_mods = [m | m <- direct_import_mods,
872 not (maybeToBool (lookupFM minimal_imports m)),
875 module_unused :: Module -> Bool
876 module_unused mod = moduleName mod `elem` unused_imp_mods
879 warnDeprecations used_names
880 = doptRn Opt_WarnDeprecations `thenRn` \ warn_drs ->
881 if not warn_drs then returnRn () else
883 getIfacesRn `thenRn` \ ifaces ->
884 getHomeIfaceTableRn `thenRn` \ hit ->
888 | n <- nameSetToList used_names,
889 Just txt <- [lookup_deprec hit pit n] ]
891 mapRn_ warnDeprec deprecs
894 lookup_deprec hit pit n
895 = case lookupModuleEnv hit mod of
896 Just iface -> lookupDeprec iface n
897 Nothing -> case lookupModuleEnv pit mod of
898 Just iface -> lookupDeprec iface n
899 Nothing -> pprPanic "warnDeprecations:" (ppr n)
903 -- ToDo: deal with original imports with 'qualified' and 'as M' clauses
904 printMinimalImports mod_name imps
905 = doptRn Opt_D_dump_minimal_imports `thenRn` \ dump_minimal ->
906 if not dump_minimal then returnRn () else
908 mapRn to_ies (fmToList imps) `thenRn` \ mod_ies ->
909 ioToRnM (do { h <- openFile filename WriteMode ;
910 printForUser h (vcat (map ppr_mod_ie mod_ies))
914 filename = moduleNameUserString mod_name ++ ".imports"
915 ppr_mod_ie (mod_name, ies)
916 | mod_name == pRELUDE_Name
919 = ptext SLIT("import") <+> ppr mod_name <>
920 parens (fsep (punctuate comma (map ppr ies)))
922 to_ies (mod, avail_env) = mapRn to_ie (availEnvElts avail_env) `thenRn` \ ies ->
925 to_ie :: AvailInfo -> RnMG (IE Name)
926 to_ie (Avail n) = returnRn (IEVar n)
927 to_ie (AvailTC n [m]) = ASSERT( n==m )
928 returnRn (IEThingAbs n)
929 to_ie (AvailTC n ns) = getInterfaceExports (moduleName (nameModule n))
930 ImportBySystem `thenRn` \ (_, avails) ->
931 case [ms | AvailTC m ms <- avails, m == n] of
932 [ms] | all (`elem` ns) ms -> returnRn (IEThingAll n)
933 | otherwise -> returnRn (IEThingWith n (filter (/= n) ns))
934 other -> pprTrace "to_ie" (ppr n <+> ppr (nameModule n) <+> ppr other) $
937 rnDump :: [RenamedHsDecl] -- Renamed imported decls
938 -> [RenamedHsDecl] -- Renamed local decls
940 rnDump imp_decls local_decls
941 = doptRn Opt_D_dump_rn_trace `thenRn` \ dump_rn_trace ->
942 doptRn Opt_D_dump_rn_stats `thenRn` \ dump_rn_stats ->
943 doptRn Opt_D_dump_rn `thenRn` \ dump_rn ->
944 if dump_rn_trace || dump_rn_stats || dump_rn then
945 getRnStats imp_decls `thenRn` \ stats_msg ->
946 returnRn (printErrs stats_msg >>
947 dumpIfSet dump_rn "Renamer:"
948 (vcat (map ppr (local_decls ++ imp_decls))))
954 %*********************************************************
956 \subsection{Statistics}
958 %*********************************************************
961 getRnStats :: [RenamedHsDecl] -> RnMG SDoc
962 getRnStats imported_decls
963 = getIfacesRn `thenRn` \ ifaces ->
965 n_mods = length [() | (_, _, True) <- eltsFM (iImpModInfo ifaces)]
967 decls_read = [decl | (avail, True, (_,decl)) <- nameEnvElts (iDecls ifaces),
968 -- Data, newtype, and class decls are in the decls_fm
969 -- under multiple names; the tycon/class, and each
970 -- constructor/class op too.
971 -- The 'True' selects just the 'main' decl
972 not (isLocallyDefined (availName avail))
975 (cd_rd, dd_rd, nd_rd, sd_rd, vd_rd) = countTyClDecls decls_read
976 (cd_sp, dd_sp, nd_sp, sd_sp, vd_sp, id_sp) = count_decls imported_decls
978 unslurped_insts = iInsts ifaces
979 inst_decls_unslurped = length (bagToList unslurped_insts)
980 inst_decls_read = id_sp + inst_decls_unslurped
983 [int n_mods <+> text "interfaces read",
984 hsep [ int cd_sp, text "class decls imported, out of",
985 int cd_rd, text "read"],
986 hsep [ int dd_sp, text "data decls imported, out of",
987 int dd_rd, text "read"],
988 hsep [ int nd_sp, text "newtype decls imported, out of",
989 int nd_rd, text "read"],
990 hsep [int sd_sp, text "type synonym decls imported, out of",
991 int sd_rd, text "read"],
992 hsep [int vd_sp, text "value signatures imported, out of",
993 int vd_rd, text "read"],
994 hsep [int id_sp, text "instance decls imported, out of",
995 int inst_decls_read, text "read"],
996 text "cls dcls slurp" <+> fsep (map (ppr . tyClDeclName)
997 [d | TyClD d <- imported_decls, isClassDecl d]),
998 text "cls dcls read" <+> fsep (map (ppr . tyClDeclName)
999 [d | d <- decls_read, isClassDecl d])]
1001 returnRn (hcat [text "Renamer stats: ", stats])
1011 tycl_decls = [d | TyClD d <- decls]
1012 (class_decls, data_decls, newtype_decls, syn_decls, val_decls) = countTyClDecls tycl_decls
1014 inst_decls = length [() | InstD _ <- decls]
1018 %************************************************************************
1020 \subsection{Errors and warnings}
1022 %************************************************************************
1025 warnDeprec :: (Name, DeprecTxt) -> RnM d ()
1026 warnDeprec (name, txt)
1027 = pushSrcLocRn (getSrcLoc name) $
1029 sep [ text (occNameFlavour (nameOccName name)) <+> ppr name <+>
1030 text "is deprecated:", nest 4 (ppr txt) ]
1033 unusedFixityDecl rdr_name fixity
1034 = hsep [ptext SLIT("Unused fixity declaration for"), quotes (ppr rdr_name)]
1036 dupFixityDecl rdr_name loc1 loc2
1037 = vcat [ptext SLIT("Multiple fixity declarations for") <+> quotes (ppr rdr_name),
1038 ptext SLIT("at ") <+> ppr loc1,
1039 ptext SLIT("and") <+> ppr loc2]
1042 = sep [ptext SLIT("Illegal deprecation when whole module is deprecated"),