Evolution of Sieve... 1-liners.hs

     ps = sv [2..]
          where
          sv (p:t) = [p] ++ sv [n | n <- t, rem n p > 0]


     ps = sv [2..]                         
          where                                                
          sv (p:t) = [p] ++ sv (t \\ [p, p+p..])  


     ps = 2 : sv [[p*p, p*p+p..] | p <- ps] [3..]
              where
              sv (cs@(q:_):r) (span (< q) -> (h,t)) = h ++ sv r (t \\ cs)
                                          --  h ++ (t & (\\ cs) & sv r)

     ps = 2 : [n | (r:q:_, px) <- (zip . tails . (2:) . map (^2) <*> inits) ps,
                   (n,True)    <- assocs ( accumArray (const id) True (r+1,q-1)
                                    [(m,False) | p <- px, s <- [ (r+p)`div`p*p ], 
                                                 m <- [s,s+p..q-1]] :: UArray Int Bool )]

import Data.Array.Unboxed 
import Data.List (tails, inits)
import Control.Applicative (<*>)


     ps = sv [2..]
          where
          sv [p, ...t...] = [p, ...sv [n | n <- t, rem n p > 0]...]


     ps = sv [2..]
          where
          sv [p, ...t...] = [p, ...sv (t \\ [p, p+p..])...]


     ps = 2 : sv [[p*p, p*p+p..] | p <- ps] [3..]
              where
              sv [cs@[q, ...], ...r...] [...h... |h < q|, ...t...] =
                                        [...h..., ...sv r (t \\ cs)...]
              -- or:
              sv [[q, ...cs...], ...r...] [...h..., q, ...t...] =
                                          [...h..., ...sv r (t \\ cs)...]



    Evolution of the Sieve .....       with (\\) = O.minus, union = O.union
_____________________________________________________________
fix $ map head . scanl (\\) [2..] . map (\p -> [p, p+p..])

fix $ map head . scanl ((\\).tail) [2..] . map (\p -> [p*p, p*p+p..])

fix $ map head . scanl (\(_:t) p -> t \\ [p*p, p*p+p..]) [2..]

fix $ map head . scanl (flip $ \p -> (\\ [p*p, p*p+p..]) . tail) [2..]

fix $ (fst =<<) . scanl (flip $ \p -> second (\\ [p*p, p*p+p..]) . splitAt 1 . snd) ([2], [3..])
                                                                   }---------\
fix $ (fst =<<) . scanl (flip $ \p -> second (\\ [p*p, p*p+p..]) . span (< p*p) . snd) ([2], [3..]) 

fix $ (fst =<<) . scanl (flip $ \cs@(q:_) -> second (\\ cs) . span (< q) . snd) ([2], [3..]) 
                 . map (\p -> [p*p, p*p+p..])
                 
fix $ (2:) . ([3..] \\) . foldr (++) [] . map (\p -> [p*p, p*p+p..])
               where (\\)=O.minus; (++)(x:xs)=(x:).O.union xs             -- Richard Bird's

2 : _Y ((3:) . ([5,7..] \\) . unionAll . map (\p -> [p*p, p*p+2*p..]))
___________________________________________________________________________________________________




fix $ (fst =<<) 
    . scanl ((_,r) p -> case span (< p*p) r of (h,t) -> (h, t \\ [p*p, p*p+p..]))
           ([2], [3..]) 


fix $ (fst =<<) . scanl (\(_,(cs,r)) p -> let (h,t) = span (< p*p) r ; (a,b) = span (< p*p) cs in
                     (h \\ a, (union b [p*p, p*p+p..], t)) )
           ([2], ([], [3..]))


fix $ (fst =<<) . scanl (\(_,(ms,r)) p -> let{(h,t) = span (< p*p) r 
  ; (a,b) = span (< p*p) cs ; cs = ...ms... } in
                     (h \\ a, ([p*p, p*p+p..]:b, t)) )  -- go segmented already ........ 
           ([2], ([], [3..]))

-- this is hard because it follows PUSH semantics.... Bird's etc is PULL PULL PULL semantics

-- so, obv, 'segmented' is this (again) (with the imaginary parallel list comprehension syntax):



     ps = 2 : [n | (r:q:_, px) <- (tails . (2:) . map (^2) &&& inits) ps,
                   (n,True)    <- assocs ( accumArray (const id) True (r+1,q-1)
                                    [(m,False) | p <- px, s <- [ (r+p)`div`p*p ], 
                                                 m <- [s,s+p..q-1]] :: UArray Int Bool )]


and to add WHEELS to it, just find out START and PHASE for each prime on each segment;
and roll the WHEEL from there.
find how to pack 8 into 32 better; etc.







{{~~~~
fix $ (fst =<<) . scanl
   (\(_,xs) -> \case p | (h,t) <- span (< p*p) xs -> (h, t \\ [p*p, p*p+p..])) ([2], [3..])

fix $ (fst =<<) . scanl (flip $ \p (span (< p*p) . snd -> (h, t)) ->
                                                         (h, t \\ [p*p, p*p+p..])) ([2], [3..]) 

fix $ (fst =<<) . scanl (\(_,b) cs@(q:_) ->
                   case span (< q) b of (h, t) -> (h, t \\ cs)) ([2], [3..])
    . map (\p -> [p*p, p*p+p..])

fix $ (fst =<<) . scanl (\(_,r) p ->
         case span (< p*p) r of (h, t) -> (h, t \\ [p*p, p*p+p..])) ([2], [3..])
~~~~}}


with        unfold f a | (xs,b) <- f a = xs ++ unfold f b

so that     unfold f = concat . unfoldr (Just . f)    


unfold (\a@(1:p:_) -> ([p], a \\ map (*p) a)) [1..]      -- Euler's sieve
unfold (\(p:xs) -> ([p], xs \\ map (*p) (p:xs))) [2..]  
 
unfold (\(p:xs) -> ([p], xs \\ [p, p+p..])) [2..]      -- the basic sieve
unfold (\(p:xs) -> ([p], xs \\ [p*p, p*p+p..])) [2..]