Testsuite: add test for #10767
[ghc.git] / testsuite / tests / deSugar / should_compile / T10767.hs
1 {-# LANGUAGE ScopedTypeVariables, TypeFamilies #-}
2
3 module Main where
4
5 {- ghc-7.8.4 and ghc-7.10.2 showed a confusing warning:
6
7 T10767.hs:43:1: Warning:
8 RULE left-hand side too complicated to desugar
9 Optimised lhs: case cobox_aWY
10 of _ [Occ=Dead] { GHC.Types.Eq# cobox ->
11 genLength @ Int $dSpecList_aWX
12 }
13 Orig lhs: case cobox_aWY of cobox_aWY { GHC.Types.Eq# cobox ->
14 genLength @ Int $dSpecList_aWX
15 }
16 -}
17
18 import Data.Proxy
19
20 class SpecList a where
21 type List a :: *
22
23 slCase :: List a -> b -> (a -> List a -> b) -> b
24
25 data IntList
26 = ILNil
27 | ILCons {-# UNPACK #-} !Int IntList
28 deriving (Show)
29
30 instance SpecList Int where
31 type List Int = IntList
32
33 slCase ILNil n _ = n
34 slCase (ILCons i t) _ c = c i t
35
36 fromList :: [Int] -> IntList
37 fromList [] = ILNil
38 fromList (h : t) = ILCons h (fromList t)
39
40 lst1 :: IntList
41 lst1 = fromList [1..10]
42
43 {-# SPECIALIZE genLength :: Proxy Int -> List Int -> Int #-}
44 genLength :: forall a . SpecList a => Proxy a -> List a -> Int
45 genLength p lst = slCase lst 0 (\(_ :: a) tail -> 1 + genLength p tail)
46
47 main :: IO ()
48 main = print (genLength (Proxy :: Proxy Int) lst1)