public
Created

Thread spamming yay

  • Download Gist
ControlTest.hs
Haskell
1 2 3 4 5 6 7 8 9 10 11
import Data.Vector.Unboxed as V
 
main :: IO ()
main = print $ sumVector ones
 
sumVector :: (Num a, Unbox a) => Vector a -> a
sumVector = V.foldl' (+) 0
 
{-# NOINLINE ones #-}
ones :: Vector Int
ones = V.replicate (800 * 1000) 1
ParallelTest.hs
Haskell
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42
-- | A simplified version of what happened at <http://www.reddit.com/r/programming/comments/1101bd>.
--
-- > ghc ParallelTest.hs -O2 -threaded
-- > ./ParallelTest +RTS -N
--
-- WARNING: ONLY RUN THIS PROGRAM ON A COMPUTER WITH AT LEAST 4 GB OF RAM!!!
 
import Control.Concurrent
import Control.Concurrent.MVar
import Data.Vector.Unboxed as V
import System.IO.Unsafe (unsafePerformIO)
 
main :: IO ()
main = print $ sumVector ones
 
-- | Add up all the numbers in a vector, in /parallel/!
sumVector :: (Num a, Unbox a) => Vector a -> a
sumVector vec = unsafePerformIO $ do
dest <- newEmptyMVar
run dest vec
takeMVar dest
 
run :: (Num a, Unbox a) => MVar a -> Vector a -> IO ()
run dest vec
| len == 0 = yield 0
| len == 1 = yield $ V.head vec
| otherwise = do
let mid = len `div` 2
lvar <- newEmptyMVar
rvar <- newEmptyMVar
forkIO $ run lvar (V.slice 0 mid vec)
forkIO $ run rvar (V.slice mid (len - mid) vec)
l <- takeMVar lvar
r <- takeMVar rvar
yield $! l + r
where
len = V.length vec
yield = putMVar dest
 
{-# NOINLINE ones #-}
ones :: Vector Int
ones = V.replicate (800 * 1000) 1

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.