{-# 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
( sqrti
, gcde
, gcde_binary
, areEven
, log2
) where
#if MIN_VERSION_integer_gmp(0,5,1)
import GHC.Integer.GMP.Internals
#else
import Data.Bits
#endif
#ifdef VERSION_integer_gmp
import GHC.Exts
import GHC.Integer.Logarithms (integerLog2#)
#endif
sqrti :: Integer -> (Integer, Integer)
sqrti :: Integer -> (Integer, Integer)
sqrti i :: Integer
i
| Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< 0 = [Char] -> (Integer, Integer)
forall a. HasCallStack => [Char] -> a
error "cannot compute negative square root"
| Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== 0 = (0,0)
| Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== 1 = (1,1)
| Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== 2 = (1,2)
| Bool
otherwise = Integer -> (Integer, Integer)
loop Integer
x0
where
nbdigits :: Int
nbdigits = [Char] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Char] -> Int) -> [Char] -> Int
forall a b. (a -> b) -> a -> b
$ Integer -> [Char]
forall a. Show a => a -> [Char]
show Integer
i
x0n :: Int
x0n = (if Int -> Bool
forall a. Integral a => a -> Bool
even Int
nbdigits then Int
nbdigits Int -> Int -> Int
forall a. Num a => a -> a -> a
- 2 else Int
nbdigits Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 2
x0 :: Integer
x0 = if Int -> Bool
forall a. Integral a => a -> Bool
even Int
nbdigits then 2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* 10 Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
x0n else 6 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* 10 Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
x0n
loop :: Integer -> (Integer, Integer)
loop x :: Integer
x = case Integer -> Integer -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Integer -> Integer
forall a. Num a => a -> a
sq Integer
x) Integer
i of
LT -> Integer -> (Integer, Integer)
iterUp Integer
x
EQ -> (Integer
x, Integer
x)
GT -> Integer -> (Integer, Integer)
iterDown Integer
x
iterUp :: Integer -> (Integer, Integer)
iterUp lb :: Integer
lb = if Integer -> Integer
forall a. Num a => a -> a
sq Integer
ub Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
i then Integer -> Integer -> (Integer, Integer)
iter Integer
lb Integer
ub else Integer -> (Integer, Integer)
iterUp Integer
ub
where ub :: Integer
ub = Integer
lb Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* 2
iterDown :: Integer -> (Integer, Integer)
iterDown ub :: Integer
ub = if Integer -> Integer
forall a. Num a => a -> a
sq Integer
lb Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
i then Integer -> (Integer, Integer)
iterDown Integer
lb else Integer -> Integer -> (Integer, Integer)
iter Integer
lb Integer
ub
where lb :: Integer
lb = Integer
ub Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` 2
iter :: Integer -> Integer -> (Integer, Integer)
iter lb :: Integer
lb ub :: Integer
ub
| Integer
lb Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
ub = (Integer
lb, Integer
ub)
| Integer
lbInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+1 Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
ub = (Integer
lb, Integer
ub)
| Bool
otherwise =
let d :: Integer
d = (Integer
ub Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
lb) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` 2 in
if Integer -> Integer
forall a. Num a => a -> a
sq (Integer
lb Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
d) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
i
then Integer -> Integer -> (Integer, Integer)
iter Integer
lb (Integer
ubInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
d)
else Integer -> Integer -> (Integer, Integer)
iter (Integer
lbInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
d) Integer
ub
sq :: a -> a
sq a :: a
a = a
a a -> a -> a
forall a. Num a => a -> a -> a
* a
a
gcde :: Integer -> Integer -> (Integer, Integer, Integer)
#if MIN_VERSION_integer_gmp(0,5,1)
gcde :: Integer -> Integer -> (Integer, Integer, Integer)
gcde a :: Integer
a b :: Integer
b = (Integer
s, Integer
t, Integer
g)
where (# g :: Integer
g, s :: Integer
s #) = Integer -> Integer -> (# Integer, Integer #)
gcdExtInteger Integer
a Integer
b
t :: Integer
t = (Integer
g Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
s Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
a) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
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)
f t (0, _, _) = t
f (a', sa, ta) t@(b', sb, tb) =
let (q, r) = a' `divMod` b' in
f t (r, sa - (q * sb), ta - (q * tb))
#endif
gcde_binary :: Integer -> Integer -> (Integer, Integer, Integer)
#if MIN_VERSION_integer_gmp(0,5,1)
gcde_binary :: Integer -> Integer -> (Integer, Integer, Integer)
gcde_binary = Integer -> Integer -> (Integer, Integer, Integer)
gcde
#else
gcde_binary a' b'
| b' == 0 = (1,0,a')
| a' >= b' = compute a' b'
| otherwise = (\(x,y,d) -> (y,x,d)) $ compute b' a'
where
getEvenMultiplier !g !x !y
| areEven [x,y] = getEvenMultiplier (g `shiftL` 1) (x `shiftR` 1) (y `shiftR` 1)
| otherwise = (x,y,g)
halfLoop !x !y !u !i !j
| areEven [u,i,j] = halfLoop x y (u `shiftR` 1) (i `shiftR` 1) (j `shiftR` 1)
| even u = halfLoop x y (u `shiftR` 1) ((i + y) `shiftR` 1) ((j - x) `shiftR` 1)
| otherwise = (u, i, j)
compute a b =
let (x,y,g) = getEvenMultiplier 1 a b in
loop g x y x y 1 0 0 1
loop g _ _ 0 !v _ _ !c !d = (c, d, g * v)
loop g x y !u !v !a !b !c !d =
let (u2,a2,b2) = halfLoop x y u a b
(v2,c2,d2) = halfLoop x y v c d
in if u2 >= v2
then loop g x y (u2 - v2) v2 (a2 - c2) (b2 - d2) c2 d2
else loop g x y u2 (v2 - u2) a2 b2 (c2 - a2) (d2 - b2)
#endif
areEven :: [Integer] -> Bool
areEven :: [Integer] -> Bool
areEven = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool) -> ([Integer] -> [Bool]) -> [Integer] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Bool) -> [Integer] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> Bool
forall a. Integral a => a -> Bool
even
log2 :: Integer -> Int
#ifdef VERSION_integer_gmp
log2 :: Integer -> Int
log2 0 = 0
log2 x :: Integer
x = Int# -> Int
I# (Integer -> Int#
integerLog2# Integer
x)
#else
log2 = imLog 2
where
imLog b x = if x < b then 0 else (x `div` b^l) `doDiv` l
where
l = 2 * imLog (b * b) x
doDiv x' l' = if x' < b then l' else (x' `div` b) `doDiv` (l' + 1)
#endif
{-# INLINE log2 #-}