Tagless-Final

Tgless.hs

{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE DataKinds #-}

import Data.Tagged
import GHC.TypeLits

-- standard list datatype
data List = N | C Int List

-- tagless final list
class TgList tg where
  nil :: tg
  cons :: Int -> tg -> tg

-- List is initial algebra
instance TgList List where
  nil = N
  cons = C

-- folding
sum_of_List :: List -> Int
sum_of_List N = 0
sum_of_List (C x xs) = x + sum_of_List xs

product_of_List :: List -> Int
product_of_List N = 1
product_of_List (C x xs) = x * product_of_List xs

-- tagless final list folding
-- List -> X <=> TgList X
instance TgList (Tagged "sum_of_List" Int) where
  nil = 0
  cons m (Tagged n) = Tagged $ m + n

instance TgList (Tagged "product_of_List" Int) where
  nil = 1
  cons m (Tagged n) = Tagged $ m * n

-- sum_of_List [1,2,3] == 6
sum_of_123 :: Tagged "sum_of_List" Int
sum_of_123 = cons 1 (cons 2 (cons 3 nil))

-- product_of_List [1,2,3,4] == 24
product_of_123 :: Tagged "product_of_List" Int
product_of_123 = cons 1 (cons 2 (cons 3 (cons 4 nil)))



-- data List2 = N | C Int List2 | C2 Int Int List2
class (TgList tg) => TgList2 tg where
  cons2 :: Int -> Int -> tg -> tg

data List2 = N2 | C2 Int List2 | C22 Int Int List2
  deriving (Eq, Show)

instance TgList List2 where
  nil = N2
  cons = C2
  
instance TgList2 List2 where
  cons2 = C22

-- sum_of_List
instance TgList2 (Tagged "sum_of_List" Int) where
  cons2 m n (Tagged p) = Tagged $ m + n + p

-- sum_of_List2 [1,(2,3),4] == 10
sum_of_123' :: Tagged "sum_of_List" Int
sum_of_123' = cons 1 (cons2 2 3 (cons 4 nil))



-- map between tagless final representations
-- duplication : List --> List2
-- <=> TgList List2
instance TgList2 tg => TgList (Tagged "duplication" tg) where
  nil = Tagged nil
  cons m (Tagged n) = Tagged $ cons2 m m n

-- duplicate [1,2,3] == [(1,1),(2,2),(3,3)]
duplicate_123 :: Tagged "duplication" List2
duplicate_123 = cons 1 (cons 2 (cons 3 nil))

main = do
  print sum_of_123
  print product_of_123
  print sum_of_123'
  print duplicate_123