fannkuch Haskell GHC #2 program | Computer Language Benchmarks Game

performance measurements

Each table row shows performance measurements for this Haskell GHC program with a particular command-line input value N.

N	CPU secs	Memory KB	Code B
10	1.34	980	1005
11	16.57	992	1005
9	0.13	968	1005

Read the ↓ make, command line, and program output logs to see how this program was run.

Read fannkuch benchmark to see what this program should do.

fannkuch Haskell GHC #2 program source code

{-# OPTIONS -fglasgow-exts -O2 -optc-O3 #-}

-- The Great Computer Language Shootout
-- http://shootout.alioth.debian.org/
-- contributed by Don Stewart, translation from the C version

import Control.Monad
import Foreign
import System
import GHC.Base
import GHC.Ptr
import GHC.IOBase

main = do
    n <- getArgs >>= return . read . head
    k <- if n < 1 then return (0::Int) else fannkuch n
    putStrLn $ "Pfannkuchen(" ++ show n ++ ") = " ++ show (k - 1)

fannkuch n@(I# n#) = do
    perm            <- mallocArray n       :: IO (Ptr Int)
    (Ptr c#)        <- mallocArray n       :: IO (Ptr Int)
    perm1@(Ptr p1#) <- newArray [0 .. n-1] :: IO (Ptr Int)
    (Ptr rP)        <- newArray [n]        :: IO (Ptr Int)
    (Ptr flipsMaxP) <- newArray [0]        :: IO (Ptr Int)

    let go didpr = do
            didpr' <- if didpr < (30 :: Int)
                      then ppr 0 n perm1 >> putStr "\n" >> return (didpr + 1)
                      else return didpr

            IO $ \s ->
                case readIntOffAddr# rP 0# s of
                    (# s, r# #) -> case setcount c# r# s of
                        (# s, _ #) -> case writeIntOffAddr# rP 0# 1# s of
                            s -> (# s, () #)

            t <- IO $ \s ->
                case readIntOffAddr# p1# 0# s of
                    (# s, p1 #) -> case readIntOffAddr# p1# (n# -# 1#) s of
                        (# s, pn #) -> (# s, not (p1 ==# 0# || pn ==# (n# -# 1#)) #)

            when t $ exchange n perm perm1 flipsMaxP

            fm   <- IO $ \s -> case readIntOffAddr# flipsMaxP 0# s of
                                (# s, x #) -> (# s, I# x #)
            done <- IO $ \s -> rot rP n# p1# c# s
            if done then return fm else go didpr'
    go 0

------------------------------------------------------------------------

exchange n p@(Ptr a) p1@(Ptr b) fm = do
    copyArray (p `advancePtr` 1) (p1 `advancePtr` 1) (n-1)
    IO $ \s ->
        case readIntOffAddr# b 0# s  of { (# s, k #) ->
        case doswap k a 0# s         of { (# s, f #) ->
        case readIntOffAddr# fm 0# s of { (# s, m #) ->
        if m <# f then case writeIntOffAddr# fm 0# f s of s -> (# s, () #)
                  else (# s, () #)
        } } }
{-# INLINE exchange #-}

doswap k a f s =
    case swap 1# (k -# 1#) a s    of { (# s, _ #) ->
    case readIntOffAddr# a k s    of { (# s, j #) ->
    case writeIntOffAddr# a k k s of { s          ->
    if k /=# 0# then doswap j a (f +# 1#) s else (# s, (f +# 1#) #)
    } } }
{-# INLINE doswap #-}

swap i j a s =
    if i <# j then case readIntOffAddr#  a i s   of { (# s, x #) ->
                   case readIntOffAddr#  a j s   of { (# s, y #) ->
                   case writeIntOffAddr# a j x s of { s          ->
                   case writeIntOffAddr# a i y s of { s          ->
                   swap (i +# 1#) (j -# 1#) a s
                   } } } }
              else (# s, () #)
{-# INLINE swap #-}

loop r i a s =
    if i <# r then case readIntOffAddr# a (i +# 1#) s of
                    (# s, x #) -> case writeIntOffAddr# a i x s of
                        s -> loop r (i +# 1#) a s
              else (# s, () #)
{-# INLINE loop #-}

setcount p r s =
    if r ==# 1# then (# s, () #)
                else case writeIntOffAddr# p (r -# 1#) r s of
                        s -> setcount p (r -# 1#) s
{-# INLINE setcount #-}

rot rP n a cp s =
  case readIntOffAddr# rP 0# s of { (# s, r #) ->
  if r ==# n then (# s, True #)
             else case readIntOffAddr# a 0# s             of { (# s, p0 #) ->
                  case loop r 0# a s                      of { (# s, _ #)  ->
                  case writeIntOffAddr# a r p0 s          of { s           ->
                  case readIntOffAddr# cp r s             of { (# s, cr #) ->
                  case writeIntOffAddr# cp r (cr -# 1#) s of { s           ->
                  if cr -# 1# ># 0# then (# s, False #)
                                    else case inc s of s -> rot rP n a cp s
  } } } } } }
  where inc s = case readIntOffAddr# rP 0# s of
                  (# s, x #) -> writeIntOffAddr# rP 0# (x +# 1#) s
{-# INLINE rot #-}

ppr i n p = when (i < n) $ do
    putStr . show . (+1) =<< peek (p `advancePtr` i)
    ppr (i+1) n p

notes

make, command-line, and program output logs

BUILD COMMANDS FOR: fannkuch.ghc-2.ghc

Sat Jan 19 19:20:53 PST 2008

cp /home/dunham/gp4/shootout/bench/fannkuch/fannkuch.ghc-2.ghc fannkuch.ghc-2.hs
/usr/bin/ghc --make -O2 -fglasgow-exts -fparr -optc-march=pentium4 fannkuch.ghc-2.hs -o fannkuch.ghc-2.ghc_run
[1 of 1] Compiling Main             ( fannkuch.ghc-2.hs, fannkuch.ghc-2.o )
Linking fannkuch.ghc-2.ghc_run ...
rm fannkuch.ghc-2.hs

=================================================================
COMMAND LINE (%A is single numeric argument):

 fannkuch.ghc-2.ghc_run $MB_GHCRTS %A 


PROGRAM OUTPUT
==============
1234567891011
2134567891011
2314567891011
3214567891011
3124567891011
1324567891011
2341567891011
3241567891011
3421567891011
4321567891011
4231567891011
2431567891011
3412567891011
4312567891011
4132567891011
1432567891011
1342567891011
3142567891011
4123567891011
1423567891011
1243567891011
2143567891011
2413567891011
4213567891011
2345167891011
3245167891011
3425167891011
4325167891011
4235167891011
2435167891011
Pfannkuchen(11) = 51

Home Flawed Fastest License Help

OUT-OF-DATE! Read http://shootout.alioth.debian.org/

performance measurements

fannkuch Haskell GHC #2 program source code

notes

make, command-line, and program output logs