1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
|
%
% (c) The GRASP Project, Glasgow University, 1992-1996
%
\section[Rename]{Renaming and dependency analysis passes}
\begin{code}
#include "HsVersions.h"
module Rename ( renameModule ) where
import PreludeGlaST ( thenPrimIO )
IMP_Ubiq()
IMPORT_1_3(List(partition))
import HsSyn
import RdrHsSyn ( RdrName, SYN_IE(RdrNameHsModule), SYN_IE(RdrNameImportDecl) )
import RnHsSyn ( SYN_IE(RenamedHsModule), SYN_IE(RenamedHsDecl), extractHsTyNames )
import CmdLineOpts ( opt_HiMap )
import RnMonad
import RnNames ( getGlobalNames )
import RnSource ( rnDecl )
import RnIfaces ( getImportedInstDecls, getDecl, getImportVersions, getSpecialInstModules,
mkSearchPath, getWiredInDecl
)
import RnEnv ( availsToNameSet, addAvailToNameSet, addImplicitOccsRn )
import Id ( GenId {- instance NamedThing -} )
import Name ( Name, Provenance, ExportFlag(..), isLocallyDefined,
NameSet(..), elemNameSet, mkNameSet, unionNameSets, nameSetToList,
isWiredInName, modAndOcc
)
import TysWiredIn ( unitTyCon, intTyCon, doubleTyCon )
import TyCon ( TyCon )
import ErrUtils ( SYN_IE(Error), SYN_IE(Warning) )
import FiniteMap ( emptyFM, eltsFM, fmToList, addToFM, FiniteMap )
import Pretty
import PprStyle ( PprStyle(..) )
import Util ( panic, assertPanic, pprTrace )
\end{code}
\begin{code}
renameModule :: UniqSupply
-> RdrNameHsModule
-> IO (Maybe -- Nothing <=> everything up to date;
-- no ned to recompile any further
(RenamedHsModule, -- Output, after renaming
InterfaceDetails, -- Interface; for interface file generatino
RnNameSupply, -- Final env; for renaming derivings
[Module]), -- Imported modules; for profiling
Bag Error,
Bag Warning
)
\end{code}
\begin{code}
renameModule us this_mod@(HsModule mod_name vers exports imports fixities local_decls loc)
= -- INITIALISE THE RENAMER MONAD
initRn mod_name us (mkSearchPath opt_HiMap) loc $
-- FIND THE GLOBAL NAME ENVIRONMENT
getGlobalNames this_mod `thenRn` \ global_name_info ->
case global_name_info of {
Nothing -> -- Everything is up to date; no need to recompile further
returnRn Nothing ;
-- Otherwise, just carry on
Just (export_env, rn_env, local_avails) ->
-- RENAME THE SOURCE
-- We also add occurrences for Int, Double, and (), because they
-- are the types to which ambigious type variables may be defaulted by
-- the type checker; so they won't every appear explicitly.
-- [The () one is a GHC extension for defaulting CCall results.]
initRnMS rn_env mod_name SourceMode (mapRn rnDecl local_decls) `thenRn` \ rn_local_decls ->
addImplicitOccsRn [getName intTyCon,
getName doubleTyCon,
getName unitTyCon] `thenRn_`
-- SLURP IN ALL THE NEEDED DECLARATIONS
-- Notice that the rnEnv starts empty
closeDecls rn_local_decls (availsToNameSet local_avails) []
`thenRn` \ (rn_all_decls, imported_avails) ->
-- SLURP IN ALL NEEDED INSTANCE DECLARATIONS
-- We keep the ones that only mention things (type constructors, classes) that are
-- already imported. Ones which don't can't possibly be useful to us.
getImportedInstDecls `thenRn` \ imported_insts ->
let
all_big_names = mkNameSet [name | Avail name _ <- local_avails] `unionNameSets`
mkNameSet [name | Avail name _ <- imported_avails]
rn_needed_insts = [ initRnMS emptyRnEnv mod_name InterfaceMode (rnDecl (InstD inst_decl))
| (inst_names, mod_name, inst_decl) <- imported_insts,
all (`elemNameSet` all_big_names) inst_names
]
in
sequenceRn rn_needed_insts `thenRn` \ inst_decls ->
-- Maybe we need to do another close-decls?
-- GENERATE THE VERSION/USAGE INFO
getImportVersions imported_avails `thenRn` \ import_versions ->
getNameSupplyRn `thenRn` \ name_supply ->
-- GENERATE THE SPECIAL-INSTANCE MODULE LIST
-- The "special instance" modules are those modules that contain instance
-- declarations that contain no type constructor or class that was declared
-- in that module.
getSpecialInstModules `thenRn` \ imported_special_inst_mods ->
let
special_inst_decls = [d | InstD d@(InstDecl inst_ty _ _ _ _) <- rn_local_decls,
all (not.isLocallyDefined) (nameSetToList (extractHsTyNames inst_ty))
]
special_inst_mods | null special_inst_decls = imported_special_inst_mods
| otherwise = mod_name : imported_special_inst_mods
in
-- RETURN THE RENAMED MODULE
let
import_mods = [mod | ImportDecl mod _ _ _ _ <- imports]
renamed_module = HsModule mod_name vers
trashed_exports trashed_imports trashed_fixities
(inst_decls ++ rn_all_decls)
loc
in
returnRn (Just (renamed_module,
(import_versions, export_env, special_inst_mods),
name_supply,
import_mods))
}
where
trashed_exports = {-trace "rnSource:trashed_exports"-} Nothing
trashed_imports = {-trace "rnSource:trashed_imports"-} []
trashed_fixities = []
\end{code}
\begin{code}
closeDecls :: [RenamedHsDecl] -- Declarations got so far
-> NameSet -- Names bound by those declarations
-> [AvailInfo] -- Available stuff generated by closeDecls so far
-> RnMG ([RenamedHsDecl], -- The closed set
[AvailInfo]) -- Available stuff generated by closeDecls
-- The monad includes a list of possibly-unresolved Names
-- This list is empty when closeDecls returns
closeDecls decls decl_names import_avails
= popOccurrenceName `thenRn` \ maybe_unresolved ->
case maybe_unresolved of
-- No more unresolved names; we're done
Nothing -> returnRn (decls, import_avails)
-- An "unresolved" name that we've already dealt with
Just (name,_) | name `elemNameSet` decl_names
-> closeDecls decls decl_names import_avails
-- An unresolved name that's wired in. In this case there's no
-- declaration to get, but we still want to record it as now available,
-- so that we remember to look for instance declarations involving it.
Just (name,_) | isWiredInName name
-> getWiredInDecl name `thenRn` \ decl_avail ->
closeDecls decls
(addAvailToNameSet decl_names decl_avail)
(decl_avail : import_avails)
-- Genuinely unresolved name
Just (name,necessity) | otherwise
-> getDecl name `thenRn` \ (decl_avail,new_decl) ->
case decl_avail of
-- Can't find the declaration; check that it was optional
NotAvailable -> checkRn (case necessity of { Optional -> True; other -> False})
(getDeclErr name) `thenRn_`
closeDecls decls decl_names import_avails
-- Found it
other -> initRnMS emptyRnEnv mod_name InterfaceMode (
rnDecl new_decl
) `thenRn` \ rn_decl ->
closeDecls (rn_decl : decls)
(addAvailToNameSet decl_names decl_avail)
(decl_avail : import_avails)
where
(mod_name,_) = modAndOcc name
getDeclErr name sty
= ppSep [ppStr "Failed to find interface decl for", ppr sty name]
\end{code}
|
