Strange performance effects with unsafePerformIO
Björn Peemöller
bjp at informatik.uni-kiel.de
Thu Mar 24 16:39:48 CET 2011
Hello,
we have a strange performance behaviour when we use unsafePerformIO, at
least with GHC 6.12.3 and 7.0.1.
Please consider the example program following at the end of this post.
Running the original code the execution time is about 26 seconds, while
uncommenting one (or both) of the comments shrinks it to about 0.01
seconds on our machine.
Is there an explanation for this effect?
Regards,
Bjoern
-- ---------------
module Main where
import System.IO.Unsafe
traverse [] = return ()
-- traverse (_:xs) = traverse xs
traverse (_:xs) = traverse xs >> return ()
makeList 0 = []
-- makeList n = () : (makeList (n - 1))
makeList n = () : (unsafePerformIO . return) (makeList (n - 1))
main = traverse $ makeList (10^5)
More information about the Glasgow-haskell-users
mailing list