Shootout/Cheap concurrency

A ShootoutEntry for the cheap-concurrency benchmark

Proposed Entry

Equal shortest entry in any language with SML

{-# OPTIONS -fglasgow-exts -O2 -optc-O3 #-}
-- $Id: message-ghc-2.code,v 1.27 2006/01/08 22:44:56 igouy-guest Exp $
-- The Great Computer Language Shootout
-- http://shootout.alioth.debian.org/
-- Contributed by Einar Karttunen
-- Modified by Simon Marlow and Don Stewart

import Control.Concurrent; import Control.Monad; import System

thread im om = do (x::Int) <- takeMVar im; putMVar om $! x+1; thread im om

spawn  c  _  = do n <- newEmptyMVar; forkIO (thread c n); return n

main = do n <- getArgs >>= readIO . head
          s <- newEmptyMVar
          f <- newEmptyMVar
          e <- foldM spawn s [1..500]
          forkIO $ replicateM n (takeMVar e) >>= putMVar f . sum
          replicateM n (putMVar s 0)
          takeMVar f >>= print

Current Entry

{-# OPTIONS -O2 -optc-O3 #-}
-- $Id: message-ghc-2.code,v 1.27 2006/01/08 22:44:56 igouy-guest Exp $
-- The Great Computer Language Shootout
-- http://shootout.alioth.debian.org/
-- Contributed by Einar Karttunen
-- Modified by Simon Marlow

import Control.Concurrent
import Control.Monad
import System

thread :: MVar Int -> MVar Int -> IO ()
thread inp out = do x <- takeMVar inp; putMVar out $! x+1; thread inp out

spawn cur _ = do next <- newEmptyMVar
                 forkIO $ thread cur next
                 return next

main = do n <- getArgs >>= readIO.head
          s <- newEmptyMVar
          e <- foldM spawn s [1..500]
          f <- newEmptyMVar
          forkIO $ replicateM n (takeMVar e) >>= putMVar f . sum
          replicateM n (putMVar s 0)
          takeMVar f >>= print