-- Construction
mkRdrUnqual, mkRdrQual,
- mkUnqual, mkVarUnqual, mkQual, mkOrig, mkIfaceOrig,
+ mkUnqual, mkVarUnqual, mkQual, mkOrig,
nameRdrName, getRdrName,
- qualifyRdrName, unqualifyRdrName,
mkDerivedRdrName,
- dummyRdrVarName, dummyRdrTcName,
-- Destruction
rdrNameModule, rdrNameOcc, setRdrNameSpace,
isOrig, isOrig_maybe, isExact, isExact_maybe, isSrcRdrName,
-- Printing; instance Outputable RdrName
- pprUnqualRdrName,
-- LocalRdrEnv
LocalRdrEnv, emptyLocalRdrEnv, extendLocalRdrEnv,
-- GlobalRdrEnv
GlobalRdrEnv, emptyGlobalRdrEnv, mkGlobalRdrEnv, plusGlobalRdrEnv,
- lookupGlobalRdrEnv, pprGlobalRdrEnv, globalRdrEnvElts,
+ lookupGlobalRdrEnv, extendGlobalRdrEnv,
+ pprGlobalRdrEnv, globalRdrEnvElts,
lookupGRE_RdrName, lookupGRE_Name,
-- GlobalRdrElt, Provenance, ImportSpec
- GlobalRdrElt(..), Provenance(..), ImportSpec(..),
- isLocalGRE, unQualOK, hasQual,
- pprNameProvenance
+ GlobalRdrElt(..), isLocalGRE, unQualOK,
+ Provenance(..), pprNameProvenance,
+ ImportSpec(..), ImpDeclSpec(..), ImpItemSpec(..),
+ importSpecLoc, importSpecModule
) where
#include "HsVersions.h"
-import OccName ( NameSpace, tcName, varName,
- OccName, UserFS, EncodedFS,
- mkSysOccFS, setOccNameSpace,
- mkOccFS, mkVarOcc, occNameFlavour,
- isDataOcc, isTvOcc, isTcOcc,
- OccEnv, emptyOccEnv, extendOccEnvList, lookupOccEnv,
- elemOccEnv, plusOccEnv_C, extendOccEnv_C, foldOccEnv,
- occEnvElts
- )
-import Module ( ModuleName, mkSysModuleNameFS, mkModuleNameFS )
-import Name ( Name, NamedThing(getName), nameModuleName, nameParent_maybe,
+import OccName
+import Module ( Module, mkModuleFS )
+import Name ( Name, NamedThing(getName), nameModule, nameParent_maybe,
nameOccName, isExternalName, nameSrcLoc )
-import Maybes ( seqMaybe )
-import SrcLoc ( SrcLoc, isGoodSrcLoc )
-import BasicTypes( DeprecTxt )
+import Maybes ( mapCatMaybes )
+import SrcLoc ( isGoodSrcLoc, SrcSpan )
+import FastString ( FastString )
import Outputable
import Util ( thenCmp )
\end{code}
-
%************************************************************************
%* *
\subsection{The main data type}
= Unqual OccName
-- Used for ordinary, unqualified occurrences
- | Qual ModuleName OccName
+ | Qual Module OccName
-- A qualified name written by the user in
- -- *source* code. The module isn't necessarily
+ -- *source* code. The module isn't necessarily
-- the module where the thing is defined;
-- just the one from which it is imported
- | Orig ModuleName OccName
+ | Orig Module OccName
-- An original name; the module is the *defining* module.
-- This is used when GHC generates code that will be fed
-- into the renamer (e.g. from deriving clauses), but where
-- (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) possibly, by the meta-programming stuff
+ -- (c) by Template Haskell, when TH has generated a unique name
\end{code}
%************************************************************************
\begin{code}
-rdrNameModule :: RdrName -> ModuleName
+rdrNameModule :: RdrName -> Module
rdrNameModule (Qual m _) = m
rdrNameModule (Orig m _) = m
-rdrNameModule (Exact n) = nameModuleName n
+rdrNameModule (Exact n) = nameModule n
rdrNameModule (Unqual n) = pprPanic "rdrNameModule" (ppr n)
rdrNameOcc :: RdrName -> OccName
setRdrNameSpace (Unqual occ) ns = Unqual (setOccNameSpace ns occ)
setRdrNameSpace (Qual m occ) ns = Qual m (setOccNameSpace ns occ)
setRdrNameSpace (Orig m occ) ns = Orig m (setOccNameSpace ns occ)
-setRdrNameSpace (Exact n) ns = Orig (nameModuleName n)
+setRdrNameSpace (Exact n) ns = Orig (nameModule n)
(setOccNameSpace ns (nameOccName n))
\end{code}
mkRdrUnqual :: OccName -> RdrName
mkRdrUnqual occ = Unqual occ
-mkRdrQual :: ModuleName -> OccName -> RdrName
+mkRdrQual :: Module -> OccName -> RdrName
mkRdrQual mod occ = Qual mod occ
-mkOrig :: ModuleName -> OccName -> RdrName
+mkOrig :: Module -> OccName -> RdrName
mkOrig mod occ = Orig mod occ
-mkIfaceOrig :: NameSpace -> EncodedFS -> EncodedFS -> RdrName
-mkIfaceOrig ns m n = Orig (mkSysModuleNameFS m) (mkSysOccFS ns n)
-
---------------
mkDerivedRdrName :: Name -> (OccName -> OccName) -> (RdrName)
mkDerivedRdrName parent mk_occ
- = mkOrig (nameModuleName parent) (mk_occ (nameOccName parent))
+ = mkOrig (nameModule parent) (mk_occ (nameOccName parent))
---------------
-- These two are used when parsing source files
-- They do encode the module and occurrence names
-mkUnqual :: NameSpace -> UserFS -> RdrName
-mkUnqual sp n = Unqual (mkOccFS sp n)
+mkUnqual :: NameSpace -> FastString -> RdrName
+mkUnqual sp n = Unqual (mkOccNameFS sp n)
-mkVarUnqual :: UserFS -> RdrName
-mkVarUnqual n = Unqual (mkOccFS varName n)
+mkVarUnqual :: FastString -> RdrName
+mkVarUnqual n = Unqual (mkVarOccFS n)
-mkQual :: NameSpace -> (UserFS, UserFS) -> RdrName
-mkQual sp (m, n) = Qual (mkModuleNameFS m) (mkOccFS sp n)
+mkQual :: NameSpace -> (FastString, FastString) -> RdrName
+mkQual sp (m, n) = Qual (mkModuleFS m) (mkOccNameFS sp n)
getRdrName :: NamedThing thing => thing -> RdrName
getRdrName name = nameRdrName (getName name)
-- unique is still there for debug printing, particularly
-- of Types (which are converted to IfaceTypes before printing)
-qualifyRdrName :: ModuleName -> RdrName -> RdrName
- -- Sets the module name of a RdrName, even if it has one already
-qualifyRdrName mod rn = Qual mod (rdrNameOcc rn)
-
-unqualifyRdrName :: RdrName -> RdrName
-unqualifyRdrName rdr_name = Unqual (rdrNameOcc rdr_name)
-
nukeExact :: Name -> RdrName
nukeExact n
- | isExternalName n = Orig (nameModuleName n) (nameOccName n)
+ | isExternalName n = Orig (nameModule n) (nameOccName n)
| otherwise = Unqual (nameOccName n)
\end{code}
\begin{code}
- -- This guy is used by the reader when HsSyn has a slot for
- -- an implicit name that's going to be filled in by
- -- the renamer. We can't just put "error..." because
- -- we sometimes want to print out stuff after reading but
- -- before renaming
-dummyRdrVarName = Unqual (mkVarOcc FSLIT("V-DUMMY"))
-dummyRdrTcName = Unqual (mkOccFS tcName FSLIT("TC-DUMMY"))
-\end{code}
-
-
-\begin{code}
isRdrDataCon rn = isDataOcc (rdrNameOcc rn)
isRdrTyVar rn = isTvOcc (rdrNameOcc rn)
isRdrTc rn = isTcOcc (rdrNameOcc rn)
ppr (Qual mod occ) = ppr mod <> dot <> ppr occ <+> ppr_name_space occ
ppr (Orig mod occ) = ppr mod <> dot <> ppr occ <+> ppr_name_space occ
-ppr_name_space occ = ifPprDebug (parens (text (occNameFlavour occ)))
+ppr_name_space occ = ifPprDebug (parens (pprNonVarNameSpace (occNameSpace occ)))
instance OutputableBndr RdrName where
pprBndr _ n
| isTvOcc (rdrNameOcc n) = char '@' <+> ppr n
| otherwise = ppr n
-pprUnqualRdrName rdr_name = ppr (rdrNameOcc rdr_name)
-
instance Eq RdrName where
(Exact n1) == (Exact n2) = n1==n2
-- Convert exact to orig
a >= b = case (a `compare` b) of { LT -> False; EQ -> True; GT -> True }
a > b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True }
- -- Unqual < Qual < Orig
- -- We always convert Exact to Orig before comparing
- compare (Exact n1) (Exact n2) | n1==n2 = EQ -- Short cut
- | otherwise = nukeExact n1 `compare` nukeExact n2
- compare (Exact n1) n2 = nukeExact n1 `compare` n2
- compare n1 (Exact n2) = n1 `compare` nukeExact n2
-
-
- compare (Qual m1 o1) (Qual m2 o2) = (o1 `compare` o2) `thenCmp` (m1 `compare` m2)
- compare (Orig m1 o1) (Orig m2 o2) = (o1 `compare` o2) `thenCmp` (m1 `compare` m2)
+ -- Exact < Unqual < Qual < Orig
+ -- [Note: Apr 2004] We used to use nukeExact to convert Exact to Orig
+ -- before comparing so that Prelude.map == the exact Prelude.map, but
+ -- that meant that we reported duplicates when renaming bindings
+ -- generated by Template Haskell; e.g
+ -- do { n1 <- newName "foo"; n2 <- newName "foo";
+ -- <decl involving n1,n2> }
+ -- I think we can do without this conversion
+ compare (Exact n1) (Exact n2) = n1 `compare` n2
+ compare (Exact n1) n2 = LT
+
+ compare (Unqual _) (Exact _) = GT
compare (Unqual o1) (Unqual o2) = o1 `compare` o2
-
compare (Unqual _) _ = LT
+
+ compare (Qual _ _) (Exact _) = GT
+ compare (Qual _ _) (Unqual _) = GT
+ compare (Qual m1 o1) (Qual m2 o2) = (o1 `compare` o2) `thenCmp` (m1 `compare` m2)
compare (Qual _ _) (Orig _ _) = LT
- compare _ _ = GT
+
+ compare (Orig m1 o1) (Orig m2 o2) = (o1 `compare` o2) `thenCmp` (m1 `compare` m2)
+ compare (Orig _ _) _ = GT
\end{code}
= extendOccEnvList env [(nameOccName n, n) | n <- names]
lookupLocalRdrEnv :: LocalRdrEnv -> RdrName -> Maybe Name
-lookupLocalRdrEnv env rdr_name
- | isUnqual rdr_name = lookupOccEnv env (rdrNameOcc rdr_name)
- | otherwise = Nothing
+lookupLocalRdrEnv env (Exact name) = Just name
+lookupLocalRdrEnv env (Unqual occ) = lookupOccEnv env occ
+lookupLocalRdrEnv env other = Nothing
elemLocalRdrEnv :: RdrName -> LocalRdrEnv -> Bool
elemLocalRdrEnv rdr_name env
data GlobalRdrElt
= GRE { gre_name :: Name,
- gre_prov :: Provenance, -- Why it's in scope
- gre_deprec :: Maybe DeprecTxt -- Whether this name is deprecated
+ gre_prov :: Provenance -- Why it's in scope
}
instance Outputable GlobalRdrElt where
Nothing -> []
Just gres -> gres
+extendGlobalRdrEnv :: GlobalRdrEnv -> GlobalRdrElt -> GlobalRdrEnv
+extendGlobalRdrEnv env gre = extendOccEnv_C add env occ [gre]
+ where
+ occ = nameOccName (gre_name gre)
+ add gres _ = gre:gres
+
lookupGRE_RdrName :: RdrName -> GlobalRdrEnv -> [GlobalRdrElt]
lookupGRE_RdrName rdr_name env
- = case lookupOccEnv env occ of
- Nothing -> []
- Just gres | isUnqual rdr_name -> filter unQualOK gres
- | otherwise -> filter (hasQual mod) gres
- where
- mod = rdrNameModule rdr_name
- occ = rdrNameOcc rdr_name
+ = case lookupOccEnv env (rdrNameOcc rdr_name) of
+ Nothing -> []
+ Just gres -> pickGREs rdr_name gres
lookupGRE_Name :: GlobalRdrEnv -> Name -> [GlobalRdrElt]
lookupGRE_Name env name
gre_name gre == name ]
+pickGREs :: RdrName -> [GlobalRdrElt] -> [GlobalRdrElt]
+-- Take a list of GREs which have the right OccName
+-- Pick those GREs that are suitable for this RdrName
+-- And for those, keep only only the Provenances that are suitable
+--
+-- Consider
+-- module A ( f ) where
+-- import qualified Foo( f )
+-- import Baz( f )
+-- f = undefined
+-- Let's suppose that Foo.f and Baz.f are the same entity really.
+-- The export of f is ambiguous because it's in scope from the local def
+-- and the import. The lookup of (Unqual f) should return a GRE for
+-- the locally-defined f, and a GRE for the imported f, with a *single*
+-- provenance, namely the one for Baz(f).
+pickGREs rdr_name gres
+ = mapCatMaybes pick gres
+ where
+ is_unqual = isUnqual rdr_name
+ mod = rdrNameModule rdr_name
+
+ pick :: GlobalRdrElt -> Maybe GlobalRdrElt
+ pick gre@(GRE {gre_prov = LocalDef, gre_name = n}) -- Local def
+ | is_unqual || nameModule n == mod = Just gre
+ | otherwise = Nothing
+ pick gre@(GRE {gre_prov = Imported [is]}) -- Single import (efficiency)
+ | is_unqual = if not (is_qual (is_decl is)) then Just gre
+ else Nothing
+ | otherwise = if mod == is_as (is_decl is) then Just gre
+ else Nothing
+ pick gre@(GRE {gre_prov = Imported is}) -- Multiple import
+ | null filtered_is = Nothing
+ | otherwise = Just (gre {gre_prov = Imported filtered_is})
+ where
+ filtered_is | is_unqual = filter (not . is_qual . is_decl) is
+ | otherwise = filter ((== mod) . is_as . is_decl) is
+
isLocalGRE :: GlobalRdrElt -> Bool
-isLocalGRE (GRE {gre_prov = LocalDef _}) = True
-isLocalGRE other = False
+isLocalGRE (GRE {gre_prov = LocalDef}) = True
+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)
-
-hasQual :: ModuleName -> GlobalRdrElt -> Bool
--- A qualified version of this thing is in scope
-hasQual mod (GRE {gre_prov = LocalDef m}) = m == mod
-hasQual mod (GRE {gre_prov = Imported is _}) = any ((== mod) . is_as) is
+unQualOK (GRE {gre_prov = LocalDef}) = True
+unQualOK (GRE {gre_prov = Imported is}) = not (all (is_qual . is_decl) is)
plusGlobalRdrEnv :: GlobalRdrEnv -> GlobalRdrEnv -> GlobalRdrEnv
plusGlobalRdrEnv env1 env2 = plusOccEnv_C (foldr insertGRE) env1 env2
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_deprec = gre_deprec g1 `seqMaybe` gre_deprec g2 }
- -- Could the deprecs be different? If we re-export
- -- something deprecated, is it propagated? I forget.
+ = GRE { gre_name = gre_name g1,
+ gre_prov = gre_prov g1 `plusProv` gre_prov g2 }
\end{code}
%************************************************************************
The "provenance" of something says how it came to be in scope.
+It's quite elaborate so that we can give accurate unused-name warnings.
\begin{code}
data Provenance
= LocalDef -- Defined locally
- ModuleName
-
| Imported -- Imported
[ImportSpec] -- INVARIANT: non-empty
- Bool -- True iff the thing was named *explicitly*
- -- in *any* of the import specs rather than being
- -- imported as part of a group;
- -- e.g.
- -- import B
- -- import C( T(..) )
- -- Here, everything imported by B, and the constructors of T
- -- are not named explicitly; only T is named explicitly.
- -- This info is used when warning of unused names.
-
-data ImportSpec -- Describes a particular import declaration
- -- Shared among all the Provenaces for a particular
- -- import declaration
- = ImportSpec {
- is_mod :: ModuleName, -- 'import Muggle'
- -- Note the Muggle may well not be
- -- the defining module for this thing!
- is_as :: ModuleName, -- 'as M' (or 'Muggle' if there is no 'as' clause)
- is_qual :: Bool, -- True <=> qualified (only)
- is_loc :: SrcLoc } -- Location of import statment
+data ImportSpec = ImpSpec { is_decl :: ImpDeclSpec,
+ is_item :: ImpItemSpec }
+ deriving( Eq, Ord )
+
+data ImpDeclSpec -- Describes a particular import declaration
+ -- Shared among all the Provenaces for that decl
+ = ImpDeclSpec {
+ is_mod :: Module, -- 'import Muggle'
+ -- Note the Muggle may well not be
+ -- the defining module for this thing!
+ is_as :: Module, -- 'as M' (or 'Muggle' if there is no 'as' clause)
+ is_qual :: Bool, -- True <=> qualified (only)
+ is_dloc :: SrcSpan -- Location of import declaration
+ }
+
+data ImpItemSpec -- Describes import info a particular Name
+ = ImpAll -- The import had no import list,
+ -- or had a hiding list
+
+ | ImpSome { -- The import had an import list
+ is_explicit :: Bool,
+ is_iloc :: SrcSpan -- Location of the import item
+ }
+ -- The is_explicit field is True iff the thing was named
+ -- *explicitly* in the import specs rather
+ -- than being imported as part of a "..." group
+ -- e.g. import C( T(..) )
+ -- Here the constructors of T are not named explicitly;
+ -- only T is named explicitly.
+
+importSpecLoc :: ImportSpec -> SrcSpan
+importSpecLoc (ImpSpec decl ImpAll) = is_dloc decl
+importSpecLoc (ImpSpec _ item) = is_iloc item
+
+importSpecModule :: ImportSpec -> Module
+importSpecModule is = is_mod (is_decl is)
+
+-- Note [Comparing provenance]
-- Comparison of provenance is just used for grouping
-- error messages (in RnEnv.warnUnusedBinds)
instance Eq Provenance where
p1 == p2 = case p1 `compare` p2 of EQ -> True; _ -> False
-instance Eq ImportSpec where
+instance Eq ImpDeclSpec where
+ p1 == p2 = case p1 `compare` p2 of EQ -> True; _ -> False
+
+instance Eq ImpItemSpec where
p1 == p2 = case p1 `compare` p2 of EQ -> True; _ -> False
instance Ord Provenance where
- compare (LocalDef _) (LocalDef _) = EQ
- compare (LocalDef _) (Imported _ _) = LT
- compare (Imported _ _) (LocalDef _) = GT
- compare (Imported is1 _) (Imported is2 _) = compare (head is1) (head is2)
+ compare LocalDef LocalDef = EQ
+ compare LocalDef (Imported _) = LT
+ compare (Imported _ ) LocalDef = GT
+ compare (Imported is1) (Imported is2) = compare (head is1)
+ {- See Note [Comparing provenance] -} (head is2)
-instance Ord ImportSpec where
+instance Ord ImpDeclSpec where
compare is1 is2 = (is_mod is1 `compare` is_mod is2) `thenCmp`
- (is_loc is1 `compare` is_loc is2)
+ (is_dloc is1 `compare` is_dloc is2)
+
+instance Ord ImpItemSpec where
+ compare is1 is2 = is_iloc is1 `compare` is_iloc is2
\end{code}
\begin{code}
-- 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 m1) (LocalDef m2)
- = pprPanic "plusProv" (ppr m1 <+> ppr m2)
-plusProv p1@(LocalDef _) p2 = p1
-plusProv p1 p2@(LocalDef _) = p2
-plusProv (Imported is1 ex1) (Imported is2 ex2)
- = Imported (is1++is2) (ex1 || ex2)
+plusProv LocalDef LocalDef = panic "plusProv"
+plusProv LocalDef p2 = LocalDef
+plusProv p1 LocalDef = LocalDef
+plusProv (Imported is1) (Imported is2) = Imported (is1++is2)
pprNameProvenance :: GlobalRdrElt -> SDoc
-pprNameProvenance (GRE {gre_name = name, gre_prov = LocalDef _})
+-- 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_reason why, nest 2 (ppr_defn (nameSrcLoc name))]
-
-ppr_reason imp_spec
- = ptext SLIT("imported from") <+> ppr (is_mod imp_spec)
- <+> ptext SLIT("at") <+> ppr (is_loc imp_spec)
+pprNameProvenance (GRE {gre_name = name, gre_prov = Imported (why:whys)})
+ = sep [ppr why, nest 2 (ppr_defn (nameSrcLoc name))]
+-- 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)
| 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)
\end{code}
projects / ghc-hetmet.git / blobdiff