Fix scoping of type variables in instances

This fixes Trac #12531:

   class Foo x where
     foo :: forall a . x a -> x a
     default foo :: forall b . x b -> x b
     foo x = go
       where go :: x b
             go = undefined

We want 'b' to scope over the code for 'foo', but we were
using 'a' instead.

1 files changed, 14 insertions, 17 deletions

diff --git a/compiler/rename/RnBinds.hs b/compiler/rename/RnBinds.hs
index a965a65e63..4af699a274 100644
--- a/compiler/rename/RnBinds.hs
+++ b/compiler/rename/RnBinds.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+
 {-
 (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 
@@ -547,24 +549,19 @@ depAnalBinds binds_w_dus
 mkSigTvFn :: [LSig Name] -> (Name -> [Name])
 -- Return a lookup function that maps an Id Name to the names
 -- of the type variables that should scope over its body.
-mkSigTvFn sigs
-  = \n -> lookupNameEnv env n `orElse` []
+mkSigTvFn sigs = \n -> lookupNameEnv env n `orElse` []
   where
-    env :: NameEnv [Name]
-    env = foldr add_scoped_sig emptyNameEnv sigs
-
-    add_scoped_sig :: LSig Name -> NameEnv [Name] -> NameEnv [Name]
-    add_scoped_sig (L _ (ClassOpSig _ names sig_ty)) env
-      = add_scoped_tvs names (hsScopedTvs sig_ty) env
-    add_scoped_sig (L _ (TypeSig names sig_ty)) env
-      = add_scoped_tvs names (hsWcScopedTvs sig_ty) env
-    add_scoped_sig (L _ (PatSynSig names sig_ty)) env
-      = add_scoped_tvs names (hsScopedTvs sig_ty) env
-    add_scoped_sig _ env = env
-
-    add_scoped_tvs :: [Located Name] -> [Name] -> NameEnv [Name] -> NameEnv [Name]
-    add_scoped_tvs id_names tv_names env
-      = foldr (\(L _ id_n) env -> extendNameEnv env id_n tv_names) env id_names
+    env = mkHsSigEnv get_scoped_tvs sigs
+
+    get_scoped_tvs :: LSig Name -> Maybe ([Located Name], [Name])
+    -- Returns (binders, scoped tvs for those binders)
+    get_scoped_tvs (L _ (ClassOpSig _ names sig_ty))
+      = Just (names, hsScopedTvs sig_ty)
+    get_scoped_tvs (L _ (TypeSig names sig_ty))
+      = Just (names, hsWcScopedTvs sig_ty)
+    get_scoped_tvs (L _ (PatSynSig names sig_ty))
+      = Just (names, hsScopedTvs sig_ty)
+    get_scoped_tvs _ = Nothing
 
 -- Process the fixity declarations, making a FastString -> (Located Fixity) map
 -- (We keep the location around for reporting duplicate fixity declarations.)