[Haskell-cafe] Memoisation + unsafePerformIO
Ryan Ingram
ryani.spam at gmail.com
Mon Jul 9 03:49:47 EDT 2007
Funny that you mention using unsafePerformIO to do memoizing; I just
implemented it a couple of days ago to familiarize myself with
techniques that use global state. Here's my implementation which uses
trees (Data.Map).
module Memoize (memoize, memoizefix) where
import System.IO.Unsafe
import qualified Data.Map as Map
import Data.IORef
memoized :: Ord a => IORef (Map.Map a b) -> (a -> b) -> a -> b
memoized memTbl f a = unsafePerformIO $ do
memo <- readIORef memTbl
catch (Map.lookup a memo) $ \_ -> do
let ans = f a
let memo' = Map.insert a ans memo
writeIORef memTbl memo'
return ans
memoize :: Ord a => (a -> b) -> (a -> b)
memoize f = unsafePerformIO $ do
memTbl <- newIORef Map.empty
return $ memoized memTbl f
memFix :: Ord a => IORef (Map.Map a b) -> ((a -> b) -> (a -> b)) -> (a -> b)
memFix memTbl f = let x = f (memoized memTbl x) in x
memoizefix :: Ord a => ((a -> b) -> (a -> b)) -> (a -> b)
memoizefix f = unsafePerformIO $ do
memTbl <- newIORef Map.empty
return $ memFix memTbl f
A test case:
module Main where
import Memoize
fix f = let x = f x in x
nfibr f x = if x <= 1 then (1::Integer) else f (x-1) + f (x-2)
nfib = fix nfibr
mfib = memoizefix nfibr
main = sequence_ $ map (print . mfib) [1..]
(compare replacing mfib with nfib in main).
I think you'll have problems with overlapping instances with your
Ix/Ord instance declarations; better to not use typeclasses there and
just have memoIx and memoTree, I think.
I am a bit nervous about what happens if you turn optimizations on;
you might need to sprinkle a few {-# NOINLINE function_name #-}
pragmas into Memoize.hs to make sure it works properly in a real
codebase, but it's a good start.
-- ryan
More information about the Haskell-Cafe
mailing list