This code was automatically extracted from a .lhs file that uses the following convention and was taken from the Paul Hudak's book implementation: -- lines beginning with ">" are executable -- lines beginning with "<" are in the text, but not necessarily executable -- lines beginning with "|" are also in the text, but are often just expressions or code fragments. > {-# OPTIONS_GHC -fglasgow-exts #-} > module Memo1 (memo1) where > import Data.IORef > import System.IO.Unsafe For GHC users, comment the Hugs part and uncomment the following > import GHC.Prim > unsafePtrEq x y = case reallyUnsafePtrEquality# x y of > 1# -> True > _ -> False For Hugs users, comment the GHC part, and uncomment the following > -- import Hugs.IOExts (unsafePtrEq) > memo1 :: (a->b) -> (a->b) > memo1 f = unsafePerformIO $ do > cache <- newIORef [] > return $ \x -> unsafePerformIO $ do > vals <- readIORef cache > case x `inCache` vals of > Nothing -> do let y = f x > writeIORef cache [(x,y)] -- ((x,y) : > -- if null vals then [] else [head vals]) > return y > Just y -> do return y > inCache :: a -> [(a,b)] -> Maybe b > x `inCache` [] = Nothing > x `inCache` ((x',y'):xys) = > if unsafePtrEq x x' then Just y' else x `inCache` xys > fib1 n = fibstr !! n > where fibstr = 0 : 1 : zipWith (+) fibstr (tail fibstr) > fib2 n = fibstr nil !! n > where fibstr = > \x -> 0 : 1 : zipWith (+) (fibstr x) (tail (fibstr x)) > fib3 n = fibstr nil !! n > where fibstr = memo1 $ > \x -> 0 : 1 : zipWith (+) (fibstr x) (tail (fibstr x)) > nil = [] :: [Int] > ones = 1 : ones > twos = 2 : twos > oats = (ones,twos) > taos = (twos,ones)