
14 Nov
2007
14 Nov
'07
9:50 p.m.
I read the GHC/Data Parallel Haskell/GHC.PArr page http://haskell.org/haskellwiki/Data_Parallel_Haskell/GHC.PArr and make a simple test to compare the speed of PArr against List: {-# OPTIONS -fparr -fglasgow-exts #-} module Main where import GHC.PArr import System.CPUTime dotp :: Num a => [:a:] -> [:a:] -> a dotp xs ys = sumP [:x * y | x <- xs | y <- ys:] main = do t1 <- getCPUTime print $ sum [x*y|x<-[1..90000]|y<-[1..90000]] t2 <- getCPUTime print $ dotp [:1..90000:] [:1..90000:] t3 <- getCPUTime print $ t2 - t1 print $ t3 - t2 and I get the result: *Main> main 243004050015000 243004050015000 384540000000 1701841000000 My laptop is macbook macosx 10.4.8 and ghc-6.8 , anything wrong or I missed ?