[Haskell-cafe] [1/16] SBM: The Haskell and C benchmarks

[Peter Firefly Brodersen Lund]

Here are the 48 Haskell and C benchmarks.

Don Stewart contributed three (although I had to fight a bit to make one of
them compile).  
Jules Bean (quicksilver) contributed one.
Bertram Felgenhauer (int-e) contributed three (in the form of a single file,
which I untangled).
Spencer Jannsen (sjannsen) contributed one.

wli (William Lee Irwin III) inspired me to add the getwchar benchmarks.

I used the following shell code to gather all the benchmarks:

 (for F in hs/*.hs c/*.c; \
        do echo "------------------------------"; \
           echo "$F:";                            \
           echo ;                                 \
           cat "$F";                              \
        done; \
           echo "=============================="  \
 ) > xx.txt

They are not in the same order as in the Makefile or in the reports,
unfortunately.

-Peter

------------------------------
hs/byte-bs----acc.hs:

{-# LANGUAGE BangPatterns #-}

import qualified Data.ByteString as B

cnt	:: Int -> B.ByteString -> Int
cnt !acc !bs = if B.null bs
		 then acc
	         else cnt (acc+1) (B.tail bs)

main = do s <- B.getContents
	  print (cnt 0 s)
------------------------------
hs/byte-bs----foldlx.hs:

{-# LANGUAGE BangPatterns #-}

import qualified Data.ByteString as B

cnt	:: B.ByteString -> Int
cnt !bs	= B.foldl' (\sum _ -> sum+1) 0 bs

main = do s <- B.getContents
	  print (cnt s)
------------------------------
hs/byte-bs----foldrx.hs:

{-# LANGUAGE BangPatterns #-}

import qualified Data.ByteString as B

cnt	:: B.ByteString -> Int
cnt !bs	= B.foldr' (\_ sum -> sum+1) 0 bs

main = do s <- B.getContents
	  print (cnt s)
------------------------------
hs/byte-bsl---acc.hs:

{-# LANGUAGE BangPatterns #-}

import qualified Data.ByteString.Lazy as B

cnt	:: Int -> B.ByteString -> Int
cnt !acc !bs = if B.null bs
		 then acc
	         else cnt (acc+1) (B.tail bs)

main = do s <- B.getContents
	  print (cnt 0 s)
------------------------------
hs/byte-xxxxx-acc-1.hs:

{-# LANGUAGE BangPatterns #-}

cnt	:: Int -> String -> Int
cnt !acc bs = if null bs
		 then acc
	         else cnt (acc+1) (tail bs)

main = do s <- getContents
	  print (cnt 0 s)
------------------------------
hs/byte-xxxxx-acc-2.hs:

{-# LANGUAGE BangPatterns #-}

cnt	:: Int -> String -> Int
cnt !acc !bs = if null bs
		 then acc
	         else cnt (acc+1) (tail bs)

main = do s <- getContents
	  print (cnt 0 s)
------------------------------
hs/byte-xxxxx-foldl.hs:

{-# LANGUAGE BangPatterns #-}

cnt	:: String -> Int
cnt !bs	= foldl (\sum _ -> sum+1) 0 bs

main = do s <- getContents
	  print (cnt s)
------------------------------
hs/byte-xxxxx-foldr-1.hs:

{-# LANGUAGE BangPatterns #-}

cnt	:: String -> Int
cnt bs	= foldr (\_ sum -> sum+1) 0 bs

main = do s <- getContents
	  print (cnt s)
------------------------------
hs/byte-xxxxx-foldr-2.hs:

{-# LANGUAGE BangPatterns #-}

cnt	:: String -> Int
cnt !bs	= foldr (\_ sum -> sum+1) 0 bs

main = do s <- getContents
	  print (cnt s)
------------------------------
hs/space-bs-c8-acc-1.hs:

{-# LANGUAGE BangPatterns #-}

import qualified Data.ByteString.Char8 as B

cnt	:: Int -> B.ByteString -> Int
cnt !acc bs = if B.null bs
		then acc
	        else cnt (if B.head bs == ' ' then acc+1 else acc) (B.tail bs)

main = do s <- B.getContents
	  print (cnt 0 s)
------------------------------
hs/space-bs-c8-count.hs:

-- Don Stewart
import qualified Data.ByteString.Char8 as B
main = print . B.count ' ' =<< B.getContents

------------------------------
hs/space-bs-c8-foldlx-1.hs:

{-# LANGUAGE BangPatterns #-}

import qualified Data.ByteString.Char8 as B

cnt	:: B.ByteString -> Int
cnt bs	= B.foldl' (\sum c -> if c == ' ' then sum+1 else sum) 0 bs

main = do s <- B.getContents
	  print (cnt s)
------------------------------
hs/space-bs-c8-foldlx-2.hs:

{-# LANGUAGE BangPatterns #-}

import qualified Data.ByteString.Char8 as B

main = do s <- B.getContents
	  print $ B.foldl' (\v c -> if c == ' ' then v+1 else v :: Int) 0 s

------------------------------
hs/space-bs-c8-foldrx.hs:

{-# LANGUAGE BangPatterns #-}

import qualified Data.ByteString.Char8 as B

cnt	:: B.ByteString -> Int
cnt bs	= B.foldr' (\c sum -> if c == ' ' then sum+1 else sum) 0 bs

main = do s <- B.getContents
	  print (cnt s)
------------------------------
hs/space-bs-c8-lenfil.hs:

{-# LANGUAGE BangPatterns #-}

import qualified Data.ByteString.Char8 as B

cnt	:: B.ByteString -> Int
cnt bs	= B.length (B.filter (== ' ') bs)

main = do s <- B.getContents
	  print (cnt s)
------------------------------
hs/space-bslc8-acc-1.hs:

{-# LANGUAGE BangPatterns #-}

import qualified Data.ByteString.Lazy.Char8 as B

cnt	:: Int -> B.ByteString -> Int
cnt !acc bs = if B.null bs
		then acc
	        else cnt (if B.head bs == ' ' then acc+1 else acc) (B.tail bs)

main = do s <- B.getContents
	  print (cnt 0 s)
------------------------------
hs/space-bslc8-acc-2.hs:

{-# LANGUAGE BangPatterns #-}

import qualified Data.ByteString.Lazy.Char8 as B

cnt	:: Int -> B.ByteString -> Int
cnt !acc !bs = if B.null bs
		then acc
	        else cnt (if B.head bs == ' ' then acc+1 else acc) (B.tail bs)

main = do s <- B.getContents
	  print (cnt 0 s)
------------------------------
hs/space-bslc8-acc-3.hs:

{-# LANGUAGE BangPatterns #-}
 -- this version by quicksilver

import qualified Data.ByteString.Lazy.Char8 as B

cnt	:: Int -> B.ByteString -> Int
cnt !acc bs | B.null bs        = acc
	    | B.head bs == ' ' = cnt (acc+1) (B.tail bs)
	    | otherwise        = cnt acc (B.tail bs)

main = do s <- B.getContents
	  print (cnt 0 s)

------------------------------
hs/space-bslc8-chunk-1.hs:

{-# LANGUAGE BangPatterns #-}
 -- this version by int-e

import qualified Data.ByteString.Lazy.Char8 as B
import qualified Data.ByteString.Char8 as BS
import Data.List (foldl')

cntS    :: Int -> BS.ByteString -> Int
cntS !acc !bs = case BS.uncons bs of
                    Nothing -> acc
                    Just (hd, tl) | hd == ' ' -> cntS (acc+1) tl
                                  | otherwise -> cntS acc tl

cnt     :: Int -> B.ByteString -> Int
cnt acc bs = foldl' cntS acc (B.toChunks bs)

main = do s <- B.getContents
          print $ cnt 0 s

------------------------------
hs/space-bslc8-chunk-2.hs:

{-# LANGUAGE BangPatterns #-}
 -- this version by int-e

import qualified Data.ByteString.Lazy.Char8 as B
import qualified Data.ByteString.Char8 as BS
import Data.List (foldl')

cntS'   :: Int -> BS.ByteString -> Int
cntS' !acc !bs | BS.null bs        = acc
               | BS.head bs == ' ' = cntS' (acc+1) (BS.tail bs)
               | otherwise         = cntS' acc (BS.tail bs)

cnt     :: Int -> B.ByteString -> Int
cnt acc bs = foldl' cntS' acc (B.toChunks bs)

main = do s <- B.getContents
          print $ cnt 0 s

------------------------------
hs/space-bslc8-chunk-3.hs:

{-# LANGUAGE BangPatterns #-}
 -- this version by int-e

import qualified Data.ByteString.Lazy.Char8 as B
import qualified Data.ByteString.Char8 as BS
import Data.List (foldl')

cntS''   :: Int -> BS.ByteString -> Int
cntS'' !acc !bs = BS.foldl' (\v c -> if c == ' ' then v+1 else v) acc bs

cnt     :: Int -> B.ByteString -> Int
cnt acc bs = foldl' cntS'' acc (B.toChunks bs)

main = do s <- B.getContents
          print $ cnt 0 s

------------------------------
hs/space-bslc8-chunk-4.hs:

{-# LANGUAGE BangPatterns #-}

-- Don Stewart
import qualified Data.ByteString.Lazy.Char8    as BLC8
import qualified Data.ByteString.Lazy.Internal as BLI
import qualified Data.ByteString               as B
import qualified Data.ByteString.Unsafe        as BU
import qualified Data.ByteString.Internal      as BI

cnt :: Int -> BLC8.ByteString -> Int
cnt n BLI.Empty        = n
cnt n (BLI.Chunk x xs) = cnt (n + cnt_strict 0 x) xs  -- process lazy spine
    where     -- now we can process a chunk without checking for Empty
        cnt_strict !i !s                          -- then strict chunk 
            | B.null s  = i
            | c == ' '  = cnt_strict (i+1) t
            | otherwise = cnt_strict i     t
          where
            (c,t) = (BI.w2c (BU.unsafeHead s), BU.unsafeTail s) -- no bounds check

main = do s <- BLC8.getContents; print (cnt 0 s)

------------------------------
hs/space-bslc8-count.hs:

-- Don Stewart
import qualified Data.ByteString.Lazy.Char8 as B
main = print . B.count ' ' =<< B.getContents

------------------------------
hs/space-bslc8-foldl.hs:

{-# LANGUAGE BangPatterns #-}

import qualified Data.ByteString.Lazy.Char8 as B

cnt	:: B.ByteString -> Int
cnt !bs	= B.foldl (\sum c -> if c == ' ' then sum+1 else sum) 0 bs

main = do s <- B.getContents
	  print (cnt s)
------------------------------
hs/space-bslc8-foldlx-1.hs:

{-# LANGUAGE BangPatterns #-}

import qualified Data.ByteString.Lazy.Char8 as B

cnt	:: B.ByteString -> Int
cnt bs	= B.foldl' (\sum c -> if c == ' ' then sum+1 else sum) 0 bs

main = do s <- B.getContents
	  print (cnt s)
------------------------------
hs/space-bslc8-foldlx-2.hs:

{-# LANGUAGE BangPatterns #-}

import qualified Data.ByteString.Lazy.Char8 as B

cnt	:: B.ByteString -> Int
cnt !bs	= B.foldl' (\sum c -> if c == ' ' then sum+1 else sum) 0 bs

main = do s <- B.getContents
	  print (cnt s)
------------------------------
hs/space-bslc8-foldr-1.hs:

{-# LANGUAGE BangPatterns #-}

import qualified Data.ByteString.Lazy.Char8 as B

cnt	:: B.ByteString -> Int
cnt bs	= B.foldr (\c sum -> if c == ' ' then sum+1 else sum) 0 bs

main = do s <- B.getContents
	  print (cnt s)
------------------------------
hs/space-bslc8-foldr-2.hs:

{-# LANGUAGE BangPatterns #-}

import qualified Data.ByteString.Lazy.Char8 as B

cnt	:: B.ByteString -> Int
cnt !bs	= B.foldr (\c sum -> if c == ' ' then sum+1 else sum) 0 bs

main = do s <- B.getContents
	  print (cnt s)
------------------------------
hs/space-bslc8-lenfil-1.hs:

{-# LANGUAGE BangPatterns #-}

import qualified Data.ByteString.Lazy.Char8 as B
import GHC.Int (Int64)

-- note that D.BS.Lazy.Char8.length is ByteString -> Int64
--           D.BS.C8.length is ByteString -> Int
cnt	:: B.ByteString -> Int64
cnt bs	= B.length (B.filter (== ' ') bs)

main = do s <- B.getContents
	  print (cnt s)
------------------------------
hs/space-bslc8-lenfil-2.hs:

{-# LANGUAGE BangPatterns #-}

import qualified Data.ByteString.Lazy.Char8 as B
import GHC.Int (Int64)

-- note that D.BS.Lazy.Char8.length is ByteString -> Int64
--           D.BS.C8.length is ByteString -> Int
cnt	:: B.ByteString -> Int64
cnt !bs	= B.length (B.filter (== ' ') bs)

main = do s <- B.getContents
	  print (cnt s)
------------------------------
hs/space-bsl---foldlx.hs:

{-# LANGUAGE BangPatterns #-}
 -- this version by sjannsen

import Data.ByteString.Lazy as B

cnt :: B.ByteString -> Int
cnt = B.foldl' f 0
 where
    f !n 32   = n+1
    f !n  _   = n

main = do
    s <- B.getContents
    print $ cnt s

------------------------------
hs/space-xxxxx-acc-1.hs:

{-# LANGUAGE BangPatterns #-}

cnt	:: Int -> String -> Int
cnt !acc bs = if null bs
		then acc
	        else cnt (if head bs == ' ' then acc+1 else acc) (tail bs)

main = do s <- getContents
	  print (cnt 0 s)
------------------------------
hs/space-xxxxx-acc-2.hs:

{-# LANGUAGE BangPatterns #-}

cnt	:: Int -> String -> Int
cnt !acc !bs = if null bs
		then acc
	        else cnt (if head bs == ' ' then acc+1 else acc) (tail bs)

main = do s <- getContents
	  print (cnt 0 s)
------------------------------
hs/space-xxxxx-foldl.hs:

{-# LANGUAGE BangPatterns #-}

cnt	:: String -> Int
cnt bs	= foldl (\sum c -> if c == ' ' then sum+1 else sum) 0 bs

main = do s <- getContents
	  print (cnt s)
------------------------------
hs/space-xxxxx-foldr-1.hs:

{-# LANGUAGE BangPatterns #-}

cnt	:: String -> Int
cnt bs	= foldr (\c sum -> if c == ' ' then sum+1 else sum) 0 bs

main = do s <- getContents
	  print (cnt s)
------------------------------
hs/space-xxxxx-foldr-2.hs:

{-# LANGUAGE BangPatterns #-}

cnt	:: String -> Int
cnt !bs	= foldr (\c sum -> if c == ' ' then sum+1 else sum) 0 bs

main = do s <- getContents
	  print (cnt s)
------------------------------
hs/space-xxxxx-lenfil.hs:

{-# LANGUAGE BangPatterns #-}

cnt	:: String -> Int
cnt bs	= length (filter (== ' ') bs)

main = do s <- getContents
	  print (cnt s)
------------------------------
c/byte-4k.c:

#include <stdio.h>
#include <unistd.h>
#include <stdlib.h>
#include <errno.h>

int Main_cnt()
{
	int	cnt = 0;
	ssize_t	sze;
	char	buf[4*1024];

	do {
	again:
		sze = read(fileno(stdin), buf, sizeof(buf));
		if (sze < 0) {
			switch (errno) {
			case EAGAIN: goto again;
			default:
				perror("read() failed\n");
				exit(1);
			}
		}

		cnt += sze;
	} while (sze != 0);

	return cnt;
}


int main()
{
	printf("%d\n", Main_cnt());
	return EXIT_SUCCESS;
}

------------------------------
c/byte-getchar.c:

#include <stdio.h>
#include <stdlib.h>

int Main_cnt()
{
	int	cnt = 0;
	int	c;

	while ((c = getchar()) != EOF)
		cnt++;

	return cnt;
}


int main()
{
	printf("%d\n", Main_cnt());
	return EXIT_SUCCESS;
}

------------------------------
c/byte-getchar-u.c:

#include <stdio.h>
#include <stdlib.h>

int Main_cnt()
{
	int	cnt = 0;
	int	c;

	while ((c = getchar_unlocked()) != EOF)
		cnt++;

	return cnt;
}


int main()
{
	printf("%d\n", Main_cnt());
	return EXIT_SUCCESS;
}

------------------------------
c/space-32k-8.c:

#include <stdio.h>
#include <unistd.h>
#include <stdlib.h>
#include <errno.h>

int Main_cnt()
{
	int	 cnt = 0;
	ssize_t	 sze, left;
	char	 buf[32760];
	char	*p;

	printf("using a buffer of %g KB\n", sizeof(buf) / 1024.0);

	do {
	again:
		sze = read(fileno(stdin), buf, sizeof(buf));
		if (sze < 0) {
			switch (errno) {
			case EAGAIN: goto again;
			default:
				perror("read() failed\n");
				exit(1);
			}
		}

		for (p = buf, left=sze; left > 0; left--)
			if (*p++ == ' ')
				cnt++;
	} while (sze != 0);

	return cnt;
}


int main()
{
	printf("%d\n", Main_cnt());
	return EXIT_SUCCESS;
}

------------------------------
c/space-32k.c:

#include <stdio.h>
#include <unistd.h>
#include <stdlib.h>
#include <errno.h>

int Main_cnt()
{
	int	 cnt = 0;
	ssize_t	 sze, left;
	char	 buf[32*1024];
	char	*p;

	printf("using a buffer of %g KB\n", sizeof(buf) / 1024.0);

	do {
	again:
		sze = read(fileno(stdin), buf, sizeof(buf));
		if (sze < 0) {
			switch (errno) {
			case EAGAIN: goto again;
			default:
				perror("read() failed\n");
				exit(1);
			}
		}

		for (p = buf, left=sze; left > 0; left--)
			if (*p++ == ' ')
				cnt++;
	} while (sze != 0);

	return cnt;
}


int main()
{
	printf("%d\n", Main_cnt());
	return EXIT_SUCCESS;
}

------------------------------
c/space-4k.c:

#include <stdio.h>
#include <unistd.h>
#include <stdlib.h>
#include <errno.h>

int Main_cnt()
{
	int	 cnt = 0;
	ssize_t	 sze, left;
	char	 buf[4*1024];
	char	*p;

	printf("using a buffer of %g KB\n", sizeof(buf) / 1024.0);

	do {
	again:
		sze = read(fileno(stdin), buf, sizeof(buf));
		if (sze < 0) {
			switch (errno) {
			case EAGAIN: goto again;
			default:
				perror("read() failed\n");
				exit(1);
			}
		}

		for (p = buf, left=sze; left > 0; left--)
			if (*p++ == ' ')
				cnt++;
	} while (sze != 0);

	return cnt;
}


int main()
{
	printf("%d\n", Main_cnt());
	return EXIT_SUCCESS;
}

------------------------------
c/space-getchar.c:

#include <stdio.h>
#include <stdlib.h>

int Main_cnt()
{
	int	cnt = 0;
	int	c;

	while ((c = getchar()) != EOF)
		if (c == ' ')
			cnt++;
	return cnt;
}


int main()
{
	printf("%d\n", Main_cnt());
	return EXIT_SUCCESS;
}

------------------------------
c/space-getchar-u.c:

#include <stdio.h>
#include <stdlib.h>

int Main_cnt()
{
	int	cnt = 0;
	int	c;

	while ((c = getchar_unlocked()) != EOF)
		if (c == ' ')
			cnt++;
	return cnt;
}


int main()
{
	printf("%d\n", Main_cnt());
	return EXIT_SUCCESS;
}

------------------------------
c/space-getwchar.c:

#include <stdio.h>
#include <wchar.h>
#include <stdlib.h>

int Main_cnt()
{
	int	cnt = 0;
	wint_t	c;

	while ((c = getwchar()) != WEOF)
		if (c == ' ')
			cnt++;
	return cnt;
}


int main()
{
	printf("%d\n", Main_cnt());
	return EXIT_SUCCESS;
}

------------------------------
c/space-getwchar-u.c:

#define _GNU_SOURCE
#include <stdio.h>
#include <wchar.h>
#include <stdlib.h>

int Main_cnt()
{
	int	cnt = 0;
	wint_t	c;

	while ((c = getwchar_unlocked()) != WEOF)
		if (c == ' ')
			cnt++;
	return cnt;
}


int main()
{
	printf("%d\n", Main_cnt());
	return EXIT_SUCCESS;
}

------------------------------
c/space-megabuf.c:

#include <stdio.h>
#include <stdlib.h>
#include <errno.h>
#include <sys/stat.h>
#include <unistd.h>

int isfile(int handle)
{
	struct stat	buf;

	if (fstat(handle, &buf) == -1) {
		perror("fstat(stdin)\n");
		exit(1);
	}

	return S_ISREG(buf.st_mode);
}


ssize_t getbufsize()
{
	if (isfile(fileno(stdin))) {
		off_t	x;

		x = lseek(fileno(stdin), 0, SEEK_END);
		if (x == -1) {
			perror("lseek(... SEEK_END)\n");
			exit(1);
		}
		if (lseek(fileno(stdin), 0, SEEK_SET) == -1) {
			perror("lseek(... SEEK_SET)\n");
			exit(1);
		}
		if (x > 1*1024*1024*1024LL) {
			x = 1024*1024*1024LL;
		}
		return x; /* file size for files */
	} else {
		return 10*1024*1024; /* 10M for non-files */
	}
}


int Main_cnt()
{
	int	 cnt = 0, reads=0, retries=0;
	ssize_t	 sze, left, bufsize;
	char	*buf;
	char	*p;

	bufsize = getbufsize();
	printf("using a buffer of %g MB\n", bufsize / (1024*1024.0));

	buf = malloc(bufsize);
	if (!buf) {
		fprintf(stderr, "couldn't allocate %lld bytes\n",
			(long long) bufsize);
	}

	do {
	again:
		sze = read(fileno(stdin), buf, bufsize);
		if (sze < 0) {
			switch (errno) {
			case EAGAIN: retries++; goto again;
			default:
				perror("read() failed\n");
				exit(1);
			}
		}
		reads++;

		for (p = buf, left=sze; left > 0; left--)
			if (*p++ == ' ')
				cnt++;
	} while (sze != 0);

	printf("%d reads, %d retries\n", reads, retries);

	return cnt;
}


int main()
{
	printf("%d\n", Main_cnt());
	return EXIT_SUCCESS;
}

==============================