Revert commits 53b30fac9fc30d9d85cc... and c8244f5cd31774de2e39... as they were not intended for master.

22 files changed, 66 insertions, 228 deletions

diff --git a/testsuite/tests/ghc-regress/generics/GEq/GEq.hs b/testsuite/tests/ghc-regress/generics/GEq/GEq.hs
deleted file mode 100644
index a878617e26..0000000000
--- a/testsuite/tests/ghc-regress/generics/GEq/GEq.hs
+++ /dev/null
@@ -1,47 +0,0 @@
-{-# LANGUAGE TypeOperators, Generics, FlexibleContexts, FlexibleInstances #-}
-
-module GEq where
-
-import GHC.Generics
-
-class GEq' f where
-  geq' :: f a -> f a -> Bool
-
-instance GEq' U1 where
-  geq' _ _ = True
-
-instance GEq' (K1 P c) where
-  geq' (K1 a) (K1 b) = undefined
-
-instance (GEq c) => GEq' (K1 R c) where
-  geq' (K1 a) (K1 b) = geq a b
-
--- No instances for P or Rec because geq is only applicable to types of kind *
-
-instance (GEq' a) => GEq' (M1 i c a) where
-  geq' (M1 a) (M1 b) = geq' a b
-
-instance (GEq' a, GEq' b) => GEq' (a :+: b) where
-  geq' (L1 a) (L1 b) = geq' a b
-  geq' (R1 a) (R1 b) = geq' a b
-  geq' _      _      = False
-
-instance (GEq' a, GEq' b) => GEq' (a :*: b) where
-  geq' (a1 :*: b1) (a2 :*: b2) = geq' a1 a2 && geq' b1 b2
-
-
-class GEq a where 
-  geq :: a -> a -> Bool
-  default geq :: (Representable0 a, GEq' (Rep0 a)) => a -> a -> Bool
-  geq x y = geq' (from0 x) (from0 y)
-
-
--- Base types instances (ad-hoc)
-instance GEq Char   where geq = (==)
-instance GEq Int    where geq = (==)
-instance GEq Float  where geq = (==)
-{-
--- Generic instances
-instance (GEq a) => GEq (Maybe a)
-instance (GEq a) => GEq [a]
--}
diff --git a/testsuite/tests/ghc-regress/generics/GEq/GEq1.stdout b/testsuite/tests/ghc-regress/generics/GEq/GEq1.stdout
deleted file mode 100644
index db029dea2a..0000000000
--- a/testsuite/tests/ghc-regress/generics/GEq/GEq1.stdout
+++ /dev/null
@@ -1,3 +0,0 @@
-False
-False
-True
diff --git a/testsuite/tests/ghc-regress/generics/GEq/Main.hs b/testsuite/tests/ghc-regress/generics/GEq/Main.hs
deleted file mode 100644
index 7cb9f95b85..0000000000
--- a/testsuite/tests/ghc-regress/generics/GEq/Main.hs
+++ /dev/null
@@ -1,31 +0,0 @@
-{-# LANGUAGE TypeOperators, Generics #-}
-
-module Main where
-
-import GHC.Generics hiding (C, D)
-import GEq
-
--- We should be able to generate a generic representation for these types
-
-data C = C0 | C1
-
-data D a = D0 | D1 { d11 :: a, d12 :: (D a) }
-
--- Example values
-c0 = C0
-c1 = C1
-
-d0 :: D Char
-d0 = D0
-d1 = D1 'p' D0
-
--- Generic instances
-instance            GEq C
-instance (GEq a) => GEq (D a)
-
--- Tests
-teq0 = geq c0 c1
-teq1 = geq d0 d1
-teq2 = geq d0 d0
-
-main = mapM_ print [teq0, teq1, teq2]
diff --git a/testsuite/tests/ghc-regress/generics/GEq/Makefile b/testsuite/tests/ghc-regress/generics/GEq/Makefile
deleted file mode 100644
index 1c39d1c1fe..0000000000
--- a/testsuite/tests/ghc-regress/generics/GEq/Makefile
+++ /dev/null
@@ -1,3 +0,0 @@
-TOP=../../../..
-include $(TOP)/mk/boilerplate.mk
-include $(TOP)/mk/test.mk
diff --git a/testsuite/tests/ghc-regress/generics/GEq/test.T b/testsuite/tests/ghc-regress/generics/GEq/test.T
deleted file mode 100644
index ae2cc994bb..0000000000
--- a/testsuite/tests/ghc-regress/generics/GEq/test.T
+++ /dev/null
@@ -1,3 +0,0 @@
-setTestOpts(only_compiler_types(['ghc']))
-
-test('GEq1', normal, multimod_compile_and_run, ['Main', ''])
\ No newline at end of file
diff --git a/testsuite/tests/ghc-regress/generics/Makefile b/testsuite/tests/ghc-regress/generics/Makefile
deleted file mode 100644
index 9101fbd40a..0000000000
--- a/testsuite/tests/ghc-regress/generics/Makefile
+++ /dev/null
@@ -1,3 +0,0 @@
-TOP=../../..
-include $(TOP)/mk/boilerplate.mk
-include $(TOP)/mk/test.mk
diff --git a/testsuite/tests/ghc-regress/generics/Uniplate/Main.hs b/testsuite/tests/ghc-regress/generics/Uniplate/Main.hs
deleted file mode 100644
index 90461d8145..0000000000
--- a/testsuite/tests/ghc-regress/generics/Uniplate/Main.hs
+++ /dev/null
@@ -1,20 +0,0 @@
-{-# LANGUAGE Generics #-}
-
-module Main where
-
-import GHC.Generics
-import Uniplate
-
-
-data Tree     = Leaf | Node Int Tree Tree deriving Show
-data Pair a b = Pair a b                  deriving Show
-
-instance Uniplate Tree
-instance Uniplate (Pair a b)
-
--- Tests
-t1 = children ('p')
-t2 = children (Pair "abc" (Pair "abc" 2))
-t3 = children (Node 2 Leaf Leaf)
-
-main = print (t1, t2, t3)
diff --git a/testsuite/tests/ghc-regress/generics/Uniplate/Makefile b/testsuite/tests/ghc-regress/generics/Uniplate/Makefile
deleted file mode 100644
index 1c39d1c1fe..0000000000
--- a/testsuite/tests/ghc-regress/generics/Uniplate/Makefile
+++ /dev/null
@@ -1,3 +0,0 @@
-TOP=../../../..
-include $(TOP)/mk/boilerplate.mk
-include $(TOP)/mk/test.mk
diff --git a/testsuite/tests/ghc-regress/generics/Uniplate/Uniplate.hs b/testsuite/tests/ghc-regress/generics/Uniplate/Uniplate.hs
deleted file mode 100644
index 85de94b12f..0000000000
--- a/testsuite/tests/ghc-regress/generics/Uniplate/Uniplate.hs
+++ /dev/null
@@ -1,53 +0,0 @@
-{-# LANGUAGE MultiParamTypeClasses      #-}

-{-# LANGUAGE TypeSynonymInstances       #-}

-{-# LANGUAGE FlexibleInstances          #-}

-{-# LANGUAGE FlexibleContexts           #-}

-{-# LANGUAGE TypeOperators              #-}

-{-# LANGUAGE Generics                   #-}

-{-# LANGUAGE IncoherentInstances        #-} -- necessary, unfortunately

-

-module Uniplate where

-

-import GHC.Generics

-

---------------------------------------------------------------------------------

--- Generic Uniplate

---------------------------------------------------------------------------------

-

-class Uniplate' f b where

-  children' :: f a -> [b]

-

-instance Uniplate' U1 a where

-  children' U1 = []

-

-instance Uniplate' (K1 i a) a where

-  children' (K1 a) = [a]

-

-instance Uniplate' (K1 i a) b where

-  children' (K1 _) = []

-

-instance (Uniplate' f b) => Uniplate' (M1 i c f) b where

-  children' (M1 a) = children' a

-

-instance (Uniplate' f b, Uniplate' g b) => Uniplate' (f :+: g) b where

-  children' (L1 a) = children' a

-  children' (R1 a) = children' a

-

-instance (Uniplate' f b, Uniplate' g b) => Uniplate' (f :*: g) b where

-  children' (a :*: b) = children' a ++ children' b 

-

-

-class Uniplate a where 

-  children :: a -> [a]

-  default children :: (Representable0 a, Uniplate' (Rep0 a) a) => a -> [a]

-  children = children' . from0

-

-

--- Base types instances

-instance Uniplate Char  where children _ = []

-instance Uniplate Int   where children _ = []

-instance Uniplate Float where children _ = []

-

-instance Uniplate [a] where

-  children []    = []

-  children (_:t) = [t]

diff --git a/testsuite/tests/ghc-regress/generics/Uniplate/Uniplate1.stdout b/testsuite/tests/ghc-regress/generics/Uniplate/Uniplate1.stdout
deleted file mode 100644
index f560e40162..0000000000
--- a/testsuite/tests/ghc-regress/generics/Uniplate/Uniplate1.stdout
+++ /dev/null
@@ -1 +0,0 @@
-("",[],[Leaf,Leaf])
diff --git a/testsuite/tests/ghc-regress/generics/Uniplate/test.T b/testsuite/tests/ghc-regress/generics/Uniplate/test.T
deleted file mode 100644
index 100c12a9c0..0000000000
--- a/testsuite/tests/ghc-regress/generics/Uniplate/test.T
+++ /dev/null
@@ -1,3 +0,0 @@
-setTestOpts(only_compiler_types(['ghc']))
-
-test('Uniplate1', normal, multimod_compile_and_run, ['Main', ''])
\ No newline at end of file
diff --git a/testsuite/tests/ghc-regress/generics/all.T b/testsuite/tests/ghc-regress/generics/all.T
deleted file mode 100644
index 9c91903f1f..0000000000
--- a/testsuite/tests/ghc-regress/generics/all.T
+++ /dev/null
@@ -1,7 +0,0 @@
-setTestOpts(only_compiler_types(['ghc']))
-
-test('canDoRep0', normal, compile, [''])
-
-test('cannotDoRep0', normal, compile_fail, [''])
-test('cannotDoRep1', normal, compile_fail, [''])
-test('cannotDoRep2', normal, compile_fail, [''])
diff --git a/testsuite/tests/ghc-regress/generics/canDoRep0.hs b/testsuite/tests/ghc-regress/generics/canDoRep0.hs
deleted file mode 100644
index 59e6c97ccb..0000000000
--- a/testsuite/tests/ghc-regress/generics/canDoRep0.hs
+++ /dev/null
@@ -1,14 +0,0 @@
-{-# LANGUAGE Generics #-}
-
-module ShouldCompile0 where
-
--- We should be able to generate a generic representation for these types
-data A
-
-data B a
-
-data C = C0 | C1
-
-data D a = D0 | D1 { d11 :: a, d12 :: (D a) }
-
-data E a = E0 a (E a) (D a)
diff --git a/testsuite/tests/ghc-regress/generics/cannotDoRep0.hs b/testsuite/tests/ghc-regress/generics/cannotDoRep0.hs
deleted file mode 100644
index 97ade74989..0000000000
--- a/testsuite/tests/ghc-regress/generics/cannotDoRep0.hs
+++ /dev/null
@@ -1,9 +0,0 @@
-{-# LANGUAGE DeriveRepresentable        #-}
-{-# LANGUAGE ExistentialQuantification  #-}
-
-module ShouldFail0 where
-
-import GHC.Generics
-
--- We do not support existential quantification
-data Dynamic = forall a. Dynamic a deriving Representable0
diff --git a/testsuite/tests/ghc-regress/generics/cannotDoRep1.hs b/testsuite/tests/ghc-regress/generics/cannotDoRep1.hs
deleted file mode 100644
index 49d7218974..0000000000
--- a/testsuite/tests/ghc-regress/generics/cannotDoRep1.hs
+++ /dev/null
@@ -1,8 +0,0 @@
-{-# LANGUAGE DeriveRepresentable #-}
-
-module ShouldFail1 where
-
-import GHC.Generics
-
--- We do not support datatypes with context
-data (Show a) => Context a = Context a deriving Representable0
diff --git a/testsuite/tests/ghc-regress/generics/cannotDoRep2.hs b/testsuite/tests/ghc-regress/generics/cannotDoRep2.hs
deleted file mode 100644
index 05161ab302..0000000000
--- a/testsuite/tests/ghc-regress/generics/cannotDoRep2.hs
+++ /dev/null
@@ -1,13 +0,0 @@
-{-# LANGUAGE DeriveRepresentable #-}
-{-# LANGUAGE StandaloneDeriving  #-}
-{-# LANGUAGE GADTs               #-}
-
-module ShouldFail2 where
-
-import GHC.Generics
-
--- We do not support GADTs
-data Term a where
-  Int :: Term Int
-
-deriving instance Representable0 (Term a)
diff --git a/testsuite/tests/ghc-regress/simplCore/should_run/simplrun009.hs b/testsuite/tests/ghc-regress/simplCore/should_run/simplrun009.hs
index 826cdeef77..af20fc7bdd 100644
--- a/testsuite/tests/ghc-regress/simplCore/should_run/simplrun009.hs
+++ b/testsuite/tests/ghc-regress/simplCore/should_run/simplrun009.hs
@@ -61,11 +61,8 @@ foo xss = Main.concatMap (\xs -> Main.map (+1) xs) xss
 instance StreamableSequence [] where
   stream = listToStream
   unstream = streamToList
-  -- These inline pragmas are useless (see #5084)
-{-
   {-# INLINE stream #-}
   {-# INLINE unstream #-}
--}
 
 listToStream :: [a] -> Stream a
 listToStream xs = Stream next xs
@@ -107,11 +104,8 @@ class StreamableSequence seq where
   unstream :: Stream a -> seq a
 
   -- axiom: stream . unstream = id
-  -- These inline pragmas are useless (see #5084)
-{-
   {-# INLINE stream #-}
   {-# INLINE unstream #-}
--}
 
 {-
 --version that does not require the sequence type
diff --git a/testsuite/tests/ghc-regress/typecheck/should_compile/T2573.hs b/testsuite/tests/ghc-regress/typecheck/should_compile/T2573.hs
new file mode 100644
index 0000000000..86d017618f
--- /dev/null
+++ b/testsuite/tests/ghc-regress/typecheck/should_compile/T2573.hs
@@ -0,0 +1,13 @@
+{-# LANGUAGE Generics, TypeOperators #-}

+

+-- Trac #2573

+

+module ShouldCompile where

+

+import GHC.Base

+

+class Tag a where

+   nCons :: a -> Int

+   nCons {| a :*: b |} _ = 1

+   nCons {| a :+: b |} _ = 1

+   nCons {| Unit |}    _ = 1

diff --git a/testsuite/tests/ghc-regress/typecheck/should_compile/all.T b/testsuite/tests/ghc-regress/typecheck/should_compile/all.T
index 004a6481b7..4c5f6ff3b8 100644
--- a/testsuite/tests/ghc-regress/typecheck/should_compile/all.T
+++ b/testsuite/tests/ghc-regress/typecheck/should_compile/all.T
@@ -296,6 +296,7 @@ test('LoopOfTheDay3', normal, compile, [''])
 
 test('T1470', normal, compile, [''])
 test('T2572', normal, compile, [''])
+test('T2573', normal, compile, [''])
 test('T2735', normal, compile, [''])
 test('T2799', normal, compile, [''])
 test('T3219', normal, compile, [''])
@@ -341,4 +342,4 @@ test('T4912', extra_clean(['T4912a.hi', 'T4912a.o']),
 
 test('T4952', normal, compile, [''])
 test('T4969', normal, compile, [''])
-test('T5120', normal, compile, [''])
+test('T5120', normal, compile, [''])
\ No newline at end of file
diff --git a/testsuite/tests/ghc-regress/typecheck/should_fail/all.T b/testsuite/tests/ghc-regress/typecheck/should_fail/all.T
index 12b8ce0b85..53c77a269e 100644
--- a/testsuite/tests/ghc-regress/typecheck/should_fail/all.T
+++ b/testsuite/tests/ghc-regress/typecheck/should_fail/all.T
@@ -150,6 +150,7 @@ test('tcfail159', normal, compile_fail, [''])
 test('tcfail160', normal, compile_fail, [''])
 test('tcfail161', normal, compile_fail, [''])
 test('tcfail162', normal, compile_fail, [''])
+test('tcfail163', normal, compile_fail, [''])
 test('tcfail164', normal, compile_fail, [''])
 test('tcfail165', normal, compile_fail, [''])
 test('tcfail166', normal, compile_fail, [''])
diff --git a/testsuite/tests/ghc-regress/typecheck/should_fail/tcfail163.hs b/testsuite/tests/ghc-regress/typecheck/should_fail/tcfail163.hs
new file mode 100644
index 0000000000..4ba1e2e586
--- /dev/null
+++ b/testsuite/tests/ghc-regress/typecheck/should_fail/tcfail163.hs
@@ -0,0 +1,29 @@
+
+{-# LANGUAGE ConstrainedClassMethods, Generics, Rank2Types, TypeOperators #-}
+
+-- Derivable type class with a higher-rank method
+-- Currently this does not work, but it crashed GHC 6.5, so
+-- this tests that the error message is civilised.
+  
+module Foo where
+
+import GHC.Base
+ 
+class ChurchEncode k where 
+ 
+  match :: k 
+      -> z 
+       -> (forall a b z. a -> b -> z)  {- product -} 
+       -> (forall a   z. a -> z)       {- left -} 
+       -> (forall a   z. a -> z)       {- right -} 
+       -> z 
+  
+  match {| Unit    |} Unit      unit prod left right = unit 
+  match {| a :*: b |} (x :*: y) unit prod left right = prod x y 
+  match {| a :+: b |} (Inl l)   unit prod left right = left l 
+  match {| a :+: b |} (Inr r)   unit prod left right = right r 
+  
+  
+instance ChurchEncode Bool 
+
+
diff --git a/testsuite/tests/ghc-regress/typecheck/should_fail/tcfail163.stderr b/testsuite/tests/ghc-regress/typecheck/should_fail/tcfail163.stderr
new file mode 100644
index 0000000000..60c8f736bd
--- /dev/null
+++ b/testsuite/tests/ghc-regress/typecheck/should_fail/tcfail163.stderr
@@ -0,0 +1,21 @@
+

+tcfail163.hs:12:1:

+    Generic method type is too complex

+        match :: forall k.

+                 ChurchEncode k =>

+                 forall z.

+                 k

+                 -> z

+                 -> (forall a b z. a -> b -> z)

+                 -> (forall a z. a -> z)

+                 -> (forall a z. a -> z)

+                 -> z

+        You can only use type variables, arrows, lists, and tuples

+    When checking the class method:

+      match :: k

+               -> z

+               -> (forall a b z. a -> b -> z)

+               -> (forall a z. a -> z)

+               -> (forall a z. a -> z)

+               -> z

+    In the class declaration for `ChurchEncode'