{-# LANGUAGE EmptyDataDecls,FlexibleInstances, TypeSynonymInstances, TypeSynonymInstances, ExistentialQuantification, CPP #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Benchmark
-- Copyright   :  (c)2011, Texas Instruments France
-- License     :  BSD-style (see the file LICENSE)
-- 
-- Maintainer  :  c-favergeon-borgialli@ti.com
-- Stability   :  provisional
-- Portability :  portable
--
-- Benchmark module to create and control the OpenCL kernels on the board

module Benchmark(
 -- * Benchmark types
   ArrayLength(..)
 -- ** Type of a generic Benchmark
 , Benchmark
 -- ** Type of kernel arguments
 , Float4(..)
 , CLFloat(..)
 , CLFloat4(..)
 , CLInt(..)
 , CLIntArray(..)
 , CLFloatArray(..)
 , CLFloat4Array(..)
 , CLIntArrayOO(..)
 , CLFloatArrayOO(..)
 , CLFloat4ArrayOO(..)
 -- ** Tag for a kernel argument
 , In
 , InOut
 -- * Benchmark control
 -- ** Rounding control
 , gpuRoundingMode
 -- ** For connection to the server and control of the test to run
 , Options(..)
 , defaultOptions
 -- ** NDRange specification
 , WorkSize
 , OneD
 , TwoD
 , ThreeD
 , NDRange
 , size1D
 , size2D
 , size3D
 , ndRange
 , simpleNDRange
 , defaultLocalWs
 -- ** Benchmark results
 , BenchResult(..)
 , DataResults(..)
 , DataResult(..)
 , TimingResult(..)
 -- * Benchmark functions
 -- ** Benchmark creations
 , bench
 , clFloatArrayOO
 , clFloat4ArrayOO
 , clIntArrayOO
 , clConstIntArray
 , clConstFloatArray
 , clConstFloat4Array
 -- ** Benchmark control
 , endSimu
 , onBoard
 , onBoardOnlyTiming
 , onBoardOnlyData
 , Clocks(..)
 , defaultClocks
#ifdef OMAP4
 , CPUClock(..)
 , MemClock(..)
 , GPUClock(..)
#endif
 -- ** Benchmark results
 , fromFloatResult
 , fromFloat4Result
 , fromIntResult
 ) where

import System.IO
import Network.Socket
import Data.Int


import Data.List(intercalate)

import Test.QuickCheck.Monadic(run)
import Rounding
import Text.Printf

-- -----------------------------------------------------------------------------
-- Benchmark options

-- | Options controling a benchmark
data Options = Options
     { port :: String -- ^ The IP port
     , addr :: String -- ^ The server IP address
     , validation :: Bool -- ^ True is validation tests must be executed
     , performance :: Bool -- ^ True if performance tests must be executed
     , roundingMode :: RoundingMode -- ^ Rounding mode used by the GPU
     } deriving Show

-- | Default values for the options
defaultOptions    = Options
     { port     = "2000"
     , addr = "128.247.79.158"
     , validation = False
     , performance = True
     , roundingMode = TowardZero
     }

class Dimension s

instance Dimension OneD

instance Dimension TwoD

instance Dimension ThreeD

-- | Phantom type to constraint a list to one element
data OneD

-- | Phantom type to constraint a list to two elements
data TwoD

-- | Phantom type to constraint a list to three elements
data ThreeD

-- | Index space dimension with a constrained dimension s
data WorkSize s = WorkSize [Int]
              deriving(Eq)

-- | NDRange : the global and local worksize are constrained to have the same dimension
data NDRange s = NDRange (WorkSize s) (WorkSize s)

-- | Force the rounding mode
gpuRoundingMode :: Options -> IO ()
gpuRoundingMode opts = setRoundingMode (roundingMode opts)


a `isMultipleOf` b = a `rem` b == 0

class DetailedShow a where
   detailedShow :: a -> String

instance DetailedShow Int32 where
   detailedShow a = printf "%d" a

instance DetailedShow Float where
   detailedShow a = printf "%.20f" a

instance DetailedShow Float4 where
   detailedShow (x,y,z,t) = printf "(%.20f,%.20f,%.20f,%.20f)" x y z t

instance DetailedShow [Float] where
   detailedShow l = ("[" ++) . ((intercalate "," (map detailedShow l)) ++) . ("]" ++) $ ""

instance DetailedShow [Float4] where
   detailedShow l = ("[" ++) . ((intercalate "," (map detailedShow l)) ++) . ("]" ++) $ ""


-- | Create the NDRange from the global and local worksize
ndRange :: WorkSize s -> WorkSize s -> Maybe (NDRange s)
ndRange a@(WorkSize la) b@(WorkSize lb) = if all (uncurry isMultipleOf) (zip la lb) then Just (NDRange a b) else Nothing

-- | Creatre an ND range with a worksize of 1 in each dimension
simpleNDRange :: WorkSize s -> NDRange s
simpleNDRange w = NDRange w (defaultLocalWs w)

instance (Show (NDRange OneD)) where
  show (NDRange wa wb) = show wa ++ " " ++ show wb

instance (Show (NDRange TwoD)) where
  show (NDRange wa wb) = show wa ++ " " ++ show wb

instance (Show (NDRange ThreeD)) where
  show (NDRange wa wb) = show wa ++ " " ++ show wb

#ifdef OMAP4

data Clocks = Clocks {
              cpuClock :: CPUClock
            , memClock :: MemClock
            , gpuClock :: GPUClock
            } deriving(Eq)

{-

WARNING : Those clock values DO NOT reflect the capabilities of the
OMAP4 platform and OMAP derivatives. To know the maximum clock values for each
OMAP4 derivative, please refer to the official Texas Instruments documentation.

-}

data CPUClock = CPU_1008MHz | CPU_800MHz deriving(Eq,Enum,Show)
data MemClock = MEM_400MHz | MEM_200MHz deriving(Eq,Enum,Show)
data GPUClock = GPU_307MHz | GPU_192MHz deriving(Eq,Enum,Show)

defaultClocks = Clocks CPU_1008MHz MEM_400MHz GPU_307MHz

instance Show Clocks where
  show (Clocks a b c) = "(" ++ show (fromEnum a) ++ "," ++ show (fromEnum b) ++ "," ++ show (fromEnum c) ++ ")"

#else
data Clocks = Clocks

defaultClocks = Clocks

instance Show Clocks where
  show _ = "(0,0,0)"
#endif

-- | Create a 1D worksize
size1D :: Int -> WorkSize OneD
size1D a = WorkSize [a]

-- | Create a 2D worksize
size2D :: Int -> Int -> WorkSize TwoD
size2D a b = WorkSize [a,b]

-- | Create a 3D worksize
size3D :: Int -> Int -> Int -> WorkSize ThreeD
size3D a b c = WorkSize [a,b,c]

-- | Create the standard worksize with a size of 1 in each dimension and
-- with a number of number given by the argument worksize
defaultLocalWs :: WorkSize s -> WorkSize s
defaultLocalWs (WorkSize l) = WorkSize $ replicate (length l) 1



instance Show (WorkSize OneD) where
  show (WorkSize (a:_)) = show a
  show _ = error "Wrong number of elements for the worksize dimension"

instance Show (WorkSize TwoD) where 
  show (WorkSize (a:b:_)) = "(" ++ show a ++ "," ++ show b ++ ")"
  show _ = error "Wrong number of elements for the worksize dimension"

instance Show (WorkSize ThreeD) where 
  show (WorkSize (a:b:c:_)) = "(" ++ show a ++ "," ++ show b ++ "," ++ show c ++ ")"
  show _ = error "Wrong number of elements for the worksize dimension"

-- | Data transfer mode for an argument
data Mode a = Input a -- ^ The argument is an input
            | InputOutput a -- ^ The argument is used as an input/output
            deriving(Eq,Show)

-- | Internal type for the argument
-- used to generate the commands for the server
data OCLARG = OCLInt (Mode Int32)
            | OCLFloat (Mode Float)
            | OCLFloat4 (Mode Float4)
            | OCLIntList (Mode [Int32])
            | OCLFloatList (Mode [Float])
            | OCLFloat4List (Mode [Float4])
            | OCLConstantIntList (Mode (ArrayLength,Int32))
            | OCLConstantFloatList (Mode (ArrayLength,Float))
            | OCLConstantFloat4List (Mode (ArrayLength,Float))
            | OCLIntListOO ArrayLength
            | OCLFloatListOO ArrayLength
            | OCLFloat4ListOO ArrayLength
            | OCLEnd
            | OCLCommand String
            deriving(Eq, Show)

type ArrayLength = Int32

-- | Create an output only float array
clFloatArrayOO x = CLFloatArrayOO (fromIntegral x)

-- | Create an output only float4 array
clFloat4ArrayOO x = CLFloat4ArrayOO (fromIntegral x)

-- | Create an output only int array
clIntArrayOO x = CLIntArrayOO (fromIntegral x)

-- | Create a constan int array
clConstIntArray i f = CLConstIntArray (fromIntegral i) f

-- | Create a constant float array
clConstFloatArray  i f = CLConstFloatArray (fromIntegral i) f

-- | Create a constant float4 array
clConstFloat4Array  i f = CLConstFloat4Array (fromIntegral i) f

-- | OpenCL Float value. 's' is used to identify if it is an input or an input /output
data CLFloat s = CLFloat Float deriving(Eq,Show)

-- | OpenCL Float value. 's' is used to identify if it is an input or an input /output
data CLFloat4 s = CLFloat4 Float4 deriving(Eq,Show)

-- | OpenCL int value. Warning : is is encoded as an Haskell Int which may be bigger
data CLInt s = CLInt Int32 deriving(Eq,Show)

-- | OpenCL array of int
data CLIntArray s = CLIntArray [Int32] 
                  | CLConstIntArray ArrayLength Int32 -- ^ Constant data generator used by the board to generate the data
                  deriving(Eq,Show)

-- | OpenCL array of float
data CLFloatArray s = CLFloatArray [Float] -- ^ The data is generated from the host
                    | CLConstFloatArray ArrayLength Float -- ^ Constant data generator used by the board to generate the data
                    deriving(Eq,Show)

-- | A Float4 type
type Float4 = (Float,Float,Float,Float)

-- | OpenCL array of float4
data CLFloat4Array s = CLFloat4Array [Float4] -- ^ The data is generated from the host
                     | CLConstFloat4Array ArrayLength Float -- ^ Constant data generator used by the board to generate the data
                     deriving(Eq,Show)

-- | Output only OpenCL array of ints. The host is not transferring any data before running the kernel.
-- The board is allocating the memory required to contain the output.
data CLIntArrayOO = CLIntArrayOO ArrayLength deriving(Eq,Show)

-- | Output only OpenCL array of float. The host is not transferring any data before running the kernel.
-- The board is allocating the memory required to contain the output.
data CLFloatArrayOO = CLFloatArrayOO ArrayLength deriving(Eq,Show)

-- | Output only OpenCL array of float4. The host is not transferring any data before running the kernel.
-- The board is allocating the memory required to contain the output.
data CLFloat4ArrayOO = CLFloat4ArrayOO ArrayLength deriving(Eq,Show)

-- | Used to tag an argument as input only
data In

-- | Used to tag an argument as input/output
data InOut

-- | Generate the part of the server command corresponding to a given argument type
generateMsgElement (OCLInt (Input a)) = "IN INT:" ++ (show a) ++ ";"
generateMsgElement (OCLInt (InputOutput a)) = "BOTH INT:" ++ (show a) ++ ";"

generateMsgElement (OCLFloat (Input a)) = "IN FLOAT:" ++ (detailedShow a) ++ ";"
generateMsgElement (OCLFloat (InputOutput a)) = "BOTH FLOAT:" ++ (detailedShow a) ++ ";"

generateMsgElement (OCLFloat4 (Input a)) = "IN FLOAT4:" ++ (detailedShow a) ++ ";"
generateMsgElement (OCLFloat4 (InputOutput a)) = "BOTH FLOAT4:" ++ (detailedShow a) ++ ";"

generateMsgElement (OCLIntList (Input a)) = "IN INTLIST:" ++ (show a) ++ ";"
generateMsgElement (OCLIntList (InputOutput a)) = "BOTH INTLIST:" ++ (show a) ++ ";"
generateMsgElement (OCLIntListOO n) = "OUT INTLIST " ++ (show n) ++ ";"

generateMsgElement (OCLFloatList (Input a)) = "IN FLOATLIST:" ++ (detailedShow a) ++ ";"
generateMsgElement (OCLFloatList (InputOutput a)) = "BOTH FLOATLIST:" ++ (detailedShow a) ++ ";"

generateMsgElement (OCLFloat4List (Input a)) = "IN FLOAT4LIST:" ++ (detailedShow a) ++ ";"
generateMsgElement (OCLFloat4List (InputOutput a)) = "BOTH FLOAT4LIST:" ++ (detailedShow a) ++ ";"

generateMsgElement (OCLConstantIntList (Input (nb,v))) = "IN INTLIST: CONSTARRAY " ++ (show nb) ++ " " ++ detailedShow v ++ ";"           
generateMsgElement (OCLConstantIntList (InputOutput (nb,v))) = "BOTH INTLIST: CONSTARRAY " ++ (show nb) ++ " " ++ detailedShow v ++ ";" 


generateMsgElement (OCLConstantFloatList (Input (nb,v))) = "IN FLOATLIST: CONSTARRAY " ++ (show nb) ++ " " ++ detailedShow v ++ ";"           
generateMsgElement (OCLConstantFloatList (InputOutput (nb,v))) = "BOTH FLOATLIST: CONSTARRAY " ++ (show nb) ++ " " ++ detailedShow v ++ ";"  

generateMsgElement (OCLConstantFloat4List (Input (nb,v))) = "IN FLOAT4LIST: CONSTARRAY " ++ (show nb) ++ " " ++ detailedShow v ++ ";"           
generateMsgElement (OCLConstantFloat4List (InputOutput (nb,v))) = "BOTH FLOAT4LIST: CONSTARRAY " ++ (show nb) ++ " " ++ detailedShow v ++ ";"           

generateMsgElement (OCLFloatListOO n) = "OUT FLOATLIST " ++ (show n) ++ ";"
generateMsgElement (OCLFloat4ListOO n) = "OUT FLOAT4LIST " ++ (show n) ++ ";"

generateMsgElement OCLEnd = "ENDMESSAGE"
generateMsgElement (OCLCommand s) = s

-- | Generate the final server command using the kernel name, global work size and kind of
-- output wanted : data only or with data
benchCommand s clock nb ignore | ignore = OCLCommand $ "KERNEL " ++ (show s) ++ " " ++ show clock ++ " " ++ (show nb) ++ " IGNORE ;"
                               | otherwise = OCLCommand $ "KERNEL " ++ (show s) ++ " " ++ show clock ++ " " ++ (show nb) ++ ";"

-- | Data type to described the wanted output from the server
data ResultMode = TimingOnly -- ^ The server is only returning the timing
                | AllData -- ^ The server is also returning the data
                deriving(Eq,Show)

-- | Generate a Benchmark
bench :: Benchmark r
      => String -- ^ Kernel name
      -> r
bench s = generateCmd  s []   


-- | Each type which can be used as an argument of a kernel is an instance of this class
class BenchmarkArg a where
  toOCLARG :: String -> a -> OCLARG

instance BenchmarkArg Float where
  toOCLARG _ a = OCLFloat (Input a)

instance BenchmarkArg Float4 where
  toOCLARG _ a = OCLFloat4 (Input a)

instance BenchmarkArg Int32 where
  toOCLARG _ a = OCLInt (Input a)

instance BenchmarkArg Int where
  toOCLARG _ a = OCLInt (Input . fromIntegral $ a)

instance BenchmarkArg (CLFloat In) where
  toOCLARG _ (CLFloat a) = OCLFloat (Input a)

instance BenchmarkArg (CLFloat InOut) where
  toOCLARG _ (CLFloat a) = OCLFloat (InputOutput a)

instance BenchmarkArg (CLFloat4 In) where
  toOCLARG _ (CLFloat4 a) = OCLFloat4 (Input a)

instance BenchmarkArg (CLFloat4 InOut) where
  toOCLARG _ (CLFloat4 a) = OCLFloat4 (InputOutput a)

instance BenchmarkArg (CLInt In) where
  toOCLARG _ (CLInt a) = OCLInt (Input a)

instance BenchmarkArg (CLInt InOut) where
  toOCLARG _ (CLInt a) = OCLInt (InputOutput a)

instance BenchmarkArg (CLIntArray In) where
  toOCLARG _ (CLIntArray a) = OCLIntList (Input a)
  toOCLARG _ (CLConstIntArray nb v) = OCLConstantIntList (Input (nb,v))

instance BenchmarkArg (CLIntArray InOut) where
  toOCLARG _ (CLIntArray a) = OCLIntList (InputOutput a)
  toOCLARG _ (CLConstIntArray nb v) = OCLConstantIntList (Input (nb,v))

instance BenchmarkArg (CLFloatArray In) where
  toOCLARG _ (CLFloatArray a) = OCLFloatList (Input a)
  toOCLARG _ (CLConstFloatArray nb v) = OCLConstantFloatList (Input (nb,v))

instance BenchmarkArg (CLFloatArray InOut) where
  toOCLARG _ (CLFloatArray a) = OCLFloatList (InputOutput a)
  toOCLARG _ (CLConstFloatArray nb v) = OCLConstantFloatList (InputOutput (nb,v))

instance BenchmarkArg (CLFloat4Array In) where
  toOCLARG _ (CLFloat4Array a) = OCLFloat4List (Input a)
  toOCLARG _ (CLConstFloat4Array nb v) = OCLConstantFloat4List (Input (nb,v))

instance BenchmarkArg (CLFloat4Array InOut) where
  toOCLARG _ (CLFloat4Array a) = OCLFloat4List (InputOutput a)
  toOCLARG _ (CLConstFloat4Array nb v) = OCLConstantFloat4List (InputOutput (nb,v))



instance BenchmarkArg (CLIntArrayOO) where
  toOCLARG _ (CLIntArrayOO n) = OCLIntListOO n

instance BenchmarkArg (CLFloatArrayOO) where
  toOCLARG _ (CLFloatArrayOO n) = OCLFloatListOO n

instance BenchmarkArg (CLFloat4ArrayOO) where
  toOCLARG _ (CLFloat4ArrayOO n) = OCLFloat4ListOO n

instance BenchmarkArg [Float] where
  toOCLARG _ a = OCLFloatList (Input a)

instance BenchmarkArg [Float4] where
  toOCLARG _ a = OCLFloat4List (Input a)

instance BenchmarkArg (Clocks, NDRange OneD,ResultMode) where
  toOCLARG c (clocks,nb,TimingOnly) = benchCommand c clocks nb True
  toOCLARG c (clocks,nb,_) = benchCommand c clocks nb False

instance BenchmarkArg (Clocks, NDRange TwoD,ResultMode) where
  toOCLARG c (clocks,nb,TimingOnly) = benchCommand c clocks nb True
  toOCLARG c (clocks,nb,_) = benchCommand c clocks nb False

instance BenchmarkArg (Clocks, NDRange ThreeD,ResultMode) where
  toOCLARG c (clocks,nb,TimingOnly) = benchCommand c clocks nb True
  toOCLARG c (clocks,nb,_) = benchCommand c clocks nb False


-- | Magic class used to implement a function with a varying number
-- of argument using different types. 
class Benchmark r where
  generateCmd :: String -> [OCLARG] -> r 

-- | String is of benchmark kind since we want to be able to generate
-- a string of command from a Benchmark
instance Benchmark String where
  generateCmd s (kernel:args) = let cmds = kernel:reverse (OCLEnd:args)
   in
     concatMap generateMsgElement cmds

-- | A benchmark taking one argument is equivalent to a new argument command for the server
-- plus a benchmark without this argument
instance (BenchmarkArg a,Benchmark r) => Benchmark (a -> r) where
   generateCmd c args = \a -> generateCmd c (toOCLARG c a:args)

-- | Send command to the server and read the timing and data returned by the server
onBoard :: Options -> Clocks -> NDRange s -> ((Clocks, NDRange s, ResultMode) -> String) -> IO BenchResult
onBoard opts clocks global_ws a =  runCmd opts $ \h -> executeBench h (a (clocks,global_ws,AllData))

-- | Send command to the server and read the timing returned by the server.
-- The server is not returning any data to minimize the communication costs.
onBoardOnlyTiming :: Options -> Clocks -> NDRange s -> ((Clocks, NDRange s, ResultMode) -> String) -> IO TimingResult
onBoardOnlyTiming opts clocks global_ws a =  do
  BenchResult (t,_) <- runCmd opts $ \h -> executeBench h (a (clocks,global_ws,TimingOnly))
  return t

-- | Send command to the server and read the data returned by the server.
-- Timing data are just dropped and not returned. But timing data (small) are nevertheless returned from
-- the server
onBoardOnlyData :: Options -> NDRange s -> ((Clocks,NDRange s, ResultMode) -> String) -> IO DataResults
onBoardOnlyData opts global_ws a =  do
  BenchResult (_,v) <- runCmd opts $ \h -> executeBench h (a (defaultClocks, global_ws,AllData))
  return v

-- | Send the end of simulation command
endSimu :: Options -> IO ()
endSimu opts = runCmd opts $ \h -> do
  hPutStrLn h $ "END"
  hFlush h

-- | Send a command to the server socket
runCmd :: Options -> (Handle -> IO a) -> IO a
runCmd opts a = do
  addrinfos <- getAddrInfo Nothing (Just (addr opts)) (Just (port opts))
  let serveraddr = head addrinfos
  sock <- socket (addrFamily serveraddr) Stream defaultProtocol
  setSocketOption sock KeepAlive 1
  connect sock (addrAddress serveraddr)

  -- Make a Handle out of it for convenience
  h <- socketToHandle sock ReadWriteMode
  hSetBuffering h (BlockBuffering Nothing)
  r <- a h
  hClose h
  return r

data DataResult = FloatResult [Float] | Float4Result [Float4] | IntResult [Int32] deriving(Eq,Show)

-- | Extract the float result
fromFloatResult :: DataResult -> [Float]
fromFloatResult (FloatResult l) = l
fromFloatResult _ = error "Can't get a float result"

-- | Extract the float4 result
fromFloat4Result :: DataResult -> [Float4]
fromFloat4Result (Float4Result l) = l
fromFloat4Result _ = error "Can't get a float result"

-- | Extract the int result
fromIntResult :: DataResult -> [Int32]
fromIntResult (IntResult l) = l
fromIntResult _ = error "Can't get a int result"


-- | Result of a benchmark : timing and list of OpenCL arrays
newtype BenchResult = BenchResult (TimingResult,DataResults) deriving(Eq,Show)

-- | Data only result : list of OpenCL arrays
type DataResults = [DataResult] 


type CLBufferCreationTime = Double
type CLBufferWriteTime = Double
type CLExecutionTime = Double
type CLReadingResultTime = Double

-- | Timing only result
-- Creation time, execution time, result time  and execution time measured by the HLOS (see DESIGN doc)
type TimingResult = (CLBufferCreationTime,CLBufferWriteTime,CLExecutionTime,CLReadingResultTime)

-- | Write the command to the server socket and read the results
executeBench :: Handle -> String -> IO BenchResult
executeBench h command = do
  --putStrLn command
  hPutStrLn h command
  hFlush h
  getResult h
  --return $ BenchResult ((0.0,0.0,0.0),[[1.0]])

{-

Reading result

-}

-- | Read an array of float
getArray h l = do
  nb <- hGetLine h
  if (nb == ".")
    then
       return (reverse l)
    else
       getArray h (read nb:l)

-- | Read a result from the socket.
-- * is end of result transmissions
-- t is timing result
-- rl is array of float
readResult h t l = do
  c <- hGetLine h
  case c of
     "*" -> return $ BenchResult (t,l)
     "t" -> do
         c <- hGetLine h
         w <- hGetLine h
         e <- hGetLine h
         r <- hGetLine h
         let createTime = read c :: Double
             writeTime = read w :: Double
             executeTime = read e :: Double
             readTime = read r :: Double
         readResult h (createTime,writeTime,executeTime,readTime) l
     "rl" -> do
        nl <- getArray h [] :: IO [Float]
        readResult h t (FloatResult nl:l)
     "zl" -> do
        nl <- getArray h [] :: IO [Float4]
        readResult h t (Float4Result nl:l)
     "nl" -> do
        nl <- getArray h [] :: IO [Int32]
        readResult h t (IntResult nl:l)
     _ -> return $ BenchResult (t,reverse l)

-- | Parse a result from the socket
getResult :: Handle -> IO BenchResult
getResult h = readResult h (0.0,0.0,0.0,0.0) []