Drastic Prelude changes imminent

[Edward Kmett]

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


instance Monad Table where

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

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

  (>>) = (*>)

  fail _ = empty


instance MonadZip Table where

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


instance MonadPlus Table where

  mzero = Table 0 $ \_ -> mempty

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


instance MonadFix Table where

  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...
URL: <http://www.haskell.org/pipermail/libraries/attachments/20150201/630b29a4/attachment-0001.html>