From: simonpj <unknown>
Date: Thu, 19 May 2005 07:56:58 +0000 (+0000)
Subject: [project @ 2005-05-19 07:56:58 by simonpj]
X-Git-Tag: Initial_conversion_from_CVS_complete~514
X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=ead9311db6e098b3affdc552269ea52bad8c12b5

[project @ 2005-05-19 07:56:58 by simonpj]
Make sure the default methods are in scope
	in a Template Haskell splice

		Merge to STABLE

This was just a typo really; in TcRnDriver.tcTopSrcDecls there were two
tcl_envs, but one had a different name so we got the less up-to-date one.

Fixes SourceForge item #1194808

TH_spliceInst tests it.
---

diff --git a/ghc/compiler/typecheck/TcInstDcls.lhs b/ghc/compiler/typecheck/TcInstDcls.lhs
index dcf8986..8366dad 100644
--- a/ghc/compiler/typecheck/TcInstDcls.lhs
+++ b/ghc/compiler/typecheck/TcInstDcls.lhs
@@ -227,7 +227,7 @@ tcLocalInstDecl1 decl@(L loc (InstDecl poly_ty binds uprags))
 
 \begin{code}
 tcInstDecls2 :: [LTyClDecl Name] -> [InstInfo] 
-	     -> TcM (TcLclEnv, LHsBinds Id)
+	     -> TcM (LHsBinds Id, TcLclEnv)
 -- (a) From each class declaration, 
 --	generate any default-method bindings
 -- (b) From each instance decl
@@ -243,9 +243,10 @@ tcInstDecls2 tycl_decls inst_decls
 	; inst_binds_s <- mappM tcInstDecl2 inst_decls
 
 		-- Done
-	; tcl_env <- getLclEnv
-	; returnM (tcl_env, unionManyBags dm_binds_s	`unionBags`
-			    unionManyBags inst_binds_s) }
+	; let binds = unionManyBags dm_binds_s `unionBags` 
+		      unionManyBags inst_binds_s
+	; tcl_env <- getLclEnv		-- Default method Ids in here
+	; returnM (binds, tcl_env) }
 \end{code}
 
 ======= New documentation starts here (Sept 92)	 ==============
diff --git a/ghc/compiler/typecheck/TcRnDriver.lhs b/ghc/compiler/typecheck/TcRnDriver.lhs
index 309f616..c0e3f5f 100644
--- a/ghc/compiler/typecheck/TcRnDriver.lhs
+++ b/ghc/compiler/typecheck/TcRnDriver.lhs
@@ -690,12 +690,12 @@ tcTopSrcDecls boot_details
 		-- We also typecheck any extra binds that came out 
 		-- of the "deriving" process (deriv_binds)
         traceTc (text "Tc5") ;
-	(tc_val_binds, lcl_env) <- tcTopBinds (val_binds ++ deriv_binds) ;
-	setLclTypeEnv lcl_env 	$ do {
+	(tc_val_binds, tcl_env) <- tcTopBinds (val_binds ++ deriv_binds) ;
+	setLclTypeEnv tcl_env 	$ do {
 
 	     	-- Second pass over class and instance declarations, 
         traceTc (text "Tc6") ;
-	(tcl_env, inst_binds) <- tcInstDecls2 tycl_decls inst_infos ;
+	(inst_binds, tcl_env) <- tcInstDecls2 tycl_decls inst_infos ;
 	showLIE (text "after instDecls2") ;
 
 		-- Foreign exports
@@ -718,7 +718,7 @@ tcTopSrcDecls boot_details
 	      tcg_env' = tcg_env {  tcg_binds = tcg_binds tcg_env `unionBags` all_binds,
 				    tcg_rules = tcg_rules tcg_env ++ rules,
 				    tcg_fords = tcg_fords tcg_env ++ foe_decls ++ fi_decls } } ;
-  	return (tcg_env', lcl_env)
+  	return (tcg_env', tcl_env)
     }}}}}}
 \end{code}