X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FbasicTypes%2FRdrName.lhs;h=acc17f16270a6c560986236fbbba73de03f74052;hb=08652e67c4d5d9a40687f93c286021a867c1bca0;hp=e99a41e9b78f9a32e0dea6446078a11e59428049;hpb=371cd67ed23b0dfc85dcc8a386dda26d2b8b8f4e;p=ghc-hetmet.git diff --git a/compiler/basicTypes/RdrName.lhs b/compiler/basicTypes/RdrName.lhs index e99a41e..acc17f1 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 @@ -23,32 +22,32 @@ module RdrName ( -- LocalRdrEnv LocalRdrEnv, emptyLocalRdrEnv, extendLocalRdrEnv, - lookupLocalRdrEnv, elemLocalRdrEnv, + lookupLocalRdrEnv, lookupLocalRdrOcc, elemLocalRdrEnv, -- GlobalRdrEnv GlobalRdrEnv, emptyGlobalRdrEnv, mkGlobalRdrEnv, plusGlobalRdrEnv, lookupGlobalRdrEnv, extendGlobalRdrEnv, pprGlobalRdrEnv, globalRdrEnvElts, - lookupGRE_RdrName, lookupGRE_Name, + lookupGRE_RdrName, lookupGRE_Name, getGRE_NameQualifier_maybes, + 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, 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 +77,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} @@ -158,34 +154,46 @@ nukeExact n \end{code} \begin{code} +isRdrDataCon :: RdrName -> Bool +isRdrTyVar :: RdrName -> Bool +isRdrTc :: RdrName -> Bool + isRdrDataCon rn = isDataOcc (rdrNameOcc rn) isRdrTyVar rn = isTvOcc (rdrNameOcc rn) isRdrTc rn = isTcOcc (rdrNameOcc rn) +isSrcRdrName :: RdrName -> Bool isSrcRdrName (Unqual _) = True isSrcRdrName (Qual _ _) = True isSrcRdrName _ = False +isUnqual :: RdrName -> Bool isUnqual (Unqual _) = True -isUnqual other = False +isUnqual _ = False +isQual :: RdrName -> Bool isQual (Qual _ _) = True isQual _ = False +isQual_maybe :: RdrName -> Maybe (ModuleName, OccName) isQual_maybe (Qual m n) = Just (m,n) isQual_maybe _ = Nothing +isOrig :: RdrName -> Bool isOrig (Orig _ _) = True isOrig _ = False +isOrig_maybe :: RdrName -> Maybe (Module, OccName) isOrig_maybe (Orig m n) = Just (m,n) isOrig_maybe _ = Nothing +isExact :: RdrName -> Bool isExact (Exact _) = True -isExact other = False +isExact _ = False +isExact_maybe :: RdrName -> Maybe Name isExact_maybe (Exact n) = Just n -isExact_maybe other = Nothing +isExact_maybe _ = Nothing \end{code} @@ -216,7 +224,7 @@ instance Eq RdrName where (Orig m1 o1) == (Orig m2 o2) = m1==m2 && o1==o2 (Qual m1 o1) == (Qual m2 o2) = m1==m2 && o1==o2 (Unqual o1) == (Unqual o2) = o1==o2 - r1 == r2 = False + _ == _ = False instance Ord RdrName where a <= b = case (a `compare` b) of { LT -> True; EQ -> True; GT -> False } @@ -233,7 +241,7 @@ instance Ord RdrName where -- } -- I think we can do without this conversion compare (Exact n1) (Exact n2) = n1 `compare` n2 - compare (Exact n1) n2 = LT + compare (Exact _) _ = LT compare (Unqual _) (Exact _) = GT compare (Unqual o1) (Unqual o2) = o1 `compare` o2 @@ -262,6 +270,7 @@ It is keyed by OccName, because we never use it for qualified names. \begin{code} type LocalRdrEnv = OccEnv Name +emptyLocalRdrEnv :: LocalRdrEnv emptyLocalRdrEnv = emptyOccEnv extendLocalRdrEnv :: LocalRdrEnv -> [Name] -> LocalRdrEnv @@ -269,9 +278,12 @@ extendLocalRdrEnv env names = extendOccEnvList env [(nameOccName n, n) | n <- names] lookupLocalRdrEnv :: LocalRdrEnv -> RdrName -> Maybe Name -lookupLocalRdrEnv env (Exact name) = Just name +lookupLocalRdrEnv _ (Exact name) = Just name lookupLocalRdrEnv env (Unqual occ) = lookupOccEnv env occ -lookupLocalRdrEnv env other = Nothing +lookupLocalRdrEnv _ _ = Nothing + +lookupLocalRdrOcc :: LocalRdrEnv -> OccName -> Maybe Name +lookupLocalRdrOcc env occ = lookupOccEnv env occ elemLocalRdrEnv :: RdrName -> LocalRdrEnv -> Bool elemLocalRdrEnv rdr_name env @@ -300,23 +312,46 @@ 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 :: GlobalRdrEnv 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 @@ -329,7 +364,7 @@ pprGlobalRdrEnv env \begin{code} lookupGlobalRdrEnv :: GlobalRdrEnv -> OccName -> [GlobalRdrElt] -lookupGlobalRdrEnv env rdr_name = case lookupOccEnv env rdr_name of +lookupGlobalRdrEnv env occ_name = case lookupOccEnv env occ_name of Nothing -> [] Just gres -> gres @@ -350,6 +385,11 @@ lookupGRE_Name env name = [ gre | gre <- lookupGlobalRdrEnv env (nameOccName name), gre_name gre == name ] +getGRE_NameQualifier_maybes :: GlobalRdrEnv -> Name -> [Maybe [ModuleName]] +getGRE_NameQualifier_maybes env + = map qualifier_maybe . map gre_prov . lookupGRE_Name env + where qualifier_maybe LocalDef = Nothing + qualifier_maybe (Imported iss) = Just $ map (is_as . is_decl) iss pickGREs :: RdrName -> [GlobalRdrElt] -> [GlobalRdrElt] -- Take a list of GREs which have the right OccName @@ -397,12 +437,20 @@ pickGREs rdr_name gres isLocalGRE :: GlobalRdrElt -> Bool isLocalGRE (GRE {gre_prov = LocalDef}) = True -isLocalGRE other = False +isLocalGRE _ = 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 +475,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 +563,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) @@ -520,27 +602,30 @@ 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 LocalDef = panic "plusProv" -plusProv LocalDef p2 = LocalDef -plusProv p1 LocalDef = LocalDef +plusProv LocalDef LocalDef = panic "plusProv" +plusProv LocalDef _ = LocalDef +plusProv _ LocalDef = LocalDef plusProv (Imported is1) (Imported is2) = Imported (is1++is2) 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))] + = ptext (sLit "defined at") <+> ppr (nameSrcLoc name) +pprNameProvenance (GRE {gre_name = name, gre_prov = Imported whys}) + = case whys of + (why:_) -> 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". -ppr_defn loc | isGoodSrcLoc loc = parens (ptext SLIT("defined at") <+> ppr loc) +ppr_defn :: SrcLoc -> SDoc +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 (importSpecModule imp_spec) - <+> if isGoodSrcSpan loc then ptext SLIT("at") <+> ppr loc + = ptext (sLit "imported from") <+> ppr (importSpecModule imp_spec) + <+> if isGoodSrcSpan loc then ptext (sLit "at") <+> ppr loc else empty where loc = importSpecLoc imp_spec