module Database.Perdure.Decrementer (
decr
) where
import Prelude ()
import Cgm.Prelude
import Cgm.Data.Structured
import Database.Perdure.Persistent
import Database.Perdure.Space
import Cgm.Data.Multiset as MS
import Database.Perdure.SpaceBook
import Database.Perdure.Deref
import qualified Data.Cache.LRU as LRU
import Database.Perdure.ArrayRef
import Control.Concurrent.MVar
import System.IO.Unsafe
decr :: Persister a -> a -> SpaceBook -> SpaceBook
decr !p !a !s = case p of
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
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
CRefPersister' _ pra -> onCRef (decr pra) (decr persister) a s
unsafeClearCache :: MVar Cache -> Len Word64 Word64 -> ()
unsafeClearCache c addr = unsafePerformIO $ modifyMVar_ c $ return . fst . LRU.delete addr
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' ( addSpan (refSpan r) s')) $ onDealloc sb)
(flip SpaceBook s) $ MS.delete (refStart r) c