module Main where

import Control.Concurrent
import System

-- Parameter:  Version #Iterationen #Producer #Consumer #Kanalgröße
usage :: String
usage = "Usage: main Ver(0=ab,i=pci) #Iter #Prods #Cons bufsize "

main :: IO()
main =  do  args <- getArgs
            let version = read (head args)
                iter    = read (args!!1)
                np      = read (args!!2)
                nc      = read (args!!3)
                size    = read (args!!4)
                call    = case version of 
                                 0 -> ab iter
                                 1 -> pc1 iter 
                                 2 -> pc2 iter np nc
                                 3 -> pc3 iter np nc size
                                 otherwise -> error "version number must be in [0..3]"
            call
            -- damit Programm nicht terminiert, bevor Kindthreads fertig sind
            putStrLn "Bitte Taste druecken!"  
            c <- getChar 
            putStrLn "Ende!"


------------------------------------------------------
-- Erzeugen eines nebenläufigen Threads
------------------------------------------------------

ab :: Int ->  IO ()
ab n =  forkIO (loopy n 'a') >> loopy n 'b'


loop n ch = if n > 0 then putChar ch >> loop (n-1) ch
                     else return ()

loopy n ch = if n > 0 then putChar ch >> yield >> loopy (n-1) ch
                      else return ()


------------------------------------------------------
-- Producer-Consumer mit einzelner Puffervariablen
------------------------------------------------------

-- Channel Variable = Einplatzpuffer 
type SVar a = (MVar a,    -- Producer -> Consumer 
               MVar ())   -- Consumer -> Producer


newSVar :: IO (SVar a)
newSVar = do data_var <- newEmptyMVar
             ack_var  <- newMVar ()
             return (data_var, ack_var)

putSVar :: SVar a -> a -> IO () 
putSVar (dv,av) val = do takeMVar av
                         putMVar dv val

getSVar :: SVar a -> IO a 
getSVar (dv,av)  = do val <- takeMVar dv
                      putMVar av ()
                      return val

-- Producer-Consumer-System
pc1 :: Int -> IO ()                         
pc1 n = do cv <- newSVar 
           forkIO (produce n 0 cv) 
           consume n cv

produce :: Int -> Int -> SVar Int -> IO ()
produce 0 n cv = return ()
produce i n cv = do putSVar cv n
                    putStr ("\nProduced "++show n)
                    produce (i-1) (n+1) cv

consume :: Int -> SVar Int -> IO ()
consume 0 cv = return ()
consume i cv = do val <- getSVar cv 
                  putStr ("\nConsumed " ++ show val)
                  consume (i-1) cv
 
------------------------------------------------------
-- Producer-Consumer mit unbeschränktem Puffer 
------------------------------------------------------

-- Typ Chan a ist in Bibliothek vordefiniert

-- pc2 :: Int -> Int -> Int -> IO()
pc2 i np nc = do c <- newChan
                 multifork np (producer i c 0)
                 multifork nc (consumer i c)    

multifork :: Int -> (Int -> IO()) -> IO()
multifork 0     thr = return ()
multifork (n+1) thr = do forkIO $ thr (n+1)
                         multifork n thr 

producer :: Num a => Int -> Chan (a,Int) -> a -> Int -> IO() 
producer 0 _ _ _     = return ()
producer i ch val id = do writeChan ch (val,id)
                          putStr ("\n Producer " ++ show id ++ " put " ++ show val)
{- Modifiziere Laufzeitverhalten:  
                          writeChan ch (val+1,id)
                          putStr ("\n Producer " ++ show id ++ " put " ++ show (val+1))
                          yield
-}
                          producer (i-1) ch (val+2) id

consumer :: Show a => Int -> Chan a -> Int -> IO () 
consumer 0 _ _   = return ()
consumer i ch id = do val <- readChan ch 
                      putStr ("\n Consumer " ++ show id ++ " got " ++ show val)
                      -- yield
                      consumer (i-1) ch id



------------------------------------------------------
-- Producer-Consumer mit beschränktem Puffer 
------------------------------------------------------

type BChan a = (Chan a, QSem) 

-- Typ QSem ist vordefiniert

newBChan :: Int -> IO (BChan a)
newBChan n = do ch <- newChan 
                qs <- newQSem n
                return (ch,qs) 

putBChan  :: BChan a -> a -> IO ()
putBChan (c,s) x = do waitQSem s 
                      writeChan c x

getBChan  :: BChan a -> IO a
getBChan (c,s) = do x <- readChan c
                    signalQSem s
                    return x

-- Producer-Consumer System 
pc3 i np nc size 
            = do bc <- newBChan size 
                 multifork np (producerb i bc 0)
                 multifork nc (consumerb i bc)


producerb :: Num a => Int -> BChan (a,Int) -> a -> Int -> IO() 
producerb 0 _ _ _     = return ()
producerb i ch val id 
    = do putBChan ch (val,id)
         putStr ("\n Producer " ++ show id ++ " put " ++ show val)
{- Modifiziere Laufzeitverhalten:  
         putBChan ch (val+1,id)
         putStr ("\n Producer " ++ show id ++ " put " ++ show (val+1))
         yield
-}
         producerb (i-1) ch (val+2) id

consumerb :: Show a => Int -> BChan a -> Int -> IO () 
consumerb 0 _ _   = return ()
consumerb i ch id = do val <- getBChan ch 
                       putStr ("\n Consumer " ++ show id ++ " got " ++ show val)
                       -- yield
                       consumerb (i-1) ch id