Editing Shootout/Chameneos (section)

== Other versions ==

This is the older fastest entry which uses Chans and is slower, at 6 seconds of user time:

<haskell>
{- The Computer Language Shootout
   http://shootout.alioth.debian.org/
   http://shootout.alioth.debian.org/benchmark.php?test=chameneos&lang=all

   contributed by Chris Kuklewicz, 28 Dec 2005
   modified by ...

   This entry uses a separate thread to manage the meetings
-}

import Control.Concurrent
import Control.Monad(replicateM_,foldM,mapM)
import System (getArgs)

data Color = Red | Yellow | Blue | Faded deriving (Eq)

complement a      b | a==b = a
complement Red    b        = if b==Yellow then Blue   else Yellow
complement Yellow b        = if b==Blue   then Red    else Blue
complement Blue   b        = if b==Red    then Yellow else Red

main = do 
  args <- getArgs
  goMeet <- newChan
  let meetings = if null args then (100::Int) else (read . head) args

      meetingPlace = replicateM_ meetings match >> fade
        where match = do (color1,pobox1) <- readChan goMeet
                         (color2,pobox2) <- readChan goMeet
                         putMVar pobox1 color2
                         putMVar pobox2 color1
              fade = do (_,pobox) <- readChan goMeet
                        putMVar pobox Faded
                        fade

      spawn startingColor = do
        metVar <- newEmptyMVar
        pobox  <- newEmptyMVar
        let creature havemet color = do 
              writeChan goMeet (color,pobox)
              other <- takeMVar pobox
              case other of
                Faded -> let color = Faded in putMVar metVar havemet
                _     -> (creature  $! (havemet+1)) $! (complement color other)
        forkIO $ creature 0 startingColor
        return metVar

  forkIO meetingPlace
  metVars <- mapM spawn [Blue,Red,Yellow,Blue]
  total <- foldM (\tot mv -> takeMVar mv >>= return.(tot+)) (0::Int) metVars
  print total
</haskell>