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