why PArr slower than list ?

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 ?

On Nov 14, 2007, at 21:50 , Albert Lee wrote:
dotp :: Num a => [:a:] -> [:a:] -> a
You're forcing Num a => a here, whereas the list one probably specializes to Integer. Seems like a bad way to go to me; polymorphism is expensive. (Whether it's *that* expensive, I couldn't tell you.) -- brandon s. allbery [solaris,freebsd,perl,pugs,haskell] allbery@kf8nh.com system administrator [openafs,heimdal,too many hats] allbery@ece.cmu.edu electrical and computer engineering, carnegie mellon university KF8NH

Albert Lee:
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:
On the wiki page GHC.PArr is described under the heading "Convenience without the speed". You'd usually still expect it not to be slower than lists. However, lists are optimised by GHC (buildr/fold fusion), where the implementation of GHC.PArr at this point is complete naive. Manuel
participants (3)
-
Albert Lee
-
Brandon S. Allbery KF8NH
-
Manuel M T Chakravarty