[Haskell-cafe] OCaml list sees abysmal Language Shootout results

[Tomasz Zielonka]

On Thu, Sep 30, 2004 at 09:49:46AM -0400, Kevin Everets wrote:
> I took Georg's, fixed the word count logic and added prettier
> printing, and then combined it with Sam's main (which I find more
> elegant, but others may find less straightforward).  I think it
> strikes a good balance between efficiency and elegance.

Then how about a solution like this: I took your program but used
my fast fileIterate instead of ,,foldl over getContents''. 
I also added {-# OPTIONS -funbox-strict-fields #-}, and played a bit
to get the best optimisations from GHC.

It's about 7 times faster this way, but it's still two times slower than
the solution I sent to shootout.

Devilish plan: Maybe we could have some variants of fileIterate in GHC's
libraries? ;->

I remember that someone proposed similar functions on haskell's lists
some time ago, but can't remember who.

Best regards,
Tom

-- 
.signature: Too many levels of symbolic links
-------------- next part --------------

{-# 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