module Crypto.Lol.Benchmarks.UCycBenches (ucycBenches1, ucycBenches2) where
import Control.Applicative
import Control.Monad.Random hiding (lift)
import Crypto.Lol.Benchmarks
import Crypto.Lol.Cyclotomic.Tensor (TElt)
import Crypto.Lol.Cyclotomic.UCyc
import Crypto.Lol.Prelude
import Crypto.Lol.Types
import Crypto.Random
ucycBenches1 :: (Monad rnd, _) => Proxy '(t,m,r) -> Proxy gen -> rnd Benchmark
ucycBenches1 ptmr pgen = benchGroup "UCyc" $ ($ ptmr) <$> [
genBenchArgs "unzipPow" bench_unzipUCycPow,
genBenchArgs "unzipDec" bench_unzipUCycDec,
genBenchArgs "unzipCRT" bench_unzipUCycCRT,
genBenchArgs "zipWith (*)" bench_mul,
genBenchArgs "crt" bench_crt,
genBenchArgs "crtInv" bench_crtInv,
genBenchArgs "l" bench_l,
genBenchArgs "lInv" bench_lInv,
genBenchArgs "*g Pow" bench_mulgPow,
genBenchArgs "*g Dec" bench_mulgDec,
genBenchArgs "*g CRT" bench_mulgCRT,
genBenchArgs "divg Pow" bench_divgPow,
genBenchArgs "divg Dec" bench_divgDec,
genBenchArgs "divg CRT" bench_divgCRT,
genBenchArgs "lift" bench_liftPow,
genBenchArgs "error" (bench_errRounded 0.1) . addGen pgen
]
ucycBenches2 :: (Monad rnd, _) => Proxy '(t,m,m',r) -> rnd Benchmark
ucycBenches2 p = benchGroup "UCyc" $ ($ p) <$> [
genBenchArgs "twacePow" bench_twacePow,
genBenchArgs "twaceDec" bench_twaceDec,
genBenchArgs "twaceCRT" bench_twaceCRT,
genBenchArgs "embedPow" bench_embedPow,
genBenchArgs "embedDec" bench_embedDec,
genBenchArgs "embedCRT" bench_embedCRT
]
bench_unzipUCycPow :: _ => UCyc t m P (r,r) -> Bench '(t,m,r)
bench_unzipUCycPow = bench unzipPow
bench_unzipUCycDec :: _ => UCyc t m D (r,r) -> Bench '(t,m,r)
bench_unzipUCycDec = bench unzipDec
bench_unzipUCycCRT :: _ => UCycPC t m (r,r) -> Bench '(t,m,r)
bench_unzipUCycCRT = either (const $ error "bench_unzipUCycCRT expected a CRTC") (bench unzipCRTC)
pcToEC :: UCycPC t m r -> UCycEC t m r
pcToEC (Right x) = (Right x)
bench_mul :: _ => UCycPC t m r -> UCycPC t m r -> Bench '(t,m,r)
bench_mul a b =
let a' = pcToEC a
b' = pcToEC b
in bench (a' *) b'
bench_crt :: _ => UCyc t m P r -> Bench '(t,m,r)
bench_crt = bench toCRT
bench_crtInv :: (UCRTElt t r, _) => UCycPC t m r -> Bench '(t,m,r)
bench_crtInv (Right a) = bench toPow a
bench_l :: _ => UCyc t m D r -> Bench '(t,m,r)
bench_l = bench toPow
bench_lInv :: _ => UCyc t m P r -> Bench '(t,m,r)
bench_lInv = bench toDec
bench_liftPow :: _ => UCyc t m P r -> Bench '(t,m,r)
bench_liftPow = bench lift
bench_mulgPow :: _ => UCyc t m P r -> Bench '(t,m,r)
bench_mulgPow = bench mulG
bench_mulgDec :: _ => UCyc t m D r -> Bench '(t,m,r)
bench_mulgDec = bench mulG
bench_mulgCRT :: _ => UCycPC t m r -> Bench '(t,m,r)
bench_mulgCRT (Right a) = bench mulG a
bench_divgPow :: _ => UCyc t m P r -> Bench '(t,m,r)
bench_divgPow = bench divGPow . mulG
bench_divgDec :: _ => UCyc t m D r -> Bench '(t,m,r)
bench_divgDec = bench divGDec . mulG
bench_divgCRT :: _ => UCycPC t m r -> Bench '(t,m,r)
bench_divgCRT = either (const $ error "bench_divgCRT expected a CRTC") (bench divGCRTC)
bench_errRounded :: forall t m r gen . (TElt t r, Fact m, CryptoRandomGen gen, _)
=> Double -> Bench '(t,m,r,gen)
bench_errRounded v = benchIO $ do
gen <- newGenIO
return $ evalRand (errorRounded v :: Rand (CryptoRand gen) (UCyc t m D (LiftOf r))) gen
bench_twacePow :: forall t m m' r . (Fact m, _)
=> UCyc t m' P r -> Bench '(t,m,m',r)
bench_twacePow = bench (twacePow :: UCyc t m' P r -> UCyc t m P r)
bench_twaceDec :: forall t m m' r . (Fact m, _)
=> UCyc t m' D r -> Bench '(t,m,m',r)
bench_twaceDec = bench (twaceDec :: UCyc t m' D r -> UCyc t m D r)
bench_twaceCRT :: forall t m m' r . (Fact m, _)
=> UCycPC t m' r -> Bench '(t,m,m',r)
bench_twaceCRT (Right a) = bench (twaceCRTC :: UCyc t m' C r -> UCycPC t m r) a
bench_embedPow :: forall t m m' r . (Fact m', _)
=> UCyc t m P r -> Bench '(t,m,m',r)
bench_embedPow = bench (embedPow :: UCyc t m P r -> UCyc t m' P r)
bench_embedDec :: forall t m m' r . (Fact m', _)
=> UCyc t m D r -> Bench '(t,m,m',r)
bench_embedDec = bench (embedDec :: UCyc t m D r -> UCyc t m' D r)
bench_embedCRT :: forall t m m' r . (Fact m', _)
=> UCycPC t m r -> Bench '(t,m,m',r)
bench_embedCRT (Right a) = bench (embedCRTC :: UCyc t m C r -> UCycPC t m' r) a