%
+% (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
GlobalRdrEnv, emptyGlobalRdrEnv, mkGlobalRdrEnv, plusGlobalRdrEnv,
lookupGlobalRdrEnv, extendGlobalRdrEnv,
pprGlobalRdrEnv, globalRdrEnvElts,
- lookupGRE_RdrName, lookupGRE_Name,
+ lookupGRE_RdrName, lookupGRE_Name, hideSomeUnquals,
-- GlobalRdrElt, Provenance, ImportSpec
- GlobalRdrElt(..), isLocalGRE, unQualOK,
+ GlobalRdrElt(..), isLocalGRE, unQualOK, qualSpecOK, unQualSpecOK,
Provenance(..), pprNameProvenance,
+ Parent(..),
ImportSpec(..), ImpDeclSpec(..), ImpItemSpec(..),
importSpecLoc, importSpecModule
) 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, SrcSpan )
-import FastString ( FastString )
+import Module
+import Name
+import Maybes
+import SrcLoc
+import FastString
import Outputable
-import Util ( thenCmp )
+import Util
\end{code}
%************************************************************************
-- 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}
-- 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
+
+instance Outputable Parent where
+ ppr NoParent = empty
+ 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
+
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
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
-- 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}
-- 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))]
+pprNameProvenance (GRE {gre_name = name, gre_prov = Imported whys})
+ = case whys of
+ (why:whys) -> 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".
| 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)
+ ppr imp_spec
+ = ptext SLIT("imported from") <+> ppr (importSpecModule imp_spec)
+ <+> if isGoodSrcSpan loc then ptext SLIT("at") <+> ppr loc
+ else empty
+ where
+ loc = importSpecLoc imp_spec
\end{code}
projects / ghc-hetmet.git / blobdiff