[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