[Haskell-cafe] C-like Haskell
Ross Mellgren
rmm-haskell at z.odi.ac
Wed Jan 28 20:23:21 EST 2009
Duncan, I think you must have some magics -- on my machine the
original code also takes forever.
Running with +RTS -S indicates it's allocating several gig of memory
or more.
Applying some bang patterns gives me ~8s for 10^8 and somewhat more
than a minute for 10^9:
{-# LANGUAGE BangPatterns #-}
module Main where
import Data.Int
main = putStrLn $ show $ circ2 (10^8)
circ2 :: Int64 -> Int64
circ2 r = ((1+4*r) + 4 * (go (rs+1) r 1 0))
where
rs = r^2
go :: Int64 -> Int64 -> Int64 -> Int64 -> Int64
go !rad !x !y !sum
| x < y = sum
| rad <= rs = go (rad+1+2*y) x (y+1) (sum+1+2*(x-y))
| otherwise = go (rad+1-2*x) (x-1) y sum
10^8:
rmm at Hugo:~$ time ./circ-bangpatterns +RTS -t
./circ-bangpatterns +RTS -t
31415926535867961
<<ghc: 9120 bytes, 1 GCs, 2432/2432 avg/max bytes residency (1
samples), 1M in use, 0.00 INIT (0.00 elapsed), 8.15 MUT (8.31
elapsed), 0.00 GC (0.00 elapsed) :ghc>>
real 0m8.315s
user 0m8.154s
sys 0m0.050s
10^9:
rmm at Hugo:~$ time ./circ-bangpatterns +RTS -t
./circ-bangpatterns +RTS -t
3141592653589764829
<<ghc: 9336 bytes, 1 GCs, 2432/2432 avg/max bytes residency (1
samples), 1M in use, 0.00 INIT (0.00 elapsed), 80.49 MUT (82.68
elapsed), 0.00 GC (0.00 elapsed) :ghc>>
real 1m22.684s
user 1m20.490s
sys 0m0.473s
The C program is quite fast:
rmm at Hugo:~$ time ./circ-orig
1302219321
real 0m1.073s
user 0m1.039s
sys 0m0.006s
-Ross
On Jan 28, 2009, at 8:06 PM, Duncan Coutts wrote:
> On Wed, 2009-01-28 at 16:42 -0800, drblanco wrote:
>
>> I do already have the number I wanted, but was wondering how this
>> could be
>> made faster, or even why it's so slow. This is all on GHC 6.8.3
>> under OS X
>> Intel, using ghc -O2.
>
> I'm not exactly sure what's different, but for me it works pretty
> well.
> I put back in the Int64 type signature.
>
>> For comparison, the C code below runs in <1 second.
>
> You've got a faster machine than me :-)
>
> I compiled both the Haskell and C versions to standalone executables
> with ghc/gcc -O2 and ran them with time.
>
> C version:
> $ time ./circ
> 3141592649589764829
>
> real 0m2.430s
> user 0m2.428s
> sys 0m0.000s
>
> Haskell version:
> time ./circ2
> 3141592653589764829
>
> real 0m2.753s
> user 0m2.756s
> sys 0m0.000s
>
>
> Not too bad I'd say! :-)
>
> I was using ghc-6.10 for this test. It would appear that ghc-6.8 is a
> bit slower, I get:
>
> 3141592653589764829
>
> real 0m5.767s
> user 0m5.768s
> sys 0m0.000s
>
> Now the other difference is that I'm using a 64bit machine so perhaps
> ghc just produces terrible code for Int64 on 32bit machines.
>
> Duncan
>
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe
More information about the Haskell-Cafe
mailing list