X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FbasicTypes%2FRdrName.lhs;h=acc17f16270a6c560986236fbbba73de03f74052;hb=08652e67c4d5d9a40687f93c286021a867c1bca0;hp=2090beadfa51ce72116146cfdfba15d80a7b6b97;hpb=5ad61e1470db6dbc8279569c5ad1cc093f753ac0;p=ghc-hetmet.git diff --git a/compiler/basicTypes/RdrName.lhs b/compiler/basicTypes/RdrName.lhs index 2090bea..acc17f1 100644 --- a/compiler/basicTypes/RdrName.lhs +++ b/compiler/basicTypes/RdrName.lhs @@ -22,20 +22,21 @@ module RdrName ( -- LocalRdrEnv LocalRdrEnv, emptyLocalRdrEnv, extendLocalRdrEnv, - lookupLocalRdrEnv, elemLocalRdrEnv, + lookupLocalRdrEnv, lookupLocalRdrOcc, elemLocalRdrEnv, -- GlobalRdrEnv GlobalRdrEnv, emptyGlobalRdrEnv, mkGlobalRdrEnv, plusGlobalRdrEnv, lookupGlobalRdrEnv, extendGlobalRdrEnv, pprGlobalRdrEnv, globalRdrEnvElts, - lookupGRE_RdrName, lookupGRE_Name, hideSomeUnquals, + lookupGRE_RdrName, lookupGRE_Name, getGRE_NameQualifier_maybes, + hideSomeUnquals, -- GlobalRdrElt, Provenance, ImportSpec GlobalRdrElt(..), isLocalGRE, unQualOK, qualSpecOK, unQualSpecOK, Provenance(..), pprNameProvenance, Parent(..), ImportSpec(..), ImpDeclSpec(..), ImpItemSpec(..), - importSpecLoc, importSpecModule + importSpecLoc, importSpecModule, isExplicitItem ) where #include "HsVersions.h" @@ -153,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} @@ -211,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 } @@ -228,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 @@ -257,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 @@ -264,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 @@ -302,16 +319,30 @@ data GlobalRdrElt } data Parent = NoParent | ParentIs Name + deriving (Eq) instance Outputable Parent where ppr NoParent = empty - ppr (ParentIs n) = ptext SLIT("parent:") <> ppr n + 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 +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] @@ -333,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 @@ -354,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 @@ -401,7 +437,7 @@ 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 @@ -527,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) @@ -562,29 +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) + = ptext (sLit "defined at") <+> ppr (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))] + (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