X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FbasicTypes%2FRdrName.lhs;h=2090beadfa51ce72116146cfdfba15d80a7b6b97;hp=e99a41e9b78f9a32e0dea6446078a11e59428049;hb=5ad61e1470db6dbc8279569c5ad1cc093f753ac0;hpb=371cd67ed23b0dfc85dcc8a386dda26d2b8b8f4e diff --git a/compiler/basicTypes/RdrName.lhs b/compiler/basicTypes/RdrName.lhs index e99a41e..2090bea 100644 --- a/compiler/basicTypes/RdrName.lhs +++ b/compiler/basicTypes/RdrName.lhs @@ -1,9 +1,8 @@ % +% (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 @@ -29,26 +28,25 @@ module RdrName ( GlobalRdrEnv, emptyGlobalRdrEnv, mkGlobalRdrEnv, plusGlobalRdrEnv, lookupGlobalRdrEnv, extendGlobalRdrEnv, pprGlobalRdrEnv, globalRdrEnvElts, - lookupGRE_RdrName, lookupGRE_Name, + lookupGRE_RdrName, lookupGRE_Name, hideSomeUnquals, -- GlobalRdrElt, Provenance, ImportSpec - GlobalRdrElt(..), isLocalGRE, unQualOK, + GlobalRdrElt(..), isLocalGRE, unQualOK, qualSpecOK, unQualSpecOK, Provenance(..), pprNameProvenance, + Parent(..), ImportSpec(..), ImpDeclSpec(..), ImpItemSpec(..), importSpecLoc, importSpecModule ) 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, SrcSpan ) -import FastString ( FastString ) +import Module +import Name +import Maybes +import SrcLoc +import FastString import Outputable -import Util ( thenCmp ) +import Util \end{code} %************************************************************************ @@ -78,10 +76,7 @@ data RdrName -- We know exactly the Name. This is used -- (a) when the parser parses built-in syntax like "[]" -- and "(,)", but wants a RdrName from it - -- (b) when converting names to the RdrNames in IfaceTypes - -- Here an Exact RdrName always contains an External Name - -- (Internal Names are converted to simple Unquals) - -- (c) by Template Haskell, when TH has generated a unique name + -- (b) by Template Haskell, when TH has generated a unique name \end{code} @@ -300,23 +295,32 @@ type GlobalRdrEnv = OccEnv [GlobalRdrElt] -- 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 + +instance Outputable Parent where + ppr NoParent = empty + ppr (ParentIs n) = ptext SLIT("parent:") <> ppr n + + +plusParent :: Parent -> Parent -> Parent +plusParent NoParent rel = ASSERT( case rel of { NoParent -> True; other -> False } ) NoParent +plusParent (ParentIs n) rel = ASSERT( case rel of { ParentIs m -> n==m; other -> False } ) ParentIs n + 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 @@ -402,7 +406,15 @@ 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_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 @@ -427,7 +439,37 @@ 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_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 +-- This is used in TH, when renaming a declaration bracket +-- [d| foo = ... |] +-- We want unqualified 'foo' in "..." to mean this foo, not +-- the one from the enclosing module. But the *qualified* name +-- from the enclosing moudule must certainly still be avaialable +-- Seems like 5 times as much work as it deserves! +hideSomeUnquals rdr_env occs + = foldr hide rdr_env occs + where + hide occ env + | 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_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 } + decl_spec = ImpDeclSpec { is_mod = mod, is_as = mod, + is_qual = True, + is_dloc = srcLocSpan (nameSrcLoc name) } + + qual_gre gre@(GRE { gre_prov = Imported specs }) + = gre { gre_prov = Imported (map qual_spec specs) } + + qual_spec spec@(ImpSpec { is_decl = decl_spec }) + = spec { is_decl = decl_spec { is_qual = True } } \end{code} @@ -529,8 +571,10 @@ 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 (why:whys)}) - = sep [ppr why, nest 2 (ppr_defn (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))] + [] -> 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".