Skip to content

Commit 7c90cd7

Browse files
jeltschjeltsch
authored
Merge pull request #467 from IntersectMBO/jeltsch/append-separation
Move general append utilities into general index module
2 parents 9cf968f + 3dbb4e3 commit 7c90cd7

File tree

8 files changed

+133
-66
lines changed

8 files changed

+133
-66
lines changed

‎bench/micro/Bench/Database/LSMTree/Internal/IndexCompact.hs‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -22,6 +22,7 @@ import qualified Data.Vector.Unboxed.Mutable as VUM
2222
import Data.Word
2323
import Database.LSMTree.Extras
2424
import Database.LSMTree.Extras.Generators
25+
import Database.LSMTree.Extras.Index
2526
import Database.LSMTree.Extras.Random
2627
import Database.LSMTree.Extras.UTxO
2728
import Database.LSMTree.Internal.IndexCompact

‎lsm-tree.cabal‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -301,6 +301,7 @@ library extras
301301
exposed-modules:
302302
Database.LSMTree.Extras
303303
Database.LSMTree.Extras.Generators
304+
Database.LSMTree.Extras.Index
304305
Database.LSMTree.Extras.NoThunks
305306
Database.LSMTree.Extras.Orphans
306307
Database.LSMTree.Extras.Random

‎src-extras/Database/LSMTree/Extras/Generators.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -48,10 +48,10 @@ import qualified Data.Vector.Primitive as VP
4848
import Data.Word
4949
import Database.LSMTree.Common (Range (..))
5050
import Database.LSMTree.Extras
51+
import Database.LSMTree.Extras.Index (Append (..))
5152
import Database.LSMTree.Extras.Orphans ()
5253
import Database.LSMTree.Internal.BlobRef (BlobSpan (..))
5354
import Database.LSMTree.Internal.Entry (Entry (..), NumEntries (..))
54-
import Database.LSMTree.Internal.IndexCompactAcc (Append (..))
5555
import qualified Database.LSMTree.Internal.Merge as Merge
5656
import Database.LSMTree.Internal.Page (PageNo (..))
5757
import Database.LSMTree.Internal.RawBytes as RB

‎src-extras/Database/LSMTree/Extras/Index.hs‎

Lines changed: 72 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,72 @@
1+
module Database.LSMTree.Extras.Index
2+
(
3+
Append (AppendSinglePage, AppendMultiPage),
4+
append,
5+
append'
6+
)
7+
where
8+
9+
import Control.DeepSeq (NFData (rnf))
10+
import Control.Monad.ST.Strict (ST)
11+
import Data.Foldable (toList)
12+
import Data.Word (Word32)
13+
import Database.LSMTree.Internal.Chunk (Chunk)
14+
import Database.LSMTree.Internal.IndexCompactAcc (IndexCompactAcc)
15+
import qualified Database.LSMTree.Internal.IndexCompactAcc as IndexCompact
16+
(appendMulti, appendSingle)
17+
import Database.LSMTree.Internal.IndexOrdinaryAcc (IndexOrdinaryAcc)
18+
import qualified Database.LSMTree.Internal.IndexOrdinaryAcc as IndexOrdinary
19+
(appendMulti, appendSingle)
20+
import Database.LSMTree.Internal.Serialise (SerialisedKey)
21+
22+
-- | Instruction for appending pages, to be used in conjunction with indexes.
23+
data Append
24+
= {-|
25+
Append a single page that fully comprises one or more key–value pairs.
26+
-}
27+
AppendSinglePage
28+
SerialisedKey -- ^ Minimum key
29+
SerialisedKey -- ^ Maximum key
30+
| {-|
31+
Append multiple pages that together comprise a single key–value pair.
32+
-}
33+
AppendMultiPage
34+
SerialisedKey -- ^ Sole key
35+
Word32 -- ^ Number of overflow pages
36+
37+
instance NFData Append where
38+
39+
rnf (AppendSinglePage minKey maxKey)
40+
= rnf minKey `seq` rnf maxKey
41+
rnf (AppendMultiPage key overflowPageCount)
42+
= rnf key `seq` rnf overflowPageCount
43+
44+
{-|
45+
Add information about appended pages to an index under incremental
46+
construction.
47+
48+
Internally, 'append' uses 'IndexCompact.appendSingle' and
49+
'IndexCompact.appendMulti', and the usage restrictions of those functions
50+
apply also here.
51+
-}
52+
append :: Append -> IndexCompactAcc s -> ST s [Chunk]
53+
append instruction indexAcc = case instruction of
54+
AppendSinglePage minKey maxKey
55+
-> toList <$> IndexCompact.appendSingle (minKey, maxKey) indexAcc
56+
AppendMultiPage key overflowPageCount
57+
-> IndexCompact.appendMulti (key, overflowPageCount) indexAcc
58+
59+
{-|
60+
A variant of 'append' for ordinary indexes, which is only used temporarily
61+
until there is a type class of index types.
62+
63+
Internally, 'append'' uses 'IndexOrdinary.appendSingle' and
64+
'IndexOrdinary.appendMulti', and the usage restrictions of those functions
65+
apply also here.
66+
-}
67+
append' :: Append -> IndexOrdinaryAcc s -> ST s [Chunk]
68+
append' instruction indexAcc = case instruction of
69+
AppendSinglePage minKey maxKey
70+
-> toList <$> IndexOrdinary.appendSingle (minKey, maxKey) indexAcc
71+
AppendMultiPage key overflowPageCount
72+
-> IndexOrdinary.appendMulti (key, overflowPageCount) indexAcc

