Stack overflow when constructing a vector.

SO.hs

-- See http://stackoverflow.com/questions/15991634/why-i-take-a-message-for-stack-overflow-in-haskell

import Control.Applicative ((<$>))
import Data.Vector.Unboxed as U hiding ((++))
import qualified Data.Vector.Unboxed.Mutable as M
import System.Environment

d :: U.Vector Int
d = U.create $ do
  v <- M.new dSize
  go 0 v
    where
      dSize = 1000000
      go i v | i >= dSize = return v
             | otherwise = do
               val <- case i of
                 0 -> return 2
                 1 -> return 3
                 2 -> return 5
                 _ -> if odd i
                      then (+2) <$> (M.read v (i-1))
                      else (+4) <$> (M.read v (i-1))
               M.write v i val
               go (i+1) v

algorithmA :: Integer -> Int -> Integer -> [Integer] -> [Integer]
algorithmA _ _  1 pt  = pt
algorithmA t k n pt =
  let dk = fromIntegral $ d ! k
      q = div n dk
      r = mod n dk
  in if r /=0 then
       if q>dk then
         algorithmA t (k+1) n pt
       else (n:pt)
     else
       algorithmA (t+1) k q (dk:pt)

main :: IO ()
main = do
  args <- getArgs
  let n = read (args !! 0)
  let l = U.last d
  print l
  if (floor(sqrt(fromIntegral n))) > l
    then error ("The square  root of number is greater than "
                ++ show l)
    else
    print (algorithmA 0 0 n [])