Bump a few more performance regressions from Type-indexed Typeable
[ghc.git] / testsuite / tests / perf / compiler / T5321FD.hs
1 {-# OPTIONS_GHC -freduction-depth=1000 #-}
2 {-# LANGUAGE
3 FlexibleContexts, FlexibleInstances, FunctionalDependencies,
4 MultiParamTypeClasses, TypeSynonymInstances,
5 TypeOperators, UndecidableInstances, TypeFamilies #-}
6 module T5321FD where
7
8 -------- USES FUNCTIONAL DEPENDENCIES -------------
9
10 -- Our running example, for simplicity's sake, is a type-level map of a
11 -- single function. For reference, here is the code for a simple
12 -- value-level map of a single function.
13
14 -- vfoo = id
15 -- mapfoo (x : xs) = vfoo x : mapfoo xs
16 -- mapfoo [] = []
17
18 -- Because Haskell is a lazy language, this runs in O(n) time and constant stack.
19
20 -- We now lift map to the type level, to operate over HLists.
21
22 -- First, the basic HList types
23
24 infixr 3 :*
25 data x :* xs = x :* xs deriving Show
26 data HNil = HNil deriving Show
27
28 -- Next, a large boring HList
29
30 -- Adds ten cells
31 addData x = i :* i :* d :* d :* s :*
32 i :* i :* d :* d :* s :*
33 x
34 where i = 1 :: Int
35 d = 1 :: Double
36 s = ""
37
38 -- Has 70 cells.
39 sampleData = addData $ addData $ addData $ addData $ addData $
40 addData $ addData $
41 HNil
42
43 -- Next, a simple polymorphic function to map
44
45 class Foo x y | x -> y
46 where foo :: x -> y
47 foo = undefined
48
49 instance Foo Int Double
50 instance Foo Double Int
51 instance Foo String String
52
53 ------------------------
54 -- Now, our map
55
56 class HMapFoo1 as bs | as -> bs where
57 hMapFoo1 :: as -> bs
58
59 instance (Foo a b, HMapFoo1 as bs) => HMapFoo1 (a :* as) (b :* bs) where
60 hMapFoo1 (x :* xs) = foo x :* hMapFoo1 xs
61
62 instance HMapFoo1 HNil HNil where
63 hMapFoo1 _ = HNil
64
65 -- If we enable the following line, compilation time is ~ 9 seconds.
66
67 testHMapFoo1 = hMapFoo1 sampleData
68
69
70 ------------------------
71 class HMapFoo2 acc as bs | acc as -> bs where
72 hMapFoo2 :: acc -> as -> bs
73
74 instance (Foo a b, HMapFoo2 (b :* bs) as res) => HMapFoo2 bs (a :* as) res where
75 hMapFoo2 acc (x :* xs) = hMapFoo2 (foo x :* acc) xs
76
77 instance HMapFoo2 acc HNil acc where
78 hMapFoo2 acc _ = acc
79
80 -- If we enable the following line, compilation time is a much more satisfying ~0.5s.
81
82 testHMapFoo2 = hMapFoo2 HNil sampleData
83
84 ------------------------
85 -- But wait, there's trouble on the horizon! Consider the following version:
86
87 class HMapFoo3 acc as bs | acc as -> bs where
88 hMapFoo3 :: acc -> as -> bs
89
90 instance (HMapFoo3 (b :* bs) as res, Foo a b) => HMapFoo3 bs (a :* as) res where
91 hMapFoo3 acc (x :* xs) = hMapFoo3 (foo x :* acc) xs
92
93 instance HMapFoo3 acc HNil acc where
94 hMapFoo3 acc _ = acc
95
96 -- The only difference between hMapFoo2 and hMapFoo3 is that the order of
97 -- constraints on the inductive case has been reversed, with the
98 -- recursive constraint first and the immediately checkable constraint
99 -- second. Now, if we enable the following line, compilation time rockets
100 -- to ~6s!
101
102 testHMapFoo3 = hMapFoo3 HNil sampleData