[number] move some number primitive to use compat without CPP
This commit is contained in:
parent
03fe63b05a
commit
ee3e5e69bf
@ -1,14 +1,3 @@
|
|||||||
{-# LANGUAGE BangPatterns #-}
|
|
||||||
{-# LANGUAGE CPP #-}
|
|
||||||
#ifndef MIN_VERSION_integer_gmp
|
|
||||||
#define MIN_VERSION_integer_gmp(a,b,c) 0
|
|
||||||
#endif
|
|
||||||
#if MIN_VERSION_integer_gmp(0,5,1)
|
|
||||||
{-# LANGUAGE UnboxedTuples #-}
|
|
||||||
#endif
|
|
||||||
#ifdef VERSION_integer_gmp
|
|
||||||
{-# LANGUAGE MagicHash #-}
|
|
||||||
#endif
|
|
||||||
-- |
|
-- |
|
||||||
-- Module : Crypto.Number.Basic
|
-- Module : Crypto.Number.Basic
|
||||||
-- License : BSD-style
|
-- License : BSD-style
|
||||||
@ -16,6 +5,7 @@
|
|||||||
-- Stability : experimental
|
-- Stability : experimental
|
||||||
-- Portability : Good
|
-- Portability : Good
|
||||||
|
|
||||||
|
{-# LANGUAGE BangPatterns #-}
|
||||||
module Crypto.Number.Basic
|
module Crypto.Number.Basic
|
||||||
( sqrti
|
( sqrti
|
||||||
, gcde
|
, gcde
|
||||||
@ -23,15 +13,7 @@ module Crypto.Number.Basic
|
|||||||
, log2
|
, log2
|
||||||
) where
|
) where
|
||||||
|
|
||||||
#if MIN_VERSION_integer_gmp(0,5,1)
|
import Crypto.Number.Compat
|
||||||
import GHC.Integer.GMP.Internals
|
|
||||||
#else
|
|
||||||
import Data.Bits
|
|
||||||
#endif
|
|
||||||
#ifdef VERSION_integer_gmp
|
|
||||||
import GHC.Exts
|
|
||||||
import GHC.Integer.Logarithms (integerLog2#)
|
|
||||||
#endif
|
|
||||||
|
|
||||||
-- | sqrti returns two integer (l,b) so that l <= sqrt i <= b
|
-- | sqrti returns two integer (l,b) so that l <= sqrt i <= b
|
||||||
-- the implementation is quite naive, use an approximation for the first number
|
-- the implementation is quite naive, use an approximation for the first number
|
||||||
@ -70,35 +52,25 @@ sqrti i
|
|||||||
-- gcde 'a' 'b' find (x,y,gcd(a,b)) where ax + by = d
|
-- gcde 'a' 'b' find (x,y,gcd(a,b)) where ax + by = d
|
||||||
--
|
--
|
||||||
gcde :: Integer -> Integer -> (Integer, Integer, Integer)
|
gcde :: Integer -> Integer -> (Integer, Integer, Integer)
|
||||||
#if MIN_VERSION_integer_gmp(0,5,1)
|
gcde a b = onGmpUnsupported (gmpGcde a b) $
|
||||||
gcde a b = (s, t, g)
|
if d < 0 then (-x,-y,-d) else (x,y,d)
|
||||||
where (# g, s #) = gcdExtInteger a b
|
where
|
||||||
t = (g - s * a) `div` b
|
|
||||||
#else
|
|
||||||
gcde a b = if d < 0 then (-x,-y,-d) else (x,y,d) where
|
|
||||||
(d, x, y) = f (a,1,0) (b,0,1)
|
(d, x, y) = f (a,1,0) (b,0,1)
|
||||||
f t (0, _, _) = t
|
f t (0, _, _) = t
|
||||||
f (a', sa, ta) t@(b', sb, tb) =
|
f (a', sa, ta) t@(b', sb, tb) =
|
||||||
let (q, r) = a' `divMod` b' in
|
let (q, r) = a' `divMod` b' in
|
||||||
f t (r, sa - (q * sb), ta - (q * tb))
|
f t (r, sa - (q * sb), ta - (q * tb))
|
||||||
#endif
|
|
||||||
|
|
||||||
|
|
||||||
-- | check if a list of integer are all even
|
-- | check if a list of integer are all even
|
||||||
areEven :: [Integer] -> Bool
|
areEven :: [Integer] -> Bool
|
||||||
areEven = and . map even
|
areEven = and . map even
|
||||||
|
|
||||||
log2 :: Integer -> Int
|
log2 :: Integer -> Int
|
||||||
#ifdef VERSION_integer_gmp
|
log2 n = onGmpUnsupported (gmpLog2 n) $ imLog 2 n
|
||||||
log2 0 = 0
|
|
||||||
log2 x = I# (integerLog2# x)
|
|
||||||
#else
|
|
||||||
-- http://www.haskell.org/pipermail/haskell-cafe/2008-February/039465.html
|
|
||||||
log2 = imLog 2
|
|
||||||
where
|
where
|
||||||
|
-- http://www.haskell.org/pipermail/haskell-cafe/2008-February/039465.html
|
||||||
imLog b x = if x < b then 0 else (x `div` b^l) `doDiv` l
|
imLog b x = if x < b then 0 else (x `div` b^l) `doDiv` l
|
||||||
where
|
where
|
||||||
l = 2 * imLog (b * b) x
|
l = 2 * imLog (b * b) x
|
||||||
doDiv x' l' = if x' < b then l' else (x' `div` b) `doDiv` (l' + 1)
|
doDiv x' l' = if x' < b then l' else (x' `div` b) `doDiv` (l' + 1)
|
||||||
#endif
|
|
||||||
{-# INLINE log2 #-}
|
{-# INLINE log2 #-}
|
||||||
|
|||||||
@ -5,14 +5,7 @@
|
|||||||
-- Stability : experimental
|
-- Stability : experimental
|
||||||
-- Portability : Good
|
-- Portability : Good
|
||||||
|
|
||||||
{-# LANGUAGE CPP #-}
|
|
||||||
{-# LANGUAGE BangPatterns #-}
|
{-# LANGUAGE BangPatterns #-}
|
||||||
#ifndef MIN_VERSION_integer_gmp
|
|
||||||
#define MIN_VERSION_integer_gmp(a,b,c) 0
|
|
||||||
#endif
|
|
||||||
#if MIN_VERSION_integer_gmp(0,5,1)
|
|
||||||
{-# LANGUAGE MagicHash #-}
|
|
||||||
#endif
|
|
||||||
module Crypto.Number.Prime
|
module Crypto.Number.Prime
|
||||||
(
|
(
|
||||||
generatePrime
|
generatePrime
|
||||||
@ -28,17 +21,13 @@ module Crypto.Number.Prime
|
|||||||
|
|
||||||
import Crypto.Internal.Imports
|
import Crypto.Internal.Imports
|
||||||
|
|
||||||
|
import Crypto.Number.Compat
|
||||||
import Crypto.Number.Generate
|
import Crypto.Number.Generate
|
||||||
import Crypto.Number.Basic (sqrti, gcde)
|
import Crypto.Number.Basic (sqrti, gcde)
|
||||||
import Crypto.Number.ModArithmetic (exponantiation)
|
import Crypto.Number.ModArithmetic (exponantiation)
|
||||||
import Crypto.Random.Types
|
import Crypto.Random.Types
|
||||||
|
|
||||||
#if MIN_VERSION_integer_gmp(0,5,1)
|
|
||||||
import GHC.Integer.GMP.Internals
|
|
||||||
import GHC.Base
|
|
||||||
#else
|
|
||||||
import Data.Bits
|
import Data.Bits
|
||||||
#endif
|
|
||||||
|
|
||||||
-- | returns if the number is probably prime.
|
-- | returns if the number is probably prime.
|
||||||
-- first a list of small primes are implicitely tested for divisibility,
|
-- first a list of small primes are implicitely tested for divisibility,
|
||||||
@ -84,27 +73,24 @@ findPrimeFromWith prop !n
|
|||||||
-- | find a prime from a starting point with no specific property.
|
-- | find a prime from a starting point with no specific property.
|
||||||
findPrimeFrom :: MonadRandom m => Integer -> m Integer
|
findPrimeFrom :: MonadRandom m => Integer -> m Integer
|
||||||
findPrimeFrom n =
|
findPrimeFrom n =
|
||||||
#if MIN_VERSION_integer_gmp(0,5,1)
|
case gmpNextPrime n of
|
||||||
return $ nextPrimeInteger n
|
GmpSupported p -> return p
|
||||||
#else
|
GmpUnsupported -> findPrimeFromWith (\_ -> return True) n
|
||||||
findPrimeFromWith (\_ -> return True) n
|
|
||||||
#endif
|
|
||||||
|
|
||||||
-- | Miller Rabin algorithm return if the number is probably prime or composite.
|
-- | Miller Rabin algorithm return if the number is probably prime or composite.
|
||||||
-- the tries parameter is the number of recursion, that determines the accuracy of the test.
|
-- the tries parameter is the number of recursion, that determines the accuracy of the test.
|
||||||
primalityTestMillerRabin :: MonadRandom m => Int -> Integer -> m Bool
|
primalityTestMillerRabin :: MonadRandom m => Int -> Integer -> m Bool
|
||||||
#if MIN_VERSION_integer_gmp(0,5,1)
|
primalityTestMillerRabin tries !n =
|
||||||
primalityTestMillerRabin (I# tries) !n =
|
case gmpTestPrimeMillerRabin tries n of
|
||||||
case testPrimeInteger n tries of
|
GmpSupported b -> return b
|
||||||
0# -> return False
|
GmpUnsupported -> run
|
||||||
_ -> return True
|
|
||||||
#else
|
|
||||||
primalityTestMillerRabin tries !n
|
|
||||||
| n <= 3 = error "Miller-Rabin requires tested value to be > 3"
|
|
||||||
| even n = return False
|
|
||||||
| tries <= 0 = error "Miller-Rabin tries need to be > 0"
|
|
||||||
| otherwise = loop <$> generateTries tries
|
|
||||||
where
|
where
|
||||||
|
run
|
||||||
|
| n <= 3 = error "Miller-Rabin requires tested value to be > 3"
|
||||||
|
| even n = return False
|
||||||
|
| tries <= 0 = error "Miller-Rabin tries need to be > 0"
|
||||||
|
| otherwise = loop <$> generateTries tries
|
||||||
|
|
||||||
!nm1 = n-1
|
!nm1 = n-1
|
||||||
!nm2 = n-2
|
!nm2 = n-2
|
||||||
|
|
||||||
@ -136,7 +122,6 @@ primalityTestMillerRabin tries !n
|
|||||||
| x2 == 1 = False
|
| x2 == 1 = False
|
||||||
| x2 /= nm1 = loop' ws ((x2*x2) `mod` n) (r+1)
|
| x2 /= nm1 = loop' ws ((x2*x2) `mod` n) (r+1)
|
||||||
| otherwise = loop ws
|
| otherwise = loop ws
|
||||||
#endif
|
|
||||||
|
|
||||||
{-
|
{-
|
||||||
n < z -> witness to test
|
n < z -> witness to test
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user