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