[project @ 2000-07-11 16:24:57 by simonmar]
[ghc-hetmet.git] / ghc / compiler / rename / RnNames.lhs
1 %
2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
3 %
4 \section[RnNames]{Extracting imported and top-level names in scope}
5
6 \begin{code}
7 module RnNames (
8         getGlobalNames
9     ) where
10
11 #include "HsVersions.h"
12
13 import CmdLineOpts    ( opt_NoImplicitPrelude, opt_WarnDuplicateExports, 
14                         opt_SourceUnchanged, opt_WarnUnusedBinds
15                       )
16
17 import HsSyn    ( HsModule(..), HsDecl(..), TyClDecl(..),
18                   IE(..), ieName, 
19                   ForeignDecl(..), ForKind(..), isDynamicExtName,
20                   FixitySig(..), Sig(..), ImportDecl(..),
21                   collectTopBinders
22                 )
23 import RdrHsSyn ( RdrNameIE, RdrNameImportDecl,
24                   RdrNameHsModule, RdrNameHsDecl
25                 )
26 import RnIfaces ( getInterfaceExports, getDeclBinders, getDeclSysBinders,
27                   recordLocalSlurps, checkModUsage, findAndReadIface, outOfDate
28                 )
29 import RnEnv
30 import RnMonad
31
32 import FiniteMap
33 import PrelInfo ( pRELUDE_Name, mAIN_Name, main_RDR )
34 import UniqFM   ( lookupUFM )
35 import Bag      ( bagToList )
36 import Module   ( ModuleName, mkThisModule, pprModuleName, WhereFrom(..) )
37 import NameSet
38 import Name     ( Name, ExportFlag(..), ImportReason(..), Provenance(..),
39                   isLocallyDefined, setNameProvenance,
40                   nameOccName, getSrcLoc, pprProvenance, getNameProvenance
41                 )
42 import RdrName  ( RdrName, rdrNameOcc, setRdrNameOcc, mkRdrQual, mkRdrUnqual, isQual, isUnqual )
43 import OccName  ( setOccNameSpace, dataName )
44 import SrcLoc   ( SrcLoc )
45 import NameSet  ( elemNameSet, emptyNameSet )
46 import Outputable
47 import Maybes   ( maybeToBool, catMaybes, mapMaybe )
48 import UniqFM   ( emptyUFM, listToUFM, plusUFM_C )
49 import Util     ( removeDups, equivClassesByUniq, sortLt )
50 import List     ( partition )
51 \end{code}
52
53
54
55 %************************************************************************
56 %*                                                                      *
57 \subsection{Get global names}
58 %*                                                                      *
59 %************************************************************************
60
61 \begin{code}
62 getGlobalNames :: RdrNameHsModule
63                -> RnMG (Maybe (GlobalRdrEnv,    -- Maps all in-scope things
64                                GlobalRdrEnv,    -- Maps just *local* things
65                                Avails,          -- The exported stuff
66                                AvailEnv,        -- Maps a name to its parent AvailInfo
67                                                 -- Just for in-scope things only
68                                Maybe ParsedIface        -- The old interface file, if any
69                                ))
70                         -- Nothing => no need to recompile
71
72 getGlobalNames (HsModule this_mod _ exports imports decls _ mod_loc)
73   =     -- These two fix-loops are to get the right
74         -- provenance information into a Name
75     fixRn ( \ ~(Just (rec_gbl_env, _, rec_export_avails, _, _)) ->
76
77         let
78            rec_unqual_fn :: Name -> Bool        -- Is this chap in scope unqualified?
79            rec_unqual_fn = unQualInScope rec_gbl_env
80
81            rec_exp_fn :: Name -> ExportFlag
82            rec_exp_fn = mk_export_fn (availsToNameSet rec_export_avails)
83         in
84         setModuleRn this_mod                    $
85
86                 -- PROCESS LOCAL DECLS
87                 -- Do these *first* so that the correct provenance gets
88                 -- into the global name cache.
89         importsFromLocalDecls this_mod rec_exp_fn decls
90         `thenRn` \ (local_gbl_env, local_mod_avails) ->
91
92                 -- PROCESS IMPORT DECLS
93                 -- Do the non {- SOURCE -} ones first, so that we get a helpful
94                 -- warning for {- SOURCE -} ones that are unnecessary
95         let
96           (source, ordinary) = partition is_source_import all_imports
97           is_source_import (ImportDecl _ ImportByUserSource _ _ _ _) = True
98           is_source_import other                                     = False
99         in
100         mapAndUnzipRn (importsFromImportDecl rec_unqual_fn) ordinary
101         `thenRn` \ (imp_gbl_envs1, imp_avails_s1) ->
102         mapAndUnzipRn (importsFromImportDecl rec_unqual_fn) source
103         `thenRn` \ (imp_gbl_envs2, imp_avails_s2) ->
104
105                 -- COMBINE RESULTS
106                 -- We put the local env second, so that a local provenance
107                 -- "wins", even if a module imports itself.
108         let
109             gbl_env :: GlobalRdrEnv
110             imp_gbl_env = foldr plusGlobalRdrEnv emptyRdrEnv (imp_gbl_envs2 ++ imp_gbl_envs1)
111             gbl_env     = imp_gbl_env `plusGlobalRdrEnv` local_gbl_env
112
113             all_avails :: ExportAvails
114             all_avails = foldr plusExportAvails local_mod_avails (imp_avails_s2 ++ imp_avails_s1)
115             (_, global_avail_env) = all_avails
116         in
117
118                 -- TRY FOR EARLY EXIT
119                 -- We can't go for an early exit before this because we have to check
120                 -- for name clashes.  Consider:
121                 --
122                 --      module A where          module B where
123                 --         import B                h = True
124                 --         f = h
125                 --
126                 -- Suppose I've compiled everything up, and then I add a
127                 -- new definition to module B, that defines "f".
128                 --
129                 -- Then I must detect the name clash in A before going for an early
130                 -- exit.  The early-exit code checks what's actually needed from B
131                 -- to compile A, and of course that doesn't include B.f.  That's
132                 -- why we wait till after the plusEnv stuff to do the early-exit.
133                 
134         -- Check For eacly exit
135         checkErrsRn                             `thenRn` \ no_errs_so_far ->
136         if not no_errs_so_far then
137                 -- Found errors already, so exit now
138                 returnRn Nothing
139         else
140         checkEarlyExit this_mod                 `thenRn` \ (up_to_date, old_iface) ->
141         if up_to_date then
142                 -- Interface files are sufficiently unchanged
143                 putDocRn (text "Compilation IS NOT required")   `thenRn_`
144                 returnRn Nothing
145         else
146         
147                 -- RECORD BETTER PROVENANCES IN THE CACHE
148                 -- The names in the envirnoment have better provenances (e.g. imported on line x)
149                 -- than the names in the name cache.  We update the latter now, so that we
150                 -- we start renaming declarations we'll get the good names
151                 -- The isQual is because the qualified name is always in scope
152         updateProvenances (concat [names | (rdr_name, names) <- rdrEnvToList gbl_env, 
153                                            isQual rdr_name])    `thenRn_`
154         
155                 -- PROCESS EXPORT LISTS
156         exportsFromAvail this_mod exports all_avails gbl_env    `thenRn` \ export_avails ->
157         
158         
159                 -- ALL DONE
160         returnRn (Just (gbl_env, local_gbl_env, export_avails, global_avail_env, old_iface))
161    )
162   where
163     all_imports = prel_imports ++ imports
164
165         -- NB: opt_NoImplicitPrelude is slightly different to import Prelude ();
166         -- because the former doesn't even look at Prelude.hi for instance declarations,
167         -- whereas the latter does.
168     prel_imports | this_mod == pRELUDE_Name ||
169                    explicit_prelude_import ||
170                    opt_NoImplicitPrelude
171                  = []
172
173                  | otherwise = [ImportDecl pRELUDE_Name
174                                            ImportByUser
175                                            False        {- Not qualified -}
176                                            Nothing      {- No "as" -}
177                                            Nothing      {- No import list -}
178                                            mod_loc]
179     
180     explicit_prelude_import
181       = not (null [ () | (ImportDecl mod _ _ _ _ _) <- imports, mod == pRELUDE_Name ])
182 \end{code}
183         
184 \begin{code}
185 checkEarlyExit mod_name
186   = traceRn (text "Considering whether compilation is required...")     `thenRn_`
187
188         -- Read the old interface file, if any, for the module being compiled
189     findAndReadIface doc_str mod_name False {- Not hi-boot -}   `thenRn` \ maybe_iface ->
190
191         -- CHECK WHETHER WE HAVE IT ALREADY
192     case maybe_iface of
193         Left err ->     -- Old interface file not found, so we'd better bail out
194                     traceRn (vcat [ptext SLIT("No old interface file for") <+> pprModuleName mod_name,
195                                    err])                        `thenRn_`
196                     returnRn (outOfDate, Nothing)
197
198         Right iface
199           | not opt_SourceUnchanged
200           ->    -- Source code changed
201              traceRn (nest 4 (text "source file changed or recompilation check turned off"))    `thenRn_` 
202              returnRn (False, Just iface)
203
204           | otherwise
205           ->    -- Source code unchanged and no errors yet... carry on 
206              checkModUsage (pi_usages iface)    `thenRn` \ up_to_date ->
207              returnRn (up_to_date, Just iface)
208   where
209         -- Only look in current directory, with suffix .hi
210     doc_str = sep [ptext SLIT("need usage info from"), pprModuleName mod_name]
211 \end{code}
212         
213 \begin{code}
214 importsFromImportDecl :: (Name -> Bool)         -- OK to omit qualifier
215                       -> RdrNameImportDecl
216                       -> RnMG (GlobalRdrEnv, 
217                                ExportAvails) 
218
219 importsFromImportDecl is_unqual (ImportDecl imp_mod_name from qual_only as_mod import_spec iloc)
220   = pushSrcLocRn iloc $
221     getInterfaceExports imp_mod_name from       `thenRn` \ (imp_mod, avails) ->
222
223     if null avails then
224         -- If there's an error in getInterfaceExports, (e.g. interface
225         -- file not found) we get lots of spurious errors from 'filterImports'
226         returnRn (emptyRdrEnv, mkEmptyExportAvails imp_mod_name)
227     else
228
229     filterImports imp_mod_name import_spec avails   `thenRn` \ (filtered_avails, hides, explicits) ->
230
231     qualifyImports imp_mod_name
232                    (not qual_only)      -- Maybe want unqualified names
233                    as_mod hides
234                    (improveAvails imp_mod iloc explicits 
235                                   is_unqual filtered_avails)
236
237
238 improveAvails imp_mod iloc explicits is_unqual avails
239         -- We 'improve' the provenance by setting
240         --      (a) the import-reason field, so that the Name says how it came into scope
241         --              including whether it's explicitly imported
242         --      (b) the print-unqualified field
243   = map improve_avail avails
244   where
245     improve_avail (Avail n)      = Avail (improve n)
246     improve_avail (AvailTC n ns) = AvailTC (improve n) (map improve ns)
247
248     improve name = setNameProvenance name 
249                         (NonLocalDef (UserImport imp_mod iloc (is_explicit name)) 
250                                      (is_unqual name))
251     is_explicit name  = name `elemNameSet` explicits
252 \end{code}
253
254
255 \begin{code}
256 importsFromLocalDecls mod_name rec_exp_fn decls
257   = mapRn (getLocalDeclBinders newLocalName) decls      `thenRn` \ avails_s ->
258
259     let
260         avails = concat avails_s
261
262         all_names :: [Name]     -- All the defns; no dups eliminated
263         all_names = [name | avail <- avails, name <- availNames avail]
264
265         dups :: [[Name]]
266         (_, dups) = removeDups compare all_names
267     in
268         -- Check for duplicate definitions
269     mapRn_ (addErrRn . dupDeclErr) dups         `thenRn_` 
270
271         -- Record that locally-defined things are available
272     recordLocalSlurps avails                    `thenRn_`
273
274         -- Build the environment
275     qualifyImports mod_name 
276                    True         -- Want unqualified names
277                    Nothing      -- no 'as M'
278                    []           -- Hide nothing
279                    avails
280
281   where
282     mod = mkThisModule mod_name
283
284     newLocalName rdr_name loc 
285         = check_unqual rdr_name loc                     `thenRn_`
286           newTopBinder mod (rdrNameOcc rdr_name)        `thenRn` \ name ->
287           returnRn (setNameProvenance name (LocalDef loc (rec_exp_fn name)))
288
289         -- There should never be a qualified name in a binding position (except in instance decls)
290         -- The parser doesn't check this because the same parser parses instance decls
291     check_unqual rdr_name loc
292         | isUnqual rdr_name = returnRn ()
293         | otherwise         = qualNameErr (text "the binding for" <+> quotes (ppr rdr_name)) 
294                                           (rdr_name,loc)
295
296 getLocalDeclBinders :: (RdrName -> SrcLoc -> RnMG Name) -- New-name function
297                     -> RdrNameHsDecl
298                     -> RnMG Avails
299 getLocalDeclBinders new_name (ValD binds)
300   = mapRn do_one (bagToList (collectTopBinders binds))
301   where
302     do_one (rdr_name, loc) = new_name rdr_name loc      `thenRn` \ name ->
303                              returnRn (Avail name)
304
305 getLocalDeclBinders new_name decl
306   = getDeclBinders new_name decl        `thenRn` \ maybe_avail ->
307     case maybe_avail of
308         Nothing    -> returnRn []               -- Instance decls and suchlike
309         Just avail -> getDeclSysBinders new_sys_name decl               `thenRn_`  
310                       returnRn [avail]
311   where
312         -- The getDeclSysBinders is just to get the names of superclass selectors
313         -- etc, into the cache
314     new_sys_name rdr_name loc = newImplicitBinder (rdrNameOcc rdr_name) loc
315 \end{code}
316
317 %************************************************************************
318 %*                                                                      *
319 \subsection{Filtering imports}
320 %*                                                                      *
321 %************************************************************************
322
323 @filterImports@ takes the @ExportEnv@ telling what the imported module makes
324 available, and filters it through the import spec (if any).
325
326 \begin{code}
327 filterImports :: ModuleName                     -- The module being imported
328               -> Maybe (Bool, [RdrNameIE])      -- Import spec; True => hiding
329               -> [AvailInfo]                    -- What's available
330               -> RnMG ([AvailInfo],             -- What's actually imported
331                        [AvailInfo],             -- What's to be hidden
332                                                 -- (the unqualified version, that is)
333                         -- (We need to return both the above sets, because
334                         --  the qualified version is never hidden; so we can't
335                         --  implement hiding by reducing what's imported.)
336                        NameSet)                 -- What was imported explicitly
337
338         -- Complains if import spec mentions things that the module doesn't export
339         -- Warns/informs if import spec contains duplicates.
340 filterImports mod Nothing imports
341   = returnRn (imports, [], emptyNameSet)
342
343 filterImports mod (Just (want_hiding, import_items)) avails
344   = flatMapRn get_item import_items             `thenRn` \ avails_w_explicits ->
345     let
346         (item_avails, explicits_s) = unzip avails_w_explicits
347         explicits                  = foldl addListToNameSet emptyNameSet explicits_s
348     in
349     if want_hiding 
350     then        
351         -- All imported; item_avails to be hidden
352         returnRn (avails, item_avails, emptyNameSet)
353     else
354         -- Just item_avails imported; nothing to be hidden
355         returnRn (item_avails, [], explicits)
356   where
357     import_fm :: FiniteMap OccName AvailInfo
358     import_fm = listToFM [ (nameOccName name, avail) 
359                          | avail <- avails,
360                            name  <- availNames avail]
361         -- Even though availNames returns data constructors too,
362         -- they won't make any difference because naked entities like T
363         -- in an import list map to TcOccs, not VarOccs.
364
365     bale_out item = addErrRn (badImportItemErr mod item)        `thenRn_`
366                     returnRn []
367
368     get_item item@(IEModuleContents _) = bale_out item
369
370     get_item item@(IEThingAll _)
371       = case check_item item of
372           Nothing                    -> bale_out item
373           Just avail@(AvailTC _ [n]) ->         -- This occurs when you import T(..), but
374                                                 -- only export T abstractly.  The single [n]
375                                                 -- in the AvailTC is the type or class itself
376                                         addWarnRn (dodgyImportWarn mod item)    `thenRn_`
377                                         returnRn [(avail, [availName avail])]
378           Just avail                 -> returnRn [(avail, [availName avail])]
379
380     get_item item@(IEThingAbs n)
381       | want_hiding     -- hiding( C ) 
382                         -- Here the 'C' can be a data constructor *or* a type/class
383       = case catMaybes [check_item item, check_item (IEThingAbs data_n)] of
384                 []     -> bale_out item
385                 avails -> returnRn [(a, []) | a <- avails]
386                                 -- The 'explicits' list is irrelevant when hiding
387       where
388         data_n = setRdrNameOcc n (setOccNameSpace (rdrNameOcc n) dataName)
389
390     get_item item
391       = case check_item item of
392           Nothing    -> bale_out item
393           Just avail -> returnRn [(avail, availNames avail)]
394
395     check_item item
396       | not (maybeToBool maybe_in_import_avails) ||
397         not (maybeToBool maybe_filtered_avail)
398       = Nothing
399
400       | otherwise    
401       = Just filtered_avail
402                 
403       where
404         wanted_occ             = rdrNameOcc (ieName item)
405         maybe_in_import_avails = lookupFM import_fm wanted_occ
406
407         Just avail             = maybe_in_import_avails
408         maybe_filtered_avail   = filterAvail item avail
409         Just filtered_avail    = maybe_filtered_avail
410 \end{code}
411
412
413
414 %************************************************************************
415 %*                                                                      *
416 \subsection{Qualifiying imports}
417 %*                                                                      *
418 %************************************************************************
419
420 @qualifyImports@ takes the @ExportEnv@ after filtering through the import spec
421 of an import decl, and deals with producing an @RnEnv@ with the 
422 right qualified names.  It also turns the @Names@ in the @ExportEnv@ into
423 fully fledged @Names@.
424
425 \begin{code}
426 qualifyImports :: ModuleName            -- Imported module
427                -> Bool                  -- True <=> want unqualified import
428                -> Maybe ModuleName      -- Optional "as M" part 
429                -> [AvailInfo]           -- What's to be hidden
430                -> Avails                -- Whats imported and how
431                -> RnMG (GlobalRdrEnv, ExportAvails)
432
433 qualifyImports this_mod unqual_imp as_mod hides avails
434   = 
435         -- Make the name environment.  We're talking about a 
436         -- single module here, so there must be no name clashes.
437         -- In practice there only ever will be if it's the module
438         -- being compiled.
439     let
440         -- Add the things that are available
441         name_env1 = foldl add_avail emptyRdrEnv avails
442
443         -- Delete things that are hidden
444         name_env2 = foldl del_avail name_env1 hides
445
446         -- Create the export-availability info
447         export_avails = mkExportAvails qual_mod unqual_imp name_env2 avails
448     in
449     returnRn (name_env2, export_avails)
450
451   where
452     qual_mod = case as_mod of
453                   Nothing           -> this_mod
454                   Just another_name -> another_name
455
456     add_avail :: GlobalRdrEnv -> AvailInfo -> GlobalRdrEnv
457     add_avail env avail = foldl add_name env (availNames avail)
458
459     add_name env name
460         | unqual_imp = env2
461         | otherwise  = env1
462         where
463           env1 = addOneToGlobalRdrEnv env  (mkRdrQual qual_mod occ) name
464           env2 = addOneToGlobalRdrEnv env1 (mkRdrUnqual occ)        name
465           occ  = nameOccName name
466
467     del_avail env avail = foldl delOneFromGlobalRdrEnv env rdr_names
468                         where
469                           rdr_names = map (mkRdrUnqual . nameOccName) (availNames avail)
470
471
472 mkEmptyExportAvails :: ModuleName -> ExportAvails
473 mkEmptyExportAvails mod_name = (unitFM mod_name [], emptyUFM)
474
475 mkExportAvails :: ModuleName -> Bool -> GlobalRdrEnv -> [AvailInfo] -> ExportAvails
476 mkExportAvails mod_name unqual_imp name_env avails
477   = (mod_avail_env, entity_avail_env)
478   where
479     mod_avail_env = unitFM mod_name unqual_avails 
480
481         -- unqual_avails is the Avails that are visible in *unqualfied* form
482         -- (1.4 Report, Section 5.1.1)
483         -- For example, in 
484         --      import T hiding( f )
485         -- we delete f from avails
486
487     unqual_avails | not unqual_imp = [] -- Short cut when no unqualified imports
488                   | otherwise      = mapMaybe prune avails
489
490     prune (Avail n) | unqual_in_scope n = Just (Avail n)
491     prune (Avail n) | otherwise         = Nothing
492     prune (AvailTC n ns) | null uqs     = Nothing
493                          | otherwise    = Just (AvailTC n uqs)
494                          where
495                            uqs = filter unqual_in_scope ns
496
497     unqual_in_scope n = unQualInScope name_env n
498
499     entity_avail_env = listToUFM [ (name,avail) | avail <- avails, 
500                                                   name  <- availNames avail]
501
502 plusExportAvails ::  ExportAvails ->  ExportAvails ->  ExportAvails
503 plusExportAvails (m1, e1) (m2, e2)
504   = (plusFM_C (++) m1 m2, plusAvailEnv e1 e2)
505         -- ToDo: wasteful: we do this once for each constructor!
506 \end{code}
507
508
509 %************************************************************************
510 %*                                                                      *
511 \subsection{Export list processing}
512 %*                                                                      *
513 %************************************************************************
514
515 Processing the export list.
516
517 You might think that we should record things that appear in the export list
518 as ``occurrences'' (using @addOccurrenceName@), but you'd be wrong.
519 We do check (here) that they are in scope,
520 but there is no need to slurp in their actual declaration
521 (which is what @addOccurrenceName@ forces).
522
523 Indeed, doing so would big trouble when
524 compiling @PrelBase@, because it re-exports @GHC@, which includes @takeMVar#@,
525 whose type includes @ConcBase.StateAndSynchVar#@, and so on...
526
527 \begin{code}
528 type ExportAccum        -- The type of the accumulating parameter of
529                         -- the main worker function in exportsFromAvail
530      = ([ModuleName],           -- 'module M's seen so far
531         ExportOccMap,           -- Tracks exported occurrence names
532         AvailEnv)               -- The accumulated exported stuff, kept in an env
533                                 --   so we can common-up related AvailInfos
534
535 type ExportOccMap = FiniteMap OccName (Name, RdrNameIE)
536         -- Tracks what a particular exported OccName
537         --   in an export list refers to, and which item
538         --   it came from.  It's illegal to export two distinct things
539         --   that have the same occurrence name
540
541
542 exportsFromAvail :: ModuleName
543                  -> Maybe [RdrNameIE]   -- Export spec
544                  -> ExportAvails
545                  -> GlobalRdrEnv 
546                  -> RnMG Avails
547         -- Complains if two distinct exports have same OccName
548         -- Warns about identical exports.
549         -- Complains about exports items not in scope
550 exportsFromAvail this_mod Nothing export_avails global_name_env
551   = exportsFromAvail this_mod true_exports export_avails global_name_env
552   where
553     true_exports = Just $ if this_mod == mAIN_Name
554                           then [IEVar main_RDR]
555                                -- export Main.main *only* unless otherwise specified,
556                           else [IEModuleContents this_mod]
557                                -- but for all other modules export everything.
558
559 exportsFromAvail this_mod (Just export_items) 
560                  (mod_avail_env, entity_avail_env)
561                  global_name_env
562   = foldlRn exports_from_item
563             ([], emptyFM, emptyAvailEnv) export_items   `thenRn` \ (_, _, export_avail_map) ->
564     let
565         export_avails :: [AvailInfo]
566         export_avails   = nameEnvElts export_avail_map
567     in
568     returnRn export_avails
569
570   where
571     exports_from_item :: ExportAccum -> RdrNameIE -> RnMG ExportAccum
572
573     exports_from_item acc@(mods, occs, avails) ie@(IEModuleContents mod)
574         | mod `elem` mods       -- Duplicate export of M
575         = warnCheckRn opt_WarnDuplicateExports
576                       (dupModuleExport mod)     `thenRn_`
577           returnRn acc
578
579         | otherwise
580         = case lookupFM mod_avail_env mod of
581                 Nothing         -> failWithRn acc (modExportErr mod)
582                 Just mod_avails -> foldlRn (check_occs ie) occs mod_avails
583                                    `thenRn` \ occs' ->
584                                    let
585                                         avails' = foldl addAvail avails mod_avails
586                                    in
587                                    returnRn (mod:mods, occs', avails')
588
589     exports_from_item acc@(mods, occs, avails) ie
590         | not (maybeToBool maybe_in_scope) 
591         = failWithRn acc (unknownNameErr (ieName ie))
592
593         | not (null dup_names)
594         = addNameClashErrRn rdr_name (name:dup_names)   `thenRn_`
595           returnRn acc
596
597 #ifdef DEBUG
598         -- I can't see why this should ever happen; if the thing is in scope
599         -- at all it ought to have some availability
600         | not (maybeToBool maybe_avail)
601         = pprTrace "exportsFromAvail: curious Nothing:" (ppr name)
602           returnRn acc
603 #endif
604
605         | not enough_avail
606         = failWithRn acc (exportItemErr ie)
607
608         | otherwise     -- Phew!  It's OK!  Now to check the occurrence stuff!
609
610
611         = warnCheckRn (ok_item ie avail) (dodgyExportWarn ie)   `thenRn_`
612           check_occs ie occs export_avail                       `thenRn` \ occs' ->
613           returnRn (mods, occs', addAvail avails export_avail)
614
615        where
616           rdr_name        = ieName ie
617           maybe_in_scope  = lookupFM global_name_env rdr_name
618           Just (name:dup_names) = maybe_in_scope
619           maybe_avail        = lookupUFM entity_avail_env name
620           Just avail         = maybe_avail
621           maybe_export_avail = filterAvail ie avail
622           enough_avail       = maybeToBool maybe_export_avail
623           Just export_avail  = maybe_export_avail
624
625     ok_item (IEThingAll _) (AvailTC _ [n]) = False
626                 -- This occurs when you import T(..), but
627                 -- only export T abstractly.  The single [n]
628                 -- in the AvailTC is the type or class itself
629     ok_item _ _ = True
630
631 check_occs :: RdrNameIE -> ExportOccMap -> AvailInfo -> RnMG ExportOccMap
632 check_occs ie occs avail 
633   = foldlRn check occs (availNames avail)
634   where
635     check occs name
636       = case lookupFM occs name_occ of
637           Nothing           -> returnRn (addToFM occs name_occ (name, ie))
638           Just (name', ie') 
639             | name == name' ->  -- Duplicate export
640                                 warnCheckRn opt_WarnDuplicateExports
641                                             (dupExportWarn name_occ ie ie')
642                                 `thenRn_` returnRn occs
643
644             | otherwise     ->  -- Same occ name but different names: an error
645                                 failWithRn occs (exportClashErr name_occ ie ie')
646       where
647         name_occ = nameOccName name
648         
649 mk_export_fn :: NameSet -> (Name -> ExportFlag)
650 mk_export_fn exported_names
651   = \name -> if name `elemNameSet` exported_names
652              then Exported
653              else NotExported
654 \end{code}
655
656 %************************************************************************
657 %*                                                                      *
658 \subsection{Errors}
659 %*                                                                      *
660 %************************************************************************
661
662 \begin{code}
663 badImportItemErr mod ie
664   = sep [ptext SLIT("Module"), quotes (pprModuleName mod), 
665          ptext SLIT("does not export"), quotes (ppr ie)]
666
667 dodgyImportWarn mod item = dodgyMsg (ptext SLIT("import")) item
668 dodgyExportWarn     item = dodgyMsg (ptext SLIT("export")) item
669
670 dodgyMsg kind item@(IEThingAll tc)
671   = sep [ ptext SLIT("The") <+> kind <+> ptext SLIT("item") <+> quotes (ppr item),
672           ptext SLIT("suggests that") <+> quotes (ppr tc) <+> ptext SLIT("has constructor or class methods"),
673           ptext SLIT("but it has none; it is a type synonym or abstract type or class") ]
674           
675 modExportErr mod
676   = hsep [ ptext SLIT("Unknown module in export list: module"), quotes (pprModuleName mod)]
677
678 exportItemErr export_item
679   = sep [ ptext SLIT("The export item") <+> quotes (ppr export_item),
680           ptext SLIT("attempts to export constructors or class methods that are not visible here") ]
681
682 exportClashErr occ_name ie1 ie2
683   = hsep [ptext SLIT("The export items"), quotes (ppr ie1)
684          ,ptext SLIT("and"), quotes (ppr ie2)
685          ,ptext SLIT("create conflicting exports for"), quotes (ppr occ_name)]
686
687 dupDeclErr (n:ns)
688   = vcat [ptext SLIT("Multiple declarations of") <+> quotes (ppr n),
689           nest 4 (vcat (map pp sorted_ns))]
690   where
691     sorted_ns = sortLt occ'ed_before (n:ns)
692
693     occ'ed_before a b = LT == compare (getSrcLoc a) (getSrcLoc b)
694
695     pp n      = pprProvenance (getNameProvenance n)
696
697 dupExportWarn occ_name ie1 ie2
698   = hsep [quotes (ppr occ_name), 
699           ptext SLIT("is exported by"), quotes (ppr ie1),
700           ptext SLIT("and"),            quotes (ppr ie2)]
701
702 dupModuleExport mod
703   = hsep [ptext SLIT("Duplicate"),
704           quotes (ptext SLIT("Module") <+> pprModuleName mod), 
705           ptext SLIT("in export list")]
706 \end{code}