    -- |
    -- Module:      Math.NumberTheory.Primes.Counting.Impl
    -- Copyright:   (c) 2011 Daniel Fischer
    -- Licence:     MIT
    -- Maintainer:  Daniel Fischer <daniel.is.fischer@googlemail.com>
    --
    -- Number of primes not exceeding @n@, @&#960;(n)@, and @n@-th prime.
    --
    {-# LANGUAGE BangPatterns        #-}
    {-# LANGUAGE FlexibleContexts    #-}
    {-# LANGUAGE ScopedTypeVariables #-}

    {-# OPTIONS_GHC -fspec-constr-count=24 #-}
    {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}

    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

    -- | Maximal allowed argument of 'primeCount'. Currently 8e18.
    primeCountMaxArg :: Integer
    primeCountMaxArg :: Integer
    primeCountMaxArg = Integer
    8000000000000000000

    -- | @'primeCount' n == &#960;(n)@ is the number of (positive) primes not exceeding @n@.
    --
    --   For efficiency, the calculations are done on 64-bit signed integers, therefore @n@ must
    --   not exceed 'primeCountMaxArg'.
    --
    --   Requires @/O/(n^0.5)@ space, the time complexity is roughly @/O/(n^0.7)@.
    --   For small bounds, @'primeCount' n@ simply counts the primes not exceeding @n@,
    --   for bounds from @30000@ on, Meissel's algorithm is used in the improved form due to
    --   D.H. Lehmer, cf.
    --   <http://en.wikipedia.org/wiki/Prime_counting_function#Algorithms_for_evaluating_.CF.80.28x.29>.
    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 a. [a] -> 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 i. Ix i => STUArray s i Bool -> ST s (i, i)
    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 a. a -> ST s a
    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' n@ calculates the @n@-th prime. Numbering of primes is
    --   @1@-based, so @'nthPrime' 1 == 2@.
    --
    --   Requires @/O/((n*log n)^0.5)@ space, the time complexity is roughly @/O/((n*log n)^0.7@.
    --   The argument must be strictly positive.
    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)

    --------------------------------------------------------------------------------
    --                                The Works                                   --
    --------------------------------------------------------------------------------

    -- TODO: do something better in case we guess too high.
    -- Not too pressing, since I think a) nthPrimeApprox always underestimates
    -- in the range we can handle, and b) it's always "goodEnough"

    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   -- a third count wouldn't make it faster, I think
      where
        gap :: Integer
    gap = Double -> Integer
    forall b. Integral b => Double -> b
    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    -- a second counting would be more work than sieving
        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 b. Integral b => Double -> b
    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 a. Num a => [a] -> a
    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 i. Ix i => UArray i 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   -- (strt - 2) - v0 - 7
                    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)

    -- highSieve :: Integer -> Integer -> Integer -> Integer
    -- highSieve a surp gap = error "Oh shit"

    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 :: forall s. 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 i. Ix i => (i, i) -> ST s (STUArray s i 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 i. Ix i => UArray i 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 i. Ix i => STUArray s i 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 a. a -> ST s a
    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 i. Ix i => STUArray s i 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 a. a -> ST s a
    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 :: forall s. 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 i. Ix i => STUArray s i Bool -> ST s (i, i)
    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 i. Ix i => (i, i) -> ST s (STUArray s i 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 i. Ix i => STUArray s i 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 i. Ix i => STUArray s i 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 i. Ix i => (i, i) -> ST s (STUArray s i 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 i. Ix i => STUArray s i 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 i. Ix i => STUArray s i 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 i. Ix i => STUArray s i 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 a. a -> m a
    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 :: forall s.
    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 i. Ix i => STUArray s i 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 i. Ix i => STUArray s i 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 a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int64
    acc,Int
    ix)
                | Bool
    otherwise = (Int64, Int) -> m (Int64, Int)
    forall a. a -> m a
    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 i. Ix i => STUArray s i 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 i. Ix i => STUArray s i 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 i. Ix i => UArray i 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 i. Ix i => UArray i 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 i. Ix i => STUArray s i 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 i. Ix i => STUArray s i 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 a. a -> ST s a
    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 a. a -> ST s a
    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 i. Ix i => STUArray s i 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 i. Ix i => STUArray s i 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

    --------------------------------------------------------------------------------
    --                               Auxiliaries                                  --
    --------------------------------------------------------------------------------

    locate :: Int64 -> Int -> Int -> STUArray s Int Int64 -> ST s Int
    locate :: forall s. 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 i. Ix i => STUArray s i 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 a. a -> m a
    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 a. a -> m a
    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 :: forall s.
    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 i. Ix i => STUArray s i 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 i. Ix i => STUArray s i 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 i. Ix i => STUArray s i 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 i. Ix i => STUArray s i 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 a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int
    wi,Int
    ri)
                | Bool
    otherwise = (Int, Int) -> m (Int, Int)
    forall a. a -> m a
    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 :: 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
    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 i. Ix i => STUArray s i 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 a b. m a -> (a -> m b) -> m b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= STUArray s Int Int64 -> Int -> Int64 -> m ()
    forall i. Ix i => STUArray s i 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 a. a -> m a
    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 i. Ix i => UArray i 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 i. Ix i => UArray i 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))

    --------------------------------------------------------------------------------
    --                           Ugly helper arrays                               --
    --------------------------------------------------------------------------------

    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 i. Ix i => (i, i) -> Int16 -> ST s (STUArray s i 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 i. Ix i => STUArray s i 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 a b. m a -> m b -> m b
    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 a. a -> m a
    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 i. Ix i => STUArray s i 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 i. Ix i => STUArray s i 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 a. a -> m a
    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 i. Ix i => (i, i) -> Int8 -> ST s (STUArray s i 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 i. Ix i => STUArray s i 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 a b. m a -> m b -> m b
    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 a. a -> m a
    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 i. Ix i => STUArray s i 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 i. Ix i => STUArray s i 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 a. a -> m a
    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 i. Ix i => (i, i) -> Int8 -> ST s (STUArray s i 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 i. Ix i => STUArray s i 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 i. Ix i => STUArray s i 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 a b. m a -> m b -> m b
    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 a. a -> m a
    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 a. a -> m a
    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 i. Ix i => STUArray s i 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 i. Ix i => STUArray s i 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

    -------------------------------------------------------------------------------
    -- Prime counting

    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 :: forall a. (Bits a, Num a) => 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 :: forall a. (Bits a, Num a) => 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

    -- find the n-th set bit in a list of PrimeSieves,
    -- aka find the (n+3)-rd prime
    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 i. Ix i => UArray i Word -> (i, i)
    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 i. Ix i => UArray i 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))

    -- count all set bits in a chunk, do it wordwise for speed.
    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 i. Ix i => UArray i Word -> (i, i)
    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 i. Ix i => UArray i 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)

    -- Find the j-th highest of bc set bits in the Word w.
    top :: Word -> Int -> Int -> Int
    top :: Word -> Int -> Int -> Int
    top Word
    w Int
    j Int
    bc = Int -> Int -> Word -> Int -> Word -> Int
    forall {t}. (Num t, Bits t) => Int -> Int -> t -> Int -> t -> 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 -> t -> Int -> t -> Int
    go !Int
    _ Int
    _ !t
    _ !Int
    _ t
    0 = [Char] -> Int
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "Too few bits set"
          go Int
    bs Int
    0 t
    _ Int
    _ t
    wd = if t
    wd t -> t -> t
    forall a. Bits a => a -> a -> a
    .&. t
    1 t -> t -> Bool
    forall a. Eq a => a -> a -> Bool
    == t
    0 then [Char] -> Int
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "Too few bits, shift 0" else Int
    bs
          go Int
    bs Int
    a t
    msk Int
    ix t
    wd =
            case t -> Int
    forall a. Bits a => a -> Int
    popCount (t
    wd t -> t -> t
    forall a. Bits a => a -> a -> a
    .&. t
    msk) of
              Int
    lc | Int
    lc Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    ix  -> Int -> Int -> t -> Int -> t -> Int
    go (Int
    bsInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    a) Int
    a t
    msk (Int
    ixInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    lc) (t
    wd t -> Int -> t
    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 -> t -> Int -> t -> Int
    go Int
    bs Int
    na (t
    msk t -> Int -> t
    forall a. Bits a => a -> Int -> a
    `unsafeShiftR` Int
    na) Int
    ix t
    wd

    -- count set bits between two indices (inclusive)
    -- start and end must both be valid indices and start <= end
    countFromTo :: Int -> Int -> STUArray s Int Bool -> ST s Int
    countFromTo :: forall s. 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 <- (STUArray s Int Bool -> ST s (STUArray s Int Word)
    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 i. Ix i => STUArray s i 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 a. a -> m a
    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 i. Ix i => STUArray s i 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 i. Ix i => STUArray s i 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 i. Ix i => STUArray s i 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 a. a -> ST s a
    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)))