f1ce2091a9772b81c61a0e48385a29d654b1b102
[ghc.git] / testsuite / tests / simplCore / should_compile / T5359b.hs
1 {-# LANGUAGE TypeFamilies #-}
2 {-# LANGUAGE FlexibleInstances #-}
3 {-# LANGUAGE FlexibleContexts #-}
4 {-# LANGUAGE TypeOperators #-}
5
6 module T5359b where
7
8 -----------------------------------------------------------------------------
9 -- Base
10 -----------------------------------------------------------------------------
11 infixr 5 :+:
12 infixr 6 :*:
13
14 data U = U
15 data a :+: b = L a | R b
16 data a :*: b = a :*: b
17 newtype Rec a = Rec a
18
19 class Representable a where
20 type Rep a
21 to :: Rep a -> a
22 from :: a -> Rep a
23
24
25 data Tree = Leaf | Bin Int Tree Tree
26
27 instance Representable Tree where
28 type Rep Tree = U
29 :+: (Rec Int :*: Rec Tree :*: Rec Tree)
30
31 from (Bin x l r) = R ((Rec x :*: Rec l :*: Rec r))
32 from Leaf = L (U)
33
34 to (R ((Rec x :*: (Rec l) :*: (Rec r)))) = Bin x l r
35 to (L (U)) = Leaf
36
37 --------------------------------------------------------------------------------
38 -- Generic enum
39 --------------------------------------------------------------------------------
40
41 class Enum' a where
42 enum' :: [a]
43
44 instance Enum' U where enum' = undefined
45 instance (Enum' a) => Enum' (Rec a) where enum' = undefined
46 instance (Enum' f, Enum' g) => Enum' (f :+: g) where enum' = undefined
47 instance (Enum' f, Enum' g) => Enum' (f :*: g) where enum' = undefined
48
49
50 -- This INLINE pragma is essential for the bug
51 {-# INLINE genum #-}
52 genum :: (Representable a, Enum' (Rep a)) => [a]
53 -- The definition of genum is essential for the bug
54 genum = map to enum'
55
56
57 instance Enum' Tree where enum' = genum
58 instance Enum' Int where enum' = []
59
60 -- This SPECIALISE pragma is essential for the bug
61 {-# SPECIALISE genum :: [Tree] #-}