Strange performance effects with unsafePerformIO

Thomas Schilling nominolo at googlemail.com
Fri Mar 25 02:56:29 CET 2011


unsafePerformIO traverses the stack to perform blackholing.  It could
be that your code uses a deep stack and unsafePerformIO is repeatedly
traversing it.  Just a guess, though.

2011/3/24 Björn Peemöller <bjp at informatik.uni-kiel.de>:
> 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)
>
>
> _______________________________________________
> Glasgow-haskell-users mailing list
> Glasgow-haskell-users at haskell.org
> http://www.haskell.org/mailman/listinfo/glasgow-haskell-users
>



-- 
Push the envelope. Watch it bend.



More information about the Glasgow-haskell-users mailing list