2 % (c) The GRASP Project, Glasgow University, 1992-1998
4 \section[Rename]{Renaming and dependency analysis passes}
7 module Rename ( renameModule ) where
9 #include "HsVersions.h"
12 import RdrHsSyn ( RdrNameHsModule )
13 import RnHsSyn ( RenamedHsModule, RenamedHsDecl,
14 extractHsTyNames, extractHsCtxtTyNames
17 import CmdLineOpts ( opt_HiMap, opt_D_dump_rn_trace,
18 opt_D_dump_rn, opt_D_dump_rn_stats,
19 opt_WarnUnusedBinds, opt_WarnUnusedImports
22 import RnNames ( getGlobalNames )
23 import RnSource ( rnSourceDecls, rnDecl )
24 import RnIfaces ( getImportedInstDecls, importDecl, getImportVersions,
25 getImportedRules, loadHomeInterface, getSlurped, removeContext
27 import RnEnv ( availName, availNames, availsToNameSet,
28 warnUnusedTopNames, mapFvRn, lookupImplicitOccRn,
29 FreeVars, plusFVs, plusFV, unitFV, emptyFVs, isEmptyFVs
31 import Module ( Module, ModuleName, pprModule, mkSearchPath, mkThisModule )
32 import Name ( Name, isLocallyDefined,
33 NamedThing(..), ImportReason(..), Provenance(..),
34 pprOccName, nameOccName,
36 maybeWiredInTyConName, maybeWiredInIdName, isWiredInName
39 import DataCon ( dataConTyCon, dataConType )
40 import TyCon ( TyCon, tyConDataCons, isSynTyCon, getSynTyConDefn )
41 import RdrName ( RdrName )
43 import PrelMods ( mAIN_Name, pREL_MAIN_Name )
44 import TysWiredIn ( unitTyCon, intTyCon, doubleTyCon, boolTyCon )
45 import PrelInfo ( ioTyCon_NAME, numClass_RDR, thinAirIdNames, derivingOccurrences )
46 import Type ( namesOfType, funTyCon )
47 import ErrUtils ( printErrorsAndWarnings, dumpIfSet, ghcExit )
48 import BasicTypes ( NewOrData(..) )
49 import Bag ( isEmptyBag, bagToList )
50 import FiniteMap ( fmToList, delListFromFM, addToFM, sizeFM, eltsFM )
51 import UniqSupply ( UniqSupply )
52 import UniqFM ( lookupUFM )
53 import Util ( equivClasses )
54 import Maybes ( maybeToBool )
61 renameModule :: UniqSupply
65 , RenamedHsModule -- Output, after renaming
66 , InterfaceDetails -- Interface; for interface file generation
67 , RnNameSupply -- Final env; for renaming derivings
68 , [ModuleName] -- Imported modules; for profiling
71 renameModule us this_mod@(HsModule mod_name vers exports imports local_decls loc)
72 = -- Initialise the renamer monad
73 initRn mod_name us (mkSearchPath opt_HiMap) loc
75 \ ((maybe_rn_stuff, dump_action), rn_errs_bag, rn_warns_bag) ->
78 printErrorsAndWarnings rn_errs_bag rn_warns_bag >>
80 -- Dump any debugging output
84 if not (isEmptyBag rn_errs_bag) then
85 ghcExit 1 >> return Nothing
92 rename this_mod@(HsModule mod_name vers _ imports local_decls loc)
93 = -- FIND THE GLOBAL NAME ENVIRONMENT
94 getGlobalNames this_mod `thenRn` \ maybe_stuff ->
96 -- CHECK FOR EARLY EXIT
97 if not (maybeToBool maybe_stuff) then
98 -- Everything is up to date; no need to recompile further
99 rnDump [] [] `thenRn` \ dump_action ->
100 returnRn (Nothing, dump_action)
103 Just (export_env, gbl_env, fixity_env, global_avail_env) = maybe_stuff
107 initRnMS gbl_env fixity_env SourceMode (
108 rnSourceDecls local_decls
109 ) `thenRn` \ (rn_local_decls, source_fvs) ->
111 -- SLURP IN ALL THE NEEDED DECLARATIONS
112 implicitFVs mod_name rn_local_decls `thenRn` \ implicit_fvs ->
114 real_source_fvs = implicit_fvs `plusFV` source_fvs
115 -- It's important to do the "plus" this way round, so that
116 -- when compiling the prelude, locally-defined (), Bool, etc
117 -- override the implicit ones.
119 slurpImpDecls real_source_fvs `thenRn` \ rn_imp_decls ->
121 rn_all_decls = rn_imp_decls ++ rn_local_decls
124 -- EXIT IF ERRORS FOUND
125 checkErrsRn `thenRn` \ no_errs_so_far ->
126 if not no_errs_so_far then
127 -- Found errors already, so exit now
128 rnDump rn_imp_decls rn_all_decls `thenRn` \ dump_action ->
129 returnRn (Nothing, dump_action)
132 -- GENERATE THE VERSION/USAGE INFO
133 getImportVersions mod_name export_env `thenRn` \ my_usages ->
134 getNameSupplyRn `thenRn` \ name_supply ->
136 -- REPORT UNUSED NAMES
137 reportUnusedNames gbl_env global_avail_env
141 -- RETURN THE RENAMED MODULE
143 has_orphans = any isOrphanDecl rn_local_decls
144 direct_import_mods = [mod | ImportDecl mod _ _ _ _ _ <- imports]
145 renamed_module = HsModule mod_name vers
146 trashed_exports trashed_imports
150 rnDump rn_imp_decls rn_all_decls `thenRn` \ dump_action ->
151 returnRn (Just (mkThisModule mod_name,
153 (has_orphans, my_usages, export_env),
155 direct_import_mods), dump_action)
157 trashed_exports = {-trace "rnSource:trashed_exports"-} Nothing
158 trashed_imports = {-trace "rnSource:trashed_imports"-} []
161 @implicitFVs@ forces the renamer to slurp in some things which aren't
162 mentioned explicitly, but which might be needed by the type checker.
165 implicitFVs mod_name decls
166 = mapRn lookupImplicitOccRn implicit_occs `thenRn` \ implicit_names ->
167 returnRn (implicit_main `plusFV`
168 mkNameSet default_tys `plusFV`
169 mkNameSet thinAirIdNames `plusFV`
170 mkNameSet implicit_names)
173 -- Add occurrences for Int, Double, and (), because they
174 -- are the types to which ambigious type variables may be defaulted by
175 -- the type checker; so they won't always appear explicitly.
176 -- [The () one is a GHC extension for defaulting CCall results.]
177 -- ALSO: funTyCon, since it occurs implicitly everywhere!
178 -- (we don't want to be bothered with making funTyCon a
179 -- free var at every function application!)
180 default_tys = [getName intTyCon, getName doubleTyCon,
181 getName unitTyCon, getName funTyCon, getName boolTyCon]
183 -- Add occurrences for IO or PrimIO
184 implicit_main | mod_name == mAIN_Name
185 || mod_name == pREL_MAIN_Name = unitFV ioTyCon_NAME
186 | otherwise = emptyFVs
188 -- Now add extra "occurrences" for things that
189 -- the deriving mechanism, or defaulting, will later need in order to
191 implicit_occs = foldr ((++) . get) [] decls
193 get (DefD _) = [numClass_RDR]
194 get (TyClD (TyData _ _ _ _ _ (Just deriv_classes) _ _))
195 = concat (map get_deriv deriv_classes)
198 get_deriv cls = case lookupUFM derivingOccurrences cls of
204 isOrphanDecl (InstD (InstDecl inst_ty _ _ _ _))
205 = not (foldNameSet ((||) . isLocallyDefined) False (extractHsTyNames (removeContext inst_ty)))
206 -- The 'removeContext' is because of
207 -- instance Foo a => Baz T where ...
208 -- The decl is an orphan if Baz and T are both not locally defined,
209 -- even if Foo *is* locally defined
211 isOrphanDecl (RuleD (RuleDecl _ _ _ lhs _ _))
214 -- At the moment we just check for common LHS forms
215 -- Expand as necessary. Getting it wrong just means
216 -- more orphans than necessary
217 check (HsVar v) = not (isLocallyDefined v)
218 check (HsApp f a) = check f && check a
219 check (HsLit _) = False
220 check (OpApp l o _ r) = check l && check o && check r
221 check (NegApp e _) = check e
222 check (HsPar e) = check e
223 check (SectionL e o) = check e && check o
224 check (SectionR o e) = check e && check o
226 check other = True -- Safe fall through
228 isOrphanDecl other = False
232 %*********************************************************
234 \subsection{Slurping declarations}
236 %*********************************************************
239 -------------------------------------------------------
240 slurpImpDecls source_fvs
241 = traceRn (text "slurpImp" <+> fsep (map ppr (nameSetToList source_fvs))) `thenRn_`
243 -- The current slurped-set records all local things
244 getSlurped `thenRn` \ source_binders ->
245 slurpSourceRefs source_binders source_fvs `thenRn` \ (decls, needed) ->
247 -- And finally get everything else
248 closeDecls decls needed
250 -------------------------------------------------------
251 slurpSourceRefs :: NameSet -- Variables defined in source
252 -> FreeVars -- Variables referenced in source
253 -> RnMG ([RenamedHsDecl],
254 FreeVars) -- Un-satisfied needs
255 -- The declaration (and hence home module) of each gate has
256 -- already been loaded
258 slurpSourceRefs source_binders source_fvs
259 = go_outer [] -- Accumulating decls
260 emptyFVs -- Unsatisfied needs
261 emptyFVs -- Accumulating gates
262 (nameSetToList source_fvs) -- Things whose defn hasn't been loaded yet
264 -- The outer loop repeatedly slurps the decls for the current gates
265 -- and the instance decls
267 -- The outer loop is needed because consider
268 -- instance Foo a => Baz (Maybe a) where ...
269 -- It may be that @Baz@ and @Maybe@ are used in the source module,
270 -- but not @Foo@; so we need to chase @Foo@ too.
272 -- We also need to follow superclass refs. In particular, 'chasing @Foo@' must
273 -- include actually getting in Foo's class decl
274 -- class Wib a => Foo a where ..
275 -- so that its superclasses are discovered. The point is that Wib is a gate too.
276 -- We do this for tycons too, so that we look through type synonyms.
278 go_outer decls fvs all_gates []
279 = returnRn (decls, fvs)
281 go_outer decls fvs all_gates refs -- refs are not necessarily slurped yet
282 = traceRn (text "go_outer" <+> ppr refs) `thenRn_`
283 go_inner decls fvs emptyFVs refs `thenRn` \ (decls1, fvs1, gates1) ->
284 getImportedInstDecls (all_gates `plusFV` gates1) `thenRn` \ inst_decls ->
285 rnInstDecls decls1 fvs1 gates1 inst_decls `thenRn` \ (decls2, fvs2, gates2) ->
286 go_outer decls2 fvs2 (all_gates `plusFV` gates2)
287 (nameSetToList (gates2 `minusNameSet` all_gates))
288 -- Knock out the all_gates because even ifwe don't slurp any new
289 -- decls we can get some apparently-new gates from wired-in names
291 go_inner decls fvs gates []
292 = returnRn (decls, fvs, gates)
294 go_inner decls fvs gates (wanted_name:refs)
295 | isWiredInName wanted_name
296 = load_home wanted_name `thenRn_`
297 go_inner decls fvs (gates `plusFV` getWiredInGates wanted_name) refs
300 = importDecl wanted_name `thenRn` \ maybe_decl ->
302 Nothing -> go_inner decls fvs gates refs -- No declaration... (already slurped, or local)
303 Just decl -> rnIfaceDecl decl `thenRn` \ (new_decl, fvs1) ->
304 go_inner (new_decl : decls)
306 (gates `plusFV` getGates source_fvs new_decl)
309 -- When we find a wired-in name we must load its
310 -- home module so that we find any instance decls therein
312 | name `elemNameSet` source_binders = returnRn ()
313 -- When compiling the prelude, a wired-in thing may
314 -- be defined in this module, in which case we don't
315 -- want to load its home module!
316 -- Using 'isLocallyDefined' doesn't work because some of
317 -- the free variables returned are simply 'listTyCon_Name',
318 -- with a system provenance. We could look them up every time
319 -- but that seems a waste.
320 | otherwise = loadHomeInterface doc name `thenRn_`
323 doc = ptext SLIT("need home module for wired in thing") <+> ppr name
325 rnInstDecls decls fvs gates []
326 = returnRn (decls, fvs, gates)
327 rnInstDecls decls fvs gates (d:ds)
328 = rnIfaceDecl d `thenRn` \ (new_decl, fvs1) ->
329 rnInstDecls (new_decl:decls)
331 (gates `plusFV` getInstDeclGates new_decl)
337 -------------------------------------------------------
338 -- closeDecls keeps going until the free-var set is empty
339 closeDecls decls needed
340 | not (isEmptyFVs needed)
341 = slurpDecls decls needed `thenRn` \ (decls1, needed1) ->
342 closeDecls decls1 needed1
345 = getImportedRules `thenRn` \ rule_decls ->
347 [] -> returnRn decls -- No new rules, so we are done
348 other -> rnIfaceDecls decls emptyFVs rule_decls `thenRn` \ (decls1, needed1) ->
349 closeDecls decls1 needed1
352 -------------------------------------------------------
353 rnIfaceDecls :: [RenamedHsDecl] -> FreeVars
354 -> [(Module, RdrNameHsDecl)]
355 -> RnM d ([RenamedHsDecl], FreeVars)
356 rnIfaceDecls decls fvs [] = returnRn (decls, fvs)
357 rnIfaceDecls decls fvs (d:ds) = rnIfaceDecl d `thenRn` \ (new_decl, fvs1) ->
358 rnIfaceDecls (new_decl:decls) (fvs1 `plusFV` fvs) ds
360 rnIfaceDecl (mod, decl) = initIfaceRnMS mod (rnDecl decl)
363 -------------------------------------------------------
364 -- Augment decls with any decls needed by needed.
365 -- Return also free vars of the new decls (only)
366 slurpDecls decls needed
367 = go decls emptyFVs (nameSetToList needed)
369 go decls fvs [] = returnRn (decls, fvs)
370 go decls fvs (ref:refs) = slurpDecl decls fvs ref `thenRn` \ (decls1, fvs1) ->
373 -------------------------------------------------------
374 slurpDecl decls fvs wanted_name
375 = importDecl wanted_name `thenRn` \ maybe_decl ->
377 -- No declaration... (wired in thing)
378 Nothing -> returnRn (decls, fvs)
380 -- Found a declaration... rename it
381 Just decl -> rnIfaceDecl decl `thenRn` \ (new_decl, fvs1) ->
382 returnRn (new_decl:decls, fvs1 `plusFV` fvs)
386 %*********************************************************
388 \subsection{Extracting the `gates'}
390 %*********************************************************
392 When we import a declaration like
394 data T = T1 Wibble | T2 Wobble
396 we don't want to treat @Wibble@ and @Wobble@ as gates
397 {\em unless} @T1@, @T2@ respectively are mentioned by the user program.
398 If only @T@ is mentioned
399 we want only @T@ to be a gate;
400 that way we don't suck in useless instance
401 decls for (say) @Eq Wibble@, when they can't possibly be useful.
403 @getGates@ takes a newly imported (and renamed) decl, and the free
404 vars of the source program, and extracts from the decl the gate names.
407 getGates source_fvs (SigD (IfaceSig _ ty _ _))
408 = extractHsTyNames ty
410 getGates source_fvs (TyClD (ClassDecl ctxt cls tvs _ sigs _ _ _ _ _ _))
411 = delListFromNameSet (foldr (plusFV . get) (extractHsCtxtTyNames ctxt) sigs)
412 (map getTyVarName tvs)
413 `addOneToNameSet` cls
415 get (ClassOpSig n _ _ ty _)
416 | n `elemNameSet` source_fvs = extractHsTyNames ty
417 | otherwise = emptyFVs
419 getGates source_fvs (TyClD (TySynonym tycon tvs ty _))
420 = delListFromNameSet (extractHsTyNames ty)
421 (map getTyVarName tvs)
422 -- A type synonym type constructor isn't a "gate" for instance decls
424 getGates source_fvs (TyClD (TyData _ ctxt tycon tvs cons _ _ _))
425 = delListFromNameSet (foldr (plusFV . get) (extractHsCtxtTyNames ctxt) cons)
426 (map getTyVarName tvs)
427 `addOneToNameSet` tycon
429 get (ConDecl n tvs ctxt details _)
430 | n `elemNameSet` source_fvs
431 -- If the constructor is method, get fvs from all its fields
432 = delListFromNameSet (get_details details `plusFV`
433 extractHsCtxtTyNames ctxt)
434 (map getTyVarName tvs)
435 get (ConDecl n tvs ctxt (RecCon fields) _)
436 -- Even if the constructor isn't mentioned, the fields
437 -- might be, as selectors. They can't mention existentially
438 -- bound tyvars (typechecker checks for that) so no need for
439 -- the deleteListFromNameSet part
440 = foldr (plusFV . get_field) emptyFVs fields
442 get other_con = emptyFVs
444 get_details (VanillaCon tys) = plusFVs (map get_bang tys)
445 get_details (InfixCon t1 t2) = get_bang t1 `plusFV` get_bang t2
446 get_details (RecCon fields) = plusFVs [get_bang t | (_, t) <- fields]
447 get_details (NewCon t _) = extractHsTyNames t
449 get_field (fs,t) | any (`elemNameSet` source_fvs) fs = get_bang t
450 | otherwise = emptyFVs
452 get_bang (Banged t) = extractHsTyNames t
453 get_bang (Unbanged t) = extractHsTyNames t
454 get_bang (Unpacked t) = extractHsTyNames t
456 getGates source_fvs other_decl = emptyFVs
459 @getWiredInGates@ is just like @getGates@, but it sees a wired-in @Name@
460 rather than a declaration.
463 getWiredInGates :: Name -> FreeVars
464 getWiredInGates name -- No classes are wired in
465 | is_id = getWiredInGates_s (namesOfType (idType the_id))
466 | isSynTyCon the_tycon = getWiredInGates_s
467 (delListFromNameSet (namesOfType ty) (map getName tyvars))
468 | otherwise = unitFV name
470 maybe_wired_in_id = maybeWiredInIdName name
471 is_id = maybeToBool maybe_wired_in_id
472 maybe_wired_in_tycon = maybeWiredInTyConName name
473 Just the_id = maybe_wired_in_id
474 Just the_tycon = maybe_wired_in_tycon
475 (tyvars,ty) = getSynTyConDefn the_tycon
477 getWiredInGates_s names = foldr (plusFV . getWiredInGates) emptyFVs (nameSetToList names)
481 getInstDeclGates (InstD (InstDecl inst_ty _ _ _ _)) = extractHsTyNames inst_ty
482 getInstDeclGates other = emptyFVs
486 %*********************************************************
488 \subsection{Unused names}
490 %*********************************************************
493 reportUnusedNames gbl_env avail_env (ExportEnv export_avails _ _) mentioned_names
495 used_names = mentioned_names `unionNameSets` availsToNameSet export_avails
497 -- Now, a use of C implies a use of T,
498 -- if C was brought into scope by T(..) or T(C)
499 really_used_names = used_names `unionNameSets`
500 mkNameSet [ availName avail
501 | sub_name <- nameSetToList used_names,
502 let avail = case lookupNameEnv avail_env sub_name of
504 Nothing -> WARN( True, text "reportUnusedName: not in avail_env" <+> ppr sub_name )
508 defined_names = mkNameSet (concat (rdrEnvElts gbl_env))
509 defined_but_not_used =
510 nameSetToList (defined_names `minusNameSet` really_used_names)
512 -- Filter out the ones only defined implicitly
513 bad_guys = filter reportableUnusedName defined_but_not_used
515 warnUnusedTopNames bad_guys
517 reportableUnusedName :: Name -> Bool
518 reportableUnusedName name
519 = explicitlyImported (getNameProvenance name)
521 explicitlyImported (LocalDef _ _) = True
522 -- Report unused defns of local vars
523 explicitlyImported (NonLocalDef (UserImport _ _ expl) _) = expl
524 -- Report unused explicit imports
525 explicitlyImported other = False
526 -- Don't report others
528 rnDump :: [RenamedHsDecl] -- Renamed imported decls
529 -> [RenamedHsDecl] -- Renamed local decls
531 rnDump imp_decls decls
532 | opt_D_dump_rn_trace ||
533 opt_D_dump_rn_stats ||
535 = getRnStats imp_decls `thenRn` \ stats_msg ->
537 returnRn (printErrs stats_msg >>
538 dumpIfSet opt_D_dump_rn "Renamer:" (vcat (map ppr decls)))
540 | otherwise = returnRn (return ())
544 %*********************************************************
546 \subsection{Statistics}
548 %*********************************************************
551 getRnStats :: [RenamedHsDecl] -> RnMG SDoc
552 getRnStats imported_decls
553 = getIfacesRn `thenRn` \ ifaces ->
555 n_mods = length [() | (_, _, Just _) <- eltsFM (iImpModInfo ifaces)]
557 decls_read = [decl | (_, avail, True, (_,decl)) <- nameEnvElts (iDecls ifaces),
558 -- Data, newtype, and class decls are in the decls_fm
559 -- under multiple names; the tycon/class, and each
560 -- constructor/class op too.
561 -- The 'True' selects just the 'main' decl
562 not (isLocallyDefined (availName avail))
565 (cd_rd, dd_rd, nd_rd, sd_rd, vd_rd, _) = count_decls decls_read
566 (cd_sp, dd_sp, nd_sp, sd_sp, vd_sp, id_sp) = count_decls imported_decls
568 unslurped_insts = iInsts ifaces
569 inst_decls_unslurped = length (bagToList unslurped_insts)
570 inst_decls_read = id_sp + inst_decls_unslurped
573 [int n_mods <+> text "interfaces read",
574 hsep [ int cd_sp, text "class decls imported, out of",
575 int cd_rd, text "read"],
576 hsep [ int dd_sp, text "data decls imported, out of",
577 int dd_rd, text "read"],
578 hsep [ int nd_sp, text "newtype decls imported, out of",
579 int nd_rd, text "read"],
580 hsep [int sd_sp, text "type synonym decls imported, out of",
581 int sd_rd, text "read"],
582 hsep [int vd_sp, text "value signatures imported, out of",
583 int vd_rd, text "read"],
584 hsep [int id_sp, text "instance decls imported, out of",
585 int inst_decls_read, text "read"],
586 text "cls dcls slurp" <+> fsep (map (ppr . tyClDeclName)
587 [d | TyClD d <- imported_decls, isClassDecl d]),
588 text "cls dcls read" <+> fsep (map (ppr . tyClDeclName)
589 [d | TyClD d <- decls_read, isClassDecl d])]
591 returnRn (hcat [text "Renamer stats: ", stats])
601 tycl_decls = [d | TyClD d <- decls]
602 (class_decls, data_decls, newtype_decls, syn_decls) = countTyClDecls tycl_decls
604 val_decls = length [() | SigD _ <- decls]
605 inst_decls = length [() | InstD _ <- decls]