[commit: ghc] master: Fix computation of dfun_tvs in mkNewTypeEqn (713ebd7)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/713ebd7cf03876c6bedc1be9fba8f60ccc5bc8f0/ghc

>---------------------------------------------------------------

commit 713ebd7cf03876c6bedc1be9fba8f60ccc5bc8f0
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Tue Feb 21 13:29:16 2017 +0000

    Fix computation of dfun_tvs in mkNewTypeEqn
    
    This bug was causing Trac #13297.
    
    We were recomputing ds_tvs, and doing it wrongly (by omitting
    variables that appear only in mtheta).  But actually plain 'tvs'
    is just fine.  So code deleted, and bug fixed.


>---------------------------------------------------------------

713ebd7cf03876c6bedc1be9fba8f60ccc5bc8f0
 compiler/typecheck/TcDeriv.hs                     | 7 +++----
 testsuite/tests/deriving/should_compile/T13297.hs | 9 +++++++++
 testsuite/tests/deriving/should_compile/all.T     | 1 +
 3 files changed, 13 insertions(+), 4 deletions(-)

diff --git a/compiler/typecheck/TcDeriv.hs b/compiler/typecheck/TcDeriv.hs
index 00869c4..55b7d6d 100644
--- a/compiler/typecheck/TcDeriv.hs
+++ b/compiler/typecheck/TcDeriv.hs
@@ -1177,7 +1177,7 @@ mkNewTypeEqn dflags overlap_mode tvs
           case mtheta of
            Just theta -> return $ GivenTheta $ DS
                { ds_loc = loc
-               , ds_name = dfun_name, ds_tvs = dfun_tvs
+               , ds_name = dfun_name, ds_tvs = tvs
                , ds_cls = cls, ds_tys = inst_tys
                , ds_tc = rep_tycon
                , ds_theta = theta
@@ -1185,7 +1185,7 @@ mkNewTypeEqn dflags overlap_mode tvs
                , ds_mechanism = mechanism }
            Nothing -> return $ InferTheta $ DS
                { ds_loc = loc
-               , ds_name = dfun_name, ds_tvs = dfun_tvs
+               , ds_name = dfun_name, ds_tvs = tvs
                , ds_cls = cls, ds_tys = inst_tys
                , ds_tc = rep_tycon
                , ds_theta = all_thetas
@@ -1258,7 +1258,6 @@ mkNewTypeEqn dflags overlap_mode tvs
         -- See Note [Newtype deriving superclasses] above
         sc_preds   :: [PredOrigin]
         cls_tyvars = classTyVars cls
-        dfun_tvs   = tyCoVarsOfTypesWellScoped inst_tys
         inst_ty    = mkTyConApp tycon tc_args
         inst_tys   = cls_tys ++ [inst_ty]
         sc_preds   = map (mkPredOrigin DerivOrigin TypeLevel) $
@@ -1278,7 +1277,7 @@ mkNewTypeEqn dflags overlap_mode tvs
           = [ mkPredOrigin (DerivOriginCoerce meth t1 t2) TypeLevel
                            (mkReprPrimEqPred t1 t2)
             | meth <- meths
-            , let (Pair t1 t2) = mkCoerceClassMethEqn cls dfun_tvs
+            , let (Pair t1 t2) = mkCoerceClassMethEqn cls tvs
                                          inst_tys rep_inst_ty meth ]
 
         all_thetas :: [ThetaOrigin]
diff --git a/testsuite/tests/deriving/should_compile/T13297.hs b/testsuite/tests/deriving/should_compile/T13297.hs
new file mode 100644
index 0000000..604a649
--- /dev/null
+++ b/testsuite/tests/deriving/should_compile/T13297.hs
@@ -0,0 +1,9 @@
+{-# Language TypeFamilies, StandaloneDeriving, GeneralizedNewtypeDeriving, UndecidableInstances #-}
+module T13297 where
+
+newtype N p m a = N (((CT p) m) a)
+deriving instance (CT p ~ f, Functor (f m)) => Functor (N p m)
+deriving instance (CT p ~ f, Applicative (f m)) => Applicative (N p m) -- panic when this line added
+
+class C p where
+    type CT p :: (* -> *) -> * -> *
diff --git a/testsuite/tests/deriving/should_compile/all.T b/testsuite/tests/deriving/should_compile/all.T
index e16bd95..5c3f970 100644
--- a/testsuite/tests/deriving/should_compile/all.T
+++ b/testsuite/tests/deriving/should_compile/all.T
@@ -84,3 +84,4 @@ test('T12688', normal, compile, [''])
 test('T12814', normal, compile, ['-Wredundant-constraints'])
 test('T13272', normal, compile, [''])
 test('T13272a', normal, compile, [''])
+test('T13297', normal, compile, [''])