Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
tree: a045e57a65
Fetching contributors…

Cannot retrieve contributors at this time

71 lines (54 sloc) 1.781 kb
-- | A very simple cache
module Cache
( Cache
, newCache
, lookupCache
, clearCache
) where
import Data.Digest.Pure.MD5 (MD5Digest)
import Control.Concurrent.MVar (MVar, newEmptyMVar, readMVar, putMVar)
import Data.Array.IO (IOArray, newArray, readArray, writeArray, getBounds)
import Data.Char (digitToInt)
-------------------------
data Cache a
= Cache
{ array :: IOArray Int [CacheEntry a]
, cacheLineSize :: Int -- length of the lists
}
data CacheEntry a
= CacheEntry
{ question :: MD5Digest
, answer :: MVar a
}
newCache :: Int -> IO (Cache a)
newCache x = do
a <- newArray (0,255) []
return $ Cache a x
clearCache :: Cache a -> IO ()
clearCache c = do
(a,b) <- getBounds $ array c
mapM_ (\i -> writeArray (array c) i []) [a..b]
lookupCache :: Cache a -> MD5Digest -> IO (Either a (a -> IO ()))
lookupCache ch e = modifyCacheLine (array ch) (getIndex e) $ \vv ->
case lookupIA (cacheLineSize ch) (\x -> e == question x) vv of
(Just x_, c) -> do
x <- readMVar (answer x_)
return (x_ : c, Left x)
(Nothing, c) -> do
v <- newEmptyMVar
return (CacheEntry e v: c, Right $ putMVar v)
where
lookupIA :: Int -> (a -> Bool) -> [a] -> (Maybe a, [a])
lookupIA i p l = f i l where
f _ (x: xs) | p x = (Just x, xs)
f 1 _ = (Nothing, [])
f i (x: xs) = case f (i-1) xs of
(a, b) -> (a, x:b)
f _ [] = (Nothing, [])
modifyCacheLine ch i f = do
x <- readArray ch i
(x', r) <- f x
writeArray ch i x'
return r
getIndex :: MD5Digest -> Int
getIndex e = 16 * digitToInt a + digitToInt b where (a:b:_) = show e
Jump to Line
Something went wrong with that request. Please try again.