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