X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FbasicTypes%2FRdrName.lhs;h=030aa1f609aa83d31d32811f110be05d66dd4fe3;hb=9d7da331989abcd1844e9d03b8d1e4163796fa85;hp=2dca6a001a6948c79dc2148325bd33f4c4791aed;hpb=853e20a3eb86137cdb8accf69c6caa9db83a3d34;p=ghc-hetmet.git diff --git a/ghc/compiler/basicTypes/RdrName.lhs b/ghc/compiler/basicTypes/RdrName.lhs index 2dca6a0..030aa1f 100644 --- a/ghc/compiler/basicTypes/RdrName.lhs +++ b/ghc/compiler/basicTypes/RdrName.lhs @@ -27,35 +27,30 @@ module RdrName ( -- GlobalRdrEnv GlobalRdrEnv, emptyGlobalRdrEnv, mkGlobalRdrEnv, plusGlobalRdrEnv, - lookupGlobalRdrEnv, pprGlobalRdrEnv, globalRdrEnvElts, + lookupGlobalRdrEnv, extendGlobalRdrEnv, + pprGlobalRdrEnv, globalRdrEnvElts, lookupGRE_RdrName, lookupGRE_Name, -- GlobalRdrElt, Provenance, ImportSpec - GlobalRdrElt(..), Provenance(..), ImportSpec(..), - isLocalGRE, unQualOK, - pprNameProvenance + GlobalRdrElt(..), isLocalGRE, unQualOK, + Provenance(..), pprNameProvenance, + ImportSpec(..), ImpDeclSpec(..), ImpItemSpec(..), + importSpecLoc, importSpecModule ) where #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} @@ -144,14 +139,14 @@ mkDerivedRdrName parent mk_occ --------------- -- 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) @@ -210,7 +205,7 @@ instance Outputable RdrName where 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 @@ -343,15 +338,17 @@ lookupGlobalRdrEnv env rdr_name = case lookupOccEnv env rdr_name of Nothing -> [] Just gres -> gres +extendGlobalRdrEnv :: GlobalRdrEnv -> GlobalRdrElt -> GlobalRdrEnv +extendGlobalRdrEnv env gre = extendOccEnv_C add env occ [gre] + where + occ = nameOccName (gre_name gre) + add gres _ = gre:gres + 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 @@ -359,19 +356,51 @@ 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 = Imported is _}) = not (all is_qual 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 +unQualOK (GRE {gre_prov = LocalDef}) = True +unQualOK (GRE {gre_prov = Imported is}) = not (all (is_qual . is_decl) is) plusGlobalRdrEnv :: GlobalRdrEnv -> GlobalRdrEnv -> GlobalRdrEnv plusGlobalRdrEnv env1 env2 = plusOccEnv_C (foldr insertGRE) env1 env2 @@ -407,52 +436,76 @@ plusGRE g1 g2 %************************************************************************ The "provenance" of something says how it came to be in scope. +It's quite elaborate so that we can give accurate unused-name warnings. \begin{code} data Provenance = LocalDef -- Defined locally - Module - | Imported -- Imported [ImportSpec] -- INVARIANT: non-empty - Bool -- True iff the thing was named *explicitly* - -- in *any* of the import specs rather than being - -- imported as part of a group; - -- e.g. - -- import B - -- import C( T(..) ) - -- Here, everything imported by B, and the constructors of T - -- are not named explicitly; only T is named explicitly. - -- This info is used when warning of unused names. - -data ImportSpec -- Describes a particular import declaration - -- Shared among all the Provenaces for a particular - -- import declaration - = ImportSpec { - is_mod :: Module, -- 'import Muggle' - -- Note the Muggle may well not be - -- the defining module for this thing! - is_as :: Module, -- 'as M' (or 'Muggle' if there is no 'as' clause) - is_qual :: Bool, -- True <=> qualified (only) - is_loc :: SrcSpan } -- Location of import statment +data ImportSpec = ImpSpec { is_decl :: ImpDeclSpec, + is_item :: ImpItemSpec } + deriving( Eq, Ord ) + +data ImpDeclSpec -- Describes a particular import declaration + -- Shared among all the Provenaces for that decl + = ImpDeclSpec { + is_mod :: Module, -- 'import Muggle' + -- Note the Muggle may well not be + -- the defining module for this thing! + is_as :: Module, -- 'as M' (or 'Muggle' if there is no 'as' clause) + is_qual :: Bool, -- True <=> qualified (only) + is_dloc :: SrcSpan -- Location of import declaration + } + +data ImpItemSpec -- Describes import info a particular Name + = ImpAll -- The import had no import list, + -- or had a hiding list + + | ImpSome { -- The import had an import list + is_explicit :: Bool, + is_iloc :: SrcSpan -- Location of the import item + } + -- The is_explicit field is True iff the thing was named + -- *explicitly* in the import specs rather + -- than being imported as part of a "..." group + -- e.g. import C( T(..) ) + -- Here the constructors of T are not named explicitly; + -- only T is named explicitly. + +importSpecLoc :: ImportSpec -> SrcSpan +importSpecLoc (ImpSpec decl ImpAll) = is_dloc decl +importSpecLoc (ImpSpec _ item) = is_iloc item + +importSpecModule :: ImportSpec -> Module +importSpecModule is = is_mod (is_decl is) + +-- 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 ImportSpec where +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) (head is2) + 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 ImportSpec where +instance Ord ImpDeclSpec where compare is1 is2 = (is_mod is1 `compare` is_mod is2) `thenCmp` - (is_loc is1 `compare` is_loc is2) + (is_dloc is1 `compare` is_dloc is2) + +instance Ord ImpItemSpec where + compare is1 is2 = is_iloc is1 `compare` is_iloc is2 \end{code} \begin{code} @@ -463,17 +516,16 @@ plusProv :: Provenance -> Provenance -> Provenance -- 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 (Imported is1 ex1) (Imported is2 ex2) - = Imported (is1++is2) (ex1 || ex2) +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) _}) +pprNameProvenance (GRE {gre_name = name, gre_prov = Imported (why:whys)}) = sep [ppr why, nest 2 (ppr_defn (nameSrcLoc name))] -- If we know the exact definition point (which we may do with GHCi) @@ -482,7 +534,7 @@ 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 (is_mod imp_spec) - <+> ptext SLIT("at") <+> ppr (is_loc imp_spec) + ppr imp_spec@(ImpSpec imp_decl _) + = ptext SLIT("imported from") <+> ppr (is_mod imp_decl) + <+> ptext SLIT("at") <+> ppr (importSpecLoc imp_spec) \end{code}