sleep sort?ってなんなのさ

Concurrentの練習がてらTLに微妙に流れてるsleep sortとやらを書いてみる.

module Main where

import Control.Monad(unless)
import Control.Concurrent(threadDelay, forkIO)
import Control.Concurrent.STM(newTVarIO, readTVarIO, readTVar, writeTVar,
                              atomically, TVar(..), retry)

main :: IO ()
main = getContents >>= sleepSort . map read . words >>= mapM_ print

sleepSort :: [Int] -> IO [Int]
sleepSort xs = do
  ls <- newTVarIO []
  sequence_ [forkIO $ threadDelay (1000000 * n) >> snoc ls n|n <- xs]
  wait ls $ length xs
  readTVarIO ls

snoc :: TVar [Int] -> Int -> IO ()
snoc ls n = atomically $ readTVar ls >>= writeTVar ls . (++[n])

wait :: TVar [Int] -> Int -> IO ()
wait ls n = atomically $ readTVar ls >>= (`unless` retry) . (n==) . length

つまるところ,時間方向にバッファを持ったバケットソートなのね.