2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
4 \section[RnNames]{Extracting imported and top-level names in scope}
7 #include "HsVersions.h"
15 import CmdLineOpts ( opt_SourceUnchanged )
16 import HsSyn ( HsModule(..), HsDecl(..), FixityDecl(..), Fixity, Fake, InPat, IE(..), HsTyVar,
17 TyDecl, ClassDecl, InstDecl, DefaultDecl, ImportDecl(..), HsBinds, IfaceSig
19 import HsBinds ( collectTopBinders )
20 import HsImpExp ( ieName )
21 import RdrHsSyn ( RdrNameHsDecl(..), RdrName(..), RdrNameIE(..), SYN_IE(RdrNameImportDecl),
22 SYN_IE(RdrNameHsModule), SYN_IE(RdrNameFixityDecl),
25 import RnHsSyn ( RenamedHsModule(..), RenamedFixityDecl(..) )
26 import RnIfaces ( getInterfaceExports, getDeclBinders, checkUpToDate )
31 import UniqFM ( UniqFM, emptyUFM, addListToUFM_C, lookupUFM )
32 import Bag ( Bag, bagToList )
33 import Maybes ( maybeToBool, expectJust )
36 import PprStyle ( PprStyle(..) )
37 import Util ( panic, pprTrace )
42 %************************************************************************
44 \subsection{Get global names}
46 %************************************************************************
49 getGlobalNames :: RdrNameHsModule
50 -> RnMG (Maybe (ExportEnv, RnEnv, [AvailInfo]))
51 -- Nothing <=> no need to recompile
53 getGlobalNames m@(HsModule this_mod _ exports imports _ _ mod_loc)
54 = fixRn (\ ~(rec_exp_fn, _) ->
56 -- PROCESS LOCAL DECLS
57 -- Do these *first* so that the correct provenance gets
58 -- into the global name cache.
59 importsFromLocalDecls rec_exp_fn m `thenRn` \ (local_rn_env, local_mod_avails) ->
61 -- PROCESS IMPORT DECLS
62 mapAndUnzipRn importsFromImportDecl all_imports
63 `thenRn` \ (imp_rn_envs, imp_avails_s) ->
65 -- CHECK FOR EARLY EXIT
66 checkEarlyExit this_mod `thenRn` \ early_exit ->
68 returnRn (junk_exp_fn, Nothing)
72 -- We put the local env first, so that a local provenance
73 -- "wins", even if a module imports itself.
74 foldlRn plusRnEnv emptyRnEnv imp_rn_envs `thenRn` \ imp_rn_env ->
75 plusRnEnv local_rn_env imp_rn_env `thenRn` \ rn_env ->
77 all_avails :: ModuleAvails
78 all_avails = foldr plusModuleAvails local_mod_avails imp_avails_s
79 local_avails = expectJust "getGlobalNames" (lookupModuleAvails local_mod_avails this_mod)
82 -- PROCESS EXPORT LISTS
83 exportsFromAvail this_mod exports all_avails rn_env
84 `thenRn` \ (export_fn, export_env) ->
86 returnRn (export_fn, Just (export_env, rn_env, local_avails))
87 ) `thenRn` \ (_, result) ->
90 junk_exp_fn = error "RnNames:export_fn"
92 all_imports = prel_imports ++ imports
94 prel_imports | this_mod == pRELUDE ||
95 explicit_prelude_import = []
97 | otherwise = [ImportDecl pRELUDE
98 False {- Not qualified -}
100 Nothing {- No import list -}
103 explicit_prelude_import
104 = not (null [ () | (ImportDecl mod qual _ _ _) <- imports, mod == pRELUDE ])
109 = if not opt_SourceUnchanged then
110 -- Source code changed; look no further
113 -- Unchanged source; look further
115 -- (a) errors so far. These can arise if a module imports
116 -- something that's no longer exported by the imported module
117 -- (b) usage information up to date
118 checkErrsRn `thenRn` \ no_errs_so_far ->
119 checkUpToDate mod `thenRn` \ up_to_date ->
120 returnRn (no_errs_so_far && up_to_date)
125 importsFromImportDecl :: RdrNameImportDecl
126 -> RnMG (RnEnv, ModuleAvails)
128 -- Check for "import M ()", and then don't even look at M.
129 -- This makes sense, and is actually rather useful for the Prelude.
130 importsFromImportDecl (ImportDecl mod qual as_mod (Just (False,[])) loc)
131 = returnRn (emptyRnEnv, emptyModuleAvails)
133 importsFromImportDecl (ImportDecl mod qual as_mod import_spec loc)
135 getInterfaceExports mod `thenRn` \ (avails, fixities) ->
136 filterImports mod import_spec avails `thenRn` \ filtered_avails ->
138 filtered_avails' = [ Avail (set_name_prov n) (map set_name_prov ns)
139 | Avail n ns <- filtered_avails
141 fixities' = [ (occ,fixity,provenance) | (occ,fixity) <- fixities ]
143 qualifyImports mod qual as_mod (ExportEnv filtered_avails' fixities')
145 set_name_prov name = setNameProvenance name provenance
146 provenance = Imported mod loc
151 importsFromLocalDecls rec_exp_fn (HsModule mod _ _ _ fix_decls decls _)
152 = foldlRn getLocalDeclBinders [] decls `thenRn` \ avails ->
153 mapRn fixityFromFixDecl fix_decls `thenRn` \ fixities ->
155 False -- Not qualified
156 Nothing -- No "as M" part
157 (ExportEnv avails fixities)
159 newLocalName rdr_name loc
160 = newLocallyDefinedGlobalName mod (rdrNameOcc rdr_name) rec_exp_fn loc
162 getLocalDeclBinders avails (ValD binds)
163 = mapRn do_one (bagToList (collectTopBinders binds)) `thenRn` \ val_avails ->
164 returnRn (val_avails ++ avails)
166 getLocalDeclBinders avails decl
167 = getDeclBinders newLocalName decl `thenRn` \ avail ->
168 returnRn (avail : avails)
170 do_one (rdr_name, loc)
171 = newLocalName rdr_name loc `thenRn` \ name ->
172 returnRn (Avail name [])
175 %************************************************************************
177 \subsection{Filtering imports}
179 %************************************************************************
181 @filterImports@ takes the @ExportEnv@ telling what the imported module makes
182 available, and filters it through the import spec (if any).
185 filterImports :: Module
186 -> Maybe (Bool, [RdrNameIE]) -- Import spec; True => hidin
187 -> [AvailInfo] -- What's available
188 -> RnMG [AvailInfo] -- What's actually imported
189 -- Complains if import spec mentions things the
190 -- module doesn't export
192 filterImports mod Nothing imports
195 filterImports mod (Just (want_hiding, import_items)) avails
196 = -- Check that each import item mentions things that are actually available
197 mapRn check_import_item import_items `thenRn_`
199 -- Return filtered environment; no need to filter fixities
200 returnRn (map new_avail avails)
203 import_fm :: FiniteMap OccName RdrNameIE
204 import_fm = listToFM [(ieOcc ie, ie) | ie <- import_items]
206 avail_fm :: FiniteMap OccName AvailInfo
207 avail_fm = listToFM [(nameOccName name, avail) | avail@(Avail name ns) <- avails]
209 new_avail NotAvailable = NotAvailable
210 new_avail avail@(Avail name _)
211 | not in_import_items && want_hiding = avail
212 | not in_import_items && not want_hiding = NotAvailable
213 | in_import_items && want_hiding = NotAvailable
214 | in_import_items && not want_hiding = filtered_avail
216 maybe_import_item = lookupFM import_fm (nameOccName name)
217 in_import_items = maybeToBool maybe_import_item
218 Just import_item = maybe_import_item
219 filtered_avail = filterAvail import_item avail
221 check_import_item :: RdrNameIE -> RnMG ()
222 check_import_item item
223 = checkRn (maybeToBool maybe_matching_avail && sub_names_ok item avail)
224 (badImportItemErr mod item)
226 item_name = ieOcc item
227 maybe_matching_avail = lookupFM avail_fm item_name
228 Just avail = maybe_matching_avail
230 sub_names_ok (IEVar _) _ = True
231 sub_names_ok (IEThingAbs _) _ = True
232 sub_names_ok (IEThingAll _) _ = True
233 sub_names_ok (IEThingWith _ wanted) (Avail _ has) = all ((`elem` has_list) . rdrNameOcc) wanted
235 has_list = map nameOccName has
236 sub_names_ok other1 other2 = False
241 %************************************************************************
243 \subsection{Qualifiying imports}
245 %************************************************************************
247 @qualifyImports@ takes the @ExportEnv@ after filtering through the import spec
248 of an import decl, and deals with producing an @RnEnv@ with the
249 right qaulified names. It also turns the @Names@ in the @ExportEnv@ into
250 fully fledged @Names@.
253 qualifyImports :: Module -- Improrted module
254 -> Bool -- True <=> qualified import
255 -> Maybe Module -- Optional "as M" part
256 -> ExportEnv -- What's imported
257 -> RnMG (RnEnv, ModuleAvails)
259 qualifyImports this_mod qual as_mod (ExportEnv avails fixities)
260 = -- Make the qualified-name environments, checking of course for clashes
261 foldlRn add_name emptyNameEnv avails `thenRn` \ name_env ->
262 foldlRn (add_fixity name_env) emptyFixityEnv fixities `thenRn` \ fixity_env ->
264 -- Deal with the "qualified" part; if not qualifies then add unqualfied bindings
266 returnRn (RnEnv name_env fixity_env, mod_avail_env)
268 returnRn (RnEnv (unQualify name_env) (unQualify fixity_env), mod_avail_env)
271 mod_avail_env = unitFM this_mod avails
273 add_name name_env NotAvailable = returnRn name_env
274 add_name name_env (Avail n ns) = foldlRn add_one name_env (n : ns)
276 add_one :: NameEnv -> Name -> RnMG NameEnv
277 add_one env name = addOneToNameEnvRn env (Qual this_mod occ_name) name
279 occ_name = nameOccName name
281 add_fixity name_env fixity_env (occ_name, fixity, provenance)
282 | maybeToBool (lookupFM name_env qual_name) -- The name is imported
283 = addOneToFixityEnvRn fixity_env qual_name (fixity,provenance)
284 | otherwise -- It ain't imported
285 = returnRn fixity_env
287 qual_name = Qual this_mod occ_name
290 unQualify adds an Unqual binding for every existing Qual binding.
293 unQualify :: FiniteMap RdrName elt -> FiniteMap RdrName elt
294 unQualify fm = addListToFM fm [(Unqual occ, elt) | (Qual _ occ, elt) <- fmToList fm]
297 %************************************************************************
299 \subsection{Local declarations}
301 %************************************************************************
305 fixityFromFixDecl :: RdrNameFixityDecl -> RnMG (OccName, Fixity, Provenance)
307 fixityFromFixDecl (FixityDecl rdr_name fixity loc)
308 = returnRn (rdrNameOcc rdr_name, fixity, LocalDef (panic "export-flag") loc)
312 %************************************************************************
314 \subsection{Export list processing
316 %************************************************************************
318 The @AvailEnv@ type is just used internally in @exportsFromAvail@.
319 When exporting we need to combine the availabilities for a particular
320 exported thing, and we also need to check for name clashes -- that
321 is: two exported things must have different @OccNames@.
324 type AvailEnv = FiniteMap OccName (RdrNameIE, AvailInfo)
325 -- The FM maps each OccName to the RdrNameIE that gave rise to it,
326 -- for error reporting, as well as to its AvailInfo
328 emptyAvailEnv = emptyFM
330 unitAvailEnv :: RdrNameIE -> AvailInfo -> AvailEnv
331 unitAvailEnv ie NotAvailable
333 unitAvailEnv ie avail@(Avail n ns)
334 = unitFM (nameOccName n) (ie,avail)
337 = mapRn (addErrRn.availClashErr) (conflictsFM bad_avail a1 a2) `thenRn_`
338 returnRn (plusFM_C plus_avail a1 a2)
340 listToAvailEnv :: RdrNameIE -> [AvailInfo] -> RnM s d AvailEnv
341 listToAvailEnv ie items
342 = foldlRn plusAvailEnv emptyAvailEnv (map (unitAvailEnv ie) items)
344 bad_avail (ie1,Avail n1 _) (ie2,Avail n2 _) = n1 /= n2 -- Same OccName, different Name
345 plus_avail (ie1,a1) (ie2,a2) = (ie1, a1 `plusAvail` a2)
350 exportsFromAvail :: Module
351 -> Maybe [RdrNameIE] -- Export spec
354 -> RnMG (Name -> ExportFlag, ExportEnv)
355 -- Complains if two distinct exports have same OccName
356 -- Complains about exports items not in scope
357 exportsFromAvail this_mod Nothing all_avails rn_env
358 = exportsFromAvail this_mod (Just [IEModuleContents this_mod]) all_avails rn_env
360 exportsFromAvail this_mod (Just export_items) all_avails (RnEnv name_env fixity_env)
361 = mapRn exports_from_item export_items `thenRn` \ avail_envs ->
362 foldlRn plusAvailEnv emptyAvailEnv avail_envs `thenRn` \ export_avail_env ->
364 export_avails = map snd (eltsFM export_avail_env)
365 export_fixities = mk_exported_fixities (availsToNameSet export_avails)
366 export_fn = mk_export_fn export_avails
368 returnRn (export_fn, ExportEnv export_avails export_fixities)
371 full_avail_env :: UniqFM AvailInfo
372 full_avail_env = addListToUFM_C plusAvail emptyUFM
373 [(name,avail) | avail@(Avail name _) <- concat (eltsFM all_avails)]
374 -- NB: full_avail_env won't contain bindings for data constructors and class ops,
375 -- which is right and proper; attempts to export them on their own will provoke an error
377 exports_from_item :: RdrNameIE -> RnMG AvailEnv
378 exports_from_item ie@(IEModuleContents mod)
379 = case lookupFM all_avails mod of
380 Nothing -> failWithRn emptyAvailEnv (modExportErr mod)
381 Just avails -> addOccurrenceNames Compulsory [n | Avail n _ <- avails] `thenRn_`
382 listToAvailEnv ie avails
385 | not (maybeToBool maybe_in_scope)
386 = failWithRn emptyAvailEnv (unknownNameErr (ieName ie))
389 -- I can't see why this should ever happen; if the thing is in scope
390 -- at all it ought to have some availability
391 | not (maybeToBool maybe_avail)
392 = pprTrace "exportsFromAvail: curious Nothing:" (ppr PprDebug name)
393 returnRn emptyAvailEnv
397 = failWithRn emptyAvailEnv (exportItemErr ie export_avail)
399 | otherwise -- Phew! It's OK!
400 = addOccurrenceName Compulsory name `thenRn_`
401 returnRn (unitAvailEnv ie export_avail)
403 maybe_in_scope = lookupNameEnv name_env (ieName ie)
404 Just name = maybe_in_scope
405 maybe_avail = lookupUFM full_avail_env name
406 Just avail = maybe_avail
407 export_avail = filterAvail ie avail
408 enough_avail = case export_avail of {NotAvailable -> False; other -> True}
410 -- We export a fixity iff we export a thing with the same (qualified) RdrName
411 mk_exported_fixities :: NameSet -> [(OccName, Fixity, Provenance)]
412 mk_exported_fixities exports
413 = [ (rdrNameOcc rdr_name, fixity, prov)
414 | (rdr_name, (fixity, prov)) <- fmToList fixity_env,
415 export_fixity name_env exports rdr_name
418 mk_export_fn :: [AvailInfo] -> (Name -> ExportFlag)
420 = \name -> if name `elemNameSet` exported_names
424 exported_names :: NameSet
425 exported_names = availsToNameSet avails
427 export_fixity :: NameEnv -> NameSet -> RdrName -> Bool
428 export_fixity name_env exports (Unqual _)
429 = False -- The qualified fixity is always there as well
430 export_fixity name_env exports rdr_name@(Qual _ occ)
431 = case lookupFM name_env rdr_name of
432 Just fixity_name -> fixity_name `elemNameSet` exports
433 -- Check whether the exported thing is
434 -- the one to which the fixity attaches
435 other -> False -- Not even in scope
439 %************************************************************************
443 %************************************************************************
446 ieOcc ie = rdrNameOcc (ieName ie)
448 badImportItemErr mod ie sty
449 = ppSep [ppStr "Module", pprModule sty mod, ppStr "does not export", ppr sty ie]
452 = ppCat [ ppStr "Unknown module in export list: module", ppPStr mod]
454 exportItemErr export_item NotAvailable sty
455 = ppSep [ ppStr "Export item not in scope:", ppr sty export_item ]
457 exportItemErr export_item avail sty
458 = ppHang (ppStr "Export item not fully in scope:")
459 4 (ppAboves [ppCat [ppStr "Wanted: ", ppr sty export_item],
460 ppCat [ppStr "Available: ", ppr sty (ieOcc export_item), pprAvail sty avail]])
462 availClashErr (occ_name, ((ie1,avail1), (ie2,avail2))) sty
463 = ppHang (ppCat [ppStr "Conflicting exports for local name: ", ppr sty occ_name])
464 4 (ppAboves [ppr sty ie1, ppr sty ie2])