Why do nested MaybeT's cause exponential allocation

Question

I have a program.

import Control.Monad
import Control.Monad.Identity
import Control.Monad.Trans.Maybe

import System.Environment

tryR :: Monad m => ([a] -> MaybeT m [a]) -> ([a] -> m [a])
tryR f x = do
  m <- runMaybeT (f x)
  case m of
    Just t -> return t
    Nothing -> return x

check :: MonadPlus m => Int -> m Int
check x = if x `mod` 2 == 0 then return (x `div` 2) else mzero

foo :: MonadPlus m => [Int] -> m [Int]
foo [] = return []
foo (x:xs) = liftM2 (:) (check x) (tryR foo xs)


runFoo :: [Int] -> [Int]
runFoo x = runIdentity $ tryR foo x

main :: IO ()
main = do
  [n_str] <- getArgs
  let n = read n_str :: Int
  print $ runFoo [2,4..n]

The main interesting thing about this program is that it can have many nested layers of MaybeT's. Here, doing so serves absolutely no purpose, but it did in the original program where I encountered this problem.

Care to take a guess of the time complexity of this program?

Okay, you cheated by reading the title of this question. Yes, it's exponential:

[jkoppel@dhcp-18-189-103-38:~/tmp]$ time ./ExpAlloc 50                                                                                                                                        (03-31 17:15)
[1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25]
./ExpAlloc 50  8.10s user 0.06s system 99% cpu 8.169 total
[jkoppel@dhcp-18-189-103-38:~/tmp]$ time ./ExpAlloc 52                                                                                                                                        (03-31 17:15)
[1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26]
./ExpAlloc 52  16.10s user 0.12s system 99% cpu 16.227 total
[jkoppel@dhcp-18-189-103-38:~/tmp]$ time ./ExpAlloc 54                                                                                                                                        (03-31 17:16)
[1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27]
./ExpAlloc 54  32.32s user 0.23s system 99% cpu 32.561 total

Some further inspection shows the reason is because it allocates an exponential amount of memory, which naturally takes an exponential amount of time:

[jkoppel@dhcp-18-189-103-38:~/tmp]$ time ./ExpAlloc 40 +RTS -s                                                                                                                                (03-31 17:17)
[1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20]
     939,634,520 bytes allocated in the heap
       5,382,816 bytes copied during GC
          75,808 bytes maximum residency (2 sample(s))
          66,592 bytes maximum slop
               2 MB total memory in use (0 MB lost due to fragmentation)

                                     Tot time (elapsed)  Avg pause  Max pause
  Gen  0      1796 colls,     0 par    0.008s   0.009s     0.0000s    0.0000s
  Gen  1         2 colls,     0 par    0.000s   0.000s     0.0001s    0.0001s

  INIT    time    0.000s  (  0.000s elapsed)
  MUT     time    0.243s  (  0.246s elapsed)
  GC      time    0.008s  (  0.009s elapsed)
  EXIT    time    0.000s  (  0.000s elapsed)
  Total   time    0.252s  (  0.256s elapsed)

  %GC     time       3.2%  (3.6% elapsed)

  Alloc rate    3,869,930,149 bytes per MUT second

  Productivity  96.8% of total user, 95.3% of total elapsed

./ExpAlloc 40 +RTS -s  0.25s user 0.00s system 98% cpu 0.260 total
[jkoppel@dhcp-18-189-103-38:~/tmp]$ time ./ExpAlloc 42 +RTS -s                                                                                                                                (03-31 17:17)
[1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21]
   1,879,159,424 bytes allocated in the heap
      10,767,048 bytes copied during GC
          95,504 bytes maximum residency (3 sample(s))
          71,152 bytes maximum slop
               2 MB total memory in use (0 MB lost due to fragmentation)

                                     Tot time (elapsed)  Avg pause  Max pause
  Gen  0      3593 colls,     0 par    0.016s   0.018s     0.0000s    0.0000s
  Gen  1         3 colls,     0 par    0.000s   0.000s     0.0001s    0.0001s

  INIT    time    0.000s  (  0.000s elapsed)
  MUT     time    0.493s  (  0.498s elapsed)
  GC      time    0.016s  (  0.018s elapsed)
  EXIT    time    0.000s  (  0.000s elapsed)
  Total   time    0.510s  (  0.517s elapsed)

  %GC     time       3.1%  (3.5% elapsed)

  Alloc rate    3,810,430,292 bytes per MUT second

  Productivity  96.8% of total user, 95.7% of total elapsed

