| Safe Haskell | Safe-Inferred | 
|---|---|
| Language | GHC2021 | 
ScheduledMerges
Description
A prototype of an LSM with explicitly scheduled incremental merges.
The scheduled incremental merges is about ensuring that the merging work (CPU and I/O) can be spread out over time evenly. This also means the LSM update operations have worst case complexity rather than amortised complexity, because they do a fixed amount of merging work each.
Another thing this prototype demonstrates is a design for duplicating tables and sharing ongoing incremental merges.
Finally, it demonstrates a design for table unions, including a representation for in-progress merging trees.
The merging policy that this prototype uses is "lazy levelling". Each level is T times bigger than the previous level. Lazy levelling means we use tiering for every level except the last level which uses levelling. Though note that the first level always uses tiering, even if the first level is also the last level. This is to simplify flushing the write buffer: if we used levelling on the first level we would need a code path for merging the write buffer into the first level.
Synopsis
- data LSM s
 - newtype TableId = TableId Int
 - data LSMConfig = LSMConfig {}
 - newtype Key = K Int
 - newtype Value = V Int
 - resolveValue :: Value -> Value -> Value
 - newtype Blob = B Int
 - new :: Tracer (ST s) Event -> TableId -> ST s (LSM s)
 - newWith :: Tracer (ST s) Event -> TableId -> LSMConfig -> ST s (LSM s)
 - data LookupResult v b
 - lookup :: Tracer (ST s) Event -> LSM s -> Key -> ST s (LookupResult Value Blob)
 - lookups :: LSM s -> [Key] -> ST s [LookupResult Value Blob]
 - type Entry = Update Value Blob
 - data Update v b
 - update :: Tracer (ST s) Event -> LSM s -> Key -> Entry -> ST s ()
 - updates :: Tracer (ST s) Event -> LSM s -> [(Key, Entry)] -> ST s ()
 - insert :: Tracer (ST s) Event -> LSM s -> Key -> Value -> Maybe Blob -> ST s ()
 - inserts :: Tracer (ST s) Event -> LSM s -> [(Key, Value, Maybe Blob)] -> ST s ()
 - delete :: Tracer (ST s) Event -> LSM s -> Key -> ST s ()
 - deletes :: Tracer (ST s) Event -> LSM s -> [Key] -> ST s ()
 - mupsert :: Tracer (ST s) Event -> LSM s -> Key -> Value -> ST s ()
 - mupserts :: Tracer (ST s) Event -> LSM s -> [(Key, Value)] -> ST s ()
 - supplyMergeCredits :: LSM s -> NominalCredit -> ST s ()
 - duplicate :: Tracer (ST s) Event -> TableId -> LSM s -> ST s (LSM s)
 - unions :: Tracer (ST s) Event -> TableId -> [LSM s] -> ST s (LSM s)
 - type Credit = Int
 - type Debt = Int
 - remainingUnionDebt :: LSM s -> ST s UnionDebt
 - supplyUnionCredits :: LSM s -> UnionCredits -> ST s UnionCredits
 - data MTree r
