perdure 0.1.2 → 0.2.0

raw patch · 38 files changed

+255/−382 lines, 38 filesdep ~cognimeta-utilsdep ~perdure

Dependency ranges changed: cognimeta-utils, perdure

Files

• exe-src/Database/Perdure/TestMap.hs +2/−2
• exe-src/Database/Perdure/TestPersistent.hs +17/−42
• exe-src/Database/Perdure/TestState.hs +2/−27
• exe-src/Database/Perdure/TestStoreFile.hs +4/−9
• exe-src/Main.hs +0/−9
• perdure.cabal +31/−28
• src/Database/Perdure.hs +18/−4
• src/Database/Perdure/AllocCopy.hs +1/−1
• src/Database/Perdure/Allocator.hs +0/−2
• src/Database/Perdure/CDeserializer.hs +21/−29
• src/Database/Perdure/CRef.hs +0/−5
• src/Database/Perdure/CSerializer.hs +5/−17
• src/Database/Perdure/Count.hs +0/−2
• src/Database/Perdure/Data/Map.hs +11/−12
• src/Database/Perdure/Data/MapMultiset.hs +0/−3
• src/Database/Perdure/Decrementer.hs +4/−10
• src/Database/Perdure/Deref.hs +1/−2
• src/Database/Perdure/Digest.hs +0/−1
• src/Database/Perdure/History.hs +28/−24
• src/Database/Perdure/Incrementer.hs +6/−9
• src/Database/Perdure/Internal.hs +32/−0
• src/Database/Perdure/LocalStoreFile.hs +28/−41
• src/Database/Perdure/Persistent.hs +14/−18
• src/Database/Perdure/RNF.hs +2/−8
• src/Database/Perdure/Ref.hs +1/−4
• src/Database/Perdure/ReplicatedFile.hs +1/−1
• src/Database/Perdure/Rev.hs +1/−2
• src/Database/Perdure/RootValidator.hs +3/−13
• src/Database/Perdure/SingleStoreFile.hs +0/−1
• src/Database/Perdure/SizeRef.hs +0/−2
• src/Database/Perdure/SpaceBook.hs +0/−9
• src/Database/Perdure/SpaceTree.hs +1/−2
• src/Database/Perdure/State.hs +10/−28
• src/Database/Perdure/StoreFile.hs +0/−1
• src/Database/Perdure/Validator.hs +0/−1
• src/Database/Perdure/WValidator.hs +0/−3
• src/Database/Perdure/WordArrayRef.hs +0/−1
• src/Database/Perdure/WriteBits.hs +11/−9

@@ -24,7 +24,7 @@ testMap _ = 
   (quickCheckWith (Args Nothing n n n True) $ insertList [1 .. k] empty == insertList (reverse [1 .. k]) empty) >> 
   (quickCheckWith (Args Nothing n n n True) $ deleteList [1 .. k] (insertList (reverse [1 .. k]) $ insertList [1 .. k] empty) == empty) where
-  insertList l m = foldl' (\z n -> insert n n z) m l
-  deleteList l m = foldl' (\z n -> delete n z) m l
+  insertList l m = foldl' (\z v -> insert v v z) m l
+  deleteList l m = foldl' (flip delete) m l
   n = 5
   k = n * 10000

@@ -24,42 +24,23 @@ 
 import Prelude()
 import Cgm.Prelude
-import Control.Exception
-import Control.DeepSeq
-import Data.Ix
-import Data.Word
-import Data.Functor.Identity
-import Test.QuickCheck
-import Test.QuickCheck.Property
-import Database.Perdure.State
-import Database.Perdure.SizeRef
-import Database.Perdure.RNF
-import Database.Perdure.ReplicatedFile
-import Cgm.Control.Combinators
-import Database.Perdure.Count(Address)
-import Cgm.System.Endian
-import Debug.Trace
-import Cgm.Control.Profile
-import qualified Control.Monad.State.Strict as Std
 import Cgm.Control.Monad.State
+import Cgm.Control.Profile
+import Cgm.Data.Array
 import Cgm.Data.Either
-import Control.Monad.Error
-import qualified Database.Perdure.Data.Map as PMap
-import Database.Perdure.Ref
-import Cgm.Data.Super
-import Database.Perdure.RNF
-import Database.Perdure.CSerializer
-import Database.Perdure.CDeserializer
-import Database.Perdure.RNF
 import Cgm.Data.Nat
-import Cgm.Data.WordN
-import Database.Perdure.Data.MapMultiset
-import Database.Perdure.SpaceTree
-import Control.Monad.Random
-import Control.Concurrent.MVar
+import Cgm.Data.Super
 import Cgm.Data.Typeable
-import Database.Perdure.TestState
+import Cgm.Data.WordN
+import Control.Monad.Error
+import Data.Ix
+import Data.Word
 import Database.Perdure
+import Database.Perdure.Internal
+import Database.Perdure.TestState
+import Test.QuickCheck
+import Test.QuickCheck.Property
+import qualified Database.Perdure.Data.Map as PMap
 
 -- | We test with some type of tree with variable arity and nodes of various sizes.
 data TestTree a = Leaf a | Node [a] [SRef (TestTree a)] deriving (Show, Eq, Typeable)
@@ -78,16 +59,10 @@ -- | We establish a default persister for TestTree, which will simply persist it according to the internal structure.
 instance (Persistent a, Typeable a) => Persistent (TestTree a) where persister = structureMap persister
 
-testInitState :: (Typeable a, Persistent a) => ReplicatedFile -> a -> IO (PState a)
-testInitState f a = fmap defaultRootLocation (newCachedFile 1000 f) >>= \l -> 
-  initState l
-  (addSpan (sortedPair (2 * apply super (getLen rootAllocSize)) $ 100 * 1000000) emptySpace)
-  a
-
 writeReadTestFile :: (Eq a, Persistent a, Typeable a) => a -> String -> IO Bool
 writeReadTestFile a name = fmap fromRight $ runErrorT $ withFileStoreFile name $ (. (ReplicatedFile . pure)) $ \f -> do
   putCpuTime "Data creation" $ evaluate $ prnf persister a
-  putCpuTime "Write time" $
+  putCpuTime "Write time" $ (() <$) $
     newCachedFile 1000 f >>=
     createPVar a (mega 100) . defaultRootLocation
   putCpuTime "Read time" $
@@ -97,14 +72,14 @@ 
 
 testPersistent  :: a -> IO ()
-testPersistent args = quickCheckWith (Args Nothing 1 1 1 True) $ morallyDubiousIOProperty $
+testPersistent _ = quickCheckWith (Args Nothing 1 1 1 True) $ morallyDubiousIOProperty $
                       writeReadTestFile (generateTestTree 15 :: TestTree Word32) "testPersistent.dag"
 
 testPersistentMap  :: a -> IO ()
-testPersistentMap args = quickCheckWith (Args Nothing 1 1 1 True) $ morallyDubiousIOProperty $
+testPersistentMap _ = quickCheckWith (Args Nothing 1 1 1 True) $ morallyDubiousIOProperty $
                          writeReadTestFile (foldl' (\z n -> PMap.insert n n z) PMap.empty [(1 :: Integer) .. 10000])  "testPersistentMap.dag"
 
-propPersister :: forall a p. (Show a, Eq a) => Persister a -> a -> Property
+propPersister :: forall a. (Show a, Eq a) => Persister a -> a -> Property
 propPersister p a = morallyDubiousIOProperty $ return $ (== a) $ 
                     deserializeFromFullArray (unsafeSeqDeserializer p) $ fullArrayRange $ (id :: Id (PrimArray Pinned Word64)) $ serializeToArray p a
 
@@ -115,7 +90,7 @@ myCheck n = quickCheckWith (Args Nothing n n n True)
 
 testSeqPersistent :: a -> IO ()
-testSeqPersistent args = do
+testSeqPersistent _ = do
   myCheck 5 $ propPersistent . (id :: Id Bool)
   myCheck 50 $ propPersistent . (id :: Id Word8)
   myCheck 50 $ propPersistent . (id :: Id (Word8, Word8))

@@ -17,45 +17,20 @@   testStates,   testStatesDag,   testStatesDestroysRaw1,-  SRef(..),+  SRef,   mega   ) where  import Prelude() import Cgm.Prelude-import Control.Exception-import Control.DeepSeq-import Data.Ix import Data.Word-import Data.Functor.Identity import Test.QuickCheck import Test.QuickCheck.Property-import Database.Perdure.State-import Database.Perdure.SizeRef-import Database.Perdure.RNF-import Database.Perdure.ReplicatedFile-import Cgm.Control.Combinators-import Database.Perdure.Count(Address)-import Cgm.System.Endian-import Debug.Trace-import Cgm.Control.Profile-import qualified Control.Monad.State.Strict as Std import Cgm.Control.Monad.State-import Cgm.Data.Either import Control.Monad.Error hiding (sequence_)-import qualified Database.Perdure.Data.Map as PMap-import Database.Perdure.Ref import Cgm.Data.Super-import Database.Perdure.RNF-import Database.Perdure.CSerializer-import Database.Perdure.CDeserializer-import Database.Perdure.RNF import Cgm.Data.Nat-import Cgm.Data.WordN-import Database.Perdure.Data.MapMultiset-import Database.Perdure.SpaceTree import Control.Monad.Random-import Control.Concurrent.MVar import Cgm.Data.Typeable import Database.Perdure @@ -120,7 +95,7 @@   withReplicatedFiles "testStatesDag" $ \f ->    newCachedFile 1000 f >>=   createPVar (Dag $ ref []) (mega 100) . defaultRootLocation >>= \v ->-  for_ [0 .. 1999] $ \c -> do+  for_ [(0 :: Int) .. 1999] $ \c -> do     print c     updatePVar v $ StateT $ fmap (((),) . Just) . evalRandIO . dagBuild 

@@ -18,21 +18,16 @@   ) where
 
 import Data.Word
-import Foreign.Ptr
-import Foreign.Marshal.Array
-import Database.Perdure.StoreFile
-import Database.Perdure.LocalStoreFile
-import Database.Perdure.SingleStoreFile
-import Cgm.Data.Word
+import Database.Perdure
+import Database.Perdure.Internal
 import Cgm.Data.Either
