2 % (c) The GRASP Project, Glasgow University, 1992-1998
4 \section[Rename]{Renaming and dependency analysis passes}
8 renameModule, RnResult(..), renameStmt, renameRdrName, mkGlobalContext,
9 closeIfaceDecls, checkOldIface, slurpIface
12 #include "HsVersions.h"
15 import RdrHsSyn ( RdrNameHsModule, RdrNameHsDecl, RdrNameDeprecation,
16 RdrNameTyClDecl, RdrNameRuleDecl, RdrNameInstDecl, RdrNameImportDecl,
19 import RnHsSyn ( RenamedHsDecl, RenamedTyClDecl, RenamedRuleDecl, RenamedInstDecl,
21 instDeclFVs, tyClDeclFVs, ruleDeclFVs
24 import CmdLineOpts ( DynFlags, DynFlag(..), opt_InPackage )
26 import RnExpr ( rnStmt )
27 import RnNames ( getGlobalNames, exportsFromAvail )
28 import RnSource ( rnSourceDecls, rnTyClDecl, rnIfaceRuleDecl, rnInstDecl )
29 import RnIfaces ( slurpImpDecls, mkImportInfo, recordLocalSlurps,
31 RecompileRequired, outOfDate, recompileRequired
33 import RnHiFiles ( readIface, loadInterface,
34 loadExports, loadFixDecls, loadDeprecs,
36 import RnEnv ( availsToNameSet,
37 unitAvailEnv, availEnvElts, availNames,
38 plusAvailEnv, groupAvails, warnUnusedImports,
39 warnUnusedLocalBinds, warnUnusedModules,
40 lookupSrcName, getImplicitStmtFVs,
41 getImplicitModuleFVs, newGlobalName, unQualInScope,
42 ubiquitousNames, lookupOccRn, checkMain,
43 plusGlobalRdrEnv, mkGlobalRdrEnv
45 import Module ( Module, ModuleName, WhereFrom(..),
46 moduleNameUserString, moduleName,
49 import Name ( Name, nameModule, isGlobalName )
52 import RdrName ( foldRdrEnv, isQual )
53 import PrelNames ( iNTERACTIVE, pRELUDE_Name )
54 import ErrUtils ( dumpIfSet, dumpIfSet_dyn, showPass,
55 printErrorsAndWarnings, errorsFound )
56 import Bag ( bagToList )
57 import FiniteMap ( FiniteMap, fmToList, emptyFM, lookupFM,
58 addToFM_C, elemFM, addToFM
60 import Maybes ( maybeToBool, catMaybes )
62 import IO ( openFile, IOMode(..) )
63 import HscTypes -- lots of it
64 import List ( partition, nub )
68 %*********************************************************
70 \subsection{The main wrappers}
72 %*********************************************************
75 renameModule :: DynFlags -> GhciMode
76 -> HomeIfaceTable -> HomeSymbolTable
77 -> PersistentCompilerState
78 -> Module -> RdrNameHsModule
79 -> IO (PersistentCompilerState, PrintUnqualified,
80 Maybe (IsExported, ModIface, RnResult))
81 -- Nothing => some error occurred in the renamer
83 renameModule dflags ghci_mode hit hst pcs this_module rdr_module
84 = renameSource dflags hit hst pcs this_module $
85 rename ghci_mode this_module rdr_module
89 renameStmt :: DynFlags
90 -> HomeIfaceTable -> HomeSymbolTable
91 -> PersistentCompilerState
93 -> RdrNameStmt -- parsed stmt
94 -> IO ( PersistentCompilerState,
96 Maybe ([Name], (RenamedStmt, [RenamedHsDecl]))
99 renameStmt dflags hit hst pcs ic stmt
100 = renameSource dflags hit hst pcs iNTERACTIVE $
102 -- load the context module
103 let InteractiveContext{ ic_rn_gbl_env = rdr_env,
104 ic_print_unqual = print_unqual,
105 ic_rn_local_env = local_rdr_env,
106 ic_type_env = type_env } = ic
109 extendTypeEnvRn type_env $
112 initRnMS rdr_env emptyAvailEnv local_rdr_env emptyLocalFixityEnv CmdLineMode (
113 rnStmt stmt $ \ stmt' ->
114 returnRn (([], stmt'), emptyFVs)
115 ) `thenRn` \ ((binders, stmt), fvs) ->
117 -- Bale out if we fail
118 checkErrsRn `thenRn` \ no_errs_so_far ->
119 if not no_errs_so_far then
120 doDump dflags [] stmt [] `thenRn_` returnRn (print_unqual, Nothing)
123 -- Add implicit free vars, and close decls
124 getImplicitStmtFVs `thenRn` \ implicit_fvs ->
125 slurpImpDecls (fvs `plusFV` implicit_fvs) `thenRn` \ decls ->
126 -- NB: an earlier version deleted (rdrEnvElts local_env) from
127 -- the fvs. But (a) that isn't necessary, because previously
128 -- bound things in the local_env will be in the TypeEnv, and
129 -- the renamer doesn't re-slurp such things, and
130 -- (b) it's WRONG to delete them. Consider in GHCi:
131 -- Mod> let x = e :: T
132 -- Mod> let y = x + 3
133 -- We need to pass 'x' among the fvs to slurpImpDecls, so that
134 -- the latter can see that T is a gate, and hence import the Num T
135 -- instance decl. (See the InTypEnv case in RnIfaces.slurpSourceRefs.)
137 doDump dflags binders stmt decls `thenRn_`
138 returnRn (print_unqual, Just (binders, (stmt, decls)))
141 doDump :: DynFlags -> [Name] -> RenamedStmt -> [RenamedHsDecl]
142 -> RnMG (Either IOError ())
143 doDump dflags bndrs stmt decls
144 = ioToRnM (dumpIfSet_dyn dflags Opt_D_dump_rn "Renamer:"
145 (vcat [text "Binders:" <+> ppr bndrs,
147 vcat (map ppr decls)]))
152 -> HomeIfaceTable -> HomeSymbolTable
153 -> PersistentCompilerState
154 -> InteractiveContext
155 -> [RdrName] -- name to rename
156 -> IO ( PersistentCompilerState,
158 Maybe ([Name], [RenamedHsDecl])
161 renameRdrName dflags hit hst pcs ic rdr_names =
162 renameSource dflags hit hst pcs iNTERACTIVE $
164 -- load the context module
165 let InteractiveContext{ ic_rn_gbl_env = rdr_env,
166 ic_print_unqual = print_unqual,
167 ic_rn_local_env = local_rdr_env,
168 ic_type_env = type_env } = ic
171 extendTypeEnvRn type_env $
173 -- rename the rdr_name
174 initRnMS rdr_env emptyAvailEnv local_rdr_env emptyLocalFixityEnv CmdLineMode
175 (mapRn (tryRn.lookupOccRn) rdr_names) `thenRn` \ maybe_names ->
177 ok_names = [ a | Right a <- maybe_names ]
180 then let errs = head [ e | Left e <- maybe_names ]
181 in setErrsRn errs `thenRn_`
182 doDump dflags ok_names [] `thenRn_`
183 returnRn (print_unqual, Nothing)
186 slurpImpDecls (mkNameSet ok_names) `thenRn` \ decls ->
188 doDump dflags ok_names decls `thenRn_`
189 returnRn (print_unqual, Just (ok_names, decls))
191 doDump :: DynFlags -> [Name] -> [RenamedHsDecl] -> RnMG (Either IOError ())
192 doDump dflags names decls
193 = ioToRnM (dumpIfSet_dyn dflags Opt_D_dump_rn "Renamer:"
194 (vcat [ppr names, text "",
195 vcat (map ppr decls)]))
198 %*********************************************************
200 \subsection{Make up an interactive context}
202 %*********************************************************
206 :: DynFlags -> HomeIfaceTable -> HomeSymbolTable
207 -> PersistentCompilerState
208 -> [Module] -> [Module]
209 -> IO (PersistentCompilerState, PrintUnqualified, Maybe GlobalRdrEnv)
210 mkGlobalContext dflags hit hst pcs toplevs exports
211 = renameSource dflags hit hst pcs iNTERACTIVE $
213 mapRn getTopLevScope toplevs `thenRn` \ toplev_envs ->
214 mapRn getModuleExports exports `thenRn` \ export_envs ->
215 let full_env = foldr plusGlobalRdrEnv emptyRdrEnv
216 (toplev_envs ++ export_envs)
217 print_unqual = unQualInScope full_env
219 checkErrsRn `thenRn` \ no_errs_so_far ->
220 if not no_errs_so_far then
221 returnRn (print_unqual, Nothing)
223 returnRn (print_unqual, Just full_env)
225 contextDoc = text "context for compiling statements"
227 getTopLevScope :: Module -> RnM d GlobalRdrEnv
229 loadInterface contextDoc (moduleName mod) ImportByUser `thenRn` \ iface ->
230 case mi_globals iface of
231 Nothing -> panic "getTopLevScope"
232 Just env -> returnRn env
234 getModuleExports :: Module -> RnM d GlobalRdrEnv
235 getModuleExports mod =
236 loadInterface contextDoc (moduleName mod) ImportByUser `thenRn` \ iface ->
237 returnRn (foldl add emptyRdrEnv (mi_exports iface))
239 prov_fn n = NonLocalDef ImplicitImport
240 add env (mod,avails) =
241 plusGlobalRdrEnv env (mkGlobalRdrEnv mod True prov_fn avails NoDeprecs)
244 %*********************************************************
246 \subsection{Slurp in a whole module eagerly}
248 %*********************************************************
252 :: DynFlags -> HomeIfaceTable -> HomeSymbolTable
253 -> PersistentCompilerState -> Module
254 -> IO (PersistentCompilerState, PrintUnqualified,
255 Maybe ([Name], [RenamedHsDecl]))
256 slurpIface dflags hit hst pcs mod =
257 renameSource dflags hit hst pcs iNTERACTIVE $
259 let mod_name = moduleName mod
261 loadInterface contextDoc mod_name ImportByUser `thenRn` \ iface ->
262 let fvs = availsToNameSet [ avail | (mn,avails) <- mi_exports iface,
265 slurpImpDecls fvs `thenRn` \ rn_imp_decls ->
266 returnRn (alwaysQualify, Just (nameSetToList fvs, rn_imp_decls))
269 %*********************************************************
271 \subsection{The main function: rename}
273 %*********************************************************
276 renameSource :: DynFlags
277 -> HomeIfaceTable -> HomeSymbolTable
278 -> PersistentCompilerState
280 -> RnMG (PrintUnqualified, Maybe r)
281 -> IO (PersistentCompilerState, PrintUnqualified, Maybe r)
282 -- Nothing => some error occurred in the renamer
284 renameSource dflags hit hst old_pcs this_module thing_inside
285 = do { showPass dflags "Renamer"
287 -- Initialise the renamer monad
288 ; (new_pcs, msgs, (print_unqual, maybe_rn_stuff))
289 <- initRn dflags hit hst old_pcs this_module thing_inside
291 -- Print errors from renaming
292 ; printErrorsAndWarnings print_unqual msgs ;
294 -- Return results. No harm in updating the PCS
295 ; if errorsFound msgs then
296 return (new_pcs, print_unqual, Nothing)
298 return (new_pcs, print_unqual, maybe_rn_stuff)
303 data RnResult -- A RenamedModule ia passed from renamer to typechecker
304 = RnResult { rr_mod :: Module, -- Same as in the ModIface,
305 rr_fixities :: FixityEnv, -- but convenient to have it here
307 rr_main :: Maybe Name, -- Just main, for module Main,
308 -- Nothing for other modules
310 rr_decls :: [RenamedHsDecl]
311 -- The other declarations of the module
312 -- Fixity and deprecations have already been slurped out
313 } -- and are now in the ModIface for the module
315 rename :: GhciMode -> Module -> RdrNameHsModule
316 -> RnMG (PrintUnqualified, Maybe (IsExported, ModIface, RnResult))
317 rename ghci_mode this_module
318 contents@(HsModule _ _ exports imports local_decls mod_deprec loc)
321 -- FIND THE GLOBAL NAME ENVIRONMENT
322 getGlobalNames this_module contents `thenRn` \ (gbl_env, local_gbl_env,
323 (mod_avail_env, global_avail_env)) ->
325 print_unqualified = unQualInScope gbl_env
327 full_avail_env :: NameEnv AvailInfo
328 -- The domain of global_avail_env is just the 'major' things;
329 -- variables, type constructors, classes.
330 -- E.g. Functor |-> Functor( Functor, fmap )
331 -- The domain of full_avail_env is everything in scope
332 -- E.g. Functor |-> Functor( Functor, fmap )
333 -- fmap |-> Functor( Functor, fmap )
335 -- This filled-out avail_env is needed to generate
336 -- exports (mkExportAvails), and for generating minimal
337 -- exports (reportUnusedNames)
338 full_avail_env = mkNameEnv [ (name,avail)
339 | avail <- availEnvElts global_avail_env,
340 name <- availNames avail]
342 -- Exit if we've found any errors
343 checkErrsRn `thenRn` \ no_errs_so_far ->
344 if not no_errs_so_far then
345 -- Found errors already, so exit now
346 rnDump [] [] `thenRn_`
347 returnRn (print_unqualified, Nothing)
350 -- PROCESS EXPORT LIST
351 exportsFromAvail mod_name exports mod_avail_env
352 full_avail_env gbl_env `thenRn` \ export_avails ->
354 traceRn (text "Local top-level environment" $$
355 nest 4 (pprGlobalRdrEnv local_gbl_env)) `thenRn_`
357 -- DEAL WITH DEPRECATIONS
358 rnDeprecs local_gbl_env mod_deprec
359 [d | DeprecD d <- local_decls] `thenRn` \ my_deprecs ->
361 -- DEAL WITH LOCAL FIXITIES
362 fixitiesFromLocalDecls local_gbl_env local_decls `thenRn` \ local_fixity_env ->
365 rnSourceDecls gbl_env global_avail_env
366 local_fixity_env local_decls `thenRn` \ (rn_local_decls, source_fvs) ->
368 -- GET ANY IMPLICIT FREE VARIALBES
369 getImplicitModuleFVs rn_local_decls `thenRn` \ implicit_fvs ->
370 checkMain ghci_mode mod_name gbl_env `thenRn` \ (maybe_main_name, main_fvs, implicit_main_fvs) ->
372 export_fvs = availsToNameSet export_avails
373 used_fvs = source_fvs `plusFV` export_fvs `plusFV` main_fvs
374 -- The export_fvs make the exported names look just as if they
375 -- occurred in the source program. For the reasoning, see the
376 -- comments with RnIfaces.mkImportInfo
377 -- It also helps reportUnusedNames, which of course must not complain
378 -- that 'f' isn't mentioned if it is mentioned in the export list
380 needed_fvs = implicit_fvs `plusFV` implicit_main_fvs `plusFV` used_fvs
381 -- It's important to do the "plus" this way round, so that
382 -- when compiling the prelude, locally-defined (), Bool, etc
383 -- override the implicit ones.
386 traceRn (text "Needed FVs:" <+> fsep (map ppr (nameSetToList needed_fvs))) `thenRn_`
388 -- EXIT IF ERRORS FOUND
389 -- We exit here if there are any errors in the source, *before*
390 -- we attempt to slurp the decls from the interfaces, otherwise
391 -- the slurped decls may get lost when we return up the stack
392 -- to hscMain/hscExpr.
393 checkErrsRn `thenRn` \ no_errs_so_far ->
394 if not no_errs_so_far then
395 -- Found errors already, so exit now
396 rnDump [] rn_local_decls `thenRn_`
397 returnRn (print_unqualified, Nothing)
400 -- SLURP IN ALL THE NEEDED DECLARATIONS
401 slurpImpDecls needed_fvs `thenRn` \ rn_imp_decls ->
402 rnDump rn_imp_decls rn_local_decls `thenRn_`
404 -- GENERATE THE VERSION/USAGE INFO
405 mkImportInfo mod_name imports `thenRn` \ my_usages ->
407 -- BUILD THE MODULE INTERFACE
409 -- We record fixities even for things that aren't exported,
410 -- so that we can change into the context of this moodule easily
411 fixities = mkNameEnv [ (name, fixity)
412 | FixitySig name fixity loc <- nameEnvElts local_fixity_env
415 -- Sort the exports to make them easier to compare for versions
416 my_exports = groupAvails this_module export_avails
418 final_decls = rn_local_decls ++ rn_imp_decls
420 -- In interactive mode, we don't want to discard any top-level
421 -- entities at all (eg. do not inline them away during
422 -- simplification), and retain them all in the TypeEnv so they are
423 -- available from the command line.
425 -- isGlobalName separates the user-defined top-level names from those
426 -- introduced by the type checker.
427 dont_discard :: Name -> Bool
428 dont_discard | ghci_mode == Interactive = isGlobalName
429 | otherwise = (`elemNameSet` exported_names)
431 exported_names = availsToNameSet export_avails
433 mod_iface = ModIface { mi_module = this_module,
434 mi_package = opt_InPackage,
435 mi_version = initialVersionInfo,
436 mi_usages = my_usages,
438 mi_orphan = panic "is_orphan",
439 mi_exports = my_exports,
440 mi_globals = Just gbl_env,
441 mi_fixities = fixities,
442 mi_deprecs = my_deprecs,
443 mi_decls = panic "mi_decls"
446 rn_result = RnResult { rr_mod = this_module,
447 rr_fixities = fixities,
448 rr_decls = final_decls,
449 rr_main = maybe_main_name }
452 -- REPORT UNUSED NAMES, AND DEBUG DUMP
453 reportUnusedNames mod_iface print_unqualified
454 imports full_avail_env gbl_env
455 used_fvs rn_imp_decls `thenRn_`
456 -- NB: used_fvs: include exports (else we get bogus
457 -- warnings of unused things) but not implicit FVs.
459 returnRn (print_unqualified, Just (dont_discard, mod_iface, rn_result))
461 mod_name = moduleName this_module
466 %*********************************************************
468 \subsection{Fixities}
470 %*********************************************************
473 fixitiesFromLocalDecls :: GlobalRdrEnv -> [RdrNameHsDecl] -> RnMG LocalFixityEnv
474 fixitiesFromLocalDecls gbl_env decls
475 = foldlRn getFixities emptyNameEnv decls `thenRn` \ env ->
476 traceRn (text "fixity env" <+> vcat (map ppr (nameEnvElts env))) `thenRn_`
479 getFixities :: LocalFixityEnv -> RdrNameHsDecl -> RnMG LocalFixityEnv
480 getFixities acc (FixD fix)
483 getFixities acc (TyClD (ClassDecl { tcdSigs = sigs}))
484 = foldlRn fix_decl acc [sig | FixSig sig <- sigs]
485 -- Get fixities from class decl sigs too.
486 getFixities acc other_decl
489 fix_decl acc sig@(FixitySig rdr_name fixity loc)
490 = -- Check for fixity decl for something not declared
492 lookupSrcName gbl_env rdr_name `thenRn` \ name ->
494 -- Check for duplicate fixity decl
495 case lookupNameEnv acc name of
496 Just (FixitySig _ _ loc') -> addErrRn (dupFixityDecl rdr_name loc loc') `thenRn_`
499 Nothing -> returnRn (extendNameEnv acc name (FixitySig name fixity loc))
503 %*********************************************************
505 \subsection{Deprecations}
507 %*********************************************************
509 For deprecations, all we do is check that the names are in scope.
510 It's only imported deprecations, dealt with in RnIfaces, that we
511 gather them together.
514 rnDeprecs :: GlobalRdrEnv -> Maybe DeprecTxt
515 -> [RdrNameDeprecation] -> RnMG Deprecations
516 rnDeprecs gbl_env Nothing []
519 rnDeprecs gbl_env (Just txt) decls
520 = mapRn (addErrRn . badDeprec) decls `thenRn_`
521 returnRn (DeprecAll txt)
523 rnDeprecs gbl_env Nothing decls
524 = mapRn rn_deprec decls `thenRn` \ pairs ->
525 returnRn (DeprecSome (mkNameEnv (catMaybes pairs)))
527 rn_deprec (Deprecation rdr_name txt loc)
529 lookupSrcName gbl_env rdr_name `thenRn` \ name ->
530 returnRn (Just (name, (name,txt)))
534 %************************************************************************
536 \subsection{Grabbing the old interface file and checking versions}
538 %************************************************************************
541 checkOldIface :: GhciMode
543 -> HomeIfaceTable -> HomeSymbolTable
544 -> PersistentCompilerState
547 -> Bool -- Source unchanged
548 -> Maybe ModIface -- Old interface from compilation manager, if any
549 -> IO (PersistentCompilerState, Bool, (RecompileRequired, Maybe ModIface))
550 -- True <=> errors happened
552 checkOldIface ghci_mode dflags hit hst pcs mod iface_path source_unchanged maybe_iface
553 = runRn dflags hit hst pcs (panic "Bogus module") $
555 -- CHECK WHETHER THE SOURCE HAS CHANGED
556 ( if not source_unchanged then
557 traceHiDiffsRn (nest 4 (text "Source file changed or recompilation check turned off"))
558 else returnRn () ) `thenRn_`
560 -- If the source has changed and we're in interactive mode, avoid reading
561 -- an interface; just return the one we might have been supplied with.
562 if ghci_mode == Interactive && not source_unchanged then
563 returnRn (outOfDate, maybe_iface)
568 Just old_iface -> -- Use the one we already have
569 check_versions old_iface
571 Nothing -- try and read it from a file
572 -> readIface iface_path `thenRn` \ read_result ->
574 Left err -> -- Old interface file not found, or garbled; give up
576 text "Cannot read old interface file:"
577 $$ nest 4 err) `thenRn_`
578 returnRn (outOfDate, Nothing)
580 Right parsed_iface ->
581 let read_mod_name = pi_mod parsed_iface
582 wanted_mod_name = moduleName mod
584 if (wanted_mod_name /= read_mod_name) then
586 text "Existing interface file has wrong module name: "
587 <> quotes (ppr read_mod_name)
589 returnRn (outOfDate, Nothing)
591 loadOldIface mod parsed_iface `thenRn` \ m_iface ->
592 check_versions m_iface
594 check_versions :: ModIface -> RnMG (RecompileRequired, Maybe ModIface)
596 | not source_unchanged
597 = returnRn (outOfDate, Just iface)
600 recompileRequired iface_path iface `thenRn` \ recompile ->
601 returnRn (recompile, Just iface)
604 I think the following function should now have a more representative name,
608 loadOldIface :: Module -> ParsedIface -> RnMG ModIface
610 loadOldIface mod parsed_iface
611 = let iface = parsed_iface
614 loadHomeDecls (pi_decls iface) `thenRn` \ decls ->
615 loadHomeRules (pi_rules iface) `thenRn` \ rules ->
616 loadHomeInsts (pi_insts iface) `thenRn` \ insts ->
617 returnRn (decls, rules, insts)
619 `thenRn` \ ((decls_vers, new_decls), (rule_vers, new_rules), new_insts) ->
621 mapRn loadHomeUsage (pi_usages iface) `thenRn` \ usages ->
622 loadExports (pi_exports iface) `thenRn` \ (export_vers, avails) ->
623 loadFixDecls mod (pi_fixity iface) `thenRn` \ fix_env ->
624 loadDeprecs mod (pi_deprecs iface) `thenRn` \ deprec_env ->
626 version = VersionInfo { vers_module = pi_vers iface,
627 vers_exports = export_vers,
628 vers_rules = rule_vers,
629 vers_decls = decls_vers }
631 decls = mkIfaceDecls new_decls new_rules new_insts
633 mod_iface = ModIface { mi_module = mod, mi_package = pi_pkg parsed_iface,
634 mi_version = version,
635 mi_exports = avails, mi_usages = usages,
636 mi_boot = False, mi_orphan = pi_orphan iface,
637 mi_fixities = fix_env, mi_deprecs = deprec_env,
646 loadHomeDecls :: [(Version, RdrNameTyClDecl)]
647 -> RnMS (NameEnv Version, [RenamedTyClDecl])
648 loadHomeDecls decls = foldlRn loadHomeDecl (emptyNameEnv, []) decls
650 loadHomeDecl :: (NameEnv Version, [RenamedTyClDecl])
651 -> (Version, RdrNameTyClDecl)
652 -> RnMS (NameEnv Version, [RenamedTyClDecl])
653 loadHomeDecl (version_map, decls) (version, decl)
654 = rnTyClDecl decl `thenRn` \ decl' ->
655 returnRn (extendNameEnv version_map (tyClDeclName decl') version, decl':decls)
658 loadHomeRules :: (Version, [RdrNameRuleDecl])
659 -> RnMS (Version, [RenamedRuleDecl])
660 loadHomeRules (version, rules)
661 = mapRn rnIfaceRuleDecl rules `thenRn` \ rules' ->
662 returnRn (version, rules')
665 loadHomeInsts :: [RdrNameInstDecl]
666 -> RnMS [RenamedInstDecl]
667 loadHomeInsts insts = mapRn rnInstDecl insts
670 loadHomeUsage :: ImportVersion OccName
671 -> RnMG (ImportVersion Name)
672 loadHomeUsage (mod_name, orphans, is_boot, whats_imported)
673 = rn_imps whats_imported `thenRn` \ whats_imported' ->
674 returnRn (mod_name, orphans, is_boot, whats_imported')
676 rn_imps NothingAtAll = returnRn NothingAtAll
677 rn_imps (Everything v) = returnRn (Everything v)
678 rn_imps (Specifically mv ev items rv) = mapRn rn_imp items `thenRn` \ items' ->
679 returnRn (Specifically mv ev items' rv)
680 rn_imp (occ,vers) = newGlobalName mod_name occ `thenRn` \ name ->
686 %*********************************************************
688 \subsection{Closing up the interface decls}
690 %*********************************************************
692 Suppose we discover we don't need to recompile. Then we start from the
693 IfaceDecls in the ModIface, and fluff them up by sucking in all the decls they need.
696 closeIfaceDecls :: DynFlags
697 -> HomeIfaceTable -> HomeSymbolTable
698 -> PersistentCompilerState
699 -> ModIface -- Get the decls from here
700 -> IO (PersistentCompilerState, Bool, [RenamedHsDecl])
701 -- True <=> errors happened
702 closeIfaceDecls dflags hit hst pcs
703 mod_iface@(ModIface { mi_module = mod, mi_decls = iface_decls })
704 = runRn dflags hit hst pcs mod $
707 rule_decls = dcl_rules iface_decls
708 inst_decls = dcl_insts iface_decls
709 tycl_decls = dcl_tycl iface_decls
710 decls = map RuleD rule_decls ++
711 map InstD inst_decls ++
713 needed = unionManyNameSets (map ruleDeclFVs rule_decls) `unionNameSets`
714 unionManyNameSets (map instDeclFVs inst_decls) `unionNameSets`
715 unionManyNameSets (map tyClDeclFVs tycl_decls)
716 local_names = foldl add emptyNameSet tycl_decls
717 add names decl = addListToNameSet names (map fst (tyClDeclSysNames decl ++ tyClDeclNames decl))
720 recordLocalSlurps local_names `thenRn_`
722 -- Do the transitive closure
723 closeDecls decls (needed `plusFV` implicit_fvs) `thenRn` \closed_decls ->
724 rnDump [] closed_decls `thenRn_`
725 returnRn closed_decls
727 implicit_fvs = ubiquitousNames -- Data type decls with record selectors,
728 -- which may appear in the decls, need unpackCString
729 -- and friends. It's easier to just grab them right now.
732 %*********************************************************
734 \subsection{Unused names}
736 %*********************************************************
739 reportUnusedNames :: ModIface -> PrintUnqualified
740 -> [RdrNameImportDecl]
743 -> NameSet -- Used in this module
746 reportUnusedNames my_mod_iface unqual imports avail_env gbl_env
747 used_names imported_decls
748 = warnUnusedModules unused_imp_mods `thenRn_`
749 warnUnusedLocalBinds bad_locals `thenRn_`
750 warnUnusedImports bad_imp_names `thenRn_`
751 printMinimalImports this_mod unqual minimal_imports
753 this_mod = mi_module my_mod_iface
755 -- Now, a use of C implies a use of T,
756 -- if C was brought into scope by T(..) or T(C)
757 really_used_names = used_names `unionNameSets`
758 mkNameSet [ parent_name
759 | sub_name <- nameSetToList used_names
761 -- Usually, every used name will appear in avail_env, but there
762 -- is one time when it doesn't: tuples and other built in syntax. When you
763 -- write (a,b) that gives rise to a *use* of "(,)", so that the
764 -- instances will get pulled in, but the tycon "(,)" isn't actually
765 -- in scope. Also, (-x) gives rise to an implicit use of 'negate';
766 -- similarly, 3.5 gives rise to an implcit use of :%
767 -- Hence the silent 'False' in all other cases
769 , Just parent_name <- [case lookupNameEnv avail_env sub_name of
770 Just (AvailTC n _) -> Just n
774 -- Collect the defined names from the in-scope environment
775 -- Look for the qualified ones only, else get duplicates
776 defined_names :: [GlobalRdrElt]
777 defined_names = foldRdrEnv add [] gbl_env
778 add rdr_name ns acc | isQual rdr_name = ns ++ acc
781 defined_and_used, defined_but_not_used :: [GlobalRdrElt]
782 (defined_and_used, defined_but_not_used) = partition used defined_names
783 used (GRE name _ _) = name `elemNameSet` really_used_names
785 -- Filter out the ones only defined implicitly
787 bad_locals = [n | (GRE n LocalDef _) <- defined_but_not_used]
789 bad_imp_names :: [(Name,Provenance)]
790 bad_imp_names = [(n,p) | GRE n p@(NonLocalDef (UserImport mod _ True)) _ <- defined_but_not_used,
791 not (module_unused mod)]
793 -- inst_mods are directly-imported modules that
794 -- contain instance decl(s) that the renamer decided to suck in
795 -- It's not necessarily redundant to import such modules.
801 -- The import M() is not *necessarily* redundant, even if
802 -- we suck in no instance decls from M (e.g. it contains
803 -- no instance decls, or This contains no code). It may be
804 -- that we import M solely to ensure that M's orphan instance
805 -- decls (or those in its imports) are visible to people who
806 -- import This. Sigh.
807 -- There's really no good way to detect this, so the error message
808 -- in RnEnv.warnUnusedModules is weakened instead
809 inst_mods :: [ModuleName]
810 inst_mods = [m | InstD (InstDecl _ _ _ (Just dfun) _) <- imported_decls,
811 let m = moduleName (nameModule dfun),
812 m `elem` direct_import_mods
815 -- To figure out the minimal set of imports, start with the things
816 -- that are in scope (i.e. in gbl_env). Then just combine them
817 -- into a bunch of avails, so they are properly grouped
818 minimal_imports :: FiniteMap ModuleName AvailEnv
819 minimal_imports0 = emptyFM
820 minimal_imports1 = foldr add_name minimal_imports0 defined_and_used
821 minimal_imports = foldr add_inst_mod minimal_imports1 inst_mods
823 -- We've carefully preserved the provenance so that we can
824 -- construct minimal imports that import the name by (one of)
825 -- the same route(s) as the programmer originally did.
826 add_name (GRE n (NonLocalDef (UserImport m _ _)) _) acc = addToFM_C plusAvailEnv acc (moduleName m)
827 (unitAvailEnv (mk_avail n))
828 add_name (GRE n other_prov _) acc = acc
830 mk_avail n = case lookupNameEnv avail_env n of
831 Just (AvailTC m _) | n==m -> AvailTC n [n]
832 | otherwise -> AvailTC m [n,m]
833 Just avail -> Avail n
834 Nothing -> pprPanic "mk_avail" (ppr n)
837 | m `elemFM` acc = acc -- We import something already
838 | otherwise = addToFM acc m emptyAvailEnv
839 -- Add an empty collection of imports for a module
840 -- from which we have sucked only instance decls
842 direct_import_mods :: [ModuleName]
843 direct_import_mods = nub [m | ImportDecl m _ _ _ _ _ <- imports]
845 -- unused_imp_mods are the directly-imported modules
846 -- that are not mentioned in minimal_imports
847 unused_imp_mods = [m | m <- direct_import_mods,
848 not (maybeToBool (lookupFM minimal_imports m)),
851 module_unused :: Module -> Bool
852 module_unused mod = moduleName mod `elem` unused_imp_mods
855 -- ToDo: deal with original imports with 'qualified' and 'as M' clauses
856 printMinimalImports :: Module -- This module
858 -> FiniteMap ModuleName AvailEnv -- Minimal imports
860 printMinimalImports this_mod unqual imps
861 = ifOptRn Opt_D_dump_minimal_imports $
863 mapRn to_ies (fmToList imps) `thenRn` \ mod_ies ->
864 ioToRnM (do { h <- openFile filename WriteMode ;
865 printForUser h unqual (vcat (map ppr_mod_ie mod_ies))
869 filename = moduleNameUserString (moduleName this_mod) ++ ".imports"
870 ppr_mod_ie (mod_name, ies)
871 | mod_name == pRELUDE_Name
874 = ptext SLIT("import") <+> ppr mod_name <>
875 parens (fsep (punctuate comma (map ppr ies)))
877 to_ies (mod, avail_env) = mapRn to_ie (availEnvElts avail_env) `thenRn` \ ies ->
880 to_ie :: AvailInfo -> RnMG (IE Name)
881 -- The main trick here is that if we're importing all the constructors
882 -- we want to say "T(..)", but if we're importing only a subset we want
883 -- to say "T(A,B,C)". So we have to find out what the module exports.
884 to_ie (Avail n) = returnRn (IEVar n)
885 to_ie (AvailTC n [m]) = ASSERT( n==m )
886 returnRn (IEThingAbs n)
888 = loadInterface (text "Compute minimal imports from" <+> ppr n_mod)
889 n_mod ImportBySystem `thenRn` \ iface ->
890 case [xs | (m,as) <- mi_exports iface,
894 [xs] | all (`elem` ns) xs -> returnRn (IEThingAll n)
895 | otherwise -> returnRn (IEThingWith n (filter (/= n) ns))
896 other -> pprTrace "to_ie" (ppr n <+> ppr (nameModule n) <+> ppr other) $
899 n_mod = moduleName (nameModule n)
901 rnDump :: [RenamedHsDecl] -- Renamed imported decls
902 -> [RenamedHsDecl] -- Renamed local decls
904 rnDump imp_decls local_decls
905 = doptRn Opt_D_dump_rn_trace `thenRn` \ dump_rn_trace ->
906 doptRn Opt_D_dump_rn_stats `thenRn` \ dump_rn_stats ->
907 doptRn Opt_D_dump_rn `thenRn` \ dump_rn ->
908 getIfacesRn `thenRn` \ ifaces ->
910 ioToRnM (do { dumpIfSet (dump_rn_trace || dump_rn_stats || dump_rn)
912 (getRnStats imp_decls ifaces) ;
914 dumpIfSet dump_rn "Renamer:"
915 (vcat (map ppr (local_decls ++ imp_decls)))
922 %*********************************************************
924 \subsection{Statistics}
926 %*********************************************************
929 getRnStats :: [RenamedHsDecl] -> Ifaces -> SDoc
930 getRnStats imported_decls ifaces
931 = hcat [text "Renamer stats: ", stats]
933 n_mods = length [() | _ <- moduleEnvElts (iPIT ifaces)]
934 -- This is really only right for a one-shot compile
936 (decls_map, n_decls_slurped) = iDecls ifaces
938 n_decls_left = length [decl | (avail, True, (_,decl)) <- nameEnvElts decls_map
939 -- Data, newtype, and class decls are in the decls_fm
940 -- under multiple names; the tycon/class, and each
941 -- constructor/class op too.
942 -- The 'True' selects just the 'main' decl
945 (insts_left, n_insts_slurped) = iInsts ifaces
946 n_insts_left = length (bagToList insts_left)
948 (rules_left, n_rules_slurped) = iRules ifaces
949 n_rules_left = length (bagToList rules_left)
952 [int n_mods <+> text "interfaces read",
953 hsep [ int n_decls_slurped, text "type/class/variable imported, out of",
954 int (n_decls_slurped + n_decls_left), text "read"],
955 hsep [ int n_insts_slurped, text "instance decls imported, out of",
956 int (n_insts_slurped + n_insts_left), text "read"],
957 hsep [ int n_rules_slurped, text "rule decls imported, out of",
958 int (n_rules_slurped + n_rules_left), text "read"]
963 %************************************************************************
965 \subsection{Errors and warnings}
967 %************************************************************************
970 dupFixityDecl rdr_name loc1 loc2
971 = vcat [ptext SLIT("Multiple fixity declarations for") <+> quotes (ppr rdr_name),
972 ptext SLIT("at ") <+> ppr loc1,
973 ptext SLIT("and") <+> ppr loc2]
976 = sep [ptext SLIT("Illegal deprecation when whole module is deprecated"),