euler #14 collatz problem

e14.hs

{-# LANGUAGE BangPatterns #-}

import Data.Array.IO
import Data.Array.Unboxed
import Control.Monad

collatz x
  | even x    = div x 2
  | otherwise = 3*x+1

solve n = do
  arr <- newArray (1,n) 0 :: IO (IOUArray Int Int)
  writeArray arr 1 1
  let eval :: Int -> IO Int
      eval x = do
        if x > n
          then fmap (1+) $ eval (collatz x)
          else do d <- readArray arr x
                  if d == 0
                    then do d <- fmap (1+) $ eval (collatz x)
                            writeArray arr x d
                            return d
                    else return d
      go :: (Int,Int) -> Int -> IO (Int,Int)
      go !m x = do d <- eval x
                   return $ max m (d,x)
  foldM go (0,0) [2..n] 

main = solve 1000000 >>= print