[Haskell-cafe] Church vs Boehm-Berarducci encoding of Lists
Dan Doel
dan.doel at gmail.com
Thu Sep 20 03:24:37 CEST 2012
On Wed, Sep 19, 2012 at 8:36 PM, wren ng thornton <wren at freegeek.org> wrote:
>> P.S. It is actually possible to write zip function using Boehm-Berarducci
>> encoding:
>> http://okmij.org/ftp/ftp/Algorithms.html#zip-folds
>
>
> Of course it is; I just never got around to doing it :)
If you do, you might want to consider not using the above method, as I
seem to recall it doing an undesirable amount of extra work (repeated
O(n) tail). One can do better with some controversial types (this is
not my idea originally; ski (don't know his real name) on freenode's
#haskell showed it to me a long time ago):
---- snip ----
{-# LANGUAGE PolymorphicComponents #-}
module ABC where
newtype L a = L { unL :: forall r. (a -> r -> r) -> r -> r }
nil :: L a
nil = L $ \_ z -> z
cons :: a -> L a -> L a
cons x (L xs) = L $ \f -> f x . xs f
newtype A a c = Roll { unroll :: (a -> A a c -> L c) -> L c }
type B a c = a -> A a c -> L c
zipWith :: (a -> b -> c) -> L a -> L b -> L c
zipWith f (L as) (L bs) = unroll (as consA nilA) (bs consB nilB)
where
-- nilA :: A a c
nilA = Roll $ const nil
-- consA :: a -> A a c -> A a c
consA x xs = Roll $ \k -> k x xs
-- nilB :: B a c
nilB _ _ = nil
-- consB :: b -> B a c -> B a c
consB y ys x xs = f x y `cons` unroll xs ys
---- snip ----
This traverses each list only once.
-- Dan
More information about the Haskell-Cafe
mailing list