lol 0.4.0.0 → 0.5.0.0

raw patch · 31 files changed

+992/−553 lines, 31 filesdep +ansi-terminaldep +statisticsdep −storable-recorddep ~containersPVP ok

version bump matches the API change (PVP)

Dependencies added: ansi-terminal, statistics

Dependencies removed: storable-record

Dependency ranges changed: containers

API changes (from Hackage documentation)

Files

• Crypto/Lol/Cyclotomic/CRTSentinel.hs +1/−1
• Crypto/Lol/Cyclotomic/Cyc.hs +11/−10
• Crypto/Lol/Cyclotomic/Tensor.hs +7/−14
• Crypto/Lol/Cyclotomic/Tensor/CTensor.hs +48/−76
• Crypto/Lol/Cyclotomic/Tensor/CTensor/Backend.hs +13/−35
• Crypto/Lol/Cyclotomic/Tensor/CTensor/Extension.hs +47/−21
• Crypto/Lol/Cyclotomic/Tensor/CTensor/common.h +0/−9
• Crypto/Lol/Cyclotomic/Tensor/CTensor/crt.cpp +90/−20
• Crypto/Lol/Cyclotomic/Tensor/CTensor/g.cpp +94/−9
• Crypto/Lol/Cyclotomic/Tensor/CTensor/random.cpp +8/−8
• Crypto/Lol/Cyclotomic/Tensor/CTensor/types.h +11/−12
• Crypto/Lol/Cyclotomic/Tensor/CTensor/zq.cpp +4/−1
• Crypto/Lol/Cyclotomic/Tensor/RepaTensor.hs +3/−10
• Crypto/Lol/Cyclotomic/Tensor/RepaTensor/CRT.hs +2/−2
• Crypto/Lol/Cyclotomic/UCyc.hs +34/−137
• Crypto/Lol/FactoredDefs.hs +70/−43
• Crypto/Lol/GaussRandom.hs +4/−1
• Crypto/Lol/PosBinDefs.hs +21/−7
• Crypto/Lol/RLWE/Discrete.hs +1/−1
• Crypto/Lol/Types/FiniteField.hs +12/−3
• Crypto/Lol/Types/Random.hs +3/−0
• Crypto/Lol/Types/ZqBasic.hs +8/−0
• Crypto/Proto/RLWE.hs +2/−2
• Crypto/Proto/RLWE/Kq.hs +6/−6
• benchmarks/CycBenches.hs +77/−59
• benchmarks/Main.hs +170/−8
• benchmarks/TensorBenches.hs +116/−13
• benchmarks/UCycBenches.hs +116/−22
• lol.cabal +9/−8
• utils/Apply/Cyc.hs +4/−4
• utils/Utils.hs +0/−11

