Merge pull request #659 from IntersectMBO/jeltsch/unsliced-keys-in-ordinary-indexes

jeltsch · web-flow · commit 441f1948c4ab · 2025-04-01T20:22:24.000Z
Make ordinary indexes store their keys unsliced
diff --git a/src/Database/LSMTree/Internal/Index/Ordinary.hs b/src/Database/LSMTree/Internal/Index/Ordinary.hs
@@ -9,7 +9,7 @@
 module Database.LSMTree.Internal.Index.Ordinary
 (
     IndexOrdinary (IndexOrdinary),
-    toLastKeys,
+    toUnslicedLastKeys,
     search,
     sizeInPages,
     headerLBS,
@@ -41,6 +41,7 @@ import           Database.LSMTree.Internal.Page (NumPages (NumPages),
                      PageNo (PageNo), PageSpan (PageSpan))
 import           Database.LSMTree.Internal.Serialise
                      (SerialisedKey (SerialisedKey'))
+import           Database.LSMTree.Internal.Unsliced (Unsliced, makeUnslicedKey)
 import           Database.LSMTree.Internal.Vector (binarySearchL, mkPrimVector)
 
 {-|
@@ -66,22 +67,22 @@ supportedTypeAndVersion = 0x0101
     ascending order and must comprise at least one page for 'search' to be able
     to return a valid page span.
 -}
-newtype IndexOrdinary = IndexOrdinary (Vector SerialisedKey)
+newtype IndexOrdinary = IndexOrdinary (Vector (Unsliced SerialisedKey))
     deriving stock (Eq, Show)
 
 instance NFData IndexOrdinary where
 
-    rnf (IndexOrdinary lastKeys) = rnf lastKeys
+    rnf (IndexOrdinary unslicedLastKeys) = rnf unslicedLastKeys
 
-toLastKeys :: IndexOrdinary -> Vector SerialisedKey
-toLastKeys (IndexOrdinary lastKeys) = lastKeys
+toUnslicedLastKeys :: IndexOrdinary -> Vector (Unsliced SerialisedKey)
+toUnslicedLastKeys (IndexOrdinary unslicedLastKeys) = unslicedLastKeys
 
 {-|
     For a specification of this operation, see the documentation of [its
     type-agnostic version]('Database.LSMTree.Internal.Index.search').
 -}
 search :: SerialisedKey -> IndexOrdinary -> PageSpan
-search key (IndexOrdinary lastKeys)
+search key (IndexOrdinary unslicedLastKeys)
   -- TODO: ideally, we could assert that an index is never empty, but
   -- unfortunately we can not currently do this. Runs (and thefeore indexes)
   -- /can/ be empty if they were created by a last-level merge where all input
@@ -94,35 +95,35 @@ search key (IndexOrdinary lastKeys)
   | otherwise = assert (pageCount > 0) result where
 
     protoStart :: Int
-    !protoStart = binarySearchL lastKeys key
+    !protoStart = binarySearchL unslicedLastKeys (makeUnslicedKey key)
 
     pageCount :: Int
-    !pageCount = length lastKeys
+    !pageCount = length unslicedLastKeys
 
     result :: PageSpan
     result | protoStart < pageCount
                = let
 
-                     resultKey :: SerialisedKey
-                     !resultKey = lastKeys ! protoStart
+                     unslicedResultKey :: Unsliced SerialisedKey
+                     !unslicedResultKey = unslicedLastKeys ! protoStart
 
                      end :: Int
                      !end = maybe (pred pageCount) (+ protoStart) $
-                            findIndex (/= resultKey) $
-                            drop (succ protoStart) lastKeys
+                            findIndex (/= unslicedResultKey) $
+                            drop (succ protoStart) unslicedLastKeys
 
                  in PageSpan (PageNo $ protoStart)
                              (PageNo $ end)
            | otherwise
                = let
 
-                     resultKey :: SerialisedKey
-                     !resultKey = last lastKeys
+                     unslicedResultKey :: Unsliced SerialisedKey
+                     !unslicedResultKey = last unslicedLastKeys
 
                      start :: Int
                      !start = maybe 0 succ $
-                              findIndexR (/= resultKey) $
-                              lastKeys
+                              findIndexR (/= unslicedResultKey) $
+                              unslicedLastKeys
 
                  in PageSpan (PageNo $ start)
                              (PageNo $ pred pageCount)
@@ -132,7 +133,8 @@ search key (IndexOrdinary lastKeys)
     type-agnostic version]('Database.LSMTree.Internal.Index.sizeInPages').
 -}
 sizeInPages :: IndexOrdinary -> NumPages
-sizeInPages (IndexOrdinary lastKeys) = NumPages $ fromIntegral (length lastKeys)
+sizeInPages (IndexOrdinary unslicedLastKeys)
+    = NumPages $ fromIntegral (length unslicedLastKeys)
 
 {-|
     For a specification of this operation, see the documentation of [its
@@ -203,10 +205,11 @@ fromSBS shortByteString@(SBS unliftedByteArray)
         Primitive.Vector _ _ entryCountRep = Primitive.force entryCountBytes
 
     index :: Either String IndexOrdinary
-    index = IndexOrdinary <$> fromList <$> lastKeys lastKeysBytes
+    index = IndexOrdinary <$> fromList <$> unslicedLastKeys lastKeysBytes
 
-    lastKeys :: Primitive.Vector Word8 -> Either String [SerialisedKey]
-    lastKeys bytes
+    unslicedLastKeys :: Primitive.Vector Word8
+                     -> Either String [Unsliced SerialisedKey]
+    unslicedLastKeys bytes
         | Primitive.null bytes
             = Right []
         | otherwise
@@ -234,8 +237,8 @@ fromSBS shortByteString@(SBS unliftedByteArray)
                       (firstBytes, othersBytes)
                           = Primitive.splitAt firstSize postFirstSizeBytes
 
-                      first :: SerialisedKey
-                      !first = SerialisedKey' (Primitive.force firstBytes)
+                      first :: Unsliced SerialisedKey
+                      !first = makeUnslicedKey (SerialisedKey' firstBytes)
 
-                  others <- lastKeys othersBytes
+                  others <- unslicedLastKeys othersBytes
                   return (first : others)
diff --git a/src/Database/LSMTree/Internal/Index/OrdinaryAcc.hs b/src/Database/LSMTree/Internal/Index/OrdinaryAcc.hs
@@ -30,24 +30,26 @@ import           Database.LSMTree.Internal.Index.Ordinary
                      (IndexOrdinary (IndexOrdinary))
 import           Database.LSMTree.Internal.Serialise
                      (SerialisedKey (SerialisedKey'))
+import           Database.LSMTree.Internal.Unsliced (Unsliced, makeUnslicedKey)
 import           Database.LSMTree.Internal.Vector (byteVectorFromPrim)
 import           Database.LSMTree.Internal.Vector.Growing (GrowingVector)
 import qualified Database.LSMTree.Internal.Vector.Growing as Growing (append,
                      freeze, new)
 #ifdef NO_IGNORE_ASSERTS
+import           Database.LSMTree.Internal.Unsliced (fromUnslicedKey)
 import qualified Database.LSMTree.Internal.Vector.Growing as Growing
                      (readMaybeLast)
 #endif
 
 {-|
     A general-purpose fence pointer index under incremental construction.
 
-    A value @IndexOrdinaryAcc lastKeys baler@ denotes a partially constructed
-    index that assigns keys to pages according to @lastKeys@ and uses @baler@
-    for incremental output of the serialised key list.
+    A value @IndexOrdinaryAcc unslicedLastKeys baler@ denotes a partially
+    constructed index that assigns keys to pages according to @unslicedLastKeys@
+    and uses @baler@ for incremental output of the serialised key list.
 -}
 data IndexOrdinaryAcc s = IndexOrdinaryAcc
-                              !(GrowingVector s SerialisedKey)
+                              !(GrowingVector s (Unsliced SerialisedKey))
                               !(Baler s)
 
 -- | Creates a new, initially empty, index.
@@ -65,7 +67,7 @@ new initialKeyBufferSize minChunkSize = IndexOrdinaryAcc                 <$>
 newWithDefaults :: ST s (IndexOrdinaryAcc s)
 newWithDefaults = new 1024 4096
 
--- Yields the serialisation of an element of a key list.
+-- | Yields the serialisation of an element of a key list.
 keyListElem :: SerialisedKey -> [Primitive.Vector Word8]
 keyListElem (SerialisedKey' keyBytes) = [keySizeBytes, keyBytes] where
 
@@ -86,14 +88,16 @@ keyListElem (SerialisedKey' keyBytes) = [keySizeBytes, keyBytes] where
 appendSingle :: (SerialisedKey, SerialisedKey)
              -> IndexOrdinaryAcc s
              -> ST s (Maybe Chunk)
-appendSingle (firstKey, lastKey) (IndexOrdinaryAcc lastKeys baler)
+appendSingle (firstKey, lastKey) (IndexOrdinaryAcc unslicedLastKeys baler)
     = assert (firstKey <= lastKey) $
       do
 #ifdef NO_IGNORE_ASSERTS
-          maybeLastLastKey <- Growing.readMaybeLast lastKeys
-          assert (all (< firstKey) maybeLastLastKey) $ return ()
+          maybeLastUnslicedLastKey <- Growing.readMaybeLast unslicedLastKeys
+          assert
+              (all (< firstKey) (fromUnslicedKey <$> maybeLastUnslicedLastKey))
+              (return ())
 #endif
-          Growing.append lastKeys 1 lastKey
+          Growing.append unslicedLastKeys 1 (makeUnslicedKey lastKey)
           feedBaler (keyListElem lastKey) baler
 
 {-|
@@ -103,13 +107,14 @@ appendSingle (firstKey, lastKey) (IndexOrdinaryAcc lastKeys baler)
 appendMulti :: (SerialisedKey, Word32)
             -> IndexOrdinaryAcc s
             -> ST s [Chunk]
-appendMulti (key, overflowPageCount) (IndexOrdinaryAcc lastKeys baler)
+appendMulti (key, overflowPageCount) (IndexOrdinaryAcc unslicedLastKeys baler)
     = do
 #ifdef NO_IGNORE_ASSERTS
-          maybeLastLastKey <- Growing.readMaybeLast lastKeys
-          assert (all (< key) maybeLastLastKey) $ return ()
+          maybeLastUnslicedLastKey <- Growing.readMaybeLast unslicedLastKeys
+          assert (all (< key) (fromUnslicedKey <$> maybeLastUnslicedLastKey))
+                 (return ())
 #endif
-          Growing.append lastKeys pageCount key
+          Growing.append unslicedLastKeys pageCount (makeUnslicedKey key)
           maybeToList <$> feedBaler keyListElems baler
     where
 
@@ -124,7 +129,7 @@ appendMulti (key, overflowPageCount) (IndexOrdinaryAcc lastKeys baler)
     type-agnostic version]('Database.LSMTree.Internal.Index.unsafeEnd').
 -}
 unsafeEnd :: IndexOrdinaryAcc s -> ST s (Maybe Chunk, IndexOrdinary)
-unsafeEnd (IndexOrdinaryAcc lastKeys baler) = do
-    keys <- Growing.freeze lastKeys
+unsafeEnd (IndexOrdinaryAcc unslicedLastKeys baler) = do
+    frozenUnslicedLastKeys <- Growing.freeze unslicedLastKeys
     remnant <- unsafeEndBaler baler
-    return (remnant, IndexOrdinary keys)
+    return (remnant, IndexOrdinary frozenUnslicedLastKeys)
diff --git a/test/Test/Database/LSMTree/Internal/Index/Ordinary.hs b/test/Test/Database/LSMTree/Internal/Index/Ordinary.hs
