From c27ec458271ebbd88ff72a7ae7ad026dd6dcc76e Mon Sep 17 00:00:00 2001
From: simonpj <unknown>
Date: Wed, 29 Oct 2003 17:04:15 +0000
Subject: [PATCH] [project @ 2003-10-29 17:04:13 by simonpj] Declaration
 splices should shadow the top-level environment

---
 ghc/compiler/basicTypes/NameEnv.lhs |    2 --
 ghc/compiler/basicTypes/OccName.lhs |    4 +++-
 ghc/compiler/basicTypes/RdrName.lhs |    2 +-
 ghc/compiler/rename/RnExpr.lhs      |    9 +++++++--
 4 files changed, 11 insertions(+), 6 deletions(-)

diff --git a/ghc/compiler/basicTypes/NameEnv.lhs b/ghc/compiler/basicTypes/NameEnv.lhs
index fe3bcb3..ab0db1e 100644
--- a/ghc/compiler/basicTypes/NameEnv.lhs
+++ b/ghc/compiler/basicTypes/NameEnv.lhs
@@ -44,7 +44,6 @@ elemNameEnv    	 :: Name -> NameEnv a -> Bool
 unitNameEnv    	 :: Name -> a -> NameEnv a
 lookupNameEnv  	 :: NameEnv a -> Name -> Maybe a
 lookupNameEnv_NF :: NameEnv a -> Name -> a
-mapNameEnv	 :: (a->b) -> NameEnv a -> NameEnv b
 foldNameEnv	 :: (a -> b -> b) -> b -> NameEnv a -> b
 filterNameEnv	 :: (elt -> Bool) -> NameEnv elt -> NameEnv elt
 
@@ -60,7 +59,6 @@ extendNameEnvList= addListToUFM
 delFromNameEnv 	 = delFromUFM
 delListFromNameEnv = delListFromUFM
 elemNameEnv    	 = elemUFM
-mapNameEnv	 = mapUFM
 unitNameEnv    	 = unitUFM
 filterNameEnv	 = filterUFM
 
diff --git a/ghc/compiler/basicTypes/OccName.lhs b/ghc/compiler/basicTypes/OccName.lhs
index 2a242a0..cbbb433 100644
--- a/ghc/compiler/basicTypes/OccName.lhs
+++ b/ghc/compiler/basicTypes/OccName.lhs
@@ -18,7 +18,7 @@ module OccName (
 	-- The OccEnv type
 	OccEnv, emptyOccEnv, unitOccEnv, extendOccEnv,
 	lookupOccEnv, mkOccEnv, extendOccEnvList, elemOccEnv,
-	occEnvElts, foldOccEnv, plusOccEnv_C, extendOccEnv_C,
+	occEnvElts, foldOccEnv, plusOccEnv, plusOccEnv_C, extendOccEnv_C,
 
 
 	-- The OccSet type
@@ -281,6 +281,7 @@ elemOccEnv   :: OccName -> OccEnv a -> Bool
 foldOccEnv   :: (a -> b -> b) -> b -> OccEnv a -> b
 occEnvElts   :: OccEnv a -> [a]
 extendOccEnv_C :: (a->a->a) -> OccEnv a -> OccName -> a -> OccEnv a
+plusOccEnv     :: OccEnv a -> OccEnv a -> OccEnv a
 plusOccEnv_C   :: (a->a->a) -> OccEnv a -> OccEnv a -> OccEnv a
 
 emptyOccEnv  	 = emptyUFM
@@ -292,6 +293,7 @@ mkOccEnv         = listToUFM
 elemOccEnv	 = elemUFM
 foldOccEnv	 = foldUFM
 occEnvElts 	 = eltsUFM
+plusOccEnv	 = plusUFM
 plusOccEnv_C	 = plusUFM_C
 extendOccEnv_C   = addToUFM_C
 
diff --git a/ghc/compiler/basicTypes/RdrName.lhs b/ghc/compiler/basicTypes/RdrName.lhs
index f743100..cc58eb1 100644
--- a/ghc/compiler/basicTypes/RdrName.lhs
+++ b/ghc/compiler/basicTypes/RdrName.lhs
@@ -483,7 +483,7 @@ instance Ord ImportSpec where
 \begin{code}
 plusProv :: Provenance -> Provenance -> Provenance
 -- Choose LocalDef over Imported
--- There is an obscure bug lurking here, in the presence
+-- There is an obscure bug lurking here; in the presence
 -- of recursive modules, something can be imported *and* locally
 -- defined, and one might refer to it with a qualified name from
 -- the import -- but I'm going to ignore that because it makes
diff --git a/ghc/compiler/rename/RnExpr.lhs b/ghc/compiler/rename/RnExpr.lhs
index 24d3893..866b59c 100644
--- a/ghc/compiler/rename/RnExpr.lhs
+++ b/ghc/compiler/rename/RnExpr.lhs
@@ -28,7 +28,7 @@ import RdrHsSyn
 import RnHsSyn
 import TcRnMonad
 import RnEnv
-import RdrName		( plusGlobalRdrEnv )
+import OccName		( plusOccEnv )
 import RnNames		( importsFromLocalDecls )
 import RnTypes		( rnHsTypeFVs, rnPat, litFVs, rnOverLit, rnPatsAndThen,
 			  dupFieldErr, precParseErr, sectionPrecErr, patSigErr, checkTupSize )
@@ -637,7 +637,12 @@ rnBracket (DecBr group)
   = importsFromLocalDecls group `thenM` \ (rdr_env, avails) ->
 	-- Discard avails (not useful here)
 
-    updGblEnv (\gbl -> gbl { tcg_rdr_env = rdr_env `plusGlobalRdrEnv` tcg_rdr_env gbl }) $
+    updGblEnv (\gbl -> gbl { tcg_rdr_env = tcg_rdr_env gbl `plusOccEnv` rdr_env}) $
+	-- 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.)
 
     rnSrcDecls group	`thenM` \ (tcg_env, group') ->
 	-- Discard the tcg_env; it contains only extra info about fixity
-- 
1.7.10.4