Ackermann very inefficient with Haskell/GHC

Question

NB: The high memory usage issue is a bug in the GHC RTS, where upon stack overflow and allocation of new stacks on the heap it was not checked whether garbage collection is due. It has been already fixed in GHC HEAD.

I was able to get much better performance by CPS-converting ack:

module Main where

data P = P !Int !Int

main :: IO ()
main = print $ ack (P 4 1) id
  where
    ack :: P -> (Int -> Int) -> Int
    ack (P 0 n) k = k (n + 1)
    ack (P m 0) k = ack (P (m-1) 1) k
    ack (P m n) k = ack (P m (n-1)) (\a -> ack (P (m-1) a) k)

Your original function consumes all available memory on my machine, while this one runs in constant space.

$ time ./Test
65533
./Test  52,47s user 0,50s system 96% cpu 54,797 total

Ocaml is still faster, however:

$ time ./test
65533./test  7,97s user 0,05s system 94% cpu 8,475 total

Edit: When compiled with JHC, your original program is about as fast as the Ocaml version:

$ time ./hs.out 
65533
./hs.out  5,31s user 0,03s system 96% cpu 5,515 total

Edit 2: Something else I’ve discovered: running your original program with a larger stack chunk size (+RTS -kc1M) makes it run in constant space. The CPS version is still a bit faster, though.

Edit 3: I managed to produce a version that runs nearly as fast as the Ocaml one by manually unrolling the main loop. However, it only works when run with +RTS -kc1M (Dan Doel has filed a bug about this behaviour):

{-# LANGUAGE CPP #-}
module Main where

data P = P {-# UNPACK #-} !Int {-# UNPACK #-} !Int

ack0 :: Int -> Int
ack0 n =(n+1)

#define C(a) a
#define CONCAT(a,b) C(a)C(b)

#define AckType(M) CONCAT(ack,M) :: Int -> Int

AckType(1)
AckType(2)
AckType(3)
AckType(4)

#define AckDecl(M,M1) \
CONCAT(ack,M) n = case n of { 0 -> CONCAT(ack,M1) 1 \
; 1 ->  CONCAT(ack,M1) (CONCAT(ack,M1) 1) \
; _ ->  CONCAT(ack,M1) (CONCAT(ack,M) (n-1)) }

AckDecl(1,0)
AckDecl(2,1)
AckDecl(3,2)
AckDecl(4,3)

ack :: P -> (Int -> Int) -> Int
ack (P m n) k = case m of
  0 -> k (ack0 n)
  1 -> k (ack1 n)
  2 -> k (ack2 n)
  3 -> k (ack3 n)
  4 -> k (ack4 n)
  _ -> case n of
    0 -> ack (P (m-1) 1) k
    1 -> ack (P (m-1) 1) (\a -> ack (P (m-1) a) k)
    _ -> ack (P m (n-1)) (\a -> ack (P (m-1) a) k)

main :: IO ()
main = print $ ack (P 4 1) id

Testing:

$ time ./Test +RTS -kc1M
65533
./Test +RTS -kc1M  6,30s user 0,04s system 97% cpu 6,516 total

Edit 4: Apparently, the space leak is fixed in GHC HEAD, so +RTS -kc1M won’t be required in the future.

Leave a Comment Cancel reply