> module Main where

> import Data.IORef
> import Control.Concurrent
> --import Control.Concurrent.STM
> import System.Environment
> import Data.Time


> import MVarList


printing 

> printList :: Show a => ListHandle a -> IO ()
> printList (ListHandle {headList = ptrPtr}) =
>  do startptr <- (
>          do ptr <- readIORef ptrPtr
>             Head {next = startptr} <- readMVar ptr
>             return startptr)
>     printListHelp startptr


> printListHelp :: Show a => MVar (List a) -> IO ()
> printListHelp curNodePtr =
>   do { curNode <- readMVar curNodePtr
>      ; case curNode of
>          Null -> putStr "Nil"
>          Node {val = curval, next = curnext} ->
>             do { putStr (show curval  ++ " -> ")
>                ;  printListHelp curnext }
>          DelNode {val = curval, next = curnext} ->
>             do { putStr (show curval  ++ "DEAD -> ")
>                ;  printListHelp curnext }
>      } 

> cntList :: Show a => ListHandle a -> IO Int
> cntList (ListHandle {headList = ptrPtr}) =
>  do startptr <- (
>          do ptr <- readIORef ptrPtr
>             Head {next = startptr} <- readMVar ptr
>             return startptr)
>     cntListHelp startptr 0


> cntListHelp :: Show a => MVar (List a) -> Int -> IO Int
> cntListHelp curNodePtr i =
>   do { curNode <- readMVar curNodePtr
>      ; case curNode of
>          Null -> return i
>          Node {val = curval, next = curnext} -> 
>                cntListHelp curnext (i+1)
>          DelNode {val = curval, next = curnext} ->
>                cntListHelp curnext (i+1)
>      } 


create List

> createList :: Int -> IO (ListHandle Int)
> createList n =
>   do nl <- newList
>      mapM (addToTail nl) [1..n]
>      return nl


> data Op a = Find a | Insert a | Delete a deriving Show
        

> createTasks :: [a] -> [Op a]
> createTasks xs = task 1 xs
>   where
>     insCnt = 5   -- every 5th op is insert
>     delCnt = 9   -- ever 9th op is delete
>     task _ [] = []
>     task cnt (x:xs) 
>       | (cnt `mod` insCnt) == 0 = (Insert x) : task (cnt+1) xs
>       | (cnt `mod` delCnt) == 0 = (Delete x) : task (cnt+1) xs
>       | otherwise             = (Find x) : task (cnt+1) xs



mainly finds, some deletes which will be inserted again

> specificTask1 :: [a] -> [Op a]
> specificTask1 xs = task 1 xs []
>   where
>     delCnt = 5   -- every 6th op is delete
>     insCnt = 50   -- after 5 deletes we'll insert them again
>     task _ [] _ = []
>     task cnt (x:xs) deletes 
>       | length deletes == insCnt =  map Insert deletes ++ task (cnt+1) (x:xs) []
>       | (cnt `mod` delCnt) == 0 = (Delete x) : task (cnt+1) xs (x:deletes)
>       | otherwise             = (Find x) : task (cnt+1) xs deletes

> executeTasks :: Eq a => ListHandle a -> [Op a] -> IO ()
> executeTasks lh ops =
>  do mapM (\ task -> 
>           case task of
>              Find x -> do { find lh x; return () }
>              Insert x -> do { addToTail lh x; return () }
>              Delete x -> do { delete lh x; return () })
>          ops
>     return ()

  put number into threads buckets

> distribution :: [Int] -> Int -> [[Int]]
> distribution no threads =
>   let init = map (\ _ -> []) [1..threads]
>       go :: [Int] -> Int -> [[Int]] -> [[Int]]
>       go [] _ acc = acc
>       go (x:xs) cnt acc = 
>          let idx = cnt `mod` threads
>              acc' = take idx acc ++ [x : (acc !! idx)] ++ drop (idx+1) acc
>          in go xs (cnt+1) acc'
>  
>   in go no 1 init           

> insert :: Eq a => ListHandle a -> a -> IO ()
> insert = addToTail


runnable version

> main = mainPar

parallel version

> mainPar :: IO ()
> mainPar =
>  do let len = 3000
>     let threads = 4
>     nl <- createList len
>     let numbers = [1..len] ++ (reverse [1..len]) ++ [1..len] ++ (reverse [1..len])
>                   ++ [1..len] ++ (reverse [1..len]) ++ [1..len] ++ (reverse [1..len])
>     let [d1,d2,d3,d4] = distribution numbers threads
>     let t1 = d1++d2++d3++d4
>     let t2 = d2++d3++d4++d1
>     let t3 = d3++d4++d1++d2
>     let t4 = d4++d1++d2++d3
>     wait <- atomically (newTVar 0)
>     putStrLn "Start"
>     start <- getCurrentTime
>     mapM (\ t -> forkIO (do executeTasks nl (specificTask1 t)
>                             atomically(do counter <- readTVar wait
>                                           writeTVar wait (counter+1))))
>          [t1,t2,t3,t4]
>     atomically ( do counter <- readTVar wait
>                     if counter < 4 then retry 
>                      else return () )
>     fin <- getCurrentTime
>     putStrLn "Done"
>     putStrLn $ "Time: " ++ show (diffUTCTime fin start)


> mainPar2 :: IO ()
> mainPar2 =
>   do nl <- createList 5
>      let len = 5 + 200
>      cnt <- atomically (newTVar 0)
>      printList nl
>      mapM (\ e -> forkIO ( do insert nl e
>                               atomically(do i <- readTVar cnt
>                                             writeTVar cnt (i+1))))
>           [6..len]

>      atomically ( do i <- readTVar cnt
>                      if i <= len-6 then retry 
>                       else return () )

>      printList nl
>      n <- cntList nl
>      putStrLn $ "Overall: " ++ show n


sequential version 
  
> mainSeq :: IO ()
> mainSeq = 
>  do let len = 3000
>     let threads = 4
>     nl <- createList len
>     let numbers = [1..len] ++ (reverse [1..len]) ++ [1..len] ++ (reverse [1..len])
>                   ++ [1..len] ++ (reverse [1..len]) ++ [1..len] ++ (reverse [1..len])
>     let [d1,d2,d3,d4] = distribution numbers threads
>     let t1 = d1++d2++d3++d4
>     let t2 = d2++d3++d4++d1
>     let t3 = d3++d4++d1++d2
>     let t4 = d4++d1++d2++d3
>     putStrLn "Start"
>     start <- getCurrentTime
>     mapM (\ t -> executeTasks nl (specificTask1 t)) [t1,t2,t3,t4]
>     fin <- getCurrentTime
>     putStrLn "Done"
>     putStrLn $ "Time: " ++ show (diffUTCTime fin start)


just testing

> mainTest2 :: IO ()
> mainTest2 =
>  do let len = 10
>     nl <- createList len
>     printList nl
>     addToTail nl 1
>     printList nl   

> mainTest :: IO ()
> mainTest =
>  do let len = 10
>     nl <- createList len
>     printList nl   

      r <- delete nl 3
      putStrLn ("Result : " ++ show r)
      find nl 10

>     insert nl 11

>     delete nl 3
>     find nl 11


>     mapM (\x -> forkIO (insert nl x)) [12..50]

>     threadDelay 1000000

> {-
>     putStrLn "Start"
>     executeTasks nl $ createTasks [1..len]
>     find nl (len+1) -- we try to find a non-existent element
>                     -- this way, in the LazyList case, we will physically delete all (logically deleted) elements 
> -}
>     putStrLn "End"
>     printList nl