HList.hs

module HList
    ( H
    , repH
    , absH
    , myAppend
    ) where

type H a = [a] -> [a]

{-# INLINABLE repH #-}
repH :: [a] -> H a
repH xs = (xs ++)

{-# INLINABLE absH #-}
absH :: H a -> [a]
absH f = f []

-- Because we can't get unfolding for ++
myAppend :: [a] -> [a] -> [a]
myAppend []     ys = ys
myAppend (x:xs) ys = x : myAppend xs ys
{-# RULES "appendFix" [~] (++) = myAppend #-}

-- Algebra for repH
{-# RULES "repH []"  [~]               repH [] = id #-}
{-# RULES "repH (:)" [~] forall x xs.  repH (x:xs) = (x:) . repH xs #-}
{-# RULES "repH ++"  [~] forall xs ys. repH (xs ++ ys) = repH xs . repH ys #-}

-- Needed because the fusion rule we generate isn't too useful yet.
{-# RULES "repH-absH-fusion" [~] forall h. repH (absH h) = h #-}