Shootout/Cheap concurrency

From HaskellWiki
< Shootout
Revision as of 02:56, 4 October 2006 by DonStewart (talk | contribs) (moved from old wiki)
(diff) ← Older revision | Latest revision (diff) | Newer revision → (diff)
Jump to navigation Jump to search
The printable version is no longer supported and may have rendering errors. Please update your browser bookmarks and please use the default browser print function instead.

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