content: 
  > {-# LANGUAGE UndecidableInstances, PatternSignatures, FlexibleInstances, MultiParamTypeClasses, FlexibleContexts #-}
  
  > module Main where
  
  > import Data.IORef
  > import Control.Concurrent
  > --import Control.Concurrent.STM
  > import System.Environment
  > import Data.Time
  
  > import System.Mem
  > import Data.List
  
  > import Collection
  > import RefInterface
  
  > import TestData
  > import TestRun
  
  -- the contenders (we can run stand-alone for a fixed test case mainPar)
  
  > import qualified CASList as CAS
  >-- import qualified CASusingSTMList as CASusingSTM
  > import qualified MVarListLockCoupling as MLC
  >-- import qualified MVarusingSTM as MLCusingSTM
  >-- import qualified LazyList2 as Lazy
  > import qualified IOList as I
  >-- import qualified STMList as S
  > import qualified ImmList as IMM
  
  
  create List
  
  > createList :: Col c e => [e] -> IO c
  > createList n = 
  >   do nl <- newCol
  >      mapM (insertCol nl) n
  >      return nl
  
  
  
  > 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 = 6   -- 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 :: Col c e => c -> [Op e] -> IO ()
  > executeTasks lh ops =
  >  do mapM (\ task -> 
  >           case task of
  >              Find x -> do { findCol lh x; return () }
  >              Insert x -> do { insertCol lh x; return () }
  >              Delete x -> do { deleteCol 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           
  
  
  runnable version
  
   main = mainPar
  
  parallel version
  
  > type RUN = CAS.ListHandle Int
  
  > main :: IO ()
  > main = 
  >  do args <- getArgs
  >     case args of
  >      (mode:"-t":in_fname:rest) -> run_testdata in_fname mode
  >--      [mode, t, l] -> 
  >--        do let len = read l :: Int
  >--           let threads = read t :: Int
  >--           let run nl = mainPar nl threads len
  >--           case mode of
  >--            "CAS"   -> do nl :: CAS.ListHandle Int <- createList [0..len]
  >--                          run nl
  >--            "CASusingSTM"   -> do nl :: CASusingSTM.ListHandle Int <- createList [0..len]
  >--                                  run nl
  >--            "LAZY" -> do nl :: Lazy.ListHandle Int <- createList [0..len]
  >--                         run nl
  >--            "MLC" -> do nl :: MLC.ListHandle Int <- createList [0..len] 
  >--                        run nl
  >--            "MLCusingSTM" -> do nl :: MLCusingSTM.ListHandle Int <- createList [0..len] 
  >--                                run nl
  >--            "IO" -> do nl  :: I.ListHandle Int <- createList [0..len]
  >--                       run nl
  >--            "STM" -> do nl  :: S.ListHandle Int <- createList [0..len]
  >--                        run nl
  >--            "IMM" -> do nl  :: IMM.ListHandle Int <- createList [0..len]
  >--                        run nl
          
  
  
   mainPar :: Col c Int => c -> Int -> Int -> IO ()
   mainPar nl threads len =
    do let numbers = [1..len] ++ (reverse [1..len]) ++ [1..len] ++ (reverse [1..len])
                     ++ [1..len] ++ (reverse [1..len]) ++ [1..len] ++ (reverse [1..len])
       let ds = distribution numbers threads
       let ts = ds
       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))))
            ts
       atomically ( do counter <- readTVar wait
                       if counter < threads then retry 
                        else return () )
       fin <- getCurrentTime
       putStrLn "Done"
       putStrLn $ "Time: " ++ show (diffUTCTime fin start)
  
  
  
   mainPar2 nl len =
     do cnt <- atomically (newTVar 0)
        printCol nl
        mapM (\ e -> forkIO ( do insertCol 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 () )
  
        printCol nl
        n <- cntCol nl
        putStrLn $ "Overall: " ++ show n
  
  
  sequential version
    
  > mainSeq nl len = 
  >  do let threads = 4
  >     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
  
  > mainTest nl len =
  >  do 
  >     printCol nl   
  
        r <- deleteCol nl 3
        putStrLn ("Result : " ++ show r)
        find nl 10
  
  >     insertCol nl 11
  
  >     deleteCol nl 3
  >     findCol nl 11
  
  
  >     mapM (\x -> forkIO (insertCol nl x)) [12..50]
  
  >     threadDelay 1000000
  
  > {-
  >     putStrLn "Start"
  >     executeTasks nl $ createTasks [1..len]
  >     find nl (len+1) -- we try to find a non-existant element
  >                     -- this way, in the LazyList case, we will physically delete all (logically deleted) elements 
  > -}
  >     putStrLn "End"
  >     printCol nl
  
  