lrucache 0.1.1 → 0.2
raw patch · 3 files changed
+58/−32 lines, 3 files
Files
- Data/Cache/LRU/IO/Internal.hs +30/−16
- Data/Cache/LRU/Internal.hs +24/−15
- lrucache.cabal +4/−1
Data/Cache/LRU/IO/Internal.hs view
@@ -1,3 +1,5 @@+{-# OPTIONS_HADDOCK not-home #-}+ -- | This module contains a mutable wrapping of an LRU in the IO -- monad, providing atomic access in a concurrent environment. All -- calls preserve the same semantics as those in "Data.Cache.LRU", but@@ -12,13 +14,8 @@ import Prelude hiding ( lookup ) import Control.Applicative ( (<$>) )-import Control.Concurrent.MVar- ( MVar- , newMVar- , readMVar- , modifyMVar- , modifyMVar_- )+import Control.Concurrent.MVar ( MVar )+import qualified Control.Concurrent.MVar as MV import Data.Cache.LRU ( LRU ) import qualified Data.Cache.LRU as LRU@@ -29,37 +26,54 @@ -- | Make a new AtomicLRU with the given maximum size. newAtomicLRU :: Ord key => Int -- ^ the maximum size -> IO (AtomicLRU key val)-newAtomicLRU = fmap C . newMVar . LRU.newLRU+newAtomicLRU = fmap C . MV.newMVar . LRU.newLRU -- | Build a new LRU from the given maximum size and list of -- contents. See 'LRU.fromList' for the semantics. fromList :: Ord key => Int -- ^ the maximum size -> [(key, val)] -> IO (AtomicLRU key val)-fromList s l = fmap C . newMVar $ LRU.fromList s l+fromList s l = fmap C . MV.newMVar $ LRU.fromList s l -- | Retreive a list view of an AtomicLRU. See 'LRU.toList' for the -- semantics. toList :: Ord key => AtomicLRU key val -> IO [(key, val)]-toList (C mvar) = LRU.toList <$> readMVar mvar+toList (C mvar) = LRU.toList <$> MV.readMVar mvar maxSize :: AtomicLRU key val -> IO Int-maxSize (C mvar) = LRU.maxSize <$> readMVar mvar+maxSize (C mvar) = LRU.maxSize <$> MV.readMVar mvar -- | Insert a key/value pair into an AtomicLRU. See 'LRU.insert' for -- the semantics. insert :: Ord key => key -> val -> AtomicLRU key val -> IO ()-insert key val (C mvar) = modifyMVar_ mvar $ return . LRU.insert key val+insert key val (C mvar) = modifyMVar_' mvar $ return . LRU.insert key val -- | Look up a key in an AtomicLRU. See 'LRU.lookup' for the -- semantics. lookup :: Ord key => key -> AtomicLRU key val -> IO (Maybe val)-lookup key (C mvar) = modifyMVar mvar $ return . LRU.lookup key+lookup key (C mvar) = modifyMVar' mvar $ return . LRU.lookup key -- | Remove an item from an AtomicLRU. Returns whether the item was -- present to be removed.-delete :: (Ord key) => key -> AtomicLRU key val -> IO Bool-delete key (C mvar) = modifyMVar mvar $ return . LRU.delete key+delete :: Ord key => key -> AtomicLRU key val -> IO Bool+delete key (C mvar) = modifyMVar' mvar $ return . LRU.delete key -- | Returns the number of elements the AtomicLRU currently contains. size :: AtomicLRU key val -> IO Int-size (C mvar) = LRU.size <$> readMVar mvar+size (C mvar) = LRU.size <$> MV.readMVar mvar++-- | A version of 'MV.modifyMVar_' that applies the modification+-- function strictly.+modifyMVar_' :: MVar a -> (a -> IO a) -> IO ()+modifyMVar_' mvar f = do+ x <- MV.takeMVar mvar+ x' <- f x+ MV.putMVar mvar $! x'++-- | A version of 'MV.modifyMVar' that applies the modification+-- function strictly. The returned value is not evaluated strictly.+modifyMVar' :: MVar a -> (a -> IO (a, b)) -> IO b+modifyMVar' mvar f = do+ x <- MV.takeMVar mvar+ (x', result) <- f x+ MV.putMVar mvar $! x'+ return result
Data/Cache/LRU/Internal.hs view
@@ -21,7 +21,7 @@ , last :: Maybe key -- ^ the key of the least recently accessed entry , maxSize :: Int -- ^ the maximum size of the LRU cache , content :: Map key (LinkedVal key val) -- ^ the backing 'Map'- }+ } deriving Eq -- | The values stored in the Map of the LRU cache. They embed a -- doubly-linked list through the values of the 'Map'.@@ -29,7 +29,7 @@ value :: val -- ^ The actual value , prev :: Maybe key -- ^ the key of the value before this one , next :: Maybe key -- ^ the key of the value after this one- }+ } deriving Eq -- | Make an LRU. The LRU is guaranteed to not grow above the -- specified number of entries.@@ -85,7 +85,7 @@ -- the most recently accessed hitSet = hit' key lru' where lru' = lru { content = contents' }- contents' = Map.adjust (\v -> v {value = val}) key contents+ contents' = adjust' (\v -> v {value = val}) key contents -- create a new LRU with a new first item, and -- conditionally dropping the last item@@ -94,7 +94,7 @@ -- add a new first item firstLV' = Link val Nothing $ Just firstKey contents' = Map.insert key firstLV' .- Map.adjust (\v -> v { prev = Just key }) firstKey $+ adjust' (\v -> v { prev = Just key }) firstKey $ contents lru' = lru { first = Just key, content = contents' } @@ -137,9 +137,9 @@ -- will be needed notFirst = if key == lastKey then replaceLast else replaceMiddle - adjFront = Map.adjust (\v -> v { prev = Just key}) firstKey .- Map.adjust (\v -> v { prev = Nothing- , next = first lru }) key+ adjFront = adjust' (\v -> v { prev = Just key}) firstKey .+ adjust' (\v -> v { prev = Nothing+ , next = first lru }) key -- key was the last entry in the list replaceLast = lru { first = Just key@@ -147,8 +147,7 @@ , content = cLast } Just pKey = prev lastLV- cLast = Map.adjust (\v -> v { next = Nothing }) pKey . adjFront $- conts+ cLast = adjust' (\v -> v { next = Nothing }) pKey . adjFront $ conts -- the key wasn't the first or last key replaceMiddle = lru { first = Just key@@ -157,8 +156,8 @@ Just keyLV = Map.lookup key conts Just prevKey = prev keyLV Just nextKey = next keyLV- cMid = Map.adjust (\v -> v { next = Just nextKey }) prevKey .- Map.adjust (\v -> v { prev = Just prevKey }) nextKey .+ cMid = adjust' (\v -> v { next = Just nextKey }) prevKey .+ adjust' (\v -> v { prev = Just prevKey }) nextKey . adjFront $ conts -- | An internal function used by 'insert' (when the cache is full)@@ -199,7 +198,7 @@ , content = contFirst } Just nKey = next lv- contFirst = Map.adjust (\v -> v { prev = Nothing }) nKey cont'+ contFirst = adjust' (\v -> v { prev = Nothing }) nKey cont' -- delete an item other than the first Just lastKey = last lru@@ -210,13 +209,23 @@ , content = contLast } Just pKey = prev lv- contLast = Map.adjust (\v -> v { next = Nothing}) pKey cont'+ contLast = adjust' (\v -> v { next = Nothing}) pKey cont' -- delete an item in the middle deleteMid = lru { content = contMid }- contMid = Map.adjust (\v -> v { next = next lv }) pKey .- Map.adjust (\v -> v { prev = prev lv }) nKey $+ contMid = adjust' (\v -> v { next = next lv }) pKey .+ adjust' (\v -> v { prev = prev lv }) nKey $ cont'++-- | Internal function. This is very similar to 'Map.adjust', with+-- two major differences. First, it's strict in the application of+-- the function, which is a huge win when working with this structure.+--+-- Second, it requires that the key be present in order to work. If+-- the key isn't present, 'undefined' will be inserted into the 'Map',+-- which will cause problems later.+adjust' :: Ord k => (a -> a) -> k -> Map k a -> Map k a+adjust' f k m = Map.insertWith' (\_ o -> f o) k undefined m -- | Internal function. This checks the three structural invariants -- of the LRU cache structure:
lrucache.cabal view
@@ -1,5 +1,5 @@ Name: lrucache-Version: 0.1.1+Version: 0.2 Synopsis: a simple, pure LRU cache License: BSD3 License-file: LICENSE@@ -18,6 +18,9 @@ an LRU cache. . Version History:+ .+ 0.2 - Added an Eq instance for LRU.+ Added strictness to eliminate space leaks in common use patterns. . 0.1.1 - Add the Data.Cache.LRU.IO.Internal module. Clean up build warnings on GHC 6.12.1.