Santa

ChrisKuklewicz 14:05, 25 June 2007 (UTC) In response to the link to an Erlang comparision at the wiki page Talk:SantaClausProblem , I am posting this roughly 34 lines of code adaptation of the Erlang message passing soultion:

-- by Chris Kuklewicz, looking at http://www.cs.otago.ac.nz/staffpriv/ok/santa/index.htm
-- This makes extensive use of sending partly or fully curried
-- commands through Chan and TChan.  Reindeer priority is implemented
-- using 'orElse'.  I did away with the extra secretary threads, since they
-- were not needed.  I used (replicateM count (readTChan chan))) instead.
-- Santa should really use a Control.Concurrent.QSemN
module Santa(main) where

import Control.Monad(replicateM,replicateM_)
import Control.Concurrent(newChan,readChan,writeChan,threadDelay,forkIO)
import Control.Concurrent.STM(newTChanIO,readTChan,writeTChan,orElse,atomically)
import System.Random(randomRIO)

data Species a = Reindeer [a] | Elves [a]
forever x = x >> forever x

santa getNext self = forever (getNext >>= handle) where
  handle (Reindeer group) = do putStr "Ho, ho, ho!  Let's deliver toys!\n"
                               act group
  handle (Elves group)    = do putStr "Ho, ho, ho!  Let's meet in the study!\n"
                               act group
  act group = do sequence_ [tellMember (writeChan self ()) | tellMember <- group]
                 replicateM_ (length group) (readChan self)

worker tellSecretary msg self = forever $ do
  threadDelay =<< randomRIO (0,1000*1000) -- 0 to 1 second
  tellSecretary (writeChan self)
  tellGateKeeperIamDone <- readChan self
  putStr msg
  tellGateKeeperIamDone
  
spawnWorker tellSecretary before i after =
  forkIO (newChan >>= worker tellSecretary (before ++ show i ++ after))

secretary count species = do
  chan <- newTChanIO
  return (writeTChan chan,fmap species (replicateM count (readTChan chan)))

main = do
  (toRobin,fromRobin) <- secretary 9 Reindeer
  (toEdna,fromEdna) <- secretary 3 Elves
  sequence [ spawnWorker (atomically . toRobin) "Reindeer " i " delivering toys.\n"
             | i <- [1..9] ]
  sequence [ spawnWorker (atomically . toEdna) "Elf " i " meeting in the study.\n"
             | i <- [1..10] ]
  newChan >>= santa (atomically (fromRobin `orElse` fromEdna)) -- main thread is santa's