-import Cgm.Data.Len
-import Cgm.Data.Array
 import Cgm.System.Endian
 import Control.Exception
 import Control.Monad.Error
+import Control.Applicative
 
 testStoreFile :: [String] -> IO ()
-testStoreFile args = fmap fromRight $ runErrorT $ withFileStoreFile "testStoreFile.dag" $ (. SingleStoreFile) $
+testStoreFile _ = fmap fromRight $ runErrorT $ withFileStoreFile "testStoreFile.dag" $ (. (ReplicatedFile . pure)) $
     \f -> do
       let a :: PrimArray Pinned Word32 = mkArrayWith 130000 $ fromIntegral . getLen
       r <- storeFileWrite f 0 platformWordEndianness [a]

@@ -17,21 +17,12 @@   main ) where -import Data.Int-import Data.Word-import qualified Data.ByteString.Lazy as BL-import qualified Data.ByteString as B-import qualified Test.QuickCheck as QC-import Test.QuickCheck.Arbitrary import System.Environment-import Language.Haskell.TH import Database.Perdure.TestState import Database.Perdure.TestPersistent import Database.Perdure.TestStoreFile import Database.Perdure.TestMap import Cgm.TH.Label--import Cgm.Control.Profile  main :: IO () main = getArgs >>= argsMain

@@ -1,5 +1,5 @@ Name: perdure-version: 0.1.2+version: 0.2.0 cabal-version: >= 1.8 build-type: Simple license: OtherLicense@@ -11,7 +11,7 @@ bug-reports: synopsis: Robust persistence for acyclic immutable data description: -	     Perdure™, a Cognimeta product, aims to provide a simple and robust persistence mechanism for acyclic+	     Perdure(TM), a Cognimeta product, aims to provide a simple and robust persistence mechanism for acyclic 	     immutable data with an easily comprehensible cost-model. It persists to raw block devices. 	     . 	     For some classes of applications, it can replace the use of traditional DMBS and keep the data modelled in@@ -28,7 +28,7 @@ 	     threshold is reached, and inlines the data otherwise. As a convenience, a Map type is also provided which 	     uses SizeRef on internal tree nodes. It can grow beyond the memory size and still remain efficient for 	     lookups and traversals. Other persistent data structures with similar properties can be built on top of-	     Perdure™.+	     Perdure. 	     . 	     For the user application, dereferencing is a pure computation. This is similar to lazy loading, but the 	     reference data types do not hold ordinary references to their referent, only their location. This allows@@ -118,15 +118,15 @@ 	     * Documentation and examples are not sufficient and should be our first focus. For a minimal example, 	     look at Database.Perdure.TestState.testStatesF in exe-src. 	     .-	     Given those limitations, Perdure™ is not applicable for very large scale projects at the moment. But it can+	     Given those limitations, Perdure is not applicable for very large scale projects at the moment. But it can 	     be ideal for smaller projects where there is no point in burdening the developer with a distinct data 	     model. It can also be used as a temporary solution before integrating to external databases. 	     .-	     Cognimeta's Iota Charts web application <https://iotacharts.com>, is based on Perdure™ and has been has+	     Cognimeta's Iota Charts web application <https://iotacharts.com>, is based on Perdure and has been has 	     been live for close to a year. Its database is relatively small at ~80MB currently, but we have been very 	     pleased with the results. 	     .-	     Perdure™ has been developed by Cognimeta Inc. over the past two years. We are releasing this as open+	     Perdure has been developed by Cognimeta Inc. over the past two years. We are releasing this as open 	     source under the permissive Apache license 2.0. The persistence mechanism is relatively simple and concise 	     and its open source nature can provide the inquisitive user with added confidence about the security of its 	     data.  Also Cognimeta has been using Haskell exclusively, and has benefited from many@@ -150,46 +150,47 @@   extensions: CPP   exposed-modules:     Database.Perdure-    Database.Perdure.AllocCopy+    Database.Perdure.Data.Map+    Database.Perdure.Deref+    Database.Perdure.History+    Database.Perdure.Internal+    Database.Perdure.Persistent+    Database.Perdure.Ref+    Database.Perdure.Rev+    Database.Perdure.SizeRef+  other-modules:             Database.Perdure.Allocator+    Database.Perdure.AllocCopy     Database.Perdure.ArrayRef+    Database.Perdure.Count+    Database.Perdure.CSerializer     Database.Perdure.CDeserializer     Database.Perdure.CRef-    Database.Perdure.CSerializer-    Database.Perdure.Count-    Database.Perdure.DRef-    Database.Perdure.Data.Map     Database.Perdure.Data.MapMultiset     Database.Perdure.Decrementer-    Database.Perdure.Deref-    Database.Perdure.History+    Database.Perdure.Digest+    Database.Perdure.DRef     Database.Perdure.Incrementer     Database.Perdure.LocalStoreFile     Database.Perdure.Package-    Database.Perdure.Persistent-    Database.Perdure.RNF-    Database.Perdure.Ref     Database.Perdure.ReplicatedFile-    Database.Perdure.Rev+    Database.Perdure.RNF     Database.Perdure.RootValidator     Database.Perdure.SingleStoreFile-    Database.Perdure.SizeRef+    Database.Perdure.StoreFile     Database.Perdure.Space     Database.Perdure.SpaceBook     Database.Perdure.SpaceTree     Database.Perdure.State-    Database.Perdure.StoreFile     Database.Perdure.Validator-    Database.Perdure.WValidator+    Database.Perdure.WriteBits     Database.Perdure.WordArrayRef     Database.Perdure.WordNArrayRef-    Database.Perdure.WriteBits-  other-modules:        -    Database.Perdure.Digest+    Database.Perdure.WValidator   build-depends:     base >= 4.5.0.0 && < 5,     template-haskell >= 2.7.0.0,-    cognimeta-utils == 0.1.0,+    cognimeta-utils == 0.1.1,     QuickCheck >=2.4.0.1,     strict >= 0.3.2,     mtl >= 2.1.2,@@ -217,7 +218,7 @@     deepseq >= 1.3.0.0,     deepseq-th >= 0.1.0.3 -  ghc-options: -rtsopts -fcontext-stack=80 -O2 -funfolding-use-threshold=24 -pgmP cpphs -optP --cpp+  ghc-options: -rtsopts -Wall -fno-warn-orphans -fcontext-stack=80 -O2 -funfolding-use-threshold=24 -pgmP cpphs -optP --cpp   extensions:   source-repository head@@ -235,13 +236,15 @@   build-depends:     base >= 4.5.0.0,     template-haskell >= 2.7.0.0,-    cognimeta-utils == 0.1.0,+    cognimeta-utils == 0.1.1,     mtl >= 2.1.2,     deepseq,     QuickCheck >=2.4.0.1,-    perdure >= 0.1.2,+    perdure >= 0.2.0,     transformers >= 0.3.0.0,     bytestring >= 0.9.2.1,     containers >= 0.4.2.1,     MonadRandom == 0.1.3-  ghc-options: -rtsopts -fcontext-stack=80 -fno-warn-duplicate-exports -O2 -funfolding-use-threshold=24 -threaded+  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

@@ -15,8 +15,18 @@  module Database.Perdure(   module Database.Perdure.Persistent,-  defaultRootLocation,+  module Database.Perdure.Ref,+  module Database.Perdure.Deref,+  module Database.Perdure.Rev,+  module Database.Perdure.SizeRef,+  LocalStoreFile,+  withRawDeviceStoreFiles,+  withRawDeviceStoreFile,+  withFileStoreFile,+  ReplicatedFile(..),   newCachedFile,+  RootLocation,+  defaultRootLocation,   PVar,   openPVar,   createPVar,@@ -28,15 +38,19 @@ import Cgm.Prelude import Database.Perdure.State import Database.Perdure.Persistent+import Database.Perdure.Ref+import Database.Perdure.Deref+import Database.Perdure.Rev+import Database.Perdure.SizeRef import Cgm.Control.Monad.State as M import Cgm.Data.Typeable-import Control.Monad hiding (sequence)-import Control.Monad.Trans import Control.Monad.Reader hiding (sequence)-import Control.Applicative import Cgm.Control.Concurrent.MVar import Cgm.Data.Super+import Cgm.Data.Len import Data.Word+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) newCachedFile :: Integer -> ReplicatedFile -> IO CachedFile

@@ -45,5 +45,5 @@   -- Starts writing after the specified length 'skip', which can later be used to write a header.
   allocCopyBitsSkip skip start end = do
     wBuf <- mkArray $ coarsenLen (addedBits end start) + skip
-    copyBits end start (aligned $ CWordSeq wBuf skip) >>= padIncompleteWord
+    _ <- copyBits end start (aligned $ CWordSeq wBuf skip) >>= padIncompleteWord
     return wBuf

@@ -29,8 +29,6 @@ import Database.Perdure.LocalStoreFile
 import Database.Perdure.SingleStoreFile
 import Database.Perdure.ReplicatedFile
-import Cgm.Data.Len
-import Cgm.Data.Array
 import Cgm.Data.Super
 import Cgm.System.Endian
   

@@ -27,35 +27,29 @@ 
 import Prelude ()
 import Cgm.Prelude
-import Data.Functor.Compose
-import Control.Concurrent
 import Database.Perdure.Persistent
+import Database.Perdure.StoreFile
 import Database.Perdure.CRef
-import Cgm.Data.Functor
-import Cgm.Data.Array
 import Cgm.Data.Word
-import Cgm.Data.Len
 import Data.Bits
-import Foreign.Ptr
-import Database.Perdure.ReplicatedFile
-import System.IO.Unsafe
 
 -- TODO figure out why the Deserializer's Allocator df is free to differ from f. Why is it a type argument of Deserializer at all if it can be anything?
 
 -- TODO consider reimplementing as in CSerializer (no Serializer layer, and possibly with continuations) and check performance
 
 deserializeFromArray :: (Allocation f, Allocation df, Deserializable w) => Deserializer df a -> ArrayRange (PrimArray f w) -> DeserOut a
