X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Frename%2FRnExpr.lhs;h=95d7b8307e003131dd33dcc111d63e4c784b2b81;hb=9d7da331989abcd1844e9d03b8d1e4163796fa85;hp=c25208067092eb7518bd66191e0ec95727f2f676;hpb=17d0932b746599cba8f504bedf45fd5236885677;p=ghc-hetmet.git

diff --git a/ghc/compiler/rename/RnExpr.lhs b/ghc/compiler/rename/RnExpr.lhs
index c2520806..95d7b83 100644
--- a/ghc/compiler/rename/RnExpr.lhs
+++ b/ghc/compiler/rename/RnExpr.lhs
@@ -30,14 +30,13 @@ import RnTypes		( rnHsTypeFVs, rnLPat, rnOverLit, rnPatsAndThen, rnLit,
 			  dupFieldErr, checkTupSize )
 import DynFlags		( DynFlag(..) )
 import BasicTypes	( FixityDirection(..) )
-import PrelNames	( hasKey, assertIdKey, assertErrorName,
+import PrelNames	( thFAKE, hasKey, assertIdKey, assertErrorName,
 			  loopAName, choiceAName, appAName, arrAName, composeAName, firstAName,
 			  negateName, thenMName, bindMName, failMName )
 import Name		( Name, nameOccName, nameIsLocalOrFrom )
 import NameSet
 import RdrName		( RdrName, emptyGlobalRdrEnv, extendLocalRdrEnv, lookupLocalRdrEnv )
 import LoadIface	( loadHomeInterface )
-import UnicodeUtil	( stringToUtf8 )
 import UniqFM		( isNullUFM )
 import UniqSet		( emptyUniqSet )
 import List		( nub )
@@ -546,17 +545,32 @@ rnBracket (TypBr t) = do { (t', fvs) <- rnHsTypeFVs doc t
 		      doc = ptext SLIT("In a Template-Haskell quoted type")
 rnBracket (DecBr group) 
   = do 	{ gbl_env  <- getGblEnv
-	; names    <- getLocalDeclBinders gbl_env group
-	; rdr_env' <- extendRdrEnvRn (tcg_mod gbl_env) emptyGlobalRdrEnv names
 
-	; setGblEnv (gbl_env { tcg_rdr_env = tcg_rdr_env gbl_env `plusOccEnv` rdr_env',
+	; let gbl_env1 = gbl_env { tcg_mod = thFAKE }
+	-- Note the thFAKE.  The top-level names from the bracketed 
+	-- declarations will go into the name cache, and we don't want them to 
+	-- confuse the Names for the current module.  
+	-- By using a pretend module, thFAKE, we keep them safely out of the way.
+
+	; names    <- getLocalDeclBinders gbl_env1 group
+	; rdr_env' <- extendRdrEnvRn emptyGlobalRdrEnv names
+	-- Furthermore, the names in the bracket shouldn't conflict with
+	-- existing top-level names E.g.
+	--	foo = 1
+	--	bar = [d| foo = 1|]
+	-- But both 'foo's get a LocalDef provenance, so we'd get a complaint unless
+	-- we start with an emptyGlobalRdrEnv
+
+	; setGblEnv (gbl_env { tcg_rdr_env = tcg_rdr_env gbl_env1 `plusOccEnv` rdr_env',
 			       tcg_dus = emptyDUs }) $ do
 		-- Notice plusOccEnv, not plusGlobalRdrEnv.  In this situation we want
-		-- to *shadow* top-level bindings.  E.g.
-		--	foo = 1
-		--	bar = [d| foo = 1|]
-		-- So we drop down to plusOccEnv.  (Perhaps there should be a fn in RdrName.)
-		--	
+		-- to *shadow* top-level bindings.  (See the 'foo' example above.)
+		-- If we don't shadow, we'll get an ambiguity complaint when we do 
+		-- a lookupTopBndrRn (which uses lookupGreLocalRn) on the binder of the 'foo'
+		--
+		-- Furthermore, arguably if the splice does define foo, that should hide
+		-- any foo's further out
+		--
 		-- The emptyDUs is so that we just collect uses for this group alone
 
 	{ (tcg_env, group') <- rnSrcDecls group
@@ -917,7 +931,7 @@ mkAssertErrorExpr
   = getSrcSpanM    			`thenM` \ sloc ->
     let
 	expr = HsApp (L sloc (HsVar assertErrorName)) (L sloc (HsLit msg))
-	msg  = HsStringPrim (mkFastString (stringToUtf8 (showSDoc (ppr sloc))))
+	msg  = HsStringPrim (mkFastString (showSDoc (ppr sloc)))
     in
     returnM (expr, emptyFVs)
 \end{code}