wip

hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal.hs

@@ -48,7 +48,7 @@ ncqStorageOpen3 fp upd = do
   let ncqMinLog         = 1 * gigabytes
   let ncqMaxLog         = 32 * gigabytes
   let ncqWriteBlock     = max 128 $ ncqWriteQLen `div` 2
-  let ncqMaxCachedIndex = 16
+  let ncqMaxCachedIndex = 64
   let ncqMaxCachedData  = 64
   let ncqIdleThrsh      = 50.0
   let ncqPostponeMerge  = 300.0

hbs2-tests/test/NCQ3.hs

@@ -1,4 +1,5 @@
 {-# Language RecordWildCards #-}
+{-# Language MultiWayIf #-}
 module NCQ3 where
 
 import HBS2.Prelude.Plated
@@ -394,7 +395,7 @@ testNCQ3Lookup1 syn TestEnv{..} = do
 
   g <- liftIO MWC.createSystemRandom
 
-  let (opts, argz) = splitOpts [("-m",0)] syn
+  let (opts, argz) = splitOpts [("-m",0),("-M",0)] syn
 
   let n = headDef 100000 [ fromIntegral x | LitIntVal x <- argz ]
   let nt = max 2 . headDef 1 $ [ fromIntegral x | LitIntVal x <- drop 1 argz ]
@@ -402,6 +403,7 @@ testNCQ3Lookup1 syn TestEnv{..} = do
   let r = (64*1024, 256*1024)
 
   let merge = headDef False [ True | ListVal [StringLike "-m"] <- opts ]
+  let mergeFull = headDef False [ True | ListVal [StringLike "-M"] <- opts ]
 
   notice $ "insert" <+> pretty n <+> "random blocks of size" <+> parens (pretty r) <+> pretty opts
 
@@ -419,9 +421,15 @@ testNCQ3Lookup1 syn TestEnv{..} = do
 
     hs <- atomically $ STM.flushTQueue thashes
 
-    when merge do
-      notice "COMPACT INDEX"
-      ncqIndexCompactFull sto
+    let wrap m = if | mergeFull -> notice "full merge" >> ncqIndexCompactFull sto >> m
+                    | merge ->
+                       fix \next -> do
+                          notice "run ncqIndexCompactStep"
+                          left <- ncqIndexCompactStep sto
+                          m
+                          if left then next else none
+                    | otherwise -> m
+    wrap do
 
       idx <- readTVarIO (ncqState sto) <&> List.length . view #ncqStateIndex
 
@@ -429,6 +437,7 @@ testNCQ3Lookup1 syn TestEnv{..} = do
 
         tfound <- newTVarIO 0
 
+
         t0 <- getTimeCoarse
 
         liftIO $ pooledForConcurrentlyN_ nt hs $ \h -> do