{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -fspec-constr-count=24 #-}
module Math.NumberTheory.Primes.Counting.Impl
( primeCount
, primeCountMaxArg
, nthPrime
) where
import Math.NumberTheory.Primes.Sieve.Eratosthenes
(PrimeSieve(..), primeList, primeSieve, psieveFrom, sieveTo, sieveBits, sieveRange)
import Math.NumberTheory.Primes.Sieve.Indexing (toPrim, idxPr)
import Math.NumberTheory.Primes.Counting.Approximate (nthPrimeApprox, approxPrimeCount)
import Math.NumberTheory.Primes.Types
import Math.NumberTheory.Roots
import Math.NumberTheory.Utils.FromIntegral
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST
import Data.Bits
import Data.Int
import Unsafe.Coerce
primeCountMaxArg :: Integer
primeCountMaxArg :: Integer
primeCountMaxArg = Integer
8000000000000000000
primeCount :: Integer -> Integer
primeCount :: Integer -> Integer
primeCount Integer
n
| Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
primeCountMaxArg = [Char] -> Integer
forall a. HasCallStack => [Char] -> a
error ([Char] -> Integer) -> [Char] -> Integer
forall a b. (a -> b) -> a -> b
$ [Char]
"primeCount: can't handle bound " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Integer -> [Char]
forall a. Show a => a -> [Char]
show Integer
n
| Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
2 = Integer
0
| Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
1000 = Int -> Integer
intToInteger (Int -> Integer) -> (Integer -> Int) -> Integer -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Integer] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Integer] -> Int) -> (Integer -> [Integer]) -> Integer -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Bool) -> [Integer] -> [Integer]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
n) ([Integer] -> [Integer])
-> (Integer -> [Integer]) -> Integer -> [Integer]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Prime Integer -> Integer) -> [Prime Integer] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map Prime Integer -> Integer
forall a. Prime a -> a
unPrime ([Prime Integer] -> [Integer])
-> (Integer -> [Prime Integer]) -> Integer -> [Integer]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrimeSieve -> [Prime Integer]
forall a. Integral a => PrimeSieve -> [Prime a]
primeList (PrimeSieve -> [Prime Integer])
-> (Integer -> PrimeSieve) -> Integer -> [Prime Integer]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> PrimeSieve
primeSieve (Integer -> Integer) -> Integer -> Integer
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
max Integer
242 Integer
n
| Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
30000 = (forall s. ST s Integer) -> Integer
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s Integer) -> Integer)
-> (forall s. ST s Integer) -> Integer
forall a b. (a -> b) -> a -> b
$ do
STUArray s Int Bool
ba <- Integer -> ST s (STUArray s Int Bool)
forall s. Integer -> ST s (STUArray s Int Bool)
sieveTo Integer
n
(Int
s,Int
e) <- STUArray s Int Bool -> ST s (Int, Int)
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> m (i, i)
getBounds STUArray s Int Bool
ba
Int
ct <- Int -> Int -> STUArray s Int Bool -> ST s Int
forall s. Int -> Int -> STUArray s Int Bool -> ST s Int
countFromTo Int
s Int
e STUArray s Int Bool
ba
Integer -> ST s Integer
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Integer
intToInteger (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ Int
ctInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
3)
| Bool
otherwise =
let !ub :: Int64
ub = Int64 -> Int64
cop (Int64 -> Int64) -> Int64 -> Int64
forall a b. (a -> b) -> a -> b
$ Integer -> Int64
forall a. Num a => Integer -> a
fromInteger Integer
n
!sr :: Int64
sr = Int64 -> Int64
forall a. Integral a => a -> a
integerSquareRoot Int64
ub
!cr :: Int64
cr = Int64 -> Int64
forall a. Integral a => a -> a
nxtEnd (Int64 -> Int64) -> Int64 -> Int64
forall a b. (a -> b) -> a -> b
$ Int64 -> Int64
forall a. Integral a => a -> a
integerCubeRoot Int64
ub Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
15
nxtEnd :: a -> a
nxtEnd a
k = a
k a -> a -> a
forall a. Num a => a -> a -> a
- (a
k a -> a -> a
forall a. Integral a => a -> a -> a
`rem` a
30) a -> a -> a
forall a. Num a => a -> a -> a
+ a
31
!phn1 :: Integer
phn1 = Int64 -> Int64 -> Integer
calc Int64
ub Int64
cr
!cs :: Int64
cs = Int64
crInt64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+Int64
6
!pdf :: Integer
pdf = Int64 -> Int64 -> Int64 -> Integer
sieveCount Int64
ub Int64
cs Int64
sr
in Integer
phn1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
pdf
nthPrime :: Int -> Prime Integer
nthPrime :: Int -> Prime Integer
nthPrime Int
1 = Integer -> Prime Integer
forall a. a -> Prime a
Prime Integer
2
nthPrime Int
2 = Integer -> Prime Integer
forall a. a -> Prime a
Prime Integer
3
nthPrime Int
3 = Integer -> Prime Integer
forall a. a -> Prime a
Prime Integer
5
nthPrime Int
4 = Integer -> Prime Integer
forall a. a -> Prime a
Prime Integer
7
nthPrime Int
5 = Integer -> Prime Integer
forall a. a -> Prime a
Prime Integer
11
nthPrime Int
6 = Integer -> Prime Integer
forall a. a -> Prime a
Prime Integer
13
nthPrime Int
n
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1
= [Char] -> Prime Integer
forall a. HasCallStack => [Char] -> a
error [Char]
"Prime indexing starts at 1"
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
200000
= Integer -> Prime Integer
forall a. a -> Prime a
Prime (Integer -> Prime Integer) -> Integer -> Prime Integer
forall a b. (a -> b) -> a -> b
$ Int -> [PrimeSieve] -> Integer
countToNth (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
3) [Integer -> PrimeSieve
primeSieve (Integer
p0 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
p0 Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`quot` Integer
32 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
37)]
| Integer
p0 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int
forall a. Bounded a => a
maxBound :: Int)
= [Char] -> Prime Integer
forall a. HasCallStack => [Char] -> a
error ([Char] -> Prime Integer) -> [Char] -> Prime Integer
forall a b. (a -> b) -> a -> b
$ [Char]
"nthPrime: index " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" is too large to handle"
| Int
miss Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
= Integer -> Prime Integer
forall a. a -> Prime a
Prime (Integer -> Prime Integer) -> Integer -> Prime Integer
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> Integer
tooLow Int
n (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
p0) Int
miss
| Bool
otherwise
= Integer -> Prime Integer
forall a. a -> Prime a
Prime (Integer -> Prime Integer) -> Integer -> Prime Integer
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> Integer
tooHigh Int
n (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
p0) (Int -> Int
forall a. Num a => a -> a
negate Int
miss)
where
p0 :: Integer
p0 = Integer -> Integer
nthPrimeApprox (Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
n)
miss :: Int
miss = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer -> Integer
primeCount Integer
p0)
tooLow :: Int -> Int -> Int -> Integer
tooLow :: Int -> Int -> Int -> Integer
tooLow Int
n Int
p0 Int
shortage
| Integer
p1 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int
forall a. Bounded a => a
maxBound :: Int)
= [Char] -> Integer
forall a. HasCallStack => [Char] -> a
error ([Char] -> Integer) -> [Char] -> Integer
forall a b. (a -> b) -> a -> b
$ [Char]
"nthPrime: index " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" is too large to handle"
| Bool
goodEnough
= Int -> Int -> Integer
lowSieve Int
p0 Int
shortage
| Int
c1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n
= Int -> Int -> Integer
lowSieve (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
p1) (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
c1)
| Bool
otherwise
= Int -> Int -> Integer
lowSieve Int
p0 Int
shortage
where
gap :: Integer
gap = Double -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Double -> Double
forall a. Floating a => a -> a
log (Int -> Double
intToDouble Int
p0 :: Double))
est :: Integer
est = Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
shortage Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
gap
p1 :: Integer
p1 = Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
p0 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
est
goodEnough :: Bool
goodEnough = Integer
3Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
estInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
estInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
est Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
2Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
p1Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
p1
c1 :: Int
c1 = Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer -> Integer
primeCount Integer
p1)
tooHigh :: Int -> Int -> Int -> Integer
tooHigh :: Int -> Int -> Int -> Integer
tooHigh Int
n Int
p0 Int
surplus
| Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n
= Int -> Int -> Integer
lowSieve Int
b (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
c)
| Bool
otherwise
= Int -> Int -> Int -> Integer
tooHigh Int
n Int
b (Int
cInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
n)
where
gap :: Int
gap = Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Double -> Double
forall a. Floating a => a -> a
log (Int -> Double
intToDouble Int
p0 :: Double))
b :: Int
b = Int
p0 Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
surplus Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
gap Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
11) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
10
c :: Int
c = Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer -> Integer
primeCount (Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
b))
lowSieve :: Int -> Int -> Integer
lowSieve :: Int -> Int -> Integer
lowSieve Int
a Int
miss = Int -> [PrimeSieve] -> Integer
countToNth (Int
missInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
rep) [PrimeSieve]
psieves
where
strt :: Int
strt = Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
a Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
1)
psieves :: [PrimeSieve]
psieves@(PS Integer
vO UArray Int Bool
ba:[PrimeSieve]
_) = Integer -> [PrimeSieve]
psieveFrom (Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
strt)
rep :: Int
rep | Integer
o0 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 = Int
0
| Bool
otherwise = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int
1 | Int
i <- [Int
0 .. Int
r2], UArray Int Bool
ba UArray Int Bool -> Int -> Bool
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> Int -> e
`unsafeAt` Int
i]
where
o0 :: Integer
o0 = Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
strt Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
vO Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
9
r0 :: Int
r0 = Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
o0 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
30
r1 :: Int
r1 = Int
r0 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
3
r2 :: Int
r2 = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
7 (if Int
r1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
5 then Int
r1Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1 else Int
r1)
sieveCount :: Int64 -> Int64 -> Int64 -> Integer
sieveCount :: Int64 -> Int64 -> Int64 -> Integer
sieveCount Int64
ub Int64
cr Int64
sr = (forall s. ST s Integer) -> Integer
forall a. (forall s. ST s a) -> a
runST (Int64 -> Int64 -> Int64 -> ST s Integer
forall s. Int64 -> Int64 -> Int64 -> ST s Integer
sieveCountST Int64
ub Int64
cr Int64
sr)
sieveCountST :: forall s. Int64 -> Int64 -> Int64 -> ST s Integer
sieveCountST :: Int64 -> Int64 -> Int64 -> ST s Integer
sieveCountST Int64
ub Int64
cr Int64
sr = do
let psieves :: [PrimeSieve]
psieves = Integer -> [PrimeSieve]
psieveFrom (Int64 -> Integer
int64ToInteger Int64
cr)
pisr :: Int64
pisr = Int64 -> Int64
forall a. Integral a => a -> a
approxPrimeCount Int64
sr
picr :: Int64
picr = Int64 -> Int64
forall a. Integral a => a -> a
approxPrimeCount Int64
cr
diff :: Int64
diff = Int64
pisr Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
picr
size :: Int
size = Int64 -> Int
int64ToInt (Int64
diff Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
diff Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`quot` Int64
50) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
30
STUArray s Int Int64
store <- (Int, Int) -> ST s (STUArray s Int Int64)
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> m (a i e)
unsafeNewArray_ (Int
0,Int
sizeInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) :: ST s (STUArray s Int Int64)
let feed :: Int64 -> Int -> Int -> UArray Int Bool -> [PrimeSieve] -> ST s Integer
feed :: Int64
-> Int -> Int -> UArray Int Bool -> [PrimeSieve] -> ST s Integer
feed Int64
voff !Int
wi !Int
ri UArray Int Bool
uar [PrimeSieve]
sves
| Int
ri Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
sieveBits = case [PrimeSieve]
sves of
(PS Integer
vO UArray Int Bool
ba : [PrimeSieve]
more) -> Int64
-> Int -> Int -> UArray Int Bool -> [PrimeSieve] -> ST s Integer
feed (Integer -> Int64
forall a. Num a => Integer -> a
fromInteger Integer
vO) Int
wi Int
0 UArray Int Bool
ba [PrimeSieve]
more
[PrimeSieve]
_ -> [Char] -> ST s Integer
forall a. HasCallStack => [Char] -> a
error [Char]
"prime stream ended prematurely"
| Int64
pval Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
sr = do
STUArray s Int Bool
stu <- UArray Int Bool -> ST s (STUArray s Int Bool)
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 Bool
uar
Integer
-> Integer
-> Int64
-> Int
-> Int
-> STUArray s Int Bool
-> [PrimeSieve]
-> ST s Integer
eat Integer
0 Integer
0 Int64
voff (Int
wiInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int
ri STUArray s Int Bool
stu [PrimeSieve]
sves
| UArray Int Bool
uar UArray Int Bool -> Int -> Bool
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> Int -> e
`unsafeAt` Int
ri = do
STUArray s Int Int64 -> Int -> Int64 -> ST s ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> Int -> e -> m ()
unsafeWrite STUArray s Int Int64
store Int
wi (Int64
ub Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`quot` Int64
pval)
Int64
-> Int -> Int -> UArray Int Bool -> [PrimeSieve] -> ST s Integer
feed Int64
voff (Int
wiInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int
riInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) UArray Int Bool
uar [PrimeSieve]
sves
| Bool
otherwise = Int64
-> Int -> Int -> UArray Int Bool -> [PrimeSieve] -> ST s Integer
feed Int64
voff Int
wi (Int
riInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) UArray Int Bool
uar [PrimeSieve]
sves
where
pval :: Int64
pval = Int64
voff Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int -> Int64
forall a. Num a => Int -> a
toPrim Int
ri
eat :: Integer -> Integer -> Int64 -> Int -> Int -> STUArray s Int Bool -> [PrimeSieve] -> ST s Integer
eat :: Integer
-> Integer
-> Int64
-> Int
-> Int
-> STUArray s Int Bool
-> [PrimeSieve]
-> ST s Integer
eat !Integer
acc !Integer
btw Int64
voff !Int
wi !Int
si STUArray s Int Bool
stu [PrimeSieve]
sves
| Int
si Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
sieveBits =
case [PrimeSieve]
sves of
[] -> [Char] -> ST s Integer
forall a. HasCallStack => [Char] -> a
error [Char]
"Premature end of prime stream"
(PS Integer
vO UArray Int Bool
ba : [PrimeSieve]
more) -> do
STUArray s Int Bool
nstu <- UArray Int Bool -> ST s (STUArray s Int Bool)
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 Bool
ba
Integer
-> Integer
-> Int64
-> Int
-> Int
-> STUArray s Int Bool
-> [PrimeSieve]
-> ST s Integer
eat Integer
acc Integer
btw (Integer -> Int64
forall a. Num a => Integer -> a
fromInteger Integer
vO) Int
wi Int
0 STUArray s Int Bool
nstu [PrimeSieve]
more
| Int
wi Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = Integer -> ST s Integer
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
acc
| Bool
otherwise = do
Int64
qb <- STUArray s Int Int64 -> Int -> ST s Int64
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> Int -> m e
unsafeRead STUArray s Int Int64
store Int
wi
let dist :: Int64
dist = Int64
qb Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
voff Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
7
if Int64
dist Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Int -> Int64
intToInt64 Int
sieveRange
then do
let (Int
b,Int
j) = Int64 -> (Int, Int)
forall a. Integral a => a -> (Int, Int)
idxPr (Int64
distInt64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+Int64
7)
!li :: Int
li = (Int
b Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
3) Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
j
Int
new <- if Int
li Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
si then Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
0 else Int -> Int -> STUArray s Int Bool -> ST s Int
forall s. Int -> Int -> STUArray s Int Bool -> ST s Int
countFromTo Int
si Int
li STUArray s Int Bool
stu
let nbtw :: Integer
nbtw = Integer
btw Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Int -> Integer
intToInteger Int
new Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1
Integer
-> Integer
-> Int64
-> Int
-> Int
-> STUArray s Int Bool
-> [PrimeSieve]
-> ST s Integer
eat (Integer
accInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
nbtw) Integer
nbtw Int64
voff (Int
wiInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (Int
liInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) STUArray s Int Bool
stu [PrimeSieve]
sves
else do
let (Int64
cpl,Int64
fds) = Int64
dist Int64 -> Int64 -> (Int64, Int64)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int -> Int64
intToInt64 Int
sieveRange
(Int
b,Int
j) = Int64 -> (Int, Int)
forall a. Integral a => a -> (Int, Int)
idxPr (Int64
fdsInt64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+Int64
7)
!li :: Int
li = (Int
b Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
3) Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
j
ctLoop :: Integer -> t -> [PrimeSieve] -> ST s Integer
ctLoop !Integer
lac t
0 (PS Integer
vO UArray Int Bool
ba : [PrimeSieve]
more) = do
STUArray s Int Bool
nstu <- UArray Int Bool -> ST s (STUArray s Int Bool)
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 Bool
ba
Int
new <- Int -> Int -> STUArray s Int Bool -> ST s Int
forall s. Int -> Int -> STUArray s Int Bool -> ST s Int
countFromTo Int
0 Int
li STUArray s Int Bool
nstu
let nbtw :: Integer
nbtw = Integer
btw Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
lac Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Int -> Integer
intToInteger Int
new
Integer
-> Integer
-> Int64
-> Int
-> Int
-> STUArray s Int Bool
-> [PrimeSieve]
-> ST s Integer
eat (Integer
accInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
nbtw) Integer
nbtw (Integer -> Int64
integerToInt64 Integer
vO) (Int
wiInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (Int
liInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) STUArray s Int Bool
nstu [PrimeSieve]
more
ctLoop Integer
lac t
s (PrimeSieve
ps : [PrimeSieve]
more) = do
let !new :: Int
new = PrimeSieve -> Int
countAll PrimeSieve
ps
Integer -> t -> [PrimeSieve] -> ST s Integer
ctLoop (Integer
lac Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Int -> Integer
intToInteger Int
new) (t
st -> t -> t
forall a. Num a => a -> a -> a
-t
1) [PrimeSieve]
more
ctLoop Integer
_ t
_ [] = [Char] -> ST s Integer
forall a. HasCallStack => [Char] -> a
error [Char]
"Primes ended"
Int
new <- Int -> Int -> STUArray s Int Bool -> ST s Int
forall s. Int -> Int -> STUArray s Int Bool -> ST s Int
countFromTo Int
si (Int
sieveBitsInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) STUArray s Int Bool
stu
Integer -> Int64 -> [PrimeSieve] -> ST s Integer
forall t.
(Eq t, Num t) =>
Integer -> t -> [PrimeSieve] -> ST s Integer
ctLoop (Int -> Integer
intToInteger Int
new) (Int64
cplInt64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
-Int64
1) [PrimeSieve]
sves
case [PrimeSieve]
psieves of
(PS Integer
vO UArray Int Bool
ba : [PrimeSieve]
more) -> Int64
-> Int -> Int -> UArray Int Bool -> [PrimeSieve] -> ST s Integer
feed (Integer -> Int64
forall a. Num a => Integer -> a
fromInteger Integer
vO) Int
0 Int
0 UArray Int Bool
ba [PrimeSieve]
more
[PrimeSieve]
_ -> [Char] -> ST s Integer
forall a. HasCallStack => [Char] -> a
error [Char]
"No primes sieved"
calc :: Int64 -> Int64 -> Integer
calc :: Int64 -> Int64 -> Integer
calc Int64
lim Int64
plim = (forall s. ST s Integer) -> Integer
forall a. (forall s. ST s a) -> a
runST (Int64 -> Int64 -> ST s Integer
forall s. Int64 -> Int64 -> ST s Integer
calcST Int64
lim Int64
plim)
calcST :: forall s. Int64 -> Int64 -> ST s Integer
calcST :: Int64 -> Int64 -> ST s Integer
calcST Int64
lim Int64
plim = do
!STUArray s Int Bool
parr <- Integer -> ST s (STUArray s Int Bool)
forall s. Integer -> ST s (STUArray s Int Bool)
sieveTo (Int64 -> Integer
int64ToInteger Int64
plim)
(Int
plo,Int
phi) <- STUArray s Int Bool -> ST s (Int, Int)
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> m (i, i)
getBounds STUArray s Int Bool
parr
!Int
pct <- Int -> Int -> STUArray s Int Bool -> ST s Int
forall s. Int -> Int -> STUArray s Int Bool -> ST s Int
countFromTo Int
plo Int
phi STUArray s Int Bool
parr
!STUArray s Int Int64
ar1 <- (Int, Int) -> ST s (STUArray s Int Int64)
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> m (a i e)
unsafeNewArray_ (Int
0,Int
endInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
STUArray s Int Int64 -> Int -> Int64 -> ST s ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> Int -> e -> m ()
unsafeWrite STUArray s Int Int64
ar1 Int
0 Int64
lim
STUArray s Int Int64 -> Int -> Int64 -> ST s ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> Int -> e -> m ()
unsafeWrite STUArray s Int Int64
ar1 Int
1 Int64
1
!STUArray s Int Int64
ar2 <- (Int, Int) -> ST s (STUArray s Int Int64)
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> m (a i e)
unsafeNewArray_ (Int
0,Int
endInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
let go :: Int -> Int -> STUArray s Int Int64 -> STUArray s Int Int64 -> ST s Integer
go :: Int
-> Int
-> STUArray s Int Int64
-> STUArray s Int Int64
-> ST s Integer
go Int
cap Int
pix STUArray s Int Int64
old STUArray s Int Int64
new
| Int
pix Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 = Int -> STUArray s Int Int64 -> ST s Integer
coll Int
cap STUArray s Int Int64
old
| Bool
otherwise = do
Bool
isp <- STUArray s Int Bool -> Int -> ST s Bool
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> Int -> m e
unsafeRead STUArray s Int Bool
parr Int
pix
if Bool
isp
then do
let !n :: Int64
n = Integer -> Int64
forall a. Num a => Integer -> a
fromInteger (Int -> Integer
forall a. Num a => Int -> a
toPrim Int
pix)
!Int
ncap <- Int
-> Int64
-> STUArray s Int Int64
-> STUArray s Int Int64
-> ST s Int
forall s.
Int
-> Int64
-> STUArray s Int Int64
-> STUArray s Int Int64
-> ST s Int
treat Int
cap Int64
n STUArray s Int Int64
old STUArray s Int Int64
new
Int
-> Int
-> STUArray s Int Int64
-> STUArray s Int Int64
-> ST s Integer
go Int
ncap (Int
pixInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) STUArray s Int Int64
new STUArray s Int Int64
old
else Int
-> Int
-> STUArray s Int Int64
-> STUArray s Int Int64
-> ST s Integer
go Int
cap (Int
pixInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) STUArray s Int Int64
old STUArray s Int Int64
new
coll :: Int -> STUArray s Int Int64 -> ST s Integer
coll :: Int -> STUArray s Int Int64 -> ST s Integer
coll Int
stop STUArray s Int Int64
ar =
let cgo :: Integer -> Int -> m Integer
cgo !Integer
acc Int
i
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
stop = do
!Int64
k <- STUArray s Int Int64 -> Int -> m Int64
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> Int -> m e
unsafeRead STUArray s Int Int64
ar Int
i
!Int64
v <- STUArray s Int Int64 -> Int -> m Int64
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> Int -> m e
unsafeRead STUArray s Int Int64
ar (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
Integer -> Int -> m Integer
cgo (Integer
acc Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Int64 -> Integer
int64ToInteger Int64
vInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*Int64 -> Integer
cp6 Int64
k) (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2)
| Bool
otherwise = Integer -> m Integer
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer
accInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Int -> Integer
intToInteger Int
pctInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
2)
in Integer -> Int -> ST s Integer
forall (m :: * -> *).
MArray (STUArray s) Int64 m =>
Integer -> Int -> m Integer
cgo Integer
0 Int
0
Int
-> Int
-> STUArray s Int Int64
-> STUArray s Int Int64
-> ST s Integer
go Int
2 Int
start STUArray s Int Int64
ar1 STUArray s Int Int64
ar2
where
(Int
bt,Int
ri) = Int64 -> (Int, Int)
forall a. Integral a => a -> (Int, Int)
idxPr Int64
plim
!start :: Int
start = Int
8Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
bt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ri
!size :: Int
size = Int64 -> Int
int64ToInt (Int64 -> Int) -> Int64 -> Int
forall a b. (a -> b) -> a -> b
$ Int64 -> Int64
forall a. Integral a => a -> a
integerSquareRoot Int64
lim Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`quot` Int64
4
!end :: Int
end = Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
size
treat :: Int -> Int64 -> STUArray s Int Int64 -> STUArray s Int Int64 -> ST s Int
treat :: Int
-> Int64
-> STUArray s Int Int64
-> STUArray s Int Int64
-> ST s Int
treat Int
end Int64
n STUArray s Int Int64
old STUArray s Int Int64
new = do
Int
qi0 <- Int64 -> Int -> Int -> STUArray s Int Int64 -> ST s Int
forall s. Int64 -> Int -> Int -> STUArray s Int Int64 -> ST s Int
locate Int64
n Int
0 (Int
end Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) STUArray s Int Int64
old
let collect :: Int64 -> Int64 -> Int -> m (Int64, Int)
collect Int64
stop !Int64
acc Int
ix
| Int
ix Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
end = do
!Int64
k <- STUArray s Int Int64 -> Int -> m Int64
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> Int -> m e
unsafeRead STUArray s Int Int64
old Int
ix
if Int64
k Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Int64
stop
then do
Int64
v <- STUArray s Int Int64 -> Int -> m Int64
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> Int -> m e
unsafeRead STUArray s Int Int64
old (Int
ixInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
Int64 -> Int64 -> Int -> m (Int64, Int)
collect Int64
stop (Int64
accInt64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
-Int64
v) (Int
ixInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2)
else (Int64, Int) -> m (Int64, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int64
acc,Int
ix)
| Bool
otherwise = (Int64, Int) -> m (Int64, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int64
acc,Int
ix)
goTreat :: Int -> Int -> Int -> ST s Int
goTreat !Int
wi !Int
ci Int
qi
| Int
qi Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
end = do
!Int64
key <- STUArray s Int Int64 -> Int -> ST s Int64
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> Int -> m e
unsafeRead STUArray s Int Int64
old Int
qi
!Int64
val <- STUArray s Int Int64 -> Int -> ST s Int64
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> Int -> m e
unsafeRead STUArray s Int Int64
old (Int
qiInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
let !q0 :: Int64
q0 = Int64
key Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`quot` Int64
n
!r0 :: Int
r0 = Int64 -> Int
int64ToInt (Int64
q0 Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`rem` Int64
30030)
!nkey :: Int64
nkey = Int64
q0 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int8 -> Int64
int8ToInt64 (UArray Int Int8
cpDfAr UArray Int Int8 -> Int -> Int8
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> Int -> e
`unsafeAt` Int
r0)
nk0 :: Int64
nk0 = Int64
q0 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int8 -> Int64
int8ToInt64 (UArray Int Int8
cpGpAr UArray Int Int8 -> Int -> Int8
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> Int -> e
`unsafeAt` (Int
r0Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int8 -> Int8 -> Int8
forall a. Num a => a -> a -> a
+ Int8
1)
!nlim :: Int64
nlim = Int64
nInt64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
*Int64
nk0
(Int
wi1,Int
ci1) <- Int
-> Int64
-> STUArray s Int Int64
-> Int
-> STUArray s Int Int64
-> Int
-> ST s (Int, Int)
forall s.
Int
-> Int64
-> STUArray s Int Int64
-> Int
-> STUArray s Int Int64
-> Int
-> ST s (Int, Int)
copyTo Int
end Int64
nkey STUArray s Int Int64
old Int
ci STUArray s Int Int64
new Int
wi
Int64
ckey <- STUArray s Int Int64 -> Int -> ST s Int64
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> Int -> m e
unsafeRead STUArray s Int Int64
old Int
ci1
(!Int64
acc, !Int
ci2) <- if Int64
ckey Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
nkey
then do
!Int64
ov <- STUArray s Int Int64 -> Int -> ST s Int64
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> Int -> m e
unsafeRead STUArray s Int Int64
old (Int
ci1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
(Int64, Int) -> ST s (Int64, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int64
ovInt64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
-Int64
val,Int
ci1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2)
else (Int64, Int) -> ST s (Int64, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (-Int64
val,Int
ci1)
(!Int64
tot, !Int
nqi) <- Int64 -> Int64 -> Int -> ST s (Int64, Int)
forall (m :: * -> *).
MArray (STUArray s) Int64 m =>
Int64 -> Int64 -> Int -> m (Int64, Int)
collect Int64
nlim Int64
acc (Int
qiInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2)
STUArray s Int Int64 -> Int -> Int64 -> ST s ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> Int -> e -> m ()
unsafeWrite STUArray s Int Int64
new Int
wi1 Int64
nkey
STUArray s Int Int64 -> Int -> Int64 -> ST s ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> Int -> e -> m ()
unsafeWrite STUArray s Int Int64
new (Int
wi1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int64
tot
Int -> Int -> Int -> ST s Int
goTreat (Int
wi1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2) Int
ci2 Int
nqi
| Bool
otherwise = Int
-> STUArray s Int Int64
-> Int
-> STUArray s Int Int64
-> Int
-> ST s Int
forall s.
Int
-> STUArray s Int Int64
-> Int
-> STUArray s Int Int64
-> Int
-> ST s Int
copyRem Int
end STUArray s Int Int64
old Int
ci STUArray s Int Int64
new Int
wi
Int -> Int -> Int -> ST s Int
goTreat Int
0 Int
0 Int
qi0
locate :: Int64 -> Int -> Int -> STUArray s Int Int64 -> ST s Int
locate :: Int64 -> Int -> Int -> STUArray s Int Int64 -> ST s Int
locate Int64
p Int
low Int
high STUArray s Int Int64
arr = do
let go :: Int -> Int -> m Int
go Int
lo Int
hi
| Int
lo Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
hi = do
let !md :: Int
md = (Int
loInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
hi) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
2
Int64
v <- STUArray s Int Int64 -> Int -> m Int64
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> Int -> m e
unsafeRead STUArray s Int Int64
arr (Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
md)
case Int64 -> Int64 -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int64
p Int64
v of
Ordering
LT -> Int -> Int -> m Int
go Int
lo Int
md
Ordering
EQ -> Int -> m Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
md)
Ordering
GT -> Int -> Int -> m Int
go (Int
mdInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
hi
| Bool
otherwise = Int -> m Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
lo)
Int -> Int -> ST s Int
forall (m :: * -> *).
MArray (STUArray s) Int64 m =>
Int -> Int -> m Int
go Int
low Int
high
{-# INLINE copyTo #-}
copyTo :: Int -> Int64 -> STUArray s Int Int64 -> Int
-> STUArray s Int Int64 -> Int -> ST s (Int,Int)
copyTo :: Int
-> Int64
-> STUArray s Int Int64
-> Int
-> STUArray s Int Int64
-> Int
-> ST s (Int, Int)
copyTo Int
end Int64
lim STUArray s Int Int64
old Int
oi STUArray s Int Int64
new Int
ni = do
let go :: Int -> Int -> m (Int, Int)
go Int
ri Int
wi
| Int
ri Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
end = do
Int64
ok <- STUArray s Int Int64 -> Int -> m Int64
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> Int -> m e
unsafeRead STUArray s Int Int64
old Int
ri
if Int64
ok Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Int64
lim
then do
!Int64
ov <- STUArray s Int Int64 -> Int -> m Int64
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> Int -> m e
unsafeRead STUArray s Int Int64
old (Int
riInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
STUArray s Int Int64 -> Int -> Int64 -> m ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> Int -> e -> m ()
unsafeWrite STUArray s Int Int64
new Int
wi Int64
ok
STUArray s Int Int64 -> Int -> Int64 -> m ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> Int -> e -> m ()
unsafeWrite STUArray s Int Int64
new (Int
wiInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int64
ov
Int -> Int -> m (Int, Int)
go (Int
riInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2) (Int
wiInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2)
else (Int, Int) -> m (Int, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
wi,Int
ri)
| Bool
otherwise = (Int, Int) -> m (Int, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
wi,Int
ri)
Int -> Int -> ST s (Int, Int)
forall (m :: * -> *).
MArray (STUArray s) Int64 m =>
Int -> Int -> m (Int, Int)
go Int
oi Int
ni
{-# INLINE copyRem #-}
copyRem :: Int -> STUArray s Int Int64 -> Int -> STUArray s Int Int64 -> Int -> ST s Int
copyRem :: Int
-> STUArray s Int Int64
-> Int
-> STUArray s Int Int64
-> Int
-> ST s Int
copyRem Int
end STUArray s Int Int64
old Int
oi STUArray s Int Int64
new Int
ni = do
let go :: Int -> Int -> m Int
go Int
ri Int
wi
| Int
ri Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
end = do
STUArray s Int Int64 -> Int -> m Int64
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> Int -> m e
unsafeRead STUArray s Int Int64
old Int
ri m Int64 -> (Int64 -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= STUArray s Int Int64 -> Int -> Int64 -> m ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> Int -> e -> m ()
unsafeWrite STUArray s Int Int64
new Int
wi
Int -> Int -> m Int
go (Int
riInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int
wiInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
| Bool
otherwise = Int -> m Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
wi
Int -> Int -> ST s Int
forall (m :: * -> *).
MArray (STUArray s) Int64 m =>
Int -> Int -> m Int
go Int
oi Int
ni
{-# INLINE cp6 #-}
cp6 :: Int64 -> Integer
cp6 :: Int64 -> Integer
cp6 Int64
k =
case Int64
k Int64 -> Int64 -> (Int64, Int64)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int64
30030 of
(Int64
q,Int64
r) -> Integer
5760Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*Int64 -> Integer
int64ToInteger Int64
q Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+
Int16 -> Integer
int16ToInteger (UArray Int Int16
cpCtAr UArray Int Int16 -> Int -> Int16
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> Int -> e
`unsafeAt` Int64 -> Int
int64ToInt Int64
r)
cop :: Int64 -> Int64
cop :: Int64 -> Int64
cop Int64
m = Int64
m Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int8 -> Int64
int8ToInt64 (UArray Int Int8
cpDfAr UArray Int Int8 -> Int -> Int8
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> Int -> e
`unsafeAt` Int64 -> Int
int64ToInt (Int64
m Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`rem` Int64
30030))
cpCtAr :: UArray Int Int16
cpCtAr :: UArray Int Int16
cpCtAr = (forall s. ST s (STUArray s Int Int16)) -> UArray Int Int16
forall i e. (forall s. ST s (STUArray s i e)) -> UArray i e
runSTUArray ((forall s. ST s (STUArray s Int Int16)) -> UArray Int Int16)
-> (forall s. ST s (STUArray s Int Int16)) -> UArray Int Int16
forall a b. (a -> b) -> a -> b
$ do
STUArray s Int Int16
ar <- (Int, Int) -> Int16 -> ST s (STUArray s Int Int16)
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> e -> m (a i e)
newArray (Int
0,Int
30029) Int16
1
let zilch :: Int -> Int -> m ()
zilch Int
s Int
i
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
30030 = STUArray s Int Int16 -> Int -> Int16 -> m ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> Int -> e -> m ()
unsafeWrite STUArray s Int Int16
ar Int
i Int16
0 m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Int -> m ()
zilch Int
s (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
s)
| Bool
otherwise = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
accumulate :: Int16 -> Int -> m (STUArray s Int Int16)
accumulate Int16
ct Int
i
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
30030 = do
Int16
v <- STUArray s Int Int16 -> Int -> m Int16
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> Int -> m e
unsafeRead STUArray s Int Int16
ar Int
i
let !ct' :: Int16
ct' = Int16
ctInt16 -> Int16 -> Int16
forall a. Num a => a -> a -> a
+Int16
v
STUArray s Int Int16 -> Int -> Int16 -> m ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> Int -> e -> m ()
unsafeWrite STUArray s Int Int16
ar Int
i Int16
ct'
Int16 -> Int -> m (STUArray s Int Int16)
accumulate Int16
ct' (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
| Bool
otherwise = STUArray s Int Int16 -> m (STUArray s Int Int16)
forall (m :: * -> *) a. Monad m => a -> m a
return STUArray s Int Int16
ar
Int -> Int -> ST s ()
forall (m :: * -> *).
MArray (STUArray s) Int16 m =>
Int -> Int -> m ()
zilch Int
2 Int
0
Int -> Int -> ST s ()
forall (m :: * -> *).
MArray (STUArray s) Int16 m =>
Int -> Int -> m ()
zilch Int
6 Int
3
Int -> Int -> ST s ()
forall (m :: * -> *).
MArray (STUArray s) Int16 m =>
Int -> Int -> m ()
zilch Int
10 Int
5
Int -> Int -> ST s ()
forall (m :: * -> *).
MArray (STUArray s) Int16 m =>
Int -> Int -> m ()
zilch Int
14 Int
7
Int -> Int -> ST s ()
forall (m :: * -> *).
MArray (STUArray s) Int16 m =>
Int -> Int -> m ()
zilch Int
22 Int
11
Int -> Int -> ST s ()
forall (m :: * -> *).
MArray (STUArray s) Int16 m =>
Int -> Int -> m ()
zilch Int
26 Int
13
Int16 -> Int -> ST s (STUArray s Int Int16)
forall (m :: * -> *).
MArray (STUArray s) Int16 m =>
Int16 -> Int -> m (STUArray s Int Int16)
accumulate Int16
1 Int
2
cpDfAr :: UArray Int Int8
cpDfAr :: UArray Int Int8
cpDfAr = (forall s. ST s (STUArray s Int Int8)) -> UArray Int Int8
forall i e. (forall s. ST s (STUArray s i e)) -> UArray i e
runSTUArray ((forall s. ST s (STUArray s Int Int8)) -> UArray Int Int8)
-> (forall s. ST s (STUArray s Int Int8)) -> UArray Int Int8
forall a b. (a -> b) -> a -> b
$ do
STUArray s Int Int8
ar <- (Int, Int) -> Int8 -> ST s (STUArray s Int Int8)
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> e -> m (a i e)
newArray (Int
0,Int
30029) Int8
0
let note :: Int -> Int -> m ()
note Int
s Int
i
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
30029 = STUArray s Int Int8 -> Int -> Int8 -> m ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> Int -> e -> m ()
unsafeWrite STUArray s Int Int8
ar Int
i Int8
1 m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Int -> m ()
note Int
s (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
s)
| Bool
otherwise = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
accumulate :: Int8 -> Int -> m (STUArray s Int Int8)
accumulate Int8
d Int
i
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
30029 = do
Int8
v <- STUArray s Int Int8 -> Int -> m Int8
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> Int -> m e
unsafeRead STUArray s Int Int8
ar Int
i
if Int8
v Int8 -> Int8 -> Bool
forall a. Eq a => a -> a -> Bool
== Int8
0
then Int8 -> Int -> m (STUArray s Int Int8)
accumulate Int8
2 (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2)
else do STUArray s Int Int8 -> Int -> Int8 -> m ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> Int -> e -> m ()
unsafeWrite STUArray s Int Int8
ar Int
i Int8
d
Int8 -> Int -> m (STUArray s Int Int8)
accumulate (Int8
dInt8 -> Int8 -> Int8
forall a. Num a => a -> a -> a
+Int8
1) (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
| Bool
otherwise = STUArray s Int Int8 -> m (STUArray s Int Int8)
forall (m :: * -> *) a. Monad m => a -> m a
return STUArray s Int Int8
ar
Int -> Int -> ST s ()
forall (m :: * -> *).
MArray (STUArray s) Int8 m =>
Int -> Int -> m ()
note Int
2 Int
0
Int -> Int -> ST s ()
forall (m :: * -> *).
MArray (STUArray s) Int8 m =>
Int -> Int -> m ()
note Int
6 Int
3
Int -> Int -> ST s ()
forall (m :: * -> *).
MArray (STUArray s) Int8 m =>
Int -> Int -> m ()
note Int
10 Int
5
Int -> Int -> ST s ()
forall (m :: * -> *).
MArray (STUArray s) Int8 m =>
Int -> Int -> m ()
note Int
14 Int
7
Int -> Int -> ST s ()
forall (m :: * -> *).
MArray (STUArray s) Int8 m =>
Int -> Int -> m ()
note Int
22 Int
11
Int -> Int -> ST s ()
forall (m :: * -> *).
MArray (STUArray s) Int8 m =>
Int -> Int -> m ()
note Int
26 Int
13
Int8 -> Int -> ST s (STUArray s Int Int8)
forall (m :: * -> *).
MArray (STUArray s) Int8 m =>
Int8 -> Int -> m (STUArray s Int Int8)
accumulate Int8
2 Int
3
cpGpAr :: UArray Int Int8
cpGpAr :: UArray Int Int8
cpGpAr = (forall s. ST s (STUArray s Int Int8)) -> UArray Int Int8
forall i e. (forall s. ST s (STUArray s i e)) -> UArray i e
runSTUArray ((forall s. ST s (STUArray s Int Int8)) -> UArray Int Int8)
-> (forall s. ST s (STUArray s Int Int8)) -> UArray Int Int8
forall a b. (a -> b) -> a -> b
$ do
STUArray s Int Int8
ar <- (Int, Int) -> Int8 -> ST s (STUArray s Int Int8)
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> e -> m (a i e)
newArray (Int
0,Int
30030) Int8
0
STUArray s Int Int8 -> Int -> Int8 -> ST s ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> Int -> e -> m ()
unsafeWrite STUArray s Int Int8
ar Int
30030 Int8
1
let note :: Int -> Int -> m ()
note Int
s Int
i
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
30029 = STUArray s Int Int8 -> Int -> Int8 -> m ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> Int -> e -> m ()
unsafeWrite STUArray s Int Int8
ar Int
i Int8
1 m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Int -> m ()
note Int
s (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
s)
| Bool
otherwise = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
accumulate :: Int8 -> Int -> m (STUArray s Int Int8)
accumulate Int8
d Int
i
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 = STUArray s Int Int8 -> m (STUArray s Int Int8)
forall (m :: * -> *) a. Monad m => a -> m a
return STUArray s Int Int8
ar
| Bool
otherwise = do
Int8
v <- STUArray s Int Int8 -> Int -> m Int8
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> Int -> m e
unsafeRead STUArray s Int Int8
ar Int
i
if Int8
v Int8 -> Int8 -> Bool
forall a. Eq a => a -> a -> Bool
== Int8
0
then Int8 -> Int -> m (STUArray s Int Int8)
accumulate Int8
2 (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2)
else do STUArray s Int Int8 -> Int -> Int8 -> m ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> Int -> e -> m ()
unsafeWrite STUArray s Int Int8
ar Int
i Int8
d
Int8 -> Int -> m (STUArray s Int Int8)
accumulate (Int8
dInt8 -> Int8 -> Int8
forall a. Num a => a -> a -> a
+Int8
1) (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
Int -> Int -> ST s ()
forall (m :: * -> *).
MArray (STUArray s) Int8 m =>
Int -> Int -> m ()
note Int
2 Int
0
Int -> Int -> ST s ()
forall (m :: * -> *).
MArray (STUArray s) Int8 m =>
Int -> Int -> m ()
note Int
6 Int
3
Int -> Int -> ST s ()
forall (m :: * -> *).
MArray (STUArray s) Int8 m =>
Int -> Int -> m ()
note Int
10 Int
5
Int -> Int -> ST s ()
forall (m :: * -> *).
MArray (STUArray s) Int8 m =>
Int -> Int -> m ()
note Int
14 Int
7
Int -> Int -> ST s ()
forall (m :: * -> *).
MArray (STUArray s) Int8 m =>
Int -> Int -> m ()
note Int
22 Int
11
Int -> Int -> ST s ()
forall (m :: * -> *).
MArray (STUArray s) Int8 m =>
Int -> Int -> m ()
note Int
26 Int
13
Int8 -> Int -> ST s (STUArray s Int Int8)
forall (m :: * -> *).
MArray (STUArray s) Int8 m =>
Int8 -> Int -> m (STUArray s Int Int8)
accumulate Int8
2 Int
30027
rMASK :: Int
rMASK :: Int
rMASK = Word -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize (Word
0 :: Word) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
wSHFT :: (Bits a, Num a) => a
wSHFT :: a
wSHFT = if Word -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize (Word
0 :: Word) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
64 then a
6 else a
5
tOPB :: Int
tOPB :: Int
tOPB = Word -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize (Word
0 :: Word) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
1
tOPM :: (Bits a, Num a) => a
tOPM :: a
tOPM = (a
1 a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftL` Int
tOPB) a -> a -> a
forall a. Num a => a -> a -> a
- a
1
countToNth :: Int -> [PrimeSieve] -> Integer
countToNth :: Int -> [PrimeSieve] -> Integer
countToNth !Int
_ [] = [Char] -> Integer
forall a. HasCallStack => [Char] -> a
error [Char]
"countToNth: Prime stream ended prematurely"
countToNth !Int
n (PS Integer
v0 UArray Int Bool
bs : [PrimeSieve]
more) = Int -> Int -> Integer
go Int
n Int
0
where
wa :: UArray Int Word
wa :: UArray Int Word
wa = UArray Int Bool -> UArray Int Word
forall a b. a -> b
unsafeCoerce UArray Int Bool
bs
go :: Int -> Int -> Integer
go !Int
k Int
i
| Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (Int, Int) -> Int
forall a b. (a, b) -> b
snd (UArray Int Word -> (Int, Int)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
bounds UArray Int Word
wa)
= Int -> [PrimeSieve] -> Integer
countToNth Int
k [PrimeSieve]
more
| Bool
otherwise
= let w :: Word
w = UArray Int Word -> Int -> Word
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> Int -> e
unsafeAt UArray Int Word
wa Int
i
bc :: Int
bc = Word -> Int
forall a. Bits a => a -> Int
popCount Word
w
in if Int
bc Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
k
then Int -> Int -> Integer
go (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
bc) (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
else let j :: Int
j = Int
bc Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
k
px :: Int
px = Word -> Int -> Int -> Int
top Word
w Int
j Int
bc
in Integer
v0 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Int -> Integer
forall a. Num a => Int -> a
toPrim (Int
px Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
i Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
forall a. (Bits a, Num a) => a
wSHFT))
countAll :: PrimeSieve -> Int
countAll :: PrimeSieve -> Int
countAll (PS Integer
_ UArray Int Bool
bs) = Int -> Int -> Int
go Int
0 Int
0
where
wa :: UArray Int Word
wa :: UArray Int Word
wa = UArray Int Bool -> UArray Int Word
forall a b. a -> b
unsafeCoerce UArray Int Bool
bs
go :: Int -> Int -> Int
go !Int
ct Int
i
| Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (Int, Int) -> Int
forall a b. (a, b) -> b
snd (UArray Int Word -> (Int, Int)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
bounds UArray Int Word
wa)
= Int
ct
| Bool
otherwise
= Int -> Int -> Int
go (Int
ct Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word -> Int
forall a. Bits a => a -> Int
popCount (UArray Int Word -> Int -> Word
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> Int -> e
unsafeAt UArray Int Word
wa Int
i)) (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
top :: Word -> Int -> Int -> Int
top :: Word -> Int -> Int -> Int
top Word
w Int
j Int
bc = Int -> Int -> Word -> Int -> Word -> Int
forall a. (Num a, Bits a) => Int -> Int -> a -> Int -> a -> Int
go Int
0 Int
tOPB Word
forall a. (Bits a, Num a) => a
tOPM Int
bn Word
w
where
!bn :: Int
bn = Int
bcInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
j
go :: Int -> Int -> a -> Int -> a -> Int
go !Int
_ Int
_ !a
_ !Int
_ a
0 = [Char] -> Int
forall a. HasCallStack => [Char] -> a
error [Char]
"Too few bits set"
go Int
bs Int
0 a
_ Int
_ a
wd = if a
wd a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 then [Char] -> Int
forall a. HasCallStack => [Char] -> a
error [Char]
"Too few bits, shift 0" else Int
bs
go Int
bs Int
a a
msk Int
ix a
wd =
case a -> Int
forall a. Bits a => a -> Int
popCount (a
wd a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
msk) of
Int
lc | Int
lc Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
ix -> Int -> Int -> a -> Int -> a -> Int
go (Int
bsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
a) Int
a a
msk (Int
ixInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
lc) (a
wd a -> Int -> a
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
a)
| Bool
otherwise ->
let !na :: Int
na = Int
a Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
1
in Int -> Int -> a -> Int -> a -> Int
go Int
bs Int
na (a
msk a -> Int -> a
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
na) Int
ix a
wd
countFromTo :: Int -> Int -> STUArray s Int Bool -> ST s Int
countFromTo :: Int -> Int -> STUArray s Int Bool -> ST s Int
countFromTo Int
start Int
end STUArray s Int Bool
ba = do
STUArray s Int Word
wa <- (forall s. STUArray s Int Bool -> ST s (STUArray s Int Word)
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 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
forall a. (Bits a, Num a) => a
wSHFT
!si :: Int
si = Int
start Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
rMASK
!eb :: Int
eb = Int
end Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
forall a. (Bits a, Num a) => a
wSHFT
!ei :: Int
ei = Int
end Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
rMASK
count :: Int -> Int -> m Int
count !Int
acc Int
i
| Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
eb = do
Word
w <- STUArray s Int Word -> Int -> m Word
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 -> m Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
acc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word -> Int
forall a. Bits a => a -> Int
popCount (Word
w Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`shiftL` (Int
rMASK Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ei)))
| Bool
otherwise = do
Word
w <- STUArray s Int Word -> Int -> m Word
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word -> Int
forall a. Bits a => a -> Int
popCount Word
w) (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
if Int
sb Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
eb
then do
Word
w <- STUArray s Int Word -> Int -> ST s Word
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> Int -> m e
unsafeRead STUArray s Int Word
wa Int
sb
Int -> Int -> ST s Int
forall (m :: * -> *).
MArray (STUArray s) Word m =>
Int -> Int -> m Int
count (Word -> Int
forall a. Bits a => a -> Int
popCount (Word
w Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`shiftR` Int
si)) (Int
sbInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
else do
Word
w <- STUArray s Int Word -> Int -> ST s Word
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> Int -> m e
unsafeRead STUArray s Int Word
wa Int
sb
let !w1 :: Word
w1 = Word
w Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`shiftR` Int
si
Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Word -> Int
forall a. Bits a => a -> Int
popCount (Word
w1 Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`shiftL` (Int
rMASK Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ei Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
si)))