@@ -73,5 +73,5 @@ twaceCRTCS :: (Tensor t, m `Divides` m', CRTrans Maybe r, TElt t r)               => CSentinel t m' r -> CSentinel t m r -> t m' r -> t m r twaceCRTCS _ _ = fromJust twaceCRT-{-# INLINABLE twaceCRTCS #-}+{-# INLINE twaceCRTCS #-} 

@@ -59,8 +59,8 @@ import qualified Algebra.ZeroTestable as ZeroTestable (C)  import Crypto.Lol.Cyclotomic.UCyc hiding (coeffsDec, coeffsPow, crtSet,-                                   divG, errorCoset, errorRounded, gSqNorm,-                                   mulG, powBasis, tGaussian)+                                   errorCoset, errorRounded, gSqNorm, mulG,+                                   powBasis, tGaussian)  import           Crypto.Lol.CRTrans import qualified Crypto.Lol.Cyclotomic.RescaleCyc as R@@ -332,9 +332,10 @@ divG :: (Fact m, CElt t r, IntegralDomain r)         => Cyc t m r -> Maybe (Cyc t m r) {-# INLINABLE divG #-}-divG (Pow u) = Pow <$> U.divG u-divG (Dec u) = Dec <$> U.divG u-divG (CRT u) = CRT <$> either (fmap Left . U.divG) (fmap Right . U.divG) u+divG (Pow u) = Pow <$> U.divGPow u+divG (Dec u) = Dec <$> U.divGDec u+divG (CRT (Left u)) = Pow <$> U.divGPow (U.toPow u)+divG (CRT (Right u)) = Just $ (CRT . Right) $ U.divGCRTC u divG c@(Scalar _) = divG $ toCRT' c divG (Sub c) = divG $ embed' c  -- must go to full ring @@ -401,7 +402,7 @@ -- | The "tweaked trace" (twace) function -- \(\Tw(x) = (\hat{m} / \hat{m}') \cdot \Tr((g' / g) \cdot x)\), -- which fixes \(R\) pointwise (i.e., @twace . embed == id@).-twace :: forall t m m' r . (m `Divides` m', CElt t r)+twace :: forall t m m' r . (m `Divides` m', UCRTElt t r, ZeroTestable r)          => Cyc t m' r -> Cyc t m r {-# INLINABLE twace #-} twace (Pow u) = Pow $ U.twacePow u@@ -561,10 +562,10 @@  ---------- Change of representation (internal use only) ---------- -toPow', toDec', toCRT' :: (Fact m, CElt t r) => Cyc t m r -> Cyc t m r-{-# INLINE toPow' #-}-{-# INLINE toDec' #-}-{-# INLINE toCRT' #-}+toPow', toDec', toCRT' :: (Fact m, UCRTElt t r, ZeroTestable r) => Cyc t m r -> Cyc t m r+{-# INLINABLE toPow' #-}+{-# INLINABLE toDec' #-}+{-# INLINABLE toCRT' #-}  -- | Force to powerful-basis representation (for internal use only). toPow' c@(Pow _) = c

@@ -174,9 +174,6 @@    -- | Potentially optimized version of 'fmap' for types that satisfy 'TElt'.   fmapT :: (Fact m, TElt t a, TElt t b) => (a -> b) -> t m a -> t m b-  -- | Potentially optimized monadic 'fmap'.-  fmapTM :: (Monad mon, Fact m, TElt t a, TElt t b)-             => (a -> mon b) -> t m a -> mon (t m b)    -- | Potentially optimized zipWith for types that satisfy 'TElt'.   zipWithT :: (Fact m, TElt t a, TElt t b, TElt t c)@@ -186,12 +183,6 @@   unzipT :: (Fact m, TElt t (a,b), TElt t a, TElt t b)             => t m (a,b) -> (t m a, t m b) -  {- CJP: suppressed, apparently not needed--  -- | Unzip for arbitrary types.-  unzipTUnrestricted :: (Fact m) => t m (a,b) -> (t m a, t m b)-  -}- -- | Convenience value indicating whether 'crtFuncs' exists. hasCRTFuncs :: forall t m mon r . (CRTrans mon r, Tensor t, Fact m, TElt t r)                => TaggedT (t m r) mon ()@@ -211,7 +202,7 @@ {-# INLINABLE mulGCRT #-} {-# INLINABLE divGCRT #-} {-# INLINABLE crt #-}-{-# INLINABLE crtInv #-}+{-# INLINE crtInv #-}  -- | Multiply by \(g_m\) in the CRT basis. (This function is simply an -- appropriate entry from 'crtFuncs'.)@@ -232,6 +223,7 @@ -- (This function is simply an appropriate entry from 'crtExtFuncs'.) twaceCRT :: forall t m m' mon r . (CRTrans mon r, Tensor t, m `Divides` m', TElt t r)             => mon (t m' r -> t m r)+{-# INLINABLE twaceCRT #-} twaceCRT = proxyT hasCRTFuncs (Proxy::Proxy (t m' r)) *>            proxyT hasCRTFuncs (Proxy::Proxy (t m  r)) *>            (fst <$> crtExtFuncs)@@ -413,8 +405,8 @@ indexInfo = let pps = proxy ppsFact (Proxy::Proxy m)                 pps' = proxy ppsFact (Proxy::Proxy m')                 mpps = mergePPs pps pps'-                phi = totientPPs pps-                phi' = totientPPs pps'+                phi = proxy totientFact (Proxy::Proxy m)+                phi' = proxy totientFact (Proxy::Proxy m')                 tots = totients mpps             in tag (mpps, phi, phi', tots) @@ -422,6 +414,7 @@ -- the index into the powerful\/decoding basis of \(\O_{m'}\) of the -- \(i\)th entry of the powerful/decoding basis of \(\O_m\). extIndicesPowDec :: (m `Divides` m') => Tagged '(m, m') (U.Vector Int)+{-# INLINABLE extIndicesPowDec #-} extIndicesPowDec = do   (_, phi, _, tots) <- indexInfo   return $ U.generate phi (fromIndexPair tots . (0,))@@ -447,15 +440,15 @@ -- | A lookup table for 'toIndexPair' applied to indices \([\varphi(m')]\). baseIndicesPow :: forall m m' . (m `Divides` m')                   => Tagged '(m, m') (U.Vector (Int,Int))+{-# INLINABLE baseIndicesPow #-} -- | A lookup table for 'baseIndexDec' applied to indices \([\varphi(m')]\). baseIndicesDec :: forall m m' . (m `Divides` m')                   => Tagged '(m, m') (U.Vector (Maybe (Int,Bool)))-+{-# INLINABLE baseIndicesDec #-} -- | Same as 'baseIndicesPow', but only includes the second component -- of each pair. baseIndicesCRT :: forall m m' . (m `Divides` m')                   => Tagged '(m, m') (U.Vector Int)- baseIndicesPow = baseWrapper (toIndexPair . totients)  -- this one is more complicated; requires the prime powers

@@ -21,8 +21,7 @@  -- | Wrapper for a C++ implementation of the 'Tensor' interface. -module Crypto.Lol.Cyclotomic.Tensor.CTensor-( CT ) where+module Crypto.Lol.Cyclotomic.Tensor.CTensor (CT) where  import Algebra.Additive     as Additive (C) import Algebra.Module       as Module (C)@@ -43,10 +42,10 @@ import Data.Traversable             as T import Data.Vector.Generic          as V (fromList, toList, unzip) import Data.Vector.Storable         as SV (Vector, convert, foldl',-                                           foldl1', fromList, generate,-                                           length, map, mapM, replicate,+                                           fromList, generate,+                                           length, map, replicate,                                            replicateM, thaw, thaw, toList,-                                           unsafeFreeze, unsafeSlice,+                                           unsafeFreeze,                                            unsafeWith, zipWith, (!)) import Data.Vector.Storable.Mutable as SM hiding (replicate) @@ -128,13 +127,13 @@    toProto (CT (CT' xs)) =     let m = fromIntegral $ proxy valueFact (Proxy::Proxy m)-        q = proxy value (Proxy::Proxy q) :: Double+        q = round (proxy value (Proxy::Proxy q) :: Double)     in Kq m q $ S.fromList $ SV.toList $ SV.map LP.lift xs   toProto x@(ZV _) = toProto $ toCT x    fromProto (Kq m' q' xs) =     let m = proxy valueFact (Proxy::Proxy m) :: Int-        q = proxy value (Proxy::Proxy q) :: Double+        q = round (proxy value (Proxy::Proxy q) :: Double)         n = proxy totientFact (Proxy::Proxy m)         xs' = SV.fromList $ F.toList xs         len = F.length xs@@ -144,7 +143,7 @@             "An error occurred while reading the proto type for CT.\n\             \Expected m=" ++ show m ++ ", got " ++ show m' ++ "\n\             \Expected n=" ++ show n ++ ", got " ++ show len ++ "\n\-            \Expected q=" ++ show (round q :: Int64) ++ ", got " ++ show q' ++ "."+            \Expected q=" ++ show q ++ ", got " ++ show q' ++ "."  toCT :: (Storable r) => CT m r -> CT m r toCT v@(CT _) = v@@ -158,12 +157,14 @@ zvToCT' :: forall m r . (Storable r) => IZipVector m r -> CT' m r zvToCT' v = coerce (convert $ unIZipVector v :: Vector r) -wrap :: (Storable r) => (CT' l r -> CT' m r) -> (CT l r -> CT m r)+wrap :: (Storable s, Storable r) => (CT' l s -> CT' m r) -> (CT l s -> CT m r)+{-# INLINABLE wrap #-} wrap f (CT v) = CT $ f v wrap f (ZV v) = CT $ f $ zvToCT' v -wrapM :: (Storable r, Monad mon) => (CT' l r -> mon (CT' m r))-         -> (CT l r -> mon (CT m r))+wrapM :: (Storable s, Storable r, Monad mon) => (CT' l s -> mon (CT' m r))+         -> (CT l s -> mon (CT m r))+{-# INLINABLE wrapM #-} wrapM f (CT v) = CT <$> f v wrapM f (ZV v) = CT <$> f (zvToCT' v) @@ -247,15 +248,14 @@    scalarPow = CT . scalarPow' -- Vector code -  l = wrap $ untag $ basicDispatch dl-  lInv = wrap $ untag $ basicDispatch dlinv+  l = wrap $ basicDispatch dl+  lInv = wrap $ basicDispatch dlinv -  mulGPow = wrap mulGPow'-  mulGDec = wrap $ untag $ basicDispatch dmulgdec+  mulGPow = wrap $ basicDispatch dmulgpow+  mulGDec = wrap $ basicDispatch dmulgdec -  divGPow = wrapM divGPow'-  -- we divide by p in the C code (for divGDec only(?)), do NOT call checkDiv!-  divGDec = wrapM $ Just . untag (basicDispatch dginvdec)+  divGPow = wrapM $ dispatchGInv dginvpow+  divGDec = wrapM $ dispatchGInv dginvdec    crtFuncs = (,,,,) <$>     return (CT . repl) <*>@@ -284,17 +284,16 @@    crtSetDec = (CT <$>) <$> coerceBasis crtSetDec' -  fmapT f (CT v) = CT $ coerce (SV.map f) v-  fmapT f v@(ZV _) = fmapT f $ toCT v--  fmapTM f (CT (CT' v)) = (CT . CT') <$> SV.mapM f v-  fmapTM f v@(ZV _) = fmapTM f $ toCT v+  fmapT f = wrap $ coerce (SV.map f) -  zipWithT f (CT (CT' v1)) (CT (CT' v2)) = CT $ CT' $ SV.zipWith f v1 v2-  zipWithT f v1 v2 = zipWithT f (toCT v1) (toCT v2)+  zipWithT f v1' v2' =+    let (CT (CT' v1)) = toCT v1'+        (CT (CT' v2)) = toCT v2'+    in CT $ CT' $ SV.zipWith f v1 v2 -  unzipT (CT (CT' v)) = (CT . CT') *** (CT . CT') $ unzip v-  unzipT v = unzipT $ toCT v+  unzipT v =+    let (CT (CT' x)) = toCT v+    in (CT . CT') *** (CT . CT') $ unzip x    {-# INLINABLE entailIndexT #-}   {-# INLINABLE entailEqT #-}@@ -315,15 +314,13 @@   {-# INLINABLE embedDec #-}   {-# INLINABLE tGaussianDec #-}   {-# INLINABLE gSqNormDec #-}-  {-# INLINABLE crtExtFuncs #-}+  {-# INLINE crtExtFuncs #-}   {-# INLINABLE coeffs #-}   {-# INLINABLE powBasisPow #-}   {-# INLINABLE crtSetDec #-}   {-# INLINABLE fmapT #-}-  {-# INLINABLE fmapTM #-}-  {-# INLINABLE zipWithT #-}-  {-# INLINABLE unzipT #-}-+  {-# INLINE zipWithT #-}+  {-# INLINE unzipT #-}  coerceTw :: (Functor mon) => TaggedT '(m, m') mon (Vector r -> Vector r) -> mon (CT' m' r -> CT' m r) coerceTw = (coerce <$>) . untagT@@ -341,12 +338,21 @@ coerceBasis :: Tagged '(m,m') [Vector r] -> Tagged m [CT' m' r] coerceBasis = coerce -mulGPow' :: (TElt CT r, Fact m) => CT' m r -> CT' m r-mulGPow' = untag $ basicDispatch dmulgpow--divGPow' :: (TElt CT r, Fact m, IntegralDomain r, ZeroTestable r)-            => CT' m r -> Maybe (CT' m r)-divGPow' = untag $ checkDiv $ basicDispatch dginvpow+dispatchGInv :: forall m r . (Storable r, Fact m)+             => (Ptr r -> Int64 -> Ptr CPP -> Int16 -> IO Int16)+                 -> CT' m r -> Maybe (CT' m r)+dispatchGInv f =+  let factors = proxy (marshalFactors <$> ppsFact) (Proxy::Proxy m)+      totm = proxy (fromIntegral <$> totientFact) (Proxy::Proxy m)+      numFacts = fromIntegral $ SV.length factors+  in \(CT' x) -> unsafePerformIO $ do+    yout <- SV.thaw x+    ret <- SM.unsafeWith yout (\pout ->+             SV.unsafeWith factors (\pfac ->+               f pout totm pfac numFacts))+    if ret /= 0+    then Just . CT' <$> unsafeFreeze yout+    else return Nothing  withBasicArgs :: forall m r . (Fact m, Storable r)   => (Ptr r -> Int64 -> Ptr CPP -> Int16 -> IO ())@@ -364,8 +370,8 @@  basicDispatch :: (Storable r, Fact m)                  => (Ptr r -> Int64 -> Ptr CPP -> Int16 -> IO ())-                     -> Tagged m (CT' m r -> CT' m r)-basicDispatch f = return $ unsafePerformIO . withBasicArgs f+                     -> CT' m r -> CT' m r+basicDispatch f = unsafePerformIO . withBasicArgs f  gSqNormDec' :: (Storable r, Fact m, Dispatch r)                => Tagged m (CT' m r -> r)@@ -387,19 +393,6 @@   return $ \x -> unsafePerformIO $     withPtrArray ruinv' (\ruptr -> with mhatInv (flip withBasicArgs x . dcrtinv ruptr)) -checkDiv :: (Storable r, IntegralDomain r, ZeroTestable r, Fact m)-    => Tagged m (CT' m r -> CT' m r) -> Tagged m (CT' m r -> Maybe (CT' m r))-checkDiv f = do-  f' <- f-  oddRad' <- fromIntegral <$> oddRadicalFact-  return $ \x ->-    let (CT' y) = f' x-    in CT' <$> SV.mapM (`divIfDivis` oddRad') y--divIfDivis :: (IntegralDomain r, ZeroTestable r) => r -> r -> Maybe r-divIfDivis num den = let (q,r) = num `divMod` den-                     in if isZero r then Just q else Nothing- cZipDispatch :: (Storable r, Fact m)   => (Ptr r -> Ptr r -> Int64 -> IO ())      -> Tagged m (CT' m r -> CT' m r -> CT' m r)@@ -418,7 +411,8 @@          => var -> rnd (CT' m r) cDispatchGaussian var = flip proxyT (Proxy::Proxy m) $ do -- in TaggedT m rnd   -- get rus for (Complex r)-  ruinv' <- mapTaggedT (return . fromMaybe (error "complexGaussianRoots")) ruInv+  -- takes ru (not ruInv) to match RT+  ruinv' <- mapTaggedT (return . fromMaybe (error "complexGaussianRoots")) ru   totm <- pureT totientFact   m <- pureT valueFact   rad <- pureT radicalFact@@ -497,25 +491,3 @@                  => mon (CT' m r) gCRT = wrapVector gCRTK gInvCRT = wrapVector gInvCRTK---- we can't put this in Extension with the rest of the twace/embed--- functions because it needs access to the C backend-twaceCRT' :: forall mon m m' r .-             (TElt CT r, CRTrans mon r, m `Divides` m')-             => TaggedT '(m, m') mon (Vector r -> Vector r)-twaceCRT' = tagT $ do-  (CT' g') :: CT' m' r <- gCRT-  (CT' gInv) :: CT' m r <- gInvCRT-  embed <- proxyT embedCRT' (Proxy::Proxy '(m,m'))-  indices <- pure $ proxy extIndicesCRT (Proxy::Proxy '(m,m'))-  (_, m'hatinv) <- proxyT crtInfo (Proxy::Proxy m')-  let phi = proxy totientFact (Proxy::Proxy m)-      phi' = proxy totientFact (Proxy::Proxy m')-      mhat = fromIntegral $ proxy valueHatFact (Proxy::Proxy m)-      hatRatioInv = m'hatinv * mhat-      reltot = phi' `div` phi-      -- tweak = mhat * g' / (m'hat * g)-      tweak = SV.map (* hatRatioInv) $ SV.zipWith (*) (embed gInv) g'-  return $ \ arr -> -- take true trace after mul-by-tweak-    let v = backpermute' indices (SV.zipWith (*) tweak arr)-    in generate phi $ \i -> foldl1' (+) $ SV.unsafeSlice (i*reltot) reltot v

@@ -31,10 +31,8 @@ , withArray, withPtrArray ) where -import Control.Applicative- import Crypto.Lol.Prelude       as LP (Complex, PP, Proxy (..), Tagged,-                                       map, mapM_, proxy, tag, (++))+                                       map, mapM_, proxy, tag) import Crypto.Lol.Reflects import Crypto.Lol.Types.RRq import Crypto.Lol.Types.ZqBasic@@ -49,7 +47,6 @@ import           Foreign.Marshal.Utils   (with) import           Foreign.Ptr             (Ptr, castPtr, plusPtr) import           Foreign.Storable        (Storable (..))-import qualified Foreign.Storable.Record as Store  #if __GLASGOW_HASKELL__ >= 800 import GHC.TypeLits -- for error message@@ -57,7 +54,7 @@  -- | Convert a list of prime powers to a suitable C representation. marshalFactors :: [PP] -> Vector CPP-marshalFactors = SV.fromList . LP.map (\(p,e) -> CPP (fromIntegral p) (fromIntegral e))+marshalFactors = SV.fromList . LP.map (\(p,e) -> (fromIntegral p, fromIntegral e))  -- http://stackoverflow.com/questions/6517387/vector-vector-foo-ptr-ptr-foo-io-a-io-a -- | Evaluates a C function that takes an "a** ptr" on a list of Vectors.@@ -69,24 +66,9 @@   LP.mapM_ (\(fp,_) -> touchForeignPtr fp) vs   return res +-- Note: These types need to be the same, otherwise something goes wrong on the C end... -- | C representation of a prime power.-data CPP = CPP {p' :: !Int32, e' :: !Int16}--- stolen from http://hackage.haskell.org/packages/archive/numeric-prelude/0.4.0.3/doc/html/src/Number-Complex.html#T--- the NumericPrelude Storable instance for complex numbers-instance Storable CPP where-   sizeOf    = Store.sizeOf store-   alignment = Store.alignment store-   peek      = Store.peek store-   poke      = Store.poke store--store :: Store.Dictionary CPP-store = Store.run $-   liftA2 CPP-      (Store.element p')-      (Store.element e')--instance Show CPP where-    show (CPP p e) = "(" LP.++ show p LP.++ "," LP.++ show e LP.++ ")"+type CPP = (Int16, Int16)  instance (Storable a, Storable b)   => Storable (a,b) where@@ -100,10 +82,6 @@     poke (castPtr p :: Ptr a) a     poke (castPtr (plusPtr p (sizeOf a)) :: Ptr b) b ---- data ZqB64D -- for type safety purposes data ComplexD data DoubleD@@ -118,7 +96,7 @@   CTypeOf (Complex Double) = ComplexD   CTypeOf (RRq (q :: k) Double) = RRqD #if __GLASGOW_HASKELL__ >= 800-  -- EAC: this doesn't display like I had hoped when there is a tuple involved...+  -- EAC: See #12237 and #11990   CTypeOf (ZqBasic (q :: k) i) = TypeError (Text "Unsupported C type: " :<>: ShowType (ZqBasic q i) :$$: Text "Use Int64 as the base ring")   CTypeOf (Complex i) = TypeError (Text "Unsupported C type: " :<>: ShowType (Complex i) :$$: Text "Use Double as the base ring")   CTypeOf (RRq (q :: k) i) = TypeError (Text "Unsupported C type: " :<>: ShowType (RRq q i) :$$: Text "Use Double as the base ring")@@ -188,9 +166,9 @@   -- | Equivalent to 'Tensor's @mulGDec@.   dmulgdec  :: Ptr r -> Int64 -> Ptr CPP -> Int16 -> IO ()   -- | Equivalent to 'Tensor's @divGPow@.-  dginvpow  :: Ptr r -> Int64 -> Ptr CPP -> Int16 -> IO ()+  dginvpow  :: Ptr r -> Int64 -> Ptr CPP -> Int16 -> IO Int16   -- | Equivalent to 'Tensor's @divGDec@.-  dginvdec  :: Ptr r -> Int64 -> Ptr CPP -> Int16 -> IO ()+  dginvdec  :: Ptr r -> Int64 -> Ptr CPP -> Int16 -> IO Int16   -- | Equivalent to @zipWith (*)@   dmul :: Ptr r -> Ptr r -> Int64 -> IO () @@ -337,12 +315,12 @@ foreign import ccall unsafe "tensorGDecR" tensorGDecR ::         Int16 -> Ptr Int64 -> Int64 -> Ptr CPP -> Int16          -> IO () foreign import ccall unsafe "tensorGDecRq" tensorGDecRq ::       Int16 -> Ptr (ZqBasic q Int64) -> Int64 -> Ptr CPP -> Int16 -> Ptr Int64 -> IO () foreign import ccall unsafe "tensorGDecC" tensorGDecC ::         Int16 -> Ptr (Complex Double) -> Int64 -> Ptr CPP -> Int16          -> IO ()-foreign import ccall unsafe "tensorGInvPowR" tensorGInvPowR ::   Int16 -> Ptr Int64 -> Int64 -> Ptr CPP -> Int16          -> IO ()-foreign import ccall unsafe "tensorGInvPowRq" tensorGInvPowRq :: Int16 -> Ptr (ZqBasic q Int64) -> Int64 -> Ptr CPP -> Int16 -> Ptr Int64 -> IO ()-foreign import ccall unsafe "tensorGInvPowC" tensorGInvPowC ::   Int16 -> Ptr (Complex Double) -> Int64 -> Ptr CPP -> Int16          -> IO ()-foreign import ccall unsafe "tensorGInvDecR" tensorGInvDecR ::   Int16 -> Ptr Int64 -> Int64 -> Ptr CPP -> Int16          -> IO ()-foreign import ccall unsafe "tensorGInvDecRq" tensorGInvDecRq :: Int16 -> Ptr (ZqBasic q Int64) -> Int64 -> Ptr CPP -> Int16 -> Ptr Int64 -> IO ()-foreign import ccall unsafe "tensorGInvDecC" tensorGInvDecC ::   Int16 -> Ptr (Complex Double) -> Int64 -> Ptr CPP -> Int16          -> IO ()+foreign import ccall unsafe "tensorGInvPowR" tensorGInvPowR ::   Int16 -> Ptr Int64 -> Int64 -> Ptr CPP -> Int16          -> IO Int16+foreign import ccall unsafe "tensorGInvPowRq" tensorGInvPowRq :: Int16 -> Ptr (ZqBasic q Int64) -> Int64 -> Ptr CPP -> Int16 -> Ptr Int64 -> IO Int16+foreign import ccall unsafe "tensorGInvPowC" tensorGInvPowC ::   Int16 -> Ptr (Complex Double) -> Int64 -> Ptr CPP -> Int16          -> IO Int16+foreign import ccall unsafe "tensorGInvDecR" tensorGInvDecR ::   Int16 -> Ptr Int64 -> Int64 -> Ptr CPP -> Int16          -> IO Int16+foreign import ccall unsafe "tensorGInvDecRq" tensorGInvDecRq :: Int16 -> Ptr (ZqBasic q Int64) -> Int64 -> Ptr CPP -> Int16 -> Ptr Int64 -> IO Int16+foreign import ccall unsafe "tensorGInvDecC" tensorGInvDecC ::   Int16 -> Ptr (Complex Double) -> Int64 -> Ptr CPP -> Int16          -> IO Int16  foreign import ccall unsafe "tensorCRTRq" tensorCRTRq ::         Int16 -> Ptr (ZqBasic q Int64) -> Int64 -> Ptr CPP -> Int16 -> Ptr (Ptr (ZqBasic q Int64)) -> Ptr Int64 -> IO () foreign import ccall unsafe "tensorCRTC" tensorCRTC ::           Int16 -> Ptr (Complex Double) -> Int64 -> Ptr CPP -> Int16 -> Ptr (Ptr (Complex Double)) -> IO ()

@@ -13,7 +13,7 @@  module Crypto.Lol.Cyclotomic.Tensor.CTensor.Extension ( embedPow', embedDec', embedCRT'-, twacePowDec' -- , twaceCRT'+, twacePowDec', twaceCRT' , coeffs', powBasisPow' , crtSetDec' , backpermute'@@ -32,8 +32,7 @@ import           Data.Maybe import           Data.Reflection      (reify) import qualified Data.Vector          as V-import           Data.Vector.Generic  as G (Vector, generate, length, (!))-import qualified Data.Vector.Storable as SV+import           Data.Vector.Storable as SV import qualified Data.Vector.Unboxed  as U  @@ -42,19 +41,21 @@ -- often much more efficient. -- -- > backpermute <a,b,c,d> <0,3,2,3,1,0> = <a,d,c,d,b,a>-backpermute' :: (Vector v a)-             => U.Vector Int -- ^ @is@ index vector (of length @n@)-             -> v a   -- ^ @xs@ value vector-             -> v a---{-# INLINE backpermute' #-}-backpermute' is v = generate (G.length is) (\i -> v ! (is ! i))+backpermute' :: (Storable a) =>+             U.Vector Int -- ^ @is@ index vector (of length @n@)+             -> Vector a   -- ^ @xs@ value vector+             -> Vector a+{-# INLINABLE backpermute' #-}+backpermute' is v = generate (U.length is) (\i -> v ! (is U.! i)) -embedPow', embedDec' :: (Additive r, Vector v r, m `Divides` m')-                     => Tagged '(m, m') (v r -> v r)+embedPow', embedDec' :: (Additive r, Storable r, m `Divides` m')+                     => Tagged '(m, m') (Vector r -> Vector r)+{-# INLINABLE embedPow' #-}+{-# INLINABLE embedDec' #-} -- | Embeds an vector in the powerful basis of the the mth cyclotomic ring -- to an vector in the powerful basis of the m'th cyclotomic ring when @m | m'@ embedPow' = (\indices arr -> generate (U.length indices) $ \idx ->-  let (j0,j1) = indices ! idx+  let (j0,j1) = indices U.! idx   in if j0 == 0      then arr ! j1      else zero) <$> baseIndicesPow@@ -67,8 +68,8 @@  -- | Embeds an vector in the CRT basis of the the mth cyclotomic ring -- to an vector in the CRT basis of the m'th cyclotomic ring when @m | m'@-embedCRT' :: forall mon m m' v r . (CRTrans mon r, Vector v r, m `Divides` m')-          => TaggedT '(m, m') mon (v r -> v r)+embedCRT' :: forall mon m m' r . (CRTrans mon r, Storable r, m `Divides` m')+          => TaggedT '(m, m') mon (Vector r -> Vector r) embedCRT' =   (lift (proxyT crtInfo (Proxy::Proxy m') :: mon (CRTInfo r))) >>   (pureT $ backpermute' <$> baseIndicesCRT)@@ -76,21 +77,46 @@ -- | maps a vector in the powerful/decoding basis, representing an -- O_m' element, to a vector of arrays representing O_m elements in -- the same type of basis-coeffs' :: (Vector v r, m `Divides` m')-        => Tagged '(m, m') (v r -> [v r])+coeffs' :: (Storable r, m `Divides` m')+        => Tagged '(m, m') (Vector r -> [Vector r]) coeffs' = flip (\x -> V.toList . V.map (`backpermute'` x))           <$> extIndicesCoeffs  -- | 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 v . (Vector v r, m `Divides` m')-             => Tagged '(m, m') (v r -> v r)+twacePowDec' :: forall m m' r . (Storable r, m `Divides` m')+             => Tagged '(m, m') (Vector r -> Vector r)+{-# INLINABLE twacePowDec' #-} twacePowDec' = backpermute' <$> extIndicesPowDec ---- EAC: twaceCRT is defined in CTensor because it needs access to C-backend functions+kronToVec :: forall mon m r . (Monad mon, Fact m, Ring r, Storable r)+  => TaggedT m mon (Kron r) -> TaggedT m mon (Vector r)+kronToVec v = do+  vmat <- v+  let n = proxy totientFact (Proxy::Proxy m)+  return $ generate n (flip (indexK vmat) 0) +twaceCRT' :: forall mon m m' r .+             (Storable r, CRTrans mon r, m `Divides` m')+             => TaggedT '(m, m') mon (Vector r -> Vector r)+{-# INLINE twaceCRT' #-}+twaceCRT' = tagT $ do+  g' <- proxyT (kronToVec gCRTK) (Proxy::Proxy m')+  gInv <- proxyT (kronToVec gInvCRTK) (Proxy::Proxy m)+  embed <- proxyT embedCRT' (Proxy::Proxy '(m,m'))+  indices <- pure $ proxy extIndicesCRT (Proxy::Proxy '(m,m'))+  (_, m'hatinv) <- proxyT crtInfo (Proxy::Proxy m')+  let phi = proxy totientFact (Proxy::Proxy m)+      phi' = proxy totientFact (Proxy::Proxy m')+      mhat = fromIntegral $ proxy valueHatFact (Proxy::Proxy m)+      hatRatioInv = m'hatinv * mhat+      reltot = phi' `div` phi+      -- tweak = mhat * g' / (m'hat * g)+      tweak = SV.map (* hatRatioInv) $ SV.zipWith (*) (embed gInv) g'+  return $ \ arr -> -- take true trace after mul-by-tweak+    let v = backpermute' indices (SV.zipWith (*) tweak arr)+    in generate phi $ \i -> foldl1' (+) $ SV.unsafeSlice (i*reltot) reltot v  -- | The powerful extension basis, wrt the powerful basis. -- Outputs a list of vectors in O_m' that are an O_m basis for O_m'@@ -125,4 +151,4 @@       cosets <- partitionCosets p       return $ LP.map (\is -> generate phi                           (\j -> hinv * trace'-                                      (sum $ LP.map (elt j) is))) cosets+                                      (LP.sum $ LP.map (elt j) is))) cosets

@@ -1,16 +1,7 @@ #ifndef COMMON_H_ #define COMMON_H_ -#include <stdio.h>-#include <stdlib.h> #include "types.h"--#define ASSERT(EXP) { \-  if (!(EXP)) { \-    fprintf (stderr, "Assertion in file '%s' line %d : " #EXP "  is false\n", __FILE__, __LINE__); \-    exit(-1); \-  } \-}  // calculates base ** exp hDim_t ipow(hDim_t base, hShort_t exp);

@@ -336,40 +336,110 @@ template <typename ring> void crtpinv (ring* y, hShort_t tupSize, hDim_t lts, hDim_t rts,                 hDim_t p, hDim_t rustride, ring* ruinv) {-  if(p ==2) {-    // need this case so that we can divide overall by mhat^(-1)-    return;+  hDim_t tensorOffset;+  if(p == 2) {+      return;   }+  else if(p == 3) {+    hDim_t temp1 = rts*2;+    ring ru1 = ruinv[rustride*tupSize];+    ring ru2 = ruinv[(rustride<<1)*tupSize];++    for(hDim_t blockOffset = 0; blockOffset < lts; blockOffset++) {+      hDim_t temp2 = blockOffset*temp1;+      for(hDim_t modOffset = 0; modOffset < rts; modOffset++) {+        tensorOffset = temp2 + modOffset;+        ring y1, y2, shift;+        y1 = y[tensorOffset*tupSize];+        y2 = y[(tensorOffset+rts)*tupSize];++        shift = (ru2*y1) + (ru1*y2);++        y[tensorOffset*tupSize]      +=                 y2  - shift;+        y[(tensorOffset+rts)*tupSize] = (ru1*y1) + (ru2*y2) - shift;+      }+    }+  }+  else if(p == 5) {+    hDim_t temp1 = rts*4;+    ring ru1 = ruinv[rustride*tupSize];+    ring ru2 = ruinv[(rustride<<1)*tupSize];+    ring ru3 = ruinv[(rustride*3)*tupSize];+    ring ru4 = ruinv[(rustride<<2)*tupSize];++    for(hDim_t blockOffset = 0; blockOffset < lts; blockOffset++) {+      hDim_t temp2 = blockOffset*temp1;+      for(hDim_t modOffset = 0; modOffset < rts; modOffset++) {+        tensorOffset = temp2 + modOffset;+        ring y1, y2, y3, y4, shift;+        y1 = y[tensorOffset*tupSize];+        y2 = y[(tensorOffset+rts)*tupSize];+        y3 = y[(tensorOffset+(rts<<1))*tupSize];+        y4 = y[(tensorOffset+3*rts)*tupSize];++        shift = (ru4*y1) + (ru3*y2) + (ru2*y3) + (ru1*y4);++        y[tensorOffset*tupSize]           +=                 y2  +      y3  +      y4  - shift;+        y[(tensorOffset+rts)*tupSize]      = (ru1*y1) + (ru2*y2) + (ru3*y3) + (ru4*y4) - shift;+        y[(tensorOffset+(rts<<1))*tupSize] = (ru2*y1) + (ru4*y2) + (ru1*y3) + (ru3*y4) - shift;+        y[(tensorOffset+rts*3)*tupSize]    = (ru3*y1) + (ru1*y2) + (ru4*y3) + (ru2*y4) - shift;+      }+    }+  }+  else if(p == 7) {+    hDim_t temp1 = rts*6;+    ring ru1 = ruinv[rustride*tupSize];+    ring ru2 = ruinv[(rustride<<1)*tupSize];+    ring ru3 = ruinv[(rustride*3)*tupSize];+    ring ru4 = ruinv[(rustride<<2)*tupSize];+    ring ru5 = ruinv[(rustride*5)*tupSize];+    ring ru6 = ruinv[(rustride*6)*tupSize];+    for(hDim_t blockOffset = 0; blockOffset < lts; blockOffset++) {+      hDim_t temp2 = blockOffset*temp1;+      for(hDim_t modOffset = 0; modOffset < rts; modOffset++) {+        tensorOffset = temp2 + modOffset;+        ring y1, y2, y3, y4, y5, y6, shift;+        y1 = y[tensorOffset*tupSize];+        y2 = y[(tensorOffset+rts)*tupSize];+        y3 = y[(tensorOffset+(rts<<1))*tupSize];+        y4 = y[(tensorOffset+3*rts)*tupSize];+        y5 = y[(tensorOffset+(rts<<2))*tupSize];+        y6 = y[(tensorOffset+rts*5)*tupSize];++        shift = (ru6*y1) + (ru5*y2) + (ru4*y3) + (ru3*y4) + (ru2*y5) + (ru1*y6);++        y[tensorOffset*tupSize]           +=                 y2  +      y3  +      y4  +      y5  +      y6  - shift;+        y[(tensorOffset+rts)*tupSize]      = (ru1*y1) + (ru2*y2) + (ru3*y3) + (ru4*y4) + (ru5*y5) + (ru6*y6) - shift;+        y[(tensorOffset+(rts<<1))*tupSize] = (ru2*y1) + (ru4*y2) + (ru6*y3) + (ru1*y4) + (ru3*y5) + (ru5*y6) - shift;+        y[(tensorOffset+rts*3)*tupSize]    = (ru3*y1) + (ru6*y2) + (ru2*y3) + (ru5*y4) + (ru1*y5) + (ru4*y6) - shift;+        y[(tensorOffset+(rts<<2))*tupSize] = (ru4*y1) + (ru1*y2) + (ru5*y3) + (ru2*y4) + (ru6*y5) + (ru3*y6) - shift;+        y[(tensorOffset+rts*5)*tupSize]    = (ru5*y1) + (ru3*y2) + (ru1*y3) + (ru6*y4) + (ru4*y5) + (ru2*y6) - shift;+      }+    }+  }   else {-    hDim_t tensorOffset,i;     ring* tempSpace = (ring*)malloc((p-1)*sizeof(ring));     hDim_t temp1 = rts*(p-1);     for(hDim_t blockOffset = 0; blockOffset < lts; blockOffset++) {       hDim_t temp2 = blockOffset*temp1;       for(hDim_t modOffset = 0; modOffset < rts; modOffset++) {         tensorOffset = temp2 + modOffset;--        for(i = 0; i < p-1; i++) {-          tempSpace[i] = (int)0;-          int j;-          for(j = 0; j < p-1; j++) {-            int ruIdx = ((j+1)*i) % p;-            tempSpace[i] += (y[(tensorOffset+j*rts)*tupSize] * ruinv[ruIdx*rustride*tupSize]);+        ring shift;+        shift = 0;+        for(hDim_t row = 0; row < p-1; row++) {+          shift += (y[(tensorOffset+row*rts)*tupSize]*ruinv[(p-row-1)*rustride*tupSize]);+          tempSpace[row] = 0;+          for(hDim_t col = 0; col < p-1; col++) {+            tempSpace[row] += (y[(tensorOffset+col*rts)*tupSize]*ruinv[((row*(col+1)) % p)*rustride*tupSize]);           }         } -        ring shift; // can't assign to a constant on the same line(?)-        shift=0;-        for(i = 0; i < p-1; i++) {-          // we were given the inverse rus, so we need to negate the indices-          shift += (y[(tensorOffset+i*rts)*tupSize] * ruinv[rustride*(p-(i+1))*tupSize]);-        }--        for(i = 0; i < p-1; i++) {-          y[(tensorOffset+i*rts)*tupSize] = tempSpace[i] - shift;+        for(hDim_t row = 0; row < p-1; row++) {+          y[(tensorOffset+rts*row)*tupSize] = tempSpace[row] - shift;         }       }     }+    free(tempSpace);   } } 

@@ -99,12 +99,11 @@       }
       ring rp;
       rp = p;
-      ring acc = lastOut / rp;
-      ASSERT ((acc * rp) == lastOut);  // this line asserts that lastOut % p == 0, without calling % operator
+      ring acc = lastOut;
       for (i = p-2; i > 0; --i) {
         hDim_t idx = tensorOffset + i*rts;
         ring tmp = acc;
-        acc -= y[idx*tupSize]; // we already divided acc by p, do not multiply y[idx] by p
+        acc -= y[idx*tupSize]*rp;
         y[idx*tupSize] = tmp;
       }
       y[tensorOffset*tupSize] = acc;
@@ -144,34 +143,120 @@   tensorFuserPrime (y, tupSize, gDec, totm, peArr, sizeOfPE, (hInt_t*)0);
 }
 
-extern "C" void tensorGInvPowR (hShort_t tupSize, hInt_t* y, hDim_t totm, PrimeExponent* peArr, hShort_t sizeOfPE)
+hInt_t oddRad(PrimeExponent* peArr, hShort_t sizeOfPE) {
+  hInt_t oddrad;
+  oddrad = 1;
+  for(int i = 0; i < sizeOfPE; i++) {
+    hShort_t p = peArr[i].prime;
+    if (p != 2) {
+      oddrad *= peArr[i].prime;
+    }
+  }
+  return oddrad;
+}
+
+extern "C" hShort_t tensorGInvPowR (hShort_t tupSize, hInt_t* y, hDim_t totm, PrimeExponent* peArr, hShort_t sizeOfPE)
 {
   tensorFuserPrime (y, tupSize, gInvPow, totm, peArr, sizeOfPE, (hInt_t*)0);
+
+  hInt_t oddrad = oddRad(peArr, sizeOfPE);
+
+  for(int i = 0; i < tupSize*totm; i++) {
+    if (y[i] % oddrad) {
+      y[i] /= oddrad;
+    }
+    else {
+      return 0;
+    }
+  }
+  return 1;
 }
 
-extern "C" void tensorGInvPowRq (hShort_t tupSize, Zq* y, hDim_t totm, PrimeExponent* peArr, hShort_t sizeOfPE, hInt_t* qs)
+extern "C" hShort_t tensorGInvPowRq (hShort_t tupSize, Zq* y, hDim_t totm, PrimeExponent* peArr, hShort_t sizeOfPE, hInt_t* qs)
 {
   tensorFuserPrime (y, tupSize, gInvPow, totm, peArr, sizeOfPE, qs);
+
+  hInt_t oddrad = oddRad(peArr, sizeOfPE);
+
+  for(int i = 0; i < tupSize; i++) {
+    Zq::q = qs[i]; // global update
+    hInt_t ori = reciprocal(Zq::q, oddrad);
+    Zq oddradInv;
+    oddradInv = ori;
+    if (ori == 0) {
+      return 0; // error condition
+    }
+    for(hDim_t j = 0; j < totm; j++) {
+      y[j*tupSize+i] *= oddradInv;
+    }
+  }
+
   canonicalizeZq(y,tupSize,totm,qs);
+  return 1;
 }
 
-extern "C" void tensorGInvPowC (hShort_t tupSize, Complex* y, hDim_t totm, PrimeExponent* peArr, hShort_t sizeOfPE)
+extern "C" hShort_t tensorGInvPowC (hShort_t tupSize, Complex* y, hDim_t totm, PrimeExponent* peArr, hShort_t sizeOfPE)
 {
   tensorFuserPrime (y, tupSize, gInvPow, totm, peArr, sizeOfPE, (hInt_t*)0);
+
+  hInt_t oddrad = oddRad(peArr, sizeOfPE);
+  Complex oddradInv;
+  oddradInv = 1 / oddrad;
+  for(int i = 0; i < tupSize*totm; i++) {
+    y[i] *= oddradInv;
+  }
+  return 1;
 }
 
-extern "C" void tensorGInvDecR (hShort_t tupSize, hInt_t* y, hDim_t totm, PrimeExponent* peArr, hShort_t sizeOfPE)
+extern "C" hShort_t tensorGInvDecR (hShort_t tupSize, hInt_t* y, hDim_t totm, PrimeExponent* peArr, hShort_t sizeOfPE)
 {
   tensorFuserPrime (y, tupSize, gInvDec, totm, peArr, sizeOfPE, (hInt_t*)0);
+
+  hInt_t oddrad = oddRad(peArr, sizeOfPE);
+
+  for(int i = 0; i < tupSize*totm; i++) {
+    if (y[i] % oddrad) {
+      y[i] /= oddrad;
+    }
+    else {
+      return 0;
+    }
+  }
+  return 1;
 }
 
-extern "C" void tensorGInvDecRq (hShort_t tupSize, Zq* y, hDim_t totm, PrimeExponent* peArr, hShort_t sizeOfPE, hInt_t* qs)
+extern "C" hShort_t tensorGInvDecRq (hShort_t tupSize, Zq* y, hDim_t totm, PrimeExponent* peArr, hShort_t sizeOfPE, hInt_t* qs)
 {
   tensorFuserPrime (y, tupSize, gInvDec, totm, peArr, sizeOfPE, qs);
+
+  hInt_t oddrad = oddRad(peArr, sizeOfPE);
+
+  for(int i = 0; i < tupSize; i++) {
+    Zq::q = qs[i]; // global update
+    hInt_t ori = reciprocal(Zq::q, oddrad);
+    Zq oddradInv;
+    oddradInv = ori;
+    if (ori == 0) {
+      return 0; // error condition
+    }
+    for(hDim_t j = 0; j < totm; j++) {
+      y[j*tupSize+i] *= oddradInv;
+    }
+  }
+
   canonicalizeZq(y,tupSize,totm,qs);
+  return 1;
 }
 
-extern "C" void tensorGInvDecC (hShort_t tupSize, Complex* y, hDim_t totm, PrimeExponent* peArr, hShort_t sizeOfPE)
+extern "C" hShort_t tensorGInvDecC (hShort_t tupSize, Complex* y, hDim_t totm, PrimeExponent* peArr, hShort_t sizeOfPE)
 {
   tensorFuserPrime (y, tupSize, gInvDec, totm, peArr, sizeOfPE, (hInt_t*)0);
+
+  hInt_t oddrad = oddRad(peArr, sizeOfPE);
+  Complex oddradInv;
+  oddradInv = 1 / oddrad;
+  for(int i = 0; i < tupSize*totm; i++) {
+    y[i] *= oddradInv;
+  }
+  return 1;
 }

@@ -3,9 +3,9 @@ #include "common.h" #include <math.h> -// this function takes *inverse* RUs, so no negation is needed on the indexing // I had been negating the ru-idx, but this was causing a *negative* mod, resulting in a hard-to-find bug-void primeD (double *y, hShort_t tupSize, hDim_t lts, hDim_t rts, hDim_t p, hDim_t rustride, Complex* ruinv)+// current behavior (taking rus, rather than ruInv) matches RT+void primeD (double *y, hShort_t tupSize, hDim_t lts, hDim_t rts, hDim_t p, hDim_t rustride, Complex* ru) { 	if(p == 2) {     return;@@ -22,10 +22,10 @@       for(row = 0; row < p-1; row++) {         double acc = 0;         for(col = 1; col <= (p>>1); col++) {-          acc += 2 * ruinv[((row*col) % p)*rustride*tupSize].real * y[(tensorOffset+rts*(col-1))*tupSize];+          acc += 2 * ru[((row*col) % p)*rustride*tupSize].real * y[(tensorOffset+rts*(col-1))*tupSize];         }         for(col = (p>>1)+1; col <= p-1; col++) {-          acc += 2 * ruinv[((row*col) % p)*rustride*tupSize].imag * y[(tensorOffset+rts*(col-1))*tupSize];+          acc += 2 * ru[((row*col) % p)*rustride*tupSize].imag * y[(tensorOffset+rts*(col-1))*tupSize];         }         tempSpace[row] = acc/sqrt(2);       }@@ -38,16 +38,16 @@   free(tempSpace); } -void ppD (double *y, hShort_t tupSize, hDim_t lts, hDim_t rts, PrimeExponent pe, Complex *ruinv)+void ppD (double *y, hShort_t tupSize, hDim_t lts, hDim_t rts, PrimeExponent pe, Complex *ru) {   hDim_t p = pe.prime;   hDim_t e = pe.exponent;   hDim_t mprime = ipow(p,e-1);-  primeD (y, tupSize, lts*mprime, rts, p, mprime, ruinv);+  primeD (y, tupSize, lts*mprime, rts, p, mprime, ru); }  //the contents of y will be destroyed, but should be initialized in Haskell-land to independent Guassians over the reals-extern "C" void tensorGaussianDec (hShort_t tupSize, double *y, hDim_t totm, PrimeExponent *peArr, hShort_t sizeOfPE, Complex** ruinv)+extern "C" void tensorGaussianDec (hShort_t tupSize, double *y, hDim_t totm, PrimeExponent *peArr, hShort_t sizeOfPE, Complex** ru) {-	tensorFuserCRT (y, tupSize, ppD, totm, peArr, sizeOfPE, ruinv, (hInt_t*)0);+	tensorFuserCRT (y, tupSize, ppD, totm, peArr, sizeOfPE, ru, (hInt_t*)0); }

@@ -3,6 +3,8 @@ #define TENSORTYPES_H_
 
 #include <inttypes.h>
+#include <stdio.h>
+#include <stdlib.h>
 
 typedef int64_t hInt_t ;
 typedef int32_t hDim_t ;
@@ -11,13 +13,20 @@ 
 typedef struct
 {
-  hDim_t prime;
+  hShort_t prime;
   hShort_t exponent;
 } PrimeExponent;
 
 
 hInt_t reciprocal (hInt_t a, hInt_t b);
 
+#define ASSERT(EXP) { \
+  if (!(EXP)) { \
+    fprintf (stderr, "Assertion in file '%s' line %d : " #EXP "  is false\n", __FILE__, __LINE__); \
+    exit(-1); \
+  } \
+}
+
 //http://stackoverflow.com/questions/37572628
 #ifdef __cplusplus
 //http://stackoverflow.com/a/4421719
@@ -55,14 +64,11 @@   {
     Zq binv;
     binv = reciprocal(q,b.x);
+    ASSERT (binv.x); // binv == 0 indicates that x is not invertible mod q
     *this *= binv;
     return *this;
   }
 };
-inline char operator==(Zq a, const Zq& b)
-{
-  return (a.x == b.x);
-}
 inline Zq operator+(Zq a, const Zq& b)
 {
   a += b;
@@ -129,13 +135,6 @@     return *this;
   }
 };
-inline char operator==(Complex a, const Complex& b)
-{
-  // This is only used in divGDec, where we do a divisiblity check.
-  // The divisibility check should always succeed for Complex since \C is a field,
-  // however if we actually implement equality, it would fail due to roundoff.
-  return 1;
-}
 inline Complex operator+(Complex a, const Complex& b)
 {
   a += b;

@@ -17,7 +17,10 @@     y  = lasty - quotient*y;     lasty = tmp;   }-  ASSERT (a==1);  // if this one fails, then b is not invertible mod a+  // if a!=1, then b is not invertible mod a+  if(a!=1) {+    return 0;+  }    // this actually returns EITHER the reciprocal OR reciprocal + fieldSize   hInt_t res = lasty + fieldSize;

@@ -82,13 +82,13 @@    toProto (RT (Arr xs)) =     let m = fromIntegral $ proxy valueFact (Proxy::Proxy m)-        q = proxy value (Proxy::Proxy q) :: Double+        q = round (proxy value (Proxy::Proxy q) :: Double)     in Kq m q $ S.fromList $ RT.toList $ RT.map lift xs   toProto x@(ZV _) = toProto $ toRT x    fromProto (Kq m' q' xs) =     let m = proxy valueFact (Proxy::Proxy m) :: Int-        q = proxy value (Proxy::Proxy q) :: Double+        q = round (proxy value (Proxy::Proxy q) :: Double)         n = proxy totientFact (Proxy::Proxy m)         xs' = RT.fromList (Z:.n) $ LP.map reduce $ F.toList xs         len = F.length xs@@ -98,7 +98,7 @@             "An error occurred while reading the proto type for RT.\n\             \Expected m=" ++ show m ++ ", got " ++ show m' ++ "\n\             \Expected n=" ++ show n ++ ", got " ++ show len ++ "\n\-            \Expected q=" ++ show (round q :: Int64) ++ ", got " ++ show q' ++ "."+            \Expected q=" ++ show q ++ ", got " ++ show q' ++ "."  instance Eq r => Eq (RT m r) where   (ZV a) == (ZV b) = a == b@@ -183,12 +183,6 @@   fmapT f (RT v) = RT $ (coerce $ force . RT.map f) v   fmapT f v@(ZV _) = fmapT f $ toRT v -  -- Repa arrays don't have mapM, so apply to underlying Unboxed-  -- vector instead-  fmapTM f (RT (Arr arr)) = (RT . Arr . fromUnboxed (extent arr)) <$>-                            U.mapM f (toUnboxed arr)-  fmapTM f v = fmapTM 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) @@ -219,7 +213,6 @@   {-# INLINABLE powBasisPow #-}   {-# INLINABLE crtSetDec #-}   {-# INLINABLE fmapT #-}-  {-# INLINABLE fmapTM #-}   {-# INLINABLE zipWithT #-}   {-# INLINABLE unzipT #-} 

@@ -28,8 +28,8 @@               => mon (r -> Arr m r) {-# INLINABLE scalarCRT' #-} scalarCRT'-  = let pps = proxy ppsFact (Proxy::Proxy m)-        sz = Z :. totientPPs pps+  = 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).

@@ -33,14 +33,14 @@ module Crypto.Lol.Cyclotomic.UCyc ( -- * Data types and constraints-  UCyc, P, D, C, E, UCycEC, UCRTElt, NFElt+  UCyc, P, D, C, E, UCycEC, UCycPC, UCRTElt, NFElt -- * Changing representation , toPow, toDec, toCRT, fmapPow, fmapDec , unzipPow, unzipDec, unzipCRTC, unzipCRTE -- * Scalars , scalarPow, scalarCRT -- * Basic operations-, mulG, divG, gSqNorm+, mulG, divGPow, divGDec, divGCRTC, gSqNorm -- * Error sampling , tGaussian, errorRounded, errorCoset -- * Inter-ring operations and values@@ -49,8 +49,9 @@ , coeffsPow, coeffsDec, powBasis, crtSet ) where -import Crypto.Lol.Cyclotomic.Tensor hiding (embedCRT, embedDec, embedPow,-                                     scalarCRT, scalarPow, twaceCRT)+import Crypto.Lol.Cyclotomic.Tensor hiding (divGDec, divGPow, embedCRT,+                                     embedDec, embedPow, scalarCRT,+                                     scalarPow, twaceCRT)  import           Crypto.Lol.CRTrans import           Crypto.Lol.Cyclotomic.CRTSentinel@@ -91,6 +92,9 @@ -- | Convenient synonym for either CRT representation. type UCycEC t m r = Either (UCyc t m E r) (UCyc t m C r) +-- | Convenient synonym for random sampling.+type UCycPC t m r = Either (UCyc t m P r) (UCyc t m C r)+ -- | Represents a cyclotomic ring such as \(\Z[\zeta_m]\), -- \(\Z_q[\zeta_m]\), and \(\Q(\zeta_m)\) in an explicit -- representation: @t@ is the 'Tensor' type for storing coefficient tensors;@@ -329,6 +333,7 @@              => UCyc t m C (a,b)              -> (Either (UCyc t m P a) (UCyc t m C a),                  Either (UCyc t m P b) (UCyc t m C b))+{-# INLINABLE unzipCRTC #-} unzipCRTC (CRTC s v)   = let (ac,bc) = unzipT v         (ap,bp) = Pow *** Pow $ unzipT $ crtInvCS s v@@ -342,6 +347,7 @@              => UCyc t m E (a,b)              -> (Either (UCyc t m P a) (UCyc t m E a),                  Either (UCyc t m P b) (UCyc t m E b))+{-# INLINABLE unzipCRTE #-} unzipCRTE (CRTE _ v)   = let (ae,be) = unzipT v         (a',b') = unzipT $ fmapT fromExt $ runIdentity crtInv v@@ -352,24 +358,37 @@  -- | Multiply by the special element \(g_m\). mulG :: (Fact m, UCRTElt t r) => UCyc t m rep r -> UCyc t m rep r-{-# INLINABLE mulG #-}+{-# INLINE mulG #-} mulG (Pow v) = Pow $ mulGPow v mulG (Dec v) = Dec $ mulGDec v mulG (CRTC s v) = CRTC s $ mulGCRTCS s v mulG (CRTE s v) = CRTE s $ runIdentity mulGCRT v +-- Note: We do not implement divGCRTE because we can't tell whether+-- the element is actually divisible by g when using the CRT extension+-- basis.+ -- | Divide by the special element \(g_m\). -- WARNING: this implementation is not a constant-time algorithm, so -- information about the argument may be leaked through a timing -- channel.-divG :: (Fact m, UCRTElt t r, ZeroTestable r, IntegralDomain r)-        => UCyc t m rep r -> Maybe (UCyc t m rep r)-{-# INLINABLE divG #-}-divG (Pow v) = Pow <$> divGPow v-divG (Dec v) = Dec <$> divGDec v-divG (CRTC s v) = Just $ CRTC s $ divGCRTCS s v-divG (CRTE s v) = Just $ CRTE s $ runIdentity divGCRT v+divGPow :: (Fact m, UCRTElt t r, ZeroTestable r, IntegralDomain r)+        => UCyc t m P r -> Maybe (UCyc t m P r)+{-# INLINABLE divGPow #-}+divGPow (Pow v) = Pow <$> T.divGPow v +-- | Similar to 'divGPow'.+divGDec :: (Fact m, UCRTElt t r, ZeroTestable r, IntegralDomain r)+        => UCyc t m D r -> Maybe (UCyc t m D r)+{-# INLINABLE divGDec #-}+divGDec (Dec v) = Dec <$> T.divGDec v++-- | Similar to 'divGPow'.+divGCRTC :: (Fact m, UCRTElt t r)+        => UCyc t m C r -> UCyc t m C r+{-# INLINE divGCRTC #-}+divGCRTC (CRTC s v) = CRTC s $ divGCRTCS s v+ -- | 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\) .@@ -467,8 +486,8 @@ -- | Twace into a subring, for the CRT basis.  (The output is an -- 'Either' because the subring might not support 'C'.) twaceCRTC :: (m `Divides` m', UCRTElt t r)-             => UCyc t m' C r -> Either (UCyc t m P r) (UCyc t m C r)-{-# INLINABLE twaceCRTC #-}+             => UCyc t m' C r -> UCycPC t m r+{-# INLINE twaceCRTC #-} twaceCRTC x@(CRTC s' v) =   case crtSentinel of     -- go to CRTC if valid for target, else go to Pow@@ -533,128 +552,6 @@  --------- Conversion methods ------------------ ---- {-# SPECIALIZE toPow :: (Fact m, Reflects q Int64) => UCyc RT m D (ZqBasic q Int64) -> UCyc RT m P (ZqBasic q Int64) #-}--- EAC: I can't specialize toPow due to the constraint synonym TElt. See GHC ticket 12068--- For future reference, it seemed to help in general to simplify constraints as much as possible--- (i.e. replacing (Ring (ZqBasic q z)) with (Ring z, Reflects t z)) and--- removing type synonyms wherever possible.--{--EAC: I tried specializing the function-toPow :: (Fact m, C) for C \subseteq [Tensor t , CRTEmbed r , CRTrans Maybe r , TElt t r , CRTrans Identity (CRTExt r) , TElt t (CRTExt r)]-using-{-# SPECIALIZE toPow :: (Fact m, Reflects q Int64) => UCyc RT m D (ZqBasic q Int64) -> UCyc RT m P (ZqBasic q Int64) #-}--The results for subsets with (Tensor t) were identical to those without (Tensor t), so we ignore (Tensor t) in what follows--There were three outcomes:-1. "Good": no warnings.-2. "NB": Warning: Forall'd constraint ‘Reflects k q Int64’ is not bound in RULE lhs-3. "Bad": Warning: RULE left-hand side too complicated to desugar--BAD:  CRTEmbed r, CRTrans Maybe r, TElt t r, CRTrans Identity (CRTExt r), TElt t (CRTExt r)-BAD:  CRTEmbed r, CRTrans Maybe r, TElt t r, CRTrans Identity (CRTExt r)-BAD:  CRTEmbed r, CRTrans Maybe r, TElt t r,                              TElt t (CRTExt r)-BAD:  CRTEmbed r, CRTrans Maybe r, TElt t r-BAD:  CRTEmbed r, CRTrans Maybe r,           CRTrans Identity (CRTExt r), TElt t (CRTExt r)-good: CRTEmbed r, CRTrans Maybe r,           CRTrans Identity (CRTExt r)-BAD:  CRTEmbed r, CRTrans Maybe r,                                        TElt t (CRTExt r)-good: CRTEmbed r, CRTrans Maybe r-BAD:  CRTEmbed r,                  TElt t r, CRTrans Identity (CRTExt r), TElt t (CRTExt r)-BAD:  CRTEmbed r,                  TElt t r, CRTrans Identity (CRTExt r)-BAD:  CRTEmbed r,                  TElt t r,                              TElt t (CRTExt r)-good: CRTEmbed r,                  TElt t r-BAD:  CRTEmbed r,                            CRTrans Identity (CRTExt r), TElt t (CRTExt r)-good: CRTEmbed r,                            CRTrans Identity (CRTExt r)-good: CRTEmbed r,                                                         TElt t (CRTExt r)-good: CRTEmbed r-BAD:              CRTrans Maybe r, TElt t r, CRTrans Identity (CRTExt r), TElt t (CRTExt r)-good:             CRTrans Maybe r, TElt t r, CRTrans Identity (CRTExt r)-BAD:              CRTrans Maybe r, TElt t r,                              TElt t (CRTExt r)-good:             CRTrans Maybe r, TElt t r-good:             CRTrans Maybe r,           CRTrans Identity (CRTExt r), TElt t (CRTExt r)-good:             CRTrans Maybe r,           CRTrans Identity (CRTExt r)-good:             CRTrans Maybe r,                                        TElt t (CRTExt r)-good:             CRTrans Maybe r-NB:                                TElt t r, CRTrans Identity (CRTExt r), TElt t (CRTExt r)-NB:                                TElt t r, CRTrans Identity (CRTExt r)-NB:                                TElt t r,                              TElt t (CRTExt r)-NB:                                TElt t r-NB:                                          CRTrans Identity (CRTExt r), TElt t (CRTExt r)-NB:                                          CRTrans Identity (CRTExt r)-NB:                                                                       TElt t (CRTExt r)-NB:--Assigning variables to constraints as follows,--A=CRTEmbed r-B=CRTrans Maybe r-C=TElt t r-D=CRTrans Identity (CRTExt r)-E=TElt t (CRTExt r)--using outcome values--BAD=0-NB=0-GOOD=1--the formula for results is--y=(-A)*B*(-C) + (-A)*B*(-E) + A*(-C)*(-E) + A*(-B)*(-C)*(-D) + A*(-B)*(-D)*(-E)--Below this line, I've reordered the subsets into logical groups.---- always nb if we don't have either of (CRTEmbed r) or (CRTrans Maybe r)--- I think this error makes sense: type families aren't injective, so references--- to TElt and CRTExt may not refer to 'r' on their RHS.-NB:                                TElt t r, CRTrans Identity (CRTExt r), TElt t (CRTExt r)-NB:                                TElt t r, CRTrans Identity (CRTExt r)-NB:                                TElt t r,                              TElt t (CRTExt r)-NB:                                TElt t r-NB:                                          CRTrans Identity (CRTExt r), TElt t (CRTExt r)-NB:                                          CRTrans Identity (CRTExt r)-NB:                                                                       TElt t (CRTExt r)-NB:---- always bad if we have both TElt constraints.-BAD:  CRTEmbed r, CRTrans Maybe r, TElt t r,                              TElt t (CRTExt r)-BAD:  CRTEmbed r, CRTrans Maybe r, TElt t r, CRTrans Identity (CRTExt r), TElt t (CRTExt r)-BAD:  CRTEmbed r,                  TElt t r, CRTrans Identity (CRTExt r), TElt t (CRTExt r)-BAD:              CRTrans Maybe r, TElt t r, CRTrans Identity (CRTExt r), TElt t (CRTExt r)-BAD:  CRTEmbed r,                  TElt t r,                              TElt t (CRTExt r)-BAD:              CRTrans Maybe r, TElt t r,                              TElt t (CRTExt r)---- always good if we don't have either TElt constraint.-good: CRTEmbed r, CRTrans Maybe r-good: CRTEmbed r, CRTrans Maybe r,           CRTrans Identity (CRTExt r)-good: CRTEmbed r,                            CRTrans Identity (CRTExt r)-good:             CRTrans Maybe r,           CRTrans Identity (CRTExt r)-good: CRTEmbed r-good:             CRTrans Maybe r---- bad if we have both (CRTEmbed r) and (CRTrans Maybe r) with at least one of the TElt constraints-BAD:  CRTEmbed r, CRTrans Maybe r, TElt t r, CRTrans Identity (CRTExt r)-BAD:  CRTEmbed r, CRTrans Maybe r, TElt t r-BAD:  CRTEmbed r, CRTrans Maybe r,           CRTrans Identity (CRTExt r), TElt t (CRTExt r)-BAD:  CRTEmbed r, CRTrans Maybe r,                                        TElt t (CRTExt r)---- a few more good cases: symmetric for (CRTEmbed r)  and (CRTrans Maybe r)-good: CRTEmbed r,                  TElt t r-good:             CRTrans Maybe r, TElt t r-good: CRTEmbed r,                                                         TElt t (CRTExt r)-good:             CRTrans Maybe r,                                        TElt t (CRTExt r)---- strange cases: works for (CRTrans Maybe r), fails for (CRTEmbed r)---   removing the (Ring (CRTExt r)) superclass constraint from CRTEmbed makes all four of these work.---   (but doesn't change the behavior of other failing cases)-BAD:  CRTEmbed r,                  TElt t r, CRTrans Identity (CRTExt r)-good:             CRTrans Maybe r, TElt t r, CRTrans Identity (CRTExt r)-BAD:  CRTEmbed r,                            CRTrans Identity (CRTExt r), TElt t (CRTExt r)-good:             CRTrans Maybe r,           CRTrans Identity (CRTExt r), TElt t (CRTExt r)---} -- | Convert to powerful-basis representation. toPow :: (Fact m, UCRTElt t r) => UCyc t m rep r -> UCyc t m P r {-# INLINABLE toPow #-}@@ -771,7 +668,7 @@   randomR _ = error "randomR non-sensical for UCyc"  instance (Random r, UCRTElt t r, Fact m)-         => Random (Either (UCyc t m P r) (UCyc t m C r)) where+         => Random (UCycPC t m r) where    -- create in CRTC basis if possible, otherwise in powerful   random = let cons = case crtSentinel of

@@ -13,14 +13,14 @@ module Crypto.Lol.FactoredDefs ( -- * Factored natural numbers-  reifyFact, reifyFactI-, Factored, SFactored, Fact, fType, fDec+  Factored, SFactored, Fact, fType, fDec+, reifyFact, reifyFactI, intToFact -- * Prime powers-, reifyPPow, reifyPPowI , PrimePower, SPrimePower, Sing(SPP), PPow, ppType, ppDec+, reifyPPow, reifyPPowI -- * Primes-, reifyPrime, reifyPrimeI , PrimeBin, SPrimeBin, Prime, pType, pDec+, reifyPrime, reifyPrimeI, valueP -- * Constructors , pToPP, sPToPP, PToPP, ppToF, sPpToF, PpToF, pToF, sPToF, PToF -- * Unwrappers@@ -32,17 +32,18 @@ , fOddRadical, FOddRadical , pFree, PFree -- * Convenient reflections-, ppsFact, valueFact, totientFact, valueHatFact, radicalFact, oddRadicalFact-, ppPPow, primePPow, exponentPPow, valuePPow, totientPPow+, ppsFact, valueFact, totientFact, radicalFact, oddRadicalFact, valueHatFact+, ppPPow, primePPow, exponentPPow, valuePPow, totientPPow, radicalPPow, oddRadicalPPow, valueHatPPow , valuePrime+-- * Data-level equivalents of reflections for 'Factored' data+, valueF, totientF, radicalF, oddRadicalF, valueHatF -- * Number-theoretic laws , transDivides, gcdDivides, lcmDivides, lcm2Divides , pSplitTheorems, pFreeDivides , (\\) -- re-export from Data.Constraint for convenience -- * Utility operations on prime powers , valueHat-, PP, ppToPP, valuePP, totientPP, radicalPP, oddRadicalPP-, valuePPs, totientPPs, radicalPPs, oddRadicalPPs+, PP, ppToPP, valuePP, totientPP, radicalPP, oddRadicalPP, valueHatPP -- * Re-export , module Crypto.Lol.PosBin ) where@@ -329,34 +330,51 @@ -- | Type synonym for @(prime, exponent)@ pair. type PP = (Int, Int) +-- | Conversion.+ppToPP :: PrimePower -> PP+ppToPP = (binToInt . unP *** posToInt) . unPP++-- | Reflect a 'PrimePower' type to a 'PP' value.+ppPPow :: forall pp . PPow pp => Tagged pp PP+ppPPow = tag $ ppToPP $ fromSing (sing :: SPrimePower pp)+ -- | Value-level prime-power factorization tagged by a 'Factored' type. ppsFact :: forall m . Fact m => Tagged m [PP] ppsFact = tag $ map ppToPP $ unF $ fromSing (sing :: SFactored m) -valueFact, totientFact, valueHatFact, radicalFact, oddRadicalFact ::-  Fact m => Tagged m Int+-- | The value of a 'PrimeBin' type.+valuePrime :: forall p . Prime p => Tagged p Int+valuePrime = tag $ binToInt $ unP $ fromSing (sing :: SPrimeBin p) ++valueFact, totientFact, radicalFact, oddRadicalFact, valueHatFact ::+  Fact m => Tagged m Int -- | The value of a 'Factored' type. valueFact = valuePPs <$> ppsFact- -- | The totient of a 'Factored' type's value. totientFact = totientPPs <$> ppsFact- -- | The "hat" of a 'Factored' type's value: -- \( \hat{m} = \begin{cases} m & \mbox{if } m \text{ is odd} \\ m/2 & \text{otherwise} \end{cases} \). valueHatFact = valueHat <$> valueFact- -- | The radical (product of prime divisors) of a 'Factored' type. radicalFact = radicalPPs <$> ppsFact- -- | The odd radical (product of odd prime divisors) of a 'Factored' type. oddRadicalFact = oddRadicalPPs <$> ppsFact --- | Reflect a 'PrimePower' type to a 'PP' value.-ppPPow :: forall pp . PPow pp => Tagged pp PP-ppPPow = tag $ ppToPP $ fromSing (sing :: SPrimePower pp)+valueF, totientF, radicalF, oddRadicalF, valueHatF :: Factored -> Int+-- | The value of a 'Factored'.+valueF = valuePPs . map ppToPP . unF+-- | Totient of a 'Factored'.+totientF = totientPPs . map ppToPP . unF+-- | The hat of a 'Factored'.+valueHatF = valueHat . valueF+-- | The radical of a 'Factored'.+radicalF = radicalPPs . map ppToPP . unF+-- | The odd radical of a 'Factored'.+oddRadicalF = oddRadicalPPs . map ppToPP . unF -primePPow, exponentPPow, valuePPow, totientPPow :: PPow pp => Tagged pp Int+primePPow, exponentPPow, valuePPow, totientPPow, radicalPPow, oddRadicalPPow, valueHatPPow ::+  PPow pp => Tagged pp Int -- | Reflect the prime component of a 'PrimePower' type. primePPow = fst <$> ppPPow -- | Reflect the exponent component of a 'PrimePower' type.@@ -365,46 +383,50 @@ valuePPow = valuePP <$> ppPPow -- | The totient of a 'PrimePower' type's value. totientPPow = totientPP <$> ppPPow---- | The value of a 'PrimeBin' type.-valuePrime :: forall p . Prime p => Tagged p Int-valuePrime = tag $ binToInt $ unP $ fromSing (sing :: SPrimeBin p)---- | Return \( m \) if \( m \) is odd, and \( m/2 \) otherwise.-valueHat :: Integral i => i -> i-valueHat m = if m `mod` 2 == 0 then m `div` 2 else m+-- | The "hat" of a 'PrimePower' type's value:+-- \( p^e \) if \( p \) is odd, \( 2^{e-1} \) otherwise.+valueHatPPow = valueHat <$> valuePPow+-- | The radical of a 'PrimePower' type's value.+radicalPPow = radicalPP <$> ppPPow+-- | The odd radical of a 'PrimePower' type's value.+oddRadicalPPow = oddRadicalPP <$> ppPPow --- | Conversion.-ppToPP :: PrimePower -> PP-ppToPP = (binToInt . unP *** posToInt) . unPP+-- functions on data-level [PP]+valuePPs, totientPPs, radicalPPs, oddRadicalPPs :: [PP] -> Int+-- | Product of values of individual 'PP's+valuePPs = product . map valuePP+-- | Product of totients of individual 'PP's+totientPPs = product . map totientPP+-- | Product of radicals of individual 'PP's+radicalPPs = product . map radicalPP+-- | Product of odd radicals of individual 'PP's+oddRadicalPPs = product . map oddRadicalPP -valuePP, totientPP, radicalPP, oddRadicalPP :: PP -> Int+-- functions on data-level PP+valuePP, totientPP, radicalPP, oddRadicalPP, valueHatPP :: PP -> Int -- | The value of a prime power. valuePP (p,e) = p^e- -- | Totient of a prime power. totientPP (_,0) = 1 totientPP (p,e) = (p-1)*(p^(e-1))-+-- | The "hat" of a prime power: \( p^e \) if \( p \) is odd, \( 2^{e-1} \)+-- otherwise.+valueHatPP = valueHat . valuePP -- | The radical of a prime power. radicalPP (_,0) = 1 radicalPP (p,_) = p- -- | The odd radical of a prime power. oddRadicalPP (2,_) = 1 oddRadicalPP (p,_) = p -valuePPs, totientPPs, radicalPPs, oddRadicalPPs :: [PP] -> Int--- | Product of values of individual 'PP's-valuePPs = product . map valuePP--- | Product of totients of individual 'PP's-totientPPs = product . map totientPP--- | Product of radicals of individual 'PP's-radicalPPs = product . map radicalPP--- | Product of odd radicals of individual 'PP's-oddRadicalPPs = product . map oddRadicalPP+valueP :: PrimeBin -> Int+valueP (P p) = binToInt p +-- | Return \( m \) if \( m \) is odd, and \( m/2 \) otherwise.+valueHat :: Integral i => i -> i+valueHat m = if m `mod` 2 == 0 then m `div` 2 else m + -- | Template Haskell splice for the 'PrimeBin' type corresponding to a -- given positive prime integer.  (Uses 'prime' to enforce primality -- of the base, so should only be used on small-to-moderate-sized@@ -449,6 +471,12 @@ fDec :: Int -> DecQ fDec n = tySynD (mkName $ 'F' : show n) [] $ fType n +intToFact :: Int -> Factored+intToFact m =+  let fcts = factorize m+      fcts' = map (\(p,e) -> PP (P $ intToBin p, intToPos e)) fcts+  in F fcts'+ -- | Factorize a positive integer into an ordered list of its prime -- divisors, with possible duplicates.  First argument is infinite -- list of primes left to consider.@@ -465,4 +493,3 @@ -- pairs, in strictly increasing order by prime. factorize :: Int -> [(Int,Int)] factorize = map (head &&& length) . group . factorize' primes-

@@ -18,7 +18,7 @@ -- @svar = true variance * (2*pi)@. See -- <http://www.alpheratz.net/murison/Maple/GaussianDistribution/GaussianDistribution.pdf -- this link> for details.-+{-# INLINABLE realGaussian #-} realGaussian :: forall v q m .                 (ToRational v, OrdFloat q, Random q, MonadRandom m)                 => v -> m (q,q)@@ -44,6 +44,7 @@ realGaussians ::     (ToRational svar, OrdFloat i, Random i, V.Vector v i, MonadRandom m)     => svar -> Int -> m (v i)+{-# INLINABLE realGaussians #-} realGaussians var n     | odd n = V.tail <$> realGaussians var (n+1) -- O(1) tail     | otherwise = (V.fromList . uncurry (++) . unzip) <$>@@ -59,11 +60,13 @@ -- | Execute an action repeatedly until its result fails to satisfy a predicate, -- and return that result (discarding all others). iterateWhile :: (Monad m) => (a -> Bool) -> m a -> m a+{-# INLINE iterateWhile #-} iterateWhile p x = x >>= iterateUntilM (not . p) (const x)  -- | Analogue of @('Prelude.until')@ -- Yields the result of applying f until p holds. iterateUntilM :: (Monad m) => (a -> Bool) -> (a -> m a) -> a -> m a+{-# INLINE iterateUntilM #-} iterateUntilM p f v     | p v       = return v     | otherwise = f v >>= iterateUntilM p f

@@ -12,15 +12,13 @@  module Crypto.Lol.PosBinDefs ( -- * Positive naturals in Peano representation-  Pos(..), Sing(SO, SS), SPos, PosC-, posToInt, addPos, sAddPos, AddPos, subPos, sSubPos, SubPos-, reifyPos, reifyPosI-, posType, posDec+  Pos(..), Sing(SO, SS), SPos, PosC, posType, posDec+, reifyPos, reifyPosI, posToInt, intToPos+, addPos, sAddPos, AddPos, subPos, sSubPos, SubPos , OSym0, SSym0, SSym1, AddPosSym0, AddPosSym1, SubPosSym0, SubPosSym1   -- * Positive naturals in binary representation-, Bin(..), Sing(SB1, SD0, SD1), SBin, BinC-, reifyBin, reifyBinI-, binToInt, binType, binDec+, Bin(..), Sing(SB1, SD0, SD1), SBin, BinC, binType, binDec+, reifyBin, reifyBinI, binToInt, intToBin , B1Sym0, D0Sym0, D0Sym1, D1Sym0, D1Sym1   -- * Miscellaneous , intDec, primes, prime@@ -60,6 +58,7 @@ -- not promotable due to numeric output  -- | Convert a 'Pos' to an integral type.+{-# INLINABLE posToInt #-} posToInt :: ToInteger.C z => Pos -> z posToInt O = one posToInt (S a) = one + posToInt a@@ -90,11 +89,26 @@             |] +-- | Convert an integral type to a 'Pos'.+intToPos :: ToInteger.C z => z -> Pos+intToPos 1 = O+intToPos x | x > 0 = S $ intToPos $ x-1+intToPos _ = error "cannot convert non-positive value to a Pos"+ -- | Convert a 'Bin' to an integral type.+{-# INLINABLE binToInt #-} binToInt :: ToInteger.C z => Bin -> z binToInt B1 = one binToInt (D0 a) = 2 * binToInt a binToInt (D1 a) = 1 + 2 * binToInt a++-- | Convert an integral type to a 'Bin'.+intToBin :: ToInteger.C z => z -> Bin+intToBin 1 = B1+intToBin x | x > 0 =+  case even x of+    True -> D0 $ intToBin $ x `div` 2+    False -> D1 $ intToBin $ x `div` 2  -- | Kind-restricted synonym for 'SingI'. type PosC (p :: Pos) = SingI p

@@ -39,7 +39,7 @@  -- | The 'gSqNorm' of the error term of an RLWE sample, given the -- purported secret.-errorGSqNorm :: (RLWECtx t m zq, Ring (LiftOf zq))+errorGSqNorm :: (RLWECtx t m zq)                 => Cyc t m zq -> Sample t m zq -> LiftOf zq {-# INLINABLE errorGSqNorm #-} errorGSqNorm s = gSqNorm . errorTerm s

@@ -39,10 +39,12 @@  import Math.NumberTheory.Primes.Factorisation -import           Control.Applicative hiding ((*>))+import           Control.Applicative  hiding ((*>)) import           Control.DeepSeq import           Control.Monad-import qualified Data.Vector         as V+import           Control.Monad.Random (liftRand, runRand)+import qualified Data.Vector          as V+import           System.Random  --import qualified Debug.Trace as DT @@ -61,9 +63,16 @@ type GFCtx fp d = (PrimeField fp, Reflects d Int)  instance (GFCtx fp d) => Enumerable (GF fp d) where-  values = GF <$> fromCoeffs <$>+  values = GF . fromCoeffs <$>            -- d-fold cartesian product of Fp values            replicateM (proxy value (Proxy::Proxy d)) values++instance (Random fp, Reflects d Int) => Random (GF fp d) where+  random = let d = proxy value (Proxy::Proxy d)+           in runRand $ (GF . fromCoeffs) <$> replicateM d (liftRand random)+  {-# INLINABLE random #-}++  randomR _ = error "randomR non-sensical for GF"  instance (GFCtx fp d) => Ring.C (GF fp d) where 

@@ -33,3 +33,6 @@    split (CryptoRand g) =     either (error . show) (CryptoRand *** CryptoRand) $ splitGen g++  {-# INLINABLE next #-}+  {-# INLINABLE split #-}

@@ -15,6 +15,7 @@ 
 module Crypto.Lol.Types.ZqBasic
 ( ZqBasic -- export the type, but not the constructor (for safety)
+, goodQs
 ) where
 
 import Crypto.Lol.CRTrans
@@ -53,6 +54,12 @@ import qualified Algebra.Ring           as Ring (C)
 import qualified Algebra.ZeroTestable   as ZeroTestable (C)
 
+-- an infinite list of primes greater than the input and congruent to
+-- 1 mod m
+goodQs :: (IntegralDomain a, ToInteger a) => a -> a -> [a]
+goodQs m lower = filter (isPrime . toInteger) $
+  iterate (+m) $ lower + ((m-lower) `mod` m) + 1
+
 -- | The ring \(\Z_q\) of integers modulo 'q', using underlying integer
 -- type 'z'.
 newtype ZqBasic q z = ZqB z
@@ -301,6 +308,7 @@                     in (ZqB x, g')
 
   randomR _ = error "randomR non-sensical for Zq types"
+  {-# INLINABLE random #-}
 
 -- instance of Arbitrary
 instance (Reflects q z, ToInteger z, Random z) => Arbitrary (ZqBasic q z) where

@@ -14,10 +14,10 @@ protoInfo :: ProtoInfo protoInfo  = Prelude'.read-    "ProtoInfo {protoMod = ProtoName {protobufName = FIName \".RLWE\", haskellPrefix = [MName \"Crypto\",MName \"Proto\"], parentModule = [], baseName = MName \"RLWE\"}, protoFilePath = [\"Crypto\",\"Proto\",\"RLWE.hs\"], protoSource = \"RLWE.proto\", extensionKeys = fromList [], messages = [DescriptorInfo {descName = ProtoName {protobufName = FIName \".RLWE.SampleCont\", haskellPrefix = [MName \"Crypto\",MName \"Proto\"], parentModule = [MName \"RLWE\"], baseName = MName \"SampleCont\"}, descFilePath = [\"Crypto\",\"Proto\",\"RLWE\",\"SampleCont.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".RLWE.SampleCont.a\", haskellPrefix' = [MName \"Crypto\",MName \"Proto\"], parentModule' = [MName \"RLWE\",MName \"SampleCont\"], baseName' = FName \"a\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".RLWE.Rq\", haskellPrefix = [MName \"Crypto\",MName \"Proto\"], parentModule = [MName \"RLWE\"], baseName = MName \"Rq\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".RLWE.SampleCont.b\", haskellPrefix' = [MName \"Crypto\",MName \"Proto\"], parentModule' = [MName \"RLWE\",MName \"SampleCont\"], baseName' = FName \"b\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 18}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".RLWE.Kq\", haskellPrefix = [MName \"Crypto\",MName \"Proto\"], parentModule = [MName \"RLWE\"], baseName = MName \"Kq\"}), hsRawDefault = Nothing, hsDefault = Nothing}], descOneofs = fromList [], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False, makeLenses = False},DescriptorInfo {descName = ProtoName {protobufName = FIName \".RLWE.SampleDisc\", haskellPrefix = [MName \"Crypto\",MName \"Proto\"], parentModule = [MName \"RLWE\"], baseName = MName \"SampleDisc\"}, descFilePath = [\"Crypto\",\"Proto\",\"RLWE\",\"SampleDisc.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".RLWE.SampleDisc.a\", haskellPrefix' = [MName \"Crypto\",MName \"Proto\"], parentModule' = [MName \"RLWE\",MName \"SampleDisc\"], baseName' = FName \"a\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".RLWE.Rq\", haskellPrefix = [MName \"Crypto\",MName \"Proto\"], parentModule = [MName \"RLWE\"], baseName = MName \"Rq\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".RLWE.SampleDisc.b\", haskellPrefix' = [MName \"Crypto\",MName \"Proto\"], parentModule' = [MName \"RLWE\",MName \"SampleDisc\"], baseName' = FName \"b\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 18}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".RLWE.Rq\", haskellPrefix = [MName \"Crypto\",MName \"Proto\"], parentModule = [MName \"RLWE\"], baseName = MName \"Rq\"}), hsRawDefault = Nothing, hsDefault = Nothing}], descOneofs = fromList [], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False, makeLenses = False},DescriptorInfo {descName = ProtoName {protobufName = FIName \".RLWE.SampleRLWR\", haskellPrefix = [MName \"Crypto\",MName \"Proto\"], parentModule = [MName \"RLWE\"], baseName = MName \"SampleRLWR\"}, descFilePath = [\"Crypto\",\"Proto\",\"RLWE\",\"SampleRLWR.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".RLWE.SampleRLWR.a\", haskellPrefix' = [MName \"Crypto\",MName \"Proto\"], parentModule' = [MName \"RLWE\",MName \"SampleRLWR\"], baseName' = FName \"a\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".RLWE.Rq\", haskellPrefix = [MName \"Crypto\",MName \"Proto\"], parentModule = [MName \"RLWE\"], baseName = MName \"Rq\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".RLWE.SampleRLWR.b\", haskellPrefix' = [MName \"Crypto\",MName \"Proto\"], parentModule' = [MName \"RLWE\",MName \"SampleRLWR\"], baseName' = FName \"b\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 18}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".RLWE.Rq\", haskellPrefix = [MName \"Crypto\",MName \"Proto\"], parentModule = [MName \"RLWE\"], baseName = MName \"Rq\"}), hsRawDefault = Nothing, hsDefault = Nothing}], descOneofs = fromList [], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False, makeLenses = False},DescriptorInfo {descName = ProtoName {protobufName = FIName \".RLWE.Rq\", haskellPrefix = [MName \"Crypto\",MName \"Proto\"], parentModule = [MName \"RLWE\"], baseName = MName \"Rq\"}, descFilePath = [\"Crypto\",\"Proto\",\"RLWE\",\"Rq.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".RLWE.Rq.m\", haskellPrefix' = [MName \"Crypto\",MName \"Proto\"], parentModule' = [MName \"RLWE\",MName \"Rq\"], baseName' = FName \"m\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 8}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 13}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".RLWE.Rq.q\", haskellPrefix' = [MName \"Crypto\",MName \"Proto\"], parentModule' = [MName \"RLWE\",MName \"Rq\"], baseName' = FName \"q\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 16}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 4}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".RLWE.Rq.xs\", haskellPrefix' = [MName \"Crypto\",MName \"Proto\"], parentModule' = [MName \"RLWE\",MName \"Rq\"], baseName' = FName \"xs\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 3}, wireTag = WireTag {getWireTag = 24}, packedTag = Just (WireTag {getWireTag = 24},WireTag {getWireTag = 26}), wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = True, mightPack = True, typeCode = FieldType {getFieldType = 18}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing}], descOneofs = fromList [], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False, makeLenses = False},DescriptorInfo {descName = ProtoName {protobufName = FIName \".RLWE.Kq\", haskellPrefix = [MName \"Crypto\",MName \"Proto\"], parentModule = [MName \"RLWE\"], baseName = MName \"Kq\"}, descFilePath = [\"Crypto\",\"Proto\",\"RLWE\",\"Kq.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".RLWE.Kq.m\", haskellPrefix' = [MName \"Crypto\",MName \"Proto\"], parentModule' = [MName \"RLWE\",MName \"Kq\"], baseName' = FName \"m\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 8}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 13}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".RLWE.Kq.q\", haskellPrefix' = [MName \"Crypto\",MName \"Proto\"], parentModule' = [MName \"RLWE\",MName \"Kq\"], baseName' = FName \"q\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 17}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 1}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".RLWE.Kq.xs\", haskellPrefix' = [MName \"Crypto\",MName \"Proto\"], parentModule' = [MName \"RLWE\",MName \"Kq\"], baseName' = FName \"xs\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 3}, wireTag = WireTag {getWireTag = 25}, packedTag = Just (WireTag {getWireTag = 25},WireTag {getWireTag = 26}), wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = True, mightPack = True, typeCode = FieldType {getFieldType = 1}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing}], descOneofs = fromList [], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False, makeLenses = False}], enums = [], oneofs = [], knownKeyMap = fromList []}"+    "ProtoInfo {protoMod = ProtoName {protobufName = FIName \".RLWE\", haskellPrefix = [MName \"Crypto\",MName \"Proto\"], parentModule = [], baseName = MName \"RLWE\"}, protoFilePath = [\"Crypto\",\"Proto\",\"RLWE.hs\"], protoSource = \"RLWE.proto\", extensionKeys = fromList [], messages = [DescriptorInfo {descName = ProtoName {protobufName = FIName \".RLWE.SampleCont\", haskellPrefix = [MName \"Crypto\",MName \"Proto\"], parentModule = [MName \"RLWE\"], baseName = MName \"SampleCont\"}, descFilePath = [\"Crypto\",\"Proto\",\"RLWE\",\"SampleCont.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".RLWE.SampleCont.a\", haskellPrefix' = [MName \"Crypto\",MName \"Proto\"], parentModule' = [MName \"RLWE\",MName \"SampleCont\"], baseName' = FName \"a\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".RLWE.Rq\", haskellPrefix = [MName \"Crypto\",MName \"Proto\"], parentModule = [MName \"RLWE\"], baseName = MName \"Rq\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".RLWE.SampleCont.b\", haskellPrefix' = [MName \"Crypto\",MName \"Proto\"], parentModule' = [MName \"RLWE\",MName \"SampleCont\"], baseName' = FName \"b\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 18}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".RLWE.Kq\", haskellPrefix = [MName \"Crypto\",MName \"Proto\"], parentModule = [MName \"RLWE\"], baseName = MName \"Kq\"}), hsRawDefault = Nothing, hsDefault = Nothing}], descOneofs = fromList [], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False, makeLenses = False},DescriptorInfo {descName = ProtoName {protobufName = FIName \".RLWE.SampleDisc\", haskellPrefix = [MName \"Crypto\",MName \"Proto\"], parentModule = [MName \"RLWE\"], baseName = MName \"SampleDisc\"}, descFilePath = [\"Crypto\",\"Proto\",\"RLWE\",\"SampleDisc.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".RLWE.SampleDisc.a\", haskellPrefix' = [MName \"Crypto\",MName \"Proto\"], parentModule' = [MName \"RLWE\",MName \"SampleDisc\"], baseName' = FName \"a\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".RLWE.Rq\", haskellPrefix = [MName \"Crypto\",MName \"Proto\"], parentModule = [MName \"RLWE\"], baseName = MName \"Rq\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".RLWE.SampleDisc.b\", haskellPrefix' = [MName \"Crypto\",MName \"Proto\"], parentModule' = [MName \"RLWE\",MName \"SampleDisc\"], baseName' = FName \"b\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 18}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".RLWE.Rq\", haskellPrefix = [MName \"Crypto\",MName \"Proto\"], parentModule = [MName \"RLWE\"], baseName = MName \"Rq\"}), hsRawDefault = Nothing, hsDefault = Nothing}], descOneofs = fromList [], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False, makeLenses = False},DescriptorInfo {descName = ProtoName {protobufName = FIName \".RLWE.SampleRLWR\", haskellPrefix = [MName \"Crypto\",MName \"Proto\"], parentModule = [MName \"RLWE\"], baseName = MName \"SampleRLWR\"}, descFilePath = [\"Crypto\",\"Proto\",\"RLWE\",\"SampleRLWR.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".RLWE.SampleRLWR.a\", haskellPrefix' = [MName \"Crypto\",MName \"Proto\"], parentModule' = [MName \"RLWE\",MName \"SampleRLWR\"], baseName' = FName \"a\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".RLWE.Rq\", haskellPrefix = [MName \"Crypto\",MName \"Proto\"], parentModule = [MName \"RLWE\"], baseName = MName \"Rq\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".RLWE.SampleRLWR.b\", haskellPrefix' = [MName \"Crypto\",MName \"Proto\"], parentModule' = [MName \"RLWE\",MName \"SampleRLWR\"], baseName' = FName \"b\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 18}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".RLWE.Rq\", haskellPrefix = [MName \"Crypto\",MName \"Proto\"], parentModule = [MName \"RLWE\"], baseName = MName \"Rq\"}), hsRawDefault = Nothing, hsDefault = Nothing}], descOneofs = fromList [], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False, makeLenses = False},DescriptorInfo {descName = ProtoName {protobufName = FIName \".RLWE.Rq\", haskellPrefix = [MName \"Crypto\",MName \"Proto\"], parentModule = [MName \"RLWE\"], baseName = MName \"Rq\"}, descFilePath = [\"Crypto\",\"Proto\",\"RLWE\",\"Rq.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".RLWE.Rq.m\", haskellPrefix' = [MName \"Crypto\",MName \"Proto\"], parentModule' = [MName \"RLWE\",MName \"Rq\"], baseName' = FName \"m\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 8}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 13}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".RLWE.Rq.q\", haskellPrefix' = [MName \"Crypto\",MName \"Proto\"], parentModule' = [MName \"RLWE\",MName \"Rq\"], baseName' = FName \"q\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 16}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 4}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".RLWE.Rq.xs\", haskellPrefix' = [MName \"Crypto\",MName \"Proto\"], parentModule' = [MName \"RLWE\",MName \"Rq\"], baseName' = FName \"xs\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 3}, wireTag = WireTag {getWireTag = 24}, packedTag = Just (WireTag {getWireTag = 24},WireTag {getWireTag = 26}), wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = True, mightPack = True, typeCode = FieldType {getFieldType = 18}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing}], descOneofs = fromList [], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False, makeLenses = False},DescriptorInfo {descName = ProtoName {protobufName = FIName \".RLWE.Kq\", haskellPrefix = [MName \"Crypto\",MName \"Proto\"], parentModule = [MName \"RLWE\"], baseName = MName \"Kq\"}, descFilePath = [\"Crypto\",\"Proto\",\"RLWE\",\"Kq.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".RLWE.Kq.m\", haskellPrefix' = [MName \"Crypto\",MName \"Proto\"], parentModule' = [MName \"RLWE\",MName \"Kq\"], baseName' = FName \"m\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 8}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 13}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".RLWE.Kq.q\", haskellPrefix' = [MName \"Crypto\",MName \"Proto\"], parentModule' = [MName \"RLWE\",MName \"Kq\"], baseName' = FName \"q\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 16}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 4}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".RLWE.Kq.xs\", haskellPrefix' = [MName \"Crypto\",MName \"Proto\"], parentModule' = [MName \"RLWE\",MName \"Kq\"], baseName' = FName \"xs\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 3}, wireTag = WireTag {getWireTag = 25}, packedTag = Just (WireTag {getWireTag = 25},WireTag {getWireTag = 26}), wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = True, mightPack = True, typeCode = FieldType {getFieldType = 1}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing}], descOneofs = fromList [], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False, makeLenses = False}], enums = [], oneofs = [], knownKeyMap = fromList []}"  fileDescriptorProto :: FileDescriptorProto fileDescriptorProto  = P'.getFromBS (P'.wireGet 11)     (P'.pack-      "\132\STX\n\nRLWE.proto\"6\n\nSampleCont\DC2\DC3\n\SOHa\CAN\SOH \STX(\v2\b.RLWE.Rq\DC2\DC3\n\SOHb\CAN\STX \STX(\v2\b.RLWE.Kq\"6\n\nSampleDisc\DC2\DC3\n\SOHa\CAN\SOH \STX(\v2\b.RLWE.Rq\DC2\DC3\n\SOHb\CAN\STX \STX(\v2\b.RLWE.Rq\"6\n\nSampleRLWR\DC2\DC3\n\SOHa\CAN\SOH \STX(\v2\b.RLWE.Rq\DC2\DC3\n\SOHb\CAN\STX \STX(\v2\b.RLWE.Rq\"&\n\STXRq\DC2\t\n\SOHm\CAN\SOH \STX(\r\DC2\t\n\SOHq\CAN\STX \STX(\EOT\DC2\n\n\STXxs\CAN\ETX \ETX(\DC2\"&\n\STXKq\DC2\t\n\SOHm\CAN\SOH \STX(\r\DC2\t\n\SOHq\CAN\STX \STX(\SOH\DC2\n\n\STXxs\CAN\ETX \ETX(\SOH")+      "\132\STX\n\nRLWE.proto\"6\n\nSampleCont\DC2\DC3\n\SOHa\CAN\SOH \STX(\v2\b.RLWE.Rq\DC2\DC3\n\SOHb\CAN\STX \STX(\v2\b.RLWE.Kq\"6\n\nSampleDisc\DC2\DC3\n\SOHa\CAN\SOH \STX(\v2\b.RLWE.Rq\DC2\DC3\n\SOHb\CAN\STX \STX(\v2\b.RLWE.Rq\"6\n\nSampleRLWR\DC2\DC3\n\SOHa\CAN\SOH \STX(\v2\b.RLWE.Rq\DC2\DC3\n\SOHb\CAN\STX \STX(\v2\b.RLWE.Rq\"&\n\STXRq\DC2\t\n\SOHm\CAN\SOH \STX(\r\DC2\t\n\SOHq\CAN\STX \STX(\EOT\DC2\n\n\STXxs\CAN\ETX \ETX(\DC2\"&\n\STXKq\DC2\t\n\SOHm\CAN\SOH \STX(\r\DC2\t\n\SOHq\CAN\STX \STX(\EOT\DC2\n\n\STXxs\CAN\ETX \ETX(\SOH")

@@ -8,7 +8,7 @@ import qualified Data.Data as Prelude' import qualified Text.ProtocolBuffers.Header as P' -data Kq = Kq{m :: !(P'.Word32), q :: !(P'.Double), xs :: !(P'.Seq P'.Double)}+data Kq = Kq{m :: !(P'.Word32), q :: !(P'.Word64), xs :: !(P'.Seq P'.Double)}         deriving (Prelude'.Show, Prelude'.Eq, Prelude'.Ord, Prelude'.Typeable, Prelude'.Data, Prelude'.Generic)  instance P'.Mergeable Kq where@@ -24,7 +24,7 @@        11 -> P'.prependMessageSize calc'Size        _ -> P'.wireSizeErr ft' self'     where-        calc'Size = (P'.wireSizeReq 1 13 x'1 + P'.wireSizeReq 1 1 x'2 + P'.wireSizeRep 1 1 x'3)+        calc'Size = (P'.wireSizeReq 1 13 x'1 + P'.wireSizeReq 1 4 x'2 + P'.wireSizeRep 1 1 x'3)   wirePut ft' self'@(Kq x'1 x'2 x'3)    = case ft' of        10 -> put'Fields@@ -36,7 +36,7 @@         put'Fields          = do              P'.wirePutReq 8 13 x'1-             P'.wirePutReq 17 1 x'2+             P'.wirePutReq 16 4 x'2              P'.wirePutRep 25 1 x'3   wireGet ft'    = case ft' of@@ -47,7 +47,7 @@         update'Self wire'Tag old'Self          = case wire'Tag of              8 -> Prelude'.fmap (\ !new'Field -> old'Self{m = new'Field}) (P'.wireGet 13)-             17 -> Prelude'.fmap (\ !new'Field -> old'Self{q = new'Field}) (P'.wireGet 1)+             16 -> Prelude'.fmap (\ !new'Field -> old'Self{q = new'Field}) (P'.wireGet 4)              25 -> Prelude'.fmap (\ !new'Field -> old'Self{xs = P'.append (xs old'Self) new'Field}) (P'.wireGet 1)              26 -> Prelude'.fmap (\ !new'Field -> old'Self{xs = P'.mergeAppend (xs old'Self) new'Field}) (P'.wireGetPacked 1)              _ -> let (field'Number, wire'Type) = P'.splitWireTag wire'Tag in P'.unknown field'Number wire'Type old'Self@@ -58,10 +58,10 @@ instance P'.GPB Kq  instance P'.ReflectDescriptor Kq where-  getMessageInfo _ = P'.GetMessageInfo (P'.fromDistinctAscList [8, 17]) (P'.fromDistinctAscList [8, 17, 25, 26])+  getMessageInfo _ = P'.GetMessageInfo (P'.fromDistinctAscList [8, 16]) (P'.fromDistinctAscList [8, 16, 25, 26])   reflectDescriptorInfo _    = Prelude'.read-      "DescriptorInfo {descName = ProtoName {protobufName = FIName \".RLWE.Kq\", haskellPrefix = [MName \"Crypto\",MName \"Proto\"], parentModule = [MName \"RLWE\"], baseName = MName \"Kq\"}, descFilePath = [\"Crypto\",\"Proto\",\"RLWE\",\"Kq.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".RLWE.Kq.m\", haskellPrefix' = [MName \"Crypto\",MName \"Proto\"], parentModule' = [MName \"RLWE\",MName \"Kq\"], baseName' = FName \"m\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 8}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 13}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".RLWE.Kq.q\", haskellPrefix' = [MName \"Crypto\",MName \"Proto\"], parentModule' = [MName \"RLWE\",MName \"Kq\"], baseName' = FName \"q\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 17}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 1}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".RLWE.Kq.xs\", haskellPrefix' = [MName \"Crypto\",MName \"Proto\"], parentModule' = [MName \"RLWE\",MName \"Kq\"], baseName' = FName \"xs\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 3}, wireTag = WireTag {getWireTag = 25}, packedTag = Just (WireTag {getWireTag = 25},WireTag {getWireTag = 26}), wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = True, mightPack = True, typeCode = FieldType {getFieldType = 1}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing}], descOneofs = fromList [], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False, makeLenses = False}"+      "DescriptorInfo {descName = ProtoName {protobufName = FIName \".RLWE.Kq\", haskellPrefix = [MName \"Crypto\",MName \"Proto\"], parentModule = [MName \"RLWE\"], baseName = MName \"Kq\"}, descFilePath = [\"Crypto\",\"Proto\",\"RLWE\",\"Kq.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".RLWE.Kq.m\", haskellPrefix' = [MName \"Crypto\",MName \"Proto\"], parentModule' = [MName \"RLWE\",MName \"Kq\"], baseName' = FName \"m\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 8}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 13}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".RLWE.Kq.q\", haskellPrefix' = [MName \"Crypto\",MName \"Proto\"], parentModule' = [MName \"RLWE\",MName \"Kq\"], baseName' = FName \"q\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 16}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 4}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".RLWE.Kq.xs\", haskellPrefix' = [MName \"Crypto\",MName \"Proto\"], parentModule' = [MName \"RLWE\",MName \"Kq\"], baseName' = FName \"xs\", baseNamePrefix' = \"\"}, fieldNumber = FieldId {getFieldId = 3}, wireTag = WireTag {getWireTag = 25}, packedTag = Just (WireTag {getWireTag = 25},WireTag {getWireTag = 26}), wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = True, mightPack = True, typeCode = FieldType {getFieldType = 1}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing}], descOneofs = fromList [], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False, makeLenses = False}"  instance P'.TextType Kq where   tellT = P'.tellSubMessage

@@ -1,13 +1,14 @@-{-# LANGUAGE DataKinds, FlexibleContexts,-             NoImplicitPrelude, RebindableSyntax,-             ScopedTypeVariables, TypeFamilies,-             TypeOperators, UndecidableInstances #-}+{-# LANGUAGE DataKinds           #-}+{-# LANGUAGE FlexibleContexts    #-}+{-# LANGUAGE NoImplicitPrelude   #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies        #-}  module CycBenches (cycBenches) where  import Apply.Cyc import Benchmarks-import Utils+import BenchParams  import Control.Monad.Random @@ -15,24 +16,30 @@ import Crypto.Lol.Types import Crypto.Random.DRBG -import Data.Singletons-import Data.Promotion.Prelude.Eq-import Data.Singletons.TypeRepStar ()- cycBenches :: IO Benchmark cycBenches = benchGroup "Cyc" [-  benchGroup "unzipCycPow" $ applyUnzip  allParams    $ hideArgs bench_unzipCycPow,-  benchGroup "unzipCycCRT" $ applyUnzip  allParams    $ hideArgs bench_unzipCycCRT,-  benchGroup "*"           $ applyBasic  allParams    $ hideArgs bench_mul,-  benchGroup "crt"         $ applyBasic  allParams    $ hideArgs bench_crt,-  benchGroup "crtInv"      $ applyBasic  allParams    $ hideArgs bench_crtInv,-  benchGroup "l"           $ applyBasic  allParams    $ hideArgs bench_l,-  benchGroup "*g Pow"      $ applyBasic  allParams    $ hideArgs bench_mulgPow,-  benchGroup "*g CRT"      $ applyBasic  allParams    $ hideArgs bench_mulgCRT,-  benchGroup "lift"        $ applyLift   liftParams   $ hideArgs bench_liftPow,-  benchGroup "error"       $ applyError  errorParams  $ hideArgs $ bench_errRounded 0.1,-  benchGroup "twace"       $ applyTwoIdx twoIdxParams $ hideArgs bench_twacePow,-  benchGroup "embed"       $ applyTwoIdx twoIdxParams $ hideArgs bench_embedPow+  benchGroup "unzipPow"    $ [hideArgs bench_unzipCycPow testParam],+  benchGroup "unzipDec"    $ [hideArgs bench_unzipCycDec testParam],+  benchGroup "unzipCRT"    $ [hideArgs bench_unzipCycCRT testParam],+  benchGroup "zipWith (*)" $ [hideArgs bench_mul testParam],+  benchGroup "crt"         $ [hideArgs bench_crt testParam],+  benchGroup "crtInv"      $ [hideArgs bench_crtInv testParam],+  benchGroup "l"           $ [hideArgs bench_l testParam],+  benchGroup "lInv"        $ [hideArgs bench_lInv testParam],+  benchGroup "*g Pow"      $ [hideArgs bench_mulgPow testParam],+  benchGroup "*g Dec"      $ [hideArgs bench_mulgDec testParam],+  benchGroup "*g CRT"      $ [hideArgs bench_mulgCRT testParam],+  benchGroup "divg Pow"    $ [hideArgs bench_divgPow testParam],+  benchGroup "divg Dec"    $ [hideArgs bench_divgDec testParam],+  benchGroup "divg CRT"    $ [hideArgs bench_divgCRT testParam],+  benchGroup "lift"        $ [hideArgs bench_liftPow testParam],+  benchGroup "error"       $ [hideArgs (bench_errRounded 0.1) testParam'],+  benchGroup "twacePow"    $ [hideArgs bench_twacePow twoIdxParam],+  benchGroup "twaceDec"    $ [hideArgs bench_twaceDec twoIdxParam],+  benchGroup "twaceCRT"    $ [hideArgs bench_twaceCRT twoIdxParam],+  benchGroup "embedPow"    $ [hideArgs bench_embedPow twoIdxParam],+  benchGroup "embedDec"    $ [hideArgs bench_embedDec twoIdxParam],+  benchGroup "embedCRT"    $ [hideArgs bench_embedCRT twoIdxParam]   ]  bench_unzipCycPow :: (UnzipCtx t m r) => Cyc t m (r,r) -> Bench '(t,m,r)@@ -40,6 +47,11 @@   let a' = advisePow a   in bench unzipCyc a' +bench_unzipCycDec :: (UnzipCtx t m r) => Cyc t m (r,r) -> Bench '(t,m,r)+bench_unzipCycDec a =+  let a' = adviseDec a+  in bench unzipCyc a'+ bench_unzipCycCRT :: (UnzipCtx t m r) => Cyc t m (r,r) -> Bench '(t,m,r) bench_unzipCycCRT a =   let a' = adviseCRT a@@ -64,18 +76,38 @@ bench_l :: (BasicCtx t m r) => Cyc t m r -> Bench '(t,m,r) bench_l x = let y = adviseDec x in bench advisePow y +-- convert input from Pow basis to Dec basis+bench_lInv :: (BasicCtx t m r) => Cyc t m r -> Bench '(t,m,r)+bench_lInv x = let y = advisePow x in bench adviseDec y+ -- lift an element in the Pow basis bench_liftPow :: forall t m r . (LiftCtx t m r) => Cyc t m r -> Bench '(t,m,r)-bench_liftPow x = let y = advisePow x in bench (liftCyc Pow :: Cyc t m r -> Cyc t m (LiftOf r)) y+bench_liftPow x = let y = advisePow x in bench (liftCyc Pow) y  -- multiply by g when input is in Pow basis bench_mulgPow :: (BasicCtx t m r) => Cyc t m r -> Bench '(t,m,r) bench_mulgPow x = let y = advisePow x in bench mulG y +-- multiply by g when input is in Dec basis+bench_mulgDec :: (BasicCtx t m r) => Cyc t m r -> Bench '(t,m,r)+bench_mulgDec x = let y = adviseDec x in bench mulG y+ -- multiply by g when input is in CRT basis bench_mulgCRT :: (BasicCtx t m r) => Cyc t m r -> Bench '(t,m,r) bench_mulgCRT x = let y = adviseCRT x in bench mulG y +-- divide by g when input is in Pow basis+bench_divgPow :: (BasicCtx t m r) => Cyc t m r -> Bench '(t,m,r)+bench_divgPow x = let y = advisePow $ mulG x in bench divG y++-- divide by g when input is in Dec basis+bench_divgDec :: (BasicCtx t m r) => Cyc t m r -> Bench '(t,m,r)+bench_divgDec x = let y = adviseDec $ mulG x in bench divG y++-- divide by g when input is in CRT basis+bench_divgCRT :: (BasicCtx t m r) => Cyc t m r -> Bench '(t,m,r)+bench_divgCRT x = let y = adviseCRT x in bench divG y+ -- generate a rounded error term bench_errRounded :: forall t m r gen . (ErrorCtx t m r gen)   => Double -> Bench '(t,m,r,gen)@@ -89,46 +121,32 @@   let y = advisePow x   in bench (twace :: Cyc t m' r -> Cyc t m r) y +bench_twaceDec :: forall t m m' r . (TwoIdxCtx t m m' r)+  => Cyc t m' r -> Bench '(t,m,m',r)+bench_twaceDec x =+  let y = adviseDec x+  in bench (twace :: Cyc t m' r -> Cyc t m r) y++bench_twaceCRT :: forall t m m' r . (TwoIdxCtx t m m' r)+  => Cyc t m' r -> Bench '(t,m,m',r)+bench_twaceCRT x =+  let y = adviseCRT x+  in bench (twace :: Cyc t m' r -> Cyc t m r) y+ bench_embedPow :: forall t m m' r . (TwoIdxCtx t m m' r)   => Cyc t m r -> Bench '(t,m,m',r) bench_embedPow x =   let y = advisePow x-  in bench (embed :: Cyc t m r -> Cyc t m' r) y--type Tensors = '[CT,RT]-type MRCombos =-  '[ '(F1024, Zq 1051649),      -- 1024 / 512-     '(F2048, Zq 1054721),      -- 2048 / 1024-     '(F64 * F27, Zq 1048897),  -- 1728 / 576-     '(F64 * F81, Zq 1073089),  -- 5184 / 1728-     '(F64*F9*F25, Zq 1065601)  -- 14400 / 3840-    ]--type MM'RCombos =-  '[ '(F8 * F91, F8 * F91 * F4, Zq 8737),-     '(F8 * F91, F8 * F91 * F5, Zq 14561),-     '(F128, F128 * F91, Zq 23297)-    ]---- EAC: must be careful where we use Nub: apparently TypeRepStar doesn't work well with the Tensor constructors-type AllParams = ( '(,) <$> Tensors) <*> MRCombos-allParams :: Proxy AllParams-allParams = Proxy--type LiftParams = ( '(,) <$> Tensors) <*> MRCombos-liftParams :: Proxy LiftParams-liftParams = Proxy--type TwoIdxParams = ( '(,) <$> Tensors) <*> MM'RCombos-twoIdxParams :: Proxy TwoIdxParams-twoIdxParams = Proxy--type ErrorParams = ( '(,) <$> '[HashDRBG]) <*> LiftParams-errorParams :: Proxy ErrorParams-errorParams = Proxy+  in bench (advisePow . embed :: Cyc t m r -> Cyc t m' r) y -data Liftable :: TyFun (Factored, *) Bool -> *-type instance Apply Liftable '(m',r) = Int64 :== (LiftOf r)+bench_embedDec :: forall t m m' r . (TwoIdxCtx t m m' r)+  => Cyc t m r -> Bench '(t,m,m',r)+bench_embedDec x =+  let y = adviseDec x+  in bench (adviseDec . embed :: Cyc t m r -> Cyc t m' r) y -data RemoveM :: TyFun (Factored, Factored, *) (Factored, *) -> *-type instance Apply RemoveM '(m,m',r) = '(m',r)+bench_embedCRT :: forall t m m' r . (TwoIdxCtx t m m' r)+  => Cyc t m r -> Bench '(t,m,m',r)+bench_embedCRT x =+  let y = adviseCRT x+  in bench (adviseCRT . embed :: Cyc t m r -> Cyc t m' r) y

@@ -1,15 +1,177 @@+{-+import TensorBenches+import Criterion.Main +main :: IO ()+main = defaultMain =<< sequence [+  tensorBenches+  ]+-}+{-# LANGUAGE BangPatterns, RecordWildCards #-}+ import CycBenches+import SimpleTensorBenches import TensorBenches+import SimpleUCycBenches import UCycBenches-import ZqBenches -import Criterion.Main+import Criterion.Internal (runAndAnalyseOne)+import Criterion.Main.Options (defaultConfig)+import Criterion.Measurement (secs)+import Criterion.Monad (Criterion, withConfig)+import Criterion.Types+import Control.Monad (foldM, forM_, when)+import Control.Monad.IO.Class (MonadIO, liftIO) -main :: IO ()-main = defaultMain =<< sequence [-  zqBenches,-  tensorBenches,-  ucycBenches,-  cycBenches+import Control.Exception (evaluate)++import Control.DeepSeq (rnf)++import Data.List (transpose)+import qualified Data.Map as Map+import Data.Maybe++import Statistics.Resampling.Bootstrap (Estimate(..))+import System.Console.ANSI+import System.IO+import Text.Printf++-- table print parameters+colWidth, testNameWidth :: Int+colWidth = 15+testNameWidth = 40+verb :: Verb+verb = Progress++benches :: [String]+benches = [+  "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"+   ]++data Verb = Progress | Abridged | Full deriving (Eq)++main :: IO ()+main = do+  hSetBuffering stdout NoBuffering -- for better printing of progress+  reports <- mapM (getReports =<<) [+    simpleTensorBenches,+    tensorBenches,+    simpleUCycBenches,+    ucycBenches,+    cycBenches+    ]+  when (verb == Progress) $ putStrLn ""+  printTable $ map reverse reports++printTable :: [[Report]] -> IO ()+printTable rpts = do+  let colLbls = map (takeWhile (/= '/') . reportName . head) rpts+  printf testName ""+  mapM_ (\lbl -> printf col lbl) colLbls+  printf "\n"+  mapM_ printRow $ transpose rpts++col, testName :: String+testName = "%-" ++ (show testNameWidth) ++ "s "+col = "%-" ++ (show colWidth) ++ "s "++printANSI :: (MonadIO m) => Color -> String -> m ()+printANSI sgr str = liftIO $ do+  setSGR [SetColor Foreground Vivid sgr]+  putStrLn str+  setSGR [Reset]++config :: Config+config = defaultConfig {verbosity = if verb == Full then Normal else Quiet}++getRuntime :: Report -> Double+getRuntime Report{..} =+  let SampleAnalysis{..} = reportAnalysis+      (builtin, _) = splitAt 1 anRegress+      mests = map (\Regression{..} -> Map.lookup "iters" regCoeffs) builtin+      [Estimate{..}] = catMaybes mests+  in estPoint++-- See Criterion.Internal.analyseOne+printRow :: [Report] -> IO ()+printRow xs@(rpt : _) = do+  printf testName $ stripOuterGroup $ reportName rpt+  let times = map getRuntime xs+      minTime = minimum times+      printCol t =+        if t > (1.1*minTime)+        then do+          setSGR [SetColor Foreground Vivid Red]+          printf col $ secs t+          setSGR [Reset]+        else printf col $ secs t+  forM_ times printCol+  putStrLn ""++stripOuterGroup :: String -> String+stripOuterGroup = tail . dropWhile (/= '/')++getReports :: Benchmark -> IO [Report]+getReports = withConfig config . runAndAnalyse++-- | Run, and analyse, one or more benchmarks.+-- From Criterion.Internal+runAndAnalyse :: Benchmark+              -> Criterion [Report]+runAndAnalyse bs = for bs $ \idx desc bm -> do+  when (verb == Abridged || verb == Full) $ liftIO $ putStr $ "benchmark " ++ desc+  when (verb == Full) $ liftIO $ putStrLn ""+  (Analysed rpt) <- runAndAnalyseOne idx desc bm+  when (verb == Progress) $ liftIO $ putStr "."+  when (verb == Abridged) $ liftIO $ putStrLn $ "..." ++ (secs $ getRuntime rpt)+  return rpt++-- | Iterate over benchmarks.+-- From Criterion.Internal+for :: MonadIO m => Benchmark+    -> (Int -> String -> Benchmarkable -> m a) -> m [a]+for bs0 handle = snd <$> go (0::Int, []) ("", bs0)+  where+    select = flip elem benches . takeWhile (/= '/') . stripOuterGroup+    go (!idx,drs) (pfx, Environment mkenv mkbench)+      | shouldRun pfx mkbench = do+        e <- liftIO $ do+          ee <- mkenv+          evaluate (rnf ee)+          return ee+        go (idx,drs) (pfx, mkbench e)+      | otherwise = return (idx,drs)+    go (!idx, drs) (pfx, Benchmark desc b)+      | select desc' = do+          x <- handle idx desc' b;+          return (idx + 1, x:drs)+      | otherwise    = return (idx, drs)+      where desc' = addPrefix pfx desc+    go (!idx,drs) (pfx, BenchGroup desc bs) =+      foldM go (idx,drs) [(addPrefix pfx desc, b) | b <- bs]++    shouldRun pfx mkbench =+      any (select . addPrefix pfx) . benchNames . mkbench $+      error "Criterion.env could not determine the list of your benchmarks since they force the environment (see the documentation for details)"

@@ -1,28 +1,131 @@-{-# LANGUAGE DataKinds, FlexibleContexts,-             NoImplicitPrelude, RebindableSyntax,-             ScopedTypeVariables, TypeFamilies,-             TypeOperators, UndecidableInstances #-}+{-# LANGUAGE DataKinds            #-}+{-# LANGUAGE FlexibleContexts     #-}+{-# LANGUAGE NoImplicitPrelude    #-}+{-# LANGUAGE ScopedTypeVariables  #-}+{-# LANGUAGE TypeFamilies         #-}+{-# LANGUAGE TypeOperators        #-}+{-# LANGUAGE UndecidableInstances #-}  module TensorBenches (tensorBenches) where  import Apply.Cyc import Benchmarks-import Utils+import BenchParams -import Crypto.Lol+import Control.Applicative+import Control.Monad.Random++import Crypto.Lol.Prelude import Crypto.Lol.Cyclotomic.Tensor import Crypto.Lol.Types+import Crypto.Random.DRBG  tensorBenches :: IO Benchmark tensorBenches = benchGroup "Tensor" [-  benchGroup "l" $ applyBasic (Proxy::Proxy QuickParams) $ hideArgs bench_l]+  benchGroup "unzipPow"    $ [hideArgs bench_unzip testParam],+  benchGroup "unzipDec"    $ [hideArgs bench_unzip testParam],+  benchGroup "unzipCRT"    $ [hideArgs bench_unzip testParam],+  benchGroup "zipWith (*)" $ [hideArgs bench_mul testParam],+  benchGroup "crt"         $ [hideArgs bench_crt testParam],+  benchGroup "crtInv"      $ [hideArgs bench_crtInv testParam],+  benchGroup "l"           $ [hideArgs bench_l testParam],+  benchGroup "lInv"        $ [hideArgs bench_lInv testParam],+  benchGroup "*g Pow"      $ [hideArgs bench_mulgPow testParam],+  benchGroup "*g Dec"      $ [hideArgs bench_mulgDec testParam],+  benchGroup "*g CRT"      $ [hideArgs bench_mulgCRT testParam],+  benchGroup "divg Pow"    $ [hideArgs bench_divgPow testParam],+  benchGroup "divg Dec"    $ [hideArgs bench_divgDec testParam],+  benchGroup "divg CRT"    $ [hideArgs bench_divgCRT testParam],+  benchGroup "lift"        $ [hideArgs bench_liftPow testParam],+  benchGroup "error"       $ [hideArgs (bench_errRounded 0.1) testParam'],+  benchGroup "twacePow"    $ [hideArgs bench_twacePow twoIdxParam],+  benchGroup "twaceDec"    $ [hideArgs bench_twacePow twoIdxParam], -- yes, twacePow is correct here. It's the same function!+  benchGroup "twaceCRT"    $ [hideArgs bench_twaceCRT twoIdxParam],+  benchGroup "embedPow"    $ [hideArgs bench_embedPow twoIdxParam],+  benchGroup "embedDec"    $ [hideArgs bench_embedDec twoIdxParam],+  benchGroup "embedCRT"    $ [hideArgs bench_embedCRT twoIdxParam]+  ] +bench_unzip :: (UnzipCtx t m r) => t m (r,r) -> Bench '(t,m,r)+bench_unzip = bench unzipT++-- no CRT conversion, just coefficient-wise multiplication+bench_mul :: (BasicCtx t m r) => t m r -> t m r -> Bench '(t,m,r)+bench_mul a = bench (zipWithT (*) a)++-- convert input from Pow basis to CRT basis+bench_crt :: (BasicCtx t m r) => t m r -> Bench '(t,m,r)+bench_crt = bench (fromJust' "TensorBenches.bench_crt" crt)++-- convert input from CRT basis to Pow basis+bench_crtInv :: (BasicCtx t m r) => t m r -> Bench '(t,m,r)+bench_crtInv = bench (fromJust' "TensorBenches.bench_crtInv" crtInv)+ -- convert input from Dec basis to Pow basis-bench_l :: (Tensor t, Fact m, Additive r, TElt t r, NFData (t m r)) => t m r -> Bench '(t,m,r)+bench_l :: (BasicCtx t m r) => t m r -> Bench '(t,m,r) bench_l = bench l -type QuickTest = '[ '(F128, Zq 257),-                    '(F32 * F9, Zq 577),-                    '(F32 * F9, Int64) ]-type Tensors = '[CT,RT]-type QuickParams = ( '(,) <$> Tensors) <*> QuickTest+-- convert input from Dec basis to Pow basis+bench_lInv :: (BasicCtx t m r) => t m r -> Bench '(t,m,r)+bench_lInv = bench lInv++-- lift an element in the Pow basis+bench_liftPow :: forall t m r . (LiftCtx t m r) => t m r -> Bench '(t,m,r)+bench_liftPow = bench (fmapT lift)++-- multiply by g when input is in Pow basis+bench_mulgPow :: (BasicCtx t m r) => t m r -> Bench '(t,m,r)+bench_mulgPow = bench mulGPow++-- multiply by g when input is in Dec basis+bench_mulgDec :: (BasicCtx t m r) => t m r -> Bench '(t,m,r)+bench_mulgDec = bench mulGDec++-- multiply by g when input is in CRT basis+bench_mulgCRT :: (BasicCtx t m r) => t m r -> Bench '(t,m,r)+bench_mulgCRT = bench (fromJust' "TensorBenches.bench_mulgCRT" mulGCRT)++-- divide by g when input is in Pow basis+bench_divgPow :: (BasicCtx t m r) => t m r -> Bench '(t,m,r)+bench_divgPow x =+  let y = mulGPow x+  in bench divGPow y++-- divide by g when input is in Dec basis+bench_divgDec :: (BasicCtx t m r) => t m r -> Bench '(t,m,r)+bench_divgDec x =+  let y = mulGDec x+  in bench divGDec y++-- divide by g when input is in CRT basis+bench_divgCRT :: (BasicCtx t m r) => t m r -> Bench '(t,m,r)+bench_divgCRT = bench (fromJust' "TensorBenches.bench_divgCRT" divGCRT)++-- generate a rounded error term+bench_errRounded :: forall t m r gen . (ErrorCtx t m r gen)+  => Double -> Bench '(t,m,r,gen)+bench_errRounded v = benchIO $ do+  gen <- newGenIO+  return $ evalRand+    (fmapT (roundMult one) <$>+      (tGaussianDec v :: Rand (CryptoRand gen) (t m Double)) :: Rand (CryptoRand gen) (t m (LiftOf r))) gen++bench_twacePow :: forall t m m' r . (TwoIdxCtx t m m' r)+  => t m' r -> Bench '(t,m,m',r)+bench_twacePow = bench (twacePowDec :: t m' r -> t m r)++bench_twaceCRT :: forall t m m' r . (TwoIdxCtx t m m' r)+  => t m' r -> Bench '(t,m,m',r)+bench_twaceCRT = bench (fromJust' "TensorBenches.bench_twaceCRT" twaceCRT :: t m' r -> t m r)++bench_embedPow :: forall t m m' r . (TwoIdxCtx t m m' r)+  => t m r -> Bench '(t,m,m',r)+bench_embedPow = bench (embedPow :: t m r -> t m' r)++bench_embedDec :: forall t m m' r . (TwoIdxCtx t m m' r)+  => t m r -> Bench '(t,m,m',r)+bench_embedDec = bench (embedDec :: t m r -> t m' r)++bench_embedCRT :: forall t m m' r . (TwoIdxCtx t m m' r)+  => t m r -> Bench '(t,m,m',r)+bench_embedCRT = bench (fromJust' "TensorBenches.bench_embedCRT" embedCRT :: t m r -> t m' r)

@@ -1,48 +1,142 @@-{-# LANGUAGE DataKinds, FlexibleContexts,-             NoImplicitPrelude, RebindableSyntax,-             ScopedTypeVariables, TypeFamilies,-             TypeOperators, UndecidableInstances #-}+{-# LANGUAGE DataKinds            #-}+{-# LANGUAGE FlexibleContexts     #-}+{-# LANGUAGE NoImplicitPrelude    #-}+{-# LANGUAGE ScopedTypeVariables  #-}+{-# LANGUAGE TypeFamilies         #-}  module UCycBenches (ucycBenches) where  import Apply.Cyc import Benchmarks-import Utils+import BenchParams -import Crypto.Lol+import Control.Monad.Random++import Crypto.Lol.Prelude import Crypto.Lol.Cyclotomic.UCyc import Crypto.Lol.Types+import Crypto.Random.DRBG  ucycBenches :: IO Benchmark ucycBenches = benchGroup "UCyc" [-  benchGroup "l"     $ applyBasic (Proxy::Proxy QuickParams) $ hideArgs bench_l,-  benchGroup "twace" $ applyTwoIdx twoIdxParams $ hideArgs bench_twacePow,-  benchGroup "embed" $ applyTwoIdx twoIdxParams $ hideArgs bench_embedPow+  benchGroup "unzipPow"    $ [hideArgs bench_unzipUCycPow testParam],+  benchGroup "unzipDec"    $ [hideArgs bench_unzipUCycDec testParam],+  benchGroup "unzipCRT"    $ [hideArgs bench_unzipUCycCRT testParam],+  benchGroup "zipWith (*)" $ [hideArgs bench_mul testParam],+  benchGroup "crt"         $ [hideArgs bench_crt testParam],+  benchGroup "crtInv"      $ [hideArgs bench_crtInv testParam],+  benchGroup "l"           $ [hideArgs bench_l testParam],+  benchGroup "lInv"        $ [hideArgs bench_lInv testParam],+  benchGroup "*g Pow"      $ [hideArgs bench_mulgPow testParam],+  benchGroup "*g Dec"      $ [hideArgs bench_mulgDec testParam],+  benchGroup "*g CRT"      $ [hideArgs bench_mulgCRT testParam],+  benchGroup "divg Pow"    $ [hideArgs bench_divgPow testParam],+  benchGroup "divg Dec"    $ [hideArgs bench_divgDec testParam],+  benchGroup "divg CRT"    $ [hideArgs bench_divgCRT testParam],+  benchGroup "lift"        $ [hideArgs bench_liftPow testParam],+  benchGroup "error"       $ [hideArgs (bench_errRounded 0.1) testParam'],+  benchGroup "twacePow"    $ [hideArgs bench_twacePow twoIdxParam],+  benchGroup "twaceDec"    $ [hideArgs bench_twaceDec twoIdxParam],+  benchGroup "twaceCRT"    $ [hideArgs bench_twaceCRT twoIdxParam],+  benchGroup "embedPow"    $ [hideArgs bench_embedPow twoIdxParam],+  benchGroup "embedDec"    $ [hideArgs bench_embedDec twoIdxParam],+  benchGroup "embedCRT"    $ [hideArgs bench_embedCRT twoIdxParam]   ] +bench_unzipUCycPow :: (UnzipCtx t m r) => UCyc t m P (r,r) -> Bench '(t,m,r)+bench_unzipUCycPow = bench unzipPow++bench_unzipUCycDec :: (UnzipCtx t m r) => UCyc t m D (r,r) -> Bench '(t,m,r)+bench_unzipUCycDec = bench unzipDec++bench_unzipUCycCRT :: (UnzipCtx t m r) => UCycPC t m (r,r) -> Bench '(t,m,r)+bench_unzipUCycCRT (Right a) = bench unzipCRTC a++pcToEC :: UCycPC t m r -> UCycEC t m r+pcToEC (Right x) = (Right x)++-- no CRT conversion, just coefficient-wise multiplication+bench_mul :: (BasicCtx t m r) => 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'++-- convert input from Pow basis to CRT basis+bench_crt :: (BasicCtx t m r) => UCyc t m P r -> Bench '(t,m,r)+bench_crt = bench toCRT++-- convert input from CRT basis to Pow basis+bench_crtInv :: (BasicCtx t m r) => UCycPC t m r -> Bench '(t,m,r)+bench_crtInv (Right a) = bench toPow a+ -- convert input from Dec basis to Pow basis bench_l :: (BasicCtx t m r) => UCyc t m D r -> Bench '(t,m,r) bench_l = bench toPow +-- convert input from Pow basis to Dec basis+bench_lInv :: (BasicCtx t m r) => UCyc t m P r -> Bench '(t,m,r)+bench_lInv = bench toDec++-- lift an element in the Pow basis+bench_liftPow :: (LiftCtx t m r) => UCyc t m P r -> Bench '(t,m,r)+bench_liftPow = bench lift++-- multiply by g when input is in Pow basis+bench_mulgPow :: (BasicCtx t m r) => UCyc t m P r -> Bench '(t,m,r)+bench_mulgPow = bench mulG++-- multiply by g when input is in Dec basis+bench_mulgDec :: (BasicCtx t m r) => UCyc t m D r -> Bench '(t,m,r)+bench_mulgDec = bench mulG++-- multiply by g when input is in CRT basis+bench_mulgCRT :: (BasicCtx t m r) => UCycPC t m r -> Bench '(t,m,r)+bench_mulgCRT (Right a) = bench mulG a++-- divide by g when input is in Pow basis+bench_divgPow :: (BasicCtx t m r) => UCyc t m P r -> Bench '(t,m,r)+bench_divgPow x =+  let y = mulG x+  in bench divGPow y++-- divide by g when input is in Dec basis+bench_divgDec :: (BasicCtx t m r) => UCyc t m D r -> Bench '(t,m,r)+bench_divgDec x =+  let y = mulG x+  in bench divGDec y++-- divide by g when input is in CRT basis+bench_divgCRT :: (BasicCtx t m r) => UCycPC t m r -> Bench '(t,m,r)+bench_divgCRT (Right a) = bench divGCRTC a++-- generate a rounded error term+bench_errRounded :: forall t m r gen . (ErrorCtx t m r 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 . (TwoIdxCtx t m m' r)   => 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 . (TwoIdxCtx t m m' r)+  => 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 . (TwoIdxCtx t m m' r)+  => 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 . (TwoIdxCtx t m m' r)   => UCyc t m P r -> Bench '(t,m,m',r) bench_embedPow = bench (embedPow :: UCyc t m P r -> UCyc t m' P r) -type QuickTest = '[ '(F128, Zq 257),-                    '(F32 * F9, Zq 577),-                    '(F32 * F9, Int64) ]-type Tensors = '[CT,RT]-type QuickParams = ( '(,) <$> Tensors) <*> QuickTest+bench_embedDec :: forall t m m' r . (TwoIdxCtx t m m' r)+  => UCyc t m D r -> Bench '(t,m,m',r)+bench_embedDec = bench (embedDec :: UCyc t m D r -> UCyc t m' D r) -type MM'RCombos =-  '[ '(F8 * F91, F8 * F91 * F4, Zq 8737),-     '(F8 * F91, F8 * F91 * F5, Zq 14561),-     '(F128, F128 * F91, Zq 23297)-    ]-type TwoIdxParams = ( '(,) <$> Tensors) <*> MM'RCombos-twoIdxParams :: Proxy TwoIdxParams-twoIdxParams = Proxy+bench_embedCRT :: forall t m m' r . (TwoIdxCtx t m m' r)+  => 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

@@ -5,7 +5,7 @@ -- PVP summary:      +-+------- breaking API changes --                   | | +----- non-breaking API additions --                   | | | +--- code changes with no API change-version:             0.4.0.0+version:             0.5.0.0 synopsis:            A library for lattice cryptography. homepage:            https://github.com/cpeikert/Lol Bug-Reports:         https://github.com/cpeikert/Lol/issues@@ -84,8 +84,8 @@    -- ghc optimizations   if flag(opt)-    ghc-options: -O3 -Odph -funbox-strict-fields -fno-liberate-case -funfolding-use-threshold1000 -funfolding-keeness-factor1000-+    -- makes lift much faster!+    ghc-options: -funfolding-use-threshold1000   exposed-modules:     Crypto.Lol     Crypto.Lol.Types@@ -163,7 +163,6 @@     reflection >= 1.5.1 && < 2.2,     repa==3.4.*,     singletons >= 1.1.2.1 && < 2.2,-    storable-record >= 0.0.3 && < 0.1,     th-desugar >= 1.5.4 && < 1.7,     tagged-transformer >= 0.7 && < 0.9,     template-haskell  >=  2.2.0.0,@@ -206,14 +205,15 @@    if flag(llvm)     ghc-options: -fllvm -optlo-O3-  -- ghc-options: -threaded -rtsopts-  ghc-options: -O3 -Odph -funbox-strict-fields -fno-liberate-case -funfolding-use-threshold1000 -funfolding-keeness-factor1000-  -- ghc-options: -O2 -Odph -funbox-strict-fields -fwarn-dodgy-imports -rtsopts-  -- ghc-options: -fno-liberate-case -funfolding-use-threshold1000 -funfolding-keeness-factor1000+  ghc-options: -O2+  -- ghc-options: -ddump-to-file -ddump-simpl+  -- ghc-options: -dsuppress-coercions -dsuppress-type-applications -dsuppress-uniques -dsuppress-module-prefixes    build-depends:+    ansi-terminal,     arithmoi,     base,+    containers,     criterion,     deepseq,     DRBG,@@ -221,6 +221,7 @@     MonadRandom,     mtl,     singletons,+    statistics,     transformers,     vector,     repa

@@ -46,7 +46,7 @@  data UnzipCtxD type UnzipCtx t m r =-  (Fact m, CElt t (r,r), Random (t m (r,r)), CElt t r, ShowType '(t,m,r), NFElt r, Random r)+  (Fact m, CElt t (r,r), Random (t m (r,r)), CElt t r, ShowType '(t,m,r), NFElt r, Random r, NFData (t m r)) data instance ArgsCtx UnzipCtxD where     UzC :: (UnzipCtx t m r) => Proxy '(t,m,r) -> ArgsCtx UnzipCtxD instance (params `Satisfy` UnzipCtxD, UnzipCtx t m r)@@ -64,7 +64,7 @@ data LiftCtxD type LiftCtx t m r =   (BasicCtx t m r, Lift' r, CElt t (LiftOf r), NFElt (LiftOf r), ToInteger (LiftOf r),-   TElt CT r, TElt RT r, TElt CT (LiftOf r), TElt RT (LiftOf r))+   TElt CT r, TElt RT r, TElt CT (LiftOf r), TElt RT (LiftOf r), NFData (t m (LiftOf r))) data instance ArgsCtx LiftCtxD where     LC :: (LiftCtx t m r) => Proxy '(t,m,r) -> ArgsCtx LiftCtxD instance (params `Satisfy` LiftCtxD, LiftCtx t m r)@@ -81,7 +81,7 @@ data ErrorCtxD type ErrorCtx t m r gen = (CElt t r, Fact m, ShowType '(t,m,r,gen),                            CElt t (LiftOf r), NFElt (LiftOf r), Lift' r,-                           ToInteger (LiftOf r), CryptoRandomGen gen)+                           ToInteger (LiftOf r), CryptoRandomGen gen, NFData (t m (LiftOf r))) data instance ArgsCtx ErrorCtxD where     EC :: (ErrorCtx t m r gen) => Proxy '(t,m,r,gen) -> ArgsCtx ErrorCtxD instance (params `Satisfy` ErrorCtxD, ErrorCtx t m r gen)@@ -97,7 +97,7 @@  data TwoIdxCtxD type TwoIdxCtx t m m' r = (m `Divides` m', CElt t r, IntegralDomain r, Eq r, Random r, NFElt r,-                           ShowType '(t,m,m',r), Random (t m r), Random (t m' r))+                           ShowType '(t,m,m',r), Random (t m r), Random (t m' r), NFData (t m r), NFData (t m' r)) data instance ArgsCtx TwoIdxCtxD where     TI :: (TwoIdxCtx t m m' r) => Proxy '(t,m,m',r) -> ArgsCtx TwoIdxCtxD instance (params `Satisfy` TwoIdxCtxD, TwoIdxCtx t m m' r)

@@ -10,7 +10,6 @@ ,type (<*>)  ,module Data.Promotion.Prelude.List-,goodQs ,showType ,ShowType) where @@ -22,16 +21,6 @@ import Crypto.Random.DRBG  import Data.Promotion.Prelude.List--import Math.NumberTheory.Primes.Testing (isPrime)---- an infinite list of primes greater than the input and congruent to--- 1 mod m-goodQs :: (Integral i) => i -> i -> [i]-goodQs m lower = checkVal (lower + ((m-lower) `mod` m) + 1)-  where checkVal v = if (isPrime (fromIntegral v :: Integer))-                     then v : checkVal (v+m)-                    else checkVal (v+m)  infixr 9 ** data a ** b