-deserializeFromArray d = (\(ArrayRange arr start _) -> deserialize d (refineLen start) arr) . deserInput
+deserializeFromArray d = (\(ArrayRange ar start _) -> deserialize d (refineLen start) ar) . deserInput
 
 deserializeFromFullArray :: forall f df w a. (Allocation f, Allocation df, Deserializable w, LgMultiple w Bool, Prim w) => 
                             Deserializer df a -> ArrayRange (PrimArray f w) -> a
-deserializeFromFullArray d arr = case deserializeFromArray d arr of
-  DeserOut a end -> bool (error $ "Inconsistent deserialized size: " ++ show (end, refineLen $ arrayLen arr :: Len Bool Word)) a $ 
-             (coarsenLen end :: Len w Word) == arrayLen arr
+deserializeFromFullArray d ar = case deserializeFromArray d ar of
+  DeserOut a end -> bool (error $ "Inconsistent deserialized size: " ++ show (end, refineLen $ arrayLen ar :: Len Bool Word)) a $ 
+             (coarsenLen end :: Len w Word) == arrayLen ar
 
 -- | The passed persister must have no references
 unsafeSeqDeserializer :: Persister a -> Deserializer Free a
-unsafeSeqDeserializer p = cDeser p (DeserializerContext (error "seqDeserializer has no file" :: ReplicatedFile) (error "seqDeserializer has no cache"))
+unsafeSeqDeserializer p =
+  cDeser p (DeserializerContext (error "seqDeserializer has no file" :: ReplicatedFile) (error "seqDeserializer has no cache"))
 
 cDeser :: Persister a -> DeserializerContext -> Deserializer Free a
 cDeser p = case p of
@@ -63,7 +57,7 @@   PairPersister pa pb -> liftA2 (liftA2 (,)) (cDeser pa) (cDeser pb)
   EitherPersister pa pb -> \dc -> cDeser persister dc >>= bool (Left <$> cDeser pa dc) (Right <$> cDeser pb dc)
   ViewPersister i pb -> flip functorIacomap i . cDeser pb
-  SummationPersister pi d _ -> \dc -> cDeser pi dc >>= d (\pb ba -> fmap ba $ cDeser pb dc)
+  SummationPersister pi' d _ -> \dc -> cDeser pi' dc >>= d (\pb ba -> fmap ba $ cDeser pb dc)
   DRefPersister' -> \dc -> DRef persister dc <$> cDeser persister dc 
   CRefPersister' _ pra -> fmap Refed . cDeser pra
   
@@ -72,7 +66,7 @@   iacomap = functorIacomap
 
 bitDeserializer :: Deserializer f Word
-bitDeserializer = Deserializer $ \bit arr -> DeserOut (let (wIx, bIx) = coarseRem bit in (indexArray arr wIx `partialShiftRL` getLen bIx) .&. 1) (bit + 1)
+bitDeserializer = Deserializer $ \b ar -> DeserOut (let (wIx, bIx) = coarseRem b in (indexArray ar wIx `partialShiftRL` getLen bIx) .&. 1) (b + 1)
 
 -- 0 <= n <= wordBits
 partialWordDeserializer :: Len Bool Word -> Deserializer f Word
@@ -80,16 +74,17 @@   | n == 0 = pure 0
   | n == 1 = bitDeserializer
   | otherwise =
