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, opt_NoImplicitPrelude )
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 -- NB: opt_NoImplicitPrelude is slightly different to import Prelude ();
95 -- because the former doesn't even look at Prelude.hi for instance declarations,
96 -- whereas the latter does.
97 prel_imports | this_mod == pRELUDE ||
98 explicit_prelude_import ||
102 | otherwise = [ImportDecl pRELUDE
103 False {- Not qualified -}
104 Nothing {- No "as" -}
105 Nothing {- No import list -}
108 explicit_prelude_import
109 = not (null [ () | (ImportDecl mod qual _ _ _) <- imports, mod == pRELUDE ])
114 = if not opt_SourceUnchanged then
115 -- Source code changed; look no further
118 -- Unchanged source; look further
120 -- (a) errors so far. These can arise if a module imports
121 -- something that's no longer exported by the imported module
122 -- (b) usage information up to date
123 checkErrsRn `thenRn` \ no_errs_so_far ->
124 checkUpToDate mod `thenRn` \ up_to_date ->
125 returnRn (no_errs_so_far && up_to_date)
130 importsFromImportDecl :: RdrNameImportDecl
131 -> RnMG (RnEnv, ModuleAvails)
133 importsFromImportDecl (ImportDecl mod qual_only 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 ]
144 True -- Want qualified names
145 (not qual_only) -- Maybe want unqualified names
147 (ExportEnv filtered_avails' fixities')
149 set_name_prov name = setNameProvenance name provenance
150 provenance = Imported mod loc
155 importsFromLocalDecls rec_exp_fn (HsModule mod _ _ _ fix_decls decls _)
156 = foldlRn getLocalDeclBinders [] decls `thenRn` \ avails ->
157 mapRn fixityFromFixDecl fix_decls `thenRn` \ fixities ->
159 False -- Don't want qualified names
160 True -- Want unqualified names
161 Nothing -- No "as M" part
162 (ExportEnv avails fixities)
164 newLocalName rdr_name loc
165 = newLocallyDefinedGlobalName mod (rdrNameOcc rdr_name) rec_exp_fn loc
167 getLocalDeclBinders avails (ValD binds)
168 = mapRn do_one (bagToList (collectTopBinders binds)) `thenRn` \ val_avails ->
169 returnRn (val_avails ++ avails)
171 getLocalDeclBinders avails decl
172 = getDeclBinders newLocalName decl `thenRn` \ avail ->
173 returnRn (avail : avails)
175 do_one (rdr_name, loc)
176 = newLocalName rdr_name loc `thenRn` \ name ->
177 returnRn (Avail name [])
180 %************************************************************************
182 \subsection{Filtering imports}
184 %************************************************************************
186 @filterImports@ takes the @ExportEnv@ telling what the imported module makes
187 available, and filters it through the import spec (if any).
190 filterImports :: Module
191 -> Maybe (Bool, [RdrNameIE]) -- Import spec; True => hidin
192 -> [AvailInfo] -- What's available
193 -> RnMG [AvailInfo] -- What's actually imported
194 -- Complains if import spec mentions things the
195 -- module doesn't export
197 filterImports mod Nothing imports
200 filterImports mod (Just (want_hiding, import_items)) avails
201 = -- Check that each import item mentions things that are actually available
202 mapRn check_import_item import_items `thenRn_`
204 -- Return filtered environment; no need to filter fixities
205 returnRn (map new_avail avails)
208 import_fm :: FiniteMap OccName RdrNameIE
209 import_fm = listToFM [(ieOcc ie, ie) | ie <- import_items]
211 avail_fm :: FiniteMap OccName AvailInfo
212 avail_fm = listToFM [(nameOccName name, avail) | avail@(Avail name ns) <- avails]
214 new_avail NotAvailable = NotAvailable
215 new_avail avail@(Avail name _)
216 | not in_import_items && want_hiding = avail
217 | not in_import_items && not want_hiding = NotAvailable
218 | in_import_items && want_hiding = NotAvailable
219 | in_import_items && not want_hiding = filtered_avail
221 maybe_import_item = lookupFM import_fm (nameOccName name)
222 in_import_items = maybeToBool maybe_import_item
223 Just import_item = maybe_import_item
224 filtered_avail = filterAvail import_item avail
226 check_import_item :: RdrNameIE -> RnMG ()
227 check_import_item item
228 = checkRn (maybeToBool maybe_matching_avail && sub_names_ok item avail)
229 (badImportItemErr mod item)
231 item_name = ieOcc item
232 maybe_matching_avail = lookupFM avail_fm item_name
233 Just avail = maybe_matching_avail
235 sub_names_ok (IEVar _) _ = True
236 sub_names_ok (IEThingAbs _) _ = True
237 sub_names_ok (IEThingAll _) _ = True
238 sub_names_ok (IEThingWith _ wanted) (Avail _ has) = all ((`elem` has_list) . rdrNameOcc) wanted
240 has_list = map nameOccName has
241 sub_names_ok other1 other2 = False
246 %************************************************************************
248 \subsection{Qualifiying imports}
250 %************************************************************************
252 @qualifyImports@ takes the @ExportEnv@ after filtering through the import spec
253 of an import decl, and deals with producing an @RnEnv@ with the
254 right qaulified names. It also turns the @Names@ in the @ExportEnv@ into
255 fully fledged @Names@.
258 qualifyImports :: Module -- Imported module
259 -> Bool -- True <=> want qualified import
260 -> Bool -- True <=> want unqualified import
261 -> Maybe Module -- Optional "as M" part
262 -> ExportEnv -- What's imported
263 -> RnMG (RnEnv, ModuleAvails)
265 qualifyImports this_mod qual_imp unqual_imp as_mod (ExportEnv avails fixities)
266 = -- Make the qualified-name environments, checking of course for clashes
267 foldlRn add_name emptyNameEnv avails `thenRn` \ name_env ->
268 foldlRn (add_fixity name_env) emptyFixityEnv fixities `thenRn` \ fixity_env ->
269 returnRn (RnEnv name_env fixity_env, mod_avail_env)
271 show_it (rdr, (fix,prov)) = ppSep [ppLbrack, ppr PprDebug rdr, ppr PprDebug fix, pprProvenance PprDebug prov, ppRbrack]
273 qual_mod = case as_mod of
275 Just another_name -> another_name
277 mod_avail_env = unitFM qual_mod avails
279 add_name name_env NotAvailable = returnRn name_env
280 add_name name_env (Avail n ns) = foldlRn add_one name_env (n : ns)
282 add_one :: NameEnv -> Name -> RnMG NameEnv
283 add_one env name = add_to_env addOneToNameEnvRn env occ_name name
285 occ_name = nameOccName name
287 add_to_env add_fn env occ thing | qual_imp && unqual_imp = both
288 | qual_imp = qual_only
289 | unqual_imp = unqual_only
291 unqual_only = add_fn env (Unqual occ) thing
292 qual_only = add_fn env (Qual qual_mod occ) thing
293 both = unqual_only `thenRn` \ env' ->
294 add_fn env' (Qual qual_mod occ) thing
296 add_fixity name_env fixity_env (occ_name, fixity, provenance)
297 | maybeToBool (lookupFM name_env rdr_name) -- It's imported
298 = add_to_env addOneToFixityEnvRn fixity_env occ_name (fixity,provenance)
299 | otherwise -- It ain't imported
300 = returnRn fixity_env
302 -- rdr_name is a name by which the thing is guaranteed to be known,
303 -- *if it is imported at all*
304 rdr_name | qual_imp = Qual qual_mod occ_name
305 | otherwise = Unqual occ_name
308 unQualify adds an Unqual binding for every existing Qual binding.
311 unQualify :: FiniteMap RdrName elt -> FiniteMap RdrName elt
312 unQualify fm = addListToFM fm [(Unqual occ, elt) | (Qual _ occ, elt) <- fmToList fm]
315 %************************************************************************
317 \subsection{Local declarations}
319 %************************************************************************
323 fixityFromFixDecl :: RdrNameFixityDecl -> RnMG (OccName, Fixity, Provenance)
325 fixityFromFixDecl (FixityDecl rdr_name fixity loc)
326 = returnRn (rdrNameOcc rdr_name, fixity, LocalDef (panic "export-flag") loc)
330 %************************************************************************
332 \subsection{Export list processing
334 %************************************************************************
336 The @AvailEnv@ type is just used internally in @exportsFromAvail@.
337 When exporting we need to combine the availabilities for a particular
338 exported thing, and we also need to check for name clashes -- that
339 is: two exported things must have different @OccNames@.
342 type AvailEnv = FiniteMap OccName (RdrNameIE, AvailInfo)
343 -- The FM maps each OccName to the RdrNameIE that gave rise to it,
344 -- for error reporting, as well as to its AvailInfo
346 emptyAvailEnv = emptyFM
348 unitAvailEnv :: RdrNameIE -> AvailInfo -> AvailEnv
349 unitAvailEnv ie NotAvailable
351 unitAvailEnv ie avail@(Avail n ns)
352 = unitFM (nameOccName n) (ie,avail)
355 = mapRn (addErrRn.availClashErr) (conflictsFM bad_avail a1 a2) `thenRn_`
356 returnRn (plusFM_C plus_avail a1 a2)
358 listToAvailEnv :: RdrNameIE -> [AvailInfo] -> RnM s d AvailEnv
359 listToAvailEnv ie items
360 = foldlRn plusAvailEnv emptyAvailEnv (map (unitAvailEnv ie) items)
362 bad_avail (ie1,Avail n1 _) (ie2,Avail n2 _) = n1 /= n2 -- Same OccName, different Name
363 plus_avail (ie1,a1) (ie2,a2) = (ie1, a1 `plusAvail` a2)
368 exportsFromAvail :: Module
369 -> Maybe [RdrNameIE] -- Export spec
372 -> RnMG (Name -> ExportFlag, ExportEnv)
373 -- Complains if two distinct exports have same OccName
374 -- Complains about exports items not in scope
375 exportsFromAvail this_mod Nothing all_avails rn_env
376 = exportsFromAvail this_mod (Just [IEModuleContents this_mod]) all_avails rn_env
378 exportsFromAvail this_mod (Just export_items) all_avails (RnEnv name_env fixity_env)
379 = mapRn exports_from_item export_items `thenRn` \ avail_envs ->
380 foldlRn plusAvailEnv emptyAvailEnv avail_envs `thenRn` \ export_avail_env ->
382 export_avails = map snd (eltsFM export_avail_env)
383 export_fixities = mk_exported_fixities (availsToNameSet export_avails)
384 export_fn = mk_export_fn export_avails
386 returnRn (export_fn, ExportEnv export_avails export_fixities)
389 full_avail_env :: UniqFM AvailInfo
390 full_avail_env = addListToUFM_C plusAvail emptyUFM
391 [(name,avail) | avail@(Avail name _) <- concat (eltsFM all_avails)]
392 -- NB: full_avail_env won't contain bindings for data constructors and class ops,
393 -- which is right and proper; attempts to export them on their own will provoke an error
395 exports_from_item :: RdrNameIE -> RnMG AvailEnv
396 exports_from_item ie@(IEModuleContents mod)
397 = case lookupFM all_avails mod of
398 Nothing -> failWithRn emptyAvailEnv (modExportErr mod)
399 Just avails -> addOccurrenceNames Compulsory [n | Avail n _ <- avails] `thenRn_`
400 listToAvailEnv ie avails
403 | not (maybeToBool maybe_in_scope)
404 = failWithRn emptyAvailEnv (unknownNameErr (ieName ie))
407 -- I can't see why this should ever happen; if the thing is in scope
408 -- at all it ought to have some availability
409 | not (maybeToBool maybe_avail)
410 = pprTrace "exportsFromAvail: curious Nothing:" (ppr PprDebug name)
411 returnRn emptyAvailEnv
415 = failWithRn emptyAvailEnv (exportItemErr ie export_avail)
417 | otherwise -- Phew! It's OK!
418 = addOccurrenceName Compulsory name `thenRn_`
419 returnRn (unitAvailEnv ie export_avail)
421 maybe_in_scope = lookupNameEnv name_env (ieName ie)
422 Just name = maybe_in_scope
423 maybe_avail = lookupUFM full_avail_env name
424 Just avail = maybe_avail
425 export_avail = filterAvail ie avail
426 enough_avail = case export_avail of {NotAvailable -> False; other -> True}
428 -- We export a fixity iff we export a thing with the same (qualified) RdrName
429 mk_exported_fixities :: NameSet -> [(OccName, Fixity, Provenance)]
430 mk_exported_fixities exports
431 = [ (rdrNameOcc rdr_name, fixity, prov)
432 | (rdr_name, (fixity, prov)) <- fmToList fixity_env,
433 export_fixity name_env exports rdr_name
436 mk_export_fn :: [AvailInfo] -> (Name -> ExportFlag)
438 = \name -> if name `elemNameSet` exported_names
442 exported_names :: NameSet
443 exported_names = availsToNameSet avails
445 export_fixity :: NameEnv -> NameSet -> RdrName -> Bool
446 export_fixity name_env exports rdr_name
447 = case lookupFM name_env rdr_name of
448 Just fixity_name -> fixity_name `elemNameSet` exports
449 -- Check whether the exported thing is
450 -- the one to which the fixity attaches
451 other -> False -- Not even in scope
455 %************************************************************************
459 %************************************************************************
462 ieOcc ie = rdrNameOcc (ieName ie)
464 badImportItemErr mod ie sty
465 = ppSep [ppStr "Module", pprModule sty mod, ppStr "does not export", ppr sty ie]
468 = ppCat [ ppStr "Unknown module in export list: module", ppPStr mod]
470 exportItemErr export_item NotAvailable sty
471 = ppSep [ ppStr "Export item not in scope:", ppr sty export_item ]
473 exportItemErr export_item avail sty
474 = ppHang (ppStr "Export item not fully in scope:")
475 4 (ppAboves [ppCat [ppStr "Wanted: ", ppr sty export_item],
476 ppCat [ppStr "Available: ", ppr sty (ieOcc export_item), pprAvail sty avail]])
478 availClashErr (occ_name, ((ie1,avail1), (ie2,avail2))) sty
479 = ppHang (ppCat [ppStr "Conflicting exports for local name: ", ppr sty occ_name])
480 4 (ppAboves [ppr sty ie1, ppr sty ie2])