synthesizer-llvm-0.2: 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.Representation as Rep
import qualified LLVM.Core as LLVM

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,
    LLVM.MakeValueTuple a av,
    Rep.Memory 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,
    LLVM.MakeValueTuple a av, Rep.Memory 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,
    LLVM.MakeValueTuple a av,
    Rep.Memory 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)