- = MLeaf r
 - | MNode TreeMergeType [MTree r]
 
 - logicalValue :: LSM s -> ST s (Map Key (Value, Maybe Blob))
 - type Representation = (Run, [LevelRepresentation], Maybe (MTree Run))
 - dumpRepresentation :: LSM s -> ST s Representation
 - representationShape :: Representation -> (Int, [([Int], [Int])], Maybe (MTree Int))
 - data Event
 - data EventAt e = EventAt {
- eventAtStep :: Counter
 - eventAtLevel :: Int
 - eventDetail :: e
 
 - data EventDetail
 - newtype MergingTree s = MergingTree (STRef s (MergingTreeState s))
 - data MergingTreeState s
 - data PendingMerge s
- = PendingLevelMerge ![PreExistingRun s] !(Maybe (MergingTree s))
 - | PendingUnionMerge ![MergingTree s]
 
 - data PreExistingRun s
 - data MergingRun t s = MergingRun !t !MergeDebt !(STRef s MergingRunState)
 - data MergingRunState
- = CompletedMerge !Run
 - | OngoingMerge !MergeCredit ![Run] Run
 
 - data MergePolicyForLevel
 - class Show t => IsMergeType t where
- isLastLevel :: t -> Bool
 - isUnion :: t -> Bool
 
 - data TreeMergeType
 - data LevelMergeType
 - data MergeCredit = MergeCredit {
- spentCredits :: !Credit
 - unspentCredits :: !Credit
 
 - newtype MergeDebt = MergeDebt {}
 - newtype NominalCredit = NominalCredit Credit
 - newtype NominalDebt = NominalDebt Credit
 - type Run = Map Key Entry
 - runSize :: Run -> Int
 - newtype UnionCredits = UnionCredits Credit
 - supplyCreditsMergingTree :: Credit -> MergingTree s -> ST s Credit
 - newtype UnionDebt = UnionDebt Debt
 - remainingDebtMergingTree :: MergingTree s -> ST s (Debt, Size)
 - mergek :: IsMergeType t => t -> [Run] -> Run
 - mergeBatchSize :: Int
 - type Invariant s = ExceptT String (ST s)
 - evalInvariant :: Invariant s a -> ST s (Either String a)
 - treeInvariant :: MergingTree s -> Invariant s ()
 - mergeDebtInvariant :: MergeDebt -> MergeCredit -> Bool
 - levelNumberToMaxRunSize :: HasCallStack => MergePolicyForLevel -> LSMConfig -> LevelNo -> Int
 - runSizeToLevelNumber :: HasCallStack => MergePolicyForLevel -> LSMConfig -> Int -> LevelNo
 - maxWriteBufferSize :: HasCallStack => LSMConfig -> Int
 - runSizeFitsInLevel :: HasCallStack => MergePolicyForLevel -> LSMConfig -> LevelNo -> Int -> Bool
 - runSizeTooSmallForLevel :: HasCallStack => MergePolicyForLevel -> LSMConfig -> LevelNo -> Int -> Bool
 - runSizeTooLargeForLevel :: HasCallStack => MergePolicyForLevel -> LSMConfig -> LevelNo -> Int -> Bool
 - levelIsFull :: MergePolicyForLevel -> LSMConfig -> LevelNo -> [Run] -> [Run] -> Bool
 
Main API
Identifiers for LSM tables
Instances
| Enum TableId Source # | |
| Show TableId Source # | |
| Eq TableId Source # | |
| Ord TableId Source # | |
| Prim TableId Source # | |
Defined in ScheduledMerges Methods sizeOfType# :: Proxy TableId -> Int# Source # sizeOf# :: TableId -> Int# Source # alignmentOfType# :: Proxy TableId -> Int# Source # alignment# :: TableId -> Int# Source # indexByteArray# :: ByteArray# -> Int# -> TableId Source # readByteArray# :: MutableByteArray# s -> Int# -> State# s -> (# State# s, TableId #) Source # writeByteArray# :: MutableByteArray# s -> Int# -> TableId -> State# s -> State# s Source # setByteArray# :: MutableByteArray# s -> Int# -> Int# -> TableId -> State# s -> State# s Source # indexOffAddr# :: Addr# -> Int# -> TableId Source # readOffAddr# :: Addr# -> Int# -> State# s -> (# State# s, TableId #) Source # writeOffAddr# :: Addr# -> Int# -> TableId -> State# s -> State# s Source # setOffAddr# :: Addr# -> Int# -> Int# -> TableId -> State# s -> State# s Source #  | |
Configuration options for individual LSM tables.
Constructors
| LSMConfig | |
Fields 
  | |
Instances
data LookupResult v b Source #
Instances
| (Show v, Show b) => Show (LookupResult v b) Source # | |
Defined in ScheduledMerges Methods showsPrec :: Int -> LookupResult v b -> ShowS # show :: LookupResult v b -> String # showList :: [LookupResult v b] -> ShowS #  | |
| (Eq v, Eq b) => Eq (LookupResult v b) Source # | |
Defined in ScheduledMerges Methods (==) :: LookupResult v b -> LookupResult v b -> Bool # (/=) :: LookupResult v b -> LookupResult v b -> Bool #  | |
supplyMergeCredits :: LSM s -> NominalCredit -> ST s () Source #
unions :: Tracer (ST s) Event -> TableId -> [LSM s] -> ST s (LSM s) Source #
Similar to Data.Map.unionWith.
A call to union itself is not expensive, as the input tables are not
 immediately merged. Instead, it creates a representation of an in-progress
 merge that can be performed incrementally (somewhat similar to a thunk).
The more merge work remains, the more expensive are lookups on the table.
Credits for keeping track of merge progress. These credits correspond directly to merge steps performed.
We also call these "physical" credits (since they correspond to steps
 done), and as opposed to "nominal" credits in NominalCredit and
 NominalDebt.
remainingUnionDebt :: LSM s -> ST s UnionDebt Source #
Return the current union debt. This debt can be reduced until it is paid
 off using supplyUnionCredits.
supplyUnionCredits :: LSM s -> UnionCredits -> ST s UnionCredits Source #
Supply union credits to reduce union debt.
Supplying union credits leads to union merging work being performed in
 batches. This reduces the union debt returned by remainingUnionDebt. Union
 debt will be reduced by at least the number of supplied union credits. It
 is therefore advisable to query remainingUnionDebt every once in a while to
 see what the current debt is.
This function returns any surplus of union credits as leftover credits when a union has finished. In particular, if the returned number of credits is non-negative, then the union is finished.
Test and trace
Constructors
| MLeaf r | |
| MNode TreeMergeType [MTree r] | 
Instances
| Foldable MTree Source # | |
Defined in ScheduledMerges Methods fold :: Monoid m => MTree m -> m # foldMap :: Monoid m => (a -> m) -> MTree a -> m # foldMap' :: Monoid m => (a -> m) -> MTree a -> m # foldr :: (a -> b -> b) -> b -> MTree a -> b # foldr' :: (a -> b -> b) -> b -> MTree a -> b # foldl :: (b -> a -> b) -> b -> MTree a -> b # foldl' :: (b -> a -> b) -> b -> MTree a -> b # foldr1 :: (a -> a -> a) -> MTree a -> a # foldl1 :: (a -> a -> a) -> MTree a -> a # elem :: Eq a => a -> MTree a -> Bool # maximum :: Ord a => MTree a -> a # minimum :: Ord a => MTree a -> a #  | |
| Functor MTree Source # | |
| Show r => Show (MTree r) Source # | |
| Eq r => Eq (MTree r) Source # | |
dumpRepresentation :: LSM s -> ST s Representation Source #
representationShape :: Representation -> (Int, [([Int], [Int])], Maybe (MTree Int)) Source #
Constructors
| EventAt | |
Fields 
  | |
data EventDetail Source #
Constructors
Instances
| Show EventDetail Source # | |
Defined in ScheduledMerges Methods showsPrec :: Int -> EventDetail -> ShowS # show :: EventDetail -> String # showList :: [EventDetail] -> ShowS #  | |
newtype MergingTree s Source #
A "merging tree" is a mutable representation of an incremental tree-shaped nested merge. This allows to represent union merges of entire tables, each of which itself first need to be merged to become a single run.
Trees have to support arbitrarily deep nesting, since each input to union
 might already contain an in-progress merging tree (which then becomes shared
 between multiple tables).
See Note [Table Unions].
Constructors
| MergingTree (STRef s (MergingTreeState s)) | 
data MergingTreeState s Source #
Constructors
| CompletedTreeMerge !Run | |
| OngoingTreeMerge !(MergingRun TreeMergeType s) | Reuses MergingRun (with its STRef) to allow sharing existing merges.  | 
| PendingTreeMerge !(PendingMerge s) | 
data PendingMerge s Source #
A merge that is waiting for its inputs to complete.
The inputs can themselves be MergingTrees (with its STRef) to allow sharing
 existing unions.
Constructors
| PendingLevelMerge ![PreExistingRun s] !(Maybe (MergingTree s)) | The inputs are entire content of a table, i.e. its (merging) runs and finally a union merge (if that table already contained a union).  | 
| PendingUnionMerge ![MergingTree s] | Each input is a level merge of the entire content of a table.  | 
data PreExistingRun s Source #
This is much like an IncomingRun, and are created from them, but contain
 only the essential information needed in a PendingLevelMerge.
Constructors
| PreExistingRun !Run | |
| PreExistingMergingRun !(MergingRun LevelMergeType s) | 
data MergingRun t s Source #
A "merging run" is a mutable representation of an incremental merge. It is also a unit of sharing between duplicated tables.
Constructors
| MergingRun !t !MergeDebt !(STRef s MergingRunState) | 
data MergingRunState Source #
Constructors
| CompletedMerge !Run | |
| OngoingMerge | |
Fields 
  | |
data MergePolicyForLevel Source #
The merge policy for a LSM level can be either tiering or levelling.
 In this design we use levelling for the last level, and tiering for
 all other levels. The first level always uses tiering however, even if
 it's also the last level. So MergePolicyForLevel and LevelMergeType are
 orthogonal, all combinations are possible.
Constructors
| LevelTiering | |
| LevelLevelling | 
Instances
| Show MergePolicyForLevel Source # | |
Defined in ScheduledMerges Methods showsPrec :: Int -> MergePolicyForLevel -> ShowS # show :: MergePolicyForLevel -> String # showList :: [MergePolicyForLevel] -> ShowS #  | |
| Eq MergePolicyForLevel Source # | |
Defined in ScheduledMerges Methods (==) :: MergePolicyForLevel -> MergePolicyForLevel -> Bool # (/=) :: MergePolicyForLevel -> MergePolicyForLevel -> Bool #  | |
class Show t => IsMergeType t where Source #
Merges can exist in different parts of the LSM, each with different options for the exact merge operation performed.
Instances
| IsMergeType LevelMergeType Source # | |
Defined in ScheduledMerges  | |
| IsMergeType TreeMergeType Source # | |
Defined in ScheduledMerges  | |
data TreeMergeType Source #
Different types of merges created as part of the merging tree.
Union merges follow the semantics of Data.Map.unionWith (<>). Since
 the input runs are semantically treated like Data.Maps, deletes are ignored
 and inserts act like mupserts, so they need to be merged monoidally using
 resolveValue.
Trees can only exist on the union level, which is the last. Therefore, node merges can always drop deletes.
Constructors
| MergeLevel | |
| MergeUnion | 
Instances
| Arbitrary TreeMergeType Source # | |
Defined in ScheduledMerges  | |
| Show TreeMergeType Source # | |
Defined in ScheduledMerges Methods showsPrec :: Int -> TreeMergeType -> ShowS # show :: TreeMergeType -> String # showList :: [TreeMergeType] -> ShowS #  | |
| Eq TreeMergeType Source # | |
Defined in ScheduledMerges Methods (==) :: TreeMergeType -> TreeMergeType -> Bool # (/=) :: TreeMergeType -> TreeMergeType -> Bool #  | |
| IsMergeType TreeMergeType Source # | |
Defined in ScheduledMerges  | |
data LevelMergeType Source #
Different types of merges created as part of a regular (non-union) level.
A last level merge behaves differently from a mid-level merge: last level
 merges can actually remove delete entries, whereas mid-level merges must
 preserve them. This is orthogonal to the MergePolicyForLevel.
Constructors
| MergeMidLevel | |
| MergeLastLevel | 
Instances
| Arbitrary LevelMergeType Source # | |
Defined in ScheduledMerges Methods arbitrary :: Gen LevelMergeType Source # shrink :: LevelMergeType -> [LevelMergeType] Source #  | |
| Show LevelMergeType Source # | |
Defined in ScheduledMerges Methods showsPrec :: Int -> LevelMergeType -> ShowS # show :: LevelMergeType -> String # showList :: [LevelMergeType] -> ShowS #  | |
| Eq LevelMergeType Source # | |
Defined in ScheduledMerges Methods (==) :: LevelMergeType -> LevelMergeType -> Bool # (/=) :: LevelMergeType -> LevelMergeType -> Bool #  | |
| IsMergeType LevelMergeType Source # | |
Defined in ScheduledMerges  | |
data MergeCredit Source #
Constructors
| MergeCredit | |
Fields 
  | |
Instances
| Show MergeCredit Source # | |
Defined in ScheduledMerges Methods showsPrec :: Int -> MergeCredit -> ShowS # show :: MergeCredit -> String # showList :: [MergeCredit] -> ShowS #  | |
newtype NominalCredit Source #
Nominal credit is the credit supplied to each level as we insert update entries, one credit per update entry inserted.
Nominal credit must be supplied up to the NominalDebt to ensure the merge
 is complete.
Nominal credits are a similar order of magnitude to physical credits (see
 Credit) but not the same, and we have to scale linearly to convert between
 them. Physical credits are the actual number of inputs to the merge, which
 may be somewhat more or somewhat less than the number of update entries
 we will insert before we need the merge to be complete.
Constructors
| NominalCredit Credit | 
Instances
| Show NominalCredit Source # | |
Defined in ScheduledMerges Methods showsPrec :: Int -> NominalCredit -> ShowS # show :: NominalCredit -> String # showList :: [NominalCredit] -> ShowS #  | |
newtype NominalDebt Source #
The nominal debt for a merging run is the worst case (minimum) number of update entries we expect to insert before we expect the merge to be complete.
We require that an equal amount of nominal credit is supplied before we can expect a merge to be complete.
We scale linearly to convert nominal credits to physical credits, such that the nominal debt and physical debt are both considered "100%", and so that both debts are paid off at exactly the same time.
Constructors
| NominalDebt Credit | 
Instances
| Show NominalDebt Source # | |
Defined in ScheduledMerges Methods showsPrec :: Int -> NominalDebt -> ShowS # show :: NominalDebt -> String # showList :: [NominalDebt] -> ShowS #  | |
newtype UnionCredits Source #
Credits are used to pay off UnionDebt, completing a union in the
 process.
A union credit corresponds to a single merging step being performed.
Constructors
| UnionCredits Credit | 
Instances
supplyCreditsMergingTree :: Credit -> MergingTree s -> ST s Credit Source #
The current upper bound on the number of UnionCredits that have to be
 supplied before a union is completed.
The union debt is the number of merging steps that need to be performed /at
 most/ until the delayed work of performing a union is completed. This
 includes the cost of completing merges that were part of the union's input
 tables.
Instances
| Num UnionDebt Source # | |
Defined in ScheduledMerges  | |
| Show UnionDebt Source # | |
| Eq UnionDebt Source # | |
| Ord UnionDebt Source # | |
remainingDebtMergingTree :: MergingTree s -> ST s (Debt, Size) Source #
mergeBatchSize :: Int Source #
Invariants
treeInvariant :: MergingTree s -> Invariant s () Source #
mergeDebtInvariant :: MergeDebt -> MergeCredit -> Bool Source #
Run sizes
levelNumberToMaxRunSize :: HasCallStack => MergePolicyForLevel -> LSMConfig -> LevelNo -> Int Source #
Compute the maximum size of a run for a given level.
The size of a tiering run at each level is allowed to be
 bufferSize*sizeRatio^(level-1) < size <= bufferSize*sizeRatio^level.
>>>levelNumberToMaxRunSize LevelTiering (LSMConfig 2 4) <$> [0, 1, 2, 3, 4][0,2,8,32,128]
The size of a levelling run at each level is allowed to be
 bufferSize*sizeRatio^level < size <= bufferSize*sizeRatio^(level+1). A
 levelling run can take take up a whole level, so the maximum size of a run is
 sizeRatio tmes larger than the maximum size of a tiering run on the same
 level.
>>>levelNumberToMaxRunSize LevelLevelling (LSMConfig 2 4) <$> [0, 1, 2, 3, 4][0,8,32,128,512]
runSizeToLevelNumber :: HasCallStack => MergePolicyForLevel -> LSMConfig -> Int -> LevelNo Source #
Compute the appropriate level for the size of the given run.
See levelNumberToMaxRunSize for the bounds on (tiering or levelling) run
 sizes at each level.
>>>runSizeToLevelNumber LevelTiering (LSMConfig 2 4) <$> [0,2,8,32,128][0,1,2,3,4]
>>>runSizeToLevelNumber LevelLevelling (LSMConfig 2 4) <$> [0,8,32,128,512][0,1,2,3,4]
maxWriteBufferSize :: HasCallStack => LSMConfig -> Int Source #
runSizeFitsInLevel :: HasCallStack => MergePolicyForLevel -> LSMConfig -> LevelNo -> Int -> Bool Source #
Check wheter a run of the given size fits in the given level.
See levelNumberToMaxRunSize for the bounds on (tiering or levelling) run
 sizes at each level.
>>>runSizeFitsInLevel LevelTiering (LSMConfig 2 4) 3 <$> [8,9,16,32,33][False,True,True,True,False]
>>>runSizeFitsInLevel LevelLevelling (LSMConfig 2 4) 2 <$> [8,9,16,32,33][False,True,True,True,False]
runSizeTooSmallForLevel :: HasCallStack => MergePolicyForLevel -> LSMConfig -> LevelNo -> Int -> Bool Source #
Check wheter a run of the given size is too small for the given level.
See levelNumberToMaxRunSize for the bounds on (tiering or levelling) run
 sizes at each level.
>>>runSizeTooSmallForLevel LevelTiering (LSMConfig 2 4) 3 <$> [8,9][True,False]
>>>runSizeTooSmallForLevel LevelLevelling (LSMConfig 2 4) 2 <$> [8,9][True,False]
runSizeTooLargeForLevel :: HasCallStack => MergePolicyForLevel -> LSMConfig -> LevelNo -> Int -> Bool Source #
Check wheter a run of the given size is too large for the given level.
See levelNumberToMaxRunSize for the bounds on (tiering or levelling) run
 sizes at each level.
>>>runSizeTooLargeForLevel LevelTiering (LSMConfig 2 4) 2 <$> [8,9][False,True]
>>>runSizeTooLargeForLevel LevelLevelling (LSMConfig 2 4) 1 <$> [8,9][False,True]
Level capacity
levelIsFull :: MergePolicyForLevel -> LSMConfig -> LevelNo -> [Run] -> [Run] -> Bool Source #