X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=compiler%2FbasicTypes%2FRdrName.lhs;h=ad1256da2ae0de87fddb9237884a9c6d9f6cccdb;hb=49c98d143c382a1341e1046f5ca00819a25691ba;hp=e99a41e9b78f9a32e0dea6446078a11e59428049;hpb=371cd67ed23b0dfc85dcc8a386dda26d2b8b8f4e;p=ghc-hetmet.git

diff --git a/compiler/basicTypes/RdrName.lhs b/compiler/basicTypes/RdrName.lhs
index e99a41e..ad1256d 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
@@ -29,7 +28,7 @@ module RdrName (
 	GlobalRdrEnv, emptyGlobalRdrEnv, mkGlobalRdrEnv, plusGlobalRdrEnv, 
 	lookupGlobalRdrEnv, extendGlobalRdrEnv,
 	pprGlobalRdrEnv, globalRdrEnvElts,
-	lookupGRE_RdrName, lookupGRE_Name,
+	lookupGRE_RdrName, lookupGRE_Name, hideSomeUnquals,
 
 	-- GlobalRdrElt, Provenance, ImportSpec
 	GlobalRdrElt(..), isLocalGRE, unQualOK, 
@@ -41,14 +40,13 @@ module RdrName (
 #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 +76,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}
 
 
@@ -311,8 +306,7 @@ data GlobalRdrElt
     }
 
 instance Outputable GlobalRdrElt where
-  ppr gre = ppr name <+> pp_parent (nameParent_maybe name)
-		<+> parens (pprNameProvenance gre)
+  ppr gre = ppr name <+> parens (pprNameProvenance gre)
 	  where
 	    name = gre_name gre
 	    pp_parent (Just p) = brackets (text "parent:" <+> ppr p)
@@ -428,6 +422,35 @@ plusGRE :: GlobalRdrElt -> GlobalRdrElt -> GlobalRdrElt
 plusGRE g1 g2
   = GRE { gre_name = gre_name g1,
 	  gre_prov = gre_prov g1 `plusProv` gre_prov 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_name = name, 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}
 
 
@@ -529,8 +552,10 @@ 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))]
+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".