On 7/15/07, Donald Bruce Stewart <dons@cse.unsw.edu.au> wrote:
> [snip] unsafeWrite[snip]
> [snip]unsafeRead[snip]

Hi Donald, the idea is to use this for operational code, so avoiding unsafe operations is preferable ;-)  You'll note that the C# version is not using unsafe operations, although to be fair that's because they worked out slower than the safe version ;-)

Also, the whole algorithm is bound to the IO Monad, which is something I'd like to avoid if possible, since my entire interest in Haskell stems from the possibilites of running programs easily on 1 megacore processors in the future.

Initial compilation gives an error:

PrimeDonald.hs:18:3: Illegal bang-pattern (use -fbang-patterns)

Ok, I'm ok with compiler patches, that's half the point of such a competition really, to encourage compiler optimization.

Anyway, congrats you got nearly as fast as C#!

J:\dev\haskell>ghc -fglasgow-exts -fbang-patterns -O2 -o PrimeDonald.exe PrimeDo
nald.hs

J:\dev\haskell>primedonald
number of primes: 664579
Elapsed time: 0.797

J:\dev\test\testperf>erase primecs.exe

J:\dev\test\testperf>gmcs primecs.cs

J:\dev\test\testperf>mono primecs.exe
number of primes: 664579
elapsed time: 0,719

J:\dev\test\testperf>erase primecs.exe

J:\dev\test\testperf>csc /nologo primecs.cs

J:\dev\test\testperf>primecs
number of primes: 664579
elapsed time: 0,6875

Here is the Haskell code:

module Main
   where

import Data.Array.IO
import Data.Array.Base
import System
import System.Time
import System.Locale

calculateNumberOfPrimes n = do
       a <- newArray (2,n) True :: IO (IOUArray Int Bool) -- an array of Bool
       go a n 2 0

go !a !m !n !c
       | n == m    = return c
       | otherwise = do
               e <- unsafeRead a n
               if e
                   then let loop !j
                               | j <= m    = unsafeWrite a j False >> loop (j+n)
                               | otherwise = go a m (n+1) (c+1)
                        in loop (n+n)
                   else go a m (n+1) c

gettime :: IO ClockTime
gettime = getClockTime

main = do starttime <- gettime
          numberOfPrimes <- (calculateNumberOfPrimes 10000000)
          putStrLn( "number of primes: " ++ show( numberOfPrimes ) )
          endtime <- gettime
          let timediff = diffClockTimes endtime starttime
          let secondsfloat = realToFrac( tdSec timediff ) + realToFrac(tdPicosec timediff) / 1000000000000
          putStrLn( "Elapsed time: " ++ show(secondsfloat) )
          return ()