X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=compiler%2FbasicTypes%2FRdrName.lhs;h=df60952bc75754043bee2eab902c1476981c1379;hb=6a05ec5ef5373f61b7f9f5bdc344483417fa801b;hp=3c6cd77c53ad2f03fd3a36d2ac8d179be79459d8;hpb=61d2625ae2e6a4cdae2ffc92df828905e81c24cc;p=ghc-hetmet.git diff --git a/compiler/basicTypes/RdrName.lhs b/compiler/basicTypes/RdrName.lhs index 3c6cd77..df60952 100644 --- a/compiler/basicTypes/RdrName.lhs +++ b/compiler/basicTypes/RdrName.lhs @@ -1,10 +1,16 @@ % +% (c) The University of Glasgow 2006 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 % -\section[RdrName]{@RdrName@} - \begin{code} +{-# OPTIONS -w #-} +-- The above warning supression flag is a temporary kludge. +-- While working on this module you are encouraged to remove it and fix +-- any warnings in the module. See +-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings +-- for details + module RdrName ( RdrName(..), -- Constructors exported only to BinIface @@ -29,26 +35,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 + 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, 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 +83,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 +302,45 @@ 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 + 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 = 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 +426,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 +459,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} @@ -485,6 +547,10 @@ importSpecLoc (ImpSpec _ item) = is_iloc item 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) @@ -529,8 +595,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". @@ -538,7 +606,10 @@ ppr_defn loc | isGoodSrcLoc loc = parens (ptext SLIT("defined at") <+> ppr loc) | otherwise = empty instance Outputable ImportSpec where - ppr imp_spec@(ImpSpec imp_decl _) - = ptext SLIT("imported from") <+> ppr (is_mod imp_decl) - <+> ptext SLIT("at") <+> ppr (importSpecLoc imp_spec) + ppr imp_spec + = ptext SLIT("imported from") <+> ppr (importSpecModule imp_spec) + <+> if isGoodSrcSpan loc then ptext SLIT("at") <+> ppr loc + else empty + where + loc = importSpecLoc imp_spec \end{code}