1 % $Id: Memo.lhs,v 1.3 1999/02/26 17:43:55 simonm Exp $
3 % (c) The GHC Team, 1999
8 {-# OPTIONS -fglasgow-exts #-}
11 ( memo -- :: (a -> b) -> a -> b
12 , memo_sized -- :: Int -> (a -> b) -> a -> b
22 -----------------------------------------------------------------------------
23 Memo table representation.
25 The representation is this: a fixed-size hash table where each bucket
26 is a list of table entries, of the form (key,value).
28 The key in this case is (StableName key), and we use hashStableName to
31 It's important that we can garbage collect old entries in the table
32 when the key is no longer reachable in the heap. Hence the value part
33 of each table entry is (Weak val), where the weak pointer "key" is the
34 key for our memo table, and 'val' is the value of this memo table
35 entry. When the key becomes unreachable, a finalizer will fire and
36 remove this entry from the hash bucket, and further attempts to
37 dereference the weak pointer will return Nothing. References from
38 'val' to the key are ignored (see the semantics of weak pointers in
42 type MemoTable key val
44 Int, -- current table size
45 IOArray Int [(StableName key, Weak val)] -- hash table
49 We use an MVar to the hash table, so that several threads may safely
50 access it concurrently. This includes the finalization threads that
51 remove entries from the table.
53 ToDo: make the finalizers refer to the memo table only through a weak
54 pointer, because otherwise the memo table will keep itself alive
55 (i.e. even after the function is dead, the weak pointers in the memo
56 table stay alive because their keys are alive, and hence the values
57 and finalizers are alive, therefore the table itself stays alive.
61 memo :: (a -> b) -> a -> b
62 memo f = memo_sized default_table_size f
64 default_table_size = 1001
66 memo_sized :: Int -> (a -> b) -> a -> b
68 let (table,weak) = unsafePerformIO (
69 do { tbl <- newIOArray (0,1001) []
70 ; mvar <- newMVar (size,tbl)
71 ; weak <- mkWeakPtr mvar (Just (table_finalizer tbl size))
76 table_finalizer :: IOArray Int [(StableName key, Weak val)] -> Int -> IO ()
77 table_finalizer table size =
78 sequence_ [ finalizeBucket i | i <- [0..size] ]
81 bucket <- readIOArray table i
82 sequence_ [ finalize w | (_,w) <- bucket ]
84 memo' :: (a -> b) -> MemoTable a b -> Weak (MemoTable a b) -> a -> b
85 memo' f ref weak_ref = \k -> unsafePerformIO $ do
86 stable_key <- makeStableName k
87 (size, table) <- takeMVar ref
88 let hash_key = hashStableName stable_key `mod` size
89 bucket <- readIOArray table hash_key
90 lkp <- lookupSN stable_key bucket
94 putMVar ref (size,table)
98 weak <- mkWeak k result (Just (finalizer hash_key stable_key weak_ref))
99 writeIOArray table hash_key ((stable_key,weak):bucket)
100 putMVar ref (size,table)
103 finalizer :: Int -> StableName a -> Weak (MemoTable a b) -> IO ()
104 finalizer hash_key stable_key weak_ref =
105 do r <- deRefWeak weak_ref
109 (size,table) <- takeMVar mvar
110 bucket <- readIOArray table hash_key
111 let new_bucket = [ (sn,weak)
112 | (sn,weak) <- bucket,
114 writeIOArray table hash_key new_bucket
115 putMVar mvar (size,table)
117 lookupSN :: StableName key -> [(StableName key, Weak val)] -> IO (Maybe val)
118 lookupSN sn [] = return Nothing
119 lookupSN sn ((sn',weak) : xs)
120 | sn == sn' = do maybe_item <- deRefWeak weak
122 Nothing -> error ("dead weak pair: " ++
123 show (hashStableName sn))
124 Just v -> return (Just v)
125 | otherwise = lookupSN sn xs