primesW :: [Int]   
primesW = [2,3,5,7] ++ _Y ( (11:) . gapsW 13 (tail wheel) . _U .
                            map (\p->  
                              map (p*) . dropWhile (< p) $
                                scanl (+) (p - rem (p-11) 210) wheel) )
  where
  wheel = cycle [b-a | let xs = [i | i <- [11..11+210], gcd i 210 == 1]
                     , (b,a) <- zip (tail xs) xs]

  gapsW k (d:w) s@(c:cs) | k < c     = k : gapsW (k+d) w s    -- set difference
                         | otherwise =     gapsW (k+d) w cs   --   k==c

  _Y g = g (_Y g)     -- = g . g . g . g . ......      -- recursive fixpoint

  _U ((x:xs):t) = x : (union xs . _U . pairs) t      -- ~= nub . sort . concat
    where 
    pairs (xs:ys:t) = union xs ys : pairs 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
         
main = print . take 5 . drop (1000000-4) $ primesW