Bump a few more performance regressions from Type-indexed Typeable
[ghc.git] / testsuite / tests / perf / compiler / T12707.hs
1 {-# LANGUAGE DeriveGeneric, DeriveDataTypeable, DefaultSignatures, FlexibleContexts, TypeOperators #-}
2 module SpeedTest (Bar (..), Foo0 (..), Foo1 (..), Foo2 (..), Foo3 (..)) where
3
4 import GHC.Generics
5 import Data.Typeable (Typeable)
6
7 -------------------------------------------------------------------------------
8 -- Generic class
9 -------------------------------------------------------------------------------
10
11 class Bar a where
12 bar :: a -> [String]
13 bar x = bar' x []
14
15 bar' :: a -> [String] -> [String]
16 default bar' :: (Generic a, GBar (Rep a)) => a -> [String] -> [String]
17 bar' x = gbar (from x)
18
19 class GBar f where
20 gbar :: f a -> [String] -> [String]
21
22 instance (GBar a, GBar b) => GBar (a :*: b) where
23 gbar (a :*: b) = gbar a . gbar b
24
25 instance GBar a => GBar (M1 i c a) where
26 gbar (M1 x) = gbar x
27
28 instance Bar a => GBar (K1 i a) where
29 gbar (K1 x) = bar' x
30
31 instance Bar a => Bar [a] where
32 bar' = foldr (.) id . map bar'
33
34 instance Bar a => Bar (Maybe a) where
35 bar' = maybe id bar'
36
37 instance Bar Bool where
38 bar' = (:) . show
39
40 instance Bar Char where
41 bar' = (:) . show
42
43 instance Bar Int where
44 bar' = (:) . show
45
46 -------------------------------------------------------------------------------
47 -- Another generic class
48 -------------------------------------------------------------------------------
49
50 class Quu a where
51 quu :: a -> [String]
52 quu x = quu' x []
53
54 quu' :: a -> [String] -> [String]
55 default quu' :: (Generic a, GQuu (Rep a)) => a -> [String] -> [String]
56 quu' x = gquu (from x)
57
58 class GQuu f where
59 gquu :: f a -> [String] -> [String]
60
61 instance (GQuu a, GQuu b) => GQuu (a :*: b) where
62 gquu (a :*: b) = gquu a . gquu b
63
64 instance GQuu a => GQuu (M1 i c a) where
65 gquu (M1 x) = gquu x
66
67 instance Quu a => GQuu (K1 i a) where
68 gquu (K1 x) = quu' x
69
70 instance Quu a => Quu [a] where
71 quu' = foldr (.) id . map quu'
72
73 instance Quu a => Quu (Maybe a) where
74 quu' = maybe id quu'
75
76 instance Quu Bool where
77 quu' = (:) . show
78
79 instance Quu Char where
80 quu' = (:) . show
81
82 instance Quu Int where
83 quu' = (:) . show
84
85 -------------------------------------------------------------------------------
86 -- Data
87 -------------------------------------------------------------------------------
88
89 data Foo0 = Foo0
90 { foo0Field00 :: !String -- Should really have Text
91 , foo0Field01 :: !Int
92 , foo0Field02 :: ![Int]
93 , foo0Field03 :: !(Maybe Bool)
94 , foo0Field04 :: !Bool
95 , foo0Field05 :: !String
96 , foo0Field06 :: !Int
97 , foo0Field07 :: ![Int]
98 , foo0Field08 :: !(Maybe Bool)
99 , foo0Field09 :: !Bool
100 , foo0Field10 :: !String
101 , foo0Field11 :: !Int
102 , foo0Field12 :: ![Int]
103 , foo0Field13 :: !(Maybe Bool)
104 , foo0Field14 :: !Bool
105 , foo0Field15 :: !String
106 , foo0Field16 :: !Int
107 , foo0Field17 :: ![Int]
108 , foo0Field18 :: !(Maybe Bool)
109 , foo0Field19 :: !Bool
110 }
111 deriving (Eq, Ord, Show, Typeable, Generic)
112
113 instance Bar Foo0
114 instance Quu Foo0
115
116 data Foo1 = Foo1
117 { foo1Field00 :: !String -- Should really have Text
118 , foo1Field01 :: !Int
119 , foo1Field02 :: ![Int]
120 , foo1Field03 :: !(Maybe Bool)
121 , foo1Field04 :: !Bool
122 , foo1Field05 :: !String
123 , foo1Field06 :: !Int
124 , foo1Field07 :: ![Int]
125 , foo1Field08 :: !(Maybe Bool)
126 , foo1Field09 :: !Bool
127 , foo1Field10 :: !String
128 , foo1Field11 :: !Int
129 , foo1Field12 :: ![Int]
130 , foo1Field13 :: !(Maybe Bool)
131 , foo1Field14 :: !Bool
132 , foo1Field15 :: !String
133 , foo1Field16 :: !Int
134 , foo1Field17 :: ![Int]
135 , foo1Field18 :: !(Maybe Bool)
136 , foo1Field19 :: !Bool
137 }
138 deriving (Eq, Ord, Show, Typeable, Generic)
139
140 instance Bar Foo1
141 instance Quu Foo1
142
143 data Foo2 = Foo2
144 { foo2Field00 :: !String -- Should really have Text
145 , foo2Field01 :: !Int
146 , foo2Field02 :: ![Int]
147 , foo2Field03 :: !(Maybe Bool)
148 , foo2Field04 :: !Bool
149 , foo2Field05 :: !String
150 , foo2Field06 :: !Int
151 , foo2Field07 :: ![Int]
152 , foo2Field08 :: !(Maybe Bool)
153 , foo2Field09 :: !Bool
154 , foo2Field10 :: !String
155 , foo2Field11 :: !Int
156 , foo2Field12 :: ![Int]
157 , foo2Field13 :: !(Maybe Bool)
158 , foo2Field14 :: !Bool
159 , foo2Field15 :: !String
160 , foo2Field16 :: !Int
161 , foo2Field17 :: ![Int]
162 , foo2Field18 :: !(Maybe Bool)
163 , foo2Field19 :: !Bool
164 }
165 deriving (Eq, Ord, Show, Typeable, Generic)
166
167 instance Bar Foo2
168 instance Quu Foo2
169
170 data Foo3 = Foo3
171 { foo3Field00 :: !String -- Should really have Text
172 , foo3Field01 :: !Int
173 , foo3Field02 :: ![Int]
174 , foo3Field03 :: !(Maybe Bool)
175 , foo3Field04 :: !Bool
176 , foo3Field05 :: !String
177 , foo3Field06 :: !Int
178 , foo3Field07 :: ![Int]
179 , foo3Field08 :: !(Maybe Bool)
180 , foo3Field09 :: !Bool
181 , foo3Field10 :: !String
182 , foo3Field11 :: !Int
183 , foo3Field12 :: ![Int]
184 , foo3Field13 :: !(Maybe Bool)
185 , foo3Field14 :: !Bool
186 , foo3Field15 :: !String
187 , foo3Field16 :: !Int
188 , foo3Field17 :: ![Int]
189 , foo3Field18 :: !(Maybe Bool)
190 , foo3Field19 :: !Bool
191 }
192 deriving (Eq, Ord, Show, Typeable, Generic)
193
194 instance Bar Foo3
195 instance Quu Foo3