{-# OPTIONS_GHC -O2 #-}
main = print $ primes !! 1000000

primes :: [Int]
primes = 2 : _Y( (3:) . sieve 5 . unionAll . map (\p->[p*p, p*p+2*p..]) )
  where
    _Y g = g (_Y g)                       -- non-sharing fixpoint combinator

    unionAll ((x:xs):t) = x : (union xs . unionAll . pairs) t
    pairs (xs:ys:t) = union xs ys : pairs t
    sieve k s@(x:xs) | k<x  = k : sieve (k+2) s    -- equivalent to
                     | True =     sieve (k+2) xs   --  [k,k+2..]`minus`s, k<=x

union (x:xs) (y:ys) = case compare x y of 
         LT -> x : union  xs (y:ys) 
         EQ -> x : union  xs    ys 
         GT -> y : union (x:xs) ys