-    Deserializer $ \bit arr -> 
+    Deserializer $ \b ar -> 
     DeserOut (
-      let (wIx, bIx) = coarseRem bit 
+      let (wIx, bIx) = coarseRem b
           avail = wordBits - bIx
           overflow = n - avail
           n' = wordBits - n
-      in bool (indexArray arr wIx `partialShiftL` getLen (n' - bIx) `partialShiftRL` getLen n') 
-         ((indexArray arr wIx `partialShiftRL` getLen bIx) + (indexArray arr (wIx + 1) `partialShiftL` getLen (wordBits - overflow) `partialShiftRL` getLen n')) $ 
+      in bool (indexArray ar wIx `partialShiftL` getLen (n' - bIx) `partialShiftRL` getLen n') 
+         ((indexArray ar wIx `partialShiftRL` getLen bIx) +
+          (indexArray ar (wIx + 1) `partialShiftL` getLen (wordBits - overflow) `partialShiftRL` getLen n')) $ 
          (signed $* getLen overflow) > 0)
-    (bit + n)
+    (b + n)
 
 ---------------------------------------------------------------------------
 
@@ -127,18 +122,15 @@ --    point x = ... inlined into pure
 instance Applicative (Deserializer f) where
   {-# INLINE pure #-}
-  pure x = Deserializer $ \bit _ -> DeserOut x bit
+  pure x = Deserializer $ \b _ -> DeserOut x b
   {-# INLINE (<*>) #-}
-  g <*> x = Deserializer $ \bit ptr -> case deserialize g bit ptr of DeserOut g' bit' -> deserialize (g' <$> x) bit' ptr
+  g <*> x = Deserializer $ \b ptr -> case deserialize g b ptr of DeserOut g' b' -> deserialize (g' <$> x) b' ptr
     -- we could define <*> = ap, but we would like to see if we could use <*> in the definition of join instead, see reflexion below
 instance Monad (Deserializer f) where
   {-# INLINE return #-}
   return = pure
   {-# INLINE (>>=) #-}
-  (>>=) = fmap join . flip fmap where
-    {-# INLINE join #-}
-    join :: Deserializer f (Deserializer f a) -> Deserializer f a
-    join d2 = Deserializer $ \bit ptr -> case deserialize d2 bit ptr of DeserOut d bit' -> deserialize d bit' ptr
-
-getBitDeserializer :: Deserializer f (Len Bool Word)
-getBitDeserializer = Deserializer $ \bit _ -> DeserOut bit bit
+  (>>=) = fmap join' . flip fmap where
+    {-# INLINE join' #-}
+    join' :: Deserializer f (Deserializer f a) -> Deserializer f a
+    join' d2 = Deserializer $ \b ptr -> case deserialize d2 b ptr of DeserOut d b' -> deserialize d b' ptr

@@ -18,12 +18,7 @@   onCRef
   ) where
 
-import Control.Concurrent
-import Control.Applicative
-import System.IO.Unsafe
-import Cgm.Control.Combinators
 import Data.Dynamic
-import Cgm.Data.Typeable
 import Database.Perdure.Package
 
 

@@ -25,36 +25,24 @@ import Prelude ()
 import Cgm.Prelude
 
-import Data.Functor.Compose
 import Control.Concurrent
-import Control.Monad.State
 import GHC.Base hiding ((.), id)
 import GHC.IO hiding (liftIO)
-import GHC.Exts
 import Cgm.Data.Functor.Sum
-import Cgm.Data.Either
 import Cgm.Data.Word
-import Cgm.Data.Len
 import Cgm.Control.Concurrent.NotificationCount
-import Cgm.Control.Combinators
 import Database.Perdure.CDeserializer
 import Database.Perdure.Count
 import Cgm.Data.Multiset as MS
-import Data.IORef
-import System.IO.Unsafe
 import Database.Perdure.AllocCopy
-import Foreign.Ptr
 import Cgm.Data.Maybe
-import Database.Perdure.ReplicatedFile
 import Database.Perdure.Allocator
 import Database.Perdure.ArrayRef
-import Database.Perdure.WordArrayRef
-import Database.Perdure.WordNArrayRef
-import Database.Perdure.Persistent
+import Database.Perdure.WordArrayRef()
+import Database.Perdure.WordNArrayRef()
 import Cgm.Data.MapMultiset
 import qualified Data.Cache.LRU as LRU
 import Data.Dynamic
-import Debug.Trace
 
 
 -- Important : We must not read (deref) a ref that has just been written in the current writeState.
@@ -81,7 +69,7 @@   PairPersister pb pc -> case a of (b, c) -> cSer pb sc (\b' -> cSer pc sc (\c' -> k (b', c')) c) b d
   EitherPersister pb pc -> either (\b -> stToIO (addBit 0 d) >>= cSer pb sc (k . Left) b) (\c -> stToIO (addBit 1 d) >>= cSer pc sc (k . Right) c) a
   ViewPersister i pb -> cSer pb sc (k . fromJust . unapply i) (apply i a) d
-  SummationPersister pi _ s -> s (\i pb ba b -> cSer pi sc (const $ cSer pb sc (k . ba) b) i d) a -- i' is ignored, i type should not contain CRefs
+  SummationPersister pi' _ s -> s (\i pb ba b -> cSer pi' sc (const $ cSer pb sc (k . ba) b) i d) a -- i' is ignored, i type should not contain CRefs
   DRefPersister' -> case a of (DRef _ _ w) -> 
                                 case sc of (_, _, c) -> addCount (arrayRefAddr w) c >> 
                                                         cSer persister sc (const $ k a) w d -- TODO verify if call to persister is wastful
@@ -117,11 +105,11 @@   IRefPersister pb -> cSerRef pb sc (k . IRef) a d
   
 noCount :: SerializerContext l c -> SerializerContext l c
-noCount (cache, l, c) = (cache, l, Nothing)
+noCount (cache, l, _) = (cache, l, Nothing)
 
 mkDRef :: (Allocator l, BitSrc s, SrcDestState s ~ RealWorld, Typeable a) => 
           SerializerContext l c -> Persister a -> Maybe a -> s -> s -> IO (DRef a)
-mkDRef sc@(cache, l, _) p ma = writeDRef p ma (DeserializerContext (allocatorStoreFile l) cache) l
+mkDRef (cache, l, _) p ma = writeDRef p ma (DeserializerContext (allocatorStoreFile l) cache) l
 
 writeDRef :: (Allocator l, BitSrc s, SrcDestState s ~ RealWorld, Typeable a) => 
              Persister a -> Maybe a -> DeserializerContext -> l -> s -> s -> IO (DRef a)

@@ -15,8 +15,6 @@   Address
   ) where
 
-import Prelude()
-import Cgm.Prelude
 import Data.Word
 import Cgm.Data.Len
 

@@ -38,18 +38,17 @@ import Database.Perdure.Persistent
 import Database.Perdure.SizeRef
 import Control.Arrow
-import Control.Monad
 import Data.Tuple
 import Data.Functor
 import Data.List(foldl')
 import Data.Lens
 import Cgm.Data.Nat
 import Database.Perdure.Ref
+import Database.Perdure.Deref
 import Cgm.Data.Maybe
 import Control.Comonad.Trans.Store
 import Data.Dynamic
 import Database.Perdure.Package
-import Cgm.Data.Typeable
 
 type R = CRef (SizeRef D9)
 
@@ -107,19 +106,19 @@ updateM :: forall k a b. Ord k => k -> State (Maybe a) b -> State (Map k a) b
 updateM k s = get >>= \p -> case p of
   Empty -> appState Nothing (maybe Empty $ NonEmpty . LastLevel . Upper k . Leaf) s
-  r@(NonEmpty t) -> (\(c, b) -> onModify (return b) ((b <$) . put) c) $ case t of
+  (NonEmpty t') -> (\(c, b) -> onModify (return b) ((b <$) . put) c) $ case t' of
     LastLevel ua -> first (fmap $ either NonEmpty (\Empt -> Empty)) $ trans' k s ua
     NextLevel t -> first (fmap $ NonEmpty . either NextLevel id) $ updateT t where
       updateT :: Tr t => Tree (Reference (Node t)) k a -> (Modify (Either (Tree (Reference (Node t)) k a) (Tree t k a)), b)
       updateT (LastLevel ua) = first (fmap $ either Left (Right . LastLevel)) $ trans' k s ua
-      updateT (NextLevel t) = first (fmap $ Left . either NextLevel id) $ updateT t
+      updateT (NextLevel t'') = first (fmap $ Left . either NextLevel id) $ updateT t''
     
 trans' :: (Tr t, Ord k) => k -> State (Maybe a) b -> Upper t k a -> (Modify (Either (Tree t k a) (G t k a)), b)
-trans' k s a = first (fmap $ \o -> case o of 
+trans' k s = first (fmap $ \o -> case o of 
                   Merge a -> Right a
                   Single a -> Left $ LastLevel a
                   Split a0 a1 -> Left $ NextLevel $ LastLevel $ mapUpper reference $ node2 a0 a1
-              ) $ trans k s a
+              ) . trans k s
 
 data Modify a = Leave | Change !a deriving Functor
 onModify :: z -> (a -> z) -> Modify a -> z
@@ -200,7 +199,7 @@ scan :: forall k a z. (k -> a -> z) -> (k -> z -> z -> z) -> Map k a -> Maybe z
 scan kaz kzzz m = case m of 
   Empty -> Nothing  
-  NonEmpty tr -> Just $ s1 tr $ \(Upper k (Leaf a)) -> kaz k a where
+  NonEmpty t -> Just $ s1 t $ \(Upper k (Leaf a)) -> kaz k a where
     s1 :: Tree t k a -> (Upper t k a -> z) -> z
     s1 tr utz = case tr of
       LastLevel ut -> utz ut
@@ -233,16 +232,16 @@   Empty -> z
   NonEmpty t -> foldlf z t where
     foldlf :: Tr t => z -> Tree t k a -> z
-    foldlf z (LastLevel t) = foldlK f z t
-    foldlf z (NextLevel t) = foldlf z t
+    foldlf zz (LastLevel tt) = foldlK f zz tt
+    foldlf zz (NextLevel tt) = foldlf zz tt
 
 foldrWithKey :: forall z k a. (k -> a -> z -> z) -> z -> Map k a -> z
 foldrWithKey f z m = case m of
   Empty -> z
   NonEmpty t -> foldrf z t where
     foldrf :: Tr t => z -> Tree t k a -> z
-    foldrf z (LastLevel t) = foldrK f z t
-    foldrf z (NextLevel t) = foldrf z t
+    foldrf zz (LastLevel tt) = foldrK f zz tt
+    foldrf zz (NextLevel tt) = foldrf zz tt
 
 fromList :: Ord k => [(k, a)] -> Map k a
 fromList = foldl' (\z (k, a) -> insert k a z) empty
@@ -269,7 +268,7 @@ maxKey Empty = Nothing
 maxKey (NonEmpty t) = Just $ maxKeyT t where
   maxKeyT :: Tree t k a -> k
-  maxKeyT (NextLevel t) = maxKeyT t
+  maxKeyT (NextLevel t') = maxKeyT t'
   maxKeyT (LastLevel (Upper k _)) = k
 
 

@@ -20,15 +20,12 @@ 
 import Prelude()
 import Cgm.Prelude
-import Cgm.Data.Maybe
 import Cgm.Data.Multiset
 import Database.Perdure.Persistent
 import Cgm.Control.Monad.State
 import Database.Perdure.Data.Map(Map)
 import qualified Database.Perdure.Data.Map as Map
 import Data.Dynamic
-import Cgm.Data.Typeable
-import Database.Perdure.Package
 
 newtype MapMultiset a = MapMultiset {mapMultisetMap :: Map a Integer} deriving Typeable
 

@@ -20,32 +20,26 @@ import Prelude ()
 import Cgm.Prelude
 import Cgm.Data.Structured
-import Control.Monad.State
 import Database.Perdure.Persistent
 import Database.Perdure.Space
-import Database.Perdure.Count
-import Database.Perdure.CSerializer(Address)
-import Cgm.Data.Monoid
 import Cgm.Data.Multiset as MS
 import Database.Perdure.SpaceBook
-import Database.Perdure.Ref
+import Database.Perdure.Deref
 import qualified Data.Cache.LRU as LRU
-import Data.Dynamic
 import Database.Perdure.ArrayRef
 import Control.Concurrent.MVar
 import System.IO.Unsafe
-import Debug.Trace
 
 -- TODO consider addding a (lazy) bool into persisters that says if StoreRefs are present in descendents, and checking it to prune parts of the traversal
 
 -- | Has effects through unsafePerformIO on the caches stored in the DRefs (removes any cache entries for the deallocated allocations).
 decr :: Persister a -> a -> SpaceBook -> SpaceBook
 decr !p !a !s = case p of
-  PartialWordPersister n -> s
+  PartialWordPersister _ -> s
   PairPersister pb pc -> case a of (b, c) -> decr pc c $ decr pb b s
   EitherPersister pb pc -> either (decr pb) (decr pc) a s
   ViewPersister i pb -> decr pb (apply i a) s
-  SummationPersister pi _ f -> f (\i pb _ b -> decr pb b $ decr pi i s) a
+  SummationPersister pi' _ f -> f (\i pb _ b -> decr pb b $ decr pi' i s) a
   DRefPersister' -> case a of (DRef _ (DeserializerContext _ cache) warr) -> 
                                 let referenced = decr persister $ let da = deref a in da `seq` unsafeClearCache cache (arrayRefAddr warr) `seq` da
                                 in either (\(WordNArrayRef _ r _) -> decrRef r referenced) (\(WordNArrayRef _ r _) -> decrRef r referenced) (unwrap warr) s
@@ -58,5 +52,5 @@ decrRef :: forall w. LgMultiple Word64 w => 
            BasicRef w -> (SpaceBook -> SpaceBook) -> SpaceBook -> SpaceBook
 decrRef r onDealloc sb@(SpaceBook c s) =
-  maybe ((\(SpaceBook c s') -> SpaceBook c ({-trace ("freeing span " ++ show (refSpan r)) $-} addSpan (refSpan r) s')) $ onDealloc sb)
+  maybe ((\(SpaceBook c' s') -> SpaceBook c' ({-trace ("freeing span " ++ show (refSpan r)) $-} addSpan (refSpan r) s')) $ onDealloc sb)
   (flip SpaceBook s) $ MS.delete (refStart r) c

@@ -26,7 +26,7 @@ import Cgm.Control.Combinators
 import Database.Perdure.Persistent
 import Database.Perdure.CDeserializer
-import Database.Perdure.WordArrayRef
+import Database.Perdure.WordArrayRef()
 import Database.Perdure.WordNArrayRef
 import Control.Applicative
 import Data.Word
@@ -34,7 +34,6 @@ import Control.Exception.Base
 import qualified Data.Cache.LRU as LRU
 import Data.Dynamic
-import Debug.Trace
 
 class Deref r where
   derefIO :: r a -> IO a

@@ -28,7 +28,6 @@ import Cgm.System.Endian
 import System.IO.Unsafe
 import qualified Data.ByteString as B
-import qualified Data.ByteString.Lazy as Lazy
 import qualified Crypto.Hash.MD5 as MD5
 import qualified Crypto.Hash.Skein512 as Skein512
 import Cgm.Data.Structured

@@ -14,7 +14,7 @@ {-# LANGUAGE TemplateHaskell, TypeFamilies, DeriveDataTypeable #-}
 
 module Database.Perdure.History (
-  History(..),
+  History,
   initial,
   current,
   insert,
@@ -30,26 +30,10 @@ import Cgm.Control.Monad.State
 import Control.Monad
 import Database.Perdure.Ref
+import Database.Perdure.Deref
 import Data.Dynamic
 
 
--- The History type is used as the state type so as to keep some snapshots of the past, in case data is lost due to a programming error
--- by the application developer. It is an homogenous collection so the argument type has to take care of versionning.
--- To avoid needless reserialization of the samples the argument type should be a Ref type.
-
--- We keep the last maxQueueLength samples inserted, then maxQueueLength samples keeping one out of every two, 
--- then maxQueueLength samples keeping one out of every four...
--- The history is never empty, so it is safe to get the current sample.
-
--- For example:
--- *Database.Perdure.History> foldr insert empty [0..999] -- with maxQueueLenth == 8
--- History 1000 [Queue [0,1,2,3,4,5,6,7],Queue [9,11,13,15,17,19,21,23],Queue [27,31,35,39,43,47,51,55],Queue [63,71,79,87,95,103,111
--- ,119],Queue [127,143,159,175,191,207,223,239],Queue [255,287,319,351,383,415,447,479],Queue [543,607,671,735,799,863,927,991]]
-
--- If the sampling interval is 1 second, and maxQueueLength is 8,
--- we get roughly 8 * log3(running-time/k)
--- For 3 years that's roughly 8*17 = 136 snapshots
-
 newtype Queue a = Queue (CDRef [a]) deriving (Show, Typeable)
 singletonQueue :: a -> Queue a
 singletonQueue a = Queue $ ref [a]
@@ -59,34 +43,54 @@   trim l = 
     if length l <= maxQueueLength 
     then (l, Nothing)
-    else case reverse $ take (maxQueueLength + 1) l of -- the 'take' drop elements when we decide to reduce maxQueueLength
-      (o : r) -> (reverse r, Just o) 
-  
+    else case reverse $ take (maxQueueLength + 1) l of -- the 'take' drops elements when we decide to reduce maxQueueLength
+      (o : r) -> (reverse r, Just o)
+      [] -> undefined
+
 maxQueueLength :: Int
 maxQueueLength = 2
--- maxQueueLength temporarily reduce from 8 to 2 to
 
+-- | The History type is used as the state type so as to keep some snapshots of the past, in case data is lost due to a programming error
+-- by the application developer. It is an homogenous collection so the argument type has to take care of versionning.
+-- To avoid needless reserialization of the past states, the argument type should be a Ref type.
+-- 
+-- We keep the last n samples inserted, then n samples keeping one out of every two, 
+-- then n samples keeping one out of every four... Currently n is hard coded to 2.
 data History a = History Integer [Queue a] deriving (Show, Typeable)
 
+-- As an example:
+-- *Database.Perdure.History> foldr insert empty [0..999] -- if n were 8
+-- History 1000 [Queue [0,1,2,3,4,5,6,7],Queue [9,11,13,15,17,19,21,23],Queue [27,31,35,39,43,47,51,55],Queue [63,71,79,87,95,103,111
+-- ,119],Queue [127,143,159,175,191,207,223,239],Queue [255,287,319,351,383,415,447,479],Queue [543,607,671,735,799,863,927,991]]
+-- If the sampling interval is 1 second, and maxQueueLength is 8, we get roughly 8 * log3(running-time/k)
+-- For 3 years that's roughly 8*17 = 136 snapshots
+
 initial :: a -> History a
 initial = History 1 . pure . singletonQueue
 
+-- | Changes a transformation on 'a' into a transformation on 'History a'. Adds a new state into the 'History'.
 updateHistory :: Monad m => Std.StateT a m b -> Std.StateT (History a) m b
 updateHistory = Std.StateT . (\u h -> liftM (second $ flip insert h) (u $ current h) )  . Std.runStateT
 
+-- | Changes a transformation on 'a' into a transformation on 'History a'. Adds a new state into the 'History',
+-- unless the state has not changed. Uses 'Cgm.Control.Monad.State'.
 updateHistoryM :: Monad m => StateT a m b -> StateT (History a) m b
 updateHistoryM = StateT . (\u h -> liftM (second $ fmap $ flip insert h) (u $ current h) )  . runStateT
 
+-- | The history is never empty, so it is safe to get the current sample.
 current :: History a -> a
-current (History _ (Queue q : _)) = head $ deref q
+current (History _ q') = case q' of
+  (Queue q : _) -> head $ deref q
+  [] -> undefined
 
 --Used when we want to flush the history
 --insert :: a -> History a -> History a
 --insert a _ = initial a
 
+-- | Add a newer state to the history
 insert :: a -> History a -> History a
 insert a (History n qs) = History (n+1) $ ins a qs n where
-  ins o [] m = [singletonQueue o]
+  ins o [] _ = [singletonQueue o]
   ins o (q:qr) m = let (q', mo') = queueInsert o q in q' : maybe qr (\o' -> if testBit m 0 then qr else ins o' qr (m `shiftR` 1)) mo'
                                                       -- we could use a probability instead of this alternating pattern, but this is easier to implement
 

@@ -20,17 +20,14 @@ import Prelude ()
 import Cgm.Prelude
 import Cgm.Data.Structured
-import Control.Monad.State
+import Cgm.Data.Word
+import Cgm.Data.Len
 import Database.Perdure.Persistent
 import Database.Perdure.Space
-import Database.Perdure.Count
-import Database.Perdure.CSerializer(Address)
-import Cgm.Data.Monoid
-import Database.Perdure.ReplicatedFile
 import Cgm.Data.Multiset as MS
-import Debug.Trace
 import Database.Perdure.SpaceBook
-import Database.Perdure.Ref
+import Database.Perdure.Deref
+import Database.Perdure.StoreFile
 
 -- While Decrementer should be used on allocated values (not in s, and may have a count in c), Incrementer is used
 -- on values which have already been written, but we use older values of s and c for which the value to increment
@@ -38,11 +35,11 @@ 
 incr :: Persister a -> a -> SpaceBook -> SpaceBook
 incr !p !a !s = case p of
-  PartialWordPersister n -> s
+  PartialWordPersister _ -> s
   PairPersister pb pc -> case a of (b, c) -> incr pc c $ incr pb b s
   EitherPersister pb pc -> either (incr pb) (incr pc) a s
   ViewPersister i pb -> incr pb (apply i a) s
-  SummationPersister pi _ f -> f (\i pb _ b -> incr pb b $ incr pi i s) a
+  SummationPersister pi' _ f -> f (\i pb _ b -> incr pb b $ incr pi' i s) a
   DRefPersister' -> case a of (DRef _ _ warr) -> 
                                 let referenced = incr persister $ deref a
                                 in either (\(WordNArrayRef _ r _) -> incrRef r referenced) (\(WordNArrayRef _ r _) -> incrRef r referenced) (unwrap warr) s

@@ -0,0 +1,32 @@+{-+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.Internal(+  module Database.Perdure.CSerializer,+  module Database.Perdure.RNF,+  module Database.Perdure.StoreFile,+  module Database.Perdure.State,+  module Database.Perdure.Incrementer,+  module Database.Perdure.Decrementer,+  module Database.Perdure.Data.MapMultiset,+  module Database.Perdure.SpaceBook+  ) where++import Database.Perdure.CSerializer+import Database.Perdure.RNF+import Database.Perdure.StoreFile+import Database.Perdure.State+import Database.Perdure.Incrementer+import Database.Perdure.Decrementer+import Database.Perdure.Data.MapMultiset+import Database.Perdure.SpaceBook

@@ -32,23 +32,11 @@ import Cgm.Prelude
 import Data.Typeable
 import qualified Data.ByteString as B
-import Control.Exception
 import Control.Concurrent
-import Control.Concurrent.STM
-import GHC.Conc
 import Data.Word
 import qualified Data.Map as Map
-import Data.Ord
-import System.FilePath
-import Data.Monoid
-import Foreign.Ptr
-import Foreign.Marshal.Array
-import Cgm.Data.Word
 import Cgm.Data.Super
 import Cgm.Data.Len
-import Cgm.Data.List
-import Cgm.Data.Maybe
-import Cgm.Data.Functor
 import Cgm.Data.Monoid
 import Cgm.Data.NEList
 import Cgm.Data.Either
@@ -64,8 +52,6 @@ import Data.Bits
 import Control.Monad.Error hiding (sequence_)
 import Database.Perdure.StoreFile(SyncableStoreFile(..))
-import Debug.Trace
-import Control.DeepSeq
 --import System.Posix.Fsync -- not needed with raw devices
 
 class SyncableStoreFile f => RawStoreFile f where
@@ -90,6 +76,7 @@   
 ---------------------------------------------------------------------------
 
+-- | A file or raw device where we can persist bytes.
 newtype LocalStoreFile = LocalStoreFile (MVar DevOp) 
 -- TODO: review to see if this queue is acceptable
 type ByteAddr = Len Word8 Word64
@@ -179,43 +166,41 @@   getSingle ((k, ne), m) = flip onNEList ne $ \single ne' -> ((k, single), maybe id (Map.insert k) ne' m)
 
 data CLook = CLook ByteAddr (Map.Map ByteAddr (NEList PosOp)) (Map.Map ByteAddr (NEList PosOp)) deriving Show
+updateLow :: (Map.Map ByteAddr (NEList PosOp) -> Map.Map ByteAddr (NEList PosOp)) -> CLook -> CLook
 updateLow u (CLook c low high) = CLook c (u low) high
+updateHigh :: (Map.Map ByteAddr (NEList PosOp) -> Map.Map ByteAddr (NEList PosOp)) -> CLook -> CLook
 updateHigh u (CLook c low high) = CLook c low (u high)
 instance Schedule CLook where
   emptySchedule = CLook 0 Map.empty Map.empty
   insertOp op@(PosOp seek _) s@(CLook c _ _) = {- (\s' -> trace ("insertOp on " ++ show s) s') $ -} bool updateLow updateHigh (seek >= c) (Map.insertWith neAppend seek (neSingleton op)) s
-  nextOp s@(CLook _ low high) = {- trace ("nextOp on " ++ show s) $ -} useHighMin `firstJust` useLowMin where
+  nextOp (CLook _ low high) = {- trace ("nextOp on " ++ show s) $ -} useHighMin `firstJust` useLowMin where
     useLowMin = (\((pos, op), low') -> (op, CLook pos low' high)) <$> minViewWithKeyNE low
     useHighMin = (\((pos, op), high') -> (op, CLook pos low high')) <$> minViewWithKeyNE high
 
 --
     
-instance Error () where
-  noMsg = ()
-  strMsg _ = ()
-
 class Show f => RawFile f where
-  fileWriteRaw :: f -> Len Word8 Word64 -> [ArrayRange (PrimArray Pinned Word8)] -> ErrorT () IO ()
-  fileReadRaw :: f -> Len Word8 Word64 -> ArrayRange (STPrimArray RealWorld Pinned Word8) -> ErrorT () IO ()
+  fileWriteRaw :: f -> Len Word8 Word64 -> [ArrayRange (PrimArray Pinned Word8)] -> ErrorT String IO ()
+  fileReadRaw :: f -> Len Word8 Word64 -> ArrayRange (STPrimArray RealWorld Pinned Word8) -> ErrorT String IO ()
   fileFlush :: f -> IO ()
   
 instance RawFile Handle where
   fileWriteRaw h seek bufs = lift $ hSeekX h seek >> sequence_ (withArrayPtr (hPutBufLen h) <$> bufs) -- TODO fix error handling
-  fileReadRaw h seek buf = ErrorT $ fmap (boolEither () () . (== arrayLen buf)) $ hSeekX h seek >> withArrayPtr (hGetBufLen h) buf
+  fileReadRaw h seek buf = ErrorT $ fmap (boolEither "" () . (== arrayLen buf)) $ hSeekX h seek >> withArrayPtr (hGetBufLen h) buf
   fileFlush = hFlush  -- todo fsync or fdatasync on FD so we flush to the drive (and the platter?, see comment below)
 
 performAll :: (Schedule s, RawFile f) => f -> s -> IO ()
 performAll f s = maybe (return ()) (\(op, s') -> perform f op >> performAll f s') $ nextOp s
 
 perform :: RawFile f => f -> PosOp -> IO ()
-perform f p@(PosOp seek rw) = {- putStrLn ("about to perform " ++ show p) >> -} case rw of 
-  WriteOp bufs k -> runErrorT (fileWriteRaw f seek bufs) >>= (log >>) . either (const $ k False) (const $ k True) where
+perform f (PosOp seek rw) = {- putStrLn ("about to perform " ++ show p) >> -} case rw of 
+  WriteOp bufs k -> runErrorT (fileWriteRaw f seek bufs) >>= (log' >>) . either (const $ k False) (const $ k True) where
     --log = putStrLn ("Wrote " ++ showLen (sum $ fmap arrayLen bufs) ++ " at " ++ showLen seek ++ " on " ++ show f {- ++ ": " ++ show bufs -})
-    log = return ()
+    log' = return ()
     --log = putStr "w"
-  ReadOp buf k -> runErrorT (fileReadRaw f seek buf) >>= (log >>) . either (const $ k False) (const $ k True) where
+  ReadOp buf k -> runErrorT (fileReadRaw f seek buf) >>= (log' >>) . either (const $ k False) (const $ k True) where
     --log = putStrLn ("Read " ++ showLen (arrayLen buf) ++ " at " ++ showLen seek ++ " from " ++ show f)
-    log = return ()
+    log' = return ()
 
 process :: (Schedule s, RawFile f) => MVar DevOp -> f -> s -> IO ()
 process c f s = {- (putStrLn ("Process on " ++ show s) >>) $ -} maybe
@@ -250,10 +235,13 @@ newtype ChildException = ChildException SomeException deriving (Typeable, Show)
 instance Exception ChildException
 
--- Do not make concurrent calls on the same file, place concurrency in the passed function 'user'
+-- | Opens the specified file as a LocalStoreFile, runs the provided function and closes the file.
+-- Do not make concurrent calls on the same file, place concurrency in the passed function.
 withFileStoreFile :: FilePath -> (LocalStoreFile -> IO a) -> ErrorT String IO a
 withFileStoreFile path user = lift $ withBinaryFile path ReadWriteMode $ \h -> hSetBuffering h NoBuffering >> withRawFile h user
-  
+
+-- | Opens the specified raw device as a LocalStoreFile, runs the provided function and closes the device.
+-- Do not make concurrent calls on the same device, place concurrency in the passed function.
 withRawDeviceStoreFile :: FilePath -> (LocalStoreFile -> IO a) -> ErrorT String IO a
 withRawDeviceStoreFile path user =
   ErrorT $ bracket (openFd path ReadWrite Nothing $ defaultFileFlags {exclusive = True, append = True}) closeFd $ 
@@ -261,7 +249,7 @@          do fs <- lift $ getFdStatus fd
             bool (throwError "Not a raw device") (lift $ withRawFile (RawDevice fd fs 9) user) $ isCharacterDevice fs
 
--- Could be generalized to allow mixing rawDevices and files. We will need to do that eventually to support remote replicas
+-- | Like nesting multiple calls to 'withRawDeviceStoreFile'.
 withRawDeviceStoreFiles :: [FilePath] -> ([LocalStoreFile] -> IO a) -> ErrorT String IO a
 withRawDeviceStoreFiles ps user = foldr (\p u fs ->  (>>= ErrorT . pure) $ withRawDeviceStoreFile p $ \f -> runErrorT $ u $ fs ◊ [f]) (lift . user) ps []
 
@@ -277,12 +265,12 @@ -- TODO: consider adding support for a 'STPrimArray RealWorld Pinned Block', and a matching address type, that would enfoce the above requirements
 -- However we would have to cast/view it as an array of Word8 later on.
 -- | Array's size and start must be aligned on the block size, and the ByteAddr too.
-fdReadArray :: Fd -> ByteAddr -> ArrayRange (STPrimArray RealWorld Pinned Word8) -> ErrorT () IO ()
-fdReadArray fd start a = ErrorT $ fmap (boolEither () () . (==) (toByteCount $ arrayLen a)) $ 
+fdReadArray :: Fd -> ByteAddr -> ArrayRange (STPrimArray RealWorld Pinned Word8) -> ErrorT String IO ()
+fdReadArray fd start a = ErrorT $ fmap (boolEither "" () . (==) (toByteCount $ arrayLen a)) $ 
                          fdSeekLen fd start >> withArrayPtr (\ptr len -> fdReadBuf fd ptr $ toByteCount len) a
 
-fdWriteArray :: Fd -> ByteAddr -> ArrayRange (STPrimArray RealWorld Pinned Word8) -> ErrorT () IO ()
-fdWriteArray fd start a = ErrorT $ fmap (boolEither () () . (==) (toByteCount $ arrayLen a)) $ 
+fdWriteArray :: Fd -> ByteAddr -> ArrayRange (STPrimArray RealWorld Pinned Word8) -> ErrorT String IO ()
+fdWriteArray fd start a = ErrorT $ fmap (boolEither "" () . (==) (toByteCount $ arrayLen a)) $ 
                           fdSeekLen fd start >> withArrayPtr (\ptr len -> fdWriteBuf fd ptr $ toByteCount len) a
 
 -- A bit of info on raw devices that i did not find easily elsewhere: http://www.win.tue.nl/~aeb/linux/lk/lk-11.html#ss11.4
@@ -290,10 +278,10 @@ data RawDevice = RawDevice Fd FileStatus Int
 rawDeviceBlockBytes :: RawDevice -> Len Word8 Word
 rawDeviceBlockBytes (RawDevice _ _ lg) = unsafeLen $ 1 `shiftL` lg
-instance Show RawDevice where show (RawDevice fd fs _) = show $ specialDeviceID fs
+instance Show RawDevice where show (RawDevice _ fs _) = show $ specialDeviceID fs
 -- TODO merge consecutive writes to improve performance (avoids many needless reads to preserve data that will be overwritten)
 instance RawFile RawDevice where                              
-  fileWriteRaw r@(RawDevice fd _ blockBytes) start bufs =
+  fileWriteRaw r@(RawDevice fd _ _) start bufs =
     let len = up $ sum $ arrayLen <$> bufs in
     withBlockArray r start len $ ((. fullArrayRange) .) $ \tStart t -> 
     do
@@ -303,7 +291,7 @@       when (tStart < start) $ fdReadArray fd tStart $ headArrayRange bb t
       when (start + len < tEnd) $ fdReadArray fd (tEnd - up bb) $ skipArrayRange (tLen - bb)  t
       let dest = skipArrayRange (fromJust $ unapply super $ start - tStart) t
-      lift $ stToIO $ foldlM (\d b -> skipArrayRange (arrayLen b) d <$ mapMArrayCopyImm return b d) dest bufs
+      _ <- lift $ stToIO $ foldlM (\d b -> skipArrayRange (arrayLen b) d <$ mapMArrayCopyImm return b d) dest bufs
       fdWriteArray fd tStart t
   fileReadRaw r@(RawDevice fd _ _) start buf =
     withBlockArray r start (up $ arrayLen buf) $ ((. fullArrayRange) .) $ \tStart t -> 
@@ -316,16 +304,15 @@   
 -- Takes start and length, and passes rounded start and an aligned buffer
 withBlockArray :: MonadIO m => RawDevice -> ByteAddr -> ByteAddr -> (ByteAddr -> STPrimArray RealWorld Pinned Word8 -> m a) -> m a
-withBlockArray r@(RawDevice fd _ lgBlockBytes) seek len f = 
+withBlockArray r@(RawDevice _ _ lgBlockBytes) seek len f = 
   let blockBytes = rawDeviceBlockBytes r
       seek' = getLen seek
       len' = getLen len
       start = (seek' `shiftR` lgBlockBytes) `shiftL` lgBlockBytes
       end = ((seek' + len' + up (getLen blockBytes) - 1) `shiftR` lgBlockBytes) `shiftL` lgBlockBytes
   in liftIO (stToIO $ newAlignedPinnedWord8Array blockBytes $ unsafeLen $ fromJust $ unapply super $ end - start) >>= 
-     \r -> f (unsafeLen start)
-           -- $ trace ("withBlockArray blockBytes=" ++ show blockBytes ++ " start=" ++ show (unsafeLen start) ++ " size=" ++ (show $ arrayLen r))
-           r
+     f (unsafeLen start)
+           -- . trace ("withBlockArray blockBytes=" ++ show blockBytes ++ " start=" ++ show (unsafeLen start) ++ " size=" ++ (show $ arrayLen r))
   
 withRawFile :: (RawFile f, Show f) => f -> (LocalStoreFile -> IO a) -> IO a
 withRawFile f user = do

@@ -41,7 +41,6 @@   lenPersister,   summationPersister,   ratioPersister,  -  wordPersister,   maybePersister,   shortcutPersister,   (>.),@@ -57,8 +56,6 @@   Ref0(..),   CDRef,   Cache,-  module Database.Perdure.StoreFile,-  module Database.Perdure.LocalStoreFile,   module Cgm.Data.Structured ) where @@ -66,16 +63,13 @@ import Cgm.Prelude import Data.Word import Data.Int-import System.IO.Unsafe import Cgm.Data.WordN import Cgm.Data.Word import Cgm.Data.Len import Cgm.Data.Structured import Cgm.Data.Functor.Sum-import Database.Perdure.LocalStoreFile --import Database.Perdure.SoftRef import Data.Ratio-import Data.Lens import qualified Data.Map as Map import qualified Data.Set as Set import Data.Time.Calendar@@ -85,19 +79,15 @@ import Database.Perdure.WValidator import Database.Perdure.StoreFile import Database.Perdure.ReplicatedFile-import Database.Perdure.Allocator import Cgm.System.Endian-import Data.Ord import Data.Char import Data.Binary.IEEE754 import Cgm.Data.List-import Data.Ratio import Data.Bits import Database.Perdure.CRef import Data.Cache.LRU import Data.Dynamic import Control.Concurrent.MVar-import Cgm.Data.Typeable  data WordNArrayRef v (r :: * -> *) = WordNArrayRef !v !(r (ValidatedElem v)) !Endianness @@ -164,8 +154,6 @@  class Persistent1_ (r :: * -> *) where persister1_ :: Persister (r a)                                                        -class Persistent2_ (r :: * -> * -> *) where persister2_ :: Persistent f => Persister (r f a)- class Persistent1 r where persister1 :: (Typeable a, Persistent a) => Persister (r a) instance Persistent1 Ref0 where persister1 = structureMap persister instance Persistent1 DRef where persister1 = DRefPersister'@@ -199,9 +187,11 @@ instance (Persistent a1, Persistent a2, Persistent a3, Persistent a4, Persistent a5, Persistent a6) => Persistent (a1,a2,a3,a4,a5,a6) where    persister = structureMap persister instance Persistent Ordering where persister = structureMap persister+{-                                    instance Persistent Word where    {-# INLINE persister #-}   persister = wordPersister+-} instance Persistent Word8 where    {-# INLINE persister #-}   persister = unsafeBitsPersister@@ -214,7 +204,9 @@ instance Persistent Word64 where    {-# INLINE persister #-}   persister = onWordConv (persister `iacomap` splitWord64LE) (wordPersister `iacomap` inv wordConv)+{-                                    instance Persistent Int where persister = persister `iacomap` unsigned+-} instance Persistent Int8 where persister = persister `iacomap` unsigned instance Persistent Int16 where persister = persister `iacomap` unsigned instance Persistent Int32 where persister = persister `iacomap` unsigned@@ -264,26 +256,30 @@   persister = structureMap $ persister |. persister  {-# INLINE listPersister #-}  +-- | Persister for lists built from a specified element persister. listPersister :: List a => Persister (Listed a) -> Persister a listPersister elemPersister = (maybePersister $ elemPersister &. listPersister elemPersister) `iacomap` listStructure --- Takes persisters for 2 types, and an injection from the smaller type 'a' to the larger type 'b', and gives a persister for the larger type which uses--- the smaller type representation when possible, plus one bit to identify which representation is used.+-- | Takes persisters for 2 types, and an injection from the smaller type 'a' to the larger type 'b', and gives a+-- persister for the larger type which uses the smaller type representation when possible, plus one bit to identify+-- which representation is used. shortcutPersister :: InjectionM i => i a b -> Persister b -> Persister a -> Persister b shortcutPersister i b a = (b |. a) `iacomap` eitherI where   eitherI = uncheckedInjection (\x -> ($ x) $ maybe (Left x) Right . unapply i) (either id $ apply i) --- Specialization of shortcutPersister with the 'super' injection.+-- | Specialization of shortcutPersister with the 'super' injection. infixl 9 >. (>.) :: Super a b => Persister b -> Persister a -> Persister b (>.) = shortcutPersister super +-- | Persister for 'Maybe a' built from a specified 'a' persister. Uses a single bit to represent 'Nothing'. maybePersister :: Persister a -> Persister (Maybe a) maybePersister elemPersister = structureMap $ persister |. elemPersister -bitPersister :: Persister Word -- Do not export to user-bitPersister = PartialWordPersister 1-wordPersister :: Persister Word+--bitPersister :: Persister Word -- Do not export to user+--bitPersister = PartialWordPersister 1++wordPersister :: Persister Word -- Do not export to user, Word is platform dependent wordPersister = PartialWordPersister wordBits  -- prefer wordPersister when writing a full word

@@ -17,23 +17,17 @@   prnf
   ) where
 
-import Control.Applicative
-import System.IO.Unsafe
-import Cgm.Data.Word
 import Cgm.Data.WordN
-import Cgm.Control.InFunctor
-import Cgm.Control.Combinators
 import Database.Perdure.Persistent
 --import Database.Perdure.SoftRef
 --import Database.Perdure.WriteRef
-import Database.Perdure.CRef
 
 prnf :: Persister a -> a -> ()
 prnf p = case p of
-  PartialWordPersister n -> (`seq` ())
+  PartialWordPersister _ -> (`seq` ())
   PairPersister pa pb -> \(a, b) -> prnf pa a `seq` prnf pb b
   EitherPersister pa pb -> either (prnf pa) (prnf pb)
   ViewPersister i pb -> prnf pb . apply i
-  SummationPersister pi _ s -> s (\i pb _ b -> prnf pi i `seq` prnf pb b)
+  SummationPersister pi' _ s -> s (\i pb _ b -> prnf pi' i `seq` prnf pb b)
   DRefPersister' -> (`seq` ())  -- Do not load, the persisted reference is already fully evaluated
   CRefPersister' _ pra -> onCRef (prnf pra) (prnf persister)

@@ -15,13 +15,10 @@ module Database.Perdure.Ref (
   Ref(..),
   ref,
-  refLens,
-  module Database.Perdure.Deref,
+  refLens
   ) where
 
 import System.IO.Unsafe
-import Cgm.Data.Functor.Sum
-import Cgm.Control.Combinators
 import Database.Perdure.Deref
 import Data.Lens
 import Database.Perdure.Persistent

@@ -21,8 +21,8 @@ import Database.Perdure.StoreFile
 import Database.Perdure.LocalStoreFile
 import Cgm.Control.Concurrent.NotificationCount
-import Cgm.Data.Word
 
+-- | A list of 'LocalStoreFile' to be used as replicates. We write to all replicates and read from the first one that reports no error.
 newtype ReplicatedFile = ReplicatedFile [LocalStoreFile]
 
 instance StoreFile ReplicatedFile where

@@ -25,7 +25,6 @@   ) where
 
 import Database.Perdure.Persistent
-import Database.Perdure.Ref
 import Cgm.Data.Tagged
 import Data.Lens
 import Data.Typeable
@@ -61,7 +60,7 @@   serRev :: (forall b. Integer -> Persister b -> (b -> a) -> b -> z) -> a -> z
 instance PersistentRev NoRev where  
   deserRev _ _ = error "bad index when deserializing Rev"
-  serRev f = onNoRev
+  serRev _ = onNoRev
 instance (Persistent b, PersistentRev r) => PersistentRev (b :> r) where
   deserRev f i = if i == (at :: At (b :> r)) lastRev then f persister Current else deserRev ((. (Previous .)) . f) i
   serRev f = onRev (f ((at :: At (b :> r)) lastRev) persister Current) (serRev $ ((. (Previous .)) .) . f)

@@ -20,21 +20,11 @@   ) where
 
 import Data.Word
-import qualified Data.ByteString as ByteString
-import qualified Data.ByteString.Lazy as Lazy
-import qualified Data.Binary as Binary
-import Crypto.Hash.Tiger
-import Foreign.Marshal.Alloc
-import Foreign.Marshal.Array
-import System.IO.Unsafe
 import Database.Perdure.Digest
 import Cgm.Data.Maybe
 import Cgm.Data.Len
 import Database.Perdure.Validator
 import Database.Perdure.CSerializer
-import Database.Perdure.CDeserializer
-import Cgm.Control.Concurrent.Await
-import Cgm.Control.Combinators
 import Database.Perdure.AllocCopy
 
 -- ValidationDigest assiciates a particular digest method to each word type to digest (Word32 and Word64)
@@ -56,13 +46,13 @@   digest' = digest
 
 data RootValidator w = RootValidator deriving (Eq, Show)
-type Header w = (Len w Word, ValidationDigest w)
+type Header w = (Len w Word64, ValidationDigest w)
 instance (ValidationDigestWord w, Show (ValidationDigest w)) => Validator (RootValidator w) where
   type ValidatedElem (RootValidator w) = w
-  mkValidationInput b = (RootValidator, [serializeToArray persister ((arrayLen b, digest' b) :: Header w), b])
+  mkValidationInput b = (RootValidator, [serializeToArray persister ((fmap fromIntegral $ arrayLen b, digest' b) :: Header w), b])
   validate RootValidator b = 
     let DeserOut ((len, h) :: Header w) u = deserializeFromArray (unsafeSeqDeserializer persister) b
-        payload = headArrayRange len $ skipArrayRange (coarsenLen u) b
+        payload = headArrayRange (fmap fromIntegral len) $ skipArrayRange (coarsenLen u) b
     in payload `justIf` (digest' payload == h)
 
 instance Persistent (RootValidator w) where persister = structureMap persister

@@ -19,7 +19,6 @@        
 import Database.Perdure.StoreFile
 import Database.Perdure.LocalStoreFile
-import Cgm.Data.Word
 
 
 newtype SingleStoreFile a = SingleStoreFile a deriving SyncableStoreFile

@@ -23,8 +23,6 @@ import Database.Perdure.Persistent
 import Cgm.Data.Functor.Sum
 import Database.Perdure.DRef
-import Database.Perdure.Allocator
-import Database.Perdure.StoreFile
 import Cgm.Data.Nat
 import Data.Dynamic
 

@@ -18,20 +18,11 @@   ) where
 
 import Prelude ()
-import Cgm.Prelude
 import Cgm.Data.Structured
-import Control.Monad.State
 import Database.Perdure.Persistent
-import Database.Perdure.Space
 import Database.Perdure.SpaceTree
 import Database.Perdure.Count
 import Database.Perdure.Data.MapMultiset
-import Database.Perdure.CSerializer(Address)
-import Cgm.Data.Monoid
-import Database.Perdure.ReplicatedFile
-import Debug.Trace
-import Cgm.Data.Super
-import Database.Perdure.Package
 import Cgm.Data.Typeable
 
 data SpaceBook = SpaceBook {

@@ -25,7 +25,6 @@ import Database.Perdure.Space
 import Database.Perdure.Data.Map
 import Database.Perdure.Persistent
-import Debug.Trace
 import Data.Typeable
 
 newtype SpaceTree = SpaceTree (Map Word64 Bool) deriving Typeable
@@ -37,7 +36,7 @@     let
       start = 0 -- TODO pass that in as a parameter
       mkSpans [] = []
-      mkSpans (k : []) = error "bad SpaceTree"
+      mkSpans (_ : []) = error "bad SpaceTree"
       mkSpans (k0 : k1 : ks) = unsafeSortedPair k0 k1 : mkSpans ks
     in mkSpans $
        (\(b, ks) -> bool (start : ks) ks b) $ -- When bool is false, prepend 'start' (consider that the span possibly overlapping 'start' actually starts at 'start')

@@ -43,13 +43,6 @@ import qualified Cgm.Control.Monad.State as M
 import Control.Monad.State hiding (sequence)
 import Control.Monad.Reader hiding (sequence)
-import Control.Applicative
-import Foreign.Marshal.Alloc
-import Foreign.Marshal.Array
-import Data.Ord
-import Data.Functor.Constant
-import Data.Functor.Identity
-import Cgm.System.Mem.Alloc
 import Cgm.Data.Word
 import Cgm.Data.Len
 import Cgm.Data.List
@@ -58,22 +51,14 @@ import Database.Perdure.Decrementer
 import Database.Perdure.Incrementer
 import Database.Perdure.RootValidator
-import Database.Perdure.SizeRef
 import Database.Perdure.Space
 import Database.Perdure.SpaceTree
-import Database.Perdure.Count
 import Database.Perdure.Data.MapMultiset
 import Cgm.System.Endian
-import Cgm.Control.Combinators
-import Cgm.Control.Concurrent.MVar
-import Cgm.Control.Concurrent.Await
-import Cgm.Data.Monoid
-import Control.Arrow
 import Cgm.Data.Multiset as MS
-import Debug.Trace
 import Database.Perdure.Ref
+import Database.Perdure.Deref
 import Database.Perdure.SpaceBook
-import Database.Perdure.Package
 import Cgm.Data.Typeable
 import qualified Data.Cache.LRU as LRU
 import Cgm.Data.Maybe
@@ -83,9 +68,6 @@ import Database.Perdure.Allocator
 import Database.Perdure.Rev
 
-moduleName :: String
-moduleName = "Database.Perdure.State"
-
 data CachedFile = CachedFile ReplicatedFile (MVar Cache)
 
 -- | The RootLocation specifies where roots are written, and provides a cache.
@@ -227,16 +209,16 @@   start <- stToIO mkABitSeq
   (result, end) <- runStateT writer start
   {-# SCC "barrier" #-} storeFileFullBarrier f -- If the following write completes, we want to assume that all preceeding writes completed
-  arr <- allocCopyBits start end
-  onWordConv (writeRoot' (apply wordConv1 arr :: PrimArray Pinned Word32)) (writeRoot' (apply wordConv1 arr :: PrimArray Pinned Word64))
+  ar <- allocCopyBits start end
+  onWordConv (writeRoot' (apply wordConv1 ar :: PrimArray Pinned Word32)) (writeRoot' (apply wordConv1 ar :: PrimArray Pinned Word64))
   -- We would like a full barrier here, to make sure reads do not move before matching writes, there is one just before,
   -- and the precedeeing write is protected by the following sync (and will never be read)
   {-# SCC "sync" #-} storeFileSync f done -- We need to know when the transaction has become durable
   -- No barrier here, however that does not help much since we have a barrier before the preceeding write
   return result where
     writeRoot' :: forall w. (LgMultiple Word64 w, ValidationDigestWord w) => PrimArray Pinned w -> IO ()
-    writeRoot' arr = {-# SCC "writeRoot" #-} do
-      let (RootValidator, bufs) = mkValidationInput arr
+    writeRoot' a = {-# SCC "writeRoot" #-} do
+      let (RootValidator, bufs) = mkValidationInput a
       when (sum (arrayLen <$> bufs) > apply super (refineLen rootAllocSize :: Len w Word32)) $ error "Root too large."
       () <$ storeFileWrite f (getRootAddress $ genericIndex roots $ mod i $ fromIntegral $ length roots) platformWordEndianness bufs
 
@@ -251,7 +233,7 @@   lv <- newMVar ls
   cSer persister (c, StateAllocator f lv, Just cd) (\a'' s' -> readMVar lv >>= \ls' -> readMVar cd >>= \u -> return ((a'', u, ls'), s')) a' s
 
-readRoot :: forall a d f. (Persistent a, Typeable a) => CachedFile -> RootAddress -> IO (Maybe (RootVersions a))
+readRoot :: forall a. (Persistent a, Typeable a) => CachedFile -> RootAddress -> IO (Maybe (RootVersions a))
 readRoot (CachedFile f c) rootAddr =
   fmap (deserializeFromFullArray $ apply cDeser persister $ DeserializerContext f c) <$> 
   foldM (\result next -> maybe next (return . Just) result) Nothing readRootDataWE where
@@ -268,10 +250,10 @@ instance Space a => Allocator (StateAllocator a) where
   allocatorStoreFile (StateAllocator f _) = f
   alloc (StateAllocator _ var) len = modifyMVar var $ \a -> do
-    let span = requireSpan a
-    let a' = removeSpan span a
-    --putStrLn $ "Alloc " ++ show size ++ "@" ++ show (onSortedPair const span) ++ "  => free: " ++ (show a') --findSpan 0 a'
-    return (a', onSortedPair (\start end -> unsafeLen start) span) where
+    let spn = requireSpan a
+    let a' = removeSpan spn a
+    --putStrLn $ "Alloc " ++ show size ++ "@" ++ show (onSortedPair const spn) ++ "  => free: " ++ (show a') --findSpan 0 a'
+    return (a', onSortedPair (\start _ -> unsafeLen start) spn) where
       requireSpan = onSortedPair (\start _ -> unsafeSortedPair start (start + getLen len)) . 
                     fromMaybe (error "Out of storage space") . listHead . 
                     findSpan (getLen len)

@@ -29,7 +29,6 @@ import Prelude () import Cgm.Prelude import Data.Word-import Data.ByteString import Foreign.Ptr import Cgm.Data.Len import Cgm.Data.Super

@@ -21,7 +21,6 @@ 
 import Prelude ()
 import Cgm.Prelude
-import Cgm.Data.Word
 import Cgm.Data.Array
 
 -- Although most hash functions are defined on strings of byte as a convention, they often start by converting the plaintext to strings

@@ -22,11 +22,8 @@ import Prelude ()
 import Cgm.Prelude
 import Data.Word
-import Cgm.Data.Word
-import Cgm.Data.Len
 import Database.Perdure.Digest
 import Database.Perdure.Validator
-import Cgm.System.Endian
 import Cgm.Data.Maybe
 import Cgm.Data.Structured
 

@@ -22,7 +22,6 @@ import Cgm.Data.Word
 import Database.Perdure.ArrayRef
 import Database.Perdure.CDeserializer
-import Database.Perdure.Persistent
 
 -- | When we write Words and read them back on a platform with a different Word size, the array length changes,
 -- and each Word64 is replaced by two consecutive Words32 (least-significant first), (the reverse substitution is applied

@@ -39,19 +39,15 @@   module Cgm.Data.Array
   ) where
 
-import Debug.Trace
 import Foreign.Ptr
-import Data.Bits
 import Control.Applicative
 import Control.Monad
-import Control.Monad.Identity
 import Foreign.Storable
-import Foreign.Marshal.Alloc
 import Foreign.Marshal.Array
 import Cgm.Data.Array
 import Cgm.Data.Word
 import Cgm.Data.Len
-import Cgm.Data.WordN
+import Cgm.Data.WordN hiding (d0)
 import Cgm.System.Mem.Alloc
 import Cgm.Control.Combinators
 
@@ -92,13 +88,17 @@   copyBits = copyWords
 instance WordSrc (Ptr Word) where
   addedWords = (apply unsigned <$>) ./ minusPtrLen
-  copyWords end start d = if end == start then return d else ioToST (peek start) >>= \w -> addWord w d >>= copyWords end (start `advancePtrLen` 1)
+  copyWords end start d =
+    if end == start
+    then return d
+    else ioToST (peek start) >>= \w -> addWord w d >>= copyWords end (start `advancePtrLen` (1 :: Len Word Integer))
   copyWordsPartial end start dropLow = 
     let len = addedWords end start 
     in if len == 0
        then undefined 
        else (\d -> ioToST (peek start) >>= \w -> 
-              addBits (refineLen word - dropLow) (w `partialShiftRL` getLen dropLow) d) >=> copyWords end (start `advancePtrLen` 1)
+              addBits (refineLen word - dropLow) (w `partialShiftRL` getLen dropLow) d) >=>
+            copyWords end (start `advancePtrLen` (1 :: Len Word Integer))
 
 ------------------------- WordSeq -------------------------
 
@@ -134,9 +134,11 @@   copyWordsPartial (WordSeq (s1, r1) c1) start@(WordSeq (s0, _) c0) =
     if s1 == s0
     then copyWordsPartial c1 c0
-    else \drop -> copyWordsPartial (WordSeq (s1 - chunkSize, tail r1) $ chunkEnd (head r1)) start drop >=> copyWords c1 (chunkStart c1)
+    else \drp -> copyWordsPartial (WordSeq (s1 - chunkSize, tail r1) $ chunkEnd (head r1)) start drp >=> copyWords c1 (chunkStart c1)
  
-chunkStart (CWordSeq a i) = CWordSeq a 0
+chunkStart :: CWordSeq s f -> CWordSeq s f
+chunkStart (CWordSeq a _) = CWordSeq a 0
+chunkEnd :: STPrimArray s f Word -> CWordSeq s f
 chunkEnd a = CWordSeq a chunkSize
   
 ------------------------- CWordSeq -------------------------