[project @ 2002-04-24 10:12:52 by simonpj]

Do the scoped-tyvar fix right this time

diff --git a/ghc/compiler/rename/RnSource.lhs b/ghc/compiler/rename/RnSource.lhs
index a5339e6..647cf6c 100644 (file)
--- 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 (file)
--- 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