Commit ba580284 authored by simonpj's avatar simonpj
Browse files

[project @ 2003-01-09 16:15:51 by simonpj]

--------------------------
	Fix export-calculation bug
	--------------------------

Ross points out that in
 	module M where
 	import List as M
 	sort = "foo"

there is no conflict in the export list. GHC used to treat this
like

	module M( module M ) where ...

which is wrong, wrong, wrong.

Now fixed.   Test in modules/mod200.hs

Some other small tidying up (notably in GRE.gre_parent).
parent 115843f2
......@@ -857,18 +857,24 @@ emptyGlobalRdrEnv = emptyRdrEnv
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
......
......@@ -890,7 +890,9 @@ mkGlobalRdrEnv this_mod unqual_imp mk_provenance avails deprecs
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}
......@@ -986,44 +988,41 @@ warnUnusedLocals names = warnUnusedBinds [(n,LocalDef) | n<-names]
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]
......
......@@ -40,10 +40,11 @@ import HscTypes ( Provenance(..), ImportReason(..), GlobalRdrEnv,
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 )
......@@ -531,21 +532,36 @@ exportsFromAvail :: Maybe [RdrNameIE] -> TcRn m Avails
-- 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
......@@ -567,11 +583,10 @@ exports_from_avail export_items
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]
......@@ -588,16 +603,16 @@ exports_from_avail export_items
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
......@@ -610,7 +625,7 @@ exports_from_avail export_items
warnIf (not (ok_item ie avail)) (dodgyExportWarn ie) `thenM_`
check_occs ie occs export_avail `thenM` \ occs' ->
returnM (mods, occs', addAvail avails export_avail)
}}}
}}
-------------------------------
......@@ -688,9 +703,11 @@ reportUnusedNames gbl_env used_names
-- 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
......@@ -752,9 +769,9 @@ reportUnusedNames gbl_env used_names
= 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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment