Skip to content

Commit ad33f2d

Browse files
jorisdraljorisdral
authored
Merge pull request #522 from IntersectMBO/jeltsch/index-choice-with-fixed-selection
Make it possible to choose the index type (fixed choice)
2 parents bd366da + 987bb0f commit ad33f2d

File tree

34 files changed

+652
-474
lines changed

34 files changed

+652
-474
lines changed

‎bench/macro/lsm-tree-bench-lookups.hs‎

Lines changed: 7 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -25,7 +25,8 @@ import Database.LSMTree.Extras.Orphans ()
2525
import Database.LSMTree.Extras.UTxO
2626
import Database.LSMTree.Internal.Entry (Entry (Insert),
2727
NumEntries (..))
28-
import Database.LSMTree.Internal.Index.Compact (IndexCompact)
28+
import Database.LSMTree.Internal.Index (Index)
29+
import qualified Database.LSMTree.Internal.Index as Index (IndexType (Compact))
2930
import Database.LSMTree.Internal.Lookup
3031
import Database.LSMTree.Internal.Paths (RunFsPaths (RunFsPaths))
3132
import Database.LSMTree.Internal.Run (Run)
@@ -333,7 +334,7 @@ lookupsEnv ::
333334
-> Run.RunDataCaching
334335
-> IO ( V.Vector (Ref (Run IO FS.HandleIO))
335336
, V.Vector (Bloom SerialisedKey)
336-
, V.Vector IndexCompact
337+
, V.Vector Index
337338
, V.Vector (FS.Handle FS.HandleIO)
338339
)
339340
lookupsEnv runSizes keyRng0 hfs hbio caching = do
@@ -351,6 +352,7 @@ lookupsEnv runSizes keyRng0 hfs hbio caching = do
351352
(RunFsPaths (FS.mkFsPath []) (RunNumber i))
352353
(NumEntries numEntries)
353354
(RunAllocFixed benchmarkNumBitsPerEntry)
355+
Index.Compact
354356
| ((numEntries, _), i) <- zip runSizes [0..] ]
355357

356358
-- fill the runs
@@ -428,7 +430,7 @@ benchBloomQueries !bs !keyRng !n
428430
benchIndexSearches ::
429431
ArenaManager RealWorld
430432
-> V.Vector (Bloom SerialisedKey)
431-
-> V.Vector IndexCompact
433+
-> V.Vector Index
432434
-> V.Vector (FS.Handle h)
433435
-> StdGen
434436
-> Int
@@ -446,7 +448,7 @@ benchIndexSearches !arenaManager !bs !ics !hs !keyRng !n
446448
benchPrepLookups ::
447449
ArenaManager RealWorld
448450
-> V.Vector (Bloom SerialisedKey)
449-
-> V.Vector IndexCompact
451+
-> V.Vector Index
450452
-> V.Vector (FS.Handle h)
451453
-> StdGen
452454
-> Int
@@ -468,7 +470,7 @@ benchLookupsIO ::
468470
-> Ref (WBB.WriteBufferBlobs IO h)
469471
-> V.Vector (Ref (Run IO h))
470472
-> V.Vector (Bloom SerialisedKey)
471-
-> V.Vector IndexCompact
473+
-> V.Vector Index
472474
-> V.Vector (FS.Handle h)
473475
-> StdGen
474476
-> Int

‎bench/micro/Bench/Database/LSMTree/Internal/Index/Compact.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -84,7 +84,7 @@ constructIndexCompact ::
8484
-> IndexCompact
8585
constructIndexCompact (ChunkSize csize) apps = runST $ do
8686
ica <- new csize
87-
mapM_ (`append` ica) apps
87+
mapM_ (`appendToCompact` ica) apps
8888
(_, index) <- unsafeEnd ica
8989
pure index
9090

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

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -21,6 +21,7 @@ import Database.LSMTree.Extras.Random (frequency, randomByteStringR,
2121
sampleUniformWithReplacement, uniformWithoutReplacement)
2222
import Database.LSMTree.Extras.UTxO
2323
import Database.LSMTree.Internal.Entry (Entry (..), NumEntries (..))
24+
import qualified Database.LSMTree.Internal.Index as Index (IndexType (Compact))
2425
import Database.LSMTree.Internal.Lookup (bloomQueries, indexSearches,
2526
intraPageLookups, lookupsIO, prepLookups)
2627
import Database.LSMTree.Internal.Page (getNumPages)
@@ -191,7 +192,7 @@ lookupsInBatchesEnv Config {..} = do
191192
wbblobs <- WBB.new hasFS (FS.mkFsPath ["0.wbblobs"])
192193
wb <- WB.fromMap <$> traverse (traverse (WBB.addBlob hasFS wbblobs)) storedKeys
193194
let fsps = RunFsPaths (FS.mkFsPath []) (RunNumber 0)
194-
r <- Run.fromWriteBuffer hasFS hasBlockIO caching (RunAllocFixed 10) fsps wb wbblobs
195+
r <- Run.fromWriteBuffer hasFS hasBlockIO caching (RunAllocFixed 10) Index.Compact fsps wb wbblobs
195196
let NumEntries nentriesReal = Run.size r
196197
assertEqual nentriesReal nentries $ pure ()
197198
-- 42 to 43 entries per page

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

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -18,6 +18,7 @@ import qualified Database.LSMTree.Extras.Random as R
1818
import Database.LSMTree.Extras.RunData
1919
import Database.LSMTree.Extras.UTxO
2020
import Database.LSMTree.Internal.Entry
21+
import qualified Database.LSMTree.Internal.Index as Index (IndexType (Compact))
2122
import Database.LSMTree.Internal.Merge (MergeType (..))
2223
import qualified Database.LSMTree.Internal.Merge as Merge
2324
import Database.LSMTree.Internal.Paths (RunFsPaths (..))
@@ -263,7 +264,7 @@ merge ::
263264
merge fs hbio Config {..} targetPaths runs = do
264265
let f = fromMaybe const mergeMappend
265266
m <- fromMaybe (error "empty inputs, no merge created") <$>
266-
Merge.new fs hbio Run.CacheRunData (RunAllocFixed 10)
267+
Merge.new fs hbio Run.CacheRunData (RunAllocFixed 10) Index.Compact
267268
mergeType f targetPaths runs
268269
Merge.stepsToCompletion m stepSize
269270

@@ -385,7 +386,7 @@ randomRuns ::
385386
-> IO InputRuns
386387
randomRuns hasFS hasBlockIO config@Config {..} rng0 =
387388
V.fromList <$>
388-
zipWithM (unsafeFlushAsWriteBuffer hasFS hasBlockIO)
389+
zipWithM (unsafeFlushAsWriteBuffer hasFS hasBlockIO Index.Compact)
389390
inputRunPaths runsData
390391
where
391392
runsData :: [SerialisedRunData]

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

Lines changed: 52 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -5,6 +5,8 @@
55
module Database.LSMTree.Extras.Index
66
(
77
Append (AppendSinglePage, AppendMultiPage),
8+
appendToCompact,
9+
appendToOrdinary,
810
append
911
)
1012
where
@@ -14,8 +16,15 @@ import Control.Monad.ST.Strict (ST)
1416
import Data.Foldable (toList)
1517
import Data.Word (Word32)
1618
import Database.LSMTree.Internal.Chunk (Chunk)
17-
import Database.LSMTree.Internal.Index (IndexAcc, appendMulti,
19+
import Database.LSMTree.Internal.Index (IndexAcc)
20+
import qualified Database.LSMTree.Internal.Index as Index (appendMulti,
1821
appendSingle)
22+
import Database.LSMTree.Internal.Index.CompactAcc (IndexCompactAcc)
23+
import qualified Database.LSMTree.Internal.Index.CompactAcc as IndexCompact
24+
(appendMulti, appendSingle)
25+
import Database.LSMTree.Internal.Index.OrdinaryAcc (IndexOrdinaryAcc)
26+
import qualified Database.LSMTree.Internal.Index.OrdinaryAcc as IndexOrdinary
27+
(appendMulti, appendSingle)
1928
import Database.LSMTree.Internal.Serialise (SerialisedKey)
2029

2130
-- | Instruction for appending pages, to be used in conjunction with indexes.
@@ -42,14 +51,51 @@ instance NFData Append where
4251

4352
{-|
4453
Adds information about appended pages to an index and outputs newly
45-
available chunks.
54+
available chunks, using primitives specific to the type of the index.
4655
47-
See the documentation of the 'IndexAcc' class for constraints to adhere to.
56+
See the documentation of the 'IndexAcc' type for constraints to adhere to.
4857
-}
49-
append :: IndexAcc j => Append -> j s -> ST s [Chunk]
50-
append instruction indexAcc = case instruction of
58+
appendWith :: ((SerialisedKey, SerialisedKey) -> j s -> ST s (Maybe Chunk))
59+
-> ((SerialisedKey, Word32) -> j s -> ST s [Chunk])
60+
-> Append
61+
-> j s
62+
-> ST s [Chunk]
63+
appendWith appendSingle appendMulti instruction indexAcc = case instruction of
5164
AppendSinglePage minKey maxKey
5265
-> toList <$> appendSingle (minKey, maxKey) indexAcc
5366
AppendMultiPage key overflowPageCount
5467
-> appendMulti (key, overflowPageCount) indexAcc
55-
{-# INLINABLE append #-}
68+
{-# INLINABLE appendWith #-}
69+
70+
{-|
71+
Adds information about appended pages to a compact index and outputs newly
72+
available chunks.
73+
74+
See the documentation of the 'IndexAcc' type for constraints to adhere to.
75+
-}
76+
appendToCompact :: Append -> IndexCompactAcc s -> ST s [Chunk]
77+
appendToCompact = appendWith IndexCompact.appendSingle
78+
IndexCompact.appendMulti
79+
{-# INLINE appendToCompact #-}
80+
81+
{-|
82+
Adds information about appended pages to an ordinary index and outputs newly
83+
available chunks.
84+
85+
See the documentation of the 'IndexAcc' type for constraints to adhere to.
86+
-}
87+
appendToOrdinary :: Append -> IndexOrdinaryAcc s -> ST s [Chunk]
88+
appendToOrdinary = appendWith IndexOrdinary.appendSingle
89+
IndexOrdinary.appendMulti
90+
{-# INLINE appendToOrdinary #-}
91+
92+
{-|
93+
Adds information about appended pages to an index and outputs newly
94+
available chunks.
95+
96+
See the documentation of the 'IndexAcc' type for constraints to adhere to.
97+
-}
98+
append :: Append -> IndexAcc s -> ST s [Chunk]
99+
append = appendWith Index.appendSingle
100+
Index.appendMulti
101+
{-# INLINE append #-}

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

Lines changed: 41 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -38,11 +38,15 @@ import Database.LSMTree.Internal as Internal
3838
import Database.LSMTree.Internal.BlobFile
3939
import Database.LSMTree.Internal.BlobRef
4040
import Database.LSMTree.Internal.ChecksumHandle
41+
import Database.LSMTree.Internal.Chunk
4142
import Database.LSMTree.Internal.Config
4243
import Database.LSMTree.Internal.CRC32C
4344
import Database.LSMTree.Internal.Entry
45+
import Database.LSMTree.Internal.Index
4446
import Database.LSMTree.Internal.Index.Compact
4547
import Database.LSMTree.Internal.Index.CompactAcc
48+
import Database.LSMTree.Internal.Index.Ordinary
49+
import Database.LSMTree.Internal.Index.OrdinaryAcc
4650
import Database.LSMTree.Internal.Merge
4751
import qualified Database.LSMTree.Internal.Merge as Merge
4852
import Database.LSMTree.Internal.MergeSchedule
@@ -64,6 +68,7 @@ import Database.LSMTree.Internal.RunReaders
6468
import Database.LSMTree.Internal.Serialise
6569
import Database.LSMTree.Internal.UniqCounter
6670
import Database.LSMTree.Internal.Unsliced
71+
import Database.LSMTree.Internal.Vector.Growing
6772
import Database.LSMTree.Internal.WriteBuffer
6873
import Database.LSMTree.Internal.WriteBufferBlobs
6974
import GHC.Generics
@@ -275,7 +280,7 @@ deriving anyclass instance Typeable (PrimState m)
275280
=> NoThunks (FilePointer m)
276281

277282
{-------------------------------------------------------------------------------
278-
IndexCompact
283+
Index
279284
-------------------------------------------------------------------------------}
280285

281286
deriving stock instance Generic IndexCompact
@@ -284,6 +289,12 @@ deriving anyclass instance NoThunks IndexCompact
284289
deriving stock instance Generic PageNo
285290
deriving anyclass instance NoThunks PageNo
286291

292+
deriving stock instance Generic IndexOrdinary
293+
deriving anyclass instance NoThunks IndexOrdinary
294+
295+
deriving stock instance Generic Index
296+
deriving anyclass instance NoThunks Index
297+
287298
{-------------------------------------------------------------------------------
288299
MergeSchedule
289300
-------------------------------------------------------------------------------}
@@ -398,7 +409,7 @@ deriving anyclass instance Typeable s
398409
=> NoThunks (RunAcc s)
399410

400411
{-------------------------------------------------------------------------------
401-
IndexCompactAcc
412+
IndexAcc
402413
-------------------------------------------------------------------------------}
403414

404415
deriving stock instance Generic (IndexCompactAcc s)
@@ -408,6 +419,30 @@ deriving anyclass instance Typeable s
408419
deriving stock instance Generic (SMaybe a)
409420
deriving anyclass instance NoThunks a => NoThunks (SMaybe a)
410421

422+
deriving stock instance Generic (IndexOrdinaryAcc s)
423+
deriving anyclass instance Typeable s
424+
=> NoThunks (IndexOrdinaryAcc s)
425+
426+
deriving stock instance Generic (IndexAcc s)
427+
deriving anyclass instance Typeable s
428+
=> NoThunks (IndexAcc s)
429+
430+
{-------------------------------------------------------------------------------
431+
GrowingVector
432+
-------------------------------------------------------------------------------}
433+
434+
deriving stock instance Generic (GrowingVector s a)
435+
deriving anyclass instance (Typeable s, Typeable a, NoThunks a)
436+
=> NoThunks (GrowingVector s a)
437+
438+
{-------------------------------------------------------------------------------
439+
Baler
440+
-------------------------------------------------------------------------------}
441+
442+
deriving stock instance Generic (Baler s)
443+
deriving anyclass instance Typeable s
444+
=> NoThunks (Baler s)
445+
411446
{-------------------------------------------------------------------------------
412447
PageAcc
413448
-------------------------------------------------------------------------------}
@@ -681,6 +716,10 @@ deriving via OnlyCheckWhnf (VUM.MVector s Word64)
681716
deriving via OnlyCheckWhnf (VUM.MVector s Bit)
682717
instance Typeable s => NoThunks (VUM.MVector s Bit)
683718

719+
-- TODO: upstream to @nothunks@
720+
deriving via OnlyCheckWhnf (VP.MVector s Word8)
721+
instance Typeable s => NoThunks (VP.MVector s Word8)
722+
684723
{-------------------------------------------------------------------------------
685724
ST
686725
-------------------------------------------------------------------------------}

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

Lines changed: 10 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -36,6 +36,7 @@ import qualified Data.Vector as V
3636
import Database.LSMTree.Extras (showPowersOf10)
3737
import Database.LSMTree.Extras.Generators ()
3838
import Database.LSMTree.Internal.Entry
39+
import Database.LSMTree.Internal.Index (IndexType)
3940
import Database.LSMTree.Internal.Lookup (ResolveSerialisedValue)
4041
import Database.LSMTree.Internal.MergeSchedule (addWriteBufferEntries)
4142
import Database.LSMTree.Internal.Paths
@@ -63,13 +64,14 @@ import Test.QuickCheck
6364
withRun ::
6465
HasFS IO h
6566
-> HasBlockIO IO h
67+
-> IndexType
6668
-> RunFsPaths
6769
-> SerialisedRunData
6870
-> (Ref (Run IO h) -> IO a)
6971
-> IO a
70-
withRun hfs hbio path rd = do
72+
withRun hfs hbio indexType path rd = do
7173
bracket
72-
(unsafeFlushAsWriteBuffer hfs hbio path $ serialiseRunData rd)
74+
(unsafeFlushAsWriteBuffer hfs hbio indexType path $ serialiseRunData rd)
7375
releaseRef
7476

7577
{-# INLINABLE withRuns #-}
@@ -78,12 +80,13 @@ withRuns ::
7880
Traversable f
7981
=> HasFS IO h
8082
-> HasBlockIO IO h
83+
-> IndexType
8184
-> f (RunFsPaths, SerialisedRunData)
8285
-> (f (Ref (Run IO h)) -> IO a)
8386
-> IO a
84-
withRuns hfs hbio xs = do
87+
withRuns hfs hbio indexType xs = do
8588
bracket
86-
(forM xs $ \(path, rd) -> unsafeFlushAsWriteBuffer hfs hbio path rd)
89+
(forM xs $ \(path, rd) -> unsafeFlushAsWriteBuffer hfs hbio indexType path rd)
8790
(mapM_ releaseRef)
8891

8992
-- | Flush serialised run data to disk as if it were a write buffer.
@@ -95,14 +98,15 @@ withRuns hfs hbio xs = do
9598
unsafeFlushAsWriteBuffer ::
9699
HasFS IO h
97100
-> HasBlockIO IO h
101+
-> IndexType
98102
-> RunFsPaths
99103
-> SerialisedRunData
100104
-> IO (Ref (Run IO h))
101-
unsafeFlushAsWriteBuffer fs hbio fsPaths (RunData m) = do
105+
unsafeFlushAsWriteBuffer fs hbio indexType fsPaths (RunData m) = do
102106
let blobpath = addExtension (runBlobPath fsPaths) ".wb"
103107
wbblobs <- WBB.new fs blobpath
104108
wb <- WB.fromMap <$> traverse (traverse (WBB.addBlob fs wbblobs)) m
105-
run <- Run.fromWriteBuffer fs hbio CacheRunData (RunAllocFixed 10)
109+
run <- Run.fromWriteBuffer fs hbio CacheRunData (RunAllocFixed 10) indexType
106110
fsPaths wb wbblobs
107111
releaseRef wbblobs
108112
return run

0 commit comments

Comments
 (0)