Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
{-# LANGUAGE MultiParamTypeClasses, ScopedTypeVariables, TypeSynonymInstances, FlexibleInstances #-}
module PingPong where
-- standard ping-pong actor example
import IO
import Monad
import Data.IORef
import Control.Concurrent
import Actor.ActorBase
import Actor.ActorSyntax
import Actor.ActorCompiler
import Actor.ActorLinearSearch
-- boilerplate
data Msg
= Ping | Pong | Stop deriving (Eq,Show)
valHashOp_Msg = HashOp {numberOfTables = 3,
hashMsg = \ msg -> case msg of
Ping -> 1
Pong -> 2
Stop -> 3 }
instance EMatch Msg where
match tags m1 m2 = return (m1 == m2, tags)
-- auxilliary
loop c = do { c; loop c}
--wait = 2
wait = 10000
pingAct count pong self =
do { pingsLeft <- newIORef (count -1)
; let pong_pid = actorToPID pong
; send pong_pid Ping
; loop
( receive self
[ [Pong] .->. ( do { v <- readIORef pingsLeft
; Monad.when (v `mod` wait == 0) (putStrLn "ping:Pong")
; if v > 0
then do {send pong_pid Ping; writeIORef pingsLeft (v-1) }
else do {putStrLn "ping:Stop" ; send pong_pid Stop }
}
)
]
)
}
pongAct pong exit self =
do { pongCount <- newIORef 0
; let pong_pid = actorToPID pong
; loop
( receive self
[ [Ping] .->. ( do { v <- readIORef pongCount
; Monad.when (v `mod` wait == 0) (putStrLn ("pong:Ping " ++ show v))
; send pong_pid Pong
; writeIORef pongCount (v+1)
}
)
,
[Stop] .->. ( do { putStrLn "pong: Stop"
; putMVar exit () -- EXIT
}
)
]
)
}
main :: IO ()
main = do { (ping :: Act Msg) <- createActor valHashOp_Msg
; (pong :: Act Msg) <- createActor valHashOp_Msg
; exit <- newEmptyMVar
; runActor ping (pingAct 1000000 pong)
; runActor pong (pongAct ping exit)
; readMVar exit -- blocks till we hit exit
; kill (actorToPID ping) ; kill (actorToPID pong)
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.