RingBufferForward.hs

{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE Rank2Types #-}
module Test.Synthesizer.LLVM.RingBufferForward (tests) where

import qualified Synthesizer.LLVM.Parameter as Param
import qualified Synthesizer.LLVM.CausalParameterized.RingBufferForward as RingBuffer
import qualified Synthesizer.LLVM.CausalParameterized.Process as CausalP
import qualified Synthesizer.LLVM.Parameterized.Signal as SigP
import Synthesizer.LLVM.CausalParameterized.Process (($*), )

import qualified Data.StorableVector.Lazy as SVL

import qualified Test.Synthesizer.LLVM.Generator as Gen
import Test.Synthesizer.LLVM.Generator
         (Test, checkWithParam, arg, pair, triple, withGenArgs, )
import Test.Synthesizer.LLVM.Utility
         (CheckEquality, CheckEquality2, checkEquality, checkEquality2,
          genRandomVectorParam, randomSignal, )

import Control.Applicative (pure, )

import qualified LLVM.Extra.Arithmetic as A

import qualified LLVM.Core as LLVM
import LLVM.Core (Value, )

import Foreign.Storable (Storable, )

import qualified System.Random as Rnd
import Data.Word (Word32, )

import NumericPrelude.Numeric
import NumericPrelude.Base


type EquFloat = CheckEquality Float

signalLength :: Int
signalLength = 10000


limitFloat :: (Storable a) => SVL.Vector a -> SVL.Vector a
limitFloat = SVL.take signalLength


trackId :: Test (Int, Word32) EquFloat
trackId =
   withGenArgs (pair (Gen.choose (1,1000)) Gen.arbitrary) $
         \(bufferSize, seed) ->
     let noise = SigP.noise seed 1
     in checkEquality limitFloat
          noise
          (CausalP.mapSimple (RingBuffer.index A.zero) $*
           RingBuffer.track bufferSize noise)

trackTail :: Test (Int, Word32) EquFloat
trackTail =
   withGenArgs (pair (Gen.choose (2,1000)) Gen.arbitrary) $
         \(bufferSize, seed) ->
     let noise = SigP.noise seed 1
     in checkEquality limitFloat
          (SigP.tail noise)
          (CausalP.mapSimple (RingBuffer.index A.one) $*
           RingBuffer.track bufferSize noise)

trackDrop :: Test (Int, Word32) EquFloat
trackDrop =
   withGenArgs (pair (Gen.choose (0,1000)) Gen.arbitrary) $
         \(n, seed) ->
     let noise = SigP.noise seed 1
     in checkEquality limitFloat
          (SigP.drop n noise)
          (CausalP.map RingBuffer.index (fmap (fromIntegral :: Int -> Word32) n) $*
           RingBuffer.track (fmap succ n) noise)

randomSkips :: Param.T p (Int, Rnd.StdGen) -> SigP.T p (Value Word32)
randomSkips = randomSignal (0,10::Word32)

trackSkip :: Test ((Int, Rnd.StdGen), Word32) EquFloat
trackSkip =
   withGenArgs (pair (arg genRandomVectorParam) Gen.arbitrary) $
      \(sk, seed) ->
   let skips = randomSkips sk
       noise = SigP.noise seed 1
   in  checkEquality limitFloat
          (CausalP.skip noise $* skips)
          (CausalP.mapSimple (RingBuffer.index A.one) $*
           (RingBuffer.trackSkip 1 noise $* skips))

trackSkip1 :: Test (Word32, Word32) EquFloat
trackSkip1 =
   let bufferSize :: Int
       bufferSize = 1000
   in  withGenArgs
         (pair
            (Gen.choose (0, fromIntegral bufferSize - 1))
            Gen.arbitrary) $
         \(k, seed) ->
            let noise = SigP.noise seed 1
            in  checkEquality limitFloat
                  (CausalP.map RingBuffer.index k $*
                   (RingBuffer.track (pure bufferSize) noise))
                  (CausalP.map RingBuffer.index k $*
                   (RingBuffer.trackSkip (pure bufferSize) noise $* 1))

trackSkipHold ::
   Test ((Int, Rnd.StdGen), Word32, Word32) (CheckEquality2 Bool Float)
trackSkipHold =
   let bufferSize = 1000
   in  withGenArgs
         (triple
            (arg genRandomVectorParam)
            (Gen.choose (0, fromIntegral bufferSize - 1))
            Gen.arbitrary) $
         \(sk, k, seed) ->
            let skips = randomSkips sk
                noise = SigP.noise seed 1
            in  checkEquality2 limitFloat limitFloat
                  (fmap ((,) (LLVM.valueOf True)) $
                   (CausalP.map RingBuffer.index k $*
                    (RingBuffer.trackSkip (pure bufferSize) noise $* skips)))
                  (CausalP.map
                      (\ki ((b,_s),buf) -> fmap ((,) b) $ RingBuffer.index ki buf) k $*
                   (RingBuffer.trackSkipHold (pure bufferSize) noise $* skips))

{-
To do:

test that trackSkipHold returns False forever after it has returned False once.
-}


tests :: [(String, IO ())]
tests =
   ("trackId", checkWithParam trackId) :
   ("trackTail", checkWithParam trackTail) :
   ("trackDrop", checkWithParam trackDrop) :
   ("trackSkip", checkWithParam trackSkip) :
   ("trackSkip1", checkWithParam trackSkip1) :
   ("trackSkipHold", checkWithParam trackSkipHold) :
   []