ST v IO

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
{-# LANGUAGE BangPatterns #-}

import Data.Int
import Data.Array.IO

{-# INLINE fib #-}
fib !_ 0 = return 0
fib !_ 1 = return 1
fib !c n = do
  f1 <- memo c (fib c) (n-1)
  f2 <- memo c (fib c) (n-2)
  return $ f1+f2

newtype C a = C a

{-# INLINE memo #-}
memo (C a) f k = do
  e <- readArray a k
  if e == (-1)
     then do
       v <- f k
       writeArray a k v
       return v
     else return e

evalFib :: Int -> IO Int
evalFib n = do
  a <- newArray (0,n) (-1) :: IO (IOUArray Int Int)
  fib (C a) n

main = print =<< evalFib 120000