Transcript Concurrency and Parallelism in Haskell

Parallel and Concurrent
Programming in Haskell
Satnam Singh
Microsoft Research Cambridge
Leeds2009
Recap
• par :: a -> b -> b
• pseq :: a -> b -> b
• forceList :: [a] -> ()
• x `par` (y `pseq` x+y)
• Determinisim
l
map f l
a
b
c
d
fa
fb
fc
fd
map :: (a -> b) -> [a] -> [b]
map f [] = []
map f (x:xs) = f x : map f xs
l
map double l
3
1
7
2
6
2
14
4
double :: Int -> Int
double x = 2 * x
l
a
b
c
d
parMap f l
fa
fb
fc
fd
parMap :: (a -> b) -> [a] -> [b]
parMap f [] = []
parMap f (x:xs) = fx `par` (fx : parMap f xs)
where
fx = f x
l
a
b
c
d
parMap f l
fa
fb
fc
fd
parMap :: (a -> b) -> [a] -> [b]
parMap f [] = []
parMap f (x:xs) = fx `par` (fxs `pseq` (fx:fxs))
where
fx = f x
fxs = parMap f xs
l
a
b
c
d
parMap f l
fa
fb
fc
fd
parList :: Strategy a -> Strategy [a]
parList strat [] = ()
parList strat (x:xs)
= strat x `par` (parList strat xs)
parMap :: Strategy b -> (a -> b) -> [a] -> [b]
parMap strat f xs = map f xs `using` parList strat
Explicitly Creating Threads
• forkIO :: IO () -> ThreadID
• Creates a lightweight Haskell thread, not
an operating system thread.
Inter-thread Communication
• putMVar :: MVar a -> IO ()
• takeMVar :: MVar a -> IO a
MVars
empty
52
mv
...
putMVar mv 52
...
...
...
...
v <- takeMVar mv
...
Rendezvous
threadA
send 42
threadB
42
read 42
blocked
read 84 and
continue
send 84
Rendezvous
threadA :: MVar Int -> MVar Float -> IO ()
threadA valueToSendMVar valueReceivedMVar
= do -- some work
-- new perform rendezvous by sending 42
putMVar valueToSendMVar 42 -- send value
v <- takeMVar valueToReadMVar
putStrLn (show v)
Rendezvous
threadB :: MVar Int -> MVar Float -> IO ()
threadB valueToReceiveMVar valueToSendMVar
= do -- some work
-- now perform rendezvous by waiting on value
z <- takeMVar valueToReceiveMVar
putMVar valueToSendMVar (2 * z)
-- continue with other work
Rendezvous
main :: IO ()
main
= do aMVar <- newEmptyMVar
bMVar <- newEmptyMVar
forkIO (threadA aMVar bMVar)
forkIO (threadB aMVar bMVar)
threadDelay 1000 -- BAD!
A function that does some work
fib
fib
fib
fib
:: Integer -> Integer
0 = 0
1 = 1
n = fib (n-1) + fib (n-2)
Asynchronous Call
fibThread :: Int -> MVar Int -> IO ()
fibThread n resultMVar
= putMVar resultMVar (fib n)
resultMVar <- newEmptyMVar
forkIO (fibThread 30 resultMVar)
seq (fib 30) (return ())
result <- takeMVar resultMVar
$ time fibForkIO +RTS -N1
real
user
sys
0m40.473s
0m0.000s
0m0.031s
$ time fibForkIO +RTS -N2
real
user
sys
0m38.580s
0m0.000s
0m0.015s
putMVar resultMVar (fib 30)
resultMVar
83204
resultMVar
fib 30
thunk for
computing
fib 30
Exercise: fix fibThread
Inter-thread Communication 2
• putTVar :: TVar a -> STM ()
• takeTVar :: TVar a -> STM a
• atomically :: STM a -> IO a
TVars
empty
52
tv
...
atomically (putTVar mv 52)
...
...
...
...
v <- atomically (takeTVar mv)
...
retry
do v <- readTVar bal
if v< 10 then
retry
else
writeTVar bal (v-10)
Reading the first arrival...
q1
atomically (do i <- “readTVar q1
or if q1 empty
readTVarq2” ;
writeTVar r i
)
q2
r