2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
4 \section[RnNames]{Extracting imported and top-level names in scope}
11 #include "HsVersions.h"
13 import CmdLineOpts ( opt_NoImplicitPrelude, opt_WarnDuplicateExports,
17 import HsSyn ( HsModule(..), ImportDecl(..), HsDecl(..),
22 import RdrHsSyn ( RdrNameHsDecl(..), RdrName(..), RdrNameIE(..), RdrNameImportDecl,
23 RdrNameHsModule, RdrNameFixityDecl,
26 import RnHsSyn ( RenamedHsModule(..), RenamedFixityDecl(..) )
27 import RnIfaces ( getInterfaceExports, getDeclBinders, recordSlurp, checkUpToDate )
28 import BasicTypes ( IfaceFlavour(..) )
34 import UniqFM ( UniqFM, emptyUFM, addListToUFM_C, lookupUFM )
35 import Bag ( Bag, bagToList )
36 import Maybes ( maybeToBool, expectJust )
39 import Util ( removeDups )
44 %************************************************************************
46 \subsection{Get global names}
48 %************************************************************************
51 getGlobalNames :: RdrNameHsModule
52 -> RnMG (Maybe (ExportEnv, RnEnv, NameSet, Name -> PrintUnqualified))
53 -- The NameSet is the set of names that are
54 -- either locally defined,
55 -- or explicitly imported
56 -- Nothing => no need to recompile
58 getGlobalNames m@(HsModule this_mod _ exports imports _ _ mod_loc)
59 = fixRn (\ ~(rec_exp_fn, _) ->
61 -- PROCESS LOCAL DECLS
62 -- Do these *first* so that the correct provenance gets
63 -- into the global name cache.
64 importsFromLocalDecls rec_exp_fn m `thenRn` \ (local_rn_env, local_mod_avails, local_avails) ->
66 -- PROCESS IMPORT DECLS
67 mapAndUnzip3Rn importsFromImportDecl all_imports
68 `thenRn` \ (imp_rn_envs, imp_avails_s, explicit_imports_s) ->
71 -- We put the local env second, so that a local provenance
72 -- "wins", even if a module imports itself.
73 foldlRn plusRnEnv emptyRnEnv imp_rn_envs `thenRn` \ imp_rn_env ->
74 plusRnEnv imp_rn_env local_rn_env `thenRn` \ rn_env ->
77 -- We can't go for an early exit before this because we have to check
78 -- for name clashes. Consider:
80 -- module A where module B where
84 -- Suppose I've compiled everything up, and then I add a
85 -- new definition to module B, that defines "f".
87 -- Then I must detect the name clash in A before going for an early
88 -- exit. The early-exit code checks what's actually needed from B
89 -- to compile A, and of course that doesn't include B.f. That's
90 -- why we wait till after the plusRnEnv stuff to do the early-exit.
91 checkEarlyExit this_mod `thenRn` \ up_to_date ->
93 returnRn (error "early exit", Nothing)
97 -- PROCESS EXPORT LISTS
99 export_avails :: ExportAvails
100 export_avails = foldr plusExportAvails local_mod_avails imp_avails_s
102 explicit_names :: NameSet -- locally defined or explicitly imported
103 explicit_names = foldr add_on emptyNameSet (local_avails : explicit_imports_s)
104 add_on avails names = foldr (unionNameSets . mkNameSet . availNames) names avails
106 exportsFromAvail this_mod exports export_avails rn_env
107 `thenRn` \ (export_fn, export_env) ->
109 -- RECORD THAT LOCALLY DEFINED THINGS ARE AVAILABLE
110 mapRn (recordSlurp Nothing Compulsory) local_avails `thenRn_`
112 -- BUILD THE "IMPORT FN". It just tells whether a name is in
113 -- scope in an unqualified form.
115 print_unqual = mkImportFn imp_rn_env
118 returnRn (export_fn, Just (export_env, rn_env, explicit_names, print_unqual))
119 ) `thenRn` \ (_, result) ->
122 junk_exp_fn = error "RnNames:export_fn"
124 all_imports = prel_imports ++ imports
126 -- NB: opt_NoImplicitPrelude is slightly different to import Prelude ();
127 -- because the former doesn't even look at Prelude.hi for instance declarations,
128 -- whereas the latter does.
129 prel_imports | this_mod == pRELUDE ||
130 explicit_prelude_import ||
131 opt_NoImplicitPrelude
134 | otherwise = [ImportDecl pRELUDE
135 False {- Not qualified -}
136 HiFile {- Not source imported -}
137 Nothing {- No "as" -}
138 Nothing {- No import list -}
141 explicit_prelude_import
142 = not (null [ () | (ImportDecl mod qual _ _ _ _) <- imports, mod == pRELUDE ])
147 = checkErrsRn `thenRn` \ no_errs_so_far ->
148 if not no_errs_so_far then
149 -- Found errors already, so exit now
153 traceRn (text "Considering whether compilation is required...") `thenRn_`
154 if not opt_SourceUnchanged then
155 -- Source code changed and no errors yet... carry on
156 traceRn (nest 4 (text "source file changed or recompilation check turned off")) `thenRn_`
160 -- Unchanged source, and no errors yet; see if usage info
161 -- up to date, and exit if so
162 checkUpToDate mod `thenRn` \ up_to_date ->
163 putDocRn (text "Compilation" <+>
164 text (if up_to_date then "IS NOT" else "IS") <+>
165 text "required") `thenRn_`
170 importsFromImportDecl :: RdrNameImportDecl
171 -> RnMG (RnEnv, ExportAvails, [AvailInfo])
173 importsFromImportDecl (ImportDecl mod qual_only as_source as_mod import_spec loc)
175 getInterfaceExports mod as_source `thenRn` \ (avails, fixities) ->
176 filterImports mod import_spec avails `thenRn` \ (filtered_avails, hides, explicits) ->
178 how_in_scope = FromImportDecl mod loc
181 True -- Want qualified names
182 (not qual_only) -- Maybe want unqualified names
185 filtered_avails (\n -> how_in_scope)
186 [ (occ,(fixity,how_in_scope)) | (occ,fixity) <- fixities ]
187 `thenRn` \ (rn_env, mod_avails) ->
188 returnRn (rn_env, mod_avails, explicits)
193 importsFromLocalDecls rec_exp_fn (HsModule mod _ _ _ fix_decls decls _)
194 = foldlRn getLocalDeclBinders [] decls `thenRn` \ avails ->
195 mapRn fixityFromFixDecl fix_decls `thenRn` \ fixities ->
197 False -- Don't want qualified names
198 True -- Want unqualified names
199 Nothing -- No "as M" part
201 avails (\n -> FromLocalDefn (getSrcLoc n))
203 `thenRn` \ (rn_env, mod_avails) ->
204 returnRn (rn_env, mod_avails, avails)
206 newLocalName rdr_name loc
207 = newLocallyDefinedGlobalName mod (rdrNameOcc rdr_name) rec_exp_fn loc
209 getLocalDeclBinders avails (ValD binds)
210 = mapRn do_one (bagToList (collectTopBinders binds)) `thenRn` \ val_avails ->
211 returnRn (val_avails ++ avails)
213 getLocalDeclBinders avails decl
214 = getDeclBinders newLocalName decl `thenRn` \ avail ->
216 NotAvailable -> returnRn avails -- Instance decls and suchlike
217 other -> returnRn (avail : avails)
219 do_one (rdr_name, loc)
220 = newLocalName rdr_name loc `thenRn` \ name ->
221 returnRn (Avail name)
224 %************************************************************************
226 \subsection{Filtering imports}
228 %************************************************************************
230 @filterImports@ takes the @ExportEnv@ telling what the imported module makes
231 available, and filters it through the import spec (if any).
234 filterImports :: Module
235 -> Maybe (Bool, [RdrNameIE]) -- Import spec; True => hidin
236 -> [AvailInfo] -- What's available
237 -> RnMG ([AvailInfo], -- What's actually imported
238 [AvailInfo], -- What's to be hidden (the unqualified version, that is)
239 [AvailInfo]) -- What was imported explicitly
241 -- Complains if import spec mentions things that the module doesn't export
242 -- Warns/informs if import spec contains duplicates.
243 filterImports mod Nothing imports
244 = returnRn (imports, [], [])
246 filterImports mod (Just (want_hiding, import_items)) avails
247 = mapRn check_item import_items `thenRn` \ item_avails ->
250 returnRn (avails, item_avails, []) -- All imported; item_avails to be hidden
252 returnRn (item_avails, [], item_avails) -- Just item_avails imported; nothing to be hidden
255 import_fm :: FiniteMap OccName AvailInfo
256 import_fm = listToFM [ (nameOccName name, avail)
258 name <- availEntityNames avail]
260 check_item item@(IEModuleContents _)
261 = addErrRn (badImportItemErr mod item) `thenRn_`
262 returnRn NotAvailable
265 | not (maybeToBool maybe_in_import_avails) ||
266 (case filtered_avail of { NotAvailable -> True; other -> False })
267 = addErrRn (badImportItemErr mod item) `thenRn_`
268 returnRn NotAvailable
270 | otherwise = returnRn filtered_avail
273 maybe_in_import_avails = lookupFM import_fm (ieOcc item)
274 Just avail = maybe_in_import_avails
275 filtered_avail = filterAvail item avail
280 %************************************************************************
282 \subsection{Qualifiying imports}
284 %************************************************************************
286 @qualifyImports@ takes the @ExportEnv@ after filtering through the import spec
287 of an import decl, and deals with producing an @RnEnv@ with the
288 right qualified names. It also turns the @Names@ in the @ExportEnv@ into
289 fully fledged @Names@.
292 qualifyImports :: Module -- Imported module
293 -> Bool -- True <=> want qualified import
294 -> Bool -- True <=> want unqualified import
295 -> Maybe Module -- Optional "as M" part
296 -> [AvailInfo] -- What's to be hidden
297 -> Avails -> (Name -> HowInScope) -- Whats imported and how
298 -> [(OccName, (Fixity, HowInScope))] -- Ditto for fixities
299 -> RnMG (RnEnv, ExportAvails)
301 qualifyImports this_mod qual_imp unqual_imp as_mod hides
302 avails name_to_his fixities
304 -- Make the name environment. Even though we're talking about a
305 -- single import module there might still be name clashes,
306 -- because it might be the module being compiled.
307 foldlRn add_avail emptyGlobalNameEnv avails `thenRn` \ name_env1 ->
309 -- Delete things that are hidden
310 name_env2 = foldl del_avail name_env1 hides
312 -- Create the fixity env
313 fixity_env = foldl (add_fixity name_env2) emptyFixityEnv fixities
315 -- Create the export-availability info
316 export_avails = mkExportAvails unqual_imp qual_mod avails
318 returnRn (RnEnv name_env2 fixity_env, export_avails)
320 qual_mod = case as_mod of
322 Just another_name -> another_name
324 add_avail :: GlobalNameEnv -> AvailInfo -> RnMG GlobalNameEnv
325 add_avail env avail = foldlRn add_name env (availNames avail)
327 add_name env name = add qual_imp env (Qual qual_mod occ err_hif) `thenRn` \ env1 ->
328 add unqual_imp env1 (Unqual occ)
330 add False env rdr_name = returnRn env
331 add True env rdr_name = addOneToGlobalNameEnv env rdr_name (name, name_to_his name)
332 occ = nameOccName name
334 del_avail env avail = foldl delOneFromGlobalNameEnv env rdr_names
336 rdr_names = map (Unqual . nameOccName) (availNames avail)
338 add_fixity name_env fix_env (occ_name, fixity)
339 = add qual $ add unqual $ fix_env
341 qual = Qual qual_mod occ_name err_hif
342 unqual = Unqual occ_name
344 add rdr_name fix_env | maybeToBool (lookupFM name_env rdr_name)
345 = addOneToFixityEnv fix_env rdr_name fixity
349 err_hif = error "qualifyImports: hif" -- Not needed in key to mapping
352 unQualify adds an Unqual binding for every existing Qual binding.
355 unQualify :: FiniteMap RdrName elt -> FiniteMap RdrName elt
356 unQualify fm = addListToFM fm [(Unqual occ, elt) | (Qual _ occ _, elt) <- fmToList fm]
359 %************************************************************************
361 \subsection{Local declarations}
363 %************************************************************************
367 fixityFromFixDecl :: RdrNameFixityDecl -> RnMG (OccName, (Fixity, HowInScope))
369 fixityFromFixDecl (FixityDecl rdr_name fixity loc)
370 = returnRn (rdrNameOcc rdr_name, (fixity, FromLocalDefn loc))
374 %************************************************************************
376 \subsection{Export list processing
378 %************************************************************************
380 The @AvailEnv@ type is just used internally in @exportsFromAvail@.
381 When exporting we need to combine the availabilities for a particular
382 exported thing, and we also need to check for name clashes -- that
383 is: two exported things must have different @OccNames@.
386 type AvailEnv = FiniteMap OccName (RdrNameIE, AvailInfo, Int{-no. of clashes-})
387 -- The FM maps each OccName to the RdrNameIE that gave rise to it,
388 -- for error reporting, as well as to its AvailInfo
390 emptyAvailEnv = emptyFM
393 Add new entry to environment. Checks for name clashes, i.e.,
394 plain duplicates or exported entity pairs that have different OccNames.
395 (c.f. 5.1.1 of Haskell 1.4 report.)
397 addAvailEnv :: Bool -> RdrNameIE -> AvailEnv -> AvailInfo -> RnM s d AvailEnv
398 addAvailEnv warn_dups ie env NotAvailable = returnRn env
399 addAvailEnv warn_dups ie env (AvailTC _ []) = returnRn env
400 addAvailEnv warn_dups ie env avail
401 | warn_dups = mapMaybeRn (addErrRn . availClashErr) () conflict `thenRn_`
402 returnRn (addToFM_C addAvail env key elt)
403 | otherwise = returnRn (addToFM_C addAvail env key elt)
405 key = nameOccName (availName avail)
406 elt = (ie,avail,reports_on)
409 | maybeToBool dup = 1
412 conflict = conflictFM bad_avail env key elt
414 | warn_dups = conflictFM dup_avail env key elt
415 | otherwise = Nothing
417 addListToAvailEnv :: AvailEnv -> RdrNameIE -> [AvailInfo] -> RnM s d AvailEnv
418 addListToAvailEnv env ie items = foldlRn (addAvailEnv False ie) env items
420 bad_avail (ie1,avail1,r1) (ie2,avail2,r2)
421 = availName avail1 /= availName avail2 -- Same OccName, different Name
422 dup_avail (ie1,avail1,r1) (ie2,avail2,r2)
423 = availName avail1 == availName avail2 -- Same OccName & avail.
425 addAvail (ie1,a1,r1) (ie2,a2,r2) = (ie1, a1 `plusAvail` a2, r1 + r2)
428 Processing the export list.
430 You might think that we should record things that appear in the export list as
431 ``occurrences'' (using addOccurrenceName), but you'd be wrong. We do check (here)
432 that they are in scope, but there is no need to slurp in their actual declaration
433 (which is what addOccurrenceName forces). Indeed, doing so would big trouble when
434 compiling PrelBase, because it re-exports GHC, which includes takeMVar#, whose type
435 includes ConcBase.StateAndSynchVar#, and so on...
438 exportsFromAvail :: Module
439 -> Maybe [RdrNameIE] -- Export spec
442 -> RnMG (Name -> ExportFlag, ExportEnv)
443 -- Complains if two distinct exports have same OccName
444 -- Warns about identical exports.
445 -- Complains about exports items not in scope
446 exportsFromAvail this_mod Nothing export_avails rn_env
447 = exportsFromAvail this_mod (Just [IEModuleContents this_mod]) export_avails rn_env
449 exportsFromAvail this_mod (Just export_items)
450 (mod_avail_env, entity_avail_env)
451 (RnEnv global_name_env fixity_env)
452 = checkForModuleExportDups export_items `thenRn` \ export_items' ->
453 foldlRn exports_from_item emptyAvailEnv export_items' `thenRn` \ export_avail_env ->
455 dup_entries = fmToList (filterFM (\ _ (_,_,clashes) -> clashes > 0) export_avail_env)
457 mapRn (addWarnRn . dupExportWarn) dup_entries `thenRn_`
459 export_avails = map (\ (_,a,_) -> a) (eltsFM export_avail_env)
460 export_fixities = mk_exported_fixities (availsToNameSet export_avails)
461 export_fn = mk_export_fn export_avails
463 returnRn (export_fn, ExportEnv export_avails export_fixities)
466 exports_from_item :: AvailEnv -> RdrNameIE -> RnMG AvailEnv
467 exports_from_item export_avail_env ie@(IEModuleContents mod)
468 = case lookupFM mod_avail_env mod of
469 Nothing -> failWithRn export_avail_env (modExportErr mod)
470 Just avails -> addListToAvailEnv export_avail_env ie avails
472 exports_from_item export_avail_env ie
473 | not (maybeToBool maybe_in_scope)
474 = failWithRn export_avail_env (unknownNameErr (ieName ie))
477 -- I can't see why this should ever happen; if the thing is in scope
478 -- at all it ought to have some availability
479 | not (maybeToBool maybe_avail)
480 = pprTrace "exportsFromAvail: curious Nothing:" (ppr name)
481 returnRn export_avail_env
485 = failWithRn export_avail_env (exportItemErr ie export_avail)
487 | otherwise -- Phew! It's OK!
488 = addAvailEnv opt_WarnDuplicateExports ie export_avail_env export_avail
490 maybe_in_scope = lookupFM global_name_env (ieName ie)
491 Just (name,_) = maybe_in_scope
492 maybe_avail = lookupUFM entity_avail_env name
493 Just avail = maybe_avail
494 export_avail = filterAvail ie avail
495 enough_avail = case export_avail of {NotAvailable -> False; other -> True}
497 -- We export a fixity iff we export a thing with the same (qualified) RdrName
498 mk_exported_fixities :: NameSet -> [(OccName, Fixity)]
499 mk_exported_fixities exports
500 = fmToList (foldr (perhaps_add_fixity exports)
502 (fmToList fixity_env))
504 perhaps_add_fixity :: NameSet -> (RdrName, (Fixity, HowInScope))
505 -> FiniteMap OccName Fixity
506 -> FiniteMap OccName Fixity
507 perhaps_add_fixity exports (rdr_name, (fixity, how_in_scope)) fix_env
509 do_nothing = fix_env -- The default is to pass on the env unchanged
511 -- Step 1: check whether the rdr_name is in scope; if so find its Name
512 case lookupFM global_name_env rdr_name of {
513 Nothing -> do_nothing;
514 Just (fixity_name,_) ->
516 -- Step 2: check whether the fixity thing is exported
517 if not (fixity_name `elemNameSet` exports) then
521 -- Step 3: check whether we already have a fixity for the
522 -- Name's OccName in the fix_env we are building up. This can easily
523 -- happen. the original fixity_env might contain bindings for
524 -- M.a and N.a, if a was imported via M and N.
525 -- If this does happen, we expect the fixity to be the same either way.
527 occ_name = rdrNameOcc rdr_name
529 case lookupFM fix_env occ_name of {
530 Just fixity1 -> -- Got it already
531 ASSERT( fixity == fixity1 )
535 -- Step 3: add it to the outgoing fix_env
536 addToFM fix_env occ_name fixity
539 {- warn and weed out duplicate module entries from export list. -}
540 checkForModuleExportDups :: [RdrNameIE] -> RnMG [RdrNameIE]
541 checkForModuleExportDups ls
542 | opt_WarnDuplicateExports = check_modules ls
543 | otherwise = returnRn ls
545 -- NOTE: reorders the export list by moving all module-contents
546 -- exports to the end (removing duplicates in the process.)
550 ls -> mapRn (\ ds@(IEModuleContents x:_) ->
551 addWarnRn (dupModuleExport x (length ds))) ls `thenRn_`
552 returnRn ()) `thenRn_`
553 returnRn (ls_no_modules ++ no_module_dups)
555 (ls_no_modules,modules) = foldr split_mods ([],[]) ls
557 split_mods i@(IEModuleContents _) ~(no_ms,ms) = (no_ms,i:ms)
558 split_mods i ~(no_ms,ms) = (i:no_ms,ms)
560 (no_module_dups, dups) = removeDups cmp_mods modules
562 cmp_mods (IEModuleContents m1) (IEModuleContents m2) = m1 `compare` m2
564 mk_export_fn :: [AvailInfo] -> (Name -> ExportFlag)
566 = \name -> if name `elemNameSet` exported_names
570 exported_names :: NameSet
571 exported_names = availsToNameSet avails
574 %************************************************************************
578 %************************************************************************
581 badImportItemErr mod ie
582 = sep [ptext SLIT("Module"), quotes (pprModule mod),
583 ptext SLIT("does not export"), quotes (ppr ie)]
586 = hsep [ ptext SLIT("Unknown module in export list: module"), quotes (pprModule mod)]
588 exportItemErr export_item NotAvailable
589 = sep [ ptext SLIT("Export item not in scope:"), quotes (ppr export_item)]
591 exportItemErr export_item avail
592 = hang (ptext SLIT("Export item not fully in scope:"))
593 4 (vcat [hsep [ptext SLIT("Wanted: "), ppr export_item],
594 hsep [ptext SLIT("Available:"), ppr (ieOcc export_item), pprAvail avail]])
596 availClashErr (occ_name, ((ie1,avail1,_), (ie2,avail2,_)))
597 = hsep [ptext SLIT("The export items"), quotes (ppr ie1), ptext SLIT("and"), quotes (ppr ie2),
598 ptext SLIT("create conflicting exports for"), quotes (ppr occ_name)]
600 dupExportWarn (occ_name, (_,_,times))
601 = hsep [quotes (ppr occ_name),
602 ptext SLIT("mentioned"), speakNTimes (times+1),
603 ptext SLIT("in export list")]
605 dupModuleExport mod times
606 = hsep [ptext SLIT("Module"), quotes (pprModule mod),
607 ptext SLIT("mentioned"), speakNTimes times,
608 ptext SLIT("in export list")]