grow-vector (empty) → 0.1.0.0

raw patch · 7 files changed

+470/−0 lines, 7 filesdep +basedep +grow-vectordep +liquid-base

Dependencies added: base, grow-vector, liquid-base, liquid-vector, liquidhaskell, primitive, quickcheck-instances, tasty, tasty-discover, tasty-hspec, tasty-quickcheck, vector

Files

CHANGELOG.md +3/−0
LICENSE +19/−0
README.md +4/−0
grow-vector.cabal +61/−0
src/Data/Vector/Grow/Unboxed.hs +224/−0
test/Data/Vector/Grow/Unboxed/Test.hs +158/−0
test/Driver.hs +1/−0

+ CHANGELOG.md view

@@ -0,0 +1,3 @@+# 0.0.1.0++* Initial release

+ LICENSE view

@@ -0,0 +1,19 @@+Copyright (c) 2020 Anton Gushcha++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.

+ README.md view

@@ -0,0 +1,4 @@+# grow-vector++Mutable vector with efficient updates. Simple implementation on partially filled+array with capacity tracking and resizing.

+ grow-vector.cabal view

@@ -0,0 +1,61 @@+name:                grow-vector+synopsis:            Mutable vector with efficient appends+description:         Mutable vector with efficient updates. Simple implementation on partially filled array with capacity tracking and resizing.+version:             0.1.0.0+license:             MIT+license-file:        LICENSE+copyright:           2020 Anton Gushcha+maintainer:          Anton Gushcha <ncrashed@protonmail.com>+category:            Data+build-type:          Simple+cabal-version:       1.24+extra-source-files:+  README.md+  CHANGELOG.md++source-repository head+  type: git+  location: https://github.com/NCrashed/asteroids-arena(haskell/grow-vector)++flag liquidhaskell+  default: False+  manual: True+  description: Use liquid haskell to check sources++library+  hs-source-dirs:      src+  exposed-modules:+    Data.Vector.Grow.Unboxed++  build-depends:+      primitive     >= 0.7      && < 0.8++  if flag(liquidhaskell)+    ghc-options: -fplugin=LiquidHaskell+    build-depends:+        liquid-base+      , liquid-vector+      , liquidhaskell >= 0.8.10+  else+    build-depends:+        base          >= 4.5      && < 4.15+      , vector        >= 0.12     && < 0.13+  default-language:    Haskell2010++test-suite grow-vector-test+  default-language:    Haskell2010+  type:                exitcode-stdio-1.0+  main-is:             Driver.hs+  hs-source-dirs:      test+  other-modules:+      Data.Vector.Grow.Unboxed.Test+  ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      base+    , grow-vector+    , primitive+    , quickcheck-instances+    , tasty+    , tasty-discover+    , tasty-hspec+    , tasty-quickcheck

+ src/Data/Vector/Grow/Unboxed.hs view

@@ -0,0 +1,224 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-}+-- |+-- Module      : Data.Vector.Grow.Unboxed+-- Copyright   : (c) 2020 Gushcha Anton+-- License     : MIT+-- Maintainer  : ncrashed@protonmail.com+-- Stability   : unstable+-- Portability : non-portable+--+-- Module defines mutable vector that can grow in size automatically when an user+-- adds new elements at the end of vector.+--+-- We reallocate vector with 1.5x length to get amortized append.+module Data.Vector.Grow.Unboxed(+    GrowVector(..)+  , IOGrowVector+  -- * Quering info about vector+  , length+  , null+  , capacity+  -- * Creation+  , new+  , newSized+  -- * Quering subvectors+  , slice+  -- * Converting to immutable+  , thaw+  , freeze+  -- * Capacity maninuplation+  , ensure+  , ensureAppend+  -- * Accessing individual elements+  , read+  , write+  , unsafeRead+  , unsafeWrite+  -- * Appending to vector+  , pushBack+  , unsafePushBack+  ) where++import Control.Monad+import Control.Monad.Primitive+import Data.Primitive.MutVar+import Data.Vector.Unboxed.Mutable (MVector, Unbox)+import GHC.Generics+import Prelude hiding (length, null, read)++import qualified Data.Vector.Unboxed as U+import qualified Data.Vector.Unboxed.Mutable as M++-- | Grow vector that is wrap around mutable vector. We allocate partially filled+-- vector and grow it when there is no more space for new element.+data GrowVector s a = GrowVector {+  growVector         :: !(MutVar s (MVector s a))+, growVectorLength   :: !(MutVar s Int)+} deriving (Generic)++-- | Synonim for 'GrowVector' in 'IO' monad+type IOGrowVector a = GrowVector RealWorld a++-- | Return current capacity of the vector (amount of elements that it can fit without realloc)+capacity :: (Unbox a, PrimMonad m) => GrowVector (PrimState m) a -> m Int+capacity v = do+  mv <- readMutVar . growVector $! v+  pure $ M.length mv+{-# INLINE capacity #-}++-- | Return current amount of elements in the vector+length :: (Unbox a, PrimMonad m) => GrowVector (PrimState m) a -> m Int+length = readMutVar . growVectorLength+{-# INLINE length #-}++-- | Return 'True' if there is no elements inside the vector+null :: (Unbox a, PrimMonad m) => GrowVector (PrimState m) a -> m Bool+null = fmap (== 0) . length+{-# INLINE null #-}++-- | Allocation of new growable vector with given capacity.+new :: (Unbox a, PrimMonad m) => Int -> m (GrowVector (PrimState m) a)+new = newSized 0+{-# INLINE new #-}++-- | Allocation of new growable vector with given filled size and capacity.+-- Elements is not initialized. Capacity must be greater than filled size.+newSized :: (Unbox a, PrimMonad m) => Int -> Int -> m (GrowVector (PrimState m) a)+newSized n cap = GrowVector <$> (newMutVar =<< M.new cap) <*> newMutVar n+{-# INLINABLE newSized #-}++-- | Yield a part of mutable vector without copying it. The vector must contain at least i+n elements.+slice :: (Unbox a, PrimMonad m)+  => Int -- ^ i starting index+  -> Int -- ^ n number of elements+  -> GrowVector (PrimState m) a+  -> m (GrowVector (PrimState m) a)+slice i n v = do+  newSize <- newMutVar n+  mv <- readMutVar . growVector $! v+  newVec <- newMutVar $! M.slice i n mv+  pure $! GrowVector newVec newSize+{-# INLINABLE slice #-}++-- | Convert immutable vector to grow mutable version. Doesn't allocate additonal memory for appending,+-- use 'ensure' to add capacity to the vector.+thaw :: (Unbox a, PrimMonad m)+  => U.Vector a+  -> m (GrowVector (PrimState m) a)+thaw u = do+  mv <- newMutVar =<< U.thaw u+  lv <- newMutVar (U.length u)+  pure $ GrowVector mv lv+{-# INLINABLE thaw #-}++-- | Freezing growable vector. It will contain only actual elements of the vector not including capacity+-- space, but you should call 'U.force' on resulting vector to not hold the allocated capacity of original+-- vector in memory.+freeze :: (Unbox a, PrimMonad m)+  => GrowVector (PrimState m) a+  -> m (U.Vector a)+freeze v = do+  n <- length v+  mv <- readMutVar . growVector $! v+  U.freeze . M.take n $! mv+{-# INLINABLE freeze #-}++-- | Ensure that grow vector has at least given capacity possibly with reallocation.+ensure :: (Unbox a, PrimMonad m)+  => GrowVector (PrimState m) a+  -> Int+  -> m ()+ensure v n = do+  c <- capacity v+  unless (c >= n) $ do+    mv <- readMutVar . growVector $! v+    writeMutVar (growVector v) =<< M.grow mv (n - c)+{-# INLINABLE ensure #-}++-- | Ensure that grow vector has enough space for additonal n elements.+-- We grow vector by 1.5 factor or by+ensureAppend :: (Unbox a, PrimMonad m)+  => GrowVector (PrimState m) a+  -> Int -- ^ Additional n elements+  -> m ()+ensureAppend v i = do+  n <- readMutVar . growVectorLength $! v+  mv <- readMutVar . growVector $! v+  let c = M.length mv+  unless (c >= n + i) $ do+    let growFactor = 1.5+        newCap = ceiling $ max (growFactor * fromIntegral c) (fromIntegral c + growFactor * fromIntegral (n + i - c))+    writeMutVar (growVector v) =<< M.grow mv (newCap - c)+{-# INLINABLE ensureAppend #-}++-- | Read element from vector at given index.+read :: (Unbox a, PrimMonad m)+  => GrowVector (PrimState m) a+  -> Int -- ^ Index of element. Must be in [0 .. length) range+  -> m a+read v i = do+  n <- readMutVar . growVectorLength $! v+  when (i < 0 || i >= n) $ error $ "GrowVector.read: index " <> show i <> " is out bounds " <> show n+  mv <- readMutVar . growVector $! v+  M.unsafeRead mv i+{-# INLINABLE read #-}++-- | Read element from vector at given index.+unsafeRead :: (Unbox a, PrimMonad m)+  => GrowVector (PrimState m) a+  -> Int -- ^ Index of element. Must be in [0 .. length) range+  -> m a+unsafeRead v i = do+  mv <- readMutVar . growVector $! v+  M.unsafeRead mv i+{-# INLINABLE unsafeRead #-}++-- | Write down element in the vector at given index.+write :: (Unbox a, PrimMonad m)+  => GrowVector (PrimState m) a+  -> Int -- ^ Index of element. Must be in [0 .. length) range+  -> a+  -> m ()+write v i a = do+  n <- readMutVar . growVectorLength $! v+  when (i < 0 || i >= n) $ error $ "GrowVector.write: index " <> show i <> " is out bounds " <> show n+  mv <- readMutVar . growVector $! v+  M.unsafeWrite mv i a+{-# INLINABLE write #-}++-- | Write down element in the vector at given index.+unsafeWrite :: (Unbox a, PrimMonad m)+  => GrowVector (PrimState m) a+  -> Int -- ^ Index of element. Must be in [0 .. length) range+  -> a+  -> m ()+unsafeWrite v i a = do+  mv <- readMutVar . growVector $! v+  M.unsafeWrite mv i a+{-# INLINABLE unsafeWrite #-}++-- | O(1) amortized appending to vector+pushBack :: (Unbox a, PrimMonad m)+  => GrowVector (PrimState m) a+  -> a+  -> m ()+pushBack v a = do+  ensureAppend v 1+  unsafePushBack v a+{-# INLINABLE pushBack #-}++-- | O(1) amortized appending to vector. Doesn't reallocate vector, so+-- there must by capacity - length >= 1.+unsafePushBack :: (Unbox a, PrimMonad m)+  => GrowVector (PrimState m) a+  -> a+  -> m ()+unsafePushBack v a = do+  n <- readMutVar . growVectorLength $! v+  mv <- readMutVar . growVector $! v+  M.write mv n a+  writeMutVar (growVectorLength v) (n+1)+{-# INLINABLE unsafePushBack #-}

+ test/Data/Vector/Grow/Unboxed/Test.hs view

@@ -0,0 +1,158 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE OverloadedLists #-}+module Data.Vector.Grow.Unboxed.Test where++import Control.Monad.Primitive (RealWorld)+import Data.Vector.Grow.Unboxed (GrowVector)+import qualified Data.Vector.Grow.Unboxed as U++import Test.Tasty.Hspec++spec_creation :: Spec+spec_creation = describe "vector creation" $ do+  it "initialized with right size" $ do+    v :: GrowVector RealWorld Int <- U.new 42+    l <- U.length v+    l `shouldBe` 0+    c <- U.capacity v+    c `shouldBe` 42+    r <- U.null v+    r `shouldBe` True+  it "preallocated initialized with right size" $ do+    v :: GrowVector RealWorld Int <- U.newSized 23 42+    l <- U.length v+    l `shouldBe` 23+    c <- U.capacity v+    c `shouldBe` 42+    r <- U.null v+    r `shouldBe` False++spec_slicing :: Spec+spec_slicing = describe "vector slicing" $ do+  it "simple slice" $ do+    v :: GrowVector RealWorld Int <- U.thaw [1, 2, 3, 4, 5]+    v' <- U.slice 1 2 v+    vf <- U.freeze v'+    vf `shouldBe` [2, 3]+  it "empty slice" $ do+    v :: GrowVector RealWorld Int <- U.thaw [1, 2, 3, 4, 5]+    v' <- U.slice 1 0 v+    vf <- U.freeze v'+    vf `shouldBe` []+  it "begin slice" $ do+    v :: GrowVector RealWorld Int <- U.thaw [1, 2, 3, 4, 5]+    v' <- U.slice 0 1 v+    vf <- U.freeze v'+    vf `shouldBe` [1]+  it "end slice" $ do+    v :: GrowVector RealWorld Int <- U.thaw [1, 2, 3, 4, 5]+    v' <- U.slice 4 1 v+    vf <- U.freeze v'+    vf `shouldBe` [5]+  it "mutating parent slice" $ do+    v :: GrowVector RealWorld Int <- U.thaw [1, 2, 3, 4, 5]+    v' <- U.slice 1 2 v+    vf1 <- U.freeze v'+    vf1 `shouldBe` [2, 3]+    U.write v 2 4+    vf2 <- U.freeze v'+    vf2 `shouldBe` [2, 4]++spec_readWrite :: Spec+spec_readWrite = describe "basic read write" $ do+  it "read elements" $ do+    v :: GrowVector RealWorld Int <- U.thaw [1, 2, 3, 4, 5]+    a1 <- U.read v 0+    a1 `shouldBe` 1+    a2 <- U.read v 1+    a2 `shouldBe` 2+    a3 <- U.read v 2+    a3 `shouldBe` 3+    a4 <- U.read v 4+    a4 `shouldBe` 5+  it "writes elements" $ do+    v :: GrowVector RealWorld Int <- U.newSized 2 2+    U.write v 0 1+    U.write v 1 2+    v' <- U.freeze v+    v' `shouldBe` [1, 2]+  it "write-read indemponent" $ do+    v :: GrowVector RealWorld Int <- U.newSized 1 1+    U.write v 0 424242+    a <- U.read v 0+    a `shouldBe` 424242++spec_ensure :: Spec+spec_ensure = describe "capacity realloc" $ do+  it "ensure reallocates properly" $ do+    v :: GrowVector RealWorld Int <- U.new 5+    U.ensure v 1+    c1 <- U.capacity v+    c1 `shouldBe` 5+    U.ensure v 6+    c2 <- U.capacity v+    c2 `shouldBe` 6+  it "ensureAppend reallocates properly" $ do+    v :: GrowVector RealWorld Int <- U.new 5+    U.ensureAppend v 1+    c1 <- U.capacity v+    c1 `shouldBe` 5+    U.ensureAppend v 6+    c2 <- U.capacity v+    c2 `shouldBe` 8+    U.ensureAppend v 14+    c3 <- U.capacity v+    c3 `shouldBe` 17++spec_pushBack :: Spec+spec_pushBack = describe "push back operations" $ do+  it "push simple" $ do+    v :: GrowVector RealWorld Int <- U.new 1+    U.pushBack v 1+    l1 <- U.length v+    c1 <- U.capacity v+    l1 `shouldBe` 1+    c1 `shouldBe` 1+    U.pushBack v 2+    l2 <- U.length v+    c2 <- U.capacity v+    l2 `shouldBe` 2+    c2 `shouldBe` 3+    U.pushBack v 3+    l3 <- U.length v+    c3 <- U.capacity v+    l3 `shouldBe` 3+    c3 `shouldBe` 3+    U.pushBack v 4+    l4 <- U.length v+    c4 <- U.capacity v+    l4 `shouldBe` 4+    c4 `shouldBe` 5+    v' <- U.freeze v+    v' `shouldBe` [1, 2, 3, 4]+  it "push unsafe" $ do+    v :: GrowVector RealWorld Int <- U.new 1+    U.unsafePushBack v 1+    l1 <- U.length v+    c1 <- U.capacity v+    l1 `shouldBe` 1+    c1 `shouldBe` 1+    U.ensureAppend v 1+    U.unsafePushBack v 2+    l2 <- U.length v+    c2 <- U.capacity v+    l2 `shouldBe` 2+    c2 `shouldBe` 3+    U.unsafePushBack v 3+    l3 <- U.length v+    c3 <- U.capacity v+    l3 `shouldBe` 3+    c3 `shouldBe` 3+    U.ensureAppend v 1+    U.unsafePushBack v 4+    l4 <- U.length v+    c4 <- U.capacity v+    l4 `shouldBe` 4+    c4 `shouldBe` 5+    v' <- U.freeze v+    v' `shouldBe` [1, 2, 3, 4]

+ test/Driver.hs view

@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF tasty-discover #-}