From d6406966932bbee4d75bd267d4df282d44124063 Mon Sep 17 00:00:00 2001
From: simonpj <unknown>
Date: Wed, 24 Apr 2002 10:12:53 +0000
Subject: [PATCH] [project @ 2002-04-24 10:12:52 by simonpj] Do the
 scoped-tyvar fix right this time

---
 ghc/compiler/rename/RnSource.lhs |   18 +++++++++++++++---
 ghc/compiler/rename/RnTypes.lhs  |   12 +++++-------
 2 files changed, 20 insertions(+), 10 deletions(-)

diff --git a/ghc/compiler/rename/RnSource.lhs b/ghc/compiler/rename/RnSource.lhs
index a5339e6..647cf6c 100644
--- a/ghc/compiler/rename/RnSource.lhs
+++ b/ghc/compiler/rename/RnSource.lhs
@@ -187,7 +187,7 @@ finishSourceInstDecl (InstDecl _       mbinds uprags _               _      )
 	-- Rename the bindings
 	-- NB meth_names can be qualified!
     checkDupNames meth_doc meth_names 		`thenRn_`
-    extendTyVarEnvFVRn (map hsTyVarName inst_tyvars) (		
+    extendTyVarEnvForMethodBinds inst_tyvars (		
 	rnMethodBinds cls [] mbinds
     )						`thenRn` \ (mbinds', meth_fvs) ->
     let 
@@ -345,7 +345,7 @@ rnTyClDecl (ClassDecl {tcdCtxt = context, tcdName = cname,
 	-- we jolly well ought to get a 'hit' there!
     mapRn lookupSysBinder names			`thenRn` \ names' ->
 
-	-- Tyvars scope over bindings and context
+	-- Tyvars scope over superclass context and method signatures
     bindTyVarsRn cls_doc tyvars			$ \ tyvars' ->
 
 	-- Check the superclasses
@@ -420,7 +420,7 @@ finishSourceTyClDecl (ClassDecl {tcdMeths = Just mbinds, tcdLoc = src_loc})	-- G
 	-- easy to group together in the typechecker.  
 	-- Hence the 
     pushSrcLocRn src_loc				$
-    extendTyVarEnvFVRn (map hsTyVarName tyvars)		$
+    extendTyVarEnvForMethodBinds tyvars			$
     getLocalNameEnv					`thenRn` \ name_env ->
     let
 	meth_rdr_names_w_locs = collectLocatedMonoBinders mbinds
@@ -447,6 +447,18 @@ finishSourceTyClDecl _ tycl_decl = returnRn (tycl_decl, emptyFVs)
 	-- Not a class declaration
 \end{code}
 
+For the method bindings in class and instance decls, we extend the 
+type variable environment iff -fglasgow-exts
+
+\begin{code}
+extendTyVarEnvForMethodBinds tyvars thing_inside
+  = doptRn Opt_GlasgowExts			`thenRn` \ opt_GlasgowExts ->
+    if opt_GlasgowExts then
+	extendTyVarEnvFVRn (map hsTyVarName tyvars) thing_inside
+    else
+	thing_inside
+\end{code}
+
 
 %*********************************************************
 %*							*
diff --git a/ghc/compiler/rename/RnTypes.lhs b/ghc/compiler/rename/RnTypes.lhs
index afe921d..6366201 100644
--- a/ghc/compiler/rename/RnTypes.lhs
+++ b/ghc/compiler/rename/RnTypes.lhs
@@ -19,7 +19,6 @@ import RdrName	( elemRdrEnv )
 import NameSet	( FreeVars )
 import Unique	( Uniquable(..) )
 
-import CmdLineOpts	( DynFlag(Opt_GlasgowExts) )
 import List		( nub )
 import ListSetOps	( removeDupsEq )
 import Outputable
@@ -65,17 +64,16 @@ rnHsType doc (HsForAllTy Nothing ctxt ty)
 	-- Given the signature  C => T  we universally quantify 
 	-- over FV(T) \ {in-scope-tyvars} 
   = getLocalNameEnv		`thenRn` \ name_env ->
-    doptRn Opt_GlasgowExts	`thenRn` \ opt_GlasgowExts ->
     let
 	mentioned_in_tau  = extractHsTyRdrTyVars ty
 	mentioned_in_ctxt = extractHsCtxtRdrTyVars ctxt
 	mentioned	  = nub (mentioned_in_tau ++ mentioned_in_ctxt)
 
-	-- Don't quantify over type variables that are in scope,
-	-- when GlasgowExts is on
-	forall_tyvars
-	   | opt_GlasgowExts = filter (not . (`elemRdrEnv` name_env)) mentioned
-	   | otherwise	     = mentioned
+	-- Don't quantify over type variables that are in scope;
+	-- when GlasgowExts is off, there usually won't be any, except for
+	-- class signatures:
+	--	class C a where { op :: a -> a }
+	forall_tyvars = filter (not . (`elemRdrEnv` name_env)) mentioned
     in
     rnForAll doc (map UserTyVar forall_tyvars) ctxt ty
 
-- 
1.7.10.4