-- see synthesizer-core/speedtest/SpeedTestExp
module Main (main) where

import System.Time (getClockTime, diffClockTimes, tdSec, tdPicosec)

import System.IO (Handle, openBinaryFile, withBinaryFile, hClose, hPutBuf, IOMode(WriteMode))
import Foreign (Int16, poke, pokeElemOff, allocaBytes, allocaArray, advancePtr, )
import Control.Exception (bracket)


doubleToInt16 :: Double -> Int16
doubleToInt16 x = round (32767 * x)


{-# INLINE withBinaryFile #-}
withBinaryFile :: FilePath -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile fp iom =
   bracket (openBinaryFile fp iom) hClose

putExponential :: Int -> Double -> Double -> Handle -> IO ()
putExponential num hl y0 h =
   -- allocaArray would be cleaner but crashes on JHC
   -- allocaArray num $ \buf ->
   allocaBytes (2*num) $ \buf ->
      let k = 0.5**(1/hl)
          loop i y =
             if i<num
               then pokeElemOff buf i (doubleToInt16 y) >>
                    loop (succ i) (y*k)
               else return ()
      in  loop 0 y0 >>
          hPutBuf h buf (2*num)

putExponentialPtr :: Int -> Double -> Double -> Handle -> IO ()
putExponentialPtr num hl y0 h =
   allocaBytes (2*num) $ \buf ->
      let k = 0.5**(1/hl)
          end = advancePtr buf num
          loop p y =
             if p<end
               then poke p (doubleToInt16 y) >>
                    loop (advancePtr p 1) (y*k)
               else return ()
      in  loop buf y0 >>
          hPutBuf h buf (2*num)


{-# INLINE measureTime #-}
measureTime :: String -> IO () -> IO ()
measureTime name act =
   do putStr (name++": ")
      timeA <- getClockTime
      act
      timeB <- getClockTime
      let td = diffClockTimes timeB timeA
      print (fromIntegral (tdSec td) +
             fromInteger (tdPicosec td) * 1e-12 :: Double)

numSamples :: Int
numSamples = 10000000

halfLife :: Double
halfLife = 100000


main :: IO ()
main =
   do {-
      measureTime "poke exponential int16"
         (withBinaryFile "exp-poked.sw" WriteMode
             (putExponential numSamples halfLife 1))
      -}
      measureTime "poke ptr exponential int16"
         (withBinaryFile "exp-poked-ptr.sw" WriteMode
             (putExponentialPtr numSamples halfLife 1))