tighten invariants

Author: mheinzel

prototypes/ScheduledMerges.hs

@@ -203,10 +203,13 @@ invariant = go 1
     expectedMergingRunLengths ln mr mrs ls =
       case mergePolicyForLevel ln ls of
         MergePolicyLevelling ->
+          assert (mergeLastForLevel ls == MergeLastLevel) $
           case (mr, mrs) of
             -- A single incoming run (which thus didn't need merging) must be
             -- of the expected size range already
-            (SingleRun r, CompletedMerge{}) ->
+            (SingleRun r, m) -> do
+              assertST $ case m of CompletedMerge{} -> True
+                                   OngoingMerge{}   -> False
               assertST $ levellingRunSizeToLevel r == ln
 
             -- A completed merge for levelling can be of almost any size at all!
@@ -216,20 +219,26 @@ invariant = go 1
               assertST $ levellingRunSizeToLevel r <= ln+1
 
             -- An ongoing merge for levelling should have 4 incoming runs of
-            -- the right size for the level below, and 1 run from this level,
+            -- the right size for the level below (since we know that that level
+            -- must use tiering), and 1 run from this level,
             -- but the run from this level can be of almost any size for the
             -- same reasons as above. Although if this is the first merge for
             -- a new level, it'll have only 4 runs.
             (_, OngoingMerge _ rs _) -> do
-              assertST $ length rs == 4 || length rs == 5
-              assertST $ all (\r -> tieringRunSizeToLevel r == ln-1) (take 4 rs)
-              assertST $ all (\r -> levellingRunSizeToLevel r <= ln+1) (drop 4 rs)
+              let incomingRuns = take 4 rs
+              let residentRuns = drop 4 rs
+              assertST $ length incomingRuns == 4
+              assertST $ length residentRuns <= 1
+              assertST $ all (\r -> tieringRunSizeToLevel r == ln-1) incomingRuns
+              assertST $ all (\r -> levellingRunSizeToLevel r <= ln+1) residentRuns
 
         MergePolicyTiering ->
           case (mr, mrs, mergeLastForLevel ls) of
             -- A single incoming run (which thus didn't need merging) must be
             -- of the expected size already
-            (SingleRun r, CompletedMerge{}, _) ->
+            (SingleRun r, m, _) -> do
+              assertST $ case m of CompletedMerge{} -> True
+                                   OngoingMerge{}   -> False
               assertST $ tieringRunSizeToLevel r == ln
 
             -- A completed last level run can be of almost any smaller size due
@@ -275,7 +284,7 @@ newMerge tr level mergepolicy mergelast rs = do
                    mergeCost     = cost,
                    mergeRunsSize = map Map.size rs
                  }
-    assert (let l = length rs in l >= 2 && l <= 5) $
+    assert (length rs `elem` [4, 5]) $
       MergingRun mergepolicy mergelast <$> newSTRef (OngoingMerge debt rs r)
   where
     cost = sum (map Map.size rs)