Commit 7ea156ae authored by Simon Peyton Jones's avatar Simon Peyton Jones

Refactor RdrName.Provenance, to fix #7672

Trac #7672 has a data type T in module A that is in scope
*both* locally-bound *and* imported (with a qualified) name.
The Provenance of a GlobalRdrElt simply couldn't express that
before. Now you can.

In doing so, I flattened out Provenance into GlobalRdrElt,
so quite a lot of modules are touched in a not-very-interesting
way.
parent 7b6800c5
......@@ -51,10 +51,11 @@ module RdrName (
-- * GlobalRdrElts
gresFromAvails, gresFromAvail, localGREsFromAvail, availFromGRE,
greUsedRdrName, greRdrNames, greSrcSpan, greQualModName,
-- ** Global 'RdrName' mapping elements: 'GlobalRdrElt', 'Provenance', 'ImportSpec'
GlobalRdrElt(..), isLocalGRE, unQualOK, qualSpecOK, unQualSpecOK,
Provenance(..), pprNameProvenance,
pprNameProvenance,
Parent(..),
ImportSpec(..), ImpDeclSpec(..), ImpItemSpec(..),
importSpecLoc, importSpecModule, isExplicitItem
......@@ -411,10 +412,12 @@ type GlobalRdrEnv = OccEnv [GlobalRdrElt]
-- | An element of the 'GlobalRdrEnv'
data GlobalRdrElt
= GRE { gre_name :: Name,
gre_par :: Parent,
gre_prov :: Provenance -- ^ Why it's in scope
}
= GRE { gre_name :: Name
, gre_par :: Parent
, gre_lcl :: Bool -- ^ True <=> the thing was defined locally
, gre_imp :: [ImportSpec] -- ^ In scope through these imports
} -- INVARIANT: either gre_lcl = True or gre_imp is non-empty
-- See Note [GlobalRdrElt provenance]
-- | The children of a Name are the things that are abbreviated by the ".."
-- notation in export lists. See Note [Parents]
......@@ -438,7 +441,32 @@ hasParent n (ParentIs n')
#endif
hasParent n _ = ParentIs n
{-
{- Note [GlobalRdrElt provenance]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The gre_lcl and gre_imp fields of a GlobalRdrElt describe its "provenance",
i.e. how the Name came to be in scope. It can be in scope two ways:
- gre_lcl = True: it is bound in this module
- gre_imp: a list of all the imports that brought it into scope
It's an INVARIANT that you have one or the other; that is, either
gre_lcl is Ture, or gre_imp is non-empty.
It is just possible to have *both* if there is a module loop: a Name
is defined locally in A, and also brought into scope by importing a
module that SOURCE-imported A. Exapmle (Trac #7672):
A.hs-boot module A where
data T
B.hs module B(Decl.T) where
import {-# SOURCE #-} qualified A as Decl
A.hs module A where
import qualified B
data T = Z | S B.T
In A.hs, 'T' is locally bound, *and* imported as B.T.
Note [Parents]
~~~~~~~~~~~~~~~~~
Parent Children
......@@ -481,22 +509,72 @@ That's why plusParent picks the "best" case.
-}
-- | make a 'GlobalRdrEnv' where all the elements point to the same
-- Provenance (useful for "hiding" imports, or imports with
-- no details).
gresFromAvails :: Provenance -> [AvailInfo] -> [GlobalRdrElt]
-- Provenance (useful for "hiding" imports, or imports with no details).
gresFromAvails :: Maybe ImportSpec -> [AvailInfo] -> [GlobalRdrElt]
-- prov = Nothing => locally bound
-- Just spec => imported as described by spec
gresFromAvails prov avails
= concatMap (gresFromAvail (const prov)) avails
gresFromAvail :: (Name -> Provenance) -> AvailInfo -> [GlobalRdrElt]
gresFromAvail prov_fn avail
= [ GRE {gre_name = n,
gre_par = mkParent n avail,
gre_prov = prov_fn n}
| n <- availNames avail ]
localGREsFromAvail :: AvailInfo -> [GlobalRdrElt]
-- Turn an Avail into a list of LocalDef GlobalRdrElts
localGREsFromAvail = gresFromAvail (const LocalDef)
localGREsFromAvail = gresFromAvail (const Nothing)
gresFromAvail :: (Name -> Maybe ImportSpec) -> AvailInfo -> [GlobalRdrElt]
gresFromAvail prov_fn avail
= map mk_gre (availNames avail)
where
mk_gre n
= case prov_fn n of -- Nothing => bound locally
-- Just is => imported from 'is'
Nothing -> GRE { gre_name = n, gre_par = mkParent n avail
, gre_lcl = True, gre_imp = [] }
Just is -> GRE { gre_name = n, gre_par = mkParent n avail
, gre_lcl = False, gre_imp = [is] }
greQualModName :: GlobalRdrElt -> ModuleName
-- Get a suitable module qualifier for the GRE
-- (used in mkPrintUnqualified)
-- Prerecondition: the gre_name is always External
greQualModName gre@(GRE { gre_name = name, gre_lcl = lcl, gre_imp = iss })
| lcl, Just mod <- nameModule_maybe name = moduleName mod
| (is:_) <- iss = is_as (is_decl is)
| otherwise = pprPanic "greQualModName" (ppr gre)
greUsedRdrName :: GlobalRdrElt -> RdrName
-- For imported things, return a RdrName to add to the
-- used-RdrName set, which is used to generate
-- unused-import-decl warnings
-- Return an Unqual if possible, otherwise any Qual
greUsedRdrName GRE{ gre_name = name, gre_lcl = lcl, gre_imp = iss }
| lcl = Unqual occ
| not (all (is_qual . is_decl) iss) = Unqual occ
| (is:_) <- iss = Qual (is_as (is_decl is)) occ
| otherwise = pprPanic "greRdrName" (ppr name)
where
occ = nameOccName name
greRdrNames :: GlobalRdrElt -> [RdrName]
greRdrNames GRE{ gre_name = name, gre_lcl = lcl, gre_imp = iss }
= (if lcl then [unqual] else []) ++ concatMap do_spec (map is_decl iss)
where
occ = nameOccName name
unqual = Unqual occ
do_spec decl_spec
| is_qual decl_spec = [qual]
| otherwise = [unqual,qual]
where qual = Qual (is_as decl_spec) occ
-- the SrcSpan that pprNameProvenance prints out depends on whether
-- the Name is defined locally or not: for a local definition the
-- definition site is used, otherwise the location of the import
-- declaration. We want to sort the export locations in
-- exportClashErr by this SrcSpan, we need to extract it:
greSrcSpan :: GlobalRdrElt -> SrcSpan
greSrcSpan gre@(GRE { gre_name = name, gre_lcl = lcl, gre_imp = iss } )
| lcl = nameSrcSpan name
| (is:_) <- iss = is_dloc (is_decl is)
| otherwise = pprPanic "greSrcSpan" (ppr gre)
mkParent :: Name -> AvailInfo -> Parent
mkParent _ (Avail _) = NoParent
......@@ -543,7 +621,6 @@ lookupGlobalRdrEnv :: GlobalRdrEnv -> OccName -> [GlobalRdrElt]
lookupGlobalRdrEnv env occ_name = case lookupOccEnv env occ_name of
Nothing -> []
Just gres -> gres
lookupGRE_RdrName :: RdrName -> GlobalRdrEnv -> [GlobalRdrElt]
lookupGRE_RdrName rdr_name env
= case lookupOccEnv env (rdrNameOcc rdr_name) of
......@@ -560,19 +637,20 @@ getGRE_NameQualifier_maybes :: GlobalRdrEnv -> Name -> [Maybe [ModuleName]]
-- Nothing means "the unqualified version is in scope"
-- [] means the thing is not in scope at all
getGRE_NameQualifier_maybes env
= map (qualifier_maybe . gre_prov) . lookupGRE_Name env
= map (qualifier_maybe) . lookupGRE_Name env
where
qualifier_maybe LocalDef = Nothing
qualifier_maybe (Imported iss) = Just $ map (is_as . is_decl) iss
qualifier_maybe (GRE { gre_lcl = lcl, gre_imp = iss })
| lcl = Nothing
| otherwise = Just $ map (is_as . is_decl) iss
isLocalGRE :: GlobalRdrElt -> Bool
isLocalGRE (GRE {gre_prov = LocalDef}) = True
isLocalGRE _ = False
isLocalGRE (GRE {gre_lcl = lcl }) = lcl
unQualOK :: GlobalRdrElt -> Bool
-- ^ Test if an unqualifed version of this thing would be in scope
unQualOK (GRE {gre_prov = LocalDef}) = True
unQualOK (GRE {gre_prov = Imported is}) = any unQualSpecOK is
unQualOK (GRE {gre_lcl = lcl, gre_imp = iss })
| lcl = True
| otherwise = any unQualSpecOK iss
pickGREs :: RdrName -> [GlobalRdrElt] -> [GlobalRdrElt]
-- ^ Take a list of GREs which have the right OccName
......@@ -593,7 +671,8 @@ pickGREs :: RdrName -> [GlobalRdrElt] -> [GlobalRdrElt]
-- The export of @f@ is ambiguous because it's in scope from the local def
-- and the import. The lookup of @Unqual f@ should return a GRE for
-- the locally-defined @f@, and a GRE for the imported @f@, with a /single/
-- provenance, namely the one for @Baz(f)@.
-- provenance, namely the one for @Baz(f)@, so that the "ambiguous occurrence"
-- message mentions the correct candidates
pickGREs rdr_name gres
= ASSERT2( isSrcRdrName rdr_name, ppr rdr_name )
mapMaybe pick gres
......@@ -602,28 +681,28 @@ pickGREs rdr_name gres
rdr_is_qual = isQual_maybe rdr_name
pick :: GlobalRdrElt -> Maybe GlobalRdrElt
pick gre@(GRE {gre_prov = LocalDef, gre_name = n}) -- Local def
| rdr_is_unqual = Just gre
| Just (mod,_) <- rdr_is_qual -- Qualified name
, Just n_mod <- nameModule_maybe n -- Binder is External
, mod == moduleName n_mod = Just gre
| otherwise = Nothing
pick gre@(GRE {gre_prov = Imported [is]}) -- Single import (efficiency)
| rdr_is_unqual,
not (is_qual (is_decl is)) = Just gre
| Just (mod,_) <- rdr_is_qual,
mod == is_as (is_decl is) = Just gre
| otherwise = Nothing
pick gre@(GRE {gre_prov = Imported is}) -- Multiple import
| null filtered_is = Nothing
| otherwise = Just (gre {gre_prov = Imported filtered_is})
pick gre@(GRE { gre_name = n, gre_lcl = lcl, gre_imp = iss })
| not lcl' && null iss'
= Nothing
| otherwise
= Just (gre { gre_lcl = lcl', gre_imp = iss' })
where
filtered_is | rdr_is_unqual
= filter (not . is_qual . is_decl) is
| Just (mod,_) <- rdr_is_qual
= filter ((== mod) . is_as . is_decl) is
| otherwise
= []
lcl' | not lcl = False
| rdr_is_unqual = True
| Just (mod,_) <- rdr_is_qual -- Qualified name
, Just n_mod <- nameModule_maybe n -- Binder is External
= mod == moduleName n_mod
| otherwise
= False
iss' | rdr_is_unqual
= filter (not . is_qual . is_decl) iss
| Just (mod,_) <- rdr_is_qual
= filter ((== mod) . is_as . is_decl) iss
| otherwise
= []
-- Building GlobalRdrEnvs
......@@ -649,9 +728,10 @@ insertGRE new_g (old_g : old_gs)
plusGRE :: GlobalRdrElt -> GlobalRdrElt -> GlobalRdrElt
-- Used when the gre_name fields match
plusGRE g1 g2
= GRE { gre_name = gre_name g1,
gre_prov = gre_prov g1 `plusProv` gre_prov g2,
gre_par = gre_par g1 `plusParent` gre_par g2 }
= GRE { gre_name = gre_name g1
, gre_lcl = gre_lcl g1 || gre_lcl g2
, gre_imp = gre_imp g1 ++ gre_imp g2
, gre_par = gre_par g1 `plusParent` gre_par g2 }
transformGREs :: (GlobalRdrElt -> GlobalRdrElt)
-> [OccName]
......@@ -718,7 +798,7 @@ There are two reasons for shadowing:
-}
shadowName :: GlobalRdrEnv -> Name -> GlobalRdrEnv
-- Remove certain old LocalDef GREs that share the same OccName as this new Name.
-- Remove certain old GREs that share the same OccName as this new Name.
-- See Note [GlobalRdrEnv shadowing] for details
shadowName env name
= alterOccEnv (fmap alter_fn) env (nameOccName name)
......@@ -727,21 +807,25 @@ shadowName env name
alter_fn gres = mapMaybe (shadow_with name) gres
shadow_with :: Name -> GlobalRdrElt -> Maybe GlobalRdrElt
shadow_with new_name old_gre@(GRE { gre_name = old_name, gre_prov = LocalDef })
shadow_with new_name
old_gre@(GRE { gre_name = old_name, gre_lcl = lcl, gre_imp = iss })
= case nameModule_maybe old_name of
Nothing -> Just old_gre
Nothing -> Just old_gre -- Old name is Internal; do not shadow
Just old_mod
| Just new_mod <- nameModule_maybe new_name
, new_mod == old_mod
, new_mod == old_mod -- Old name same as new name; shadow completely
-> Nothing
| null iss' -- Nothing remains
-> Nothing
| otherwise
-> Just (old_gre { gre_prov = Imported [mk_fake_imp_spec old_name old_mod] })
-> Just (old_gre { gre_lcl = False, gre_imp = iss' })
shadow_with new_name old_gre@(GRE { gre_prov = Imported imp_specs })
| null imp_specs' = Nothing
| otherwise = Just (old_gre { gre_prov = Imported imp_specs' })
where
imp_specs' = mapMaybe (shadow_is new_name) imp_specs
where
iss' = lcl_imp ++ mapMaybe (shadow_is new_name) iss
lcl_imp | lcl = [mk_fake_imp_spec old_name old_mod]
| otherwise = []
mk_fake_imp_spec old_name old_mod -- Urgh!
= ImpSpec id_spec ImpAll
......@@ -769,15 +853,8 @@ shadowName env name
************************************************************************
-}
-- | The 'Provenance' of something says how it came to be in scope.
-- | The 'ImportSpec' of something says how it came to be imported
-- It's quite elaborate so that we can give accurate unused-name warnings.
data Provenance
= LocalDef -- ^ The thing was defined locally
| Imported
[ImportSpec] -- ^ The thing was imported.
--
-- INVARIANT: the list of 'ImportSpec' is non-empty
data ImportSpec = ImpSpec { is_decl :: ImpDeclSpec,
is_item :: ImpItemSpec }
deriving( Eq, Ord )
......@@ -815,6 +892,19 @@ data ImpItemSpec
-- Here the constructors of @T@ are not named explicitly;
-- only @T@ is named explicitly.
instance Eq ImpDeclSpec where
p1 == p2 = case p1 `compare` p2 of EQ -> True; _ -> False
instance Ord ImpDeclSpec where
compare is1 is2 = (is_mod is1 `compare` is_mod is2) `thenCmp`
(is_dloc is1 `compare` is_dloc is2)
instance Eq ImpItemSpec where
p1 == p2 = case p1 `compare` p2 of EQ -> True; _ -> False
instance Ord ImpItemSpec where
compare is1 is2 = is_iloc is1 `compare` is_iloc is2
unQualSpecOK :: ImportSpec -> Bool
-- ^ Is in scope unqualified?
unQualSpecOK is = not (is_qual (is_decl is))
......@@ -834,55 +924,34 @@ isExplicitItem :: ImpItemSpec -> Bool
isExplicitItem ImpAll = False
isExplicitItem (ImpSome {is_explicit = exp}) = exp
{-
-- Note [Comparing provenance]
-- Comparison of provenance is just used for grouping
-- error messages (in RnEnv.warnUnusedBinds)
instance Eq Provenance where
p1 == p2 = case p1 `compare` p2 of EQ -> True; _ -> False
instance Eq ImpDeclSpec where
p1 == p2 = case p1 `compare` p2 of EQ -> True; _ -> False
instance Eq ImpItemSpec where
p1 == p2 = case p1 `compare` p2 of EQ -> True; _ -> False
instance Ord Provenance where
compare LocalDef LocalDef = EQ
compare LocalDef (Imported _) = LT
compare (Imported _ ) LocalDef = GT
compare (Imported is1) (Imported is2) = compare (head is1)
{- See Note [Comparing provenance] -} (head is2)
instance Ord ImpDeclSpec where
compare is1 is2 = (is_mod is1 `compare` is_mod is2) `thenCmp`
(is_dloc is1 `compare` is_dloc is2)
instance Ord ImpItemSpec where
compare is1 is2 = is_iloc is1 `compare` is_iloc is2
plusProv :: Provenance -> Provenance -> Provenance
-- Choose LocalDef over Imported
-- There is an obscure bug lurking here; in the presence
-- of recursive modules, something can be imported *and* locally
-- defined, and one might refer to it with a qualified name from
-- the import -- but I'm going to ignore that because it makes
-- the isLocalGRE predicate so much nicer this way
plusProv LocalDef LocalDef = panic "plusProv"
plusProv LocalDef _ = LocalDef
plusProv _ LocalDef = LocalDef
plusProv (Imported is1) (Imported is2) = Imported (is1++is2)
compare (Prov l1 i1) (Prov l2 i2)
= (l1 `compare` l2) `thenCmp` (i1 `cmp_is` i2)
where -- See Note [Comparing provenance]
[] `cmp_is` [] = EQ
[] `cmp_is` _ = LT
(_:_) `cmp_is` [] = GT
(i1:_) `cmp_is` (i2:_) = i1 `compare` i2
-}
pprNameProvenance :: GlobalRdrElt -> SDoc
-- ^ Print out the place where the name was imported
pprNameProvenance (GRE {gre_name = name, gre_prov = LocalDef})
= ptext (sLit "defined at") <+> ppr (nameSrcLoc name)
pprNameProvenance (GRE {gre_name = name, gre_prov = Imported whys})
= case whys of
(why:_) | opt_PprStyle_Debug -> vcat (map pp_why whys)
| otherwise -> pp_why why
[] -> panic "pprNameProvenance"
-- ^ Print out one place where the name was define/imported
-- (With -dppr-debug, print them all)
pprNameProvenance (GRE { gre_name = name, gre_lcl = lcl, gre_imp = iss })
| opt_PprStyle_Debug = vcat pp_provs
| otherwise = head pp_provs
where
pp_why why = sep [ppr why, ppr_defn_site why name]
pp_provs = pp_lcl ++ map pp_is iss
pp_lcl = if lcl then [ptext (sLit "defined at") <+> ppr (nameSrcLoc name)]
else []
pp_is is = sep [ppr is, ppr_defn_site is name]
-- If we know the exact definition point (which we may do with GHCi)
-- then show that too. But not if it's just "imported from X".
......
......@@ -258,7 +258,7 @@ loadModule doc mod
Succeeded iface -> return $ mkGlobalRdrEnv . gresFromAvails prov . mi_exports $ iface
} }
where
prov = Imported [ImpSpec { is_decl = imp_spec, is_item = ImpAll }]
prov = Just (ImpSpec { is_decl = imp_spec, is_item = ImpAll })
imp_spec = ImpDeclSpec { is_mod = name, is_qual = True,
is_dloc = wiredInSrcSpan, is_as = name }
name = moduleName mod
......
......@@ -73,9 +73,11 @@ newGlobalBinder :: Module -> OccName -> SrcSpan -> TcRnIf a b Name
newGlobalBinder mod occ loc
= do { mod `seq` occ `seq` return () -- See notes with lookupOrig
-- ; traceIf (text "newGlobalBinder" <+> ppr mod <+> ppr occ <+> ppr loc)
; updNameCacheTcRn $ \name_cache ->
allocateGlobalBinder name_cache mod occ loc }
; name <- updNameCacheTcRn $ \name_cache ->
allocateGlobalBinder name_cache mod occ loc
; traceIf (text "newGlobalBinder" <+>
(vcat [ ppr mod <+> ppr occ <+> ppr loc, ppr name]))
; return name }
newInteractiveBinder :: HscEnv -> OccName -> SrcSpan -> IO Name
-- Works in the IO monad, and gets the Module
......
......@@ -27,7 +27,7 @@ import SrcLoc ( noSrcSpan )
import Finder ( findImportedModule, cannotFindModule )
import TcRnMonad ( initTcInteractive, initIfaceTcRn )
import LoadIface ( loadPluginInterface )
import RdrName ( RdrName, Provenance(..), ImportSpec(..), ImpDeclSpec(..)
import RdrName ( RdrName, ImportSpec(..), ImpDeclSpec(..)
, ImpItemSpec(..), mkGlobalRdrEnv, lookupGRE_RdrName
, gre_name, mkRdrQual )
import OccName ( mkVarOcc )
......@@ -221,8 +221,8 @@ lookupRdrNameInModuleForPlugins hsc_env mod_name rdr_name = do
-- Try and find the required name in the exports
let decl_spec = ImpDeclSpec { is_mod = mod_name, is_as = mod_name
, is_qual = False, is_dloc = noSrcSpan }
provenance = Imported [ImpSpec decl_spec ImpAll]
env = mkGlobalRdrEnv (gresFromAvails provenance (mi_exports iface))
imp_spec = ImpSpec decl_spec ImpAll
env = mkGlobalRdrEnv (gresFromAvails (Just imp_spec) (mi_exports iface))
case lookupGRE_RdrName rdr_name env of
[gre] -> return (Just (gre_name gre))
[] -> return Nothing
......
......@@ -1575,7 +1575,7 @@ mkPrintUnqualified dflags env = QueryQualify qual_name
-- the right one, then we can use the unqualified name
| [gre] <- qual_gres
= NameQual (get_qual_mod (gre_prov gre))
= NameQual (greQualModName gre)
| null qual_gres
= if null (lookupGRE_RdrName (mkRdrQual (moduleName mod) occ) env)
......@@ -1591,9 +1591,6 @@ mkPrintUnqualified dflags env = QueryQualify qual_name
unqual_gres = lookupGRE_RdrName (mkRdrUnqual occ) env
qual_gres = filter right_name (lookupGlobalRdrEnv env occ)
get_qual_mod LocalDef = moduleName mod
get_qual_mod (Imported is) = ASSERT( not (null is) ) is_as (is_decl (head is))
-- we can mention a module P:M without the P: qualifier iff
-- "import M" would resolve unambiguously to P:M. (if P is the
-- current package we can just assume it is unqualified).
......
......@@ -895,11 +895,11 @@ findGlobalRdrEnv hsc_env imports
availsToGlobalRdrEnv :: ModuleName -> [AvailInfo] -> GlobalRdrEnv
availsToGlobalRdrEnv mod_name avails
= mkGlobalRdrEnv (gresFromAvails imp_prov avails)
= mkGlobalRdrEnv (gresFromAvails (Just imp_spec) avails)
where
-- We're building a GlobalRdrEnv as if the user imported
-- all the specified modules into the global interactive module
imp_prov = Imported [ImpSpec { is_decl = decl, is_item = ImpAll}]
imp_spec = ImpSpec { is_decl = decl, is_item = ImpAll}
decl = ImpDeclSpec { is_mod = mod_name, is_as = mod_name,
is_qual = False,
is_dloc = srcLocSpan interactiveSrcLoc }
......@@ -972,24 +972,10 @@ getRdrNamesInScope = withSession $ \hsc_env -> do
let
ic = hsc_IC hsc_env
gbl_rdrenv = ic_rn_gbl_env ic
gbl_names = concatMap greToRdrNames $ globalRdrEnvElts gbl_rdrenv
gbl_names = concatMap greRdrNames $ globalRdrEnvElts gbl_rdrenv
return gbl_names
-- ToDo: move to RdrName
greToRdrNames :: GlobalRdrElt -> [RdrName]
greToRdrNames GRE{ gre_name = name, gre_prov = prov }
= case prov of
LocalDef -> [unqual]
Imported specs -> concat (map do_spec (map is_decl specs))
where
occ = nameOccName name
unqual = Unqual occ
do_spec decl_spec
| is_qual decl_spec = [qual]
| otherwise = [unqual,qual]
where qual = Qual (is_as decl_spec) occ
-- | Parses a string as an identifier, and returns the list of 'Name's that
-- the identifier can refer to in the current interactive context.
parseName :: GhcMonad m => String -> m [Name]
......
......@@ -21,7 +21,6 @@ module RnEnv (
lookupFixityRn, lookupTyFixityRn,
lookupInstDeclBndr, lookupSubBndrOcc, lookupFamInstName,
greRdrName,
lookupSubBndrGREs, lookupConstructorFields,
lookupSyntaxName, lookupSyntaxNames, lookupIfThenElse,
lookupGreAvailRn,
......@@ -228,6 +227,7 @@ newTopSrcBinder (L loc rdr_name)
Nothing ->
-- Normal case
do { this_mod <- getModule
; traceRn (text "newTopSrcBinder" <+> (ppr this_mod $$ ppr rdr_name $$ ppr loc))
; newGlobalBinder this_mod (rdrNameOcc rdr_name) loc } }
{-
......@@ -490,26 +490,7 @@ lookupSubBndrOcc warnIfDeprec parent doc rdr_name
-- Note [Usage for sub-bndrs]
used_rdr_name gre
| isQual rdr_name = rdr_name
| otherwise = greRdrName gre
greRdrName :: GlobalRdrElt -> RdrName
greRdrName gre
= case gre_prov gre of
LocalDef -> unqual_rdr
Imported is -> used_rdr_name_from_is is
where
occ = nameOccName (gre_name gre)
unqual_rdr = mkRdrUnqual occ
used_rdr_name_from_is imp_specs -- rdr_name is unqualified
| not (all (is_qual . is_decl) imp_specs)
= unqual_rdr -- An unqualified import is available
| otherwise
= -- Only qualified imports available, so make up
-- a suitable qualifed name from the first imp_spec
ASSERT( not (null imp_specs) )
mkRdrQual (is_as (is_decl (head imp_specs))) occ
| otherwise = greUsedRdrName gre
lookupSubBndrGREs :: GlobalRdrEnv -> Parent -> RdrName -> [GlobalRdrElt]
-- If Parent = NoParent, just do a normal lookup
......@@ -912,13 +893,14 @@ Note [Handling of deprecations]
addUsedRdrName :: Bool -> GlobalRdrElt -> RdrName -> RnM ()
-- Record usage of imported RdrNames
addUsedRdrName warnIfDeprec gre rdr
| isLocalGRE gre = return () -- No call to warnIfDeprecated
-- See Note [Handling of deprecations]
| otherwise = do { env <- getGblEnv
; when warnIfDeprec $ warnIfDeprecated gre
; updMutVar (tcg_used_rdrnames env)
(\s -> Set.insert rdr s) }
addUsedRdrName warn_if_deprec gre rdr
= do { unless (isLocalGRE gre) $
do { env <- getGblEnv
; updMutVar (tcg_used_rdrnames env)
(\s -> Set.insert rdr s) }
; when warn_if_deprec $
warnIfDeprecated gre }
addUsedRdrNames :: [RdrName] -> RnM ()
-- Record used sub-binders
......@@ -931,29 +913,34 @@ addUsedRdrNames rdrs
(\s -> foldr Set.insert s rdrs) }
warnIfDeprecated :: GlobalRdrElt -> RnM ()
warnIfDeprecated gre@(GRE { gre_name = name, gre_prov = Imported (imp_spec : _) })
warnIfDeprecated gre@(GRE { gre_name = name, gre_imp = iss })
| (imp_spec : _) <- iss
= do { dflags <- getDynFlags
; when (wopt Opt_WarnWarningsDeprecations dflags) $
; this_mod <- getModule
; when (wopt Opt_WarnWarningsDeprecations dflags &&
not (nameIsLocalOrFrom this_mod name)) $
-- See Note [Handling of deprecations]
do { iface <- loadInterfaceForName doc name
; case lookupImpDeprec iface gre of
Just txt -> addWarn (mk_msg txt)
Just txt -> addWarn (mk_msg imp_spec txt)
Nothing -> return () } }
| otherwise
= return ()
where
mk_msg txt = sep [ sep [ ptext (sLit "In the use of")
<+> pprNonVarNameSpace (occNameSpace (nameOccName name))
<+> quotes (ppr name)
, parens imp_msg <> colon ]
, ppr txt ]
name_mod = ASSERT2( isExternalName name, ppr name ) nameModule name
imp_mod = importSpecModule imp_spec
imp_msg = ptext (sLit "imported from") <+> ppr imp_mod <> extra
extra | imp_mod == moduleName name_mod = Outputable.empty
| otherwise = ptext (sLit ", but defined in") <+> ppr name_mod
doc = ptext (sLit "The name") <+> quotes (ppr name) <+> ptext (sLit "is mentioned explicitly")
warnIfDeprecated _ = return () -- No deprecations for things defined locally
mk_msg imp_spec txt
= sep [ sep [ ptext (sLit "In the use of")
<+> pprNonVarNameSpace (occNameSpace (nameOccName name))
<+> quotes (ppr name)
, parens imp_msg <> colon ]
, ppr txt ]
where
imp_mod = importSpecModule imp_spec
imp_msg = ptext (sLit "imported from") <+> ppr imp_mod <> extra
extra | imp_mod == moduleName name_mod = Outputable.empty
| otherwise = ptext (sLit ", but defined in") <+> ppr name_mod