{-# OPTIONS_GHC -O2 #-}
module Main where
import Data.List (tails)  
main = print $ primes !! 1000000    --  -fno-cse -fno-full-laziness 

primes0 = _Y $ (2:) . minus [3..] . 
              foldr (\p-> (p*p :) . union [p*p+p, p*p+2*p..]) []

primes :: [Int]
primes = [2,3,5,7] ++ _Y ((11:) . tail . minus (scanl (+) 11 wh11) 
                   . foldi (\(x:xs)-> (x:) . union xs)
                   . map (\(w,p)-> scanl (\c d-> c + p*d) (p*p) w)
                   . equalsBy snd (tails wh11 `zip` scanl (+) 11 wh11))
                   
wh3  = 2:wh3                 --  ([3],2)                {1*2,2*3}
wh5  = 2:4:wh5               --  ([5,7],6)                  {2*4,6*5}
wh7  = 4:2:4:2:4:6:2:6:wh7   --  ([7,11,13,17,19,23,29,31],30)  {8*6,30*7}
wh11 = 2:4:2:4:6:2:6:4:2:4:6:6:2:6:4:2:6:4:6:8:4:2:4:2:  
       4:8:6:4:6:2:4:6:2:6:6:4:2:4:6:2:6:4:2:4:2:10:2:10:wh11
_Y g = g (_Y g)        -- multistage with non-sharing fixpoint combinator
     -- = g (fix g)    -- two stages with sharing fixpoint combinator

foldi f (xs:t) = f xs . foldi f . pairs f $ t
pairs f (x:y:t) = f x y : pairs f t

union a@(x:xs) b@(y:ys) = case compare x y of 
         LT -> x : union  xs b   
         EQ -> x : union  xs ys  
         GT -> y : union  a  ys  
minus a@(x:xs) b@(y:ys) = case compare x y of 
         LT -> x : minus  xs b   
         EQ ->     minus  xs ys  
         GT ->     minus  a  ys  
equalsBy f a@(x:xs) b@(y:ys) = case compare (f x) y of 
         LT ->     equalsBy f  xs b   
         EQ -> x : equalsBy f  xs ys  
         GT ->     equalsBy f  a  ys