Change the MergingRun credit tracking strategy

The intention is to simplify things and make them more obviously correct
in the presence of concurrency. This should have the bonus of making it
easier to reliably determine leftover/excess supplied credits (which is
something we want for supplying credits to trees of merging runs).

The approach is to change the counters from three independent counters,
to just two, which are modified together as a pair atomically.
Previously we tracked the credits spent and unspent, and the steps
performed. We did not explicitly keep track of credits that were in the
process of being spent.

Now we track spent and unspent (and not steps performed), but the spent
credits includes those that are in the process of being spent. We keep
these together in a single atomic variable, and so all operations on the
pair are atomic. This makes the concurrency story much simpler because
all credit tracking changes are atomic. We avoid having to track steps
performed by accounting differently for the difference between credits
used for merging and steps performed: we simply borrow more credits from
the unspent pot, allowing the pot to become negative.

Author: dcoutts

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

@@ -321,14 +321,8 @@ deriving anyclass instance NoThunks MergePolicyForLevel
 deriving stock instance Generic NumRuns
 deriving anyclass instance NoThunks NumRuns
 
-deriving stock instance Generic (UnspentCreditsVar s)
-deriving anyclass instance Typeable s => NoThunks (UnspentCreditsVar s)
-
-deriving stock instance Generic (TotalStepsVar s)
-deriving anyclass instance Typeable s => NoThunks (TotalStepsVar s)
-
-deriving stock instance Generic (SpentCreditsVar s)
-deriving anyclass instance Typeable s => NoThunks (SpentCreditsVar s)
+deriving stock instance Generic (CreditsVar s)
+deriving anyclass instance Typeable s => NoThunks (CreditsVar s)
 
 deriving stock instance Generic MergeKnownCompleted
 deriving anyclass instance NoThunks MergeKnownCompleted

src/Database/LSMTree/Internal/MergeSchedule.hs

@@ -673,7 +673,7 @@ addRunToLevels tr conf@TableConfig{..} resolve hfs hbio root uc r0 reg levels =
           OneShot -> do
             let !required = MR.Credits (unNumEntries (V.foldMap' Run.size rs))
             let !thresh = creditThresholdForLevel conf ln
-            MR.supplyCredits required thresh mr
+            MR.supplyCredits mr thresh required
             -- This ensures the merge is really completed. However, we don't
             -- release the merge yet and only briefly inspect the resulting run.
             bracket (MR.expectCompleted mr) releaseRef $ \r ->
@@ -802,7 +802,7 @@ supplyCredits conf c levels =
         Merging mp mr -> do
           let !c' = scaleCreditsForMerge mp mr c
           let !thresh = creditThresholdForLevel conf ln
-          MR.supplyCredits c' thresh mr
+          MR.supplyCredits mr thresh c'
 
 -- | Scale a number of credits to a number of merge steps to be performed, based
 -- on the merging run.
@@ -837,4 +837,4 @@ scaleCreditsForMerge LevelLevelling (DeRef mr) (Credits c) =
 creditThresholdForLevel :: TableConfig -> LevelNo -> MR.CreditThreshold
 creditThresholdForLevel conf (LevelNo _i) =
     let AllocNumEntries (NumEntries x) = confWriteBufferAlloc conf
-    in  MR.CreditThreshold x
+    in  MR.CreditThreshold (MR.Credits x)