import Data.Map (Map)
import qualified Data.Map as Map
import System.IO.Unsafe
import Data.IORef

-- memo keeps a local cache of all the previous calls
memo :: Ord a => (a -> b) -> a -> b
memo f = unsafePerformIO $ do
  history <- newIORef Map.empty
  return (f' history)
  where
    f' history x = unsafePerformIO $ do
      tbl <- readIORef history
      case Map.lookup x tbl of
        Just y  -> return y
        Nothing -> do
          let y = f x
          writeIORef history (Map.insert x y tbl)
          return y

-- By memoizing the naive implementation of the Fibonacci numbers we get an
-- efficient version.
fib = memo $ \n -> case n of
  0 -> 0
  1 -> 1
  n -> fib (n - 1) + fib (n - 2)

-- You need to be a little careful with sharing to make sure that you get a
-- single memo structure and not one for each call. For instance, the following
-- doesn't work, since memo won't be applied until there is an argument to
-- badfib.
badfib n = memo (\n -> case n of
  0 -> 0
  1 -> 1
  n -> badfib (n - 1) + badfib (n - 2)) n