Main.hs

{-# LANGUAGE ScopedTypeVariables, TypeFamilies #-}

module Main where

import Data.Proxy

class SpecList a where
    type List a :: *

    slNil       :: Proxy a -> List a
    slCons      :: a -> List a -> List a
    slLength    :: List a -> Int
    slFoldr     :: (a -> b -> b) -> b -> List a -> b
    slMap       :: SpecList b
                => (a -> b) -> List a -> List b
    slCase      :: List a -> b -> (a -> List a -> b) -> b

data IntList
  = ILNil
  | ILCons {-# UNPACK #-} !Int IntList

intListLength :: IntList -> Int
intListLength ILNil = 0
intListLength (ILCons _ l) = 1 + intListLength l

intListFoldr :: (Int -> b -> b) -> b -> IntList -> b
intListFoldr _ acc ILNil = acc
intListFoldr f acc (ILCons i rest) = f i (intListFoldr f acc rest)

intListMap :: forall b . SpecList b
           => (Int -> b) -> IntList -> List b
intListMap _ ILNil = slNil (Proxy::Proxy b)
intListMap f (ILCons i rest) = slCons (f i) (intListMap f rest)

instance SpecList Int where
  type List Int = IntList

  slNil (_ :: Proxy Int) = ILNil :: List Int
  slCons   = ILCons
  slLength = intListLength
  slFoldr  = intListFoldr
  slMap    = intListMap

  slCase ILNil        n _  = n
  slCase (ILCons i t) _ c  = c i t

fromList :: [Int] -> IntList
fromList [] = slNil (Proxy :: Proxy Int)
fromList (h : t) = slCons 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