Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Strange behavior with concurrency in Haskell

I have the following code:

import Control.Concurrent

sleepSort = mapM_ (forkIO . put)
  where put x = threadDelay (x*10000) >> print x

This performs a sleep sort on a set of integers, and works fine, apart from one caveat:

The program prints out each of the numbers in the data set in sequence, just as it is supposed to. However, after it finishes printing out the last number, it waits for the user to type in some number, and then echos that number back, and then completes.

I don't think I'm asking for user input at any point, so why is this happening?

like image 628
Benjamin Kovach Avatar asked Aug 24 '12 20:08

Benjamin Kovach


1 Answers

This happens because your main thread does not wait for the other threads to complete. Your program starts n threads, but the main thread immediately exits, and you're returned back to the interpreter prompt. Meanwhile the other threads continue to produce output:

Prelude Control.Concurrent> sleepSort [1,2,3]
1
Prelude Control.Concurrent> 2
3

You can fix this by adding a delay to the main thread:

Prelude Control.Concurrent> sleepSort [1,2,3] >> threadDelay 10000
1
2
3

If you were running a compiled program, it would just exit immediately without printing anything:

$ cat Test.hs
import Control.Concurrent

sleepSort = mapM_ (forkIO . put)
  where put x = threadDelay (x*1000) >> print x

main = sleepSort [1,2,3]
$ ghc --make -O2 Test.hs
[1 of 1] Compiling Main             ( Test.hs, Test.o )
Linking Test ...
$ ./Test
$

Update: Instead of adding a call to threadDelay to main, you can use a semaphore in the sleepSort function:

import Control.Concurrent
import Control.Concurrent.QSemN

sleepSort l = do
  qsem <- newQSemN 0
  mapM_ (forkIO . put qsem) l
  waitQSemN qsem n
  where
    n = length l
    put qsem x = threadDelay (x*1000) >> print x >> signalQSemN qsem 1

main = sleepSort [1,2,3]
like image 182
Mikhail Glushenkov Avatar answered Sep 22 '22 11:09

Mikhail Glushenkov