perdure 0.2.0 → 0.2.1

raw patch · 15 files changed

+153/−39 lines, 15 filesdep −deepseqdep −deepseq-thdep −lrucachedep ~MonadRandomdep ~cognimeta-utilsdep ~perdurePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies removed: deepseq, deepseq-th, lrucache

Dependency ranges changed: MonadRandom, cognimeta-utils, perdure

API changes (from Hackage documentation)

Files

• exe-src/Database/Perdure/TestPersistent.hs +2/−2
• exe-src/Database/Perdure/TestState.hs +2/−2
• perdure.cabal +9/−9
• src/Database/Perdure.hs +5/−2
• src/Database/Perdure/ArrayRef.hs +1/−0
• src/Database/Perdure/CSerializer.hs +5/−3
• src/Database/Perdure/Cache.hs +49/−0
• src/Database/Perdure/Cache1.hs +61/−0
• src/Database/Perdure/Decrementer.hs +2/−2
• src/Database/Perdure/Deref.hs +12/−9
• src/Database/Perdure/Digest.hs +1/−0
• src/Database/Perdure/Persistent.hs +1/−3
• src/Database/Perdure/State.hs +0/−7
• src/Database/Perdure/WordArrayRef.hs +2/−0
• src/Database/Perdure/WordNArrayRef.hs +1/−0

@@ -63,10 +63,10 @@ writeReadTestFile a name = fmap fromRight $ runErrorT $ withFileStoreFile name $ (. (ReplicatedFile . pure)) $ \f -> do
   putCpuTime "Data creation" $ evaluate $ prnf persister a
   putCpuTime "Write time" $ (() <$) $
-    newCachedFile 1000 f >>=
+    newCachedFile 1000000 f >>=
     createPVar a (mega 100) . defaultRootLocation
   putCpuTime "Read time" $
-    newCachedFile 1000 f >>=
+    newCachedFile 1000000 f >>=
     fmap (fromMaybe $ error "Read error") . openPVar . defaultRootLocation >>= \v ->
     updatePVar v $ get >>= liftIO . evaluate . (a ==)
 

@@ -48,7 +48,7 @@  testStatesF :: ReplicatedFile -> IO () testStatesF f =-    newCachedFile 1000 f >>=+    newCachedFile 1000000 f >>=     createPVar (EmptyRList :: RList Word32) (mega 100) . defaultRootLocation >>= \v ->     for_ [0 .. 19] $ \c -> do       print c@@ -93,7 +93,7 @@ testStatesDag _ =   quickCheckWith (Args Nothing 1 1 1 True) $ morallyDubiousIOProperty $ (>>= either fail return) $ runErrorT $ (True <$) $   withReplicatedFiles "testStatesDag" $ \f -> -  newCachedFile 1000 f >>=+  newCachedFile 1000000 f >>=   createPVar (Dag $ ref []) (mega 100) . defaultRootLocation >>= \v ->   for_ [(0 :: Int) .. 1999] $ \c -> do     print c

