diff --git a/lsm-tree/src-core/Database/LSMTree/Internal/Index/Compact.hs b/lsm-tree/src-core/Database/LSMTree/Internal/Index/Compact.hs index c4d68b7d4..0bdd70bb9 100644 --- a/lsm-tree/src-core/Database/LSMTree/Internal/Index/Compact.hs +++ b/lsm-tree/src-core/Database/LSMTree/Internal/Index/Compact.hs @@ -1,4 +1,7 @@ -{-# OPTIONS_HADDOCK not-home #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE NoFieldSelectors #-} +{-# LANGUAGE OverloadedRecordDot #-} +{-# OPTIONS_HADDOCK not-home #-} -- | A compact fence-pointer index for uniformly distributed keys. -- @@ -394,33 +397,33 @@ search :: SerialisedKey -> IndexCompact -> PageSpan -- search key. The code below is annotated with [x,y] or [x, y) comments that -- describe the known page number interval at that point in the search -- algorithm. -search k IndexCompact{..} = +search k idx = let !primbits = keyTopBits64 k in -- [0, n), where n is the length of the P array - case unsafeSearchLE primbits icPrimary of + case unsafeSearchLE primbits idx.icPrimary of Nothing -> -- TODO: if the P array is indeed empty, then this violates the -- guarantee that we return a valid page span! We should specify that a -- compact index should be non-empty. - if VU.length icLargerThanPage == 0 then singlePage (PageNo 0) else + if VU.length idx.icLargerThanPage == 0 then singlePage (PageNo 0) else -- [0, n), our page span definitely starts at 0, but we still have to -- consult the LTP array to check whether the value on page 0 overflows -- into subsequent pages. - let !i = bitLongestPrefixFromTo (BoundExclusive 0) NoBound (Bit True) icLargerThanPage + let !i = bitLongestPrefixFromTo (BoundExclusive 0) NoBound (Bit True) idx.icLargerThanPage -- [0, i] in multiPage (PageNo 0) (PageNo i) Just !i -> -- [0, i] - if unBit $ icClashes VU.! i then + if unBit $ idx.icClashes VU.! i then -- [0, i], now in clash recovery mode. let -- i is the *last* index in a range of contiguous pages that all -- clash. Since i is the end of the range, we search backwards -- through the C array to find the start of this range. !i1 = PageNo $ fromMaybe 0 $ - bitIndexFromToRev (BoundInclusive 0) (BoundInclusive i) (Bit False) icClashes + bitIndexFromToRev (BoundInclusive 0) (BoundInclusive i) (Bit False) idx.icClashes -- The TB map is consulted to find the closest key smaller than k. !i2 = maybe (PageNo 0) snd $ - Map.lookupLE (makeUnslicedKey k) icTieBreaker + Map.lookupLE (makeUnslicedKey k) idx.icTieBreaker -- If i2 < i1, then it means the clashing pages were all just part -- of the same larger-than-page value. Entries are only included -- in the TB map if the clash was a *proper* clash. @@ -430,7 +433,7 @@ search k IndexCompact{..} = PageNo !i3 = max i1 i2 -- [max i1 i2, i], this is equivalent to taking the intersection -- of [i1, i] and [i2, i] - !i4 = bitLongestPrefixFromTo (BoundExclusive i3) (BoundInclusive i) (Bit True) icLargerThanPage + !i4 = bitLongestPrefixFromTo (BoundExclusive i3) (BoundInclusive i) (Bit True) idx.icLargerThanPage in multiPage (PageNo i3) (PageNo i4) -- [i3, i4], we consulted the LTP array to check whether the value -- on page i3 overflows into subsequent pages @@ -441,17 +444,17 @@ search k IndexCompact{..} = countClashes :: IndexCompact -> Int -countClashes = Map.size . icTieBreaker +countClashes idx = Map.size idx.icTieBreaker hasClashes :: IndexCompact -> Bool -hasClashes = not . Map.null . icTieBreaker +hasClashes idx = not (Map.null idx.icTieBreaker) {-| For a specification of this operation, see the documentation of [its type-agnostic version]('Database.LSMTree.Internal.Index.sizeInPages'). -} sizeInPages :: IndexCompact -> NumPages -sizeInPages = NumPages . toEnum . VU.length . icPrimary +sizeInPages idx = NumPages . toEnum . VU.length $ idx.icPrimary {------------------------------------------------------------------------------- Non-incremental serialisation @@ -461,7 +464,7 @@ sizeInPages = NumPages . toEnum . VU.length . icPrimary toLBS :: NumEntries -> IndexCompact -> LBS.ByteString toLBS numEntries index = headerLBS - <> LBS.fromStrict (Chunk.toByteString (word64VectorToChunk (icPrimary index))) + <> LBS.fromStrict (Chunk.toByteString (word64VectorToChunk (index.icPrimary))) <> finalLBS numEntries index {------------------------------------------------------------------------------- @@ -489,22 +492,23 @@ headerLBS = type-agnostic version]('Database.LSMTree.Internal.Index.finalLBS'). -} finalLBS :: NumEntries -> IndexCompact -> LBS.ByteString -finalLBS (NumEntries numEntries) IndexCompact {..} = +finalLBS (NumEntries numEntries) idx = -- use a builder, since it is all relatively small BB.toLazyByteString $ - putBitVec icClashes - <> putBitVec icLargerThanPage - <> putTieBreaker icTieBreaker + putBitVec idx.icClashes + <> putBitVec idx.icLargerThanPage + <> putTieBreaker idx.icTieBreaker <> BB.word64Host (fromIntegral numPages) <> BB.word64Host (fromIntegral numEntries) where - numPages = VU.length icPrimary + numPages = VU.length idx.icPrimary -- | Constructs a chunk containing the contents of a vector of 64-bit words. word64VectorToChunk :: VU.Vector Word64 -> Chunk word64VectorToChunk (VU.V_Word64 (VP.Vector off len ba)) = Chunk (mkPrimVector (mul8 off) (mul8 len) ba) + -- | Padded to 64 bit. -- -- Assumes that the bitvector has a byte-aligned offset. @@ -595,7 +599,12 @@ fromSBS (SBS ba') = do when (bytesUsed < sizeofByteArray ba) $ Left "Byte array is too large for components" - pure (NumEntries numEntries, IndexCompact {..}) + pure (NumEntries numEntries, IndexCompact { + icPrimary = icPrimary, + icClashes = icClashes, + icTieBreaker = icTieBreaker, + icLargerThanPage = icLargerThanPage + }) type Offset32 = Int type Offset64 = Int diff --git a/lsm-tree/src-core/Database/LSMTree/Internal/Index/CompactAcc.hs b/lsm-tree/src-core/Database/LSMTree/Internal/Index/CompactAcc.hs index 2805bccff..a3332cb4d 100644 --- a/lsm-tree/src-core/Database/LSMTree/Internal/Index/CompactAcc.hs +++ b/lsm-tree/src-core/Database/LSMTree/Internal/Index/CompactAcc.hs @@ -1,5 +1,8 @@ -{-# LANGUAGE CPP #-} -{-# OPTIONS_HADDOCK not-home #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE NoFieldSelectors #-} +{-# LANGUAGE OverloadedRecordDot #-} +{-# OPTIONS_HADDOCK not-home #-} -- | -- Incremental construction of a compact index yields chunks of the primary array @@ -129,15 +132,15 @@ newWithDefaults = new 1024 type-agnostic version]('Database.LSMTree.Internal.Index.appendSingle'). -} appendSingle :: forall s. (SerialisedKey, SerialisedKey) -> IndexCompactAcc s -> ST s (Maybe Chunk) -appendSingle (minKey, maxKey) ica@IndexCompactAcc{..} = do +appendSingle (minKey, maxKey) ica = do #ifdef NO_IGNORE_ASSERTS - lastMinKey <- readSTRef icaLastMinKey + lastMinKey <- readSTRef ica.icaLastMinKey assert (minKey <= maxKey && smaybe True (<= minKey) lastMinKey) $ pure () -- sorted #endif - pageNo <- readSTRef icaCurrentPageNumber - let ix = pageNo `mod` icaMaxChunkSize + pageNo <- readSTRef ica.icaCurrentPageNumber + let ix = pageNo `mod` ica.icaMaxChunkSize goAppend pageNo ix - writeSTRef icaCurrentPageNumber $! pageNo + 1 + writeSTRef ica.icaCurrentPageNumber $! pageNo + 1 yield ica where minPrimbits, maxPrimbits :: Word64 @@ -156,31 +159,31 @@ appendSingle (minKey, maxKey) ica@IndexCompactAcc{..} = do -- | Set value in primary vector writePrimary :: ST s () writePrimary = - readSTRef icaPrimary >>= \cs -> VUM.write (NE.head cs) ix minPrimbits + readSTRef ica.icaPrimary >>= \cs -> VUM.write (NE.head cs) ix minPrimbits -- | Set value in clash vector, tie-breaker map and larger-than-page -- vector writeClashesAndLTP :: ST s () writeClashesAndLTP = do - lastMaxPrimbits <- readSTRef icaLastMaxPrimbits + lastMaxPrimbits <- readSTRef ica.icaLastMaxPrimbits let clash = lastMaxPrimbits == SJust minPrimbits - writeSTRef icaLastMaxPrimbits $! SJust maxPrimbits + writeSTRef ica.icaLastMaxPrimbits $! SJust maxPrimbits - lastMinKey <- readSTRef icaLastMinKey + lastMinKey <- readSTRef ica.icaLastMinKey let ltp = SJust minKey == lastMinKey - writeSTRef icaLastMinKey $! SJust minKey + writeSTRef ica.icaLastMinKey $! SJust minKey - readSTRef icaClashes >>= \cs -> VUM.write (NE.head cs) ix (Bit clash) - readSTRef icaLargerThanPage >>= \cs -> VUM.write (NE.head cs) ix (Bit ltp) + readSTRef ica.icaClashes >>= \cs -> VUM.write (NE.head cs) ix (Bit clash) + readSTRef ica.icaLargerThanPage >>= \cs -> VUM.write (NE.head cs) ix (Bit ltp) when (clash && not ltp) $ - modifySTRef' icaTieBreaker (Map.insert (makeUnslicedKey minKey) (PageNo pageNo)) + modifySTRef' ica.icaTieBreaker (Map.insert (makeUnslicedKey minKey) (PageNo pageNo)) {-| For a specification of this operation, see the documentation of [its type-agnostic version]('Database.LSMTree.Internal.Index.appendMulti'). -} appendMulti :: forall s. (SerialisedKey, Word32) -> IndexCompactAcc s -> ST s [Chunk] -appendMulti (k, n0) ica@IndexCompactAcc{..} = +appendMulti (k, n0) ica = maybe id (:) <$> appendSingle (k, k) ica <*> overflows (fromIntegral n0) where minPrimbits :: Word64 @@ -192,16 +195,16 @@ appendMulti (k, n0) ica@IndexCompactAcc{..} = overflows n | n <= 0 = pure [] | otherwise = do - pageNo <- readSTRef icaCurrentPageNumber - let ix = pageNo `mod` icaMaxChunkSize -- will be 0 in recursive calls - remInChunk = min n (icaMaxChunkSize - ix) - readSTRef icaPrimary >>= \cs -> + pageNo <- readSTRef ica.icaCurrentPageNumber + let ix = pageNo `mod` ica.icaMaxChunkSize -- will be 0 in recursive calls + remInChunk = min n (ica.icaMaxChunkSize - ix) + readSTRef ica.icaPrimary >>= \cs -> unsafeWriteRange (NE.head cs) (BoundInclusive ix) (BoundExclusive $ ix + remInChunk) minPrimbits - readSTRef icaClashes >>= \cs -> + readSTRef ica.icaClashes >>= \cs -> unsafeWriteRange (NE.head cs) (BoundInclusive ix) (BoundExclusive $ ix + remInChunk) (Bit True) - readSTRef icaLargerThanPage >>= \cs -> + readSTRef ica.icaLargerThanPage >>= \cs -> unsafeWriteRange (NE.head cs) (BoundInclusive ix) (BoundExclusive $ ix + remInChunk) (Bit True) - writeSTRef icaCurrentPageNumber $! pageNo + remInChunk + writeSTRef ica.icaCurrentPageNumber $! pageNo + remInChunk res <- yield ica maybe id (:) res <$> overflows (n - remInChunk) @@ -212,13 +215,13 @@ appendMulti (k, n0) ica@IndexCompactAcc{..} = -- -- INVARIANTS: see [construction invariants](#construction-invariants). yield :: IndexCompactAcc s -> ST s (Maybe Chunk) -yield IndexCompactAcc{..} = do - pageNo <- readSTRef icaCurrentPageNumber - if pageNo `mod` icaMaxChunkSize == 0 then do -- The current chunk is full - primaryChunk <- VU.unsafeFreeze . NE.head =<< readSTRef icaPrimary - modifySTRef' icaPrimary . NE.cons =<< newPinnedMVec64 icaMaxChunkSize - modifySTRef' icaClashes . NE.cons =<< VUM.new icaMaxChunkSize - modifySTRef' icaLargerThanPage . NE.cons =<< VUM.new icaMaxChunkSize +yield ica = do + pageNo <- readSTRef ica.icaCurrentPageNumber + if pageNo `mod` ica.icaMaxChunkSize == 0 then do -- The current chunk is full + primaryChunk <- VU.unsafeFreeze . NE.head =<< readSTRef ica.icaPrimary + modifySTRef' ica.icaPrimary . NE.cons =<< newPinnedMVec64 ica.icaMaxChunkSize + modifySTRef' ica.icaClashes . NE.cons =<< VUM.new ica.icaMaxChunkSize + modifySTRef' ica.icaLargerThanPage . NE.cons =<< VUM.new ica.icaMaxChunkSize pure $ Just (word64VectorToChunk primaryChunk) else -- the current chunk is not yet full pure Nothing @@ -228,16 +231,16 @@ yield IndexCompactAcc{..} = do type-agnostic version]('Database.LSMTree.Internal.Index.unsafeEnd'). -} unsafeEnd :: IndexCompactAcc s -> ST s (Maybe Chunk, IndexCompact) -unsafeEnd IndexCompactAcc{..} = do - pageNo <- readSTRef icaCurrentPageNumber - let ix = pageNo `mod` icaMaxChunkSize +unsafeEnd ica = do + pageNo <- readSTRef ica.icaCurrentPageNumber + let ix = pageNo `mod` ica.icaMaxChunkSize chunksPrimary <- - traverse VU.unsafeFreeze . sliceCurrent ix =<< readSTRef icaPrimary + traverse VU.unsafeFreeze . sliceCurrent ix =<< readSTRef ica.icaPrimary chunksClashes <- - traverse VU.unsafeFreeze . sliceCurrent ix =<< readSTRef icaClashes + traverse VU.unsafeFreeze . sliceCurrent ix =<< readSTRef ica.icaClashes chunksLargerThanPage <- - traverse VU.unsafeFreeze . sliceCurrent ix =<< readSTRef icaLargerThanPage + traverse VU.unsafeFreeze . sliceCurrent ix =<< readSTRef ica.icaLargerThanPage -- Only slice out a chunk if there are entries in the chunk let mchunk = if ix == 0 @@ -247,9 +250,14 @@ unsafeEnd IndexCompactAcc{..} = do let icPrimary = VU.concat . reverse $ chunksPrimary let icClashes = VU.concat . reverse $ chunksClashes let icLargerThanPage = VU.concat . reverse $ chunksLargerThanPage - icTieBreaker <- readSTRef icaTieBreaker + icTieBreaker <- readSTRef ica.icaTieBreaker - pure (mchunk, IndexCompact {..}) + pure (mchunk, IndexCompact { + icPrimary = icPrimary, + icClashes = icClashes, + icTieBreaker = icTieBreaker, + icLargerThanPage = icLargerThanPage + }) where -- The current (most recent) chunk of the bitvectors is only partially -- constructed, so we need to only use the part that is already filled. diff --git a/lsm-tree/test/Test/Database/LSMTree/Internal/Index/Compact.hs b/lsm-tree/test/Test/Database/LSMTree/Internal/Index/Compact.hs index 1507a3148..d2ea74150 100644 --- a/lsm-tree/test/Test/Database/LSMTree/Internal/Index/Compact.hs +++ b/lsm-tree/test/Test/Database/LSMTree/Internal/Index/Compact.hs @@ -1,6 +1,8 @@ -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE RecordWildCards #-} -{-# OPTIONS_GHC -Wno-orphans #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE NoFieldSelectors #-} +{-# LANGUAGE OverloadedRecordDot #-} +{-# OPTIONS_GHC -Wno-orphans #-} module Test.Database.LSMTree.Internal.Index.Compact (tests) where @@ -315,9 +317,9 @@ prop_total_deserialisation word32s = -- Just forcing the index is not enough. The underlying vectors might -- point to outside of the byte array, so we check they are valid. (numEntries, ic) `deepseq` - vec64IsValid (icPrimary ic) - && bitVecIsValid (icClashes ic) - && bitVecIsValid (icLargerThanPage ic) + vec64IsValid ic.icPrimary + && bitVecIsValid ic.icClashes + && bitVecIsValid ic.icLargerThanPage where vec64IsValid (VU.V_Word64 (VP.Vector off len ba)) = off >= 0 && len >= 0 && mul8 (off + len) <= sizeofByteArray ba @@ -385,7 +387,7 @@ labelIndex ic = multiPageValuesClash :: IndexCompact -> Bool multiPageValuesClash ic - | VU.length (icClashes ic) < 3 = False + | VU.length ic.icClashes < 3 = False | otherwise = VU.any p $ VU.zip4 v1 v2 v3 v4 where -- note: @i = j - 1@ and @k = j + 1@. This gives us a local view of a @@ -396,8 +398,8 @@ multiPageValuesClash ic unBit ltpi && not (unBit ltpj) && unBit ltpk -- and they clash && unBit cj - v1 = VU.tail (icClashes ic) - v2 = icLargerThanPage ic + v1 = VU.tail ic.icClashes + v2 = ic.icLargerThanPage v3 = VU.tail v2 v4 = VU.tail v3 @@ -408,7 +410,7 @@ countContiguousClashes ic = actualContigClashes where -- filtered is a list of maximal sub-vectors that have only only contiguous -- clashes - zipped = VU.zip (icClashes ic) (icLargerThanPage ic) + zipped = VU.zip ic.icClashes ic.icLargerThanPage grouped = VU.groupBy (\x y -> fst x == fst y) zipped filtered = filter (VU.all (\(c, _ltp) -> c == Bit True)) grouped -- clashes that are part of a multi-page value shouldn't be counted towards @@ -478,8 +480,8 @@ instance Arbitrary Chunks where -- shrink number of pages [ Chunks chunks' index { icPrimary = primary' - , icClashes = VU.slice 0 numPages' (icClashes index) - , icLargerThanPage = VU.slice 0 numPages' (icLargerThanPage index) + , icClashes = VU.slice 0 numPages' index.icClashes + , icLargerThanPage = VU.slice 0 numPages' index.icLargerThanPage } | chunks' <- shrink chunks , let primary' = mconcat chunks' @@ -489,5 +491,5 @@ instance Arbitrary Chunks where [ Chunks chunks index { icTieBreaker = tieBreaker' } - | tieBreaker' <- shrink (icTieBreaker index) + | tieBreaker' <- shrink index.icTieBreaker ]