#include "HsVersions.h"
-import OccName ( NameSpace, varName,
- OccName, UserFS,
- setOccNameSpace,
- mkOccFS, occNameFlavour,
- isDataOcc, isTvOcc, isTcOcc,
- OccEnv, emptyOccEnv, extendOccEnvList, lookupOccEnv,
- elemOccEnv, plusOccEnv_C, extendOccEnv_C, foldOccEnv,
- occEnvElts
- )
+import OccName
import Module ( Module, mkModuleFS )
import Name ( Name, NamedThing(getName), nameModule, nameParent_maybe,
nameOccName, isExternalName, nameSrcLoc )
+import Maybes ( mapCatMaybes )
import SrcLoc ( isGoodSrcLoc, SrcSpan )
+import FastString ( FastString )
import Outputable
import Util ( thenCmp )
\end{code}
-
%************************************************************************
%* *
\subsection{The main data type}
---------------
-- These two are used when parsing source files
-- They do encode the module and occurrence names
-mkUnqual :: NameSpace -> UserFS -> RdrName
-mkUnqual sp n = Unqual (mkOccFS sp n)
+mkUnqual :: NameSpace -> FastString -> RdrName
+mkUnqual sp n = Unqual (mkOccNameFS sp n)
-mkVarUnqual :: UserFS -> RdrName
-mkVarUnqual n = Unqual (mkOccFS varName n)
+mkVarUnqual :: FastString -> RdrName
+mkVarUnqual n = Unqual (mkVarOccFS n)
-mkQual :: NameSpace -> (UserFS, UserFS) -> RdrName
-mkQual sp (m, n) = Qual (mkModuleFS m) (mkOccFS sp n)
+mkQual :: NameSpace -> (FastString, FastString) -> RdrName
+mkQual sp (m, n) = Qual (mkModuleFS m) (mkOccNameFS sp n)
getRdrName :: NamedThing thing => thing -> RdrName
getRdrName name = nameRdrName (getName name)
ppr (Qual mod occ) = ppr mod <> dot <> ppr occ <+> ppr_name_space occ
ppr (Orig mod occ) = ppr mod <> dot <> ppr occ <+> ppr_name_space occ
-ppr_name_space occ = ifPprDebug (parens (occNameFlavour occ))
+ppr_name_space occ = ifPprDebug (parens (pprNonVarNameSpace (occNameSpace occ)))
instance OutputableBndr RdrName where
pprBndr _ n
lookupGRE_RdrName :: RdrName -> GlobalRdrEnv -> [GlobalRdrElt]
lookupGRE_RdrName rdr_name env
- = case lookupOccEnv env occ of
- Nothing -> []
- Just gres | isUnqual rdr_name -> filter unQualOK gres
- | otherwise -> filter (hasQual mod) gres
- where
- mod = rdrNameModule rdr_name
- occ = rdrNameOcc rdr_name
+ = case lookupOccEnv env (rdrNameOcc rdr_name) of
+ Nothing -> []
+ Just gres -> pickGREs rdr_name gres
lookupGRE_Name :: GlobalRdrEnv -> Name -> [GlobalRdrElt]
lookupGRE_Name env name
gre_name gre == name ]
+pickGREs :: RdrName -> [GlobalRdrElt] -> [GlobalRdrElt]
+-- Take a list of GREs which have the right OccName
+-- Pick those GREs that are suitable for this RdrName
+-- And for those, keep only only the Provenances that are suitable
+--
+-- Consider
+-- module A ( f ) where
+-- import qualified Foo( f )
+-- import Baz( f )
+-- f = undefined
+-- Let's suppose that Foo.f and Baz.f are the same entity really.
+-- 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).
+pickGREs rdr_name gres
+ = mapCatMaybes pick gres
+ where
+ is_unqual = isUnqual rdr_name
+ mod = rdrNameModule rdr_name
+
+ pick :: GlobalRdrElt -> Maybe GlobalRdrElt
+ pick gre@(GRE {gre_prov = LocalDef, gre_name = n}) -- Local def
+ | is_unqual || nameModule n == mod = Just gre
+ | otherwise = Nothing
+ pick gre@(GRE {gre_prov = Imported [is]}) -- Single import (efficiency)
+ | is_unqual = if not (is_qual (is_decl is)) then Just gre
+ else Nothing
+ | otherwise = if mod == is_as (is_decl is) then Just gre
+ else Nothing
+ pick gre@(GRE {gre_prov = Imported is}) -- Multiple import
+ | null filtered_is = Nothing
+ | otherwise = Just (gre {gre_prov = Imported filtered_is})
+ where
+ filtered_is | is_unqual = filter (not . is_qual . is_decl) is
+ | otherwise = filter ((== mod) . is_as . is_decl) is
+
isLocalGRE :: GlobalRdrElt -> Bool
-isLocalGRE (GRE {gre_prov = LocalDef _}) = True
-isLocalGRE other = False
+isLocalGRE (GRE {gre_prov = LocalDef}) = True
+isLocalGRE other = False
unQualOK :: GlobalRdrElt -> Bool
-- An unqualifed version of this thing is in scope
-unQualOK (GRE {gre_prov = LocalDef _}) = True
+unQualOK (GRE {gre_prov = LocalDef}) = True
unQualOK (GRE {gre_prov = Imported is}) = not (all (is_qual . is_decl) is)
-hasQual :: Module -> GlobalRdrElt -> Bool
--- A qualified version of this thing is in scope
-hasQual mod (GRE {gre_prov = LocalDef m}) = m == mod
-hasQual mod (GRE {gre_prov = Imported is}) = any ((== mod) . is_as . is_decl) is
-
plusGlobalRdrEnv :: GlobalRdrEnv -> GlobalRdrEnv -> GlobalRdrEnv
plusGlobalRdrEnv env1 env2 = plusOccEnv_C (foldr insertGRE) env1 env2
\begin{code}
data Provenance
= LocalDef -- Defined locally
- Module
-
- | Imported -- Imported
+ | Imported -- Imported
[ImportSpec] -- INVARIANT: non-empty
data ImportSpec = ImpSpec { is_decl :: ImpDeclSpec,
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 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)
-- 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 m1) (LocalDef m2) = pprPanic "plusProv" (ppr m1 <+> ppr m2)
-plusProv p1@(LocalDef _) p2 = p1
-plusProv p1 p2@(LocalDef _) = p2
+plusProv LocalDef LocalDef = panic "plusProv"
+plusProv LocalDef p2 = LocalDef
+plusProv p1 LocalDef = LocalDef
plusProv (Imported is1) (Imported is2) = Imported (is1++is2)
pprNameProvenance :: GlobalRdrElt -> SDoc
-pprNameProvenance (GRE {gre_name = name, gre_prov = LocalDef _})
+-- 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 (why:whys)})
= sep [ppr why, nest 2 (ppr_defn (nameSrcLoc name))]
projects / ghc-hetmet.git / blobdiff