‎src/Database/LSMTree/Internal/IndexCompactAcc.hs‎

Lines changed: 0 additions & 24 deletions
Original file line numberDiff line numberDiff line change
@@ -14,8 +14,6 @@ module Database.LSMTree.Internal.IndexCompactAcc (
1414
-- $construction-invariants
1515
IndexCompactAcc (..)
1616
, new
17-
, Append (..)
18-
, append
1917
, appendSingle
2018
, appendMulti
2119
, unsafeEnd
@@ -30,11 +28,9 @@ module Database.LSMTree.Internal.IndexCompactAcc (
3028
import Control.Exception (assert)
3129
#endif
3230

33-
import Control.DeepSeq (NFData (..))
3431
import Control.Monad (when)
3532
import Control.Monad.ST.Strict
3633
import Data.Bit hiding (flipBit)
37-
import Data.Foldable (toList)
3834
import Data.List.NonEmpty (NonEmpty)
3935
import qualified Data.List.NonEmpty as NE
4036
import Data.Map.Range (Bound (..))
@@ -126,26 +122,6 @@ newPinnedMVec64 lenWords = do
126122
setByteArray mba 0 lenWords (0 :: Word64)
127123
return (VUM.MV_Word64 (VPM.MVector 0 lenWords mba))
128124

129-
-- | Min\/max key-info for pages
130-
data Append =
131-
-- | One or more keys are in this page, and their values fit within a single
132-
-- page.
133-
AppendSinglePage SerialisedKey SerialisedKey
134-
-- | There is only one key in this page, and it's value does not fit within
135-
-- a single page.
136-
| AppendMultiPage SerialisedKey Word32 -- ^ Number of overflow pages
137-
138-
instance NFData Append where
139-
rnf (AppendSinglePage kmin kmax) = rnf kmin `seq` rnf kmax
140-
rnf (AppendMultiPage k nOverflow) = rnf k `seq` rnf nOverflow
141-
142-
-- | Append a new page entry to a mutable compact index.
143-
--
144-
-- INVARIANTS: see [construction invariants](#construction-invariants).
145-
append :: Append -> IndexCompactAcc s -> ST s [Chunk]
146-
append (AppendSinglePage kmin kmax) ica = toList <$> appendSingle (kmin, kmax) ica
147-
append (AppendMultiPage k n) ica = appendMulti (k, n) ica
148-
149125
-- | Append a single page to a mutable compact index.
150126
--
151127
-- INVARIANTS: see [construction invariants](#construction-invariants).

‎src/Database/LSMTree/Internal/IndexOrdinaryAcc.hs‎

Lines changed: 49 additions & 32 deletions
Original file line numberDiff line numberDiff line change
@@ -8,7 +8,8 @@ module Database.LSMTree.Internal.IndexOrdinaryAcc
88
(
99
IndexOrdinaryAcc,
1010
new,
11-
append,
11+
appendSingle,
12+
appendMulti,
1213
unsafeEnd
1314
)
1415
where
@@ -17,12 +18,11 @@ import Prelude hiding (take)
1718

1819
import Control.Exception (assert)
1920
import Control.Monad.ST.Strict (ST)
21+
import Data.Maybe (maybeToList)
2022
import qualified Data.Vector.Primitive as Primitive (Vector, length)
21-
import Data.Word (Word16, Word8)
23+
import Data.Word (Word16, Word32, Word8)
2224
import Database.LSMTree.Internal.Chunk (Baler, Chunk, createBaler,
2325
feedBaler, unsafeEndBaler)
24-
import Database.LSMTree.Internal.IndexCompactAcc
25-
(Append (AppendMultiPage, AppendSinglePage))
2626
import Database.LSMTree.Internal.IndexOrdinary
2727
(IndexOrdinary (IndexOrdinary))
2828
import Database.LSMTree.Internal.Serialise
@@ -51,41 +51,58 @@ new initialKeyBufferSize minChunkSize = IndexOrdinaryAcc <$>
5151
Growing.new initialKeyBufferSize <*>
5252
createBaler minChunkSize
5353

54+
-- Yields the serialisation of an element of a key list.
55+
keyListElem :: SerialisedKey -> [Primitive.Vector Word8]
56+
keyListElem (SerialisedKey' keyBytes) = [keySizeBytes, keyBytes] where
57+
58+
keySize :: Int
59+
!keySize = Primitive.length keyBytes
60+
61+
keySizeAsWord16 :: Word16
62+
!keySizeAsWord16 = assert (keySize <= fromIntegral (maxBound :: Word16)) $
63+
fromIntegral keySize
64+
65+
keySizeBytes :: Primitive.Vector Word8
66+
!keySizeBytes = byteVectorFromPrim keySizeAsWord16
67+
5468
{-|
55-
Appends keys to the key list of an index and outputs newly available chunks
56-
of the serialised key list.
69+
Adds information about a single page that fully comprises one or more
70+
key–value pairs to an index and outputs newly available chunks of the
71+
serialised key list.
5772
58-
__Warning:__ Appending keys whose length cannot be represented by a 16-bit
59-
word may result in a corrupted serialised key list.
73+
__Warning:__ Using keys whose length cannot be represented by a 16-bit word
74+
may result in a corrupted serialised key list.
6075
-}
61-
append :: Append -> IndexOrdinaryAcc s -> ST s (Maybe Chunk)
62-
append instruction (IndexOrdinaryAcc lastKeys baler)
63-
= case instruction of
64-
AppendSinglePage _ key -> do
65-
Growing.append lastKeys 1 key
66-
feedBaler (keyListElem key) baler
67-
AppendMultiPage key overflowPageCount -> do
68-
let
69-
70-
pageCount :: Int
71-
!pageCount = succ (fromIntegral overflowPageCount)
72-
73-
Growing.append lastKeys pageCount key
74-
feedBaler (concat (replicate pageCount (keyListElem key))) baler
75-
where
76+
appendSingle :: (SerialisedKey, SerialisedKey)
77+
-> IndexOrdinaryAcc s
78+
-> ST s (Maybe Chunk)
79+
appendSingle (_, key) (IndexOrdinaryAcc lastKeys baler)
80+
= do
81+
Growing.append lastKeys 1 key
82+
feedBaler (keyListElem key) baler
7683

77-
keyListElem :: SerialisedKey -> [Primitive.Vector Word8]
78-
keyListElem (SerialisedKey' keyBytes) = [keySizeBytes, keyBytes] where
84+
{-|
85+
Adds information about multiple pages that together comprise a single
86+
key–value pair to an index and outputs newly available chunks of the
87+
serialised key list.
7988
80-
keySize :: Int
81-
!keySize = Primitive.length keyBytes
89+
__Warning:__ Using keys whose length cannot be represented by a 16-bit word
90+
may result in a corrupted serialised key list.
91+
-}
92+
appendMulti :: (SerialisedKey, Word32)
93+
-> IndexOrdinaryAcc s
94+
-> ST s [Chunk]
95+
appendMulti (key, overflowPageCount) (IndexOrdinaryAcc lastKeys baler)
96+
= do
97+
Growing.append lastKeys pageCount key
98+
maybeToList <$> feedBaler keyListElems baler
99+
where
82100

83-
keySizeAsWord16 :: Word16
84-
!keySizeAsWord16 = assert (keySize <= fromIntegral (maxBound :: Word16)) $
85-
fromIntegral keySize
101+
pageCount :: Int
102+
!pageCount = succ (fromIntegral overflowPageCount)
86103

87-
keySizeBytes :: Primitive.Vector Word8
88-
!keySizeBytes = byteVectorFromPrim keySizeAsWord16
104+
keyListElems :: [Primitive.Vector Word8]
105+
keyListElems = concat (replicate pageCount (keyListElem key))
89106

90107
{-|
91108
Returns the constructed index, along with a final chunk in case the

‎test/Test/Database/LSMTree/Internal/IndexCompact.hs‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -28,6 +28,7 @@ import qualified Data.Vector.Unboxed.Base as VU
2828
import Data.Word
2929
import Database.LSMTree.Extras
3030
import Database.LSMTree.Extras.Generators as Gen
31+
import Database.LSMTree.Extras.Index as Cons (Append (..), append)
3132
import Database.LSMTree.Internal.BitMath
3233
import Database.LSMTree.Internal.Chunk as Chunk (toByteString)
3334
import Database.LSMTree.Internal.Entry (NumEntries (..))

‎test/Test/Database/LSMTree/Internal/IndexOrdinary.hs‎

Lines changed: 8 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -16,7 +16,7 @@ import qualified Data.ByteString.Short as ShortByteString (length, pack)
1616
import Data.Either (isLeft)
1717
import Data.List (genericReplicate)
1818
import qualified Data.List as List (tail)
19-
import Data.Maybe (catMaybes)
19+
import Data.Maybe (maybeToList)
2020
import Data.Primitive.ByteArray (ByteArray (ByteArray), ByteArray#)
2121
import Data.Vector (Vector, all, fromList, head, last, length,
2222
notElem, splitAt, tail, takeWhile, toList, (!))
@@ -25,15 +25,14 @@ import qualified Data.Vector.Primitive as Primitive (Vector (Vector), concat,
2525
import Data.Word (Word16, Word32, Word64, Word8)
2626
import Database.LSMTree.Extras.Generators (LogicalPageSummaries,
2727
toAppends)
28+
import Database.LSMTree.Extras.Index
29+
(Append (AppendMultiPage, AppendSinglePage), append')
2830
import qualified Database.LSMTree.Internal.Chunk as Chunk (toByteVector)
2931
import Database.LSMTree.Internal.Entry (NumEntries (NumEntries))
30-
import Database.LSMTree.Internal.IndexCompactAcc
31-
(Append (AppendMultiPage, AppendSinglePage))
3232
import Database.LSMTree.Internal.IndexOrdinary
3333
(IndexOrdinary (IndexOrdinary), fromSBS, search,
3434
toLastKeys)
35-
import Database.LSMTree.Internal.IndexOrdinaryAcc (append, new,
36-
unsafeEnd)
35+
import Database.LSMTree.Internal.IndexOrdinaryAcc (new, unsafeEnd)
3736
import Database.LSMTree.Internal.Page (PageNo (PageNo),
3837
PageSpan (PageSpan))
3938
import Database.LSMTree.Internal.Serialise
@@ -259,14 +258,14 @@ lastKeysBlockFromAppends appends = lastKeysBlock where
259258
incrementalConstruction :: [Append] -> (IndexOrdinary, Primitive.Vector Word8)
260259
incrementalConstruction appends = runST $ do
261260
acc <- new initialKeyBufferSize minChunkSize
262-
commonChunks <- mapM (flip append acc) appends
261+
commonChunks <- concat <$> mapM (flip append' acc) appends
263262
(remnant, unserialised) <- unsafeEnd acc
264263
let
265264

266265
serialised :: Primitive.Vector Word8
267-
serialised = Primitive.concat $
268-
map Chunk.toByteVector $
269-
catMaybes (commonChunks ++ [remnant])
266+
serialised = Primitive.concat $
267+
map Chunk.toByteVector $
268+
commonChunks ++ maybeToList remnant
270269

271270
return (unserialised, serialised)
272271
where

0 commit comments

Comments
 (0)