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 (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 -> Word) n) $*
           RingBuffer.track (fmap succ n) noise)

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

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 (Word, 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), Word, 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) :
   []