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