lol-repa (empty) → 0.0.0.1
raw patch · 14 files changed
+1960/−0 lines, 14 filesdep +DRBGdep +MonadRandomdep +arithmoisetup-changed
Dependencies added: DRBG, MonadRandom, arithmoi, base, bytestring, constraints, containers, crypto-api, data-default, deepseq, lol, lol-benches, lol-repa, lol-tests, monadcryptorandom, mtl, numeric-prelude, protocol-buffers, protocol-buffers-descriptor, random, reflection, repa, singletons, tagged-transformer, template-haskell, th-desugar, transformers, vector, vector-th-unbox
Files
- CHANGES.md +6/−0
- Crypto/Lol/Cyclotomic/Tensor/Repa.hs +276/−0
- Crypto/Lol/Cyclotomic/Tensor/Repa/CRT.hs +233/−0
- Crypto/Lol/Cyclotomic/Tensor/Repa/Dec.hs +87/−0
- Crypto/Lol/Cyclotomic/Tensor/Repa/Extension.hs +211/−0
- Crypto/Lol/Cyclotomic/Tensor/Repa/GL.hs +151/−0
- Crypto/Lol/Cyclotomic/Tensor/Repa/Instances.hs +134/−0
- Crypto/Lol/Cyclotomic/Tensor/Repa/RTCommon.hs +289/−0
- LICENSE +339/−0
- README +6/−0
- Setup.hs +2/−0
- benchmarks/BenchRepaMain.hs +83/−0
- lol-repa.cabal +122/−0
- tests/TestRepaMain.hs +21/−0
+ CHANGES.md view
@@ -0,0 +1,6 @@+Changelog for lol-repa project+================================++0.0.0.1+----+ * Initial split from lol package.
+ Crypto/Lol/Cyclotomic/Tensor/Repa.hs view
@@ -0,0 +1,276 @@+{-|+Module : Crypto.Lol.Cyclotomic.Tensor.Repa+Description : A pure, repa-based implementation of the 'Tensor' interface.+Copyright : (c) Eric Crockett, 2011-2017+ Chris Peikert, 2011-2017+License : GPL-2+Maintainer : ecrockett0@email.com+Stability : experimental+Portability : POSIX++A pure, repa-based implementation of the 'Tensor' interface.+-}++{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE RebindableSyntax #-}+{-# LANGUAGE RoleAnnotations #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}++module Crypto.Lol.Cyclotomic.Tensor.Repa+( RT ) where++import Crypto.Lol.Cyclotomic.Tensor as T+import Crypto.Lol.Cyclotomic.Tensor.Repa.CRT+import Crypto.Lol.Cyclotomic.Tensor.Repa.Dec+import Crypto.Lol.Cyclotomic.Tensor.Repa.Extension+import Crypto.Lol.Cyclotomic.Tensor.Repa.GL+import Crypto.Lol.Cyclotomic.Tensor.Repa.Instances ()+import Crypto.Lol.Cyclotomic.Tensor.Repa.RTCommon as RT hiding+ ((++))+import Crypto.Lol.Prelude as LP+import Crypto.Lol.Types.FiniteField as FF+import Crypto.Lol.Types.IZipVector+import Crypto.Lol.Types.Proto+import Crypto.Lol.Utils.ShowType++import Algebra.Additive as Additive (C)+import Algebra.Module as Module (C)+import Algebra.ZeroTestable as ZeroTestable (C)++import Control.Applicative hiding ((*>))+import Control.Arrow hiding (arr)+import Control.DeepSeq (NFData (rnf))+import Control.Monad.Random+import Data.Coerce+import Data.Constraint hiding ((***))+import Data.Foldable as F+import Data.Maybe+import Data.Traversable as T+import Data.Vector as V hiding (force, (++))+import Data.Vector.Unboxed as U hiding (force, (++))++-- | An implementation of 'Tensor' backed by repa.+data RT (m :: Factored) r where+ RT :: Unbox r => !(Arr m r) -> RT m r+ ZV :: IZipVector m r -> RT m r++deriving instance Show r => Show (RT m r)++instance Show (ArgType RT) where+ show _ = "RT"++instance (Protoable (IZipVector m r), Fact m, Unbox r) => Protoable (RT m r) where+ type ProtoType (RT m r) = ProtoType (IZipVector m r)++ toProto x@(RT _) = toProto $ toZV x+ toProto (ZV x) = toProto x++ fromProto x = toRT <$> ZV <$> fromProto x+++instance Eq r => Eq (RT m r) where+ (ZV a) == (ZV b) = a == b+ (RT a) == (RT b) = a == b+ a@(RT _) == b = a == toRT b+ a == b@(RT _) = toRT a == b+ {-# INLINABLE (==) #-}++zvToArr :: Unbox r => IZipVector m r -> Arr m r+zvToArr v = let vec = convert $ unIZipVector v+ in Arr $ fromUnboxed (Z :. U.length vec) vec++-- converts to RT constructor+toRT :: Unbox r => RT m r -> RT m r+toRT v@(RT _) = v+toRT (ZV v) = RT $ zvToArr v++toZV :: Fact m => RT m r -> RT m r+toZV (RT (Arr v)) = ZV $ fromMaybe (error "toZV: internal error") $+ iZipVector $ convert $ toUnboxed v+toZV v@(ZV _) = v++{-# INLINABLE wrap #-}+wrap :: Unbox r => (Arr l r -> Arr m r) -> RT l r -> RT m r+wrap f (RT v) = RT $ f v+wrap f (ZV v) = RT $ f $ zvToArr v++{-# INLINABLE wrapM #-}+wrapM :: (Unbox r, Monad mon) => (Arr l r -> mon (Arr m r))+ -> RT l r -> mon (RT m r)+wrapM f (RT v) = RT <$> f v+wrapM f (ZV v) = RT <$> f (zvToArr v)++instance Tensor RT where++ type TElt RT r = (Unbox r, Elt r)++ entailIndexT = tag $ Sub Dict+ entailEqT = tag $ Sub Dict+ entailZTT = tag $ Sub Dict+ entailNFDataT = tag $ Sub Dict+ entailRandomT = tag $ Sub Dict+ entailShowT = tag $ Sub Dict+ entailModuleT = tag $ Sub Dict++ scalarPow = RT . scalarPow'++ l = wrap fL+ lInv = wrap fLInv++ mulGPow = wrap fGPow+ mulGDec = wrap fGDec++ divGPow = wrapM fGInvPow+ divGDec = wrapM fGInvDec++ crtFuncs = (,,,,) <$>+ ((RT .) <$> scalarCRT') <*>+ (wrap <$> mulGCRT') <*>+ (wrap <$> divGCRT') <*>+ (wrap <$> fCRT) <*>+ (wrap <$> fCRTInv)++ tGaussianDec = fmap RT . tGaussianDec'++ gSqNormDec (RT e) = gSqNormDec' e+ gSqNormDec e = gSqNormDec $ toRT e++ twacePowDec = wrap twacePowDec'++ embedPow = wrap embedPow'+ embedDec = wrap embedDec'++ crtExtFuncs = (,) <$> (wrap <$> twaceCRT') <*> (wrap <$> embedCRT')++ coeffs = wrapM coeffs'++ powBasisPow = (RT <$>) <$> powBasisPow'++ crtSetDec = (RT <$>) <$> crtSetDec'++ fmapT f (RT v) = RT $ (coerce $ force . RT.map f) v+ fmapT f v@(ZV _) = fmapT f $ toRT v++ zipWithT f (RT (Arr a1)) (RT (Arr a2)) = RT $ Arr $ force $ RT.zipWith f a1 a2+ zipWithT f v1 v2 = zipWithT f (toRT v1) (toRT v2)++ unzipT v@(RT _) = unzipT $ toZV v+ unzipT (ZV v) = ZV *** ZV $ unzipIZV v++ {-# INLINABLE entailIndexT #-}+ {-# INLINABLE entailEqT #-}+ {-# INLINABLE entailZTT #-}+ {-# INLINABLE entailNFDataT #-}+ {-# INLINABLE entailRandomT #-}+ {-# INLINABLE entailShowT #-}+ {-# INLINABLE scalarPow #-}+ {-# INLINABLE l #-}+ {-# INLINABLE lInv #-}+ {-# INLINABLE mulGPow #-}+ {-# INLINABLE mulGDec #-}+ {-# INLINABLE divGPow #-}+ {-# INLINABLE divGDec #-}+ {-# INLINABLE crtFuncs #-}+ {-# INLINABLE twacePowDec #-}+ {-# INLINABLE embedPow #-}+ {-# INLINABLE embedDec #-}+ {-# INLINABLE tGaussianDec #-}+ {-# INLINABLE gSqNormDec #-}+ {-# INLINABLE crtExtFuncs #-}+ {-# INLINABLE coeffs #-}+ {-# INLINABLE powBasisPow #-}+ {-# INLINABLE crtSetDec #-}+ {-# INLINABLE fmapT #-}+ {-# INLINABLE zipWithT #-}+ {-# INLINABLE unzipT #-}+++---------- Category-theoretic instances ----------++instance Fact m => Functor (RT m) where+ -- Functor instance is implied by Applicative+ fmap f x = pure f <*> x++instance Fact m => Applicative (RT m) where+ pure = ZV . pure++ -- RT can never hold an a -> b+ (ZV f) <*> (ZV a) = ZV (f <*> a)+ f@(ZV _) <*> v@(RT _) = f <*> toZV v++instance Fact m => Foldable (RT m) where+ -- Foldable instance is implied by Traversable+ foldMap = foldMapDefault++instance Fact m => Traversable (RT m) where+ traverse f r@(RT _) = T.traverse f $ toZV r+ traverse f (ZV v) = ZV <$> T.traverse f v+++---------- Numeric Prelude instances ----------++--CJP: Additive, Ring are not necessary when we use zipWithT+--EAC: But we need an Additive instance for the Module instance++instance (Unbox r, Additive (Arr m r)) => Additive.C (RT m r) where+ zero = RT zero++ (RT a) + (RT b) = RT $ a + b+ a + b = toRT a + toRT b++ (RT a) - (RT b) = RT $ a - b+ a - b = toRT a - toRT b++ negate (RT a) = RT $ negate a+ negate a = negate $ toRT a++ {-# INLINABLE (+) #-}+ {-# INLINABLE (-) #-}+ {-# INLINABLE zero #-}+ {-# INLINABLE negate #-}++{-+instance (Unbox r, Ring (Arr m r)) => Ring.C (RT m r) where+ (RT a) * (RT b) = RT $ a * b+ a * b = toRT a * toRT b++ fromInteger = RT . fromInteger+ {-# INLINABLE (*) #-}+ {-# INLINABLE fromInteger #-}+-}++instance (ZeroTestable (Arr m r), ZeroTestable (IZipVector m r))+ => ZeroTestable.C (RT m r) where+ isZero (RT a) = isZero a+ isZero (ZV v) = isZero v+ {-# INLINABLE isZero #-}++instance (GFCtx fp d, Fact m, Additive (RT m fp))+ => Module.C (GF fp d) (RT m fp) where++ r *> v = case v of+ RT (Arr arr) -> RT $ Arr $ RT.fromList (extent arr)+ $ unCoeffs $ r *> Coeffs $ RT.toList arr+ ZV zv -> ZV $ fromJust $ iZipVector $ V.fromList+ $ unCoeffs $ r *> Coeffs $ V.toList $ unIZipVector zv++---------- Miscellaneous instances ----------++instance (Unbox r, Random (Arr m r)) => Random (RT m r) where+ random = runRand $ RT <$> liftRand random++ randomR = error "randomR nonsensical for RT"++instance (NFData r) => NFData (RT m r) where+ rnf (RT v) = rnf v+ rnf (ZV v) = rnf v
+ Crypto/Lol/Cyclotomic/Tensor/Repa/CRT.hs view
@@ -0,0 +1,233 @@+{-|+Module : Crypto.Lol.Cyclotomic.Tensor.Repa.CRT+Description : Functions to support the chinese remainder transform on Repa arrays.+Copyright : (c) Eric Crockett, 2011-2017+ Chris Peikert, 2011-2017+License : GPL-2+Maintainer : ecrockett0@email.com+Stability : experimental+Portability : POSIX++Functions to support the chinese remainder transform on Repa arrays.+-}++{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Crypto.Lol.Cyclotomic.Tensor.Repa.CRT+( scalarCRT'+, fCRT, fCRTInv+, mulGCRT', divGCRT'+, gCRT, gInvCRT+) where++import Crypto.Lol.CRTrans+import Crypto.Lol.Cyclotomic.Tensor+import Crypto.Lol.Cyclotomic.Tensor.Repa.RTCommon as RT+import Crypto.Lol.Prelude as LP++import Control.Applicative+import Data.Coerce+import Data.Singletons.Prelude++-- | Embeds a scalar into the CRT basis (when it exists).+scalarCRT' :: forall mon m r . (Fact m, CRTrans mon r, Unbox r)+ => mon (r -> Arr m r)+{-# INLINABLE scalarCRT' #-}+scalarCRT'+ = let n = proxy totientFact (Proxy::Proxy m)+ sz = Z :. n+ in pure $ Arr . force . fromFunction sz . const++-- | Multiply by @g_m@ in the CRT basis (when it exists).+mulGCRT' :: (Fact m, CRTrans mon r, Unbox r)+ => mon (Arr m r -> Arr m r)+{-# INLINABLE mulGCRT' #-}+mulGCRT' = (coerce (\x -> force . RT.zipWith (*) x) `asTypeOf` asTypeOf) <$> gCRT++-- | Divide by @g@ in the CRT basis (when it exists).+divGCRT' :: (Fact m, CRTrans mon r, Unbox r) => mon (Arr m r -> Arr m r)+{-# INLINABLE divGCRT' #-}+divGCRT' = (coerce (\x -> force . RT.zipWith (*) x) `asTypeOf` asTypeOf) <$> gInvCRT++wrapVector :: forall mon m r . (Monad mon, Fact m, Ring r, Unbox r)+ => TaggedT m mon (Kron r) -> mon (Arr m r)+wrapVector v = do+ vmat <- proxyT v (Proxy::Proxy m)+ let n = proxy totientFact (Proxy::Proxy m)+ return $ coerce $ force $ RT.fromFunction (Z:.n)+ (\(Z:.i) -> indexK vmat i 0)++gCRT, gInvCRT :: (Fact m, CRTrans mon r, Unbox r) => mon (Arr m r)+{-# INLINABLE gCRT #-}+{-# INLINABLE gInvCRT #-}++-- | The coefficient vector of @g@ in the CRT basis (when it exists).+gCRT = wrapVector gCRTK+-- | The coefficient vector of @g^{ -1 }@ in the CRT basis (when it exists).+gInvCRT = wrapVector gInvCRTK++fCRT, fCRTInv ::+ forall mon m r . (Fact m, CRTrans mon r, Unbox r, Elt r)+ => mon (Arr m r -> Arr m r)++{-# INLINABLE fCRT #-}+{-# INLINABLE fCRTInv #-}++-- | The Chinese Remainder Transform.+-- Exists if and only if CRT exists for all prime powers.+fCRT = evalM $ fTensor ppCRT++-- divide by mhat after doing crtInv'+-- | The inverse Chinese Remainder Transform.+-- Exists if and only if CRT exists for all prime powers.+fCRTInv = do+ (_, mhatInv) :: (CRTInfo r) <- proxyT crtInfo (Proxy :: Proxy m)+ let totm = proxy totientFact (Proxy :: Proxy m)+ divMhat = trans totm $ RT.map (*mhatInv)+ evalM $ (divMhat .*) <$> fTensor ppCRTInv'++ppDFT, ppDFTInv', ppCRT, ppCRTInv' ::+ forall mon pp r . (PPow pp, CRTrans mon r, Unbox r, Elt r)+ => TaggedT pp mon (Trans r)++{-# INLINABLE ppDFT #-}+{-# INLINABLE ppDFTInv' #-}+{-# INLINABLE ppCRT #-}+{-# INLINABLE ppCRTInv' #-}++ppDFT = case (sing :: SPrimePower pp) of+ (SPP (STuple2 sp SO)) -> tagT $ withWitnessT pDFT sp+ spp@(SPP (STuple2 sp (SS se'))) ->+ tagT $ do+ let spp' = SPP (STuple2 sp se')+ pp'dft <- withWitnessT ppDFT spp'+ pptwid <- withWitnessT (ppTwid False) spp+ pdft <- withWitnessT pDFT sp+ return $ (pp'dft @* Id (dim pdft)) .* pptwid .* (Id (dim pp'dft) @* pdft)++ppDFTInv' = case (sing :: SPrimePower pp) of+ (SPP (STuple2 sp SO)) -> tagT $ withWitnessT pDFTInv' sp+ spp@(SPP (STuple2 sp (SS se'))) ->+ tagT $ do+ let spp' = SPP (STuple2 sp se')+ pp'dftInv' <- withWitnessT ppDFTInv' spp'+ pptwidInv <- withWitnessT (ppTwid True) spp+ pdftInv' <- withWitnessT pDFTInv' sp+ return $ (Id (dim pp'dftInv') @* pdftInv') .* pptwidInv .*+ (pp'dftInv' @* Id (dim pdftInv'))++ppCRT = case (sing :: SPrimePower pp) of+ (SPP (STuple2 sp SO)) -> tagT $ withWitnessT pCRT sp+ spp@(SPP (STuple2 sp (SS se'))) ->+ tagT $ do+ let spp' = SPP (STuple2 sp se')+ pp'dft <- withWitnessT ppDFT spp'+ pptwid <- withWitnessT (ppTwidHat False) spp+ pcrt <- withWitnessT pCRT sp+ return $+ (pp'dft @* Id (dim pcrt)) .* pptwid .*+ -- save some work when p=2+ (if dim pcrt > 1 then Id (dim pp'dft) @* pcrt else Id (dim pp'dft))++ppCRTInv' = case (sing :: SPrimePower pp) of+ (SPP (STuple2 sp SO)) -> tagT $ withWitnessT pCRTInv' sp+ spp@(SPP (STuple2 sp (SS se'))) ->+ tagT $ do+ let spp' = SPP (STuple2 sp se')+ pp'dftInv' <- withWitnessT ppDFTInv' spp'+ pptwidInv <- withWitnessT (ppTwidHat True) spp+ pcrtInv' <- withWitnessT pCRTInv' sp+ return $+ (Id (dim pp'dftInv') @* pcrtInv') .* pptwidInv .*+ (pp'dftInv' @* Id (dim pcrtInv'))++butterfly :: (Additive r) => Trans r+butterfly = trans 2 $ \arr ->+ fromFunction (extent arr) $+ \(sh:.j) -> case j of+ 0 -> arr ! (sh:.0) ++ arr ! (sh:.1)+ 1 -> arr ! (sh:.0) -+ arr ! (sh:.1)++-- DFT_p, CRT_p, scaled DFT_p^{ -1 } and CRT_p^{ -1 }+pDFT, pDFTInv', pCRT, pCRTInv' ::+ forall mon p r . (Prime p, CRTrans mon r, Unbox r, Elt r)+ => TaggedT p mon (Trans r)++{-# INLINABLE pDFT #-}+{-# INLINABLE pDFTInv' #-}+{-# INLINABLE pCRT #-}+{-# INLINABLE pCRTInv' #-}++pDFT = let pval = proxy valuePrime (Proxy::Proxy p)+ in if pval == 2+ then return butterfly+ else do (omegaPPow, _) <- crtInfo+ return $ trans pval $ mulMat $ force $+ fromFunction (Z :. pval :. pval)+ (\(Z:.i:.j) -> omegaPPow (i*j))++pDFTInv' = let pval = proxy valuePrime (Proxy::Proxy p)+ in if pval == 2+ then return butterfly+ else do (omegaPPow, _) <- crtInfo+ return $ trans pval $ mulMat $ force $+ fromFunction (Z :. pval :. pval)+ (\(Z:.i:.j) -> omegaPPow (-i*j))++pCRT = let pval = proxy valuePrime (Proxy::Proxy p)+ in if pval == 2+ then return $ Id 1+ else do (omegaPPow, _) <- crtInfo+ return $ trans (pval-1) $ mulMat $ force $+ fromFunction (Z :. pval-1 :. pval-1)+ (\(Z:.i:.j) -> omegaPPow ((i+1)*j))++-- crt_p * this = \hat{p}*I, for all prime p.+pCRTInv' =+ let pval = proxy valuePrime (Proxy::Proxy p)+ in if pval == 2 then return $ Id 1+ else do+ (omegaPPow, _) <- crtInfo+ return $ trans (pval-1) $ mulMat $ force $+ fromFunction (Z :. pval-1 :. pval-1)+ (\(Z:.i:.j) -> omegaPPow (negate i*(j+1)) -+ omegaPPow (j+1))++-- twiddle factors for DFT_pp and CRT_pp decompositions+ppTwid, ppTwidHat ::+ forall mon pp r . (PPow pp, CRTrans mon r, Unbox r)+ => Bool -> TaggedT pp mon (Trans r)++{-# INLINABLE ppTwid #-}+{-# INLINABLE ppTwidHat #-}++ppTwid inv =+ let pp@(p,e) = proxy ppPPow (Proxy :: Proxy pp)+ ppval = valuePP pp+ in do+ (omegaPPPow, _) <- crtInfo+ return $ trans ppval $ mulDiag $ force $+ fromFunction (Z :. ppval)+ (\(Z:.i) -> let (iq,ir) = i `divMod` p+ pow = (if inv then negate else id)+ ir * digitRev (p,e-1) iq+ in omegaPPPow pow)++ppTwidHat inv =+ let pp@(p,e) = proxy ppPPow (Proxy :: Proxy pp)+ pptot = totientPP pp+ in do+ (omegaPPPow, _) <- crtInfo+ return $ trans pptot $ mulDiag $ force $+ fromFunction (Z :. pptot)+ (\(Z:.i) -> let (iq,ir) = i `divMod` (p-1)+ pow = (if inv then negate else id)+ (ir+1) * digitRev (p,e-1) iq+ in omegaPPPow pow)
+ Crypto/Lol/Cyclotomic/Tensor/Repa/Dec.hs view
@@ -0,0 +1,87 @@+{-|+Module : Crypto.Lol.Cyclotomic.Tensor.Repa.Dec+Description : Linear transforms and operations related to the decoding basis.+Copyright : (c) Eric Crockett, 2011-2017+ Chris Peikert, 2011-2017+License : GPL-2+Maintainer : ecrockett0@email.com+Stability : experimental+Portability : POSIX++Linear transforms and operations related to the decoding basis.+-}++{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE RebindableSyntax #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Crypto.Lol.Cyclotomic.Tensor.Repa.Dec+( tGaussianDec', gSqNormDec' ) where++import Crypto.Lol.Cyclotomic.Tensor.Repa.RTCommon as R+import Crypto.Lol.GaussRandom+import Crypto.Lol.Prelude++import Control.Monad.Random++-- | Given @v=r^2@, yields the decoding-basis coefficients of a sample+-- from the tweaked Gaussian @t_m \cdot D_r@.+tGaussianDec' :: forall m v r rnd .+ (Fact m, OrdFloat r, Random r, Unbox r, Elt r,+ ToRational v, MonadRandom rnd)+ => v -> rnd (Arr m r)+tGaussianDec' =+ let pm = Proxy::Proxy m+ m = proxy valueFact pm+ n = proxy totientFact pm+ rad = proxy radicalFact pm+ in \v -> do -- rnd monad+ x <- realGaussians (v * fromIntegral (m `div` rad)) n+ let arr = Arr $ fromUnboxed (Z:.n) x+ return $ fE arr++-- | The @E_m@ transformation for an arbitrary @m@.+fE :: (Fact m, Transcendental r, Unbox r, Elt r) => Arr m r -> Arr m r+fE = eval $ fTensor $ ppTensor pE++-- | The @E_p@ transformation for a prime @p@.+pE :: forall p r . (Prime p, Transcendental r, Unbox r, Elt r)+ => Tagged p (Trans r)+pE = let pval = proxy valuePrime (Proxy::Proxy p)+ in tag $ if pval==2 then Id 1+ else trans (pval-1) $ mulMat $ force $+ fromFunction (Z :. pval-1 :. pval-1)+ (\(Z:.i:.j) ->+ -- sqrt(2)*[ cos(2pi*i*(j+1)/p) | sin(same) ]+ -- (signs of columns doesn't matter for our purposes.)+ let theta = 2 * pi * fromIntegral (i*(j+1)) /+ fromIntegral pval+ in sqrt 2 * if j < pval `div` 2+ then cos theta else sin theta)++-- | Given coefficient tensor @e@ with respect to the decoding basis+-- of @R@, yield the (scaled) squared norm of @g_m \cdot e@ under+-- the canonical embedding, namely,+-- @\hat{m}^{ -1 } \cdot || \sigma(g_m -- \cdot e) ||^2@ .+gSqNormDec' :: (Fact m, Ring r, Unbox r, Elt r) => Arr m r -> r+gSqNormDec' e@(Arr ae) = let (Arr ae') = fGramDec' e+ -- use sumAllP (define it in RTCommon)?+ in sumAllS $ force $ R.zipWith (*) ae ae'++-- | Multiply by @\hat{m}@ times the Gram matrix of decoding basis of+-- @R^vee@.+fGramDec' :: (Fact m, Ring r, Unbox r, Elt r) => Arr m r -> Arr m r+fGramDec' = eval $ fTensor $ ppTensor pGramDec++-- | Multiply by (scaled) Gram matrix of decoding basis: (I_{p-1} + all-1s).+pGramDec :: forall p r . (Prime p, Ring r, Unbox r, Elt r) => Tagged p (Trans r)+pGramDec =+ let pval = proxy valuePrime (Proxy::Proxy p)+ in tag $ if pval==2 then Id 1+ else trans (pval-1) $+ \arr -> let sums = sumS arr+ in fromFunction (extent arr)+ (\sh@(sh' :. _) -> arr ! sh + sums ! sh')++
+ Crypto/Lol/Cyclotomic/Tensor/Repa/Extension.hs view
@@ -0,0 +1,211 @@+{-|+Module : Crypto.Lol.Cyclotomic.Tensor.Repa.Extension+Description : RT-specific functions for embedding/twacing in various bases.+Copyright : (c) Eric Crockett, 2011-2017+ Chris Peikert, 2011-2017+License : GPL-2+Maintainer : ecrockett0@email.com+Stability : experimental+Portability : POSIX++RT-specific functions for embedding/twacing in various bases.+-}++{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}++module Crypto.Lol.Cyclotomic.Tensor.Repa.Extension+( twacePowDec', twaceCRT', embedPow', embedDec', embedCRT'+, coeffs', powBasisPow', crtSetDec'+) where++import Crypto.Lol.CRTrans+import qualified Crypto.Lol.Cyclotomic.Tensor as T+import Crypto.Lol.Cyclotomic.Tensor.Repa.CRT+import Crypto.Lol.Cyclotomic.Tensor.Repa.RTCommon as RT+import Crypto.Lol.Prelude as LP++import Crypto.Lol.Types.FiniteField+import Crypto.Lol.Types.ZmStar++import Control.Applicative+import Control.Arrow (first, second)++import Data.Coerce+import Data.Default+import Data.Maybe+import Data.Reflection (reify)+import qualified Data.Vector as V+import qualified Data.Vector.Unboxed as U+import Data.Vector.Unboxed.Deriving++-- Default instances+instance Default Z where def = Z+instance (Default a, Default b) => Default (a:.b) where def = def:.def++-- derived Unbox instances+derivingUnbox "DIM1"+ [t| (Z:.Int) -> Int |]+ [| \(Z:.i) -> i |]+ [| (Z :.) |]++-- | The "tweaked trace" function in either the powerful or decoding+-- basis of the m'th cyclotomic ring to the mth cyclotomic ring when+-- @m | m'@.+twacePowDec' :: forall m m' r . (m `Divides` m', Unbox r)+ => Arr m' r -> Arr m r+twacePowDec'+ = let indices = proxy extIndicesPowDec (Proxy::Proxy '(m, m'))+ in coerce $ \ !arr -> force $ backpermute (extent indices) (indices !) arr++-- | The "tweaked trace" function in the CRT+-- basis of the m'th cyclotomic ring to the mth cyclotomic ring when+-- @m | m'@.+twaceCRT' :: forall mon m m' r .+ (m `Divides` m', CRTrans mon r, Unbox r, Elt r)+ => mon (Arr m' r -> Arr m r)+twaceCRT' = do+ g' :: Arr m' r <- gCRT+ gInv <- gInvCRT+ embed :: Arr m r -> Arr m' r <- embedCRT'+ (_, m'hatinv) <- proxyT crtInfo (Proxy::Proxy m')+ let hatRatioInv = m'hatinv * fromIntegral (proxy valueHatFact (Proxy::Proxy m))+ -- tweak = mhat * g' / (m'hat * g)+ tweak = (coerce $ \x -> force . RT.map (* hatRatioInv) . RT.zipWith (*) x) (embed gInv) g' :: Arr m' r+ indices = proxy extIndicesCRT (Proxy::Proxy '(m, m'))+ return $+ -- take true trace after mul-by-tweak+ coerce (\ !arr -> sumS . backpermute (extent indices) (indices !) . RT.zipWith (*) arr) tweak++embedPow', embedDec' :: forall m m' r .+ (m `Divides` m', Unbox r, Additive r)+ => Arr m r -> Arr m' r+-- | Embeds an array in the powerful basis of the the mth cyclotomic ring+-- to an array in the powerful basis of the m'th cyclotomic ring when @m | m'@+embedPow'+ = let indices = proxy baseIndicesPow (Proxy::Proxy '(m, m'))+ in coerce $ \ !arr -> force $ fromFunction (extent indices)+ (\idx -> let (j0,j1) = (indices ! idx)+ in if j0 == 0 then arr ! j1 else zero)+-- | Embeds an array in the decoding basis of the the mth cyclotomic ring+-- to an array in the decoding basis of the m'th cyclotomic ring when @m | m'@+embedDec'+ = let indices = proxy baseIndicesDec (Proxy::Proxy '(m, m'))+ in coerce $ \ !arr -> force $+ fromFunction (extent indices)+ (\idx -> maybe zero+ (\(sh,b) -> if b then negate (arr ! sh)+ else arr ! sh)+ (indices ! idx))++-- | Embeds an array in the CRT basis of the the mth cyclotomic ring+-- to an array in the CRT basis of the m'th cyclotomic ring when @m | m'@+embedCRT' :: forall mon m m' r . (m `Divides` m', CRTrans mon r, Unbox r)+ => mon (Arr m r -> Arr m' r)+embedCRT' = do+ -- first check existence of CRT transform of index m'+ _ <- proxyT crtInfo (Proxy::Proxy m') :: mon (CRTInfo r)+ let idxs = proxy baseIndicesCRT (Proxy::Proxy '(m,m'))+ return $ coerce $ \ !arr -> (force $ backpermute (extent idxs) (idxs !) arr)++-- | maps an array in the powerful/decoding basis, representing an+-- O_m' element, to an array of arrays representing O_m elements in+-- the same type of basis+coeffs' :: forall m m' r . (m `Divides` m', Unbox r)+ => Arr m' r -> [Arr m r]+coeffs' =+ let indices = proxy extIndicesCoeffs (Proxy::Proxy '(m, m'))+ in coerce $ \ !arr -> V.toList $+ V.map (\idxs -> force $ backpermute (extent idxs) (idxs !) arr) indices++-- | The powerful extension basis, wrt the powerful basis.+-- Outputs a list of arrays in O_m' that are an O_m basis for O_m'+powBasisPow' :: forall m m' r . (m `Divides` m', Ring r, Unbox r)+ => Tagged m [Arr m' r]+powBasisPow' = return $+ let (_, phi, phi', _) = proxy T.indexInfo (Proxy::Proxy '(m,m'))+ idxs = proxy T.baseIndicesPow (Proxy::Proxy '(m,m'))+ in LP.map (\k -> Arr $ force $ fromFunction (Z :. phi')+ (\(Z:.j) -> let (j0,j1) = idxs U.! j+ in if j0==k && j1==0 then one else zero))+ [0..phi' `div` phi - 1]++-- | A list of arrays representing the mod-p CRT set of the+-- extension O_m'/O_m+crtSetDec' :: forall m m' fp .+ (m `Divides` m', PrimeField fp, Coprime (PToF (CharOf fp)) m',+ Unbox fp)+ => Tagged m [Arr m' fp]+crtSetDec' = return $+ let m'p = Proxy :: Proxy m'+ p = proxy valuePrime (Proxy::Proxy (CharOf fp))+ phi = proxy totientFact m'p++ d = proxy (order p) m'p+ h :: Int = proxy valueHatFact m'p+ hinv = recip $ fromIntegral h+ in reify d $ \(_::Proxy d) ->+ let twCRTs' :: T.Kron (GF fp d)+ = fromMaybe (error "internal error: crtSetDec': twCRTs") $ proxyT T.twCRTs m'p+ zmsToIdx = proxy T.zmsToIndexFact m'p+ elt j i = T.indexK twCRTs' j (zmsToIdx i)+ trace' = trace :: GF fp d -> fp+ cosets = proxy (partitionCosets p) (Proxy::Proxy '(m,m'))+ in LP.map (\is -> Arr $ force $ fromFunction (Z :. phi)+ (\(Z:.j) -> hinv * trace'+ (sum $ LP.map (elt j) is))) cosets+++-- convert memoized reindexing Vectors to Arrays, for convenience and speed++extIndicesPowDec :: forall m m' . (m `Divides` m')+ => Tagged '(m, m') (Array U DIM1 DIM1)+extIndicesPowDec = do+ idxs <- T.extIndicesPowDec+ return $ fromUnboxed (Z :. U.length idxs) $ U.map (Z:.) idxs++extIndicesCRT :: forall m m' . (m `Divides` m')+ => Tagged '(m, m') (Array U DIM2 DIM1)+extIndicesCRT =+ let phi = proxy totientFact (Proxy::Proxy m)+ phi' = proxy totientFact (Proxy::Proxy m')+ in do+ idxs <- T.extIndicesCRT+ return $ fromUnboxed (Z :. phi :. phi' `div` phi) $ U.map (Z:.) idxs++baseIndicesPow :: forall m m' . (m `Divides` m')+ => Tagged '(m, m') (Array U DIM1 (Int,DIM1))++baseIndicesDec :: forall m m' . (m `Divides` m')+ => Tagged '(m, m') (Array U DIM1 (Maybe (DIM1, Bool)))++baseIndicesCRT :: forall m m' . (m `Divides` m')+ => Tagged '(m, m') (Array U DIM1 DIM1)++baseIndicesPow = do+ idxs <- T.baseIndicesPow+ return $ fromUnboxed (Z :. U.length idxs) $ U.map (second (Z:.)) idxs++baseIndicesDec = do+ idxs <- T.baseIndicesDec+ return $ fromUnboxed (Z :. U.length idxs) $ U.map (liftA (first (Z:.))) idxs++baseIndicesCRT = do+ idxs <- T.baseIndicesCRT+ return $ fromUnboxed (Z :. U.length idxs) $ U.map (Z:.) idxs++extIndicesCoeffs :: forall m m' . (m `Divides` m')+ => Tagged '(m, m') (V.Vector (Array U DIM1 DIM1))+extIndicesCoeffs =+ V.map (\arr -> fromUnboxed (Z :. U.length arr) $+ U.map (Z:.) arr) <$> T.extIndicesCoeffs
+ Crypto/Lol/Cyclotomic/Tensor/Repa/GL.hs view
@@ -0,0 +1,151 @@+{-|+Module : Crypto.Lol.Cyclotomic.Tensor.Repa.GL+Description : The @G@ and @L@ transforms for Repa arrays.+Copyright : (c) Eric Crockett, 2011-2017+ Chris Peikert, 2011-2017+License : GPL-2+Maintainer : ecrockett0@email.com+Stability : experimental+Portability : POSIX++The @G@ and @L@ transforms for Repa arrays.+-}++{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RebindableSyntax #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Crypto.Lol.Cyclotomic.Tensor.Repa.GL+( fL, fLInv, fGPow, fGDec, fGInvPow, fGInvDec+) where++import Crypto.Lol.Cyclotomic.Tensor.Repa.RTCommon as RT+import Crypto.Lol.Prelude as LP+import Data.Coerce++fLInv, fGPow :: (Fact m, Additive r, Unbox r)+ => Arr m r -> Arr m r+fL, fGDec :: (Fact m, Additive r, Unbox r, Elt r)+ => Arr m r -> Arr m r+{-# INLINABLE fL #-}+{-# INLINABLE fLInv #-}+{-# INLINABLE fGPow #-}+{-# INLINABLE fGDec #-}++fGInvPow, fGInvDec ::+ (Fact m, IntegralDomain r, ZeroTestable r, Unbox r, Elt r)+ => Arr m r -> Maybe (Arr m r)+{-# INLINABLE fGInvPow #-}+{-# INLINABLE fGInvDec #-}++-- | Arbitrary-index @L@ transform, which converts from decoding-basis+-- to powerful-basis representation.+fL = eval $ fTensor $ ppTensor pL+-- | Arbitrary-index @L^{ -1 }@ transform, which converts from+-- powerful-basis to decoding-basis representation.+fLInv = eval $ fTensor $ ppTensor pLInv+-- | Arbitrary-index multiplication by @g_m@ in the powerful basis.+fGPow = eval $ fTensor $ ppTensor pGPow+-- | Arbitrary-index multiplication by @g_m@ in the decoding basis.+fGDec = eval $ fTensor $ ppTensor pGDec+-- | Arbitrary-index division by @g_m@ in the powerful+-- basis. Outputs 'Nothing' if the input is not evenly divisible by+-- @g_m@. Warning: not constant time!+fGInvPow = wrapGInv' pGInvPow'+-- | Arbitrary-index division by @g_m@ in the decoding+-- basis. Outputs 'Nothing' if the input is no evenly divisible by+-- @g_m@. Warning: not constant time!+fGInvDec = wrapGInv' pGInvDec'++wrapGInv' :: forall m r .+ (Fact m, IntegralDomain r, ZeroTestable r, Unbox r)+ => (forall p . Prime p => Tagged p (Trans r))+ -> Arr m r -> Maybe (Arr m r)+wrapGInv' ginv =+ let fGInv = eval $ fTensor $ ppTensor ginv+ oddrad = fromIntegral $ proxy oddRadicalFact (Proxy::Proxy m)+ in (`divCheck` oddrad) . fGInv+{-# INLINABLE wrapGInv' #-}++-- | This is not a constant-time algorithm! Depending on its usage,+-- it might provide a timing side-channel.+divCheck :: (IntegralDomain r, ZeroTestable r, Unbox r)+ => Arr m r -> r -> Maybe (Arr m r)+divCheck = coerce $ \ !arr den ->+ let qrs = force $ RT.map (`divMod` den) arr+ pass = foldAllS (&&) True $ RT.map (isZero . snd) qrs+ out = force $ RT.map fst qrs+ in if pass then Just out else Nothing+{-# INLINABLE divCheck #-}++pWrap :: forall p r . Prime p+ => (forall rep . Source rep r => Int -> Array rep DIM2 r -> Array D DIM2 r)+ -> Tagged p (Trans r)+pWrap f = let pval = proxy valuePrime (Proxy::Proxy p)+ -- special case: return identity function for p=2+ in return $ if pval > 2+ then trans (pval-1) $ f pval+ else Id 1+{-# INLINABLE pWrap #-}+++pLInv, pGPow :: (Prime p, Additive r) => Tagged p (Trans r)+pL, pGDec :: (Prime p, Additive r, Elt r, Unbox r) => Tagged p (Trans r)+pGInvPow', pGInvDec' :: (Prime p, Ring r, Unbox r, Elt r)+ => Tagged p (Trans r)+{-# INLINABLE pL #-}+{-# INLINABLE pLInv #-}+{-# INLINABLE pGPow #-}+{-# INLINABLE pGDec #-}+{-# INLINABLE pGInvPow' #-}+{-# INLINABLE pGInvDec' #-}++pL = pWrap (\_ !arr ->+ fromFunction (extent arr) $+ \ (i':.i) -> sumAllS $ extract (Z:.0) (Z:.(i+1)) $ slice arr (i':.All))++pLInv = pWrap (\_ !arr ->+ let f (i' :. 0) = arr! (i' :. 0)+ f (i' :. i) = arr! (i' :. i) - arr! (i' :. i-1)+ in fromFunction (extent arr) f)+++-- multiplicaton by g_p=1-zeta_p in power basis.+-- this is "wrong" for p=2 but we never use that case thanks to pWrap.+pGPow = pWrap (\p !arr ->+ let f (i':.0) = arr! (i':.p-2) + arr! (i':.0)+ f (i':.i) = arr! (i':.p-2) + arr! (i':.i) - arr! (i':.i-1)+ in fromFunction (extent arr) f)++-- multiplication by g_p=1-zeta_p in decoding basis+pGDec = pWrap (\_ !arr ->+ let f (i':.0) = arr! (i':.0) + sumAllS (slice arr (i':.All))+ f (i':.i) = arr! (i':.i) - arr! (i':.i-1)+ in fromFunction (extent arr) f)++-- CJP: profiling suggests that this does two read passes through the+-- array; see if we can rewrite to make it one++-- doesn't do division by (odd) p+pGInvPow' =+ pWrap (\p !arr ->+ let f (i':.i) =+ let col = slice arr (i':.All)+ in fromIntegral (p-i-1) * sumAllS (extract (Z:.0) (Z:.i+1) col) ++ fromIntegral (-i-1) * sumAllS (extract (Z:.i+1) (Z:.p-i-2) col)+ in fromFunction (extent arr) f)++-- doesn't do division by (odd) p+pGInvDec' =+ pWrap (\p !arr ->+ let f (i':.i) =+ let col = slice arr (i':.All)+ nats = fromFunction (Z:.p-1) (\(Z:.j) -> fromIntegral j+1)+ in (sumAllS $ RT.zipWith (*) col nats) -+ fromIntegral p * sumAllS (extract (Z:.i+1) (Z:.p-i-2) col)+ in fromFunction (extent arr) f)
+ Crypto/Lol/Cyclotomic/Tensor/Repa/Instances.hs view
@@ -0,0 +1,134 @@+{-|+Module : Crypto.Lol.Cyclotomic.Tensor.Repa.Instances+Description : RT-specific instances.+Copyright : (c) Eric Crockett, 2011-2017+ Chris Peikert, 2011-2017+License : GPL-2+Maintainer : ecrockett0@email.com+Stability : experimental+Portability : POSIX++RT-specific instances.+-}++{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}++module Crypto.Lol.Cyclotomic.Tensor.Repa.Instances where++-- EAC: Do not import Crypto.Lol.Types, because it exports an IrreduciblePoly+-- instance which screw with GHC. Probably #10338.+import Crypto.Lol.Types.Unsafe.Complex+import Crypto.Lol.Types.Unsafe.RRq+import Crypto.Lol.Types.Unsafe.ZqBasic++import Data.Array.Repa.Eval as R+import qualified Number.Complex as C hiding (exp, signum)++import qualified Data.Vector.Generic as G+import qualified Data.Vector.Generic.Mutable as M+import qualified Data.Vector.Unboxed as U+import Data.Vector.Unboxed.Deriving+++++instance (R.Elt a) => R.Elt (Complex a) where+ touch (Complex c) = do+ touch $ C.real c+ touch $ C.imag c+ zero = Complex $ R.zero C.+: R.zero+ one = Complex $ R.one C.+: R.zero++derivingUnbox "Complex"+ [t| forall a . (U.Unbox a) => Complex a -> (a, a) |]+ [| \ (Complex x) -> (C.real x, C.imag x) |]+ [| \ (r, i) -> Complex $ r C.+: i |]+++++++deriving instance (Elt r) => Elt (RRq q r)++-- CJP: restored manual Unbox instances, until we have a better way+-- (NewtypeDeriving or TH)++newtype instance U.MVector s (RRq q r) = MV_RRq (U.MVector s r)+newtype instance U.Vector (RRq q r) = V_RRq (U.Vector r)++-- Unbox, when underlying representation is+instance U.Unbox r => U.Unbox (RRq q r)++{- purloined and tweaked from code in `vector` package that defines+types as unboxed -}+instance U.Unbox r => M.MVector U.MVector (RRq q r) where+ basicLength (MV_RRq v) = M.basicLength v+ basicUnsafeSlice z n (MV_RRq v) = MV_RRq $ M.basicUnsafeSlice z n v+ basicOverlaps (MV_RRq v1) (MV_RRq v2) = M.basicOverlaps v1 v2+ basicInitialize (MV_RRq v) = M.basicInitialize v+ basicUnsafeNew n = MV_RRq <$> M.basicUnsafeNew n+ basicUnsafeReplicate n (RRq' x) = MV_RRq <$> M.basicUnsafeReplicate n x+ basicUnsafeRead (MV_RRq v) z = RRq' <$> M.basicUnsafeRead v z+ basicUnsafeWrite (MV_RRq v) z (RRq' x) = M.basicUnsafeWrite v z x+ basicClear (MV_RRq v) = M.basicClear v+ basicSet (MV_RRq v) (RRq' x) = M.basicSet v x+ basicUnsafeCopy (MV_RRq v1) (MV_RRq v2) = M.basicUnsafeCopy v1 v2+ basicUnsafeMove (MV_RRq v1) (MV_RRq v2) = M.basicUnsafeMove v1 v2+ basicUnsafeGrow (MV_RRq v) n = MV_RRq <$> M.basicUnsafeGrow v n++instance U.Unbox r => G.Vector U.Vector (RRq q r) where+ basicUnsafeFreeze (MV_RRq v) = V_RRq <$> G.basicUnsafeFreeze v+ basicUnsafeThaw (V_RRq v) = MV_RRq <$> G.basicUnsafeThaw v+ basicLength (V_RRq v) = G.basicLength v+ basicUnsafeSlice z n (V_RRq v) = V_RRq $ G.basicUnsafeSlice z n v+ basicUnsafeIndexM (V_RRq v) z = RRq' <$> G.basicUnsafeIndexM v z+ basicUnsafeCopy (MV_RRq mv) (V_RRq v) = G.basicUnsafeCopy mv v+ elemseq _ = seq++++++deriving instance (Elt i) => Elt (ZqBasic q i)++-- CJP: restored manual Unbox instances, until we have a better way+-- (NewtypeDeriving or TH)++newtype instance U.MVector s (ZqBasic q z) = MV_ZqBasic (U.MVector s z)+newtype instance U.Vector (ZqBasic q z) = V_ZqBasic (U.Vector z)++-- Unbox, when underlying representation is+instance U.Unbox z => U.Unbox (ZqBasic q z)++{- purloined and tweaked from code in `vector` package that defines+types as unboxed -}+instance U.Unbox z => M.MVector U.MVector (ZqBasic q z) where+ basicLength (MV_ZqBasic v) = M.basicLength v+ basicUnsafeSlice z n (MV_ZqBasic v) = MV_ZqBasic $ M.basicUnsafeSlice z n v+ basicOverlaps (MV_ZqBasic v1) (MV_ZqBasic v2) = M.basicOverlaps v1 v2+ basicInitialize (MV_ZqBasic v) = M.basicInitialize v+ basicUnsafeNew n = MV_ZqBasic <$> M.basicUnsafeNew n+ basicUnsafeReplicate n (ZqB x) = MV_ZqBasic <$> M.basicUnsafeReplicate n x+ basicUnsafeRead (MV_ZqBasic v) z = ZqB <$> M.basicUnsafeRead v z+ basicUnsafeWrite (MV_ZqBasic v) z (ZqB x) = M.basicUnsafeWrite v z x+ basicClear (MV_ZqBasic v) = M.basicClear v+ basicSet (MV_ZqBasic v) (ZqB x) = M.basicSet v x+ basicUnsafeCopy (MV_ZqBasic v1) (MV_ZqBasic v2) = M.basicUnsafeCopy v1 v2+ basicUnsafeMove (MV_ZqBasic v1) (MV_ZqBasic v2) = M.basicUnsafeMove v1 v2+ basicUnsafeGrow (MV_ZqBasic v) n = MV_ZqBasic <$> M.basicUnsafeGrow v n++instance U.Unbox z => G.Vector U.Vector (ZqBasic q z) where+ basicUnsafeFreeze (MV_ZqBasic v) = V_ZqBasic <$> G.basicUnsafeFreeze v+ basicUnsafeThaw (V_ZqBasic v) = MV_ZqBasic <$> G.basicUnsafeThaw v+ basicLength (V_ZqBasic v) = G.basicLength v+ basicUnsafeSlice z n (V_ZqBasic v) = V_ZqBasic $ G.basicUnsafeSlice z n v+ basicUnsafeIndexM (V_ZqBasic v) z = ZqB <$> G.basicUnsafeIndexM v z+ basicUnsafeCopy (MV_ZqBasic mv) (V_ZqBasic v) = G.basicUnsafeCopy mv v+ elemseq _ = seq
+ Crypto/Lol/Cyclotomic/Tensor/Repa/RTCommon.hs view
@@ -0,0 +1,289 @@+{-|+Module : Crypto.Lol.Cyclotomic.Tensor.Repa.Common+Description : A simple DSL for tensoring Repa arrays.+Copyright : (c) Eric Crockett, 2011-2017+ Chris Peikert, 2011-2017+License : GPL-2+Maintainer : ecrockett0@email.com+Stability : experimental+Portability : POSIX++A simple DSL for tensoring Repa arrays and other common functionality+on Repa arrays.+-}++{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RebindableSyntax #-}+{-# LANGUAGE RoleAnnotations #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeOperators #-}++module Crypto.Lol.Cyclotomic.Tensor.Repa.RTCommon+( module R+, module Data.Array.Repa.Eval+, module Data.Array.Repa.Repr.Unboxed+, Arr(..), repl, replM, eval, evalM, fTensor, ppTensor+, Trans(Id), trans, dim, (.*), (@*), force+, mulMat, mulDiag+, scalarPow'+, sumS, sumAllS+) where++import Crypto.Lol.Prelude as LP hiding ((!!))++import Algebra.Additive as Additive (C)+import Algebra.Ring as Ring (C)+import Algebra.ZeroTestable as ZeroTestable (C)++import Control.DeepSeq (NFData (..))+import Control.Monad.Identity ()+import Control.Monad.Random+import Data.Array.Repa as R hiding (sumAllP, sumAllS, sumP,+ sumS, (*^), (+^), (-^), (/^))+import Data.Array.Repa.Eval hiding (one, zero)+import Data.Array.Repa.Repr.Unboxed+import Data.Coerce+import Data.Singletons+import Data.Singletons.Prelude hiding ((:.))+import Data.Vector.Unboxed as U (replicate, replicateM)++-- always unboxed (manifest); intermediate calculations can use+-- delayed arrays++-- | Indexed newtype for 1-dimensional Unbox repa arrays+newtype Arr (m :: Factored) r = Arr (Array U DIM1 r)+ deriving (Eq, Show, NFData)++-- the first argument, though phantom, affects representation+-- CJP: why must the second arg be nominal?+-- EAC: From https://ghc.haskell.org/trac/ghc/wiki/Roles#Thesolution:+-- "The exception to the above algorithm is for classes: all parameters for a class default to a nominal role."+-- Arr is a synonym for Array, which is an associated data type to the class Source. The parameter `r` above+-- corresponds to the parameter `e` in the definition of class Source, so it's role must be nominal.+type role Arr nominal nominal++-- | An 'Arr' filled with the argument.+repl :: forall m r . (Fact m, Unbox r) => r -> Arr m r+repl = let n = proxy totientFact (Proxy::Proxy m)+ in Arr . fromUnboxed (Z:.n) . U.replicate n+{-# INLINABLE repl #-}++-- | Monadic version of 'repl'.+replM :: forall m r mon . (Fact m, Unbox r, Monad mon)+ => mon r -> mon (Arr m r)+replM = let n = proxy totientFact (Proxy::Proxy m)+ in fmap (Arr . fromUnboxed (Z:.n)) . U.replicateM n+{-# INLINABLE replM #-}++instance (Fact m, Additive r, Unbox r) => Additive.C (Arr m r) where+ zero = repl zero+ (Arr a) + (Arr b) = Arr $ force $ R.zipWith (+) a b+ negate (Arr a) = Arr $ force $ R.map negate a+ {-# INLINABLE zero #-}+ {-# INLINABLE (+) #-}+ {-# INLINABLE negate #-}++instance (Fact m, Ring r, Unbox r) => Ring.C (Arr m r) where+ one = repl one+ (Arr a) * (Arr b) = Arr $ force $ R.zipWith (*) a b+ fromInteger = repl . fromInteger+ {-# INLINABLE one #-}+ {-# INLINABLE (*) #-}+ {-# INLINABLE fromInteger #-}++instance (ZeroTestable r, Unbox r, Elt r) => ZeroTestable.C (Arr m r) where+ -- not using 'zero' to avoid Additive r constraint+ isZero (Arr a)+ = isZero $ foldAllS (\ x y -> if isZero x then y else x) (a R.! (Z:.0)) a+ {-# INLINABLE isZero #-}+++instance (Unbox r) => NFData (Array U DIM1 r) where+ -- EAC: Repa doesn't define any NFData instances,+ -- I'm hoping deepSeqArray is a reasonable approx+ rnf x = deepSeqArray x ()++instance (Unbox r, Random r, Fact m) => Random (Arr m r) where+ random = runRand $ replM (liftRand random)++ randomR = error "randomR nonsensical for Arr"++-- | For a factored index, tensors up any function defined for (and+-- tagged by) any prime power+fTensor :: forall m r mon . (Fact m, Monad mon)+ => (forall pp . (PPow pp) => TaggedT pp mon (Trans r))+ -> TaggedT m mon (Trans r)++fTensor func = tagT $ go $ sUnF (sing :: SFactored m)+ where+ go :: Sing (pplist :: [PrimePower]) -> mon (Trans r)+ go spps = case spps of+ SNil -> return $ Id 1+ (SCons spp rest) -> do+ rest' <- go rest+ func' <- withWitnessT func spp+ return $ rest' @* func'+{-# INLINABLE fTensor #-}++-- | For a prime power p^e, tensors up any function f defined for+-- (and tagged by) a prime to @I_(p^{e-1}) \otimes f@+ppTensor :: forall pp r mon . (PPow pp, Monad mon)+ => (forall p . (Prime p) => TaggedT p mon (Trans r))+ -> TaggedT pp mon (Trans r)++ppTensor func = tagT $ case (sing :: SPrimePower pp) of+ pp@(SPP (STuple2 sp _)) -> do+ func' <- withWitnessT func sp+ let lts = withWitness valuePPow pp `div` withWitness valuePrime sp+ return $ Id lts @* func'+{-# INLINABLE ppTensor #-}+++-- deeply embedded DSL for transformations and their various+-- compositions++-- (dim(f), f) where f operates on innermost dimension of array+data Tensorable r = Tensorable+ !Int !(forall rep . Source rep r => Array rep DIM2 r -> Array D DIM2 r)++-- transform component: a Tensorable with particular I_l, I_r+type TransC r = (Tensorable r, Int, Int)++-- full transform: sequence of zero or more components+-- | a DSL for tensor transforms on Repa arrays+data Trans r = Id !Int -- ^| identity sentinel+ | TSnoc !(Trans r) !(TransC r) -- ^| (function) composition of transforms++dimC :: TransC r -> Int+dimC (Tensorable d _, l, r) = l*d*r+{-# INLINABLE dimC #-}++-- | Returns the (linear) dimension of a transform+dim :: Trans r -> Int+dim (Id n) = n+dim (TSnoc _ f) = dimC f -- just use dimension of head+{-# INLINABLE dim #-}++-- | smart constructor from a Tensorable+trans :: Int -> (forall rep . Source rep r => Array rep DIM2 r -> Array D DIM2 r) -> Trans r+trans d f = TSnoc (Id d) (Tensorable d f, 1, 1)+{-# INLINABLE trans #-}++-- | compose transforms+(.*) :: Trans r -> Trans r -> Trans r+f .* g | dim f == dim g = f ..* g+ | otherwise = error $ "(.*): transform dimensions don't match "+ LP.++ show (dim f) LP.++ ", " LP.++ show (dim g)+ where+ f' ..* (Id _) = f' -- drop sentinel+ f' ..* (TSnoc rest g') = TSnoc (f' ..* rest) g'+{-# INLINABLE (.*) #-}++-- | tensor/Kronecker product (otimes)+(@*) :: Trans r -> Trans r -> Trans r+-- merge identity transforms+(Id n) @* (Id m) = Id (n*m)+-- Id on left or right+i@(Id n) @* (TSnoc g' (g, l, r)) = TSnoc (i @* g') (g, n*l, r)+(TSnoc f' (f, l, r)) @* i@(Id n) = TSnoc (f' @* i) (f, l, r*n)+-- no Ids: compose+f @* g = (f @* Id (dim g)) .* (Id (dim f) @* g)+{-# INLINABLE (@*) #-}++evalC :: (Unbox r) => TransC r -> Array U DIM1 r -> Array U DIM1 r+evalC (Tensorable d f, _, r) = force . unexpose r . f . expose d r+{-# INLINABLE evalC #-}++-- | Creates an evaluatable Haskell function from a tensored transform+eval :: (Unbox r) => Tagged m (Trans r) -> Arr m r -> Arr m r+eval x = coerce $ eval' $ untag x+ where eval' (Id _) = id+ eval' (TSnoc rest f) = eval' rest . evalC f+{-# INLINABLE eval #-}++-- | Monadic version of 'eval'+evalM :: (Unbox r, Monad mon) => TaggedT m mon (Trans r) -> mon (Arr m r -> Arr m r)+evalM = fmap (eval . return) . untagT+{-# INLINE evalM #-}++-- | maps the innermost dimension to a 2-dim array with innermost dim d,+-- for performing a I_l \otimes f_d \otimes I_r transformation+expose :: (Source r1 r)+ => Int -> Int -> Array r1 DIM1 r -> Array D DIM2 r+expose !d !r !arr =+ let (Z :. sz) = extent arr+ f (Z :. i :. j) = let imodr = i `mod` r+ in (Z :. (i-imodr)*d + j*r + imodr)+ in backpermute (Z :. sz `div` d :. d) f arr+{-# INLINABLE expose #-}++-- | inverse of expose+unexpose :: (Source r1 r) => Int -> Array r1 DIM2 r -> Array D DIM1 r+unexpose !r !arr =+ let (Z :. sz :. d) = extent arr+ f (Z :. i) = let (idivr,imodr) = i `divMod` r+ (idivrd,j) = idivr `divMod` d+ in (Z :. r*idivrd + imodr :. j)+ in backpermute (Z :. sz*d) f arr+{-# INLINABLE unexpose #-}++-- | general matrix multiplication along innermost dim of v+mulMat :: (Source r1 r, Source r2 r, Ring r, Unbox r, Elt r)+ => Array r1 DIM2 r -> Array r2 DIM2 r -> Array D DIM2 r+mulMat !m !v+ = let (Z :. mrows :. mcols) = extent m+ (sh :. vrows) = extent v+ f (sh' :. i) = sumAllS $ R.zipWith (*) (slice m (Z:.i:.All)) $ slice v (sh':.All)+ in if mcols == vrows then fromFunction (sh :. mrows) f+ else error "mulMatVec: mcols != vdim"+{-# INLINABLE mulMat #-}++-- | multiplication by a diagonal matrix along innermost dim+mulDiag :: (Source r1 r, Source r2 r, Ring r)+ => Array r1 DIM1 r -> Array r2 DIM2 r -> Array D DIM2 r+mulDiag !diag !arr = fromFunction (extent arr) f+ where f idx@(_ :. i) = (arr ! idx) * (diag ! (Z:.i))+{-# INLINABLE mulDiag #-}++-- misc Tensor functions++-- | Embeds a scalar into a powerful-basis representation of a Repa array,+-- tagged by the cyclotomic index+scalarPow' :: forall m r . (Fact m, Additive r, Unbox r) => r -> Arr m r+scalarPow' = coerce . go (proxy totientFact (Proxy::Proxy m))+ where go n !r = let fct (Z:.0) = r+ fct _ = LP.zero+ in force $ fromFunction (Z:.n) fct+{-# INLINABLE scalarPow' #-}++-- | Forces a delayed array to a manifest array.+force :: (Shape sh, Unbox r) => Array D sh r -> Array U sh r+force = computeS+--force = runIdentity . computeP+{-# INLINABLE force #-}++-- copied implementations of functions we need that normally require+-- Num++-- | Sum the inner-most dimension of an array sequentially+sumS :: (Source r a, Elt a, Unbox a, Additive a, Shape sh)+ => Array r (sh :. Int) a+ -> Array U sh a+sumS = foldS (+) LP.zero+{-# INLINABLE sumS #-}++-- | Sum all array indices to a scalar sequentially+sumAllS :: (Shape sh, Source r a, Elt a, Unbox a, Additive a)+ => Array r sh a+ -> a+sumAllS = foldAllS (+) LP.zero+{-# INLINABLE sumAllS #-}
+ LICENSE view
@@ -0,0 +1,339 @@+ GNU GENERAL PUBLIC LICENSE+ Version 2, June 1991++ Copyright (C) 1989, 1991 Free Software Foundation, Inc.,+ 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA+ Everyone is permitted to copy and distribute verbatim copies+ of this license document, but changing it is not allowed.++ Preamble++ The licenses for most software are designed to take away your+freedom to share and change it. By contrast, the GNU General Public+License is intended to guarantee your freedom to share and change free+software--to make sure the software is free for all its users. This+General Public License applies to most of the Free Software+Foundation's software and to any other program whose authors commit to+using it. (Some other Free Software Foundation software is covered by+the GNU Lesser General Public License instead.) You can apply it to+your programs, too.++ When we speak of free software, we are referring to freedom, not+price. Our General Public Licenses are designed to make sure that you+have the freedom to distribute copies of free software (and charge for+this service if you wish), that you receive source code or can get it+if you want it, that you can change the software or use pieces of it+in new free programs; and that you know you can do these things.++ To protect your rights, we need to make restrictions that forbid+anyone to deny you these rights or to ask you to surrender the rights.+These restrictions translate to certain responsibilities for you if you+distribute copies of the software, or if you modify it.++ For example, if you distribute copies of such a program, whether+gratis or for a fee, you must give the recipients all the rights that+you have. You must make sure that they, too, receive or can get the+source code. And you must show them these terms so they know their+rights.++ We protect your rights with two steps: (1) copyright the software, and+(2) offer you this license which gives you legal permission to copy,+distribute and/or modify the software.++ Also, for each author's protection and ours, we want to make certain+that everyone understands that there is no warranty for this free+software. If the software is modified by someone else and passed on, we+want its recipients to know that what they have is not the original, so+that any problems introduced by others will not reflect on the original+authors' reputations.++ Finally, any free program is threatened constantly by software+patents. We wish to avoid the danger that redistributors of a free+program will individually obtain patent licenses, in effect making the+program proprietary. To prevent this, we have made it clear that any+patent must be licensed for everyone's free use or not licensed at all.++ The precise terms and conditions for copying, distribution and+modification follow.++ GNU GENERAL PUBLIC LICENSE+ TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION++ 0. This License applies to any program or other work which contains+a notice placed by the copyright holder saying it may be distributed+under the terms of this General Public License. The "Program", below,+refers to any such program or work, and a "work based on the Program"+means either the Program or any derivative work under copyright law:+that is to say, a work containing the Program or a portion of it,+either verbatim or with modifications and/or translated into another+language. (Hereinafter, translation is included without limitation in+the term "modification".) Each licensee is addressed as "you".++Activities other than copying, distribution and modification are not+covered by this License; they are outside its scope. The act of+running the Program is not restricted, and the output from the Program+is covered only if its contents constitute a work based on the+Program (independent of having been made by running the Program).+Whether that is true depends on what the Program does.++ 1. You may copy and distribute verbatim copies of the Program's+source code as you receive it, in any medium, provided that you+conspicuously and appropriately publish on each copy an appropriate+copyright notice and disclaimer of warranty; keep intact all the+notices that refer to this License and to the absence of any warranty;+and give any other recipients of the Program a copy of this License+along with the Program.++You may charge a fee for the physical act of transferring a copy, and+you may at your option offer warranty protection in exchange for a fee.++ 2. You may modify your copy or copies of the Program or any portion+of it, thus forming a work based on the Program, and copy and+distribute such modifications or work under the terms of Section 1+above, provided that you also meet all of these conditions:++ a) You must cause the modified files to carry prominent notices+ stating that you changed the files and the date of any change.++ b) You must cause any work that you distribute or publish, that in+ whole or in part contains or is derived from the Program or any+ part thereof, to be licensed as a whole at no charge to all third+ parties under the terms of this License.++ c) If the modified program normally reads commands interactively+ when run, you must cause it, when started running for such+ interactive use in the most ordinary way, to print or display an+ announcement including an appropriate copyright notice and a+ notice that there is no warranty (or else, saying that you provide+ a warranty) and that users may redistribute the program under+ these conditions, and telling the user how to view a copy of this+ License. (Exception: if the Program itself is interactive but+ does not normally print such an announcement, your work based on+ the Program is not required to print an announcement.)++These requirements apply to the modified work as a whole. If+identifiable sections of that work are not derived from the Program,+and can be reasonably considered independent and separate works in+themselves, then this License, and its terms, do not apply to those+sections when you distribute them as separate works. But when you+distribute the same sections as part of a whole which is a work based+on the Program, the distribution of the whole must be on the terms of+this License, whose permissions for other licensees extend to the+entire whole, and thus to each and every part regardless of who wrote it.++Thus, it is not the intent of this section to claim rights or contest+your rights to work written entirely by you; rather, the intent is to+exercise the right to control the distribution of derivative or+collective works based on the Program.++In addition, mere aggregation of another work not based on the Program+with the Program (or with a work based on the Program) on a volume of+a storage or distribution medium does not bring the other work under+the scope of this License.++ 3. You may copy and distribute the Program (or a work based on it,+under Section 2) in object code or executable form under the terms of+Sections 1 and 2 above provided that you also do one of the following:++ a) Accompany it with the complete corresponding machine-readable+ source code, which must be distributed under the terms of Sections+ 1 and 2 above on a medium customarily used for software interchange; or,++ b) Accompany it with a written offer, valid for at least three+ years, to give any third party, for a charge no more than your+ cost of physically performing source distribution, a complete+ machine-readable copy of the corresponding source code, to be+ distributed under the terms of Sections 1 and 2 above on a medium+ customarily used for software interchange; or,++ c) Accompany it with the information you received as to the offer+ to distribute corresponding source code. (This alternative is+ allowed only for noncommercial distribution and only if you+ received the program in object code or executable form with such+ an offer, in accord with Subsection b above.)++The source code for a work means the preferred form of the work for+making modifications to it. For an executable work, complete source+code means all the source code for all modules it contains, plus any+associated interface definition files, plus the scripts used to+control compilation and installation of the executable. However, as a+special exception, the source code distributed need not include+anything that is normally distributed (in either source or binary+form) with the major components (compiler, kernel, and so on) of the+operating system on which the executable runs, unless that component+itself accompanies the executable.++If distribution of executable or object code is made by offering+access to copy from a designated place, then offering equivalent+access to copy the source code from the same place counts as+distribution of the source code, even though third parties are not+compelled to copy the source along with the object code.++ 4. You may not copy, modify, sublicense, or distribute the Program+except as expressly provided under this License. Any attempt+otherwise to copy, modify, sublicense or distribute the Program is+void, and will automatically terminate your rights under this License.+However, parties who have received copies, or rights, from you under+this License will not have their licenses terminated so long as such+parties remain in full compliance.++ 5. You are not required to accept this License, since you have not+signed it. However, nothing else grants you permission to modify or+distribute the Program or its derivative works. These actions are+prohibited by law if you do not accept this License. Therefore, by+modifying or distributing the Program (or any work based on the+Program), you indicate your acceptance of this License to do so, and+all its terms and conditions for copying, distributing or modifying+the Program or works based on it.++ 6. Each time you redistribute the Program (or any work based on the+Program), the recipient automatically receives a license from the+original licensor to copy, distribute or modify the Program subject to+these terms and conditions. You may not impose any further+restrictions on the recipients' exercise of the rights granted herein.+You are not responsible for enforcing compliance by third parties to+this License.++ 7. If, as a consequence of a court judgment or allegation of patent+infringement or for any other reason (not limited to patent issues),+conditions are imposed on you (whether by court order, agreement or+otherwise) that contradict the conditions of this License, they do not+excuse you from the conditions of this License. If you cannot+distribute so as to satisfy simultaneously your obligations under this+License and any other pertinent obligations, then as a consequence you+may not distribute the Program at all. For example, if a patent+license would not permit royalty-free redistribution of the Program by+all those who receive copies directly or indirectly through you, then+the only way you could satisfy both it and this License would be to+refrain entirely from distribution of the Program.++If any portion of this section is held invalid or unenforceable under+any particular circumstance, the balance of the section is intended to+apply and the section as a whole is intended to apply in other+circumstances.++It is not the purpose of this section to induce you to infringe any+patents or other property right claims or to contest validity of any+such claims; this section has the sole purpose of protecting the+integrity of the free software distribution system, which is+implemented by public license practices. Many people have made+generous contributions to the wide range of software distributed+through that system in reliance on consistent application of that+system; it is up to the author/donor to decide if he or she is willing+to distribute software through any other system and a licensee cannot+impose that choice.++This section is intended to make thoroughly clear what is believed to+be a consequence of the rest of this License.++ 8. If the distribution and/or use of the Program is restricted in+certain countries either by patents or by copyrighted interfaces, the+original copyright holder who places the Program under this License+may add an explicit geographical distribution limitation excluding+those countries, so that distribution is permitted only in or among+countries not thus excluded. In such case, this License incorporates+the limitation as if written in the body of this License.++ 9. The Free Software Foundation may publish revised and/or new versions+of the General Public License from time to time. Such new versions will+be similar in spirit to the present version, but may differ in detail to+address new problems or concerns.++Each version is given a distinguishing version number. If the Program+specifies a version number of this License which applies to it and "any+later version", you have the option of following the terms and conditions+either of that version or of any later version published by the Free+Software Foundation. If the Program does not specify a version number of+this License, you may choose any version ever published by the Free Software+Foundation.++ 10. If you wish to incorporate parts of the Program into other free+programs whose distribution conditions are different, write to the author+to ask for permission. For software which is copyrighted by the Free+Software Foundation, write to the Free Software Foundation; we sometimes+make exceptions for this. Our decision will be guided by the two goals+of preserving the free status of all derivatives of our free software and+of promoting the sharing and reuse of software generally.++ NO WARRANTY++ 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY+FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN+OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES+PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED+OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS+TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE+PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,+REPAIR OR CORRECTION.++ 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR+REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,+INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING+OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED+TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY+YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER+PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE+POSSIBILITY OF SUCH DAMAGES.++ END OF TERMS AND CONDITIONS++ How to Apply These Terms to Your New Programs++ If you develop a new program, and you want it to be of the greatest+possible use to the public, the best way to achieve this is to make it+free software which everyone can redistribute and change under these terms.++ To do so, attach the following notices to the program. It is safest+to attach them to the start of each source file to most effectively+convey the exclusion of warranty; and each file should have at least+the "copyright" line and a pointer to where the full notice is found.++ <one line to give the program's name and a brief idea of what it does.>+ Copyright (C) <year> <name of author>++ This program is free software; you can redistribute it and/or modify+ it under the terms of the GNU General Public License as published by+ the Free Software Foundation; either version 2 of the License, or+ (at your option) any later version.++ This program is distributed in the hope that it will be useful,+ but WITHOUT ANY WARRANTY; without even the implied warranty of+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+ GNU General Public License for more details.++ You should have received a copy of the GNU General Public License along+ with this program; if not, write to the Free Software Foundation, Inc.,+ 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.++Also add information on how to contact you by electronic and paper mail.++If the program is interactive, make it output a short notice like this+when it starts in an interactive mode:++ Gnomovision version 69, Copyright (C) year name of author+ Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.+ This is free software, and you are welcome to redistribute it+ under certain conditions; type `show c' for details.++The hypothetical commands `show w' and `show c' should show the appropriate+parts of the General Public License. Of course, the commands you use may+be called something other than `show w' and `show c'; they could even be+mouse-clicks or menu items--whatever suits your program.++You should also get your employer (if you work as a programmer) or your+school, if any, to sign a "copyright disclaimer" for the program, if+necessary. Here is a sample; alter the names:++ Yoyodyne, Inc., hereby disclaims all copyright interest in the program+ `Gnomovision' (which makes passes at compilers) written by James Hacker.++ <signature of Ty Coon>, 1 April 1989+ Ty Coon, President of Vice++This General Public License does not permit incorporating your program into+proprietary programs. If your program is a subroutine library, you may+consider it more useful to permit linking proprietary applications with the+library. If this is what you want to do, use the GNU Lesser General+Public License instead of this License.
+ README view
@@ -0,0 +1,6 @@++This package contains a pure Haskell implementation of the 'Tensor' interface for+Lol, using the highly optimized and parallelizable array library Repa.++You can test this package by running `stack test lol-repa`, and benchmark by+running `stack bench lol-repa`.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ benchmarks/BenchRepaMain.hs view
@@ -0,0 +1,83 @@+{-|+Module : BenchRepaMain+Description : Main driver for RT benchmarks.+Copyright : (c) Eric Crockett, 2011-2017+ Chris Peikert, 2011-2017+License : GPL-2+Maintainer : ecrockett0@email.com+Stability : experimental+Portability : POSIX++Main driver for RT benchmarks.+-}++{-# LANGUAGE DataKinds #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE TypeOperators #-}++module BenchRepaMain where++import Crypto.Lol.Benchmarks+import Crypto.Lol.Benchmarks.Standard+import Crypto.Lol.Cyclotomic.Tensor.Repa+import Crypto.Lol.Factored+import qualified Crypto.Lol.Utils.PrettyPrint.Diagnostic as D+--import qualified Crypto.Lol.Utils.PrettyPrint.Table as T+import Crypto.Random.DRBG++import Data.Proxy++-- choose which layers of Lol to benchmark+ls :: [String]+ls = [+ "STensor",+ "Tensor",+ "SUCyc",+ "UCyc",+ "Cyc"+ ]++-- choose which operations to benchmark+bs :: [String]+bs = [+ {-"unzipPow",+ "unzipDec",+ "unzipCRT",+ "zipWith (*)",+ "crt",+ "crtInv",+ "l",+ "lInv",+ "*g Pow",+ "*g Dec",+ "*g CRT",+ "divg Pow",+ "divg Dec",+ "divg CRT",+ "lift",+ "error",+ "twacePow",+ "twaceDec",+ "twaceCRT",+ "embedPow",+ "embedDec",+ "embedCRT"-}+ ]++main :: IO ()+main = diagnosticMain+{-+tableMain :: IO ()+tableMain = do+ let opts = (T.defaultOpts "UCyc"){T.benches=bs}+ g1 <- defaultBenches (Proxy::Proxy RT)+ mapM_ (T.prettyBenches opts) g1+-}+diagnosticMain :: IO ()+diagnosticMain = do+ let opts = D.defaultOpts{D.levels=ls, D.benches=bs}+ b1 <- benchGroup "Single Index"+ [oneIdxBenches (Proxy::Proxy '(F64*F9*F25, Zq 14401)) (Proxy::Proxy RT) (Proxy::Proxy HashDRBG)]+ b2 <- benchGroup "Twace-Embed"+ [twoIdxBenches (Proxy::Proxy '(F64*F9*F25, F64*F9*F25, Zq 14401)) (Proxy::Proxy RT)]+ mapM_ (D.prettyBenches opts) [b1,b2]
+ lol-repa.cabal view
@@ -0,0 +1,122 @@+name: lol-repa+-- The package version. See the Haskell package versioning policy (PVP)+-- for standards guiding when and how versions should be incremented.+-- http://www.haskell.org/haskellwiki/Package_versioning_policy+-- PVP summary: +-+------- breaking API changes+-- | | +----- non-breaking API additions+-- | | | +--- code changes with no API change+version: 0.0.0.1+synopsis: A repa backend for <https://hackage.haskell.org/package/lol Λ ∘ λ>.+homepage: https://github.com/cpeikert/Lol+Bug-Reports: https://github.com/cpeikert/Lol/issues+license: GPL-2+license-file: LICENSE+author: Eric Crockett <ecrockett0@gmail.com>, Chris Peikert <cpeikert@alum.mit.edu>+maintainer: Eric Crockett <ecrockett0@gmail.com>+copyright: Eric Crockett, Chris Peikert+category: Crypto+stability: experimental+build-type: Simple+extra-source-files: README, CHANGES.md+cabal-version: >= 1.10+description:+ Λ ∘ λ (Lol) is a general-purpose library for ring-based lattice cryptography.+ This package provides a pure Haskell implementation of Lol's Tensor interface+ using the repa library for parallel arrays.+source-repository head+ type: git+ location: https://github.com/cpeikert/Lol++-- For information on compiling C with cabal: http://blog.ezyang.com/2010/06/setting-up-cabal-the-ffi-and-c2hs/++Flag llvm+ Description: Compile via LLVM. This produces much better object code,+ but you need to have the LLVM compiler installed.+ -- If you enable this and get errors like "Error: can't resolve `.rodata' {.rodata section}"+ -- then GHC doesn't like your version of LLVM!+ Default: False++Flag opt+ Description: Turn on library optimizations+ Default: True++library+ default-language: Haskell2010+ ghc-options: -fwarn-dodgy-imports++ if flag(llvm)+ ghc-options: -fllvm -optlo-O3++ -- ghc optimizations+ if flag(opt)+ -- makes lift much faster!+ ghc-options: -funfolding-use-threshold1000+ exposed-modules:+ Crypto.Lol.Cyclotomic.Tensor.Repa++ other-modules:+ Crypto.Lol.Cyclotomic.Tensor.Repa.CRT+ Crypto.Lol.Cyclotomic.Tensor.Repa.Extension+ Crypto.Lol.Cyclotomic.Tensor.Repa.Dec+ Crypto.Lol.Cyclotomic.Tensor.Repa.GL+ Crypto.Lol.Cyclotomic.Tensor.Repa.Instances+ Crypto.Lol.Cyclotomic.Tensor.Repa.RTCommon++ build-depends:+ arithmoi >= 0.4.1.3,+ base >= 4.9 && < 5,+ bytestring,+ constraints,+ containers >= 0.5.6.2,+ crypto-api,+ data-default >= 0.3.0,+ deepseq >= 1.4.1.1,+ lol >= 0.6.0.0,+ monadcryptorandom,+ MonadRandom >= 0.2,+ mtl >= 2.2.1,+ numeric-prelude >= 0.4.2,+ protocol-buffers,+ protocol-buffers-descriptor,+ random >= 1.1,+ reflection >= 1.5.1,+ repa>=3.4,+ singletons >= 1.1.2.1,+ th-desugar >= 1.5.4,+ tagged-transformer >= 0.7,+ template-haskell >= 2.2.0.0,+ transformers >= 0.4.2.0,+ vector>=0.11,+ vector-th-unbox >= 0.2.1.0++ other-extensions: TemplateHaskell++Benchmark bench-lol-repa+ type: exitcode-stdio-1.0+ default-language: Haskell2010+ main-is: BenchRepaMain.hs+ ghc-options: -main-is BenchRepaMain+ hs-source-dirs: benchmarks++ ghc-options: -O2 -funfolding-creation-threshold=15000 -funfolding-use-threshold=1000+ ghc-options: -fsimpl-tick-factor=110++ build-depends:+ base >= 4.9 && < 5,+ DRBG,+ lol >= 0.6.0.0,+ lol-benches,+ lol-repa++test-suite test-lol-repa+ type: exitcode-stdio-1.0+ default-language: Haskell2010+ main-is: TestRepaMain.hs+ ghc-options: -main-is TestRepaMain+ hs-source-dirs: tests+ ghc-options: -threaded -O2++ build-depends:+ base >= 4.9 && < 5,+ lol-repa,+ lol-tests
+ tests/TestRepaMain.hs view
@@ -0,0 +1,21 @@+{-|+Module : TestRepaMain+Description : Main driver for RT tests.+Copyright : (c) Eric Crockett, 2011-2017+ Chris Peikert, 2011-2017+License : GPL-2+Maintainer : ecrockett0@email.com+Stability : experimental+Portability : POSIX++Main driver for RT tests.+-}++module TestRepaMain where++import Crypto.Lol.Cyclotomic.Tensor.Repa+import Crypto.Lol.Tests.Standard+import Data.Proxy++main :: IO ()+main = defaultTestMain (Proxy::Proxy RT)