X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=compiler%2FbasicTypes%2FRdrName.lhs;h=9dd0670a04b5ded3218b3c94f15feae1f8643ca2;hb=ad94d40948668032189ad22a0ad741ac1f645f50;hp=8729f4748b2b3d84e89207de7d3e7ac5bfc0e7ab;hpb=8c3e6304e6a5fe3dbbdf2223de0ccc0f96d2a913;p=ghc-hetmet.git diff --git a/compiler/basicTypes/RdrName.lhs b/compiler/basicTypes/RdrName.lhs index 8729f47..9dd0670 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/CodingStyle#Warnings +-- for details + module RdrName ( RdrName(..), -- Constructors exported only to BinIface @@ -32,23 +38,22 @@ module RdrName ( 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, isGoodSrcSpan, srcLocSpan, 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,8 @@ 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 @@ -444,7 +477,7 @@ hideSomeUnquals rdr_env occs | 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_name = name, gre_prov = Imported [imp_spec] } + = 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 } @@ -514,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)