data GlobalRdrElt
= GRE { gre_name :: Name,
- gre_parent :: Name, -- Name of the "parent" structure
- -- * the tycon of a data con
- -- * the class of a class op
- -- For others it's just the same as gre_name
- gre_prov :: Provenance, -- Why it's in scope
- gre_deprec :: Maybe DeprecTxt -- Whether this name is deprecated
+ gre_parent :: Maybe Name, -- Name of the "parent" structure, for
+ -- * the tycon of a data con
+ -- * the class of a class op
+ -- For others it's Nothing
+ -- Invariant: gre_name g /= gre_parent g
+ -- when the latter is a Just
+
+ gre_prov :: Provenance, -- Why it's in scope
+ gre_deprec :: Maybe DeprecTxt -- Whether this name is deprecated
}
instance Outputable GlobalRdrElt where
ppr gre = ppr (gre_name gre) <+>
- parens (hsep [text "parent:" <+> ppr (gre_parent gre) <> comma,
- pprNameProvenance gre])
+ parens (pp_parent (gre_parent gre) <+> pprNameProvenance gre)
+ where
+ pp_parent (Just p) = text "parent:" <+> ppr p <> comma
+ pp_parent Nothing = empty
+
pprGlobalRdrEnv env
= vcat (map pp (rdrEnvToList env))
where
where
occ = nameOccName name
elt = GRE {gre_name = name,
- gre_parent = parent,
+ gre_parent = if name == parent
+ then Nothing
+ else Just parent,
gre_prov = mk_provenance name,
gre_deprec = lookupDeprec deprecs name}
warnUnusedBinds :: [(Name,Provenance)] -> TcRn m ()
warnUnusedBinds names
- = mappM_ warnUnusedGroup groups
+ = mappM_ warnUnusedGroup groups
where
-- Group by provenance
- groups = equivClasses cmp names
+ groups = equivClasses cmp (filter reportable names)
(_,prov1) `cmp` (_,prov2) = prov1 `compare` prov2
+ reportable (name,_) = case occNameUserString (nameOccName name) of
+ ('_' : _) -> False
+ zz_other -> True
+ -- Haskell 98 encourages compilers to suppress warnings about
+ -- unused names in a pattern if they start with "_".
+
-------------------------
warnUnusedGroup :: [(Name,Provenance)] -> TcRn m ()
warnUnusedGroup names
- | null filtered_names = returnM ()
- | not is_local = returnM ()
- | otherwise
= addSrcLoc def_loc $
- addWarn $
- sep [msg <> colon, nest 4 (fsep (punctuate comma (map (ppr.fst) filtered_names)))]
+ addWarn $
+ sep [msg <> colon, nest 4 (fsep (punctuate comma (map (ppr.fst) names)))]
where
- filtered_names = filter reportable names
- (name1, prov1) = head filtered_names
- (is_local, def_loc, msg)
- = case prov1 of
- LocalDef -> (True, getSrcLoc name1, text "Defined but not used")
-
- NonLocalDef (UserImport mod loc _)
- -> (True, loc, text "Imported from" <+> quotes (ppr mod) <+> text "but not used")
-
- reportable (name,_) = case occNameUserString (nameOccName name) of
- ('_' : _) -> False
- zz_other -> True
- -- Haskell 98 encourages compilers to suppress warnings about
- -- unused names in a pattern if they start with "_".
+ (name1, prov1) = head names
+ loc1 = getSrcLoc name1
+ (def_loc, msg) = case prov1 of
+ LocalDef -> (loc1, unused_msg)
+ NonLocalDef (UserImport mod loc _) -> (loc, imp_from mod)
+
+ unused_msg = text "Defined but not used"
+ imp_from mod = text "Imported from" <+> quotes (ppr mod) <+> text "but not used"
\end{code}
\begin{code}
addNameClashErrRn rdr_name (np1:nps)
= addErr (vcat [ptext SLIT("Ambiguous occurrence") <+> quotes (ppr rdr_name),
- ptext SLIT("It could refer to") <+> vcat (msg1 : msgs)])
+ ptext SLIT("It could refer to") <+> vcat (msg1 : msgs)])
where
msg1 = ptext SLIT("either") <+> mk_ref np1
msgs = [ptext SLIT(" or") <+> mk_ref np | np <- nps]
Deprecations(..), ModIface(..), Dependencies(..),
GlobalRdrElt(..), unQualInScope, isLocalGRE, pprNameProvenance
)
-import RdrName ( RdrName, rdrNameOcc, setRdrNameSpace, lookupRdrEnv,
+import RdrName ( RdrName, rdrNameOcc, setRdrNameSpace, lookupRdrEnv, rdrEnvToList,
emptyRdrEnv, foldRdrEnv, rdrEnvElts, mkRdrUnqual, isQual )
import Outputable
-import Maybe ( isJust, isNothing, catMaybes )
+import Maybe ( isJust, isNothing, catMaybes, fromMaybe )
+import Maybes ( orElse, expectJust )
import ListSetOps ( removeDups )
import Util ( sortLt, notNull )
import List ( partition, insert )
-- Complains if two distinct exports have same OccName
-- Warns about identical exports.
-- Complains about exports items not in scope
-exportsFromAvail Nothing
+
+exportsFromAvail exports
+ = do { TcGblEnv { tcg_rdr_env = rdr_env,
+ tcg_imports = imports } <- getGblEnv ;
+ exports_from_avail exports rdr_env imports }
+
+exports_from_avail Nothing rdr_env
+ (ImportAvails { imp_env = entity_avail_env })
= 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.
+ -- Export nothing; Main.$main is automatically exported
+ else
+ -- 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 [ avail
+ | (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,
+ let avail = expectJust "exportsFromAvail"
+ (lookupAvailEnv entity_avail_env name)
+ ]
}
-exportsFromAvail (Just exports)
- = do { TcGblEnv { tcg_imports = imports } <- getGblEnv ;
- exports_from_avail exports imports }
-
-exports_from_avail export_items
+exports_from_avail (Just export_items) rdr_env
(ImportAvails { imp_qual = mod_avail_env,
imp_env = entity_avail_env })
= foldlM exports_from_item emptyExportAccum
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]
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 = expectJust "exportsFromAvail2"
+ (lookupAvailEnv entity_avail_env parent)
+ in
-- Filter out the bits we want
case filterAvail ie avail of {
Nothing -> -- Not enough availability
warnIf (not (ok_item ie avail)) (dodgyExportWarn ie) `thenM_`
check_occs ie occs export_avail `thenM` \ occs' ->
returnM (mods, occs', addAvail avails export_avail)
- }}}
+ }}
-------------------------------
-- 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]
+ mkNameSet [ parent
+ | GRE{ gre_name = name,
+ gre_parent = Just parent }
+ <- defined_names,
+ name `elemNameSet` used_names]
-- Collect the defined names from the in-scope environment
-- Look for the qualified ones only, else get duplicates
= 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
projects / ghc-hetmet.git / commitdiff