%
+% (c) The University of Glasgow 2006
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
-\section[RdrName]{@RdrName@}
-
\begin{code}
module RdrName (
RdrName(..), -- Constructors exported only to BinIface
-- LocalRdrEnv
LocalRdrEnv, emptyLocalRdrEnv, extendLocalRdrEnv,
- lookupLocalRdrEnv, elemLocalRdrEnv,
+ lookupLocalRdrEnv, lookupLocalRdrOcc, elemLocalRdrEnv,
-- GlobalRdrEnv
GlobalRdrEnv, emptyGlobalRdrEnv, mkGlobalRdrEnv, plusGlobalRdrEnv,
lookupGlobalRdrEnv, extendGlobalRdrEnv,
pprGlobalRdrEnv, globalRdrEnvElts,
- lookupGRE_RdrName, lookupGRE_Name, hideSomeUnquals,
+ lookupGRE_RdrName, lookupGRE_Name, getGRE_NameQualifier_maybes,
+ hideSomeUnquals, findLocalDupsRdrEnv,
-- GlobalRdrElt, Provenance, ImportSpec
- GlobalRdrElt(..), isLocalGRE, unQualOK,
+ GlobalRdrElt(..), isLocalGRE, unQualOK, qualSpecOK, unQualSpecOK,
Provenance(..), pprNameProvenance,
+ Parent(..),
ImportSpec(..), ImpDeclSpec(..), ImpItemSpec(..),
- importSpecLoc, importSpecModule
+ importSpecLoc, importSpecModule, isExplicitItem
) where
#include "HsVersions.h"
-import OccName
-import Module ( ModuleName, mkModuleNameFS, Module, moduleName )
-import Name ( Name, NamedThing(getName), nameModule, nameParent_maybe,
- nameOccName, isExternalName, nameSrcLoc )
-import Maybes ( mapCatMaybes )
-import SrcLoc ( isGoodSrcLoc, isGoodSrcSpan, srcLocSpan, SrcSpan )
-import FastString ( FastString )
+import Module
+import Name
+import Maybes
+import SrcLoc
+import FastString
import Outputable
-import Util ( thenCmp )
+import Util
\end{code}
%************************************************************************
\end{code}
\begin{code}
+isRdrDataCon :: RdrName -> Bool
+isRdrTyVar :: RdrName -> Bool
+isRdrTc :: RdrName -> Bool
+
isRdrDataCon rn = isDataOcc (rdrNameOcc rn)
isRdrTyVar rn = isTvOcc (rdrNameOcc rn)
isRdrTc rn = isTcOcc (rdrNameOcc rn)
+isSrcRdrName :: RdrName -> Bool
isSrcRdrName (Unqual _) = True
isSrcRdrName (Qual _ _) = True
isSrcRdrName _ = False
+isUnqual :: RdrName -> Bool
isUnqual (Unqual _) = True
-isUnqual other = False
+isUnqual _ = False
+isQual :: RdrName -> Bool
isQual (Qual _ _) = True
isQual _ = False
+isQual_maybe :: RdrName -> Maybe (ModuleName, OccName)
isQual_maybe (Qual m n) = Just (m,n)
isQual_maybe _ = Nothing
+isOrig :: RdrName -> Bool
isOrig (Orig _ _) = True
isOrig _ = False
+isOrig_maybe :: RdrName -> Maybe (Module, OccName)
isOrig_maybe (Orig m n) = Just (m,n)
isOrig_maybe _ = Nothing
+isExact :: RdrName -> Bool
isExact (Exact _) = True
-isExact other = False
+isExact _ = False
+isExact_maybe :: RdrName -> Maybe Name
isExact_maybe (Exact n) = Just n
-isExact_maybe other = Nothing
+isExact_maybe _ = Nothing
\end{code}
(Orig m1 o1) == (Orig m2 o2) = m1==m2 && o1==o2
(Qual m1 o1) == (Qual m2 o2) = m1==m2 && o1==o2
(Unqual o1) == (Unqual o2) = o1==o2
- r1 == r2 = False
+ _ == _ = False
instance Ord RdrName where
a <= b = case (a `compare` b) of { LT -> True; EQ -> True; GT -> False }
-- <decl involving n1,n2> }
-- I think we can do without this conversion
compare (Exact n1) (Exact n2) = n1 `compare` n2
- compare (Exact n1) n2 = LT
+ compare (Exact _) _ = LT
compare (Unqual _) (Exact _) = GT
compare (Unqual o1) (Unqual o2) = o1 `compare` o2
\begin{code}
type LocalRdrEnv = OccEnv Name
+emptyLocalRdrEnv :: LocalRdrEnv
emptyLocalRdrEnv = emptyOccEnv
extendLocalRdrEnv :: LocalRdrEnv -> [Name] -> LocalRdrEnv
= extendOccEnvList env [(nameOccName n, n) | n <- names]
lookupLocalRdrEnv :: LocalRdrEnv -> RdrName -> Maybe Name
-lookupLocalRdrEnv env (Exact name) = Just name
+lookupLocalRdrEnv _ (Exact name) = Just name
lookupLocalRdrEnv env (Unqual occ) = lookupOccEnv env occ
-lookupLocalRdrEnv env other = Nothing
+lookupLocalRdrEnv _ _ = Nothing
+
+lookupLocalRdrOcc :: LocalRdrEnv -> OccName -> Maybe Name
+lookupLocalRdrOcc env occ = lookupOccEnv env occ
elemLocalRdrEnv :: RdrName -> LocalRdrEnv -> Bool
elemLocalRdrEnv rdr_name env
-- INVARIANT: All the members of the list have distinct
-- gre_name fields; that is, no duplicate Names
+data GlobalRdrElt
+ = GRE { gre_name :: Name,
+ gre_par :: Parent,
+ gre_prov :: Provenance -- Why it's in scope
+ }
+
+data Parent = NoParent | ParentIs Name
+ deriving (Eq)
+
+instance Outputable Parent where
+ ppr NoParent = empty
+ ppr (ParentIs n) = ptext (sLit "parent:") <> ppr n
+
+
+plusParent :: Parent -> Parent -> Parent
+plusParent p1 p2 = ASSERT2( p1 == p2, parens (ppr p1) <+> parens (ppr p2) )
+ p1
+
+{- Why so complicated? -=chak
+plusParent :: Parent -> Parent -> Parent
+plusParent NoParent rel =
+ ASSERT2( case rel of { NoParent -> True; other -> False },
+ ptext (sLit "plusParent[NoParent]: ") <+> ppr rel )
+ NoParent
+plusParent (ParentIs n) rel =
+ ASSERT2( case rel of { ParentIs m -> n==m; other -> False },
+ ptext (sLit "plusParent[ParentIs]:") <+> ppr n <> comma <+> ppr rel )
+ ParentIs n
+ -}
+
+emptyGlobalRdrEnv :: GlobalRdrEnv
emptyGlobalRdrEnv = emptyOccEnv
globalRdrEnvElts :: GlobalRdrEnv -> [GlobalRdrElt]
globalRdrEnvElts env = foldOccEnv (++) [] env
-data GlobalRdrElt
- = GRE { gre_name :: Name,
- gre_prov :: Provenance -- Why it's in scope
- }
-
instance Outputable GlobalRdrElt where
- ppr gre = ppr name <+> pp_parent (nameParent_maybe name)
- <+> parens (pprNameProvenance gre)
+ ppr gre = ppr name <+> parens (ppr (gre_par gre) <+> pprNameProvenance gre)
where
name = gre_name gre
- pp_parent (Just p) = brackets (text "parent:" <+> ppr p)
- pp_parent Nothing = empty
pprGlobalRdrEnv :: GlobalRdrEnv -> SDoc
pprGlobalRdrEnv env
\begin{code}
lookupGlobalRdrEnv :: GlobalRdrEnv -> OccName -> [GlobalRdrElt]
-lookupGlobalRdrEnv env rdr_name = case lookupOccEnv env rdr_name of
+lookupGlobalRdrEnv env occ_name = case lookupOccEnv env occ_name of
Nothing -> []
Just gres -> gres
= [ gre | gre <- lookupGlobalRdrEnv env (nameOccName name),
gre_name gre == name ]
+getGRE_NameQualifier_maybes :: GlobalRdrEnv -> Name -> [Maybe [ModuleName]]
+getGRE_NameQualifier_maybes env
+ = map qualifier_maybe . map gre_prov . lookupGRE_Name env
+ where qualifier_maybe LocalDef = Nothing
+ qualifier_maybe (Imported iss) = Just $ map (is_as . is_decl) iss
pickGREs :: RdrName -> [GlobalRdrElt] -> [GlobalRdrElt]
-- Take a list of GREs which have the right OccName
isLocalGRE :: GlobalRdrElt -> Bool
isLocalGRE (GRE {gre_prov = LocalDef}) = True
-isLocalGRE other = False
+isLocalGRE _ = False
unQualOK :: GlobalRdrElt -> Bool
-- An unqualifed version of this thing is in scope
unQualOK (GRE {gre_prov = LocalDef}) = True
-unQualOK (GRE {gre_prov = Imported is}) = not (all (is_qual . is_decl) is)
+unQualOK (GRE {gre_prov = Imported is}) = any unQualSpecOK is
+
+unQualSpecOK :: ImportSpec -> Bool
+-- In scope unqualified
+unQualSpecOK is = not (is_qual (is_decl is))
+
+qualSpecOK :: ModuleName -> ImportSpec -> Bool
+-- In scope qualified with M
+qualSpecOK mod is = mod == is_as (is_decl is)
plusGlobalRdrEnv :: GlobalRdrEnv -> GlobalRdrEnv -> GlobalRdrEnv
plusGlobalRdrEnv env1 env2 = plusOccEnv_C (foldr insertGRE) env1 env2
(nameOccName (gre_name gre))
[gre]
+findLocalDupsRdrEnv :: GlobalRdrEnv -> [OccName] -> (GlobalRdrEnv, [[Name]])
+-- For each OccName, see if there are multiple LocalDef definitions
+-- for it. If so, remove all but one (to suppress subsequent error messages)
+-- and return a list of the duplicate bindings
+findLocalDupsRdrEnv rdr_env occs
+ = go rdr_env [] occs
+ where
+ go rdr_env dups [] = (rdr_env, dups)
+ go rdr_env dups (occ:occs)
+ = case filter isLocalGRE gres of
+ [] -> WARN( True, ppr occ <+> ppr rdr_env )
+ go rdr_env dups occs -- Weird! No binding for occ
+ [_] -> go rdr_env dups occs -- The common case
+ dup_gres -> go (extendOccEnv rdr_env occ (head dup_gres : nonlocal_gres))
+ (map gre_name dup_gres : dups)
+ occs
+ where
+ gres = lookupOccEnv rdr_env occ `orElse` []
+ nonlocal_gres = filterOut isLocalGRE gres
+
+
insertGRE :: GlobalRdrElt -> [GlobalRdrElt] -> [GlobalRdrElt]
insertGRE new_g [] = [new_g]
insertGRE new_g (old_g : old_gs)
-- 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_prov = gre_prov g1 `plusProv` gre_prov g2,
+ gre_par = gre_par g1 `plusParent` gre_par g2 }
hideSomeUnquals :: GlobalRdrEnv -> [OccName] -> GlobalRdrEnv
-- Hide any unqualified bindings for the specified OccNames
| Just gres <- lookupOccEnv env occ = extendOccEnv env occ (map qual_gre gres)
| otherwise = env
qual_gre gre@(GRE { gre_name = name, gre_prov = LocalDef })
- = GRE { gre_name = name, gre_prov = Imported [imp_spec] }
+ = gre { gre_prov = Imported [imp_spec] }
where -- Local defs get transfomed to (fake) imported things
mod = moduleName (nameModule name)
imp_spec = ImpSpec { is_item = ImpAll, is_decl = decl_spec }
importSpecModule :: ImportSpec -> ModuleName
importSpecModule is = is_mod (is_decl is)
+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)
-- 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 p2 = LocalDef
-plusProv p1 LocalDef = LocalDef
+plusProv LocalDef LocalDef = panic "plusProv"
+plusProv LocalDef _ = LocalDef
+plusProv _ LocalDef = LocalDef
plusProv (Imported is1) (Imported is2) = Imported (is1++is2)
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)
+ = ptext (sLit "defined at") <+> ppr (nameSrcLoc name)
pprNameProvenance (GRE {gre_name = name, gre_prov = Imported whys})
= case whys of
- (why:whys) -> sep [ppr why, nest 2 (ppr_defn (nameSrcLoc name))]
+ (why:_) -> sep [ppr why, nest 2 (ppr_defn (nameSrcLoc name))]
[] -> panic "pprNameProvenance"
-- 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".
-ppr_defn loc | isGoodSrcLoc loc = parens (ptext SLIT("defined at") <+> ppr loc)
+ppr_defn :: SrcLoc -> SDoc
+ppr_defn loc | isGoodSrcLoc loc = parens (ptext (sLit "defined at") <+> ppr loc)
| otherwise = empty
instance Outputable ImportSpec where
ppr imp_spec
- = ptext SLIT("imported from") <+> ppr (importSpecModule imp_spec)
- <+> if isGoodSrcSpan loc then ptext SLIT("at") <+> ppr loc
+ = ptext (sLit "imported from") <+> ppr (importSpecModule imp_spec)
+ <+> if isGoodSrcSpan loc then ptext (sLit "at") <+> ppr loc
else empty
where
loc = importSpecLoc imp_spec
projects / ghc-hetmet.git / blobdiff