ForeignDecl(..), HsGroup(..),
collectLocatedHsBinders, tyClDeclNames
)
-import RdrHsSyn ( RdrNameIE, RdrNameImportDecl )
+import RdrHsSyn ( RdrNameIE, RdrNameImportDecl, main_RDR_Unqual )
import RnEnv
import TcRnMonad
import FiniteMap
-import PrelNames ( pRELUDE_Name, mAIN_Name, isBuiltInSyntaxName )
+import PrelNames ( pRELUDE_Name, isBuiltInSyntaxName )
import Module ( Module, ModuleName, ModuleEnv, moduleName,
moduleNameUserString, isHomeModule,
emptyModuleEnv, unitModuleEnvByName, unitModuleEnv,
import Name ( Name, nameSrcLoc, nameOccName, nameModule, isExternalName )
import NameSet
import NameEnv
-import OccName ( OccName, dataName, isTcOcc )
+import OccName ( OccName, srcDataName, isTcOcc )
import HscTypes ( Provenance(..), ImportReason(..), GlobalRdrEnv,
- GenAvailInfo(..), AvailInfo, Avails,
+ GenAvailInfo(..), AvailInfo, Avails, GhciMode(..),
IsBootInterface,
availName, availNames, availsToNameSet,
Deprecations(..), ModIface(..), Dependencies(..),
- GlobalRdrElt(..), unQualInScope, isLocalGRE
+ GlobalRdrElt(..), unQualInScope, isLocalGRE, pprNameProvenance
)
-import RdrName ( RdrName, rdrNameOcc, setRdrNameSpace, lookupRdrEnv,
- emptyRdrEnv, foldRdrEnv, mkRdrUnqual, isQual )
+import RdrName ( RdrName, rdrNameOcc, setRdrNameSpace, lookupRdrEnv, rdrEnvToList,
+ emptyRdrEnv, foldRdrEnv, rdrEnvElts, mkRdrUnqual, isQual )
import Outputable
import Maybe ( isJust, isNothing, catMaybes )
+import Maybes ( orElse )
import ListSetOps ( removeDups )
import Util ( sortLt, notNull )
import List ( partition, insert )
avails -> returnM [(a, []) | a <- avails]
-- The 'explicits' list is irrelevant when hiding
where
- data_n = setRdrNameSpace n dataName
+ data_n = setRdrNameSpace n srcDataName
get_item item
= case check_item item of
-- that have the same occurrence name
-exportsFromAvail :: Maybe [RdrNameIE] -> TcRn m Avails
+exportsFromAvail :: Maybe Module -- Nothing => no 'module M(..) where' header at all
+ -> Maybe [RdrNameIE] -- Nothing => no explicit export list
+ -> TcRn m Avails
-- Complains if two distinct exports have same OccName
-- Warns about identical exports.
-- Complains about exports items not in scope
-exportsFromAvail Nothing
- = do { this_mod <- getModule ;
- if moduleName this_mod == mAIN_Name then
- return []
- -- Export nothing; Main.$main is automatically exported
- else
- exportsFromAvail (Just [IEModuleContents (moduleName this_mod)])
- -- but for all other modules export everything.
- }
-
-exportsFromAvail (Just exports)
- = do { TcGblEnv { tcg_imports = imports } <- getGblEnv ;
- warn_dup_exports <- doptM Opt_WarnDuplicateExports ;
- exports_from_avail exports warn_dup_exports imports }
-exports_from_avail export_items warn_dup_exports
+exportsFromAvail maybe_mod exports
+ = do { TcGblEnv { tcg_rdr_env = rdr_env,
+ tcg_imports = imports } <- getGblEnv ;
+
+ -- If the module header is omitted altogether, then behave
+ -- as if the user had written "module Main(main) where..."
+ -- EXCEPT in interactive mode, when we behave as if he had
+ -- written "module Main where ..."
+ -- Reason: don't want to complain about 'main' not in scope
+ -- in interactive mode
+ ghci_mode <- getGhciMode ;
+ let { real_exports
+ = case maybe_mod of
+ Just mod -> exports
+ Nothing | ghci_mode == Interactive -> Nothing
+ | otherwise -> Just [IEVar main_RDR_Unqual] } ;
+
+ exports_from_avail exports rdr_env imports }
+
+exports_from_avail Nothing rdr_env
+ imports@(ImportAvails { imp_env = entity_avail_env })
+ = -- Export all locally-defined things
+ -- We do this by filtering the global RdrEnv,
+ -- keeping only things that are (a) qualified,
+ -- (b) locally defined, (c) a 'main' name
+ -- Then we look up in the entity-avail-env
+ return [ lookupAvailEnv entity_avail_env name
+ | (rdr_name, gres) <- rdrEnvToList rdr_env,
+ isQual rdr_name, -- Avoid duplicates
+ GRE { gre_name = name,
+ gre_parent = Nothing, -- Main things only
+ gre_prov = LocalDef } <- gres
+ ]
+
+exports_from_avail (Just export_items) rdr_env
(ImportAvails { imp_qual = mod_avail_env,
imp_env = entity_avail_env })
= foldlM exports_from_item emptyExportAccum
exports_from_item acc@(mods, occs, avails) ie@(IEModuleContents mod)
| mod `elem` mods -- Duplicate export of M
- = warnIf warn_dup_exports (dupModuleExport mod) `thenM_`
- returnM acc
+ = do { warn_dup_exports <- doptM Opt_WarnDuplicateExports ;
+ warnIf warn_dup_exports (dupModuleExport mod) ;
+ returnM acc }
| otherwise
= case lookupModuleEnvByName mod_avail_env mod of
- Nothing -> addErr (modExportErr mod) `thenM_`
- returnM acc
+ Nothing -> addErr (modExportErr mod) `thenM_`
+ returnM acc
+
Just avail_env
- -> getGlobalRdrEnv `thenM` \ global_env ->
- let
+ -> let
mod_avails = [ filtered_avail
| avail <- availEnvElts avail_env,
- let mb_avail = filter_unqual global_env avail,
+ let mb_avail = filter_unqual rdr_env avail,
isJust mb_avail,
let Just filtered_avail = mb_avail]
-- and others, but also internally within this item. That is,
-- if 'M.x' is in scope in several ways, we'll have several
-- members of mod_avails with the same OccName.
- foldlM (check_occs warn_dup_exports ie)
- occs mod_avails `thenM` \ occs' ->
+ foldlM (check_occs ie) occs mod_avails `thenM` \ occs' ->
returnM (mod:mods, occs', avails')
exports_from_item acc@(mods, occs, avails) ie
= lookupGRE (ieName ie) `thenM` \ mb_gre ->
case mb_gre of {
- Nothing -> addErr (unknownNameErr (ieName ie)) `thenM_`
- returnM acc ;
- Just gre ->
+ Nothing -> addErr (unknownNameErr (ieName ie)) `thenM_`
+ returnM acc ;
+ Just gre ->
-- Get the AvailInfo for the parent of the specified name
- case lookupAvailEnv entity_avail_env (gre_parent gre) of {
- Nothing -> pprPanic "exportsFromAvail"
- ((ppr (ieName ie)) <+> ppr gre) ;
- Just avail ->
-
+ let
+ parent = gre_parent gre `orElse` gre_name gre
+ avail = lookupAvailEnv entity_avail_env parent
+ in
-- Filter out the bits we want
case filterAvail ie avail of {
Nothing -> -- Not enough availability
-- Phew! It's OK! Now to check the occurrence stuff!
warnIf (not (ok_item ie avail)) (dodgyExportWarn ie) `thenM_`
- check_occs warn_dup_exports ie occs export_avail `thenM` \ occs' ->
+ check_occs ie occs export_avail `thenM` \ occs' ->
returnM (mods, occs', addAvail avails export_avail)
- }}}
+ }}
-------------------------------
in_scope :: GlobalRdrEnv -> Name -> Bool
-- Checks whether the Name is in scope unqualified,
-- regardless of whether it's ambiguous or not
-in_scope env n = isJust (lookupRdrEnv env (mkRdrUnqual (nameOccName n)))
+in_scope env n
+ = case lookupRdrEnv env (mkRdrUnqual (nameOccName n)) of
+ Nothing -> False
+ Just gres -> or [n == gre_name g | g <- gres]
-------------------------------
ok_item _ _ = True
-------------------------------
-check_occs :: Bool -> RdrNameIE -> ExportOccMap -> AvailInfo -> TcRn m ExportOccMap
-check_occs warn_dup_exports ie occs avail
+check_occs :: RdrNameIE -> ExportOccMap -> AvailInfo -> TcRn m ExportOccMap
+check_occs ie occs avail
= foldlM check occs (availNames avail)
where
check occs name
= case lookupFM occs name_occ of
- Nothing -> returnM (addToFM occs name_occ (name, ie))
+ Nothing -> returnM (addToFM occs name_occ (name, ie))
+
Just (name', ie')
- | name == name' -> -- Duplicate export
- warnIf warn_dup_exports
- (dupExportWarn name_occ ie ie')
- `thenM_` returnM occs
-
- | otherwise -> -- Same occ name but different names: an error
- addErr (exportClashErr name name' ie ie') `thenM_`
- returnM occs
+ | name == name' -- Duplicate export
+ -> do { warn_dup_exports <- doptM Opt_WarnDuplicateExports ;
+ warnIf warn_dup_exports (dupExportWarn name_occ ie ie') ;
+ returnM occs }
+
+ | otherwise -- Same occ name but different names: an error
+ -> do { global_env <- getGlobalRdrEnv ;
+ addErr (exportClashErr global_env name name' ie ie') ;
+ returnM occs }
where
name_occ = nameOccName name
\end{code}
%*********************************************************
\begin{code}
-reportUnusedNames :: TcGblEnv
- -> NameSet -- Used in this module
- -> TcRn m ()
-reportUnusedNames gbl_env used_names
- = warnUnusedModules unused_imp_mods `thenM_`
- warnUnusedTopBinds bad_locals `thenM_`
- warnUnusedImports bad_imports `thenM_`
+reportUnusedNames :: TcGblEnv -> DefUses -> TcRn m ()
+reportUnusedNames gbl_env dus
+ = warnUnusedModules unused_imp_mods `thenM_`
+ warnUnusedTopBinds bad_locals `thenM_`
+ warnUnusedImports bad_imports `thenM_`
printMinimalImports minimal_imports
where
- direct_import_mods :: [ModuleName]
- direct_import_mods = map (moduleName . fst)
- (moduleEnvElts (imp_mods (tcg_imports gbl_env)))
-
- -- Now, a use of C implies a use of T,
- -- if C was brought into scope by T(..) or T(C)
- really_used_names :: NameSet
- really_used_names = used_names `unionNameSets`
- mkNameSet [ gre_parent gre
- | gre <- defined_names,
- gre_name gre `elemNameSet` used_names]
+ used_names :: NameSet
+ used_names = findUses dus emptyNameSet
-- Collect the defined names from the in-scope environment
-- Look for the qualified ones only, else get duplicates
| otherwise = acc
defined_and_used, defined_but_not_used :: [GlobalRdrElt]
- (defined_and_used, defined_but_not_used) = partition used defined_names
- used gre = gre_name gre `elemNameSet` really_used_names
+ (defined_and_used, defined_but_not_used) = partition is_used defined_names
+
+ is_used gre = n `elemNameSet` used_names || any (`elemNameSet` used_names) kids
+ -- The 'kids' part is because a use of C implies a use of T,
+ -- if C was brought into scope by T(..) or T(C)
+ where
+ n = gre_name gre
+ kids = case lookupAvailEnv_maybe avail_env n of
+ Just (AvailTC n ns) -> ns
+ other -> [] -- Ids, class ops and datacons
+ -- (The latter two give Nothing)
-- Filter out the ones that are
-- (a) defined in this module, and
-- The latter have an Internal Name, so we can filter them out easily
bad_locals :: [GlobalRdrElt]
bad_locals = filter is_bad defined_but_not_used
-
is_bad :: GlobalRdrElt -> Bool
is_bad gre = isLocalGRE gre && isExternalName (gre_name gre)
= acc
-- n is the name of the thing, p is the name of its parent
- mk_avail n p | n/=p = AvailTC p [p,n]
- | isTcOcc (nameOccName p) = AvailTC n [n]
- | otherwise = Avail n
+ mk_avail n (Just p) = AvailTC p [p,n]
+ mk_avail n Nothing | isTcOcc (nameOccName n) = AvailTC n [n]
+ | otherwise = Avail n
add_inst_mod m acc
| m `elemFM` acc = acc -- We import something already
-- Add an empty collection of imports for a module
-- from which we have sucked only instance decls
+ imports = tcg_imports gbl_env
+ avail_env = imp_env imports
+
+ direct_import_mods :: [ModuleName]
+ direct_import_mods = map (moduleName . fst)
+ (moduleEnvElts (imp_mods imports))
+
-- unused_imp_mods are the directly-imported modules
-- that are not mentioned in minimal_imports1
-- [Note: not 'minimal_imports', because that includes direcly-imported
= sep [ ptext SLIT("The export item") <+> quotes (ppr export_item),
ptext SLIT("attempts to export constructors or class methods that are not visible here") ]
-exportClashErr name1 name2 ie1 ie2
- | different_items
- = sep [ ptext SLIT("The export items") <+> quotes (ppr ie1)
- <+> ptext SLIT("and") <+> quotes (ppr ie2)
- , ptext SLIT("create") <+> name_msg <+> ptext SLIT("respectively") ]
- | otherwise
- = sep [ ptext SLIT("The export item") <+> quotes (ppr ie1)
- , ptext SLIT("creates") <+> name_msg ]
+exportClashErr global_env name1 name2 ie1 ie2
+ = vcat [ ptext SLIT("Conflicting exports for") <+> quotes (ppr occ) <> colon
+ , ppr_export ie1 name1
+ , ppr_export ie2 name2 ]
where
- name_msg = ptext SLIT("conflicting exports for") <+> quotes (ppr name1)
- <+> ptext SLIT("and") <+> quotes (ppr name2)
- different_items -- This only comes into play when we have a single
- -- 'module M' export item which gives rise to conflicts
- = case (ie1,ie2) of
- (IEModuleContents m1, IEModuleContents m2) -> m1 /= m2
- other -> True
+ occ = nameOccName name1
+ ppr_export ie name = nest 2 (quotes (ppr ie) <+> ptext SLIT("exports") <+>
+ quotes (ppr name) <+> pprNameProvenance (get_gre name))
+
+ -- get_gre finds a GRE for the Name, in a very inefficient way
+ -- There isn't a more efficient way to do it, because we don't necessarily
+ -- know the RdrName under which this Name is in scope. So we just
+ -- search linearly. Shouldn't matter because this only happens
+ -- in an error message.
+ get_gre name
+ = case [gre | gres <- rdrEnvElts global_env,
+ gre <- gres,
+ gre_name gre == name] of
+ (gre:_) -> gre
+ [] -> pprPanic "exportClashErr" (ppr name)
dupDeclErr (n:ns)
= vcat [ptext SLIT("Multiple declarations of") <+> quotes (ppr n),
projects / ghc-hetmet.git / blobdiff