[Haskell-cafe] In-place modification
Sebastian Sylvan
sebastian.sylvan at gmail.com
Sun Jul 15 09:07:48 EDT 2007
On 15/07/07, Donald Bruce Stewart <dons at cse.unsw.edu.au> wrote:
> dons:
> > dons:
> > > hughperkins:
> > > >
> > > > Hey, I just realized I can shave off another 30% in C# ;-)
> > > > So now the timings become:
> > >
> > > Ok. So do the same thing to the Haskell program. The compilers should
> > > produce pretty much identical assembly.
> > >
> >
> > Oh, and I forgot you count up by two now. Here's the Haskell
> > transliteration (again).
>
> Oh, also, I was using the wrong brackets in the last program!
> Stick with me, because this makes the program go at least 100x faster.
>
> First, we'll move the pureSieve into a library module:
>
> {-# OPTIONS -O2 -optc-O -fbang-patterns #-}
>
> module Primes (pureSieve) where
>
> import Control.Monad.ST
> import Data.Array.ST
> import Data.Array.Base
> import System
> import Control.Monad
> import Data.Bits
>
> pureSieve :: Int -> Int
> pureSieve n = runST ( sieve n )
>
> sieve n = do
> a <- newArray (3,n) True :: ST s (STUArray s Int Bool)
> let cutoff = truncate (sqrt (fromIntegral n)) + 1
> go a n cutoff 3 1
>
> go !a !m cutoff !n !c
> | n >= m = return c
> | otherwise = do
> e <- unsafeRead a n
> if e then
> if n < cutoff
> then let loop !j
> | j < m = do
> x <- unsafeRead a j
> when x $ unsafeWrite a j False
> loop (j+n)
>
> | otherwise = go a m cutoff (n+2) (c+1)
>
> in loop ( if n < 46340 then n * n else n `shiftL` 1)
> else go a m cutoff (n+2) (c+1)
>
> else go a m cutoff (n+2) c
>
> And now just a module to call it:
>
> {-# OPTIONS -fth #-}
>
> import Primes
>
> main = print $( let x = pureSieve 10000000 in [| x |] )
>
> Pretty simple to compile and run this now:
>
> $ ghc --make -o primes Main.hs
> $ time ./primes
> 664579
> ./primes 0.00s user 0.01s system 228% cpu 0.003 total
>
> Oh! Much faster. Looks like Haskell is 100x faster than C#.
> Who gets fired? :)
>
Oooh, I love it!
--
Sebastian Sylvan
+44(0)7857-300802
UIN: 44640862
More information about the Haskell-Cafe
mailing list