2 % (c) The GRASP Project, Glasgow University, 1992-1996
4 \section[Rename]{Renaming and dependency analysis passes}
7 #include "HsVersions.h"
9 module Rename ( renameModule ) where
11 #if __GLASGOW_HASKELL__ <= 201
12 import PreludeGlaST ( thenPrimIO )
19 IMPORT_1_3(List(partition))
22 import RdrHsSyn ( RdrName(..), SYN_IE(RdrNameHsModule), SYN_IE(RdrNameImportDecl) )
23 import RnHsSyn ( SYN_IE(RenamedHsModule), SYN_IE(RenamedHsDecl), extractHsTyNames )
25 import CmdLineOpts ( opt_HiMap, opt_WarnNameShadowing, opt_D_show_rn_trace,
26 opt_D_dump_rn, opt_D_show_passes
29 import RnNames ( getGlobalNames )
30 import RnSource ( rnDecl )
31 import RnIfaces ( getImportedInstDecls, importDecl, getImportVersions, getSpecialInstModules,
33 mkSearchPath, getSlurpedNames, getRnStats
35 import RnEnv ( availsToNameSet, addAvailToNameSet,
36 addImplicitOccsRn, lookupImplicitOccRn )
37 import Id ( GenId {- instance NamedThing -} )
38 import Name ( Name, Provenance, ExportFlag(..), isLocallyDefined,
39 NameSet(..), elemNameSet, mkNameSet, unionNameSets,
40 nameSetToList, minusNameSet, NamedThing(..),
41 modAndOcc, pprModule, pprOccName, nameOccName
43 import TysWiredIn ( unitTyCon, intTyCon, doubleTyCon )
44 import PrelInfo ( ioTyCon_NAME, primIoTyCon_NAME )
45 import TyCon ( TyCon )
46 import PrelMods ( mAIN, gHC_MAIN )
47 import ErrUtils ( SYN_IE(Error), SYN_IE(Warning) )
48 import FiniteMap ( emptyFM, eltsFM, fmToList, addToFM, FiniteMap )
50 import PprStyle ( PprStyle(..) )
51 import Util ( cmpPString, equivClasses, panic, assertPanic, pprTrace )
52 #if __GLASGOW_HASKELL__ >= 202
60 renameModule :: UniqSupply
62 -> IO (Maybe -- Nothing <=> everything up to date;
63 -- no ned to recompile any further
64 (RenamedHsModule, -- Output, after renaming
65 InterfaceDetails, -- Interface; for interface file generatino
66 RnNameSupply, -- Final env; for renaming derivings
67 [Module]), -- Imported modules; for profiling
75 renameModule us this_mod@(HsModule mod_name vers exports imports fixities local_decls loc)
76 = -- INITIALISE THE RENAMER MONAD
77 initRn mod_name us (mkSearchPath opt_HiMap) loc $
79 -- FIND THE GLOBAL NAME ENVIRONMENT
80 getGlobalNames this_mod `thenRn` \ global_name_info ->
82 case global_name_info of {
83 Nothing -> -- Everything is up to date; no need to recompile further
87 -- Otherwise, just carry on
88 Just (export_env, rn_env, explicit_names) ->
91 initRnMS rn_env mod_name SourceMode (
92 addImplicits mod_name `thenRn_`
93 mapRn rnDecl local_decls
94 ) `thenRn` \ rn_local_decls ->
96 -- SLURP IN ALL THE NEEDED DECLARATIONS
97 closeDecls rn_local_decls `thenRn` \ rn_all_decls ->
100 -- GENERATE THE VERSION/USAGE INFO
101 getImportVersions mod_name exports `thenRn` \ import_versions ->
102 getNameSupplyRn `thenRn` \ name_supply ->
104 -- REPORT UNUSED NAMES
105 reportUnusedNames explicit_names `thenRn_`
107 -- GENERATE THE SPECIAL-INSTANCE MODULE LIST
108 -- The "special instance" modules are those modules that contain instance
109 -- declarations that contain no type constructor or class that was declared
111 getSpecialInstModules `thenRn` \ imported_special_inst_mods ->
113 special_inst_decls = [d | InstD d@(InstDecl inst_ty _ _ _ _) <- rn_local_decls,
114 all (not.isLocallyDefined) (nameSetToList (extractHsTyNames inst_ty))
116 special_inst_mods | null special_inst_decls = imported_special_inst_mods
117 | otherwise = mod_name : imported_special_inst_mods
121 -- RETURN THE RENAMED MODULE
123 import_mods = [mod | ImportDecl mod _ _ _ _ <- imports]
125 renamed_module = HsModule mod_name vers
126 trashed_exports trashed_imports trashed_fixities
130 rnStats rn_all_decls `thenRn_`
131 returnRn (Just (renamed_module,
132 (import_versions, export_env, special_inst_mods),
137 trashed_exports = {-trace "rnSource:trashed_exports"-} Nothing
138 trashed_imports = {-trace "rnSource:trashed_imports"-} []
139 trashed_fixities = []
142 @addImplicits@ forces the renamer to slurp in some things which aren't
143 mentioned explicitly, but which might be needed by the type checker.
146 addImplicits mod_name
147 = addImplicitOccsRn (implicit_main ++ default_tys)
149 -- Add occurrences for Int, Double, and (), because they
150 -- are the types to which ambigious type variables may be defaulted by
151 -- the type checker; so they won't every appear explicitly.
152 -- [The () one is a GHC extension for defaulting CCall results.]
153 default_tys = [getName intTyCon, getName doubleTyCon, getName unitTyCon]
155 -- Add occurrences for IO or PrimIO
156 implicit_main | mod_name == mAIN = [ioTyCon_NAME]
157 | mod_name == gHC_MAIN = [primIoTyCon_NAME]
163 closeDecls :: [RenamedHsDecl] -- Declarations got so far
164 -> RnMG [RenamedHsDecl] -- input + extra decls slurped
165 -- The monad includes a list of possibly-unresolved Names
166 -- This list is empty when closeDecls returns
169 = popOccurrenceName `thenRn` \ maybe_unresolved ->
170 case maybe_unresolved of
172 -- No more unresolved names
173 Nothing -> -- Instance decls still pending?
174 getImportedInstDecls `thenRn` \ inst_decls ->
175 traceRn (sep [ptext SLIT("Slurped"), int (length inst_decls), ptext SLIT("instance decls")])
177 if not (null inst_decls) then
178 mapRn rn_inst_decl inst_decls `thenRn` \ new_inst_decls ->
180 -- We *must* loop again here. Why? Two reasons:
181 -- (a) an instance decl will give rise to an unresolved dfun, whose
182 -- decl we must slurp to get its version number; that's the version
183 -- number for the whole instance decl. (And its unfolding might mention new
184 -- unresolved names.)
185 -- (b) an instance decl might give rise to a new unresolved class,
186 -- whose decl we must slurp, which might let in some new instance decls,
187 -- and so on. Example: instance Foo a => Baz [a] where ...
189 closeDecls (new_inst_decls ++ decls)
192 -- No more instance decls, so all we have left is
193 -- to deal with the deferred data type decls.
194 getDeferredDataDecls `thenRn` \ data_decls ->
195 mapRn rn_data_decl data_decls `thenRn` \ rn_data_decls ->
196 returnRn (rn_data_decls ++ decls)
198 -- An unresolved name
199 Just (name,necessity)
200 -> -- Slurp its declaration, if any
201 -- traceRn (sep [ptext SLIT("Considering"), ppr PprDebug name]) `thenRn_`
202 importDecl name necessity `thenRn` \ maybe_decl ->
205 -- No declaration... (wired in thing or optional)
206 Nothing -> closeDecls decls
208 -- Found a declaration... rename it
209 Just decl -> rn_iface_decl mod_name decl `thenRn` \ new_decl ->
210 closeDecls (new_decl : decls)
212 (mod_name,_) = modAndOcc name
215 rn_iface_decl mod_name decl = initRnMS emptyRnEnv mod_name InterfaceMode (rnDecl decl)
216 -- Notice that the rnEnv starts empty
218 rn_inst_decl (mod_name,decl) = rn_iface_decl mod_name (InstD decl)
220 rn_data_decl (tycon_name,ty_decl) = rn_iface_decl mod_name (TyD ty_decl)
222 (mod_name, _) = modAndOcc tycon_name
226 reportUnusedNames explicit_avail_names
227 | not opt_WarnNameShadowing
231 = getSlurpedNames `thenRn` \ slurped_names ->
233 unused = explicit_avail_names `minusNameSet` slurped_names
234 (local_unused, imported_unused) = partition isLocallyDefined (nameSetToList unused)
235 imports_by_module = equivClasses cmp imported_unused
236 name1 `cmp` name2 = nameModule name1 `_CMP_STRING_` nameModule name2
238 pp_imp sty = sep [text "For information: the following unqualified imports are unused:",
239 nest 4 (vcat (map (pp_group sty) imports_by_module))]
240 pp_group sty (n:ns) = sep [hcat [text "Module ", pprModule PprForUser (nameModule n), char ':'],
241 nest 4 (sep (map (pprOccName sty . nameOccName) (n:ns)))]
243 pp_local sty = sep [text "For information: the following local top-level definitions are unused:",
244 nest 4 (sep (map (pprOccName sty . nameOccName) local_unused))]
246 (if null imported_unused
248 else addWarnRn pp_imp) `thenRn_`
250 (if null local_unused
252 else addWarnRn pp_local)
254 nameModule n = fst (modAndOcc n)
256 rnStats :: [RenamedHsDecl] -> RnMG ()
258 | opt_D_show_rn_trace ||
261 = getRnStats all_decls `thenRn` \ msg ->
262 ioToRnMG (hPutStr stderr (show msg) >>
263 hPutStr stderr "\n") `thenRn_`
266 | otherwise = returnRn ()