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
27 import RnEnv ( availName, availNames, availsToNameSet,
28 warnUnusedTopNames, mapFvRn,
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,
35 getNameProvenance, occNameUserString,
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, thinAirIdNames )
46 import Type ( namesOfType, funTyCon )
47 import ErrUtils ( pprBagOfErrors, pprBagOfWarnings,
48 doIfSet, dumpIfSet, ghcExit
50 import BasicTypes ( NewOrData(..) )
51 import Bag ( isEmptyBag, bagToList )
52 import FiniteMap ( fmToList, delListFromFM, addToFM, sizeFM, eltsFM )
53 import UniqSupply ( UniqSupply )
54 import Util ( equivClasses )
55 import Maybes ( maybeToBool )
62 renameModule :: UniqSupply
66 , RenamedHsModule -- Output, after renaming
67 , InterfaceDetails -- Interface; for interface file generation
68 , RnNameSupply -- Final env; for renaming derivings
69 , [ModuleName] -- Imported modules; for profiling
72 renameModule us this_mod@(HsModule mod_name vers exports imports local_decls loc)
73 = -- Initialise the renamer monad
74 initRn mod_name us (mkSearchPath opt_HiMap) loc
76 \ (maybe_rn_stuff, rn_errs_bag, rn_warns_bag) ->
79 doIfSet (not (isEmptyBag rn_warns_bag))
80 (printErrs (pprBagOfWarnings rn_warns_bag)) >>
82 -- Check for errors; exit if so
83 doIfSet (not (isEmptyBag rn_errs_bag))
84 (printErrs (pprBagOfErrors rn_errs_bag) >>
88 -- Dump output, if any
89 (case maybe_rn_stuff of
91 Just results@(_, rn_mod, _, _, _)
92 -> dumpIfSet opt_D_dump_rn "Renamer:"
102 rename this_mod@(HsModule mod_name vers exports imports local_decls loc)
103 = -- FIND THE GLOBAL NAME ENVIRONMENT
104 getGlobalNames this_mod `thenRn` \ maybe_stuff ->
106 -- CHECK FOR EARLY EXIT
107 if not (maybeToBool maybe_stuff) then
108 -- Everything is up to date; no need to recompile further
113 Just (export_env, gbl_env, fixity_env, global_avail_env) = maybe_stuff
117 initRnMS gbl_env fixity_env SourceMode (
118 rnSourceDecls local_decls
119 ) `thenRn` \ (rn_local_decls, source_fvs) ->
121 -- SLURP IN ALL THE NEEDED DECLARATIONS
123 real_source_fvs = implicitFVs mod_name `plusFV` source_fvs
124 -- It's important to do the "plus" this way round, so that
125 -- when compiling the prelude, locally-defined (), Bool, etc
126 -- override the implicit ones.
128 slurpImpDecls real_source_fvs `thenRn` \ rn_imp_decls ->
130 -- EXIT IF ERRORS FOUND
131 checkErrsRn `thenRn` \ no_errs_so_far ->
132 if not no_errs_so_far then
133 -- Found errors already, so exit now
138 -- GENERATE THE VERSION/USAGE INFO
139 getImportVersions mod_name exports `thenRn` \ my_usages ->
140 getNameSupplyRn `thenRn` \ name_supply ->
142 -- REPORT UNUSED NAMES
143 reportUnusedNames gbl_env global_avail_env
147 -- RETURN THE RENAMED MODULE
149 has_orphans = any isOrphanDecl rn_local_decls
150 direct_import_mods = [mod | ImportDecl mod _ _ _ _ _ <- imports]
151 rn_all_decls = rn_imp_decls ++ rn_local_decls
152 renamed_module = HsModule mod_name vers
153 trashed_exports trashed_imports
157 rnStats rn_imp_decls `thenRn_`
158 returnRn (Just (mkThisModule mod_name,
160 (has_orphans, my_usages, export_env),
164 trashed_exports = {-trace "rnSource:trashed_exports"-} Nothing
165 trashed_imports = {-trace "rnSource:trashed_imports"-} []
168 @implicitFVs@ forces the renamer to slurp in some things which aren't
169 mentioned explicitly, but which might be needed by the type checker.
173 = implicit_main `plusFV`
174 mkNameSet default_tys `plusFV`
175 mkNameSet thinAirIdNames
177 -- Add occurrences for Int, Double, and (), because they
178 -- are the types to which ambigious type variables may be defaulted by
179 -- the type checker; so they won't always appear explicitly.
180 -- [The () one is a GHC extension for defaulting CCall results.]
181 -- ALSO: funTyCon, since it occurs implicitly everywhere!
182 -- (we don't want to be bothered with making funTyCon a
183 -- free var at every function application!)
184 default_tys = [getName intTyCon, getName doubleTyCon,
185 getName unitTyCon, getName funTyCon, getName boolTyCon]
187 -- Add occurrences for IO or PrimIO
188 implicit_main | mod_name == mAIN_Name
189 || mod_name == pREL_MAIN_Name = unitFV ioTyCon_NAME
190 | otherwise = emptyFVs
194 isOrphanDecl (InstD (InstDecl inst_ty _ _ _ _))
195 = not (foldNameSet ((||) . isLocallyDefined) False (extractHsTyNames inst_ty))
196 isOrphanDecl (RuleD (RuleDecl _ _ _ lhs _ _))
199 check (HsVar v) = not (isLocallyDefined v)
200 check (HsApp f a) = check f && check a
202 isOrphanDecl other = False
206 %*********************************************************
208 \subsection{Slurping declarations}
210 %*********************************************************
213 -------------------------------------------------------
214 slurpImpDecls source_fvs
215 = traceRn (text "slurpImp" <+> fsep (map ppr (nameSetToList source_fvs))) `thenRn_`
216 -- The current slurped-set records all local things
217 getSlurped `thenRn` \ local_binders ->
219 slurpSourceRefs source_fvs `thenRn` \ (decls1, needed1, wired_in) ->
221 inst_gates1 = foldr (plusFV . getWiredInGates) source_fvs wired_in
222 inst_gates2 = foldr (plusFV . getGates source_fvs) inst_gates1 decls1
224 -- Do this first slurpDecls before the getImportedInstDecls,
225 -- so that the home modules of all the inst_gates will be sure to be loaded
226 slurpDecls decls1 needed1 `thenRn` \ (decls2, needed2) ->
227 mapRn_ (load_home local_binders) wired_in `thenRn_`
229 -- Now we can get the instance decls
230 getImportedInstDecls inst_gates2 `thenRn` \ inst_decls ->
231 rnIfaceDecls decls2 needed2 inst_decls `thenRn` \ (decls3, needed3) ->
232 closeDecls decls3 needed3
234 load_home local_binders name
235 | name `elemNameSet` local_binders = returnRn ()
236 -- When compiling the prelude, a wired-in thing may
237 -- be defined in this module, in which case we don't
238 -- want to load its home module!
239 -- Using 'isLocallyDefined' doesn't work because some of
240 -- the free variables returned are simply 'listTyCon_Name',
241 -- with a system provenance. We could look them up every time
242 -- but that seems a waste.
243 | otherwise = loadHomeInterface doc name `thenRn_`
246 doc = ptext SLIT("need home module for wired in thing") <+> ppr name
248 -------------------------------------------------------
249 slurpSourceRefs :: FreeVars -- Variables referenced in source
250 -> RnMG ([RenamedHsDecl],
251 FreeVars, -- Un-satisfied needs
252 [Name]) -- Those variables referenced in the source
253 -- that turned out to be wired in things
255 slurpSourceRefs source_fvs
256 = go [] emptyFVs [] (nameSetToList source_fvs)
258 go decls fvs wired []
259 = returnRn (decls, fvs, wired)
260 go decls fvs wired (wanted_name:refs)
261 | isWiredInName wanted_name
262 = go decls fvs (wanted_name:wired) refs
264 = importDecl wanted_name `thenRn` \ maybe_decl ->
266 -- No declaration... (already slurped, or local)
267 Nothing -> go decls fvs wired refs
268 Just decl -> rnIfaceDecl decl `thenRn` \ (new_decl, fvs1) ->
269 go (new_decl : decls) (fvs1 `plusFV` fvs) wired
270 (extraGates new_decl ++ refs)
272 -- Hack alert. If we suck in a class
273 -- class Ord a => Baz a where ...
274 -- then Eq is also a 'gate'. Why? Because Eq is a superclass of Ord,
275 -- and hence may be needed during context reduction even though
276 -- Eq is never mentioned explicitly. So we snaffle out the super-classes
277 -- right now, so that slurpSourceRefs will heave them in
279 -- Similarly the RHS of type synonyms
280 extraGates (TyClD (ClassDecl ctxt _ tvs _ _ _ _ _ _ _))
281 = nameSetToList (delListFromNameSet (extractHsCtxtTyNames ctxt) (map getTyVarName tvs))
282 extraGates (TyClD (TySynonym _ tvs ty _))
283 = nameSetToList (delListFromNameSet (extractHsTyNames ty) (map getTyVarName tvs))
284 extraGates other = []
286 -------------------------------------------------------
287 -- closeDecls keeps going until the free-var set is empty
288 closeDecls decls needed
289 | not (isEmptyFVs needed)
290 = slurpDecls decls needed `thenRn` \ (decls1, needed1) ->
291 closeDecls decls1 needed1
294 = getImportedRules `thenRn` \ rule_decls ->
296 [] -> returnRn decls -- No new rules, so we are done
297 other -> rnIfaceDecls decls emptyFVs rule_decls `thenRn` \ (decls1, needed1) ->
298 closeDecls decls1 needed1
301 -------------------------------------------------------
302 rnIfaceDecls :: [RenamedHsDecl] -> FreeVars
303 -> [(Module, RdrNameHsDecl)]
304 -> RnM d ([RenamedHsDecl], FreeVars)
305 rnIfaceDecls decls fvs [] = returnRn (decls, fvs)
306 rnIfaceDecls decls fvs (d:ds) = rnIfaceDecl d `thenRn` \ (new_decl, fvs1) ->
307 rnIfaceDecls (new_decl:decls) (fvs1 `plusFV` fvs) ds
309 rnIfaceDecl (mod, decl) = initIfaceRnMS mod (rnDecl decl)
312 -------------------------------------------------------
313 -- Augment decls with any decls needed by needed.
314 -- Return also free vars of the new decls (only)
315 slurpDecls decls needed
316 = go decls emptyFVs (nameSetToList needed)
318 go decls fvs [] = returnRn (decls, fvs)
319 go decls fvs (ref:refs) = slurpDecl decls fvs ref `thenRn` \ (decls1, fvs1) ->
322 -------------------------------------------------------
323 slurpDecl decls fvs wanted_name
324 = importDecl wanted_name `thenRn` \ maybe_decl ->
326 -- No declaration... (wired in thing)
327 Nothing -> returnRn (decls, fvs)
329 -- Found a declaration... rename it
330 Just decl -> rnIfaceDecl decl `thenRn` \ (new_decl, fvs1) ->
331 returnRn (new_decl:decls, fvs1 `plusFV` fvs)
335 %*********************************************************
337 \subsection{Extracting the 'gates'}
339 %*********************************************************
341 When we import a declaration like
343 data T = T1 Wibble | T2 Wobble
345 we don't want to treat Wibble and Wobble as gates *unless* T1, T2
346 respectively are mentioned by the user program. If only T is mentioned
347 we want only T to be a gate; that way we don't suck in useless instance
348 decls for (say) Eq Wibble, when they can't possibly be useful.
350 @getGates@ takes a newly imported (and renamed) decl, and the free
351 vars of the source program, and extracts from the decl the gate names.
354 getGates source_fvs (SigD (IfaceSig _ ty _ _))
355 = extractHsTyNames ty
357 getGates source_fvs (TyClD (ClassDecl ctxt cls tvs sigs _ _ _ _ _ _))
358 = delListFromNameSet (foldr (plusFV . get) (extractHsCtxtTyNames ctxt) sigs)
359 (map getTyVarName tvs)
360 `addOneToNameSet` cls
362 get (ClassOpSig n _ ty _)
363 | n `elemNameSet` source_fvs = extractHsTyNames ty
364 | otherwise = emptyFVs
366 getGates source_fvs (TyClD (TySynonym tycon tvs ty _))
367 = delListFromNameSet (extractHsTyNames ty)
368 (map getTyVarName tvs)
369 `addOneToNameSet` tycon
371 getGates source_fvs (TyClD (TyData _ ctxt tycon tvs cons _ _ _))
372 = delListFromNameSet (foldr (plusFV . get) (extractHsCtxtTyNames ctxt) cons)
373 (map getTyVarName tvs)
374 `addOneToNameSet` tycon
376 get (ConDecl n tvs ctxt details _)
377 | n `elemNameSet` source_fvs
378 -- If the constructor is method, get fvs from all its fields
379 = delListFromNameSet (get_details details `plusFV`
380 extractHsCtxtTyNames ctxt)
381 (map getTyVarName tvs)
382 get (ConDecl n tvs ctxt (RecCon fields) _)
383 -- Even if the constructor isn't mentioned, the fields
384 -- might be, as selectors. They can't mention existentially
385 -- bound tyvars (typechecker checks for that) so no need for
386 -- the deleteListFromNameSet part
387 = foldr (plusFV . get_field) emptyFVs fields
389 get other_con = emptyFVs
391 get_details (VanillaCon tys) = plusFVs (map get_bang tys)
392 get_details (InfixCon t1 t2) = get_bang t1 `plusFV` get_bang t2
393 get_details (RecCon fields) = plusFVs [get_bang t | (_, t) <- fields]
394 get_details (NewCon t _) = extractHsTyNames t
396 get_field (fs,t) | any (`elemNameSet` source_fvs) fs = get_bang t
397 | otherwise = emptyFVs
399 get_bang (Banged t) = extractHsTyNames t
400 get_bang (Unbanged t) = extractHsTyNames t
401 get_bang (Unpacked t) = extractHsTyNames t
403 getGates source_fvs other_decl = emptyFVs
406 getWiredInGates is just like getGates, but it sees a wired-in Name
407 rather than a declaration.
410 getWiredInGates name | is_tycon = get_wired_tycon the_tycon
411 | otherwise = get_wired_id the_id
413 maybe_wired_in_tycon = maybeWiredInTyConName name
414 is_tycon = maybeToBool maybe_wired_in_tycon
415 maybe_wired_in_id = maybeWiredInIdName name
416 Just the_tycon = maybe_wired_in_tycon
417 Just the_id = maybe_wired_in_id
419 get_wired_id id = namesOfType (idType id)
421 get_wired_tycon tycon
423 = namesOfType ty `minusNameSet` mkNameSet (map getName tyvars)
425 | otherwise -- data or newtype
426 = foldr (unionNameSets . namesOfType . dataConType) emptyNameSet data_cons
428 (tyvars,ty) = getSynTyConDefn tycon
429 data_cons = tyConDataCons tycon
433 %*********************************************************
435 \subsection{Unused names}
437 %*********************************************************
440 reportUnusedNames gbl_env avail_env (ExportEnv export_avails _) mentioned_names
441 | not (opt_WarnUnusedBinds || opt_WarnUnusedImports)
446 used_names = mentioned_names `unionNameSets` availsToNameSet export_avails
448 -- Now, a use of C implies a use of T,
449 -- if C was brought into scope by T(..) or T(C)
450 really_used_names = used_names `unionNameSets`
451 mkNameSet [ availName avail
452 | sub_name <- nameSetToList used_names,
453 let avail = case lookupNameEnv avail_env sub_name of
455 Nothing -> pprTrace "r.u.n" (ppr sub_name) $
459 defined_names = mkNameSet (concat (rdrEnvElts gbl_env))
460 defined_but_not_used = nameSetToList (defined_names `minusNameSet` really_used_names)
462 -- Filter out the ones only defined implicitly
463 bad_guys = filter reportableUnusedName defined_but_not_used
465 warnUnusedTopNames bad_guys `thenRn_`
468 reportableUnusedName :: Name -> Bool
469 reportableUnusedName name
470 = explicitlyImported (getNameProvenance name) &&
471 not (startsWithUnderscore (occNameUserString (nameOccName name)))
473 explicitlyImported (LocalDef _ _) = True -- Report unused defns of local vars
474 explicitlyImported (NonLocalDef (UserImport _ _ expl) _) = expl -- Report unused explicit imports
475 explicitlyImported other = False -- Don't report others
477 -- Haskell 98 encourages compilers to suppress warnings about
478 -- unused names in a pattern if they start with "_".
479 startsWithUnderscore ('_' : _) = True -- Suppress warnings for names starting
480 startsWithUnderscore other = False -- with an underscore
482 rnStats :: [RenamedHsDecl] -> RnMG ()
484 | opt_D_dump_rn_trace ||
485 opt_D_dump_rn_stats ||
487 = getRnStats imp_decls `thenRn` \ msg ->
488 ioToRnM (printErrs msg) `thenRn_`
491 | otherwise = returnRn ()
496 %*********************************************************
498 \subsection{Statistics}
500 %*********************************************************
503 getRnStats :: [RenamedHsDecl] -> RnMG SDoc
504 getRnStats imported_decls
505 = getIfacesRn `thenRn` \ ifaces ->
507 n_mods = length [() | (_, _, Just _) <- eltsFM (iImpModInfo ifaces)]
509 decls_read = [decl | (_, avail, True, (_,decl)) <- nameEnvElts (iDecls ifaces),
510 -- Data, newtype, and class decls are in the decls_fm
511 -- under multiple names; the tycon/class, and each
512 -- constructor/class op too.
513 -- The 'True' selects just the 'main' decl
514 not (isLocallyDefined (availName avail))
517 (cd_rd, dd_rd, nd_rd, sd_rd, vd_rd, _) = count_decls decls_read
518 (cd_sp, dd_sp, nd_sp, sd_sp, vd_sp, id_sp) = count_decls imported_decls
520 unslurped_insts = iInsts ifaces
521 inst_decls_unslurped = length (bagToList unslurped_insts)
522 inst_decls_read = id_sp + inst_decls_unslurped
525 [int n_mods <+> text "interfaces read",
526 hsep [ int cd_sp, text "class decls imported, out of",
527 int cd_rd, text "read"],
528 hsep [ int dd_sp, text "data decls imported, out of",
529 int dd_rd, text "read"],
530 hsep [ int nd_sp, text "newtype decls imported, out of",
531 int nd_rd, text "read"],
532 hsep [int sd_sp, text "type synonym decls imported, out of",
533 int sd_rd, text "read"],
534 hsep [int vd_sp, text "value signatures imported, out of",
535 int vd_rd, text "read"],
536 hsep [int id_sp, text "instance decls imported, out of",
537 int inst_decls_read, text "read"],
538 text "cls dcls slurp" <+> fsep (map (ppr . tyClDeclName)
539 [d | TyClD d <- imported_decls, isClassDecl d]),
540 text "cls dcls read" <+> fsep (map (ppr . tyClDeclName)
541 [d | TyClD d <- decls_read, isClassDecl d])]
543 returnRn (hcat [text "Renamer stats: ", stats])
553 tycl_decls = [d | TyClD d <- decls]
554 (class_decls, data_decls, newtype_decls, syn_decls) = countTyClDecls tycl_decls
556 val_decls = length [() | SigD _ <- decls]
557 inst_decls = length [() | InstD _ <- decls]