-- | An implementation of communicating sequential processes.
module Control.CUtils.Processes (CSP(..), runCSP0, runCSP) where

import Control.Concurrent (forkIO)
import Control.Concurrent.MVar
import Control.CUtils.FChan
import Data.List
import Control.Monad
import qualified Control.Exception as E

infixr 1 :->

-- | The CSP data type:
--
--   :||  - interleave
--
--   :?   - deterministic choice
--
--   Join - interface parallel
--
--   :->  - prefix
--
--   Stop - empty computation
--
--   Do   - execute IO, then behave as the returned process
data CSP = CSP :|| CSP | CSP :? CSP | Join CSP [String] CSP | String :-> CSP | Stop | Do (IO CSP) deriving Show

instance Show (IO t) where
	showsPrec _ _ = ("<IO action>"++)

data Side = N | L | R deriving Eq

prefix emitToken chan halt s p = do
	let may = find (\(int, (_, s2, _):tl) -> s2 == s) (init (zip (inits halt) (tails halt)))
	case may of
		Just (int, (status, _, side):tl) -> do
			side2 <- takeMVar status
			if side2 == N || side == side2 then do
					-- Waiting
					putMVar status side
					runCSP0 chan (int ++ tl) ((s :-> p) :? ("" :-> Stop))
				else do
					-- Wake up
					putMVar status side2
					when emitToken (E.catch (fst chan s) (\DoneReadingException -> return ()))
					runCSP0 chan (int ++ tl) p
		Nothing -> do
			when emitToken (E.catch (fst chan s) (\DoneReadingException -> return ()))
			runCSP0 chan halt p

runCSP0 chan halt (p1 :|| p2) = do
	forkIO (runCSP0 chan halt p1)
	runCSP0 chan halt p2
runCSP0 chan halt ((s1 :-> p1) :? (s2 :-> p2)) = do
	consumer <- makeConsumer (snd chan)
	let taking = fst consumer >>= \s -> if s `elem` [s1, s2] then return s else taking
	s <- taking
	newChan <- snd consumer
	prefix False (fst chan, newChan) halt s (if s == s1 then p1 else p2)
runCSP0 chan halt (Join p1 ls p2) = do
	statuses <- mapM (const (newMVar N)) ls
	forkIO (runCSP0 chan (zip3 statuses ls (repeat L) ++ halt) p1)
	runCSP0 chan (zip3 statuses ls (repeat R) ++ halt) p2
runCSP0 chan halt (s :-> p) = prefix True chan halt s p
runCSP0 chan halt Stop = return ()
runCSP0 chan halt (Do io) = do
	p <- io
	runCSP0 chan halt p

-- | Run a CSP computation.
runCSP p = do
	chan <- newChan
	runCSP0 chan [] p