QLS tests: label the logical size of tables

Initial results:
      Table sizes (440 in total):
      41.1% TableSize "n == 0"
      21.1% TableSize "32 <= n < 64"
      13.4% TableSize "16 <= n < 32"
       8.9% TableSize "8 <= n < 16"
       7.5% TableSize "64 <= n < 128"
       2.7% TableSize "4 <= n < 8"
       2.3% TableSize "128 <= n < 256"
       2.0% TableSize "2 <= n < 4"
       0.7% TableSize "1 <= n < 2"
       0.2% TableSize "256 <= n < 512"

Again, it's not great that 40% of tables are empty. We'll try and
improve that. On the othe hand, the long tail is quite long, going out
over 100 elements.

Author: dcoutts

test/Database/LSMTree/Model/Normal.hs

@@ -30,6 +30,8 @@ module Database.LSMTree.Model.Normal (
   , snapshot
     -- * Multiple writable table handles
   , duplicate
+    -- * Testing
+  , size
   ) where
 
 import qualified Crypto.Hash.SHA256 as SHA256
@@ -61,6 +63,9 @@ type role Table nominal nominal nominal
 empty :: Table k v blob
 empty = Table Map.empty
 
+size :: Table k v blob -> Int
+size (Table m) = Map.size m
+
 -- | This instance is for testing and debugging only.
 instance
     (SerialiseKey k, SerialiseValue v, SerialiseValue blob)

test/Database/LSMTree/Model/Normal/Session.hs

@@ -24,12 +24,14 @@ module Database.LSMTree.Model.Normal.Session (
     Model (..)
   , initModel
   , UpdateCounter (..)
-    -- ** SomeTable
+    -- ** SomeTable, for testing
   , SomeTable (..)
   , toSomeTable
   , fromSomeTable
+  , withSomeTable
   , TableHandleID
   , tableHandleID
+  , Model.size
     -- ** Constraints
   , C
   , C_
@@ -139,6 +141,13 @@ fromSomeTable ::
   -> Maybe (Model.Table k v blob)
 fromSomeTable (SomeTable tbl) = cast tbl
 
+withSomeTable ::
+     (forall k v blob. (Typeable k, Typeable v, Typeable blob)
+                    => Model.Table k v blob -> a)
+  -> SomeTable
+  -> a
+withSomeTable f (SomeTable tbl) = f tbl
+
 newtype SomeCursor = SomeCursor Dynamic
 
 instance Show SomeCursor where

test/Test/Database/LSMTree/Normal/StateMachine.hs

@@ -673,12 +673,13 @@ instance ( Eq (Class.TableConfig h)
     -> ModelLookUp (ModelState h)
     -> ModelState h
     -> (ModelValue (ModelState h) a, ModelState h)
-  modelNextState action lookUp (ModelState mock stats) =
-      auxStats $ runModel lookUp action mock
+  modelNextState action lookUp (ModelState state stats) =
+      auxStats $ runModel lookUp action state
     where
       auxStats :: (Val h a, Model.Model) -> (Val h a, ModelState h)
-      auxStats (result, state') =
-          (result, ModelState state' $ updateStats action lookUp result stats)
+      auxStats (result, state') = (result, ModelState state' stats')
+        where
+          stats' = updateStats action lookUp state state' result stats
 
   usedVars :: LockstepAction (ModelState h) a -> [AnyGVar (ModelOp (ModelState h))]
   usedVars = \case
@@ -1315,6 +1316,10 @@ data Stats = Stats {
     -- === Final tags (per action sequence, per table)
     -- | Number of actions per table (succesful or failing)
   , numActionsPerTable :: !(Map Model.TableHandleID Int)
+    -- | The size of tables that were closed. This is used to augment the table
+    -- sizes from the final model state (which of course has only tables still
+    -- open in the final state).
+  , closedTableSizes   :: !(Map Model.TableHandleID Int)
   }
   deriving stock Show
 
@@ -1329,6 +1334,7 @@ initStats = Stats {
     , successActions = []
     , failActions = []
     , numActionsPerTable = Map.empty
+    , closedTableSizes   = Map.empty
     }
 
 updateStats ::
@@ -1340,10 +1346,12 @@ updateStats ::
      )
   => LockstepAction (ModelState h) a
   -> ModelLookUp (ModelState h)
+  -> Model.Model
+  -> Model.Model
   -> Val h a
   -> Stats
   -> Stats
-updateStats action lookUp result =
+updateStats action lookUp modelBefore _modelAfter result =
       -- === Tags
       updNewTableTypes
     . updSnapshotted
@@ -1353,6 +1361,7 @@ updateStats action lookUp result =
     . updSuccessActions
     . updFailActions
     . updNumActionsPerTable
+    . updClosedTableSizes
   where
     -- === Tags
 
@@ -1477,6 +1486,18 @@ updateStats action lookUp result =
                                                     (numActionsPerTable stats)
               }
 
+    updClosedTableSizes stats = case action of
+        Close tableVar
+          | MTableHandle th <- lookUp tableVar
+          , let tid          = Model.tableHandleID th
+            -- This lookup can fail if the table was already closed:
+          , Just (_, table) <- Map.lookup tid (Model.tableHandles modelBefore)
+          , let  tsize       = Model.withSomeTable Model.size table
+          -> stats {
+               closedTableSizes = Map.insert tid tsize (closedTableSizes stats)
+             }
+        _ -> stats
+
     getTableHandleId :: ModelValue (ModelState h) (WrapTableHandle h IO k v blob)
                      -> Model.TableHandleID
     getTableHandleId (MTableHandle th) = Model.tableHandleID th
@@ -1594,18 +1615,19 @@ data FinalTag =
     -- | Number of actions on each table
   | NumTableActions String
     -- | Total /logical/ size of a table
-  | TableSize String -- TODO: implement
+  | TableSize String
   deriving stock Show
 
 -- | This is run only after completing every action
 tagFinalState' :: Lockstep (ModelState h) -> [(String, [FinalTag])]
-tagFinalState' (getModel -> ModelState _ finalStats) = concat [
+tagFinalState' (getModel -> ModelState finalState finalStats) = concat [
       tagNumLookupsResults
     , tagNumUpdates
     , tagSuccessActions
     , tagFailActions
     , tagNumTables
     , tagNumTableActions
+    , tagTableSizes
     ]
   where
     tagNumLookupsResults = [
@@ -1640,6 +1662,15 @@ tagFinalState' (getModel -> ModelState _ finalStats) = concat [
         | n <- Map.elems (numActionsPerTable finalStats)
         ]
 
+    tagTableSizes =
+        [ ("Table sizes", [ TableSize (showPowersOf 2 size) ])
+        | let openSizes, closedSizes :: Map Model.TableHandleID Int
+              openSizes   = Model.withSomeTable Model.size . snd <$>
+                              Model.tableHandles finalState
+              closedSizes = closedTableSizes finalStats
+        , size <- Map.elems (openSizes `Map.union` closedSizes)
+        ]
+
 {-------------------------------------------------------------------------------
   Utils
 -------------------------------------------------------------------------------}