TCache 0.10.0.2 → 0.10.0.3

raw patch · 5 files changed

+30/−33 lines, 5 files

Files

• Data/TCache.hs +13/−13
• Data/TCache/IndexText.hs +1/−1
• Data/TCache/Memoization.hs +11/−16
• Data/TCache/Triggers.hs +3/−2
• TCache.cabal +2/−1

@@ -269,8 +269,8 @@ import Control.Concurrent.MVar import Control.Exception(catch, throw,evaluate) ---import Debug.Trace---(!>) = flip trace+import Debug.Trace+(!>) = flip trace  -- there are two references to the DBRef here -- The Maybe one keeps it alive until the cache releases it for *Resources@@ -357,7 +357,8 @@    else do     applyTriggers  [dbref] [Just x]     t <- unsafeIOToSTM timeInteger-    writeTVar tv $ Exist $ Elem x t t  --  !> ("writeDBRef "++ key)++    writeTVar tv $! Exist $! Elem x t t     return()  @@ -736,7 +737,6 @@ clearSyncCacheProc  time check sizeObjects= forkIO  clear  where  clear =handle ( \ (e :: SomeException)-> hPutStr stderr (show e) >> clear ) $ do-    	threadDelay (fromIntegral$ time * 1000000)     	clearSyncCache   check sizeObjects   --`debug` "CLEAR"     	clear @@ -790,18 +790,18 @@ -- | Perform a synchronization of the cache with permanent storage once executed the STM transaction -- when 'syncWrite' policy is `Synchronous` atomicallySync :: STM a -> IO a
-atomicallySync proc= atomically $ do
-                        r <- proc
-                        t <- transact
-                        if t then return r else retry
+atomicallySync proc=do+   r <- atomically  proc+   sync+   return r
+
    where-   transact= do-       (savetype,_) <- unsafeIOToSTM $ readIORef tvSyncWrite
+   sync= do+       (savetype,_) <- readIORef tvSyncWrite
        case  savetype of
         Synchronous -> do
-            safeIOToSTM syncCache
-            return True
-        _ -> return True+            syncCache
+        _ -> return ()   -- |Saves the unsaved elems of the cache.

@@ -158,7 +158,7 @@    t=  show t1 ++ show t2    refIndex= getDBRef . key $ IndexText t u u u u where u= undefined --- | return the DBRefs whose fields (usually of container type) contains the requested value.+-- | return the DBRefs of the registers whose field (first parameter, usually a container) contains the requested value. containsElem :: (IResource a, Typeable a, Typeable b) => (a -> b)  -> String -> STM [DBRef a] containsElem  sel wstr = do     let w= T.pack wstr

@@ -15,7 +15,7 @@             , ExistentialQuantification             , FlexibleInstances             , TypeSynonymInstances  #-}-module Data.TCache.Memoization (cachedByKey,cachedp,addrStr,addrHash,Executable(..))+module Data.TCache.Memoization (cachedByKey,cachedp,addrStr,Executable(..))  where import Data.Typeable@@ -27,27 +27,22 @@ import Data.Maybe(fromJust) import Control.Monad.Trans import Control.Monad.Identity-+import Data.RefSerialize(addrHash,newContext) import Debug.Trace (!>)= flip trace  data Cached a b= forall m.Executable m => Cached a (a -> m b) b Integer deriving Typeable ------ | return a string identifier for any object-addrStr :: MonadIO m => a -> m String-addrStr x = addrHash x >>= return . show---- | return a hash of an object-addrHash :: MonadIO m => a -> m Int--{-# NOINLINE addrHash #-}-addrHash x=  liftIO $ do-       st <- makeStableName $! x-       return $ hashStableName st+context= unsafePerformIO newContext +-- | given a string, return a key that can be used in Indexable instances+--  Of non persistent objects, such are cached objects (it changes fron execution to execution)+-- . It uses `addrHash`+addrStr x= "addr" ++ show hash+ where+ hash = case unsafePerformIO $ addrHash context x of+   Right x -> x+   Left x  -> x  -- | to execute a monad for the purpose of memoizing its result class Executable m where

@@ -32,10 +32,10 @@ The DBRef to the object and the new value is passed to the trigger. The called trigger function has two parameters: the DBRef being accesed (which still contains the old value), and the new value.-If the content of the DBRef is being deleted, the second parameter is 'Nothing'.+If the DBRef is being deleted, the second parameter is 'Nothing'. if the DBRef contains Nothing, then the object is being created -}-addTrigger :: (IResource a, Typeable a) =>     ((DBRef a) -> Maybe a -> STM()) -> IO()+addTrigger :: (IResource a, Typeable a) => ((DBRef a) -> Maybe a -> STM()) -> IO() addTrigger   t= do    map <-  readIORef cmtriggers    writeIORef cmtriggers $@@ -49,6 +49,7 @@  mbToList mxs= case mxs of Nothing -> []; Just xs -> xs +-- | internally called when a DBRef is modified/deleted/created applyTriggers:: (IResource a, Typeable a) => [DBRef a] -> [Maybe a] -> STM() applyTriggers  [] _ = return() applyTriggers  dbrfs mas = do

@@ -1,5 +1,5 @@ name: TCache-version: 0.10.0.2+version: 0.10.0.3 cabal-version: >= 1.6 build-type: Simple license: BSD3@@ -17,6 +17,7 @@              This version add memoization and a persistent and transactional collection/queue              .              See "Data.TCache" for details+  category: Data, Database author: Alberto Gómez Corona