@@ -1,5 +1,5 @@ Name: perdure-version: 0.2.0+version: 0.2.1 cabal-version: >= 1.8 build-type: Simple license: OtherLicense@@ -162,6 +162,8 @@     Database.Perdure.Allocator     Database.Perdure.AllocCopy     Database.Perdure.ArrayRef+    Database.Perdure.Cache+    Database.Perdure.Cache1     Database.Perdure.Count     Database.Perdure.CSerializer     Database.Perdure.CDeserializer@@ -187,10 +189,11 @@     Database.Perdure.WordArrayRef     Database.Perdure.WordNArrayRef     Database.Perdure.WValidator+  C-sources:   build-depends:     base >= 4.5.0.0 && < 5,     template-haskell >= 2.7.0.0,-    cognimeta-utils == 0.1.1,+    cognimeta-utils == 0.1.2,     QuickCheck >=2.4.0.1,     strict >= 0.3.2,     mtl >= 2.1.2,@@ -214,9 +217,7 @@     time >= 1.4.0.1,     unix >= 2.5.1.0,     data-binary-ieee754 >= 0.4.2.1,-    lrucache >= 1.1.1,-    deepseq >= 1.3.0.0,-    deepseq-th >= 0.1.0.3+    MonadRandom >= 0.1.8    ghc-options: -rtsopts -Wall -fno-warn-orphans -fcontext-stack=80 -O2 -funfolding-use-threshold=24 -pgmP cpphs -optP --cpp   extensions: @@ -236,15 +237,14 @@   build-depends:     base >= 4.5.0.0,     template-haskell >= 2.7.0.0,-    cognimeta-utils == 0.1.1,+    cognimeta-utils == 0.1.2,     mtl >= 2.1.2,-    deepseq,     QuickCheck >=2.4.0.1,-    perdure >= 0.2.0,+    perdure >= 0.2.1,     transformers >= 0.3.0.0,     bytestring >= 0.9.2.1,     containers >= 0.4.2.1,-    MonadRandom == 0.1.3+    MonadRandom >= 0.1.3   ghc-options: -rtsopts -Wall -fcontext-stack=80 -fno-warn-duplicate-exports -O2 -funfolding-use-threshold=24 -threaded  -- We are not using the unicode (TM) symbol because of http://trac.haskell.org/haddock/ticket/210

@@ -42,6 +42,7 @@ import Database.Perdure.Deref import Database.Perdure.Rev import Database.Perdure.SizeRef+import qualified Database.Perdure.Cache as Cache import Cgm.Control.Monad.State as M import Cgm.Data.Typeable import Control.Monad.Reader hiding (sequence)@@ -52,9 +53,11 @@ import Database.Perdure.ReplicatedFile(ReplicatedFile(..)) import Database.Perdure.LocalStoreFile(withFileStoreFile, withRawDeviceStoreFile, withRawDeviceStoreFiles, LocalStoreFile) --- | Wraps a ReplicatedFile with cache of a given size (number of dereferenced DRefs)+-- | Wraps a ReplicatedFile with a cache of a given size. The size is specified in bytes of serialized data, but the actual consumed+-- size may be a few times larger since the cache contains the deserialized data, which is often less compact than its serialized+-- representation. newCachedFile :: Integer -> ReplicatedFile -> IO CachedFile-newCachedFile sz f = CachedFile f <$> newMVar (emptyCache sz)+newCachedFile sz f = CachedFile f <$> newMVar (Cache.empty sz)  -- | At the moment this is the only way to create a rootLocation. -- The root of the database will be located in one of two reserved locations at the start of the specified files.

@@ -25,4 +25,5 @@   writeArrayRef :: (Allocator l) => l -> PrimArray Pinned (ArrayRefElem r) -> IO (r (StoreRef ReplicatedFile))
   derefArrayRef :: (StoreFile f, Allocation fr) => f -> r (StoreRef f) -> IO (Maybe (ArrayRange (PrimArray fr (ArrayRefElem r))))
   arrayRefAddr ::  r BasicRef -> Len Word64 Word64
+  arrayRefSize ::  r BasicRef -> Len Word64 Word64
   

@@ -40,9 +40,10 @@ import Database.Perdure.ArrayRef
 import Database.Perdure.WordArrayRef()
 import Database.Perdure.WordNArrayRef()
+import qualified Database.Perdure.Cache as Cache
 import Cgm.Data.MapMultiset
-import qualified Data.Cache.LRU as LRU
 import Data.Dynamic
+import Control.Monad.Random
 
 
 -- Important : We must not read (deref) a ref that has just been written in the current writeState.
@@ -116,14 +117,15 @@ writeDRef p ma dc@(DeserializerContext _ c) l start end = 
   DRef p dc <$> maybe id (\a -> (>>= \w -> w <$ addToCache a w)) ma (allocCopyBits start end >>= writeArrayRef l) where
   addToCache a w = let addr = arrayRefAddr w in modifyMVar_ c $ 
