Project Euler Problem 003

-- http://www.haskell.org/haskellwiki/Prime_numbers
-- haskell.orgよりコピペ、O(n^1.2)のprimes
primes :: [Integer]
primes = 2 : ([3,5..] `minus` join [[p*p, p*p+2*p..] | p <- primes']) 
  where
    primes' = 3 : ([5,7..] `minus` join [[p*p, p*p+2*p..] | p <- primes'])   
    join  ((x:xs):t)    = x : union xs (join (pairs t))
    pairs ((x:xs):ys:t) = (x : union xs ys) : pairs t                      
    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
    union  xs     []    = xs
    union  []     ys    = ys
    minus (x:xs) (y:ys) = case (compare x y) of 
      LT -> x : minus  xs  (y:ys)
      EQ ->     minus  xs     ys
      GT ->     minus (x:xs)  ys
    minus  xs     _     = xs

{- 簡易版
primes = 2: f [3] [3,5..] where
  f (x:xs) ys = ps ++ f (xs ++ ps) [z | z<-qs,z `rem` x /= 0] where
    (ps,qs) = span (< (x*x)) ys
-- -}

dst :: Integer
dst = 600851475143

factor :: Integer -> [Integer]
factor nn = factorimpl nn primes where
  factorimpl n pri@(p:xs) =
    if p*p>n then [n]
    else if n`rem` p == 0 then
      p:factorimpl (n `quot` p) pri
         else
           factorimpl n xs
solve :: Integer
solve = last $ factor dst  -- 6857 -- [71,839,1471,6857]
-- 6857
main :: IO ()
main = print solve