./ExpAlloc 42 +RTS -s  0.51s user 0.01s system 99% cpu 0.521 total
[jkoppel@dhcp-18-189-103-38:~/tmp]$ time ./ExpAlloc 44 +RTS -s                                                                                                                                (03-31 17:17)
[1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22]
   3,758,208,408 bytes allocated in the heap
      21,499,312 bytes copied during GC
         102,056 bytes maximum residency (5 sample(s))
          73,784 bytes maximum slop
               2 MB total memory in use (0 MB lost due to fragmentation)

                                     Tot time (elapsed)  Avg pause  Max pause
  Gen  0      7186 colls,     0 par    0.032s   0.037s     0.0000s    0.0009s
  Gen  1         5 colls,     0 par    0.000s   0.001s     0.0001s    0.0001s

  INIT    time    0.000s  (  0.000s elapsed)
  MUT     time    0.979s  (  0.987s elapsed)
  GC      time    0.033s  (  0.038s elapsed)
  EXIT    time    0.000s  (  0.000s elapsed)
  Total   time    1.013s  (  1.024s elapsed)

  %GC     time       3.2%  (3.7% elapsed)

  Alloc rate    3,840,757,815 bytes per MUT second

  Productivity  96.7% of total user, 95.6% of total elapsed

./ExpAlloc 44 +RTS -s  1.01s user 0.01s system 99% cpu 1.029 total

I cannot for the life of me figure out why it does this. I'd appreciate any light people could shed on the situation.

Answer 1

The transformers package (currently at version 0.5.4.0) implements MonadTrans using liftM:

lift :: Monad m => m a -> MaybeT m a
lift = MaybeT . liftM Just

where liftM is a combinator defined as

liftM :: Monad m => (a -> b) -> m a -> m b
liftM f m = m >>= \a -> return (f a)

Furthermore, return is defined for MaybeT as

return :: Monad m => a -> MaybeT m a
return a = lift . return

Reduce the definition:

return :: Monad m => a -> MaybeT m a
return a = MaybeT (return a >>= \a -> return (Just a))

where the two inner return are instantiated at type m.

One call to return @(MaybeT m) calls return @m twice, hence the exponential behavior you observe for a tower of MaybeT.

This is fixable by using fmap instead of liftM, but this is backwards incompatible, when Functor was not a superclass of Monad.

EDIT: Other transformers do not have this issue, as return is not defined using lift, which provides an even better fix.

return = MaybeT . return . Just

---

Here is a more minimal test case:

{-# LANGUAGE RankNTypes, ScopedTypeVariables #-}
import Control.Monad.Trans.Maybe
import System.Environment

f :: forall m proxy. Monad m => proxy m -> Int -> ()
f _ 0 = (return () :: m ()) `seq` ()
f _ n = f (undefined :: proxy (MaybeT m)) (n - 1)

main = do
  n : _ <- getArgs
  f (undefined :: proxy []) (read n) `seq` return ()

Output

> for i in {18..21} ; time ./b $i
./b $i  0.35s user 0.04s system 99% cpu 0.390 total
./b $i  0.71s user 0.07s system 99% cpu 0.782 total
./b $i  1.38s user 0.18s system 99% cpu 1.565 total
./b $i  2.82s user 0.32s system 100% cpu 3.139 total