{-# OPTIONS_GHC -O2 -fno-cse #-} main = do let m = 1000000 putStr $ show m ++ "-th prime: " print $ tmawprimes !! (m - 1) data A a = A a (A a) | B [a] -- direct encoding for Split List tmawprimes :: [Int] tmawprimes = 2:3:5:7:primes' -- tree-merged | primes-multiples removal where -- | with 2-3-5-7 WHEEL primes' = roll 11 wheel `minus` tjoin [A (p*p) (B [p*q|q<-rollFrom p]) | p <- primes_] primes_ = h ++ t `minus` tjoin [A (p*p) (B [p*q|q<-rollFrom p]) | p <- primes_] where (h,t) = splitAt 6 (roll 11 wheel) rollFrom n = go wheelNums wheel where m = (n-11) `mod` 210 go (x:xs) (w:ws) | x==m = roll (n+w) ws | True = go xs ws wheelNums = roll 0 wheel -- [0,2,6,8,12,18, ...] roll = scanl (+) wheel = 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:wheel tjoin (a:b:c:ys) = add a (add b c) `add` tjoin (pairs ys) where pairs (a:b:ys) = add a b : pairs ys add u@(B(x:xs)) v@(A y ys) = case compare x y of LT -> A x (add (B xs) v) EQ -> A x (add (B xs) ys) GT -> A y (add u ys) add (A x xs) v = A x (add xs v) add (B xs) (B ys) = B (union xs ys) 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@(A y ys) = case compare x y of LT -> x : minus xs b EQ -> minus xs ys GT -> minus a ys