%
\begin{code}
+{-# LANGUAGE DeriveDataTypeable #-}
-- |
-- #name_types#
mkRdrUnqual, mkRdrQual,
mkUnqual, mkVarUnqual, mkQual, mkOrig,
nameRdrName, getRdrName,
- mkDerivedRdrName,
-- ** Destruction
rdrNameOcc, rdrNameSpace, setRdrNameSpace,
showRdrName,
-- * Local mapping of 'RdrName' to 'Name.Name'
- LocalRdrEnv, emptyLocalRdrEnv, extendLocalRdrEnv,
+ LocalRdrEnv, emptyLocalRdrEnv, extendLocalRdrEnv, extendLocalRdrEnvList,
lookupLocalRdrEnv, lookupLocalRdrOcc, elemLocalRdrEnv,
-- * Global mapping of 'RdrName' to 'GlobalRdrElt's
lookupGlobalRdrEnv, extendGlobalRdrEnv,
pprGlobalRdrEnv, globalRdrEnvElts,
lookupGRE_RdrName, lookupGRE_Name, getGRE_NameQualifier_maybes,
- hideSomeUnquals, findLocalDupsRdrEnv,
+ transformGREs, findLocalDupsRdrEnv, pickGREs,
-- ** Global 'RdrName' mapping elements: 'GlobalRdrElt', 'Provenance', 'ImportSpec'
GlobalRdrElt(..), isLocalGRE, unQualOK, qualSpecOK, unQualSpecOK,
import FastString
import Outputable
import Util
+
+import Data.Data
\end{code}
%************************************************************************
-- (2) By Template Haskell, when TH has generated a unique name
--
-- Such a 'RdrName' can be created by using 'getRdrName' on a 'Name'
+ deriving (Data, Typeable)
\end{code}
mkOrig mod occ = Orig mod occ
---------------
--- | Produce an original 'RdrName' whose module that of a parent 'Name' but its 'OccName'
--- is derived from that of it's parent using the supplied function
-mkDerivedRdrName :: Name -> (OccName -> OccName) -> RdrName
-mkDerivedRdrName parent mk_occ
- = ASSERT2( isExternalName parent, ppr 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 -> FastString -> RdrName
ppr (Exact name) = ppr name
ppr (Unqual occ) = ppr occ
ppr (Qual mod occ) = ppr mod <> dot <> ppr occ
- ppr (Orig mod occ) = ppr mod <> dot <> ppr occ
+ ppr (Orig mod occ) = getPprStyle (\sty -> pprModulePrefix sty mod occ <> ppr occ)
instance OutputableBndr RdrName where
pprBndr _ n
emptyLocalRdrEnv :: LocalRdrEnv
emptyLocalRdrEnv = emptyOccEnv
-extendLocalRdrEnv :: LocalRdrEnv -> [Name] -> LocalRdrEnv
-extendLocalRdrEnv env names
+extendLocalRdrEnv :: LocalRdrEnv -> Name -> LocalRdrEnv
+extendLocalRdrEnv env name
+ = extendOccEnv env (nameOccName name) name
+
+extendLocalRdrEnvList :: LocalRdrEnv -> [Name] -> LocalRdrEnv
+extendLocalRdrEnvList env names
= extendOccEnvList env [(nameOccName n, n) | n <- names]
lookupLocalRdrEnv :: LocalRdrEnv -> RdrName -> Maybe Name
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
Just gres -> gres
extendGlobalRdrEnv :: GlobalRdrEnv -> GlobalRdrElt -> GlobalRdrEnv
-extendGlobalRdrEnv env gre = extendOccEnv_C add env occ [gre]
+extendGlobalRdrEnv env gre = extendOccEnv_Acc (:) singleton env occ gre
where
occ = nameOccName (gre_name gre)
- add gres _ = gre:gres
lookupGRE_RdrName :: RdrName -> GlobalRdrEnv -> [GlobalRdrElt]
lookupGRE_RdrName rdr_name env
gre_name gre == name ]
getGRE_NameQualifier_maybes :: GlobalRdrEnv -> Name -> [Maybe [ModuleName]]
+-- Returns all the qualifiers by which 'x' is in scope
+-- Nothing means "the unqualified version is in scope"
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
+ 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
pick :: GlobalRdrElt -> Maybe GlobalRdrElt
pick gre@(GRE {gre_prov = LocalDef, gre_name = n}) -- Local def
| rdr_is_unqual = Just gre
- | Just (mod,_) <- rdr_is_qual -- Qualified name
+ | Just (mod,_) <- rdr_is_qual -- Qualified name
, Just n_mod <- nameModule_maybe n -- Binder is External
, mod == moduleName n_mod = Just gre
| otherwise = Nothing
mkGlobalRdrEnv gres
= foldr add emptyGlobalRdrEnv gres
where
- add gre env = extendOccEnv_C (foldr insertGRE) env
- (nameOccName (gre_name gre))
- [gre]
+ add gre env = extendOccEnv_Acc insertGRE singleton env
+ (nameOccName (gre_name gre))
+ gre
findLocalDupsRdrEnv :: GlobalRdrEnv -> [OccName] -> (GlobalRdrEnv, [[Name]])
-- ^ For each 'OccName', see if there are multiple local definitions
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 module must certainly still be available
-
--- Seems like 5 times as much work as it deserves!
-hideSomeUnquals rdr_env occs
- = foldr hide rdr_env occs
+transformGREs :: (GlobalRdrElt -> GlobalRdrElt)
+ -> [OccName]
+ -> GlobalRdrEnv -> GlobalRdrEnv
+-- ^ Apply a transformation function to the GREs for these OccNames
+transformGREs trans_gre occs rdr_env
+ = foldr trans 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 = ASSERT2( isExternalName name, ppr name) 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 } }
+ trans occ env
+ = case lookupOccEnv env occ of
+ Just gres -> extendOccEnv env occ (map trans_gre gres)
+ Nothing -> env
\end{code}
%************************************************************************
-- should be a Maybe PackageId here too.
is_as :: ModuleName, -- ^ Import alias, e.g. from @as M@ (or @Muggle@ if there is no @as@ clause)
is_qual :: Bool, -- ^ Was this import qualified?
- is_dloc :: SrcSpan -- ^ The location of the import declaration
+ is_dloc :: SrcSpan -- ^ The location of the entire import declaration
}
-- | Describes import info a particular Name
projects / ghc-hetmet.git / blobdiff