Merge branch 'master' into atomics
[ghc.git] / testsuite / tests / simplCore / should_compile / dfun-loop.hs
1 {-# LANGUAGE TypeFamilies, FlexibleContexts #-}
2
3 -- This one sent an earlier version of GHC into a
4 -- loop in the simplfier, because we allowed a RULE
5 -- to fire on a loop-breaker
6 --
7 -- Discovered by Roman L, Nov 09
8
9 module Roman where
10
11 data T a = T (T a)
12
13 type family F a
14 type instance F (T a) = Wrap (T a)
15
16 class B (F a) => C a where
17 toF :: a -> F a
18
19 go :: C a => a -> Int
20 {-# INLINE go #-}
21 go x = gow (toF x)
22
23 instance C a => C (T a) where
24 {-# INLINE toF #-}
25 toF x = Wrap x
26
27 newtype Wrap a = Wrap a
28
29 class B a where
30 dummy :: a
31
32 gow :: a -> Int
33
34 instance C a => B (Wrap a) where
35 {-# INLINE gow #-}
36 gow (Wrap x) = go x
37 dummy = error "urk"
38
39 foo :: C a => T a -> Int
40 foo t = let t' = T t in go t'
41