content: 
  {-# LANGUAGE UndecidableInstances, PatternSignatures, FlexibleInstances, MultiParamTypeClasses #-}
  
  module TestRun (
     run_testdata  -- FilePath -> FilePath -> IO ()
  ) where
  
  import TestData
  import TestDataParser
  import Collection
  
  import Control.Monad
  import GHC.Conc
  import Text.Printf
  import Data.List
  import Data.IORef
  import Control.Concurrent
  --import Control.Concurrent.STM
  import System.Environment
  import Data.Time
  import System.Mem
  import System.Random
  import Control.Exception
  
  -- the contenders
  import qualified CASList as CAS
  import qualified ImmList as IMM
  --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
  
  
  
  instance (Eq e, Show e) => Col (CAS.ListHandle e) e where
     newCol = CAS.newList
     insertCol c e = do CAS.addToTail c e
                        return ()
     deleteCol = CAS.delete
     findCol = CAS.find
     printCol = CAS.printList
     cntCol = CAS.cntList
  
  instance (Eq e, Show e) => Col (IMM.ListHandle e) e where
     newCol = IMM.newList
     insertCol c e = do IMM.addToTail c e
                        return ()
     deleteCol = IMM.delete
     findCol = IMM.find
     printCol = IMM.printList
     cntCol = IMM.cntList
  
  --instance (Eq e, Show e) => Col (CASusingSTM.ListHandle e) e where
  --   newCol = CASusingSTM.newList
  --   insertCol c e = do CASusingSTM.addToTail c e
  --                      return ()
  --   deleteCol = CASusingSTM.delete
  --   findCol = CASusingSTM.find
  --   printCol = CASusingSTM.printList
  --   cntCol = CASusingSTM.cntList
  
  
  --instance (Eq e, Show e) => Col (Lazy.ListHandle e) e where
  --   newCol = Lazy.newList
  --   insertCol c e = do  Lazy.addToTail c e
  --                       return ()
  --   deleteCol =  Lazy.delete
  --   findCol =  Lazy.find
  --   printCol =  Lazy.printList
  --   cntCol =  Lazy.cntList
  
  
  instance (Eq e, Show e) => Col (I.ListHandle e) e where
     newCol = I.newList
     insertCol c e = do I.addToTail c e
                        return ()
     deleteCol = I.delete
     findCol = I.find
     printCol = I.printList
     cntCol = I.cntList
  
  --instance (Eq e, Show e) => Col (MLCusingSTM.ListHandle e) e where
  --   newCol = MLCusingSTM.newList
  --   insertCol c e = do MLCusingSTM.addToTail c e
  --                      return ()
  --   deleteCol = MLCusingSTM.delete
  --   findCol = MLCusingSTM.find
  --   printCol = MLCusingSTM.printList
  --   cntCol = MLCusingSTM.cntList
  
  
  instance (Eq e, Show e) => Col (MLC.ListHandle e) e where
     newCol = MLC.newList
     insertCol c e = do MLC.addToTail c e
                        return ()
     deleteCol = MLC.delete
     findCol = MLC.find
     printCol = MLC.printList
     cntCol = MLC.cntList
  
  --instance (Eq e, Show e) => Col (S.ListHandle e) e where
  --   newCol = S.newList
  --   insertCol c e = do S.addToTail c e
  --                      return ()
  --   deleteCol = S.delete
  --   findCol = S.find
  --   printCol = S.printList
  --   cntCol = S.cntList
  
  -- Auxiliary functions
  
  createList :: Col c e => [e] -> IO c
  createList n = 
    do nl <- newCol
       mapM (insertCol nl) n
       return nl
  
  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 ()
  
  appendIORef :: IORef [a] -> a -> IO ()
  appendIORef ref a = do
    { as <- readIORef ref
    ; writeIORef ref (a:as) }
      
  showComma :: [String] -> String
  showComma (s:ss) = "," ++ s ++ (showComma ss)
  showComma [] = ""
    
  -- Main interface
      
  run_testdata :: FilePath -> String -> IO ()
  run_testdata testdata_fname mode = do
      { tc <- parse_testdata testdata_fname
      ; putStrLn "Test Initiated: "
      ; let init_elems = t_init_list tc
            works      = t_tasks tc
      ; medians  <- newIORef []
      ; highlows <- newIORef []
      ; runtests mode init_elems works (medians,highlows)
      }
      where
          runtests m elems works refs =
            case m of
               "CAS"   -> do nl :: CAS.ListHandle Int <- createList elems 
                             runtest m works nl refs
               "IMM"   -> do nl :: IMM.ListHandle Int <- createList elems 
                             runtest m works nl refs
  --             "CASusingSTM"   -> do nl :: CASusingSTM.ListHandle Int <- createList elems 
  --                                   runtest m works nl refs
  --             "LAZY" -> do nl :: Lazy.ListHandle Int <- createList elems
  --                          runtest m works nl refs
               "MLC" -> do nl :: MLC.ListHandle Int <- createList elems 
                           runtest m works nl refs
  --             "MLCusingSTM" -> do nl :: MLCusingSTM.ListHandle Int <- createList elems 
  --                                 runtest m works nl refs
               "IO" -> do nl  :: I.ListHandle Int <- createList elems
                          runtest m works nl refs
  --             "STM" -> do nl  :: S.ListHandle Int <- createList elems
  --                         runtest m works nl refs
               trash -> fail $ "Oi! No such concurrency mode: " ++ trash 
             
     
          runtest m works nl (medians,highlows) = do
            { putStrLn $ "Test Started: " ++ m
            ; performGC 
  --          ; wait <- atomically (newTVar 0)
            ; wait <- newEmptyMVar
            ; start <- getCurrentTime
            ; zipWithM (\n work -> forkOn n (do { executeTasks nl work
                                                ; putMVar wait () }))
                                                --atomically(do counter <- readTVar wait
  --                                                              writeTVar wait (counter+1)) }))
              [0..] works
            ; replicateM_ (length works) (takeMVar wait)
  --          ; atomically ( do { counter <- readTVar wait
  --                            ; if counter < length works then retry 
  --                              else return () } )
            ; fin <- getCurrentTime
            ; let result = diffUTCTime fin start
            ; -- printf "time: %.2fs\n" (realToFrac result :: Double)
            ; return () }
  
          output_fname = "out"
  
          write_output mod ms mref hlref = do
            { if mod == 1 
              then do { writeFile output_fname ""
                      ; output_header output_fname ms
                      ; appendFile output_fname ",,"
                      ; output_header output_fname ms
                      ; appendFile output_fname "\n1Core" }
              else appendFile output_fname ("\n" ++ (show mod) ++ "Cores") 
            ; medians  <- readIORef mref
            ; highlows <- readIORef hlref
            ; let mstr = reverse $ map show medians
                  hlstr = reverse $ highlows
            ; appendFile output_fname (filter (/='s') (showComma mstr))
            ; appendFile output_fname ",," 
            ; appendFile output_fname (filter (/='s') (showComma hlstr)) }
            
          output_header output_fname (m:ms) = do
            { appendFile output_fname ("," ++ m)
            ; output_header output_fname ms }
          output_header output_fname [] = return ()
            
          high_low results =
            let fst = head results
                lst = head $ drop ((length results) - 1) results
            in (fst,lst)
  