primes = 2:takePrimes [3, 5 ..]
    where takePrimes (x:xs) = let smallPrimes = untilRoot x primes
                              in  if 0 `notElem` (map (mod x) smallPrimes)
                                  then x:takePrimes xs
                                  else takePrimes xs

untilRoot n = takeWhile (x -> x*x < n)

firstPrimeDivisor :: Integer -> Integer
firstPrimeDivisor x = head [p | p <- primes, x `mod` p == 0]

primeFactor 1 = []
primeFactor x = let p = firstPrimeDivisor x
                in p:primeFactor (x `div` p)

factorize :: Integer -> Integer -> [Integer]
factorize _ 1 = []
factorize d n
    | d * d > n = [n]
    | n `mod` d == 0 = d : factorize d (n `div` d)
    | otherwise = factorize (d + 1) n

primeFactors :: Integer -> [Integer]
primeFactors = factorize 2

factors' :: Integral t => t -> [t]
factors' n
  | n < 0 = factors' (-n)
  | n > 0 = if 1 == n
               then []
               else let fac = mfac n 2 in fac : factors' (n `div` fac)
  where mfac m x
          | rem m x == 0 = x
          | x * x > m    = m
          | otherwise    = mfac m (if odd x then x + 2 else x + 1)

primes :: [Integer]
primes    = [2, 3, 5] ++ (diff [7, 9 ..] nonprimes)
  where
    nonprimes :: [Integer]
    nonprimes = foldr1 f $ map g $ tail primes
        where
            f (x:xt) ys = x : (merge xt ys)
            g p         = [ n * p | n <- [p, p + 2 ..]]

    merge :: (Ord a) => [a] -> [a] -> [a]
    merge xs@(x:xt) ys@(y:yt) =
      case compare x y of
        LT -> x : (merge xt ys)
        EQ -> x : (merge xt yt)
        GT -> y : (merge xs yt)

    diff :: (Ord a) => [a] -> [a] -> [a]
    diff xs@(x:xt) ys@(y:yt) =
      case compare x y of
        LT -> x : (diff xt ys)
        EQ -> diff xt yt
        GT -> diff xs yt