{-# OPTIONS_GHC
    -Wall
    -fwarn-tabs
    -fno-warn-incomplete-patterns
    -fno-warn-name-shadowing
    #-}
----------------------------------------------------------------
--                                                    2021.10.17
-- |
-- Module      :  Math.Combinatorics.Exact.Primes
-- Copyright   :  Copyright (c) 2011--2021 wren gayle romano
-- License     :  BSD
-- Maintainer  :  wren@cpan.org
-- Stability   :  experimental
-- Portability :  Haskell98
--
-- The prime numbers (<http://oeis.org/A000040>).
----------------------------------------------------------------
module Math.Combinatorics.Exact.Primes (primes) where


data Wheel = Wheel {-# UNPACK #-}!Int ![Int]


-- BUG: the CAF is nice for sharing, but what about when we want
-- fusion and to avoid sharing? Using Data.IntList seems to only
-- increase the overhead. I guess things aren't being memoized/freed
-- like they should...

-- | The prime numbers. Implemented with the algorithm in:
--
-- * Colin Runciman (1997)
--    /Lazy Wheel Sieves and Spirals of Primes/, Functional Pearl,
--    Journal of Functional Programming, 7(2). pp.219--225.
--    ISSN 0956-7968
--    <http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.55.7096>
--
primes :: [Int]
primes :: [Int]
primes = [Wheel] -> [Int] -> [Int] -> [Int]
seive [Wheel]
wheels [Int]
primes [Int]
primeSquares
    where
    primeSquares :: [Int]
primeSquares = [Int
pInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
p | Int
p <- [Int]
primes]

    wheels :: [Wheel]
wheels = Int -> [Int] -> Wheel
Wheel Int
1 [Int
1] Wheel -> [Wheel] -> [Wheel]
forall a. a -> [a] -> [a]
: (Wheel -> Int -> Wheel) -> [Wheel] -> [Int] -> [Wheel]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Wheel -> Int -> Wheel
nextSize [Wheel]
wheels [Int]
primes
        where
        nextSize :: Wheel -> Int -> Wheel
nextSize (Wheel Int
s [Int]
ns) Int
p =
            Int -> [Int] -> Wheel
Wheel (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
p) [Int
n' | Int
o  <- [Int
0,Int
s..(Int
pInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
s]
                            , Int
n  <- [Int]
ns
                            , Int
n' <- [Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
o]
                            , Int
n' Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 ]

    -- N.B., ps and qs must be lazy. Or else the circular program is _|_.
    seive :: [Wheel] -> [Int] -> [Int] -> [Int]
seive (Wheel Int
s [Int]
ns : [Wheel]
ws) [Int]
ps [Int]
qs =
        [ Int
n' | Int
o  <- Int
s Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
s,Int
3Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
s..([Int] -> Int
forall a. [a] -> a
head [Int]
psInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
s]
             , Int
n  <- [Int]
ns
             , Int
n' <- [Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
o]
             , Int
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
2 Bool -> Bool -> Bool
|| [Int] -> [Int] -> Int -> Bool
forall t. Integral t => [t] -> [t] -> t -> Bool
noFactorIn [Int]
ps [Int]
qs Int
n' ]
        [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Wheel] -> [Int] -> [Int] -> [Int]
seive [Wheel]
ws ([Int] -> [Int]
forall a. [a] -> [a]
tail [Int]
ps) ([Int] -> [Int]
forall a. [a] -> [a]
tail [Int]
qs)
        where
        -- noFactorIn :: [Int] -> [Int] -> Int -> Bool
        noFactorIn :: [t] -> [t] -> t -> Bool
noFactorIn (t
p:[t]
ps) (t
q:[t]
qs) t
x =
            t
q t -> t -> Bool
forall a. Ord a => a -> a -> Bool
> t
x Bool -> Bool -> Bool
|| t
x t -> t -> t
forall a. Integral a => a -> a -> a
`mod` t
p t -> t -> Bool
forall a. Ord a => a -> a -> Bool
> t
0 Bool -> Bool -> Bool
&& [t] -> [t] -> t -> Bool
noFactorIn [t]
ps [t]
qs t
x

----------------------------------------------------------------
----------------------------------------------------------- fin.