2 % (c) The GRASP Project, Glasgow University, 1992-1998
4 \section[Rename]{Renaming and dependency analysis passes}
19 #include "HsVersions.h"
22 import RdrHsSyn ( RdrNameHsModule, RdrNameHsDecl, RdrNameDeprecation,
23 RdrNameTyClDecl, RdrNameRuleDecl, RdrNameInstDecl, RdrNameImportDecl,
26 import RnHsSyn ( RenamedHsDecl, RenamedTyClDecl, RenamedRuleDecl, RenamedInstDecl,
28 instDeclFVs, tyClDeclFVs, ruleDeclFVs
31 import CmdLineOpts ( DynFlags, DynFlag(..), opt_InPackage )
33 import RnExpr ( rnStmt )
34 import RnNames ( getGlobalNames, exportsFromAvail )
35 import RnSource ( rnSourceDecls, rnTyClDecl, rnIfaceRuleDecl, rnInstDecl )
36 import RnIfaces ( slurpImpDecls, mkImportInfo, recordLocalSlurps,
38 RecompileRequired, outOfDate, recompileRequired
40 import RnHiFiles ( readIface, loadInterface,
41 loadExports, loadFixDecls, loadDeprecs,
43 import RnEnv ( availsToNameSet,
44 unitAvailEnv, availEnvElts, availNames,
45 plusAvailEnv, groupAvails, warnUnusedImports,
46 warnUnusedLocalBinds, warnUnusedModules,
47 lookupSrcName, getImplicitStmtFVs, mkTopFixityEnv,
48 getImplicitModuleFVs, newGlobalName, unQualInScope,
49 ubiquitousNames, lookupOccRn, checkMain,
50 plusGlobalRdrEnv, mkGlobalRdrEnv
52 import Module ( Module, ModuleName, WhereFrom(..),
53 moduleNameUserString, moduleName,
56 import Name ( Name, nameModule, isExternalName )
59 import RdrName ( foldRdrEnv, isQual, emptyRdrEnv )
60 import PrelNames ( iNTERACTIVE, pRELUDE_Name )
61 import ErrUtils ( dumpIfSet, dumpIfSet_dyn, showPass,
62 printErrorsAndWarnings, errorsFound )
63 import Bag ( bagToList )
64 import FiniteMap ( FiniteMap, fmToList, emptyFM, lookupFM,
65 addToFM_C, elemFM, addToFM
67 import Maybes ( maybeToBool, catMaybes )
69 import IO ( openFile, IOMode(..) )
70 import HscTypes -- lots of it
71 import List ( partition, nub )
75 %*********************************************************
77 \subsection{The main wrappers}
79 %*********************************************************
82 renameModule :: DynFlags -> GhciMode
83 -> HomeIfaceTable -> HomeSymbolTable
84 -> PersistentCompilerState
85 -> Module -> RdrNameHsModule
86 -> IO (PersistentCompilerState, PrintUnqualified,
87 Maybe (IsExported, ModIface, RnResult))
88 -- Nothing => some error occurred in the renamer
90 renameModule dflags ghci_mode hit hst pcs this_module rdr_module
91 = renameSource dflags hit hst pcs this_module $
92 rename ghci_mode this_module rdr_module
96 renameStmt :: DynFlags
97 -> HomeIfaceTable -> HomeSymbolTable
98 -> PersistentCompilerState
100 -> RdrNameStmt -- parsed stmt
101 -> IO ( PersistentCompilerState,
103 Maybe ([Name], (RenamedStmt, [RenamedHsDecl]))
106 renameStmt dflags hit hst pcs ic stmt
107 = renameSource dflags hit hst pcs iNTERACTIVE $
109 -- load the context module
110 let InteractiveContext{ ic_rn_gbl_env = rdr_env,
111 ic_print_unqual = print_unqual,
112 ic_rn_local_env = local_rdr_env,
113 ic_type_env = type_env } = ic
116 extendTypeEnvRn type_env $
119 initRnMS rdr_env emptyAvailEnv local_rdr_env emptyLocalFixityEnv CmdLineMode (
120 rnStmt stmt $ \ stmt' ->
121 returnRn (([], stmt'), emptyFVs)
122 ) `thenRn` \ ((binders, stmt), fvs) ->
124 -- Bale out if we fail
125 checkErrsRn `thenRn` \ no_errs_so_far ->
126 if not no_errs_so_far then
127 doDump dflags [] stmt [] `thenRn_` returnRn (print_unqual, Nothing)
130 -- Add implicit free vars, and close decls
131 getImplicitStmtFVs `thenRn` \ implicit_fvs ->
132 slurpImpDecls (fvs `plusFV` implicit_fvs) `thenRn` \ decls ->
133 -- NB: an earlier version deleted (rdrEnvElts local_env) from
134 -- the fvs. But (a) that isn't necessary, because previously
135 -- bound things in the local_env will be in the TypeEnv, and
136 -- the renamer doesn't re-slurp such things, and
137 -- (b) it's WRONG to delete them. Consider in GHCi:
138 -- Mod> let x = e :: T
139 -- Mod> let y = x + 3
140 -- We need to pass 'x' among the fvs to slurpImpDecls, so that
141 -- the latter can see that T is a gate, and hence import the Num T
142 -- instance decl. (See the InTypEnv case in RnIfaces.slurpSourceRefs.)
144 doDump dflags binders stmt decls `thenRn_`
145 returnRn (print_unqual, Just (binders, (stmt, decls)))
148 doDump :: DynFlags -> [Name] -> RenamedStmt -> [RenamedHsDecl]
149 -> RnMG (Either IOError ())
150 doDump dflags bndrs stmt decls
151 = ioToRnM (dumpIfSet_dyn dflags Opt_D_dump_rn "Renamer:"
152 (vcat [text "Binders:" <+> ppr bndrs,
154 vcat (map ppr decls)]))
159 -> HomeIfaceTable -> HomeSymbolTable
160 -> PersistentCompilerState
161 -> InteractiveContext
162 -> [RdrName] -- name to rename
163 -> IO ( PersistentCompilerState,
165 Maybe ([Name], [RenamedHsDecl])
168 renameRdrName dflags hit hst pcs ic rdr_names =
169 renameSource dflags hit hst pcs iNTERACTIVE $
171 -- load the context module
172 let InteractiveContext{ ic_rn_gbl_env = rdr_env,
173 ic_print_unqual = print_unqual,
174 ic_rn_local_env = local_rdr_env,
175 ic_type_env = type_env } = ic
178 extendTypeEnvRn type_env $
180 -- rename the rdr_name
181 initRnMS rdr_env emptyAvailEnv local_rdr_env emptyLocalFixityEnv CmdLineMode
182 (mapRn (tryRn.lookupOccRn) rdr_names) `thenRn` \ maybe_names ->
184 ok_names = [ a | Right a <- maybe_names ]
187 then let errs = head [ e | Left e <- maybe_names ]
188 in setErrsRn errs `thenRn_`
189 doDump dflags ok_names [] `thenRn_`
190 returnRn (print_unqual, Nothing)
193 slurpImpDecls (mkNameSet ok_names) `thenRn` \ decls ->
195 doDump dflags ok_names decls `thenRn_`
196 returnRn (print_unqual, Just (ok_names, decls))
198 doDump :: DynFlags -> [Name] -> [RenamedHsDecl] -> RnMG (Either IOError ())
199 doDump dflags names decls
200 = ioToRnM (dumpIfSet_dyn dflags Opt_D_dump_rn "Renamer:"
201 (vcat [ppr names, text "",
202 vcat (map ppr decls)]))
206 renameExtCore :: DynFlags
207 -> HomeIfaceTable -> HomeSymbolTable
208 -> PersistentCompilerState
211 -> IO (PersistentCompilerState, PrintUnqualified,
212 Maybe (IsExported, ModIface, [RenamedHsDecl]))
214 -- Nothing => some error occurred in the renamer
215 renameExtCore dflags hit hst pcs this_module
216 rdr_module@(HsModule _ _ _ _ local_decls _ loc)
217 -- Rename the (Core) module
218 = renameSource dflags hit hst pcs this_module $
222 initIfaceRnMS this_module (rnExtCoreDecls local_decls) `thenRn` \ (rn_local_decls, binders, fvs) ->
223 recordLocalSlurps binders `thenRn_`
224 closeDecls rn_local_decls fvs `thenRn` \ final_decls ->
226 -- Bail out if we fail (but dump debug output anyway for debugging)
227 rnDump final_decls `thenRn_`
228 checkErrsRn `thenRn` \ no_errs_so_far ->
229 if not no_errs_so_far then
230 returnRn (print_unqualified, Nothing)
233 mod_iface = ModIface { mi_module = this_module,
234 mi_package = opt_InPackage,
235 mi_version = initialVersionInfo,
238 mi_orphan = panic "is_orphan",
239 -- ToDo: export the data types also.
240 mi_exports = [(moduleName this_module,
241 map Avail (nameSetToList binders))],
242 mi_globals = Nothing,
243 mi_fixities = mkNameEnv [],
244 mi_deprecs = NoDeprecs,
245 mi_decls = panic "mi_decls"
250 returnRn (print_unqualified, Just (is_exported, mod_iface, final_decls))
253 print_unqualified = const False -- print everything qualified.
256 rnExtCoreDecls :: [RdrNameHsDecl]
257 -> RnMS ([RenamedHsDecl],
259 FreeVars) -- Free variables
262 -- Renaming external-core decls is rather like renaming an interface file
263 -- All the decls are TyClDecls, and all the names are original names
264 = go [] emptyNameSet emptyNameSet decls
266 go rn_decls bndrs fvs [] = returnRn (rn_decls, bndrs, fvs)
268 go rn_decls bndrs fvs (TyClD decl : decls)
269 = rnTyClDecl decl `thenRn` \ rn_decl ->
270 go (TyClD rn_decl : rn_decls)
271 (addListToNameSet bndrs (map fst (tyClDeclSysNames rn_decl ++ tyClDeclNames rn_decl)))
272 (fvs `plusFV` tyClDeclFVs rn_decl)
275 go rn_decls bndrs fvs (decl : decls)
276 = addErrRn (text "Unexpected decl in ExtCore file" $$ ppr decl) `thenRn_`
277 go rn_decls bndrs fvs decls
281 %*********************************************************
283 \subsection{Make up an interactive context}
285 %*********************************************************
289 :: DynFlags -> HomeIfaceTable -> HomeSymbolTable
290 -> PersistentCompilerState
291 -> [Module] -> [Module]
292 -> IO (PersistentCompilerState, PrintUnqualified, Maybe GlobalRdrEnv)
293 mkGlobalContext dflags hit hst pcs toplevs exports
294 = renameSource dflags hit hst pcs iNTERACTIVE $
296 mapRn getTopLevScope toplevs `thenRn` \ toplev_envs ->
297 mapRn getModuleExports exports `thenRn` \ export_envs ->
298 let full_env = foldr plusGlobalRdrEnv emptyRdrEnv
299 (toplev_envs ++ export_envs)
300 print_unqual = unQualInScope full_env
302 checkErrsRn `thenRn` \ no_errs_so_far ->
303 if not no_errs_so_far then
304 returnRn (print_unqual, Nothing)
306 returnRn (print_unqual, Just full_env)
308 contextDoc = text "context for compiling statements"
310 getTopLevScope :: Module -> RnM d GlobalRdrEnv
312 loadInterface contextDoc (moduleName mod) ImportByUser `thenRn` \ iface ->
313 case mi_globals iface of
314 Nothing -> panic "getTopLevScope"
315 Just env -> returnRn env
317 getModuleExports :: Module -> RnM d GlobalRdrEnv
318 getModuleExports mod =
319 loadInterface contextDoc (moduleName mod) ImportByUser `thenRn` \ iface ->
320 returnRn (foldl add emptyRdrEnv (mi_exports iface))
322 prov_fn n = NonLocalDef ImplicitImport
323 add env (mod,avails) =
324 plusGlobalRdrEnv env (mkGlobalRdrEnv mod True prov_fn avails NoDeprecs)
327 %*********************************************************
329 \subsection{Slurp in a whole module eagerly}
331 %*********************************************************
335 :: DynFlags -> HomeIfaceTable -> HomeSymbolTable
336 -> PersistentCompilerState -> Module
337 -> IO (PersistentCompilerState, PrintUnqualified,
338 Maybe ([Name], [RenamedHsDecl]))
339 slurpIface dflags hit hst pcs mod =
340 renameSource dflags hit hst pcs iNTERACTIVE $
342 let mod_name = moduleName mod
344 loadInterface contextDoc mod_name ImportByUser `thenRn` \ iface ->
345 let fvs = availsToNameSet [ avail | (mn,avails) <- mi_exports iface,
348 slurpImpDecls fvs `thenRn` \ rn_imp_decls ->
349 returnRn (alwaysQualify, Just (nameSetToList fvs, rn_imp_decls))
352 %*********************************************************
354 \subsection{The main function: rename}
356 %*********************************************************
359 renameSource :: DynFlags
360 -> HomeIfaceTable -> HomeSymbolTable
361 -> PersistentCompilerState
363 -> RnMG (PrintUnqualified, Maybe r)
364 -> IO (PersistentCompilerState, PrintUnqualified, Maybe r)
365 -- Nothing => some error occurred in the renamer
367 renameSource dflags hit hst old_pcs this_module thing_inside
368 = do { showPass dflags "Renamer"
370 -- Initialise the renamer monad
371 ; (new_pcs, msgs, (print_unqual, maybe_rn_stuff))
372 <- initRn dflags hit hst old_pcs this_module thing_inside
374 -- Print errors from renaming
375 ; printErrorsAndWarnings print_unqual msgs ;
377 -- Return results. No harm in updating the PCS
378 ; if errorsFound msgs then
379 return (new_pcs, print_unqual, Nothing)
381 return (new_pcs, print_unqual, maybe_rn_stuff)
386 data RnResult -- A RenamedModule ia passed from renamer to typechecker
387 = RnResult { rr_mod :: Module, -- Same as in the ModIface,
388 rr_fixities :: FixityEnv, -- but convenient to have it here
390 rr_main :: Maybe Name, -- Just main, for module Main,
391 -- Nothing for other modules
393 rr_decls :: [RenamedHsDecl]
394 -- The other declarations of the module
395 -- Fixity and deprecations have already been slurped out
396 } -- and are now in the ModIface for the module
398 rename :: GhciMode -> Module -> RdrNameHsModule
399 -> RnMG (PrintUnqualified, Maybe (IsExported, ModIface, RnResult))
400 rename ghci_mode this_module
401 contents@(HsModule _ _ exports imports local_decls mod_deprec loc)
404 -- FIND THE GLOBAL NAME ENVIRONMENT
405 getGlobalNames this_module contents `thenRn` \ (gbl_env, local_gbl_env,
406 (mod_avail_env, global_avail_env)) ->
408 print_unqualified = unQualInScope gbl_env
410 full_avail_env :: NameEnv AvailInfo
411 -- The domain of global_avail_env is just the 'major' things;
412 -- variables, type constructors, classes.
413 -- E.g. Functor |-> Functor( Functor, fmap )
414 -- The domain of full_avail_env is everything in scope
415 -- E.g. Functor |-> Functor( Functor, fmap )
416 -- fmap |-> Functor( Functor, fmap )
418 -- This filled-out avail_env is needed to generate
419 -- exports (mkExportAvails), and for generating minimal
420 -- exports (reportUnusedNames)
421 full_avail_env = mkNameEnv [ (name,avail)
422 | avail <- availEnvElts global_avail_env,
423 name <- availNames avail]
425 -- Exit if we've found any errors
426 checkErrsRn `thenRn` \ no_errs_so_far ->
427 if not no_errs_so_far then
428 -- Found errors already, so exit now
429 returnRn (print_unqualified, Nothing)
432 -- PROCESS EXPORT LIST
433 exportsFromAvail mod_name exports mod_avail_env
434 full_avail_env gbl_env `thenRn` \ export_avails ->
436 traceRn (text "Local top-level environment" $$
437 nest 4 (pprGlobalRdrEnv local_gbl_env)) `thenRn_`
439 -- DEAL WITH DEPRECATIONS
440 rnDeprecs local_gbl_env mod_deprec
441 [d | DeprecD d <- local_decls] `thenRn` \ my_deprecs ->
443 -- DEAL WITH LOCAL FIXITIES
444 fixitiesFromLocalDecls local_gbl_env local_decls `thenRn` \ local_fixity_env ->
447 rnSourceDecls gbl_env global_avail_env
448 local_fixity_env SourceMode local_decls `thenRn` \ (rn_local_decls, source_fvs) ->
450 -- GET ANY IMPLICIT FREE VARIALBES
451 getImplicitModuleFVs rn_local_decls `thenRn` \ implicit_fvs ->
452 checkMain ghci_mode mod_name gbl_env `thenRn` \ (maybe_main_name, main_fvs, implicit_main_fvs) ->
454 export_fvs = availsToNameSet export_avails
455 used_fvs = source_fvs `plusFV` export_fvs `plusFV` main_fvs
456 -- The export_fvs make the exported names look just as if they
457 -- occurred in the source program. For the reasoning, see the
458 -- comments with RnIfaces.mkImportInfo
459 -- It also helps reportUnusedNames, which of course must not complain
460 -- that 'f' isn't mentioned if it is mentioned in the export list
462 needed_fvs = implicit_fvs `plusFV` implicit_main_fvs `plusFV` used_fvs
463 -- It's important to do the "plus" this way round, so that
464 -- when compiling the prelude, locally-defined (), Bool, etc
465 -- override the implicit ones.
468 traceRn (text "Needed FVs:" <+> fsep (map ppr (nameSetToList needed_fvs))) `thenRn_`
470 -- EXIT IF ERRORS FOUND
471 -- We exit here if there are any errors in the source, *before*
472 -- we attempt to slurp the decls from the interfaces, otherwise
473 -- the slurped decls may get lost when we return up the stack
474 -- to hscMain/hscExpr.
475 checkErrsRn `thenRn` \ no_errs_so_far ->
476 if not no_errs_so_far then
477 -- Found errors already, so exit now
478 rnDump rn_local_decls `thenRn_`
479 returnRn (print_unqualified, Nothing)
482 -- SLURP IN ALL THE NEEDED DECLARATIONS
483 slurpImpDecls needed_fvs `thenRn` \ rn_imp_decls ->
485 -- GENERATE THE VERSION/USAGE INFO
486 mkImportInfo mod_name imports `thenRn` \ my_usages ->
488 -- BUILD THE MODULE INTERFACE
490 -- We record fixities even for things that aren't exported,
491 -- so that we can change into the context of this moodule easily
492 fixities = mkNameEnv [ (name, fixity)
493 | FixitySig name fixity loc <- nameEnvElts local_fixity_env
496 -- Sort the exports to make them easier to compare for versions
497 my_exports = groupAvails this_module export_avails
499 final_decls = rn_local_decls ++ rn_imp_decls
501 -- In interactive mode, we don't want to discard any top-level
502 -- entities at all (eg. do not inline them away during
503 -- simplification), and retain them all in the TypeEnv so they are
504 -- available from the command line.
506 -- isExternalName separates the user-defined top-level names from those
507 -- introduced by the type checker.
508 dont_discard :: Name -> Bool
509 dont_discard | ghci_mode == Interactive = isExternalName
510 | otherwise = (`elemNameSet` export_fvs)
512 mod_iface = ModIface { mi_module = this_module,
513 mi_package = opt_InPackage,
514 mi_version = initialVersionInfo,
515 mi_usages = my_usages,
517 mi_orphan = panic "is_orphan",
518 mi_exports = my_exports,
519 mi_globals = Just gbl_env,
520 mi_fixities = fixities,
521 mi_deprecs = my_deprecs,
522 mi_decls = panic "mi_decls"
525 rn_result = RnResult { rr_mod = this_module,
526 rr_fixities = fixities,
527 rr_decls = final_decls,
528 rr_main = maybe_main_name }
531 rnDump final_decls `thenRn_`
532 rnStats rn_imp_decls `thenRn_`
534 -- REPORT UNUSED NAMES, AND DEBUG DUMP
535 reportUnusedNames mod_iface print_unqualified
536 imports full_avail_env gbl_env
537 used_fvs rn_imp_decls `thenRn_`
538 -- NB: used_fvs: include exports (else we get bogus
539 -- warnings of unused things) but not implicit FVs.
541 returnRn (print_unqualified, Just (dont_discard, mod_iface, rn_result))
543 mod_name = moduleName this_module
548 %*********************************************************
550 \subsection{Fixities}
552 %*********************************************************
555 fixitiesFromLocalDecls :: GlobalRdrEnv -> [RdrNameHsDecl] -> RnMG LocalFixityEnv
556 fixitiesFromLocalDecls gbl_env decls
557 = mkTopFixityEnv gbl_env (foldr get_fix_sigs [] decls) `thenRn` \ env ->
558 traceRn (text "fixity env" <+> vcat (map ppr (nameEnvElts env))) `thenRn_`
561 get_fix_sigs (FixD fix) acc = fix:acc
562 get_fix_sigs (TyClD (ClassDecl { tcdSigs = sigs})) acc
563 = [sig | FixSig sig <- sigs] ++ acc -- Get fixities from class decl sigs too.
564 get_fix_sigs other_decl acc = acc
568 %*********************************************************
570 \subsection{Deprecations}
572 %*********************************************************
574 For deprecations, all we do is check that the names are in scope.
575 It's only imported deprecations, dealt with in RnIfaces, that we
576 gather them together.
579 rnDeprecs :: GlobalRdrEnv -> Maybe DeprecTxt
580 -> [RdrNameDeprecation] -> RnMG Deprecations
581 rnDeprecs gbl_env Nothing []
584 rnDeprecs gbl_env (Just txt) decls
585 = mapRn (addErrRn . badDeprec) decls `thenRn_`
586 returnRn (DeprecAll txt)
588 rnDeprecs gbl_env Nothing decls
589 = mapRn rn_deprec decls `thenRn` \ pairs ->
590 returnRn (DeprecSome (mkNameEnv (catMaybes pairs)))
592 rn_deprec (Deprecation rdr_name txt loc)
594 lookupSrcName gbl_env rdr_name `thenRn` \ name ->
595 returnRn (Just (name, (name,txt)))
599 %************************************************************************
601 \subsection{Grabbing the old interface file and checking versions}
603 %************************************************************************
606 checkOldIface :: GhciMode
608 -> HomeIfaceTable -> HomeSymbolTable
609 -> PersistentCompilerState
612 -> Bool -- Source unchanged
613 -> Maybe ModIface -- Old interface from compilation manager, if any
614 -> IO (PersistentCompilerState, Bool, (RecompileRequired, Maybe ModIface))
615 -- True <=> errors happened
617 checkOldIface ghci_mode dflags hit hst pcs mod iface_path source_unchanged maybe_iface
618 = runRn dflags hit hst pcs (panic "Bogus module") $
620 -- CHECK WHETHER THE SOURCE HAS CHANGED
621 ( if not source_unchanged then
622 traceHiDiffsRn (nest 4 (text "Source file changed or recompilation check turned off"))
623 else returnRn () ) `thenRn_`
625 -- If the source has changed and we're in interactive mode, avoid reading
626 -- an interface; just return the one we might have been supplied with.
627 if ghci_mode == Interactive && not source_unchanged then
628 returnRn (outOfDate, maybe_iface)
633 Just old_iface -> -- Use the one we already have
634 check_versions old_iface
636 Nothing -- try and read it from a file
637 -> readIface iface_path `thenRn` \ read_result ->
639 Left err -> -- Old interface file not found, or garbled; give up
641 text "Cannot read old interface file:"
642 $$ nest 4 err) `thenRn_`
643 returnRn (outOfDate, Nothing)
645 Right parsed_iface ->
646 let read_mod_name = pi_mod parsed_iface
647 wanted_mod_name = moduleName mod
649 if (wanted_mod_name /= read_mod_name) then
651 text "Existing interface file has wrong module name: "
652 <> quotes (ppr read_mod_name)
654 returnRn (outOfDate, Nothing)
656 loadOldIface mod parsed_iface `thenRn` \ m_iface ->
657 check_versions m_iface
659 check_versions :: ModIface -> RnMG (RecompileRequired, Maybe ModIface)
661 | not source_unchanged
662 = returnRn (outOfDate, Just iface)
665 recompileRequired iface_path iface `thenRn` \ recompile ->
666 returnRn (recompile, Just iface)
669 I think the following function should now have a more representative name,
673 loadOldIface :: Module -> ParsedIface -> RnMG ModIface
675 loadOldIface mod parsed_iface
676 = let iface = parsed_iface
679 loadHomeDecls (pi_decls iface) `thenRn` \ decls ->
680 loadHomeRules (pi_rules iface) `thenRn` \ rules ->
681 loadHomeInsts (pi_insts iface) `thenRn` \ insts ->
682 returnRn (decls, rules, insts)
684 `thenRn` \ ((decls_vers, new_decls), (rule_vers, new_rules), new_insts) ->
686 mapRn loadHomeUsage (pi_usages iface) `thenRn` \ usages ->
687 loadExports (pi_exports iface) `thenRn` \ (export_vers, avails) ->
688 loadFixDecls mod (pi_fixity iface) `thenRn` \ fix_env ->
689 loadDeprecs mod (pi_deprecs iface) `thenRn` \ deprec_env ->
691 version = VersionInfo { vers_module = pi_vers iface,
692 vers_exports = export_vers,
693 vers_rules = rule_vers,
694 vers_decls = decls_vers }
696 decls = mkIfaceDecls new_decls new_rules new_insts
698 mod_iface = ModIface { mi_module = mod, mi_package = pi_pkg parsed_iface,
699 mi_version = version,
700 mi_exports = avails, mi_usages = usages,
701 mi_boot = False, mi_orphan = pi_orphan iface,
702 mi_fixities = fix_env, mi_deprecs = deprec_env,
711 loadHomeDecls :: [(Version, RdrNameTyClDecl)]
712 -> RnMS (NameEnv Version, [RenamedTyClDecl])
713 loadHomeDecls decls = foldlRn loadHomeDecl (emptyNameEnv, []) decls
715 loadHomeDecl :: (NameEnv Version, [RenamedTyClDecl])
716 -> (Version, RdrNameTyClDecl)
717 -> RnMS (NameEnv Version, [RenamedTyClDecl])
718 loadHomeDecl (version_map, decls) (version, decl)
719 = rnTyClDecl decl `thenRn` \ decl' ->
720 returnRn (extendNameEnv version_map (tyClDeclName decl') version, decl':decls)
723 loadHomeRules :: (Version, [RdrNameRuleDecl])
724 -> RnMS (Version, [RenamedRuleDecl])
725 loadHomeRules (version, rules)
726 = mapRn rnIfaceRuleDecl rules `thenRn` \ rules' ->
727 returnRn (version, rules')
730 loadHomeInsts :: [RdrNameInstDecl]
731 -> RnMS [RenamedInstDecl]
732 loadHomeInsts insts = mapRn rnInstDecl insts
735 loadHomeUsage :: ImportVersion OccName
736 -> RnMG (ImportVersion Name)
737 loadHomeUsage (mod_name, orphans, is_boot, whats_imported)
738 = rn_imps whats_imported `thenRn` \ whats_imported' ->
739 returnRn (mod_name, orphans, is_boot, whats_imported')
741 rn_imps NothingAtAll = returnRn NothingAtAll
742 rn_imps (Everything v) = returnRn (Everything v)
743 rn_imps (Specifically mv ev items rv) = mapRn rn_imp items `thenRn` \ items' ->
744 returnRn (Specifically mv ev items' rv)
745 rn_imp (occ,vers) = newGlobalName mod_name occ `thenRn` \ name ->
751 %*********************************************************
753 \subsection{Closing up the interface decls}
755 %*********************************************************
757 Suppose we discover we don't need to recompile. Then we start from the
758 IfaceDecls in the ModIface, and fluff them up by sucking in all the decls they need.
761 closeIfaceDecls :: DynFlags
762 -> HomeIfaceTable -> HomeSymbolTable
763 -> PersistentCompilerState
764 -> ModIface -- Get the decls from here
765 -> IO (PersistentCompilerState, Bool, [RenamedHsDecl])
766 -- True <=> errors happened
767 closeIfaceDecls dflags hit hst pcs
768 mod_iface@(ModIface { mi_module = mod, mi_decls = iface_decls })
769 = runRn dflags hit hst pcs mod $
772 rule_decls = dcl_rules iface_decls
773 inst_decls = dcl_insts iface_decls
774 tycl_decls = dcl_tycl iface_decls
775 decls = map RuleD rule_decls ++
776 map InstD inst_decls ++
778 needed = unionManyNameSets (map ruleDeclFVs rule_decls) `unionNameSets`
779 unionManyNameSets (map instDeclFVs inst_decls) `unionNameSets`
780 unionManyNameSets (map tyClDeclFVs tycl_decls) `unionNameSets`
782 -- Data type decls with record selectors,
783 -- which may appear in the decls, need unpackCString
784 -- and friends. It's easier to just grab them right now.
786 local_names = foldl add emptyNameSet tycl_decls
787 add names decl = addListToNameSet names (map fst (tyClDeclSysNames decl ++ tyClDeclNames decl))
789 recordLocalSlurps local_names `thenRn_`
791 -- Do the transitive closure
792 closeDecls decls needed `thenRn` \closed_decls ->
793 rnDump closed_decls `thenRn_`
794 returnRn closed_decls
797 %*********************************************************
799 \subsection{Unused names}
801 %*********************************************************
804 reportUnusedNames :: ModIface -> PrintUnqualified
805 -> [RdrNameImportDecl]
808 -> NameSet -- Used in this module
811 reportUnusedNames my_mod_iface unqual imports avail_env gbl_env
812 used_names imported_decls
813 = warnUnusedModules unused_imp_mods `thenRn_`
814 warnUnusedLocalBinds bad_locals `thenRn_`
815 warnUnusedImports bad_imp_names `thenRn_`
816 printMinimalImports this_mod unqual minimal_imports
818 this_mod = mi_module my_mod_iface
820 -- Now, a use of C implies a use of T,
821 -- if C was brought into scope by T(..) or T(C)
822 really_used_names = used_names `unionNameSets`
823 mkNameSet [ parent_name
824 | sub_name <- nameSetToList used_names
826 -- Usually, every used name will appear in avail_env, but there
827 -- is one time when it doesn't: tuples and other built in syntax. When you
828 -- write (a,b) that gives rise to a *use* of "(,)", so that the
829 -- instances will get pulled in, but the tycon "(,)" isn't actually
830 -- in scope. Also, (-x) gives rise to an implicit use of 'negate';
831 -- similarly, 3.5 gives rise to an implcit use of :%
832 -- Hence the silent 'False' in all other cases
834 , Just parent_name <- [case lookupNameEnv avail_env sub_name of
835 Just (AvailTC n _) -> Just n
839 -- Collect the defined names from the in-scope environment
840 -- Look for the qualified ones only, else get duplicates
841 defined_names :: [GlobalRdrElt]
842 defined_names = foldRdrEnv add [] gbl_env
843 add rdr_name ns acc | isQual rdr_name = ns ++ acc
846 defined_and_used, defined_but_not_used :: [GlobalRdrElt]
847 (defined_and_used, defined_but_not_used) = partition used defined_names
848 used (GRE name _ _) = name `elemNameSet` really_used_names
850 -- Filter out the ones only defined implicitly
852 bad_locals = [n | (GRE n LocalDef _) <- defined_but_not_used]
854 bad_imp_names :: [(Name,Provenance)]
855 bad_imp_names = [(n,p) | GRE n p@(NonLocalDef (UserImport mod _ True)) _ <- defined_but_not_used,
856 not (module_unused mod)]
858 -- inst_mods are directly-imported modules that
859 -- contain instance decl(s) that the renamer decided to suck in
860 -- It's not necessarily redundant to import such modules.
866 -- The import M() is not *necessarily* redundant, even if
867 -- we suck in no instance decls from M (e.g. it contains
868 -- no instance decls, or This contains no code). It may be
869 -- that we import M solely to ensure that M's orphan instance
870 -- decls (or those in its imports) are visible to people who
871 -- import This. Sigh.
872 -- There's really no good way to detect this, so the error message
873 -- in RnEnv.warnUnusedModules is weakened instead
874 inst_mods :: [ModuleName]
875 inst_mods = [m | InstD (InstDecl _ _ _ (Just dfun) _) <- imported_decls,
876 let m = moduleName (nameModule dfun),
877 m `elem` direct_import_mods
880 -- To figure out the minimal set of imports, start with the things
881 -- that are in scope (i.e. in gbl_env). Then just combine them
882 -- into a bunch of avails, so they are properly grouped
883 minimal_imports :: FiniteMap ModuleName AvailEnv
884 minimal_imports0 = emptyFM
885 minimal_imports1 = foldr add_name minimal_imports0 defined_and_used
886 minimal_imports = foldr add_inst_mod minimal_imports1 inst_mods
888 -- We've carefully preserved the provenance so that we can
889 -- construct minimal imports that import the name by (one of)
890 -- the same route(s) as the programmer originally did.
891 add_name (GRE n (NonLocalDef (UserImport m _ _)) _) acc = addToFM_C plusAvailEnv acc (moduleName m)
892 (unitAvailEnv (mk_avail n))
893 add_name (GRE n other_prov _) acc = acc
895 mk_avail n = case lookupNameEnv avail_env n of
896 Just (AvailTC m _) | n==m -> AvailTC n [n]
897 | otherwise -> AvailTC m [n,m]
898 Just avail -> Avail n
899 Nothing -> pprPanic "mk_avail" (ppr n)
902 | m `elemFM` acc = acc -- We import something already
903 | otherwise = addToFM acc m emptyAvailEnv
904 -- Add an empty collection of imports for a module
905 -- from which we have sucked only instance decls
907 direct_import_mods :: [ModuleName]
908 direct_import_mods = nub [m | ImportDecl m _ _ _ _ _ <- imports]
910 -- unused_imp_mods are the directly-imported modules
911 -- that are not mentioned in minimal_imports
912 unused_imp_mods = [m | m <- direct_import_mods,
913 not (maybeToBool (lookupFM minimal_imports m)),
916 module_unused :: Module -> Bool
917 module_unused mod = moduleName mod `elem` unused_imp_mods
920 -- ToDo: deal with original imports with 'qualified' and 'as M' clauses
921 printMinimalImports :: Module -- This module
923 -> FiniteMap ModuleName AvailEnv -- Minimal imports
925 printMinimalImports this_mod unqual imps
926 = ifOptRn Opt_D_dump_minimal_imports $
928 mapRn to_ies (fmToList imps) `thenRn` \ mod_ies ->
929 ioToRnM (do { h <- openFile filename WriteMode ;
930 printForUser h unqual (vcat (map ppr_mod_ie mod_ies))
934 filename = moduleNameUserString (moduleName this_mod) ++ ".imports"
935 ppr_mod_ie (mod_name, ies)
936 | mod_name == pRELUDE_Name
939 = ptext SLIT("import") <+> ppr mod_name <>
940 parens (fsep (punctuate comma (map ppr ies)))
942 to_ies (mod, avail_env) = mapRn to_ie (availEnvElts avail_env) `thenRn` \ ies ->
945 to_ie :: AvailInfo -> RnMG (IE Name)
946 -- The main trick here is that if we're importing all the constructors
947 -- we want to say "T(..)", but if we're importing only a subset we want
948 -- to say "T(A,B,C)". So we have to find out what the module exports.
949 to_ie (Avail n) = returnRn (IEVar n)
950 to_ie (AvailTC n [m]) = ASSERT( n==m )
951 returnRn (IEThingAbs n)
953 = loadInterface (text "Compute minimal imports from" <+> ppr n_mod)
954 n_mod ImportBySystem `thenRn` \ iface ->
955 case [xs | (m,as) <- mi_exports iface,
959 [xs] | all (`elem` ns) xs -> returnRn (IEThingAll n)
960 | otherwise -> returnRn (IEThingWith n (filter (/= n) ns))
961 other -> pprTrace "to_ie" (ppr n <+> ppr (nameModule n) <+> ppr other) $
964 n_mod = moduleName (nameModule n)
966 rnDump :: [RenamedHsDecl] -- Renamed decls
969 = doptRn Opt_D_dump_rn_trace `thenRn` \ dump_rn_trace ->
970 doptRn Opt_D_dump_rn_stats `thenRn` \ dump_rn_stats ->
971 doptRn Opt_D_dump_rn `thenRn` \ dump_rn ->
972 getIfacesRn `thenRn` \ ifaces ->
974 ioToRnM ( dumpIfSet dump_rn "Renamer:"
975 (vcat (map ppr decls)) )
980 rnStats :: [RenamedHsDecl] -- Imported decls
983 = doptRn Opt_D_dump_rn_trace `thenRn` \ dump_rn_trace ->
984 doptRn Opt_D_dump_rn_stats `thenRn` \ dump_rn_stats ->
985 doptRn Opt_D_dump_rn `thenRn` \ dump_rn ->
986 getIfacesRn `thenRn` \ ifaces ->
988 ioToRnM (dumpIfSet (dump_rn_trace || dump_rn_stats || dump_rn)
990 (getRnStats imp_decls ifaces)) `thenRn_`
995 %*********************************************************
997 \subsection{Statistics}
999 %*********************************************************
1002 getRnStats :: [RenamedHsDecl] -> Ifaces -> SDoc
1003 getRnStats imported_decls ifaces
1004 = hcat [text "Renamer stats: ", stats]
1006 n_mods = length [() | _ <- moduleEnvElts (iPIT ifaces)]
1007 -- This is really only right for a one-shot compile
1009 (decls_map, n_decls_slurped) = iDecls ifaces
1011 n_decls_left = length [decl | (avail, True, (_,decl)) <- nameEnvElts decls_map
1012 -- Data, newtype, and class decls are in the decls_fm
1013 -- under multiple names; the tycon/class, and each
1014 -- constructor/class op too.
1015 -- The 'True' selects just the 'main' decl
1018 (insts_left, n_insts_slurped) = iInsts ifaces
1019 n_insts_left = length (bagToList insts_left)
1021 (rules_left, n_rules_slurped) = iRules ifaces
1022 n_rules_left = length (bagToList rules_left)
1025 [int n_mods <+> text "interfaces read",
1026 hsep [ int n_decls_slurped, text "type/class/variable imported, out of",
1027 int (n_decls_slurped + n_decls_left), text "read"],
1028 hsep [ int n_insts_slurped, text "instance decls imported, out of",
1029 int (n_insts_slurped + n_insts_left), text "read"],
1030 hsep [ int n_rules_slurped, text "rule decls imported, out of",
1031 int (n_rules_slurped + n_rules_left), text "read"]
1036 %************************************************************************
1038 \subsection{Errors and warnings}
1040 %************************************************************************
1044 = sep [ptext SLIT("Illegal deprecation when whole module is deprecated"),