[Haskell-cafe] In-place modification
Hugh Perkins
hughperkins at gmail.com
Sun Jul 15 07:12:10 EDT 2007
On 7/15/07, Sebastian Sylvan <sebastian.sylvan at gmail.com> wrote:
>
> > "unsafe"' here just means direct array indexing. Same as the other
> > languages. Haskell's 'unsafe' is a little more paranoid that other
> > languages.
Yes, I was kindof hoping it was something like that. Cool :-)
> > Since the goal is to flip bits very quickly in the cache, you could
> > localise this to the ST monad then, as its perfectly pure on the
> > outside.
>
Ok, awesome!
J:\dev\haskell>ghc -fglasgow-exts -O2 -o PrimeDonald2.exe PrimeDonald2.hs
J:\dev\haskell>primedonald2
number of primes: 664579
Elapsed time: 0.7030000000000001
{-# OPTIONS -O2 -fbang-patterns #-}
import Control.Monad.ST
import Data.Array.ST
import Data.Array.Base
import System
import Control.Monad
import Data.Bits
import System.Time
import System.Locale
pureSieve :: Int -> Int
pureSieve n = runST( sieve n )
sieve n = do
a <- newArray (2,n) True :: ST s (STUArray s 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 = do
x <- unsafeRead a j
when x (unsafeWrite a j False)
loop (j+n)
| otherwise = go a m (n+1) (c+1)
in loop (n `shiftL` 1)
else go a m (n+1) c
calculateNumberOfPrimes :: Int -> Int
calculateNumberOfPrimes = pureSieve
gettime :: IO ClockTime
gettime = getClockTime
main = do starttime <- gettime
let 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 ()
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://www.haskell.org/pipermail/haskell-cafe/attachments/20070715/bf539ee1/attachment.htm
More information about the Haskell-Cafe
mailing list