Fix computation of dfun_tvs in mkNewTypeEqn
authorSimon Peyton Jones <simonpj@microsoft.com>
Tue, 21 Feb 2017 13:29:16 +0000 (13:29 +0000)
committerSimon Peyton Jones <simonpj@microsoft.com>
Tue, 21 Feb 2017 14:26:57 +0000 (14:26 +0000)
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.

compiler/typecheck/TcDeriv.hs
testsuite/tests/deriving/should_compile/T13297.hs [new file with mode: 0644]
testsuite/tests/deriving/should_compile/all.T

index 00869c4..55b7d6d 100644 (file)
@@ -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 (file)
index 0000000..604a649
--- /dev/null
@@ -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 :: (* -> *) -> * -> *
index e16bd95..5c3f970 100644 (file)
@@ -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, [''])