Ticket #3207: STCheck.hs

File STCheck.hs, 864 bytes (added by j.waldmann, 5 years ago)
Line 
1{-# language CPP #-}
2
3#define LAZY 1
4#if(LAZY)
5import Data.STRef.Lazy
6import Control.Monad.ST.Lazy
7#else
8import Data.STRef.Strict
9import Control.Monad.ST.Strict
10#endif
11
12import Data.Map (Map)
13import qualified Data.Map as M
14
15main = print $ runST $ do
16    r <- newSTRef ( M.empty :: Map Int Int )
17    fib r 2
18
19fib :: STRef s ( Map Int Int )
20    -> Int
21    -> ST s Int
22fib r x = cached r x $ case x of
23    0 -> return 0
24    1 -> return 1
25    _ -> do 
26        a <- fib r (x-1) 
27        b <- fib r (x-2) 
28        return $ a + b
29
30cached :: Ord a
31       => STRef s ( Map a b )
32       -> a
33       -> ( ST s b )
34       -> ST s b
35cached r x computation = do
36    m <- readSTRef r
37    case M.lookup x m of
38        Just y -> return y
39        Nothing -> do
40            y <- computation
41            m <- readSTRef r
42            writeSTRef r $ M.insert x y m
43            return y