2 % (c) The GRASP Project, Glasgow University, 1992-1998
4 \section[Rename]{Renaming and dependency analysis passes}
7 module Rename ( renameModule, renameExpr, closeIfaceDecls, checkOldIface ) where
9 #include "HsVersions.h"
12 import RdrHsSyn ( RdrNameHsModule, RdrNameHsDecl, RdrNameDeprecation, RdrNameHsExpr,
13 RdrNameTyClDecl, RdrNameRuleDecl, RdrNameInstDecl, RdrNameImportDecl
15 import RnHsSyn ( RenamedHsDecl, RenamedTyClDecl, RenamedRuleDecl, RenamedInstDecl,
16 extractHsTyNames, RenamedHsExpr,
17 instDeclFVs, tyClDeclFVs, ruleDeclFVs
20 import CmdLineOpts ( DynFlags, DynFlag(..) )
22 import RnExpr ( rnExpr )
23 import RnNames ( getGlobalNames, exportsFromAvail )
24 import RnSource ( rnSourceDecls, rnTyClDecl, rnIfaceRuleDecl, rnInstDecl )
25 import RnIfaces ( slurpImpDecls, mkImportInfo, recordLocalSlurps,
26 getInterfaceExports, closeDecls,
27 RecompileRequired, outOfDate, recompileRequired
29 import RnHiFiles ( readIface, removeContext, loadInterface,
30 loadExports, loadFixDecls, loadDeprecs,
32 import RnEnv ( availsToNameSet, availName, mkIfaceGlobalRdrEnv,
33 emptyAvailEnv, unitAvailEnv, availEnvElts,
34 plusAvailEnv, groupAvails, warnUnusedImports,
35 warnUnusedLocalBinds, warnUnusedModules,
36 lookupOrigNames, lookupSrcName,
37 newGlobalName, unQualInScope
39 import Module ( Module, ModuleName, WhereFrom(..),
40 moduleNameUserString, moduleName,
43 import Name ( Name, NamedThing(..), getSrcLoc,
44 nameIsLocalOrFrom, nameOccName, nameModule,
46 import Name ( mkNameEnv, nameEnvElts, extendNameEnv )
47 import RdrName ( foldRdrEnv, isQual )
48 import OccName ( occNameFlavour )
50 import TysWiredIn ( unitTyCon, intTyCon, boolTyCon )
51 import PrelNames ( mAIN_Name, pREL_MAIN_Name, pRELUDE_Name,
52 ioTyConName, printName,
53 unpackCStringName, unpackCStringFoldrName, unpackCStringUtf8Name,
56 import PrelInfo ( derivingOccurrences )
57 import Type ( funTyCon )
58 import ErrUtils ( dumpIfSet, dumpIfSet_dyn, showPass,
59 printErrorsAndWarnings, errorsFound )
60 import Bag ( bagToList )
61 import FiniteMap ( FiniteMap, fmToList, emptyFM, lookupFM,
62 addToFM_C, elemFM, addToFM
64 import UniqFM ( lookupWithDefaultUFM )
65 import Maybes ( maybeToBool, catMaybes )
67 import IO ( openFile, IOMode(..) )
68 import HscTypes ( PersistentCompilerState, HomeIfaceTable, HomeSymbolTable,
69 ModIface(..), WhatsImported(..),
70 VersionInfo(..), ImportVersion, IsExported,
71 IfaceDecls, mkIfaceDecls, dcl_tycl, dcl_rules, dcl_insts,
72 GlobalRdrEnv, pprGlobalRdrEnv,
73 AvailEnv, GenAvailInfo(..), AvailInfo, Avails,
74 Provenance(..), ImportReason(..), initialVersionInfo,
75 Deprecations(..), lookupDeprec, lookupIface
77 import CmStaticInfo ( GhciMode(..) )
78 import List ( partition, nub )
84 %*********************************************************
86 \subsection{The two main wrappers}
88 %*********************************************************
91 renameModule :: DynFlags
92 -> HomeIfaceTable -> HomeSymbolTable
93 -> PersistentCompilerState
94 -> Module -> RdrNameHsModule
95 -> IO (PersistentCompilerState, Maybe (PrintUnqualified, (IsExported, ModIface, [RenamedHsDecl])))
96 -- Nothing => some error occurred in the renamer
98 renameModule dflags hit hst pcs this_module rdr_module
99 = renameSource dflags hit hst pcs this_module $
100 rename this_module rdr_module
105 renameExpr :: DynFlags
106 -> HomeIfaceTable -> HomeSymbolTable
107 -> PersistentCompilerState
108 -> Module -> RdrNameHsExpr
109 -> IO ( PersistentCompilerState,
110 Maybe (PrintUnqualified, (RenamedHsExpr, [RenamedHsDecl]))
113 renameExpr dflags hit hst pcs this_module expr
114 = renameSource dflags hit hst pcs this_module $
115 tryLoadInterface doc (moduleName this_module) ImportByUser
116 `thenRn` \ (iface, maybe_err) ->
118 Just msg -> ioToRnM (printErrs alwaysQualify
119 (ptext SLIT("failed to load interface for")
120 <+> quotes (ppr this_module)
121 <> char ':' <+> msg)) `thenRn_`
125 let rdr_env = mi_globals iface
126 print_unqual = unQualInScope rdr_env
129 initRnMS rdr_env emptyLocalFixityEnv CmdLineMode (rnExpr expr)
130 `thenRn` \ (e,fvs) ->
132 checkErrsRn `thenRn` \ no_errs_so_far ->
133 if not no_errs_so_far then
134 -- Found errors already, so exit now
135 doDump e [] `thenRn_`
140 implicit_fvs = fvs `plusFV` string_names
141 `plusFV` default_tycon_names
142 `plusFV` unitFV printName
143 -- print :: a -> IO () may be needed later
145 slurpImpDecls (fvs `plusFV` implicit_fvs) `thenRn` \ decls ->
147 doDump e decls `thenRn_`
148 returnRn (Just (print_unqual, (e, decls)))
151 doc = text "context for compiling expression"
153 doDump :: RenamedHsExpr -> [RenamedHsDecl] -> RnMG (Either IOError ())
155 getDOptsRn `thenRn` \ dflags ->
156 ioToRnM (dumpIfSet_dyn dflags Opt_D_dump_rn "Renamer:"
157 (vcat (ppr e : map ppr decls)))
161 %*********************************************************
163 \subsection{The main function: rename}
165 %*********************************************************
168 renameSource :: DynFlags
169 -> HomeIfaceTable -> HomeSymbolTable
170 -> PersistentCompilerState
172 -> RnMG (Maybe (PrintUnqualified, r))
173 -> IO (PersistentCompilerState, Maybe (PrintUnqualified, r))
174 -- Nothing => some error occurred in the renamer
176 renameSource dflags hit hst old_pcs this_module thing_inside
177 = do { showPass dflags "Renamer"
179 -- Initialise the renamer monad
180 ; (new_pcs, msgs, maybe_rn_stuff) <- initRn dflags hit hst old_pcs this_module thing_inside
182 -- Print errors from renaming
183 ; let print_unqual = case maybe_rn_stuff of
184 Just (unqual, _) -> unqual
185 Nothing -> alwaysQualify
187 ; printErrorsAndWarnings print_unqual msgs ;
189 -- Return results. No harm in updating the PCS
190 ; if errorsFound msgs then
191 return (new_pcs, Nothing)
193 return (new_pcs, maybe_rn_stuff)
198 rename :: Module -> RdrNameHsModule -> RnMG (Maybe (PrintUnqualified, (IsExported, ModIface, [RenamedHsDecl])))
199 rename this_module contents@(HsModule _ _ exports imports local_decls mod_deprec loc)
202 -- FIND THE GLOBAL NAME ENVIRONMENT
203 getGlobalNames this_module contents `thenRn` \ (gbl_env, local_gbl_env, all_avails@(_, global_avail_env)) ->
205 -- Exit if we've found any errors
206 checkErrsRn `thenRn` \ no_errs_so_far ->
207 if not no_errs_so_far then
208 -- Found errors already, so exit now
209 rnDump [] [] `thenRn_`
213 -- PROCESS EXPORT LIST
214 exportsFromAvail mod_name exports all_avails gbl_env `thenRn` \ export_avails ->
216 traceRn (text "Local top-level environment" $$
217 nest 4 (pprGlobalRdrEnv local_gbl_env)) `thenRn_`
219 -- DEAL WITH DEPRECATIONS
220 rnDeprecs local_gbl_env mod_deprec
221 [d | DeprecD d <- local_decls] `thenRn` \ my_deprecs ->
223 -- DEAL WITH LOCAL FIXITIES
224 fixitiesFromLocalDecls local_gbl_env local_decls `thenRn` \ local_fixity_env ->
227 rnSourceDecls gbl_env local_fixity_env local_decls `thenRn` \ (rn_local_decls, source_fvs) ->
229 -- EXIT IF ERRORS FOUND
230 -- We exit here if there are any errors in the source, *before*
231 -- we attempt to slurp the decls from the interfaces, otherwise
232 -- the slurped decls may get lost when we return up the stack
233 -- to hscMain/hscExpr.
234 checkErrsRn `thenRn` \ no_errs_so_far ->
235 if not no_errs_so_far then
236 -- Found errors already, so exit now
237 rnDump [] rn_local_decls `thenRn_`
241 -- SLURP IN ALL THE NEEDED DECLARATIONS
242 implicitFVs mod_name rn_local_decls `thenRn` \ implicit_fvs ->
244 slurp_fvs = implicit_fvs `plusFV` source_fvs
245 -- It's important to do the "plus" this way round, so that
246 -- when compiling the prelude, locally-defined (), Bool, etc
247 -- override the implicit ones.
249 traceRn (text "Source FVs:" <+> fsep (map ppr (nameSetToList slurp_fvs))) `thenRn_`
250 slurpImpDecls slurp_fvs `thenRn` \ rn_imp_decls ->
252 rnDump rn_imp_decls rn_local_decls `thenRn_`
254 -- GENERATE THE VERSION/USAGE INFO
255 mkImportInfo mod_name imports `thenRn` \ my_usages ->
257 -- BUILD THE MODULE INTERFACE
259 -- We record fixities even for things that aren't exported,
260 -- so that we can change into the context of this moodule easily
261 fixities = mkNameEnv [ (name, fixity)
262 | FixitySig name fixity loc <- nameEnvElts local_fixity_env
265 -- Sort the exports to make them easier to compare for versions
266 my_exports = groupAvails this_module export_avails
268 final_decls = rn_local_decls ++ rn_imp_decls
269 is_orphan = any (isOrphanDecl this_module) rn_local_decls
271 mod_iface = ModIface { mi_module = this_module,
272 mi_version = initialVersionInfo,
273 mi_usages = my_usages,
275 mi_orphan = is_orphan,
276 mi_exports = my_exports,
277 mi_globals = gbl_env,
278 mi_fixities = fixities,
279 mi_deprecs = my_deprecs,
280 mi_decls = panic "mi_decls"
283 print_unqualified = unQualInScope gbl_env
284 is_exported name = name `elemNameSet` exported_names
285 exported_names = availsToNameSet export_avails
288 -- REPORT UNUSED NAMES, AND DEBUG DUMP
289 reportUnusedNames mod_iface print_unqualified
290 imports global_avail_env
291 source_fvs export_avails rn_imp_decls `thenRn_`
293 returnRn (Just (print_unqualified, (is_exported, mod_iface, final_decls)))
295 mod_name = moduleName this_module
298 @implicitFVs@ forces the renamer to slurp in some things which aren't
299 mentioned explicitly, but which might be needed by the type checker.
302 implicitFVs mod_name decls
303 = lookupOrigNames deriv_occs `thenRn` \ deriving_names ->
304 returnRn (default_tycon_names `plusFV`
305 string_names `plusFV`
306 deriving_names `plusFV`
310 -- Add occurrences for IO or PrimIO
311 implicit_main | mod_name == mAIN_Name
312 || mod_name == pREL_MAIN_Name = unitFV ioTyConName
313 | otherwise = emptyFVs
315 deriv_occs = [occ | TyClD (TyData {tcdDerivs = Just deriv_classes}) <- decls,
316 cls <- deriv_classes,
317 occ <- lookupWithDefaultUFM derivingOccurrences [] cls ]
319 -- Virtually every program has error messages in it somewhere
320 string_names = mkFVs [unpackCStringName, unpackCStringFoldrName,
321 unpackCStringUtf8Name, eqStringName]
323 -- Add occurrences for Int, and (), because they
324 -- are the types to which ambigious type variables may be defaulted by
325 -- the type checker; so they won't always appear explicitly.
326 -- [The () one is a GHC extension for defaulting CCall results.]
327 -- ALSO: funTyCon, since it occurs implicitly everywhere!
328 -- (we don't want to be bothered with making funTyCon a
329 -- free var at every function application!)
330 -- Double is dealt with separately in getGates
331 default_tycon_names = mkFVs (map getName [unitTyCon, funTyCon, boolTyCon, intTyCon])
335 isOrphanDecl this_mod (InstD (InstDecl inst_ty _ _ _ _))
336 = not (foldNameSet ((||) . nameIsLocalOrFrom this_mod) False
337 (extractHsTyNames (removeContext inst_ty)))
338 -- The 'removeContext' is because of
339 -- instance Foo a => Baz T where ...
340 -- The decl is an orphan if Baz and T are both not locally defined,
341 -- even if Foo *is* locally defined
343 isOrphanDecl this_mod (RuleD (HsRule _ _ _ lhs _ _))
346 -- At the moment we just check for common LHS forms
347 -- Expand as necessary. Getting it wrong just means
348 -- more orphans than necessary
349 check (HsVar v) = not (nameIsLocalOrFrom this_mod v)
350 check (HsApp f a) = check f && check a
351 check (HsLit _) = False
352 check (HsOverLit _) = False
353 check (OpApp l o _ r) = check l && check o && check r
354 check (NegApp e _) = check e
355 check (HsPar e) = check e
356 check (SectionL e o) = check e && check o
357 check (SectionR o e) = check e && check o
359 check other = True -- Safe fall through
361 isOrphanDecl _ _ = False
365 %*********************************************************
367 \subsection{Fixities}
369 %*********************************************************
372 fixitiesFromLocalDecls :: GlobalRdrEnv -> [RdrNameHsDecl] -> RnMG LocalFixityEnv
373 fixitiesFromLocalDecls gbl_env decls
374 = foldlRn getFixities emptyNameEnv decls `thenRn` \ env ->
375 traceRn (text "fixity env" <+> vcat (map ppr (nameEnvElts env))) `thenRn_`
378 getFixities :: LocalFixityEnv -> RdrNameHsDecl -> RnMG LocalFixityEnv
379 getFixities acc (FixD fix)
382 getFixities acc (TyClD (ClassDecl { tcdSigs = sigs}))
383 = foldlRn fix_decl acc [sig | FixSig sig <- sigs]
384 -- Get fixities from class decl sigs too.
385 getFixities acc other_decl
388 fix_decl acc sig@(FixitySig rdr_name fixity loc)
389 = -- Check for fixity decl for something not declared
391 lookupSrcName gbl_env rdr_name `thenRn` \ name ->
393 -- Check for duplicate fixity decl
394 case lookupNameEnv acc name of
395 Just (FixitySig _ _ loc') -> addErrRn (dupFixityDecl rdr_name loc loc') `thenRn_`
398 Nothing -> returnRn (extendNameEnv acc name (FixitySig name fixity loc))
402 %*********************************************************
404 \subsection{Deprecations}
406 %*********************************************************
408 For deprecations, all we do is check that the names are in scope.
409 It's only imported deprecations, dealt with in RnIfaces, that we
410 gather them together.
413 rnDeprecs :: GlobalRdrEnv -> Maybe DeprecTxt
414 -> [RdrNameDeprecation] -> RnMG Deprecations
415 rnDeprecs gbl_env Nothing []
418 rnDeprecs gbl_env (Just txt) decls
419 = mapRn (addErrRn . badDeprec) decls `thenRn_`
420 returnRn (DeprecAll txt)
422 rnDeprecs gbl_env Nothing decls
423 = mapRn rn_deprec decls `thenRn` \ pairs ->
424 returnRn (DeprecSome (mkNameEnv (catMaybes pairs)))
426 rn_deprec (Deprecation rdr_name txt loc)
428 lookupSrcName gbl_env rdr_name `thenRn` \ name ->
429 returnRn (Just (name, (name,txt)))
433 %************************************************************************
435 \subsection{Grabbing the old interface file and checking versions}
437 %************************************************************************
440 checkOldIface :: GhciMode
442 -> HomeIfaceTable -> HomeSymbolTable
443 -> PersistentCompilerState
445 -> Bool -- Source unchanged
446 -> Maybe ModIface -- Old interface from compilation manager, if any
447 -> IO (PersistentCompilerState, Bool, (RecompileRequired, Maybe ModIface))
448 -- True <=> errors happened
450 checkOldIface ghci_mode dflags hit hst pcs iface_path source_unchanged maybe_iface
451 = runRn dflags hit hst pcs (panic "Bogus module") $
453 -- CHECK WHETHER THE SOURCE HAS CHANGED
454 ( if not source_unchanged then
455 traceHiDiffsRn (nest 4 (text "Source file changed or recompilation check turned off"))
456 else returnRn () ) `thenRn_`
458 -- If the source has changed and we're in interactive mode, avoid reading
459 -- an interface; just return the one we might have been supplied with.
460 if ghci_mode == Interactive && not source_unchanged then
461 returnRn (outOfDate, maybe_iface)
465 Just old_iface -> -- Use the one we already have
466 setModuleRn (mi_module old_iface) (check_versions old_iface)
468 Nothing -- try and read it from a file
469 -> readIface iface_path `thenRn` \ read_result ->
471 Left err -> -- Old interface file not found, or garbled; give up
472 traceRn (text "Bad old interface file" $$ nest 4 err) `thenRn_`
473 returnRn (outOfDate, Nothing)
476 -> setModuleRn (pi_mod parsed_iface) $
477 loadOldIface parsed_iface `thenRn` \ m_iface ->
478 check_versions m_iface
480 check_versions :: ModIface -> RnMG (RecompileRequired, Maybe ModIface)
482 | not source_unchanged
483 = returnRn (outOfDate, Just iface)
486 recompileRequired iface_path iface `thenRn` \ recompile ->
487 returnRn (recompile, Just iface)
490 I think the following function should now have a more representative name,
494 loadOldIface :: ParsedIface -> RnMG ModIface
496 loadOldIface parsed_iface
497 = let iface = parsed_iface
501 loadHomeDecls (pi_decls iface) `thenRn` \ decls ->
502 loadHomeRules (pi_rules iface) `thenRn` \ rules ->
503 loadHomeInsts (pi_insts iface) `thenRn` \ insts ->
504 returnRn (decls, rules, insts)
506 `thenRn` \ ((decls_vers, new_decls), (rule_vers, new_rules), new_insts) ->
508 mapRn loadHomeUsage (pi_usages iface) `thenRn` \ usages ->
509 loadExports (pi_exports iface) `thenRn` \ (export_vers, avails) ->
510 loadFixDecls mod (pi_fixity iface) `thenRn` \ fix_env ->
511 loadDeprecs mod (pi_deprecs iface) `thenRn` \ deprec_env ->
513 version = VersionInfo { vers_module = pi_vers iface,
514 vers_exports = export_vers,
515 vers_rules = rule_vers,
516 vers_decls = decls_vers }
518 decls = mkIfaceDecls new_decls new_rules new_insts
520 mod_iface = ModIface { mi_module = mod, mi_version = version,
521 mi_exports = avails, mi_usages = usages,
522 mi_boot = False, mi_orphan = pi_orphan iface,
523 mi_fixities = fix_env, mi_deprecs = deprec_env,
525 mi_globals = mkIfaceGlobalRdrEnv avails
532 loadHomeDecls :: [(Version, RdrNameTyClDecl)]
533 -> RnMS (NameEnv Version, [RenamedTyClDecl])
534 loadHomeDecls decls = foldlRn loadHomeDecl (emptyNameEnv, []) decls
536 loadHomeDecl :: (NameEnv Version, [RenamedTyClDecl])
537 -> (Version, RdrNameTyClDecl)
538 -> RnMS (NameEnv Version, [RenamedTyClDecl])
539 loadHomeDecl (version_map, decls) (version, decl)
540 = rnTyClDecl decl `thenRn` \ decl' ->
541 returnRn (extendNameEnv version_map (tyClDeclName decl') version, decl':decls)
544 loadHomeRules :: (Version, [RdrNameRuleDecl])
545 -> RnMS (Version, [RenamedRuleDecl])
546 loadHomeRules (version, rules)
547 = mapRn rnIfaceRuleDecl rules `thenRn` \ rules' ->
548 returnRn (version, rules')
551 loadHomeInsts :: [RdrNameInstDecl]
552 -> RnMS [RenamedInstDecl]
553 loadHomeInsts insts = mapRn rnInstDecl insts
556 loadHomeUsage :: ImportVersion OccName
557 -> RnMG (ImportVersion Name)
558 loadHomeUsage (mod_name, orphans, is_boot, whats_imported)
559 = rn_imps whats_imported `thenRn` \ whats_imported' ->
560 returnRn (mod_name, orphans, is_boot, whats_imported')
562 rn_imps NothingAtAll = returnRn NothingAtAll
563 rn_imps (Everything v) = returnRn (Everything v)
564 rn_imps (Specifically mv ev items rv) = mapRn rn_imp items `thenRn` \ items' ->
565 returnRn (Specifically mv ev items' rv)
566 rn_imp (occ,vers) = newGlobalName mod_name occ `thenRn` \ name ->
572 %*********************************************************
574 \subsection{Closing up the interface decls}
576 %*********************************************************
578 Suppose we discover we don't need to recompile. Then we start from the
579 IfaceDecls in the ModIface, and fluff them up by sucking in all the decls they need.
582 closeIfaceDecls :: DynFlags
583 -> HomeIfaceTable -> HomeSymbolTable
584 -> PersistentCompilerState
585 -> ModIface -- Get the decls from here
586 -> IO (PersistentCompilerState, Bool, [RenamedHsDecl])
587 -- True <=> errors happened
588 closeIfaceDecls dflags hit hst pcs
589 mod_iface@(ModIface { mi_module = mod, mi_decls = iface_decls })
590 = runRn dflags hit hst pcs mod $
593 rule_decls = dcl_rules iface_decls
594 inst_decls = dcl_insts iface_decls
595 tycl_decls = dcl_tycl iface_decls
596 decls = map RuleD rule_decls ++
597 map InstD inst_decls ++
599 needed = unionManyNameSets (map ruleDeclFVs rule_decls) `unionNameSets`
600 unionManyNameSets (map instDeclFVs inst_decls) `unionNameSets`
601 unionManyNameSets (map tyClDeclFVs tycl_decls)
602 local_names = foldl add emptyNameSet tycl_decls
603 add names decl = addListToNameSet names (map fst (tyClDeclSysNames decl ++ tyClDeclNames decl))
606 recordLocalSlurps local_names `thenRn_`
608 -- Do the transitive closure
609 closeDecls decls (needed `plusFV` implicit_fvs) `thenRn` \closed_decls ->
610 rnDump [] closed_decls `thenRn_`
611 returnRn closed_decls
613 implicit_fvs = string_names -- Data type decls with record selectors,
614 -- which may appear in the decls, need unpackCString
615 -- and friends. It's easier to just grab them right now.
618 %*********************************************************
620 \subsection{Unused names}
622 %*********************************************************
625 reportUnusedNames :: ModIface -> PrintUnqualified
626 -> [RdrNameImportDecl]
628 -> NameSet -- Used in this module
629 -> Avails -- Exported by this module
632 reportUnusedNames my_mod_iface unqual imports avail_env
633 source_fvs export_avails imported_decls
634 = warnUnusedModules unused_imp_mods `thenRn_`
635 warnUnusedLocalBinds bad_locals `thenRn_`
636 warnUnusedImports bad_imp_names `thenRn_`
637 printMinimalImports this_mod unqual minimal_imports `thenRn_`
638 warnDeprecations this_mod export_avails my_deprecs
642 this_mod = mi_module my_mod_iface
643 gbl_env = mi_globals my_mod_iface
644 my_deprecs = mi_deprecs my_mod_iface
646 -- The export_fvs make the exported names look just as if they
647 -- occurred in the source program.
648 export_fvs = availsToNameSet export_avails
649 used_names = source_fvs `plusFV` export_fvs
651 -- Now, a use of C implies a use of T,
652 -- if C was brought into scope by T(..) or T(C)
653 really_used_names = used_names `unionNameSets`
654 mkNameSet [ parent_name
655 | sub_name <- nameSetToList used_names
657 -- Usually, every used name will appear in avail_env, but there
658 -- is one time when it doesn't: tuples and other built in syntax. When you
659 -- write (a,b) that gives rise to a *use* of "(,)", so that the
660 -- instances will get pulled in, but the tycon "(,)" isn't actually
661 -- in scope. Also, (-x) gives rise to an implicit use of 'negate';
662 -- similarly, 3.5 gives rise to an implcit use of :%
663 -- Hence the silent 'False' in all other cases
665 , Just parent_name <- [case lookupNameEnv avail_env sub_name of
666 Just (AvailTC n _) -> Just n
670 -- Collect the defined names from the in-scope environment
671 -- Look for the qualified ones only, else get duplicates
672 defined_names :: [(Name,Provenance)]
673 defined_names = foldRdrEnv add [] gbl_env
674 add rdr_name ns acc | isQual rdr_name = ns ++ acc
677 defined_and_used, defined_but_not_used :: [(Name,Provenance)]
678 (defined_and_used, defined_but_not_used) = partition used defined_names
679 used (name,_) = name `elemNameSet` really_used_names
681 -- Filter out the ones only defined implicitly
683 bad_locals = [n | (n,LocalDef) <- defined_but_not_used]
685 bad_imp_names :: [(Name,Provenance)]
686 bad_imp_names = [(n,p) | (n,p@(NonLocalDef (UserImport mod _ True))) <- defined_but_not_used,
687 not (module_unused mod)]
689 -- inst_mods are directly-imported modules that
690 -- contain instance decl(s) that the renamer decided to suck in
691 -- It's not necessarily redundant to import such modules.
697 -- The import M() is not *necessarily* redundant, even if
698 -- we suck in no instance decls from M (e.g. it contains
699 -- no instance decls, or This contains no code). It may be
700 -- that we import M solely to ensure that M's orphan instance
701 -- decls (or those in its imports) are visible to people who
702 -- import This. Sigh.
703 -- There's really no good way to detect this, so the error message
704 -- in RnEnv.warnUnusedModules is weakened instead
705 inst_mods :: [ModuleName]
706 inst_mods = [m | InstD (InstDecl _ _ _ (Just dfun) _) <- imported_decls,
707 let m = moduleName (nameModule dfun),
708 m `elem` direct_import_mods
711 -- To figure out the minimal set of imports, start with the things
712 -- that are in scope (i.e. in gbl_env). Then just combine them
713 -- into a bunch of avails, so they are properly grouped
714 minimal_imports :: FiniteMap ModuleName AvailEnv
715 minimal_imports0 = emptyFM
716 minimal_imports1 = foldr add_name minimal_imports0 defined_and_used
717 minimal_imports = foldr add_inst_mod minimal_imports1 inst_mods
719 -- We've carefully preserved the provenance so that we can
720 -- construct minimal imports that import the name by (one of)
721 -- the same route(s) as the programmer originally did.
722 add_name (n,NonLocalDef (UserImport m _ _)) acc = addToFM_C plusAvailEnv acc (moduleName m)
723 (unitAvailEnv (mk_avail n))
724 add_name (n,other_prov) acc = acc
726 mk_avail n = case lookupNameEnv avail_env n of
727 Just (AvailTC m _) | n==m -> AvailTC n [n]
728 | otherwise -> AvailTC m [n,m]
729 Just avail -> Avail n
730 Nothing -> pprPanic "mk_avail" (ppr n)
733 | m `elemFM` acc = acc -- We import something already
734 | otherwise = addToFM acc m emptyAvailEnv
735 -- Add an empty collection of imports for a module
736 -- from which we have sucked only instance decls
738 direct_import_mods :: [ModuleName]
739 direct_import_mods = nub [m | ImportDecl m _ _ _ _ _ <- imports]
741 -- unused_imp_mods are the directly-imported modules
742 -- that are not mentioned in minimal_imports
743 unused_imp_mods = [m | m <- direct_import_mods,
744 not (maybeToBool (lookupFM minimal_imports m)),
747 module_unused :: Module -> Bool
748 module_unused mod = moduleName mod `elem` unused_imp_mods
750 warnDeprecations this_mod export_avails my_deprecs used_names
751 = doptRn Opt_WarnDeprecations `thenRn` \ warn_drs ->
752 if not warn_drs then returnRn () else
754 -- The home modules for things in the export list
755 -- may not have been loaded yet; do it now, so
756 -- that we can see their deprecations, if any
757 mapRn_ load_home export_mods `thenRn_`
759 getIfacesRn `thenRn` \ ifaces ->
760 getHomeIfaceTableRn `thenRn` \ hit ->
764 | n <- nameSetToList used_names,
765 not (nameIsLocalOrFrom this_mod n),
766 Just txt <- [lookup_deprec hit pit n] ]
767 -- nameIsLocalOrFrom: don't complain about locally defined names
768 -- For a start, we may be exporting a deprecated thing
769 -- Also we may use a deprecated thing in the defn of another
770 -- deprecated things. We may even use a deprecated thing in
771 -- the defn of a non-deprecated thing, when changing a module's
774 mapRn_ warnDeprec deprecs
777 export_mods = nub [ moduleName mod
778 | avail <- export_avails,
779 let mod = nameModule (availName avail),
782 load_home m = loadInterface (text "Check deprecations for" <+> ppr m) m ImportBySystem
784 lookup_deprec hit pit n
785 = case lookupIface hit pit n of
786 Just iface -> lookupDeprec (mi_deprecs iface) n
787 Nothing -> pprPanic "warnDeprecations:" (ppr n)
789 -- ToDo: deal with original imports with 'qualified' and 'as M' clauses
790 printMinimalImports this_mod unqual imps
791 = doptRn Opt_D_dump_minimal_imports `thenRn` \ dump_minimal ->
792 if not dump_minimal then returnRn () else
794 mapRn to_ies (fmToList imps) `thenRn` \ mod_ies ->
795 ioToRnM (do { h <- openFile filename WriteMode ;
796 printForUser h unqual (vcat (map ppr_mod_ie mod_ies))
800 filename = moduleNameUserString (moduleName this_mod) ++ ".imports"
801 ppr_mod_ie (mod_name, ies)
802 | mod_name == pRELUDE_Name
805 = ptext SLIT("import") <+> ppr mod_name <>
806 parens (fsep (punctuate comma (map ppr ies)))
808 to_ies (mod, avail_env) = mapRn to_ie (availEnvElts avail_env) `thenRn` \ ies ->
811 to_ie :: AvailInfo -> RnMG (IE Name)
812 to_ie (Avail n) = returnRn (IEVar n)
813 to_ie (AvailTC n [m]) = ASSERT( n==m )
814 returnRn (IEThingAbs n)
816 = getInterfaceExports n_mod ImportBySystem `thenRn` \ (_, avails_by_module) ->
817 case [xs | (m,as) <- avails_by_module,
821 [xs] | all (`elem` ns) xs -> returnRn (IEThingAll n)
822 | otherwise -> returnRn (IEThingWith n (filter (/= n) ns))
823 other -> pprTrace "to_ie" (ppr n <+> ppr (nameModule n) <+> ppr other) $
826 n_mod = moduleName (nameModule n)
828 rnDump :: [RenamedHsDecl] -- Renamed imported decls
829 -> [RenamedHsDecl] -- Renamed local decls
831 rnDump imp_decls local_decls
832 = doptRn Opt_D_dump_rn_trace `thenRn` \ dump_rn_trace ->
833 doptRn Opt_D_dump_rn_stats `thenRn` \ dump_rn_stats ->
834 doptRn Opt_D_dump_rn `thenRn` \ dump_rn ->
835 getIfacesRn `thenRn` \ ifaces ->
837 ioToRnM (do { dumpIfSet (dump_rn_trace || dump_rn_stats || dump_rn)
839 (getRnStats imp_decls ifaces) ;
841 dumpIfSet dump_rn "Renamer:"
842 (vcat (map ppr (local_decls ++ imp_decls)))
849 %*********************************************************
851 \subsection{Statistics}
853 %*********************************************************
856 getRnStats :: [RenamedHsDecl] -> Ifaces -> SDoc
857 getRnStats imported_decls ifaces
858 = hcat [text "Renamer stats: ", stats]
860 n_mods = length [() | _ <- moduleEnvElts (iPIT ifaces)]
861 -- This is really only right for a one-shot compile
863 (decls_map, n_decls_slurped) = iDecls ifaces
865 n_decls_left = length [decl | (avail, True, (_,decl)) <- nameEnvElts decls_map
866 -- Data, newtype, and class decls are in the decls_fm
867 -- under multiple names; the tycon/class, and each
868 -- constructor/class op too.
869 -- The 'True' selects just the 'main' decl
872 (insts_left, n_insts_slurped) = iInsts ifaces
873 n_insts_left = length (bagToList insts_left)
875 (rules_left, n_rules_slurped) = iRules ifaces
876 n_rules_left = length (bagToList rules_left)
879 [int n_mods <+> text "interfaces read",
880 hsep [ int n_decls_slurped, text "type/class/variable imported, out of",
881 int (n_decls_slurped + n_decls_left), text "read"],
882 hsep [ int n_insts_slurped, text "instance decls imported, out of",
883 int (n_insts_slurped + n_insts_left), text "read"],
884 hsep [ int n_rules_slurped, text "rule decls imported, out of",
885 int (n_rules_slurped + n_rules_left), text "read"]
890 %************************************************************************
892 \subsection{Errors and warnings}
894 %************************************************************************
897 warnDeprec :: (Name, DeprecTxt) -> RnM d ()
898 warnDeprec (name, txt)
899 = pushSrcLocRn (getSrcLoc name) $
901 sep [ text (occNameFlavour (nameOccName name)) <+> quotes (ppr name) <+>
902 text "is deprecated:", nest 4 (ppr txt) ]
905 dupFixityDecl rdr_name loc1 loc2
906 = vcat [ptext SLIT("Multiple fixity declarations for") <+> quotes (ppr rdr_name),
907 ptext SLIT("at ") <+> ppr loc1,
908 ptext SLIT("and") <+> ppr loc2]
911 = sep [ptext SLIT("Illegal deprecation when whole module is deprecated"),