-                                                return . {-(trace ("writing/adding to cache at" ++ show addr) $ -}LRU.insert addr (toDyn a)
+                                                evalRandIO . {-(trace ("writing/adding to cache at" ++ show addr) $ -}
+                                                Cache.insert addr (Cache.Entry (toDyn a) $ arrayRefSize w)
   
 -- | The passed Persister must hace no references
 {-# NOINLINE serializeToArray #-}
 serializeToArray :: AllocCopy w => Persister a -> a -> PrimArray Pinned w
 serializeToArray p a = unsafePerformIO $ do
   start <- stToIO mkABitSeq 
-  noCache <- newMVar $ LRU.fromList Nothing []
+  noCache <- newMVar $ Cache.empty 0
   cSer p (noCache, NoAllocator, Nothing :: CountDest MapMultiset) (const $ allocCopyBits start) a start
                              
 data NoAllocator = NoAllocator

@@ -0,0 +1,49 @@+{-+Copyright 2010-2012 Cognimeta Inc.++Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in+compliance with the License. You may obtain a copy of the License at++     http://www.apache.org/licenses/LICENSE-2.0++Unless required by applicable law or agreed to in writing, software distributed under the License is+distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express+or implied. See the License for the specific language governing permissions and limitations under the License.+-}++module Database.Perdure.Cache (+  Cache(..),+  Entry(..),+  empty,+  lookup,+  insert,+  delete+  ) where++import Prelude ()+import Cgm.Prelude hiding (empty, lookup, insert, delete)+import qualified Database.Perdure.Cache1 as Cache+import Control.Monad.Random+import Data.Dynamic+import Cgm.Data.Len+import Data.Word+import Database.Perdure.Count(Address)++data Entry = Entry {entryValue :: Dynamic, entrySize :: Len Word64 Word64}+instance Cache.Entry Entry where entrySize (Entry _ s) = fromIntegral s++newtype Cache = Cache (Cache.Cache Address Entry)++-- | Create an empty cache of the specified size in bytes of serialized data. The actual consumed size may be a few times larger+-- since heap data is usually much less compact than its serialized representation.+empty :: Integer -> Cache+empty = Cache . Cache.empty . getLen . (id :: Id (Len Word64 Integer)) . coarsenLen . (id :: Id (Len Word8 Integer)) . unsafeLen++lookup :: Address -> Cache -> Maybe (Entry, Cache)+lookup k (Cache c) = fmap (second Cache) $ Cache.lookup k c+  +insert :: RandomGen g => Address -> Entry -> Cache -> Rand g Cache+insert k v (Cache c) = fmap Cache $ Cache.insert k v c++delete :: Address -> Cache -> Cache+delete k (Cache c) = Cache $ Cache.delete k c

@@ -0,0 +1,61 @@+{-+Copyright 2010-2012 Cognimeta Inc.++Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in+compliance with the License. You may obtain a copy of the License at++     http://www.apache.org/licenses/LICENSE-2.0++Unless required by applicable law or agreed to in writing, software distributed under the License is+distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express+or implied. See the License for the specific language governing permissions and limitations under the License.+-}++module Database.Perdure.Cache1 (+  Cache(..),+  Entry(..),+  empty,+  lookup,+  insert,+  delete+  ) where++import Prelude hiding (lookup)+import qualified Data.Map as Map+import Control.Monad.Random+import Control.Applicative hiding (empty)+import Control.Arrow+import Data.List(minimumBy)+import Data.Ord++data Cache k a = Cache {contents :: Map.Map k (a, Integer), step :: Integer, size :: Integer, free :: Integer}++class Entry a where entrySize :: a -> Integer++empty :: Integer -> Cache k a+empty sz = Cache Map.empty 0 sz sz++lookup :: Ord k => k -> Cache k a -> Maybe (a, Cache k a)+lookup k (Cache c p s f) = fmap (\(a1, _) -> (a1, Cache (Map.insert k (a1, p) c) (p + 1) s f)) $ Map.lookup k c+  +insert :: (RandomGen g, Ord k, Entry a) => k -> a -> Cache k a -> Rand g (Cache k a)+insert k v cache =+  let es = entrySize v+      insert' (Cache c p s f) = Cache (Map.insert k (v, p) c) (p + 1) s (f - es)+  in (if es <= size cache+      then fmap insert' $ requireFree es cache+      else return cache) where+    requireFree :: (RandomGen g, Ord k, Entry a) => Integer -> Cache k a -> Rand g (Cache k a)+    requireFree n ca = if free ca > n then return ca else flip deleteExisting ca <$> oldestOfSample ca+    oldestOfSample :: RandomGen g => Cache k a -> Rand g (k, a)+    oldestOfSample (Cache c _ _ _) =+      fmap ((fst &&& fst . snd) . minimumBy (comparing $ snd . snd)) $+      sequence $ replicate 10 $ fmap (flip Map.elemAt c) $ getRandomR (0, Map.size c - 1)+    +deleteExisting :: (Ord k, Entry a) => (k, a) -> Cache k a -> Cache k a+deleteExisting (k, a) (Cache c p s f) = Cache (Map.delete k c) p s $ f + entrySize a++delete :: (Ord k, Entry a) => k -> Cache k a -> Cache k a+delete k (Cache c p s f) =+  let (mv, c') = Map.updateLookupWithKey (const $ const Nothing) k c+  in Cache c' p s $ maybe id ((+) . entrySize . fst) mv f

@@ -25,7 +25,7 @@ import Cgm.Data.Multiset as MS
 import Database.Perdure.SpaceBook
 import Database.Perdure.Deref
-import qualified Data.Cache.LRU as LRU
+import qualified Database.Perdure.Cache as Cache
 import Database.Perdure.ArrayRef
 import Control.Concurrent.MVar
 import System.IO.Unsafe
@@ -47,7 +47,7 @@ 
 {-# NOINLINE unsafeClearCache #-}
 unsafeClearCache :: MVar Cache -> Len Word64 Word64 -> ()
-unsafeClearCache c addr = unsafePerformIO $ modifyMVar_  c $ return . fst . LRU.delete addr
+unsafeClearCache c addr = unsafePerformIO $ modifyMVar_  c $ return . Cache.delete addr
 
 decrRef :: forall w. LgMultiple Word64 w => 
            BasicRef w -> (SpaceBook -> SpaceBook) -> SpaceBook -> SpaceBook

@@ -32,8 +32,9 @@ import Data.Word
 import Control.Concurrent.MVar
 import Control.Exception.Base
-import qualified Data.Cache.LRU as LRU
+import qualified Database.Perdure.Cache as Cache
 import Data.Dynamic
+import Control.Monad.Random
 
 class Deref r where
   derefIO :: r a -> IO a
@@ -47,14 +48,16 @@ 
 instance Deref DRef where 
   derefIO (DRef p dc@(DeserializerContext f cv) aRef) = 
-    let addr = arrayRefAddr aRef 
-        r = {-(trace ("(looking up cache at" ++ show addr ++ " wanting an " ++ show (typeOf r))-} modifyMVar cv (return . LRU.lookup addr) >>= 
-            maybe 
-            ((>>= \a -> evaluate a >> (a <$ modifyMVar_ cv (return . {-(trace ("adding to cache at" ++ show addr) $-} LRU.insert addr (toDyn a)))) $
-             fmap (maybe (error "Read error") $ deserializeFromFullArray (cDeser p dc) . (id :: Id (ArrayRange (PrimArray Free Word)))) $
-             derefArrayRef f aRef)
-            (return . fromMaybe (error $ "Wrong type in cache cell " ++ show addr) . fromDynamic)
-    in r
+    let addr = arrayRefAddr aRef
+    in {-trace ("(looking up cache at" ++ show addr ++ " wanting an " ++ show (typeOf r))-}
+     modifyMVar cv (\c -> return $ (maybe (c, Nothing) $ \(e, c') -> (c', Just $ Cache.entryValue e)) $ Cache.lookup addr c) >>= 
+     maybe 
+     ((>>= \a -> evaluate a >>
+                 (a <$ modifyMVar_ cv (evalRandIO . {-trace ("adding to cache at" ++ show addr) $-}
+                                       Cache.insert addr (Cache.Entry (toDyn a) $ arrayRefSize aRef)))) $
+      fmap (maybe (error "Read error") $ deserializeFromFullArray (cDeser p dc) . (id :: Id (ArrayRange (PrimArray Free Word)))) $
+      derefArrayRef f aRef)
+     (return . fromMaybe (error $ "Wrong type in cache cell " ++ show addr) . fromDynamic)
     
 instance Show a => Show (DRef a) where show = show . deref
 instance Eq a => Eq (DRef a) where (==) = derefEq

@@ -30,6 +30,7 @@ import qualified Data.ByteString as B
 import qualified Crypto.Hash.MD5 as MD5
 import qualified Crypto.Hash.Skein512 as Skein512
+--import qualified Database.Perdure.Skein512 as Skein512
 import Cgm.Data.Structured
 
 -- Recovers a hash function on words from a hash function on a specific byte encoding the words

@@ -79,13 +79,13 @@ import Database.Perdure.WValidator import Database.Perdure.StoreFile import Database.Perdure.ReplicatedFile+import Database.Perdure.Cache(Cache) import Cgm.System.Endian import Data.Char import Data.Binary.IEEE754 import Cgm.Data.List import Data.Bits import Database.Perdure.CRef-import Data.Cache.LRU import Data.Dynamic import Control.Concurrent.MVar @@ -94,8 +94,6 @@ data WordArrayRef r32 r64 (r :: * -> *) = Word32ArrayRef !(r32 r) | Word64ArrayRef !(r64 r)  type WArrayRef = WordArrayRef (WordNArrayRef W32Validator) (WordNArrayRef W64Validator)--type Cache = LRU (Len Word64 Word64) Dynamic  data DeserializerContext = forall f. (StoreFile f, StoreRef f ~ BasicRef) => DeserializerContext {dcFile :: f, dcCache :: MVar Cache} 

@@ -28,7 +28,6 @@   --asyncCollectState,
   collectState,
   collectStateM,
-  emptyCache,
   module Database.Perdure.Space,
   module Database.Perdure.Persistent,
   CachedFile(..),
@@ -60,7 +59,6 @@ import Database.Perdure.Deref
 import Database.Perdure.SpaceBook
 import Cgm.Data.Typeable
-import qualified Data.Cache.LRU as LRU
 import Cgm.Data.Maybe
 import Database.Perdure.WriteBits
 import Database.Perdure.AllocCopy
@@ -134,11 +132,6 @@ readState l@(RootLocation f rootAddrs) = 
   fmap (\r -> let rs = rootScan $ toOnlyRev r in PState l (bookSpace $ incr persister rs $ deref $ rootCS rs) r) . 
   maybeMaximumBy (comparing $ rootId . toOnlyRev) . catMaybes <$> sequence (readRoot f <$> rootAddrs)
-
--- | Create an empty cache of the specified size (number of dereferenced DRefs).
--- Note that eventually we would like a cache with a size measured in bytes, for a better prediction of memory consumption.
-emptyCache :: Integer -> Cache
-emptyCache sz = LRU.fromList (Just sz) []
 
 -- | We reserve the option of growing roots to 1MB, so use this as a minimum distance between the various RootAddress in RootLocation
 rootAllocSize :: Len Word64 Word32

@@ -36,6 +36,8 @@   derefArrayRef f (Word64ArrayRef r) = fmap deserInput <$> derefPinnedArrayRef f r
   arrayRefAddr (Word32ArrayRef r) = arrayRefAddr r
   arrayRefAddr (Word64ArrayRef r) = arrayRefAddr r
+  arrayRefSize (Word32ArrayRef r) = arrayRefSize r
+  arrayRefSize (Word64ArrayRef r) = arrayRefSize r
 
 derefPinnedArrayRef :: (ArrayRef r, StoreFile f) => f -> r (StoreRef f) -> IO (Maybe (ArrayRange (PrimArray Pinned (ArrayRefElem r))))
 derefPinnedArrayRef = derefArrayRef

@@ -39,4 +39,5 @@     return $ WordNArrayRef v r platformWordEndianness
   derefArrayRef f (WordNArrayRef v r e) = fmap primArrayMatchAllocation <$> await1 (storeFileRead f r e v)
   arrayRefAddr (WordNArrayRef _ r _) = refStart r
+  arrayRefSize (WordNArrayRef _ r _) = coarsenLen $ fmap fromIntegral $ refSize r