X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FbasicTypes%2FRdrName.lhs;h=030aa1f609aa83d31d32811f110be05d66dd4fe3;hb=9d7da331989abcd1844e9d03b8d1e4163796fa85;hp=9d2e416d146c58a020d56839671ab08689107205;hpb=56e6b5842accf1efe580483457a10a0e6de8b960;p=ghc-hetmet.git diff --git a/ghc/compiler/basicTypes/RdrName.lhs b/ghc/compiler/basicTypes/RdrName.lhs index 9d2e416..030aa1f 100644 --- a/ghc/compiler/basicTypes/RdrName.lhs +++ b/ghc/compiler/basicTypes/RdrName.lhs @@ -32,31 +32,25 @@ module RdrName ( 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} @@ -145,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) @@ -211,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 @@ -352,13 +346,9 @@ extendGlobalRdrEnv env gre = extendOccEnv_C add env occ [gre] 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 @@ -366,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 @@ -414,40 +436,50 @@ 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 -data ImportSpec -- Describes a particular import declaration - -- Shared among all the Provenaces for a - -- import-all declaration; otherwise it's done - -- per explictly-named item - = ImportSpec { +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_explicit :: Bool, -- True <=> explicit import (see below) - is_loc :: SrcSpan -- Location of import item + 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 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. - -- - -- We keep ImportSpec separate from the Bool so that the - -- former can be shared between all Provenances for a particular - -- import declaration. + -- 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 @@ -455,19 +487,25 @@ data ImportSpec -- Describes a particular import declaration 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 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} @@ -478,13 +516,14 @@ 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 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))] @@ -495,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}