Commit aed83b98 authored by simonm's avatar simonm

[project @ 1999-02-03 16:54:00 by simonm]

Add memo table library.
parent 9de7c7e1
......@@ -15,7 +15,7 @@ include $(TOP)/mk/
ifeq "$(GhcWithHscBuiltViaC)" "YES"
SUBDIRS = std exts
SUBDIRS = std exts misc posix concurrent
SUBDIRS = std exts concurrent misc posix
include $(TOP)/mk/
# $Id: Makefile,v 1.10 1998/12/02 13:26:38 simonm Exp $
# $Id: Makefile,v 1.11 1999/02/03 16:54:01 simonm Exp $
# Makefile for miscellaneous libraries.
......@@ -37,7 +37,7 @@ SRC_MKDEPENDHS_OPTS += -optdep--include-prelude
# Setting the GHC compile options
SRC_HC_OPTS += -recomp -cpp -fglasgow-exts -fvia-C -Rghc-timing $(GhcLibHcOpts)
SRC_HC_OPTS += -i../concurrent -recomp -cpp -fglasgow-exts -fvia-C -Rghc-timing $(GhcLibHcOpts)
# Profiling options
% $Id: Memo.lhs,v 1.1 1999/02/03 16:54:02 simonm Exp $
% (c) The GHC Team, 1999
% Hashing memo tables.
{-# OPTIONS -fglasgow-exts #-}
module Memo
( memo -- :: (a -> b) -> a -> b
, memo_sized -- :: Int -> (a -> b) -> a -> b
) where
import Stable
import Weak
import IO
import IOExts
import Concurrent
Memo table representation.
The representation is this: a fixed-size hash table where each bucket
is a list of table entries, of the form (key,value).
The key in this case is (StableName key), and we use hashStableName to
hash it.
It's important that we can garbage collect old entries in the table
when the key is no longer reachable in the heap. Hence the value part
of each table entry is (Weak val), where the weak pointer "key" is the
key for our memo table, and 'val' is the value of this memo table
entry. When the key becomes unreachable, a finaliser will fire and
remove this entry from the hash bucket, and further attempts to
dereference the weak pointer will return Nothing. References from
'val' to the key are ignored (see the semantics of weak pointers in
the documentation).
type MemoTable key val
= MVar (
Int, -- current table size
IOArray Int [(StableName key, Weak val)] -- hash table
We use an MVar to the hash table, so that several threads may safely
access it concurrently. This includes the finalisation threads that
remove entries from the table.
ToDo: make the finalisers refer to the memo table only through a weak
pointer, because otherwise the memo table will keep itself alive
(i.e. even after the function is dead, the weak pointers in the memo
table stay alive because their keys are alive, and hence the values
and finalisers are alive, therefore the table itself stays alive.
memo :: (a -> b) -> a -> b
memo f = memo_sized default_table_size f
default_table_size = 1001
memo_sized :: Int -> (a -> b) -> a -> b
memo_sized size f =
let table = unsafePerformIO (do
tbl <- newIOArray (0,1001) [];
newMVar (size,tbl))
in memo' f table
memo' :: (a -> b) -> MemoTable a b -> a -> b
memo' f ref = \x -> unsafePerformIO $ do
stable_key <- makeStableName x
(size, table) <- takeMVar ref
let hash_key = hashStableName stable_key `mod` size
bucket <- readIOArray table hash_key
lkp <- lookupSN stable_key bucket
case lkp of
Just result -> do
putMVar ref (size,table)
return result
Nothing -> do
let result = f x
weak <- mkWeak x result finaliser
writeIOArray table hash_key ((stable_key,weak):bucket)
putMVar ref (size,table)
return result
where finaliser = do
(size,table) <- takeMVar ref
bucket <- readIOArray table hash_key
let new_bucket = [ (sn,weak)
| (sn,weak) <- bucket,
sn /= stable_key ]
writeIOArray table hash_key new_bucket
putMVar ref (size,table)
lookupSN :: StableName key -> [(StableName key, Weak val)] -> IO (Maybe val)
lookupSN sn [] = return Nothing
lookupSN sn ((sn',weak) : xs)
| sn == sn' = do maybe_item <- deRefWeak weak
case maybe_item of
Nothing -> error ("dead weak pair: " ++
show (hashStableName sn))
Just v -> return (Just v)
| otherwise = lookupSN sn xs
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment