-
Notifications
You must be signed in to change notification settings - Fork 7
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Enable ordinary-index building without a page count bound
- Loading branch information
Showing
4 changed files
with
141 additions
and
38 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,117 @@ | ||
| {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} | ||
|
|
||
| {- HLINT ignore "Avoid restricted alias" -} | ||
|
|
||
| -- | Vectors with support for appending elements. | ||
| module Database.LSMTree.Internal.Vector.Growing | ||
| ( | ||
| GrowingVector, | ||
| new, | ||
| append, | ||
| unsafeFreeze | ||
| ) | ||
| where | ||
|
|
||
| import Prelude hiding (init, last, length) | ||
|
|
||
| import Control.Monad (when) | ||
| import Control.Monad.ST.Strict (ST) | ||
| import Data.Primitive.PrimVar (PrimVar, newPrimVar, readPrimVar, | ||
| writePrimVar) | ||
| import Data.STRef.Strict (STRef, newSTRef, readSTRef, writeSTRef) | ||
| import Data.Vector (Vector, force) | ||
| import qualified Data.Vector as Mutable (unsafeFreeze) | ||
| import Data.Vector.Mutable (MVector) | ||
| import qualified Data.Vector.Mutable as Mutable (grow, length, new, set, slice, | ||
| take) | ||
|
|
||
| {-| | ||
| A vector with support for appending elements. | ||
| Internally, the elements of a growing vector are stored in a buffer. This | ||
| buffer is automatically enlarged whenever this is needed for storing | ||
| additional elements. On each such enlargement, the size of the buffer is | ||
| multiplied by a power of 2, whose exponent is chosen just big enough to make | ||
| the final buffer size at least as high as the new vector length. | ||
| -} | ||
| data GrowingVector s a = GrowingVector | ||
| !(STRef s (MVector s a)) -- Reference to the buffer | ||
| !(PrimVar s Int) -- Reference to the length | ||
|
|
||
| -- | Creates a new, initially empty, vector. | ||
| new :: Int -- ^ Initial buffer size | ||
| -> ST s (GrowingVector s a) -- ^ Construction of the vector | ||
| new illegalInitialBufferSize | illegalInitialBufferSize <= 0 | ||
| = error "Initial buffer size not positive" | ||
| new initialBufferSize | ||
| = do | ||
| buffer <- Mutable.new initialBufferSize | ||
| bufferRef <- newSTRef buffer | ||
| lengthRef <- newPrimVar 0 | ||
| return (GrowingVector bufferRef lengthRef) | ||
|
|
||
| {-| | ||
| Appends a value a certain number of times to a vector. If a negative number | ||
| is provided as the count, the vector is not changed. | ||
| -} | ||
| append :: forall s a . GrowingVector s a -> Int -> a -> ST s () | ||
| append _ pseudoCount _ | pseudoCount <= 0 | ||
| = return () | ||
| append (GrowingVector bufferRef lengthRef) count val | ||
| = do | ||
| length <- readPrimVar lengthRef | ||
| makeRoom | ||
| buffer' <- readSTRef bufferRef | ||
| Mutable.set (Mutable.slice length count buffer') val | ||
| where | ||
|
|
||
| makeRoom :: ST s () | ||
| makeRoom = do | ||
| length <- readPrimVar lengthRef | ||
| when (count > maxBound - length) (error "New length too large") | ||
| buffer <- readSTRef bufferRef | ||
| let | ||
|
|
||
| bufferSize :: Int | ||
| !bufferSize = Mutable.length buffer | ||
|
|
||
| length' :: Int | ||
| !length' = length + count | ||
|
|
||
| when (bufferSize < length') $ do | ||
| let | ||
|
|
||
| higherBufferSizes :: [Int] | ||
| higherBufferSizes = tail (init ++ [last]) where | ||
|
|
||
| init :: [Int] | ||
| last :: Int | ||
| (init, last : _) = span (<= maxBound `div` 2) $ | ||
| iterate (* 2) bufferSize | ||
| {-NOTE: | ||
| In order to prevent overflow, we have to start with the | ||
| current buffer size here, although we know that it is | ||
| not sufficient. | ||
| -} | ||
|
|
||
| sufficientBufferSizes :: [Int] | ||
| sufficientBufferSizes = dropWhile (< length') higherBufferSizes | ||
|
|
||
| case sufficientBufferSizes of | ||
| [] | ||
| -> error "No sufficient buffer size available" | ||
| bufferSize' : _ | ||
| -> Mutable.grow buffer (bufferSize' - bufferSize) >>= | ||
| writeSTRef bufferRef | ||
| writePrimVar lengthRef length' | ||
|
|
||
| {-| | ||
| Turns a growing vector into an ordinary vector, thereby invalidating the | ||
| growing vector. Executing @unsafeFreeze vec@ is only safe when @vec@ is not | ||
| used afterwards. | ||
| -} | ||
| unsafeFreeze :: GrowingVector s a -> ST s (Vector a) | ||
| unsafeFreeze (GrowingVector bufferRef lengthRef) = do | ||
| buffer <- readSTRef bufferRef | ||
| length <- readPrimVar lengthRef | ||
| force <$> Mutable.unsafeFreeze (Mutable.take length buffer) |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters