synthesizer-llvm-0.3: src/Test/Synthesizer/LLVM/Utility.hs

{-# LANGUAGE NoImplicitPrelude #-}
module Test.Synthesizer.LLVM.Utility where

import qualified Synthesizer.LLVM.Parameter as Param
import qualified LLVM.Extra.Memory as Memory
import qualified LLVM.Extra.Class as Class

import qualified Synthesizer.LLVM.Parameterized.Signal as SigP

import qualified Synthesizer.State.Signal as SigS

import Control.Arrow (arr, )
import Control.Monad (liftM, liftM2, )

import qualified Data.StorableVector.Lazy as SVL
import Data.StorableVector.Lazy (ChunkSize, )
import Foreign.Storable (Storable, )

import qualified Algebra.RealRing as RealRing

import System.Random (Random, randomR, mkStdGen, )

import NumericPrelude.Numeric
import NumericPrelude.Base


rangeFromInt :: Random a => (a,a) -> Param.T Int a
rangeFromInt rng =
   arr $ fst . randomR rng . mkStdGen


{-# INLINE checkSimilarityState #-}
checkSimilarityState ::
   (RealRing.C a, Storable a,
    Class.MakeValueTuple a av,
    Memory.C av ap) =>
   a ->
   (SVL.Vector a -> SVL.Vector a) ->
   SigP.T p av ->
   (p -> SigS.T a) ->
   IO (ChunkSize -> p -> Bool)
checkSimilarityState tol limit gen0 sig1 =
   let render sig =
          fmap
             (\func chunkSize ->
                limit . func chunkSize) $
          SigP.runChunky sig
   in  liftM
          (\sig0 chunkSize p ->
             SigS.foldR (&&) True $
             -- dangerous, since shortened signals would be tolerated
             SigS.zipWith (\x y -> abs(x-y) < tol)
                (SigS.fromStorableSignal (sig0 chunkSize p))
                (sig1 p))
          (render gen0)


{-# INLINE checkSimilarity #-}
checkSimilarity ::
   (RealRing.C b, Storable b,
    Storable a,
    Class.MakeValueTuple a av, Memory.C av ap) =>
   b ->
   (SVL.Vector a -> SVL.Vector b) ->
   SigP.T p av -> SigP.T p av ->
   IO (ChunkSize -> p -> Bool)
checkSimilarity tol limit gen0 gen1 =
   let render sig =
          fmap
             (\func chunkSize ->
                limit . func chunkSize) $
          SigP.runChunky sig
   in  liftM2
          (\sig0 sig1 chunkSize p ->
             SigS.foldR (&&) True $
             -- dangerous, since shortened signals would be tolerated
             SigS.zipWith (\x y -> abs(x-y) < tol)
                (SigS.fromStorableSignal (sig0 chunkSize p))
                (SigS.fromStorableSignal (sig1 chunkSize p)))
          (render gen0)
          (render gen1)


checkEquality ::
   (Eq a, Storable a,
    Class.MakeValueTuple a av,
    Memory.C av ap) =>
   (SVL.Vector a -> SVL.Vector a) ->
   SigP.T p av -> SigP.T p av ->
   IO (ChunkSize -> p -> Bool)
checkEquality limit gen0 gen1 =
   let render sig =
          fmap
             (\func chunkSize ->
                limit . func chunkSize) $
          SigP.runChunky sig
   in  liftM2
          (\sig0 sig1 chunkSize p ->
             sig0 chunkSize p == sig1 chunkSize p)
          (render gen0)
          (render gen1)