{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -fspec-constr-count=8 #-}
module Math.NumberTheory.Primes.Sieve.Eratosthenes
( primes
, psieveFrom
, PrimeSieve(..)
, psieveList
, primeList
, primeSieve
, sieveBits
, sieveRange
, sieveTo
) where
import Control.Monad (when)
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST
import Data.Bits
import Data.Coerce
import Data.Proxy
import Data.Word
import Math.NumberTheory.Primes.Sieve.Indexing
import Math.NumberTheory.Primes.Types
import Math.NumberTheory.Roots
import Math.NumberTheory.Utils.FromIntegral
iXMASK :: Num a => a
iXMASK :: forall a. Num a => a
iXMASK = a
0xFFFFF
iXBITS :: Int
iXBITS :: Int
iXBITS = Int
20
iXJMASK :: Num a => a
iXJMASK :: forall a. Num a => a
iXJMASK = a
0x7FFFFF
iXJBITS :: Int
iXJBITS :: Int
iXJBITS = Int
23
jMASK :: Int
jMASK :: Int
jMASK = Int
7
jBITS :: Int
jBITS :: Int
jBITS = Int
3
sieveBytes :: Int
sieveBytes :: Int
sieveBytes = Int
128 forall a. Num a => a -> a -> a
* Int
1024
sieveBits :: Int
sieveBits :: Int
sieveBits = Int
8 forall a. Num a => a -> a -> a
* Int
sieveBytes
lastIndex :: Int
lastIndex :: Int
lastIndex = Int
sieveBits forall a. Num a => a -> a -> a
- Int
1
sieveRange :: Int
sieveRange :: Int
sieveRange = Int
30 forall a. Num a => a -> a -> a
* Int
sieveBytes
wSHFT :: (Bits a, Num a) => a
wSHFT :: forall a. (Bits a, Num a) => a
wSHFT = if forall b. FiniteBits b => b -> Int
finiteBitSize (Word
0 :: Word) forall a. Eq a => a -> a -> Bool
== Int
64 then a
6 else a
5
data PrimeSieve = PS !Integer {-# UNPACK #-} !(UArray Int Bool)
primeSieve :: Integer -> PrimeSieve
primeSieve :: Integer -> PrimeSieve
primeSieve Integer
bound = Integer -> UArray Int Bool -> PrimeSieve
PS Integer
0 (forall i e. (forall s. ST s (STUArray s i e)) -> UArray i e
runSTUArray forall a b. (a -> b) -> a -> b
$ forall s. Integer -> ST s (STUArray s Int Bool)
sieveTo Integer
bound)
primeList :: forall a. Integral a => PrimeSieve -> [Prime a]
primeList :: forall a. Integral a => PrimeSieve -> [Prime a]
primeList ps :: PrimeSieve
ps@(PS Integer
v UArray Int Bool
_)
| forall a. Integral a => Proxy a -> Integer -> Bool
doesNotFit (forall {k} (t :: k). Proxy t
Proxy :: Proxy a) Integer
v
= []
| Integer
v forall a. Eq a => a -> a -> Bool
== Integer
0 = (coerce :: forall a b. Coercible a b => a -> b
coerce :: [a] -> [Prime a])
forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> [a]
takeWhileIncreasing forall a b. (a -> b) -> a -> b
$ a
2 forall a. a -> [a] -> [a]
: a
3 forall a. a -> [a] -> [a]
: a
5 forall a. a -> [a] -> [a]
: forall a. Num a => PrimeSieve -> [a]
primeListInternal PrimeSieve
ps
| Bool
otherwise = (coerce :: forall a b. Coercible a b => a -> b
coerce :: [a] -> [Prime a])
forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> [a]
takeWhileIncreasing forall a b. (a -> b) -> a -> b
$ forall a. Num a => PrimeSieve -> [a]
primeListInternal PrimeSieve
ps
primeListInternal :: Num a => PrimeSieve -> [a]
primeListInternal :: forall a. Num a => PrimeSieve -> [a]
primeListInternal (PS Integer
v0 UArray Int Bool
bs)
= forall a b. (a -> b) -> [a] -> [b]
map ((forall a. Num a => a -> a -> a
+ forall a. Num a => Integer -> a
fromInteger Integer
v0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => Int -> a
toPrim)
forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> Int -> e
unsafeAt UArray Int Bool
bs) [Int
lo..Int
hi]
where
(Int
lo, Int
hi) = forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
bounds UArray Int Bool
bs
doesNotFit :: forall a. Integral a => Proxy a -> Integer -> Bool
doesNotFit :: forall a. Integral a => Proxy a -> Integer -> Bool
doesNotFit Proxy a
_ Integer
v = forall a. Integral a => a -> Integer
toInteger (forall a. Num a => Integer -> a
fromInteger Integer
v :: a) forall a. Eq a => a -> a -> Bool
/= Integer
v
takeWhileIncreasing :: Ord a => [a] -> [a]
takeWhileIncreasing :: forall a. Ord a => [a] -> [a]
takeWhileIncreasing = \case
[] -> []
a
x : [a]
xs -> a
x forall a. a -> [a] -> [a]
: forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall a. Ord a => a -> (a -> [a]) -> a -> [a]
go (forall a b. a -> b -> a
const []) [a]
xs a
x
where
go :: Ord a => a -> (a -> [a]) -> a -> [a]
go :: forall a. Ord a => a -> (a -> [a]) -> a -> [a]
go a
y a -> [a]
f a
z = if a
z forall a. Ord a => a -> a -> Bool
< a
y then a
y forall a. a -> [a] -> [a]
: a -> [a]
f a
y else []
primes :: Integral a => [Prime a]
primes :: forall a. Integral a => [Prime a]
primes
= (coerce :: forall a b. Coercible a b => a -> b
coerce :: [a] -> [Prime a])
forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> [a]
takeWhileIncreasing forall a b. (a -> b) -> a -> b
$ a
2 forall a. a -> [a] -> [a]
: a
3 forall a. a -> [a] -> [a]
: a
5 forall a. a -> [a] -> [a]
: forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a. Num a => PrimeSieve -> [a]
primeListInternal [PrimeSieve]
psieveList
psieveList :: [PrimeSieve]
psieveList :: [PrimeSieve]
psieveList = Integer
-> Integer
-> Integer
-> Integer
-> UArray Int Word64
-> [PrimeSieve]
makeSieves Integer
plim Integer
sqlim Integer
0 Integer
0 UArray Int Word64
cache
where
plim :: Integer
plim = Integer
4801
sqlim :: Integer
sqlim = Integer
plimforall a. Num a => a -> a -> a
*Integer
plim
cache :: UArray Int Word64
cache = forall i e. (forall s. ST s (STUArray s i e)) -> UArray i e
runSTUArray forall a b. (a -> b) -> a -> b
$ do
STUArray s Int Bool
sieve <- forall s. Integer -> ST s (STUArray s Int Bool)
sieveTo (Integer
4801 :: Integer)
STUArray s Int Word64
new <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> m (a i e)
unsafeNewArray_ (Int
0,Int
1287) :: ST s (STUArray s Int Word64)
let fill :: Int -> Int -> m (STUArray s Int Word64)
fill Int
j Int
indx
| Int
1279 forall a. Ord a => a -> a -> Bool
< Int
indx = forall (m :: * -> *) a. Monad m => a -> m a
return STUArray s Int Word64
new
| Bool
otherwise = do
Bool
p <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> Int -> m e
unsafeRead STUArray s Int Bool
sieve Int
indx
if Bool
p
then do
let !i :: Int
i = Int
indx forall a. Bits a => a -> a -> a
.&. Int
jMASK
k :: Int
k = Int
indx forall a. Bits a => a -> Int -> a
`shiftR` Int
jBITS
strt1 :: Int
strt1 = (Int
kforall a. Num a => a -> a -> a
*(Int
30forall a. Num a => a -> a -> a
*Int
k forall a. Num a => a -> a -> a
+ Int
2forall a. Num a => a -> a -> a
*Int -> Int
rho Int
i) forall a. Num a => a -> a -> a
+ Int -> Int
byte Int
i) forall a. Bits a => a -> Int -> a
`shiftL` Int
jBITS forall a. Num a => a -> a -> a
+ Int -> Int
idx Int
i
!strt :: Word64
strt = Int -> Word64
intToWord64 (Int
strt1 forall a. Bits a => a -> a -> a
.&. forall a. Num a => a
iXMASK)
!skip :: Word64
skip = Int -> Word64
intToWord64 (Int
strt1 forall a. Bits a => a -> Int -> a
`shiftR` Int
iXBITS)
!ixes :: Word64
ixes = Int -> Word64
intToWord64 Int
indx forall a. Bits a => a -> Int -> a
`shiftL` Int
iXJBITS forall a. Num a => a -> a -> a
+ Word64
strt forall a. Bits a => a -> Int -> a
`shiftL` Int
jBITS forall a. Num a => a -> a -> a
+ Int -> Word64
intToWord64 Int
i
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> Int -> e -> m ()
unsafeWrite STUArray s Int Word64
new Int
j Word64
skip
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> Int -> e -> m ()
unsafeWrite STUArray s Int Word64
new (Int
jforall a. Num a => a -> a -> a
+Int
1) Word64
ixes
Int -> Int -> m (STUArray s Int Word64)
fill (Int
jforall a. Num a => a -> a -> a
+Int
2) (Int
indxforall a. Num a => a -> a -> a
+Int
1)
else Int -> Int -> m (STUArray s Int Word64)
fill Int
j (Int
indxforall a. Num a => a -> a -> a
+Int
1)
forall {m :: * -> *}.
(MArray (STUArray s) Bool m, MArray (STUArray s) Word64 m) =>
Int -> Int -> m (STUArray s Int Word64)
fill Int
0 Int
0
makeSieves :: Integer -> Integer -> Integer -> Integer -> UArray Int Word64 -> [PrimeSieve]
makeSieves :: Integer
-> Integer
-> Integer
-> Integer
-> UArray Int Word64
-> [PrimeSieve]
makeSieves Integer
plim Integer
sqlim Integer
bitOff Integer
valOff UArray Int Word64
cache
| Integer
valOff' forall a. Ord a => a -> a -> Bool
< Integer
sqlim =
let (UArray Int Word64
nc, UArray Int Bool
bs) = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
STUArray s Int Word64
cch <- forall i (a :: * -> * -> *) e (b :: * -> * -> *) (m :: * -> *).
(Ix i, IArray a e, MArray b e m) =>
a i e -> m (b i e)
unsafeThaw UArray Int Word64
cache :: ST s (STUArray s Int Word64)
STUArray s Int Bool
bs0 <- forall s. STUArray s Int Word64 -> ST s (STUArray s Int Bool)
slice STUArray s Int Word64
cch
UArray Int Word64
fcch <- forall i (a :: * -> * -> *) e (m :: * -> *) (b :: * -> * -> *).
(Ix i, MArray a e m, IArray b e) =>
a i e -> m (b i e)
unsafeFreeze STUArray s Int Word64
cch
UArray Int Bool
fbs0 <- forall i (a :: * -> * -> *) e (m :: * -> *) (b :: * -> * -> *).
(Ix i, MArray a e m, IArray b e) =>
a i e -> m (b i e)
unsafeFreeze STUArray s Int Bool
bs0
forall (m :: * -> *) a. Monad m => a -> m a
return (UArray Int Word64
fcch, UArray Int Bool
fbs0)
in Integer -> UArray Int Bool -> PrimeSieve
PS Integer
valOff UArray Int Bool
bs forall a. a -> [a] -> [a]
: Integer
-> Integer
-> Integer
-> Integer
-> UArray Int Word64
-> [PrimeSieve]
makeSieves Integer
plim Integer
sqlim Integer
bitOff' Integer
valOff' UArray Int Word64
nc
| Bool
otherwise =
let plim' :: Integer
plim' = Integer
plim forall a. Num a => a -> a -> a
+ Integer
4800
sqlim' :: Integer
sqlim' = Integer
plim' forall a. Num a => a -> a -> a
* Integer
plim'
(UArray Int Word64
nc,UArray Int Bool
bs) = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
STUArray s Int Word64
cch <- forall s.
Integer
-> Integer -> UArray Int Word64 -> ST s (STUArray s Int Word64)
growCache Integer
bitOff Integer
plim UArray Int Word64
cache
STUArray s Int Bool
bs0 <- forall s. STUArray s Int Word64 -> ST s (STUArray s Int Bool)
slice STUArray s Int Word64
cch
UArray Int Word64
fcch <- forall i (a :: * -> * -> *) e (m :: * -> *) (b :: * -> * -> *).
(Ix i, MArray a e m, IArray b e) =>
a i e -> m (b i e)
unsafeFreeze STUArray s Int Word64
cch
UArray Int Bool
fbs0 <- forall i (a :: * -> * -> *) e (m :: * -> *) (b :: * -> * -> *).
(Ix i, MArray a e m, IArray b e) =>
a i e -> m (b i e)
unsafeFreeze STUArray s Int Bool
bs0
forall (m :: * -> *) a. Monad m => a -> m a
return (UArray Int Word64
fcch, UArray Int Bool
fbs0)
in Integer -> UArray Int Bool -> PrimeSieve
PS Integer
valOff UArray Int Bool
bs forall a. a -> [a] -> [a]
: Integer
-> Integer
-> Integer
-> Integer
-> UArray Int Word64
-> [PrimeSieve]
makeSieves Integer
plim' Integer
sqlim' Integer
bitOff' Integer
valOff' UArray Int Word64
nc
where
valOff' :: Integer
valOff' = Integer
valOff forall a. Num a => a -> a -> a
+ Int -> Integer
intToInteger Int
sieveRange
bitOff' :: Integer
bitOff' = Integer
bitOff forall a. Num a => a -> a -> a
+ Int -> Integer
intToInteger Int
sieveBits
slice :: STUArray s Int Word64 -> ST s (STUArray s Int Bool)
slice :: forall s. STUArray s Int Word64 -> ST s (STUArray s Int Bool)
slice STUArray s Int Word64
cache = do
Int
hi <- forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> m (i, i)
getBounds STUArray s Int Word64
cache
STUArray s Int Bool
sieve <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> e -> m (a i e)
newArray (Int
0,Int
lastIndex) Bool
True
let treat :: Int -> m (STUArray s Int Bool)
treat Int
pr
| Int
hi forall a. Ord a => a -> a -> Bool
< Int
pr = forall (m :: * -> *) a. Monad m => a -> m a
return STUArray s Int Bool
sieve
| Bool
otherwise = do
Word64
w <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> Int -> m e
unsafeRead STUArray s Int Word64
cache Int
pr
if Word64
w forall a. Eq a => a -> a -> Bool
/= Word64
0
then forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> Int -> e -> m ()
unsafeWrite STUArray s Int Word64
cache Int
pr (Word64
wforall a. Num a => a -> a -> a
-Word64
1)
else do
Word64
ixes <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> Int -> m e
unsafeRead STUArray s Int Word64
cache (Int
prforall a. Num a => a -> a -> a
+Int
1)
let !stj :: Int
stj = Word64 -> Int
word64ToInt Word64
ixes forall a. Bits a => a -> a -> a
.&. forall a. Num a => a
iXJMASK
!ixw :: Int
ixw = Word64 -> Int
word64ToInt (Word64
ixes forall a. Bits a => a -> Int -> a
`shiftR` Int
iXJBITS)
!i :: Int
i = Int
ixw forall a. Bits a => a -> a -> a
.&. Int
jMASK
!k :: Int
k = Int
ixw forall a. Num a => a -> a -> a
- Int
i
!o :: Int
o = Int
i forall a. Bits a => a -> Int -> a
`shiftL` Int
jBITS
!j :: Int
j = Int
stj forall a. Bits a => a -> a -> a
.&. Int
jMASK
!s :: Int
s = Int
stj forall a. Bits a => a -> Int -> a
`shiftR` Int
jBITS
(Int
n, Int
u) <- forall {m :: * -> *}.
MArray (STUArray s) Bool m =>
Int -> Int -> Int -> Int -> m (Int, Int)
tick Int
k Int
o Int
j Int
s
let !skip :: Word64
skip = Int -> Word64
intToWord64 (Int
n forall a. Bits a => a -> Int -> a
`shiftR` Int
iXBITS)
!strt :: Word64
strt = Int -> Word64
intToWord64 (Int
n forall a. Bits a => a -> a -> a
.&. forall a. Num a => a
iXMASK)
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> Int -> e -> m ()
unsafeWrite STUArray s Int Word64
cache Int
pr Word64
skip
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> Int -> e -> m ()
unsafeWrite STUArray s Int Word64
cache (Int
prforall a. Num a => a -> a -> a
+Int
1) ((Word64
ixes forall a. Bits a => a -> a -> a
.&. forall a. Bits a => a -> a
complement forall a. Num a => a
iXJMASK) forall a. Bits a => a -> a -> a
.|. Word64
strt forall a. Bits a => a -> Int -> a
`shiftL` Int
jBITS forall a. Bits a => a -> a -> a
.|. Int -> Word64
intToWord64 Int
u)
Int -> m (STUArray s Int Bool)
treat (Int
prforall a. Num a => a -> a -> a
+Int
2)
tick :: Int -> Int -> Int -> Int -> m (Int, Int)
tick Int
stp Int
off Int
j Int
ix
| Int
lastIndex forall a. Ord a => a -> a -> Bool
< Int
ix = forall (m :: * -> *) a. Monad m => a -> m a
return (Int
ix forall a. Num a => a -> a -> a
- Int
sieveBits, Int
j)
| Bool
otherwise = do
Bool
p <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> Int -> m e
unsafeRead STUArray s Int Bool
sieve Int
ix
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
p (forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> Int -> e -> m ()
unsafeWrite STUArray s Int Bool
sieve Int
ix Bool
False)
Int -> Int -> Int -> Int -> m (Int, Int)
tick Int
stp Int
off ((Int
jforall a. Num a => a -> a -> a
+Int
1) forall a. Bits a => a -> a -> a
.&. Int
jMASK) (Int
ix forall a. Num a => a -> a -> a
+ Int
stpforall a. Num a => a -> a -> a
*Int -> Int
delta Int
j forall a. Num a => a -> a -> a
+ Int -> Int
tau (Int
offforall a. Num a => a -> a -> a
+Int
j))
forall {m :: * -> *}.
(MArray (STUArray s) Bool m, MArray (STUArray s) Word64 m) =>
Int -> m (STUArray s Int Bool)
treat Int
0
sieveTo :: Integer -> ST s (STUArray s Int Bool)
sieveTo :: forall s. Integer -> ST s (STUArray s Int Bool)
sieveTo Integer
bound = ST s (STUArray s Int Bool)
arr
where
(Int
bytes,Int
lidx) = forall a. Integral a => a -> (Int, Int)
idxPr Integer
bound
!mxidx :: Int
mxidx = Int
8forall a. Num a => a -> a -> a
*Int
bytesforall a. Num a => a -> a -> a
+Int
lidx
mxval :: Integer
mxval :: Integer
mxval = Integer
30forall a. Num a => a -> a -> a
*Int -> Integer
intToInteger Int
bytes forall a. Num a => a -> a -> a
+ Int -> Integer
intToInteger (Int -> Int
rho Int
lidx)
!mxsve :: Integer
mxsve = forall a. Integral a => a -> a
integerSquareRoot Integer
mxval
(Int
kr,Int
r) = forall a. Integral a => a -> (Int, Int)
idxPr Integer
mxsve
!svbd :: Int
svbd = Int
8forall a. Num a => a -> a -> a
*Int
krforall a. Num a => a -> a -> a
+Int
r
arr :: ST s (STUArray s Int Bool)
arr = do
STUArray s Int Bool
ar <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> e -> m (a i e)
newArray (Int
0,Int
mxidx) Bool
True
let start :: Int -> Int -> Int
start Int
k Int
i = Int
8forall a. Num a => a -> a -> a
*(Int
kforall a. Num a => a -> a -> a
*(Int
30forall a. Num a => a -> a -> a
*Int
kforall a. Num a => a -> a -> a
+Int
2forall a. Num a => a -> a -> a
*Int -> Int
rho Int
i) forall a. Num a => a -> a -> a
+ Int -> Int
byte Int
i) forall a. Num a => a -> a -> a
+ Int -> Int
idx Int
i
tick :: Int -> Int -> Int -> Int -> m ()
tick Int
stp Int
off Int
j Int
ix
| Int
mxidx forall a. Ord a => a -> a -> Bool
< Int
ix = forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = do
Bool
p <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> Int -> m e
unsafeRead STUArray s Int Bool
ar Int
ix
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
p (forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> Int -> e -> m ()
unsafeWrite STUArray s Int Bool
ar Int
ix Bool
False)
Int -> Int -> Int -> Int -> m ()
tick Int
stp Int
off ((Int
jforall a. Num a => a -> a -> a
+Int
1) forall a. Bits a => a -> a -> a
.&. Int
jMASK) (Int
ix forall a. Num a => a -> a -> a
+ Int
stpforall a. Num a => a -> a -> a
*Int -> Int
delta Int
j forall a. Num a => a -> a -> a
+ Int -> Int
tau (Int
offforall a. Num a => a -> a -> a
+Int
j))
sift :: Int -> m (STUArray s Int Bool)
sift Int
ix
| Int
svbd forall a. Ord a => a -> a -> Bool
< Int
ix = forall (m :: * -> *) a. Monad m => a -> m a
return STUArray s Int Bool
ar
| Bool
otherwise = do
Bool
p <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> Int -> m e
unsafeRead STUArray s Int Bool
ar Int
ix
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
p (do let i :: Int
i = Int
ix forall a. Bits a => a -> a -> a
.&. Int
jMASK
k :: Int
k = Int
ix forall a. Bits a => a -> Int -> a
`shiftR` Int
jBITS
!off :: Int
off = Int
i forall a. Bits a => a -> Int -> a
`shiftL` Int
jBITS
!stp :: Int
stp = Int
ix forall a. Num a => a -> a -> a
- Int
i
forall {m :: * -> *}.
MArray (STUArray s) Bool m =>
Int -> Int -> Int -> Int -> m ()
tick Int
stp Int
off Int
i (Int -> Int -> Int
start Int
k Int
i))
Int -> m (STUArray s Int Bool)
sift (Int
ixforall a. Num a => a -> a -> a
+Int
1)
forall {m :: * -> *}.
MArray (STUArray s) Bool m =>
Int -> m (STUArray s Int Bool)
sift Int
0
growCache :: Integer -> Integer -> UArray Int Word64 -> ST s (STUArray s Int Word64)
growCache :: forall s.
Integer
-> Integer -> UArray Int Word64 -> ST s (STUArray s Int Word64)
growCache Integer
offset Integer
plim UArray Int Word64
old = do
let (Int
_,Int
num) = forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
bounds UArray Int Word64
old
(Int
bt,Int
ix) = forall a. Integral a => a -> (Int, Int)
idxPr Integer
plim
!start :: Int
start = Int
8forall a. Num a => a -> a -> a
*Int
btforall a. Num a => a -> a -> a
+Int
ixforall a. Num a => a -> a -> a
+Int
1
!nlim :: Integer
nlim = Integer
plimforall a. Num a => a -> a -> a
+Integer
4800
STUArray s Int Bool
sieve <- forall s. Integer -> ST s (STUArray s Int Bool)
sieveTo Integer
nlim
(Int
_,Int
hi) <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> m (i, i)
getBounds STUArray s Int Bool
sieve
Int
more <- forall s. Int -> Int -> STUArray s Int Bool -> ST s Int
countFromToWd Int
start Int
hi STUArray s Int Bool
sieve
STUArray s Int Word64
new <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> m (a i e)
unsafeNewArray_ (Int
0,Int
numforall a. Num a => a -> a -> a
+Int
2forall a. Num a => a -> a -> a
*Int
more) :: ST s (STUArray s Int Word64)
let copy :: Int -> m ()
copy Int
i
| Int
num forall a. Ord a => a -> a -> Bool
< Int
i = forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = do
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> Int -> e -> m ()
unsafeWrite STUArray s Int Word64
new Int
i (UArray Int Word64
old forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> Int -> e
`unsafeAt` Int
i)
Int -> m ()
copy (Int
iforall a. Num a => a -> a -> a
+Int
1)
forall {m :: * -> *}. MArray (STUArray s) Word64 m => Int -> m ()
copy Int
0
let fill :: Int -> Int -> m (STUArray s Int Word64)
fill Int
j Int
indx
| Int
hi forall a. Ord a => a -> a -> Bool
< Int
indx = forall (m :: * -> *) a. Monad m => a -> m a
return STUArray s Int Word64
new
| Bool
otherwise = do
Bool
p <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> Int -> m e
unsafeRead STUArray s Int Bool
sieve Int
indx
if Bool
p
then do
let !i :: Int
i = Int
indx forall a. Bits a => a -> a -> a
.&. Int
jMASK
k :: Integer
k :: Integer
k = Int -> Integer
intToInteger (Int
indx forall a. Bits a => a -> Int -> a
`shiftR` Int
jBITS)
strt0 :: Integer
strt0 = ((Integer
kforall a. Num a => a -> a -> a
*(Integer
30forall a. Num a => a -> a -> a
*Integer
k forall a. Num a => a -> a -> a
+ Int -> Integer
intToInteger (Int
2forall a. Num a => a -> a -> a
*Int -> Int
rho Int
i))
forall a. Num a => a -> a -> a
+ Int -> Integer
intToInteger (Int -> Int
byte Int
i)) forall a. Bits a => a -> Int -> a
`shiftL` Int
jBITS)
forall a. Num a => a -> a -> a
+ Int -> Integer
intToInteger (Int -> Int
idx Int
i)
strt1 :: Integer
strt1 = Integer
strt0 forall a. Num a => a -> a -> a
- Integer
offset
!strt :: Word64
strt = Integer -> Word64
integerToWord64 Integer
strt1 forall a. Bits a => a -> a -> a
.&. forall a. Num a => a
iXMASK
!skip :: Word64
skip = Integer -> Word64
integerToWord64 (Integer
strt1 forall a. Bits a => a -> Int -> a
`shiftR` Int
iXBITS)
!ixes :: Word64
ixes = Int -> Word64
intToWord64 Int
indx forall a. Bits a => a -> Int -> a
`shiftL` Int
iXJBITS forall a. Bits a => a -> a -> a
.|. Word64
strt forall a. Bits a => a -> Int -> a
`shiftL` Int
jBITS forall a. Bits a => a -> a -> a
.|. Int -> Word64
intToWord64 Int
i
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> Int -> e -> m ()
unsafeWrite STUArray s Int Word64
new Int
j Word64
skip
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> Int -> e -> m ()
unsafeWrite STUArray s Int Word64
new (Int
jforall a. Num a => a -> a -> a
+Int
1) Word64
ixes
Int -> Int -> m (STUArray s Int Word64)
fill (Int
jforall a. Num a => a -> a -> a
+Int
2) (Int
indxforall a. Num a => a -> a -> a
+Int
1)
else Int -> Int -> m (STUArray s Int Word64)
fill Int
j (Int
indxforall a. Num a => a -> a -> a
+Int
1)
forall {m :: * -> *}.
(MArray (STUArray s) Bool m, MArray (STUArray s) Word64 m) =>
Int -> Int -> m (STUArray s Int Word64)
fill (Int
numforall a. Num a => a -> a -> a
+Int
1) Int
start
{-# INLINE countFromToWd #-}
countFromToWd :: Int -> Int -> STUArray s Int Bool -> ST s Int
countFromToWd :: forall s. Int -> Int -> STUArray s Int Bool -> ST s Int
countFromToWd Int
start Int
end STUArray s Int Bool
ba = do
STUArray s Int Word
wa <- (forall s ix a b. STUArray s ix a -> ST s (STUArray s ix b)
castSTUArray :: STUArray s Int Bool -> ST s (STUArray s Int Word)) STUArray s Int Bool
ba
let !sb :: Int
sb = Int
start forall a. Bits a => a -> Int -> a
`shiftR` forall a. (Bits a, Num a) => a
wSHFT
!eb :: Int
eb = Int
end forall a. Bits a => a -> Int -> a
`shiftR` forall a. (Bits a, Num a) => a
wSHFT
count :: Int -> Int -> m Int
count !Int
acc Int
i
| Int
eb forall a. Ord a => a -> a -> Bool
< Int
i = forall (m :: * -> *) a. Monad m => a -> m a
return Int
acc
| Bool
otherwise = do
Word
w <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> Int -> m e
unsafeRead STUArray s Int Word
wa Int
i
Int -> Int -> m Int
count (Int
acc forall a. Num a => a -> a -> a
+ forall a. Bits a => a -> Int
popCount Word
w) (Int
iforall a. Num a => a -> a -> a
+Int
1)
forall {m :: * -> *}.
MArray (STUArray s) Word m =>
Int -> Int -> m Int
count Int
0 Int
sb
psieveFrom :: Integer -> [PrimeSieve]
psieveFrom :: Integer -> [PrimeSieve]
psieveFrom Integer
n = Integer
-> Integer
-> Integer
-> Integer
-> UArray Int Word64
-> [PrimeSieve]
makeSieves Integer
plim Integer
sqlim Integer
bitOff Integer
valOff UArray Int Word64
cache
where
k0 :: Integer
k0 = ((Integer
n forall a. Ord a => a -> a -> a
`max` Integer
7) forall a. Num a => a -> a -> a
- Integer
7) forall a. Integral a => a -> a -> a
`quot` Integer
30
valOff :: Integer
valOff = Integer
30forall a. Num a => a -> a -> a
*Integer
k0
bitOff :: Integer
bitOff = Integer
8forall a. Num a => a -> a -> a
*Integer
k0
start :: Integer
start = Integer
valOffforall a. Num a => a -> a -> a
+Integer
7
ssr :: Integer
ssr = forall a. Integral a => a -> a
integerSquareRoot (Integer
startforall a. Num a => a -> a -> a
-Integer
1) forall a. Num a => a -> a -> a
+ Integer
1
end1 :: Integer
end1 = Integer
start forall a. Num a => a -> a -> a
- Integer
6 forall a. Num a => a -> a -> a
+ Int -> Integer
intToInteger Int
sieveRange
plim0 :: Integer
plim0 = forall a. Integral a => a -> a
integerSquareRoot Integer
end1
plim :: Integer
plim = Integer
plim0 forall a. Num a => a -> a -> a
+ Integer
4801 forall a. Num a => a -> a -> a
- (Integer
plim0 forall a. Integral a => a -> a -> a
`rem` Integer
4800)
sqlim :: Integer
sqlim = Integer
plimforall a. Num a => a -> a -> a
*Integer
plim
cache :: UArray Int Word64
cache = forall i e. (forall s. ST s (STUArray s i e)) -> UArray i e
runSTUArray forall a b. (a -> b) -> a -> b
$ do
STUArray s Int Bool
sieve <- forall s. Integer -> ST s (STUArray s Int Bool)
sieveTo Integer
plim
(Int
lo,Int
hi) <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> m (i, i)
getBounds STUArray s Int Bool
sieve
Int
pct <- forall s. Int -> Int -> STUArray s Int Bool -> ST s Int
countFromToWd Int
lo Int
hi STUArray s Int Bool
sieve
STUArray s Int Word64
new <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> m (a i e)
unsafeNewArray_ (Int
0,Int
2forall a. Num a => a -> a -> a
*Int
pctforall a. Num a => a -> a -> a
-Int
1) :: ST s (STUArray s Int Word64)
let fill :: Int -> Int -> m (STUArray s Int Word64)
fill Int
j Int
indx
| Int
hi forall a. Ord a => a -> a -> Bool
< Int
indx = forall (m :: * -> *) a. Monad m => a -> m a
return STUArray s Int Word64
new
| Bool
otherwise = do
Bool
isPr <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> Int -> m e
unsafeRead STUArray s Int Bool
sieve Int
indx
if Bool
isPr
then do
let !i :: Int
i = Int
indx forall a. Bits a => a -> a -> a
.&. Int
jMASK
!moff :: Int
moff = Int
i forall a. Bits a => a -> Int -> a
`shiftL` Int
jBITS
k :: Integer
k :: Integer
k = Int -> Integer
intToInteger (Int
indx forall a. Bits a => a -> Int -> a
`shiftR` Int
jBITS)
p :: Integer
p = Integer
30forall a. Num a => a -> a -> a
*Integer
kforall a. Num a => a -> a -> a
+Int -> Integer
intToInteger (Int -> Int
rho Int
i)
q0 :: Integer
q0 = (Integer
startforall a. Num a => a -> a -> a
-Integer
1) forall a. Integral a => a -> a -> a
`quot` Integer
p
(Integer
skp0,Integer
q1) = Integer
q0 forall a. Integral a => a -> a -> (a, a)
`quotRem` Int -> Integer
intToInteger Int
sieveRange
(Int
b0,Int
r0)
| Integer
q1 forall a. Eq a => a -> a -> Bool
== Integer
0 = (-Int
1,Int
6)
| Integer
q1 forall a. Ord a => a -> a -> Bool
< Integer
7 = (-Int
1,Int
7)
| Bool
otherwise = forall a. Integral a => a -> (Int, Int)
idxPr (Integer -> Int
integerToInt Integer
q1 :: Int)
(Int
b1,Int
r1) | Int
r0 forall a. Eq a => a -> a -> Bool
== Int
7 = (Int
b0forall a. Num a => a -> a -> a
+Int
1,Int
0)
| Bool
otherwise = (Int
b0,Int
r0forall a. Num a => a -> a -> a
+Int
1)
b2 :: Integer
b2 = Integer
skp0forall a. Num a => a -> a -> a
*Int -> Integer
intToInteger Int
sieveBytes forall a. Num a => a -> a -> a
+ Int -> Integer
intToInteger Int
b1
strt0 :: Integer
strt0 = ((Integer
kforall a. Num a => a -> a -> a
*(Integer
30forall a. Num a => a -> a -> a
*Integer
b2 forall a. Num a => a -> a -> a
+ Int -> Integer
intToInteger (Int -> Int
rho Int
r1))
forall a. Num a => a -> a -> a
+ Integer
b2 forall a. Num a => a -> a -> a
* Int -> Integer
intToInteger (Int -> Int
rho Int
i)
forall a. Num a => a -> a -> a
+ Int -> Integer
intToInteger (Int -> Int
mu (Int
moff forall a. Num a => a -> a -> a
+ Int
r1))) forall a. Bits a => a -> Int -> a
`shiftL` Int
jBITS)
forall a. Num a => a -> a -> a
+ Int -> Integer
intToInteger (Int -> Int
nu (Int
moff forall a. Num a => a -> a -> a
+ Int
r1))
strt1 :: Integer
strt1 = ((Integer
kforall a. Num a => a -> a -> a
*(Integer
30forall a. Num a => a -> a -> a
*Integer
k forall a. Num a => a -> a -> a
+ Int -> Integer
intToInteger (Int
2forall a. Num a => a -> a -> a
*Int -> Int
rho Int
i))
forall a. Num a => a -> a -> a
+ Int -> Integer
intToInteger (Int -> Int
byte Int
i)) forall a. Bits a => a -> Int -> a
`shiftL` Int
jBITS)
forall a. Num a => a -> a -> a
+ Int -> Integer
intToInteger (Int -> Int
idx Int
i)
(Integer
strt2,Int
r2)
| Integer
p forall a. Ord a => a -> a -> Bool
< Integer
ssr = (Integer
strt0 forall a. Num a => a -> a -> a
- Integer
bitOff,Int
r1)
| Bool
otherwise = (Integer
strt1 forall a. Num a => a -> a -> a
- Integer
bitOff, Int
i)
!strt :: Word64
strt = Integer -> Word64
integerToWord64 Integer
strt2 forall a. Bits a => a -> a -> a
.&. forall a. Num a => a
iXMASK
!skip :: Word64
skip = Integer -> Word64
integerToWord64 (Integer
strt2 forall a. Bits a => a -> Int -> a
`shiftR` Int
iXBITS)
!ixes :: Word64
ixes = Int -> Word64
intToWord64 Int
indx forall a. Bits a => a -> Int -> a
`shiftL` Int
iXJBITS forall a. Bits a => a -> a -> a
.|. Word64
strt forall a. Bits a => a -> Int -> a
`shiftL` Int
jBITS forall a. Bits a => a -> a -> a
.|. Int -> Word64
intToWord64 Int
r2
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> Int -> e -> m ()
unsafeWrite STUArray s Int Word64
new Int
j Word64
skip
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> Int -> e -> m ()
unsafeWrite STUArray s Int Word64
new (Int
jforall a. Num a => a -> a -> a
+Int
1) Word64
ixes
Int -> Int -> m (STUArray s Int Word64)
fill (Int
jforall a. Num a => a -> a -> a
+Int
2) (Int
indxforall a. Num a => a -> a -> a
+Int
1)
else Int -> Int -> m (STUArray s Int Word64)
fill Int
j (Int
indxforall a. Num a => a -> a -> a
+Int
1)
forall {m :: * -> *}.
(MArray (STUArray s) Bool m, MArray (STUArray s) Word64 m) =>
Int -> Int -> m (STUArray s Int Word64)
fill Int
0 Int
0
{-# INLINE delta #-}
delta :: Int -> Int
delta :: Int -> Int
delta = forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> Int -> e
unsafeAt UArray Int Int
deltas
deltas :: UArray Int Int
deltas :: UArray Int Int
deltas = forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
listArray (Int
0,Int
7) [Int
4,Int
2,Int
4,Int
2,Int
4,Int
6,Int
2,Int
6]
{-# INLINE tau #-}
tau :: Int -> Int
tau :: Int -> Int
tau = forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> Int -> e
unsafeAt UArray Int Int
taus
taus :: UArray Int Int
taus :: UArray Int Int
taus = forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
listArray (Int
0,Int
63)
[ Int
7, Int
4, Int
7, Int
4, Int
7, Int
12, Int
3, Int
12
, Int
12, Int
6, Int
11, Int
6, Int
12, Int
18, Int
5, Int
18
, Int
14, Int
7, Int
13, Int
7, Int
14, Int
21, Int
7, Int
21
, Int
18, Int
9, Int
19, Int
9, Int
18, Int
27, Int
9, Int
27
, Int
20, Int
10, Int
21, Int
10, Int
20, Int
30, Int
11, Int
30
, Int
25, Int
12, Int
25, Int
12, Int
25, Int
36, Int
13, Int
36
, Int
31, Int
15, Int
31, Int
15, Int
31, Int
47, Int
15, Int
47
, Int
33, Int
17, Int
33, Int
17, Int
33, Int
49, Int
17, Int
49
]
{-# INLINE byte #-}
byte :: Int -> Int
byte :: Int -> Int
byte = forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> Int -> e
unsafeAt UArray Int Int
startByte
startByte :: UArray Int Int
startByte :: UArray Int Int
startByte = forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
listArray (Int
0,Int
7) [Int
1,Int
3,Int
5,Int
9,Int
11,Int
17,Int
27,Int
31]
{-# INLINE idx #-}
idx :: Int -> Int
idx :: Int -> Int
idx = forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> Int -> e
unsafeAt UArray Int Int
startIdx
startIdx :: UArray Int Int
startIdx :: UArray Int Int
startIdx = forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
listArray (Int
0,Int
7) [Int
4,Int
7,Int
4,Int
4,Int
7,Int
4,Int
7,Int
7]
{-# INLINE mu #-}
mu :: Int -> Int
mu :: Int -> Int
mu = forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> Int -> e
unsafeAt UArray Int Int
mArr
{-# INLINE nu #-}
nu :: Int -> Int
nu :: Int -> Int
nu = forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> Int -> e
unsafeAt UArray Int Int
nArr
mArr :: UArray Int Int
mArr :: UArray Int Int
mArr = forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
listArray (Int
0,Int
63)
[ Int
1, Int
2, Int
2, Int
3, Int
4, Int
5, Int
6, Int
7
, Int
2, Int
3, Int
4, Int
6, Int
6, Int
8, Int
10, Int
11
, Int
2, Int
4, Int
5, Int
7, Int
8, Int
9, Int
12, Int
13
, Int
3, Int
6, Int
7, Int
9, Int
10, Int
12, Int
16, Int
17
, Int
4, Int
6, Int
8, Int
10, Int
11, Int
14, Int
18, Int
19
, Int
5, Int
8, Int
9, Int
12, Int
14, Int
17, Int
22, Int
23
, Int
6, Int
10, Int
12, Int
16, Int
18, Int
22, Int
27, Int
29
, Int
7, Int
11, Int
13, Int
17, Int
19, Int
23, Int
29, Int
31
]
nArr :: UArray Int Int
nArr :: UArray Int Int
nArr = forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
listArray (Int
0,Int
63)
[ Int
4, Int
3, Int
7, Int
6, Int
2, Int
1, Int
5, Int
0
, Int
3, Int
7, Int
5, Int
0, Int
6, Int
2, Int
4, Int
1
, Int
7, Int
5, Int
4, Int
1, Int
0, Int
6, Int
3, Int
2
, Int
6, Int
0, Int
1, Int
4, Int
5, Int
7, Int
2, Int
3
, Int
2, Int
6, Int
0, Int
5, Int
7, Int
3, Int
1, Int
4
, Int
1, Int
2, Int
6, Int
7, Int
3, Int
4, Int
0, Int
5
, Int
5, Int
4, Int
3, Int
2, Int
1, Int
0, Int
7, Int
6
, Int
0, Int
1, Int
2, Int
3, Int
4, Int
5, Int
6, Int
7
]