From 6195332e01b8b6e6ddfa109af36e4f0798c1ea6a Mon Sep 17 00:00:00 2001
From: simonpj <unknown>
Date: Thu, 13 Nov 2003 15:03:22 +0000
Subject: [PATCH] [project @ 2003-11-13 15:03:20 by simonpj] Maintain renaming
 envt during tyepcheck, so we can rename a splice

---
 ghc/compiler/typecheck/TcEnv.lhs     |   14 ++++++++++----
 ghc/compiler/typecheck/TcRnTypes.lhs |    4 ++++
 2 files changed, 14 insertions(+), 4 deletions(-)

diff --git a/ghc/compiler/typecheck/TcEnv.lhs b/ghc/compiler/typecheck/TcEnv.lhs
index 54c4eee..4668199 100644
--- a/ghc/compiler/typecheck/TcEnv.lhs
+++ b/ghc/compiler/typecheck/TcEnv.lhs
@@ -59,6 +59,7 @@ import Id		( idName, isLocalId )
 import Var		( TyVar, Id, mkTyVar, idType )
 import VarSet
 import VarEnv
+import RdrName		( extendLocalRdrEnv )
 import DataCon		( DataCon )
 import TyCon		( TyCon )
 import Class		( Class )
@@ -258,9 +259,12 @@ tcExtendTyVarEnv2 tv_pairs thing_inside
 		     thing_inside
 
 tc_extend_tv_env binds tyvars thing_inside
-  = getLclEnv	   `thenM` \ env@(TcLclEnv {tcl_env = le, tcl_tyvars = gtvs}) ->
+  = getLclEnv	   `thenM` \ env@(TcLclEnv {tcl_env = le, 
+					    tcl_tyvars = gtvs, 
+					    tcl_rdr = rdr_env}) ->
     let
  	le'        = extendNameEnvList le binds
+	rdr_env'   = extendLocalRdrEnv rdr_env (map fst binds)
 	new_tv_set = mkVarSet tyvars
     in
 	-- It's important to add the in-scope tyvars to the global tyvar set
@@ -270,7 +274,7 @@ tc_extend_tv_env binds tyvars thing_inside
 	-- class and instance decls, when we mustn't generalise the class tyvars
 	-- when typechecking the methods.
     tc_extend_gtvs gtvs new_tv_set		`thenM` \ gtvs' ->
-    setLclEnv (env {tcl_env = le', tcl_tyvars = gtvs'}) thing_inside
+    setLclEnv (env {tcl_env = le', tcl_tyvars = gtvs', tcl_rdr = rdr_env'}) thing_inside
 \end{code}
 
 
@@ -284,9 +288,10 @@ tcExtendLocalValEnv ids thing_inside
 	proc_lvl	    = proc_level (tcl_arrow_ctxt env)
 	extra_env	    = [(idName id, ATcId id th_lvl proc_lvl) | id <- ids]
 	le'		    = extendNameEnvList (tcl_env env) extra_env
+	rdr_env'	    = extendLocalRdrEnv (tcl_rdr env) (map idName ids)
     in
     tc_extend_gtvs (tcl_tyvars env) extra_global_tyvars	`thenM` \ gtvs' ->
-    setLclEnv (env {tcl_env = le', tcl_tyvars = gtvs'}) thing_inside
+    setLclEnv (env {tcl_env = le', tcl_tyvars = gtvs', tcl_rdr = rdr_env'}) thing_inside
 
 tcExtendLocalValEnv2 :: [(Name,TcId)] -> TcM a -> TcM a
 tcExtendLocalValEnv2 names_w_ids thing_inside
@@ -297,9 +302,10 @@ tcExtendLocalValEnv2 names_w_ids thing_inside
 	proc_lvl	    = proc_level (tcl_arrow_ctxt env)
 	extra_env	    = [(name, ATcId id th_lvl proc_lvl) | (name,id) <- names_w_ids]
 	le'		    = extendNameEnvList (tcl_env env) extra_env
+	rdr_env'	    = extendLocalRdrEnv (tcl_rdr env) (map fst names_w_ids)
     in
     tc_extend_gtvs (tcl_tyvars env) extra_global_tyvars	`thenM` \ gtvs' ->
-    setLclEnv (env {tcl_env = le', tcl_tyvars = gtvs'}) thing_inside
+    setLclEnv (env {tcl_env = le', tcl_tyvars = gtvs', tcl_rdr = rdr_env'}) thing_inside
 \end{code}
 
 
diff --git a/ghc/compiler/typecheck/TcRnTypes.lhs b/ghc/compiler/typecheck/TcRnTypes.lhs
index 8b5bc3b..f7896ee 100644
--- a/ghc/compiler/typecheck/TcRnTypes.lhs
+++ b/ghc/compiler/typecheck/TcRnTypes.lhs
@@ -261,6 +261,10 @@ data TcLclEnv		-- Changes as we move inside an expression
 	tcl_arrow_ctxt :: ArrowCtxt,	-- Arrow-notation context
 
 	tcl_rdr :: LocalRdrEnv,		-- Local name envt
+		-- Maintained during renaming, of course, but also during
+		-- type checking, solely so that when renaming a Template-Haskell
+		-- splice we have the right environment for the renamer.
+		-- 
 		--   Does *not* include global name envt; may shadow it
 		--   Includes both ordinary variables and type variables;
 		--   they are kept distinct because tyvar have a different
-- 
1.7.10.4