# Drastic Prelude changes imminent

Edward Kmett ekmett at gmail.com
Sun Feb 1 21:26:15 UTC 2015

```I didn't say arbitrary.

At the risk of an overly complicated example, just because I have it handy:

In the following type: rep 1000 "a" folds in logarithmic time, lots of
operations actually get to exploit the obliviousness of (*>) and (<*) and
(>>) to one argument or the other's values to exploit replication heavily
for parts of the result as well. This is needed to match the asymptotics of
Fritz Henglein's linear time table joins in a final encoding for instance.

data Table a = Table

{ count :: {-# UNPACK #-} !Int

, runTable :: forall r. Monoid r => (a -> r) -> r

}

instance IsList (Table a) where

type Item (Table a) = a

fromList  = foldMap pure

toList    = Foldable.toList

fromListN n xs = Table n (`foldMap` xs)

instance Functor Table where

fmap f (Table i m) = Table i \$ \k -> m (k.f)

instance Foldable Table where

foldMap f (Table _ m) = m f

foldr f z (Table _ m) = m (Endo . f) `appEndo` z

instance Monoid (Table a) where

mempty = Table 0 \$ \_ -> mempty

mappend (Table i m) (Table j n) = Table (i + j) \$ \k -> m k `mappend` n k

newtype Ap f a = Ap { runAp :: f a }

instance (Applicative f, Monoid a) => Monoid (Ap f a) where

mempty = Ap (pure mempty)

mappend (Ap m) (Ap n) = Ap (liftA2 mappend m n)

instance Traversable Table where

-- this reassembles the result with sharing!

traverse f = runAp . foldMap (Ap . fmap pure . f)

instance Applicative Table where

pure a = Table 1 \$ \k -> k a

Table n as <*> Table m bs = Table (n * m) \$ \k -> as \$ \f -> bs (k . f)

Table n as <*  Table m _  = Table (n * m) \$ \k -> as (rep m . k)

Table n _   *> Table m bs = Table (n * m) \$ rep n . bs

-- peasant multiplication

rep :: Monoid m => Int -> m -> m

rep y0 x0

| y0 <= 0   = mempty

| otherwise = f x0 y0

where

f x y

| even y = f (mappend x x) (quot y 2)

| y == 1 = x

| otherwise = g (mappend x x) (quot (y - 1) 2) x

g x y z

| even y = g (mappend x x) (quot y 2) z

| y == 1 = mappend x z

| otherwise = g (mappend x x) (quot (y - 1) 2) (mappend x z)

bag :: (forall m. Monoid m => (a -> m) -> m) -> Table a

bag k = Table (getSum \$ k \$ \_ -> Sum 1) k

return a = Table 1 \$ \k -> k a

as >>= f = bag \$ \k -> runTable as \$ \a -> runTable (f a) k

(>>) = (*>)

fail _ = empty

-- we can handle this in a smarter fashion now

mzipWith k m n = foldMap pure \$ mzipWith k (Foldable.toList m)
(Foldable.toList n)

munzip m = (fmap fst m, fmap snd m)

instance Alternative Table where

empty = Table 0 \$ \_ -> mempty

Table m as <|> Table n bs = Table (m + n) \$ \k -> as k `mappend` bs k

mzero = Table 0 \$ \_ -> mempty

Table m as `mplus` Table n bs = Table (m + n) \$ \k -> as k `mappend` bs k

mfix a2ba = foldMap pure \$ mfix (Foldable.toList . a2ba)

etc.

On Sun, Feb 1, 2015 at 4:17 PM, Roman Cheplyaka <roma at ro-che.info> wrote:

> On 01/02/15 22:56, Edward Kmett wrote:
> >     sum = getSum . foldMap sum
> >
> >     is the implementation that ensures that it doesn't destroy the
> >     asymptotics of the number of uses of 'mappend' in foldMap.
> >
> >     The right container can readily fold 2^20th a's with 20 mappends.
>
> Fold 2^20 *arbitrary* a's? What kind of container is that?
>
> Roman
>
-------------- next part --------------
An HTML attachment was scrubbed...