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 #-}