[Shootout-list] PHP 5, Haskell 6.4

[Tomasz Zielonka]

On Tue, Mar 15, 2005 at 12:17:21PM +0200, Einar Karttunen wrote:
> Alexandre <Xlex0x835 at rambler.ru> writes:
> > What about add/update PHP with latest PHP 5 version? And what about 
> > update Haskell to the latest 6.4 version (it should be lots of speed 
> > improvements there)?
> 
> Most benchmarks do work with GHC 6.4 and fixing the remaining few 
> should not be hard. I can look at those in the weekend if GHC is
> updated. 

Please use the attached version of the count-words benchmarks. It
manages to combine elegance with speed.

Best regards
Tomasz
-------------- next part --------------
-- A somewhat prettier implementation of the count-words benchmark
-- Authors: Kevin Everets, Georg Martius, Sam Mason, Tomasz Zielonka
-- compile with: ghc -O2 -o wc wc.hs

{-# OPTIONS -funbox-strict-fields #-}

import System.IO
import Data.Array.IO
import Data.Array.Base
import Data.Word
import Data.Int
import List
import Char

main = fileIterate stdin wc' (C 0 0 0 False) >>= putStrLn . showC

data C = C !Int !Int !Int !Bool deriving Show
--         Line Word Char InWord

showC (C l w c _) = show l ++ " " ++ show w ++ " " ++ show c

wc' :: C  -> Char -> C
wc' (C l w c _)     '\n' = C (l+1) w     (c+1) False
wc' (C l w c _)     ' '  = C l     w     (c+1) False
wc' (C l w c _)     '\t' = C l     w     (c+1) False
wc' (C l w c False) _    = C l     (w+1) (c+1) True
wc' (C l w c True)  _    = C l     w     (c+1) True

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

{-# INLINE fileIterate #-}

fileIterate :: Handle -> (a -> Char -> a) -> a -> IO a
fileIterate h f a0 = do
    buf <- newArray_ (0, bufSize - 1) :: IO (IOUArray Int Word8)
    let loop i n a
            | i `seq` n `seq` a `seq` False = undefined
            | i == n =
                do  n' <- hGetArray h buf bufSize
                    if n' == 0
                        then return a
                        else loop 0 n' a
            | otherwise =
                do  c <- fmap (toEnum . fromEnum) (readArray buf i)
                    loop (i + 1) n (f a c)
    loop 0 0 a0
  where
    bufSize :: Int
    bufSize = 4096