testsuite: Bump a performance tests
[ghc.git] / testsuite / tests / perf / compiler / T5321Fun.hs
1 {-# OPTIONS_GHC -freduction-depth=1000 #-}
2 {-# LANGUAGE
3 FlexibleContexts, FlexibleInstances, FunctionalDependencies,
4 MultiParamTypeClasses, TypeSynonymInstances,
5 TypeOperators, UndecidableInstances, TypeFamilies #-}
6 module T5321Fun where
7
8 -- As the below code demonstrates, the same issues demonstrated with
9 -- Functional Dependencies also appear with Type Families, although less
10 --horribly, as their code-path seems more optimized in the current
11 -- constraint solver:
12
13 -- Our running example, for simplicity's sake, is a type-level map of a
14 -- single function. For reference, here is the code for a simple
15 -- value-level map of a single function.
16
17 -- > vfoo = id
18 -- > mapfoo (x : xs) = vfoo x : mapfoo xs
19 -- > mapfoo [] = []
20
21 -- Because Haskell is a lazy language, this runs in O(n) time and constant stack.
22
23 -- We now lift map to the type level, to operate over HLists.
24
25 -- First, the basic HList types
26
27 infixr 3 :*
28 data x :* xs = x :* xs deriving Show
29 data HNil = HNil deriving Show
30
31 -- Next, a large boring HList
32
33 -- Adds ten cells
34 addData x = i :* i :* d :* d :* s :*
35 i :* i :* d :* d :* s :*
36 x
37 where i = 1 :: Int
38 d = 1 :: Double
39 s = ""
40
41 -- Has 70 cells.
42 sampleData = addData $ addData $ addData $ addData $ addData $
43 addData $ addData $
44 HNil
45
46
47 class TFoo x where
48 type TFooFun x
49 tfoo :: x -> TFooFun x
50 tfoo = undefined
51
52 instance TFoo Int where
53 type TFooFun Int = Double
54 instance TFoo Double where
55 type TFooFun Double = Int
56 instance TFoo String where
57 type TFooFun String = String
58
59 class THMapFoo1 as where
60 type THMapFoo1Res as
61 thMapFoo1 :: as -> THMapFoo1Res as
62
63 instance (TFoo a, THMapFoo1 as) => THMapFoo1 (a :* as) where
64 type THMapFoo1Res (a :* as) = TFooFun a :* THMapFoo1Res as
65 thMapFoo1 (x :* xs) = tfoo x :* thMapFoo1 xs
66
67 instance THMapFoo1 HNil where
68 type THMapFoo1Res HNil = HNil
69 thMapFoo1 _ = HNil
70
71 -- The following, when enabled, takes ~3.5s. This demonstrates that slowdown occurs with type families as well.
72
73 testTHMapFoo1 = thMapFoo1 sampleData
74
75 class THMapFoo2 acc as where
76 type THMapFoo2Res acc as
77 thMapFoo2 :: acc -> as -> THMapFoo2Res acc as
78
79 instance (TFoo a, THMapFoo2 (TFooFun a :* acc) as) => THMapFoo2 acc (a :* as) where
80 type THMapFoo2Res acc (a :* as) = THMapFoo2Res (TFooFun a :* acc) as
81 thMapFoo2 acc (x :* xs) = thMapFoo2 (tfoo x :* acc) xs
82
83 instance THMapFoo2 acc HNil where
84 type THMapFoo2Res acc HNil = acc
85 thMapFoo2 acc _ = acc
86
87 -- The following, when enabled, takes ~0.6s. This demonstrates that the
88 -- tail recursive transform fixes the slowdown with type families just as
89 -- with fundeps.
90
91 testTHMapFoo2 = thMapFoo2 HNil sampleData
92
93 class THMapFoo3 acc as where
94 type THMapFoo3Res acc as
95 thMapFoo3 :: acc -> as -> THMapFoo3Res acc as
96
97 instance (THMapFoo3 (TFooFun a :* acc) as, TFoo a) => THMapFoo3 acc (a :* as) where
98 type THMapFoo3Res acc (a :* as) = THMapFoo3Res (TFooFun a :* acc) as
99 thMapFoo3 acc (x :* xs) = thMapFoo3 (tfoo x :* acc) xs
100
101 instance THMapFoo3 acc HNil where
102 type THMapFoo3Res acc HNil = acc
103 thMapFoo3 acc _ = acc
104
105 -- The following, when enabled, also takes ~0.6s. This demonstrates that,
106 -- unlike the fundep case, the order of type class constraints does not,
107 -- in this instance, affect the performance of type families.
108
109 testTHMapFoo3 = thMapFoo3 HNil sampleData