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 import PreludeGlaST ( thenPrimIO, returnPrimIO, fixPrimIO, newVar, MutableVar(..) )
16 import RdrHsSyn ( RdrNameHsModule(..), RdrNameImportDecl(..) )
17 import RnHsSyn ( RnName, RenamedHsModule(..), isRnTyCon, isRnClass )
20 import RnNames ( getGlobalNames, GlobalNameInfo(..) )
21 import RnSource ( rnSource )
22 import RnIfaces ( rnInterfaces, finalIfaceInfo, VersionInfo(..), ParsedIface )
23 import RnUtils ( extendGlobalRnEnv, emptyRnEnv, multipleOccWarn )
26 import Bag ( isEmptyBag, unionBags, bagToList, listToBag )
27 import ErrUtils ( Error(..), Warning(..) )
28 import FiniteMap ( emptyFM, eltsFM )
29 import Name ( getOrigNameRdr, isLocallyDefined, Name, RdrName(..) )
30 import PrelInfo ( BuiltinNames(..), BuiltinKeys(..) )
31 import UniqFM ( emptyUFM, lookupUFM, addListToUFM_C, eltsUFM )
32 import UniqSupply ( splitUniqSupply )
33 import Util ( panic, assertPanic )
35 findHiFiles :: PrimIO (FiniteMap Module FAST_STRING)
36 findHiFiles = returnPrimIO emptyFM
40 renameModule :: BuiltinNames
47 RenamedHsModule, -- output, after renaming
48 [Module], -- imported modules; for profiling
50 VersionInfo, -- version info; for usage
51 [Module], -- instance modules; for iface
58 ToDo: May want to arrange to return old interface for this module!
59 ToDo: Return OrigName RnEnv to rename derivings etc with.
60 ToDo: Builtin names which must be read.
61 ToDo: Deal with instances (instance version, this module on instance list ???)
64 renameModule b_names b_keys us
65 input@(HsModule mod _ _ imports _ _ _ _ _ _ _ _ _ _)
66 = findHiFiles `thenPrimIO` \ hi_files ->
67 newVar (emptyFM, hi_files) `thenPrimIO` \ iface_var ->
69 fixPrimIO ( \ ~(_, _, _, _, rec_occ_fm, rec_export_fn) ->
71 rec_occ_fn :: Name -> [RdrName]
72 rec_occ_fn n = case lookupUFM rec_occ_fm n of
74 Just (rn,occs) -> occs
76 global_name_info = (b_names, b_keys, rec_export_fn, rec_occ_fn)
78 getGlobalNames iface_var global_name_info us1 input
79 `thenPrimIO` \ (occ_env, imp_mods, imp_fixes, top_errs, top_warns) ->
81 if not (isEmptyBag top_errs) then
82 returnPrimIO (rn_panic, rn_panic, top_errs, top_warns, emptyUFM, rn_panic)
85 -- No top-level name errors so rename source ...
86 case initRn True mod occ_env us2
87 (rnSource imp_mods imp_fixes input) of {
88 ((rn_module, export_fn, src_occs), src_errs, src_warns) ->
91 occ_fm :: UniqFM (RnName, [RdrName])
93 occ_list = [ (rn,(rn,[occ])) | (rn,occ) <- bagToList src_occs]
94 occ_fm = addListToUFM_C insert_occ emptyUFM occ_list
96 insert_occ (rn,olds) (rn',[new]) = (rn, insert new olds)
99 insert new xxs@(x:xs) = case cmp new x of LT_ -> new : xxs
101 GT__ -> x : insert new xs
103 occ_warns = map multipleOccWarn (filter multiple_occs (eltsUFM occ_fm))
104 multiple_occs (rn, (o1:o2:_)) = True
105 multiple_occs _ = False
107 returnPrimIO (rn_module, imp_mods,
108 top_errs `unionBags` src_errs,
109 top_warns `unionBags` src_warns `unionBags` listToBag occ_warns,
112 }) `thenPrimIO` \ (rn_module, imp_mods, errs_so_far, warns_so_far, occ_fm, _) ->
114 if not (isEmptyBag errs_so_far) then
115 returnMn (rn_panic, rn_panic, rn_panic, rn_panic,
116 errs_so_far, warns_so_far)
119 -- No errors renaming source so rename the interfaces ...
121 imports_used = [ rn | (rn,_) <- eltsUFM occ_fm, not (isLocallyDefined rn) ]
122 (import_tcs, import_vals) = partition (\ rn -> isRnTyCon rn || isRnClass rn) imports_used
124 (orig_env, orig_dups) = extendGlobalRnEnv emptyRnEnv (map pair_orig import_vals)
125 (map pair_orig import_tcs)
126 pair_orig rn = (getOrigNameRdr rn, rn)
128 -- ToDo: Do we need top-level names from this module in orig_env ???
130 ASSERT (isEmptyBag orig_dups)
131 rnInterfaces iface_var orig_env us3 rn_module imports_used
132 `thenPrimIO` \ (rn_module_with_imports,
133 (implicit_val_fm, implicit_tc_fm),
134 iface_errs, iface_warns) ->
136 all_imports_used = imports_used ++ eltsFM implicit_tc_fm ++ eltsFM implicit_val_fm
138 finalIfaceInfo iface_var all_imports_used imp_mods
139 `thenPrimIO` \ (version_info, instance_mods) ->
141 returnMn (rn_module_with_imports, imp_mods,
142 version_info, instance_mods,
143 errs_so_far `unionBags` iface_errs,
144 warns_so_far `unionBags` iface_warns)
147 rn_panic = panic "renameModule: aborted with errors"
149 (us1, us') = splitUniqSupply us
150 (us2, us3) = splitUniqSupply us'