Fix support for deriving Generic1 for data families (FIX #9563)
authorJose Pedro Magalhaes <jpm@cs.ox.ac.uk>
Fri, 12 Sep 2014 16:44:12 +0000 (17:44 +0100)
committerJose Pedro Magalhaes <jpm@cs.ox.ac.uk>
Fri, 12 Sep 2014 16:44:12 +0000 (17:44 +0100)
compiler/typecheck/TcGenGenerics.lhs
testsuite/tests/generics/T9563.hs [new file with mode: 0644]
testsuite/tests/generics/all.T

index acdd654..158a1e7 100644 (file)
@@ -486,10 +486,11 @@ tc_mkRepFamInsts gk tycon metaDts mod =
                      -- `appT` = D Int a b (data families case)
                      Just (famtycon, apps) ->
                        -- `fam` = D
-                       -- `apps` = [Int, a]
-                       let allApps = apps ++
-                                     drop (length apps + length tyvars
-                                           - tyConArity famtycon) tyvar_args
+                       -- `apps` = [Int, a, b]
+                       let allApps = case gk of
+                                       Gen0 -> apps
+                                       Gen1 -> ASSERT(not $ null apps)
+                                               init apps
                        in [mkTyConApp famtycon allApps]
                      -- `appT` = D a b (normal case)
                      Nothing -> [mkTyConApp tycon tyvar_args]
diff --git a/testsuite/tests/generics/T9563.hs b/testsuite/tests/generics/T9563.hs
new file mode 100644 (file)
index 0000000..fd12865
--- /dev/null
@@ -0,0 +1,18 @@
+{-# LANGUAGE TypeFamilies       #-}
+{-# LANGUAGE DeriveGeneric      #-}
+{-# LANGUAGE FlexibleInstances  #-}
+{-# LANGUAGE StandaloneDeriving #-}
+
+module T9563 where
+
+import GHC.Generics
+
+data family F typ :: * -> *
+data A
+data instance F A a = AData a
+  deriving (Generic, Generic1)
+
+data family G a b c d
+data instance G Int b Float d = H deriving Generic
+
+deriving instance Generic1 (G Int b Float)
index 1231c61..df95fa6 100644 (file)
@@ -32,3 +32,4 @@ test('T7878', extra_clean(['T7878A.o'     ,'T7878A.hi'
 
 test('T8468', normal, compile_fail, [''])
 test('T8479', normal, compile, [''])
+test('T9563', normal, compile, [''])