{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LinearTypes #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE UnboxedTuples #-}
{-# OPTIONS_GHC -Wno-unbanged-strict-patterns #-}

-- | Mutable vectors with a linear API.
--
-- Vectors are arrays that grow automatically, that you can append to with
-- 'push'. They never shrink automatically to reduce unnecessary copying,
-- use 'shrinkToFit' to get rid of the wasted space.
--
-- To use mutable vectors, create a linear computation of type
-- @Vector a %1-> Ur b@ and feed it to 'constant' or 'fromList'.
--
-- == Example
--
-- >>> :set -XLinearTypes
-- >>> import Prelude.Linear
-- >>> import qualified Data.Vector.Mutable.Linear as Vector
-- >>> :{
--  isFirstZero :: Vector.Vector Int %1-> Ur Bool
--  isFirstZero vec =
--    Vector.get 0 vec
--      & \(Ur ret, vec) -> vec `lseq` Ur (ret == 0)
-- :}
--
-- >>> unur $ Vector.fromList [0..10] isFirstZero
-- True
-- >>> unur $ Vector.fromList [1,2,3] isFirstZero
-- False
module Data.Vector.Mutable.Linear
  ( -- * A mutable vector
    Vector,
    -- * Run a computation with a vector
    empty,
    constant,
    fromList,
    -- * Mutators
    set,
    unsafeSet,
    modify,
    modify_,
    push,
    pop,
    filter,
    mapMaybe,
    slice,
    shrinkToFit,
    -- * Accessors
    get,
    unsafeGet,
    size,
    capacity,
    toList,
    freeze,
    -- * Mutable-style interface
    read,
    unsafeRead,
    write,
    unsafeWrite
  )
where

import GHC.Stack
import Prelude.Linear hiding (read, filter, mapMaybe)
import Data.Array.Mutable.Linear (Array)
import qualified Prelude
import Data.Monoid.Linear
import qualified Data.Array.Mutable.Linear as Array
import qualified Data.Functor.Linear as Data
import qualified Unsafe.Linear as Unsafe
import qualified Data.Vector as Vector

-- # Constants
-------------------------------------------------------------------------------

-- | When growing the vector, capacity will be multiplied by this number.
--
-- This is usually chosen between 1.5 and 2; 2 being the most common.
constGrowthFactor :: Int
constGrowthFactor :: Int
constGrowthFactor = Int
2

-- # Core data types
-------------------------------------------------------------------------------

-- | A dynamic mutable vector.
data Vector a where
  Vec ::
    -- ^ Current size
    Int ->
    -- ^ Underlying array (has size equal to or larger than the vectors)
    Array a %1->
    Vector a

-- # API: Construction, Mutation, Queries
-------------------------------------------------------------------------------

-- | Create a 'Vector' from an 'Array'. Result will have the size and capacity
-- equal to the size of the given array.
--
-- This is a constant time operation.
fromArray :: HasCallStack => Array a %1-> Vector a
fromArray :: forall a. HasCallStack => Array a %1 -> Vector a
fromArray Array a
arr =
  Array a %1 -> (Ur Int, Array a)
forall a. Array a %1 -> (Ur Int, Array a)
Array.size Array a
arr
    (Ur Int, Array a)
%1 -> ((Ur Int, Array a) %1 -> Vector a) %1 -> Vector a
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \(Ur Int
size', Array a
arr') -> Int -> Array a %1 -> Vector a
forall a. Int -> Array a -> Vector a
Vec Int
size' Array a
arr'

-- Allocate an empty vector
empty :: (Vector a %1-> Ur b) %1-> Ur b
empty :: forall a b. (Vector a %1 -> Ur b) %1 -> Ur b
empty Vector a %1 -> Ur b
f = [a] -> (Array a %1 -> Ur b) %1 -> Ur b
forall a b. HasCallStack => [a] -> (Array a %1 -> Ur b) %1 -> Ur b
Array.fromList [] (Vector a %1 -> Ur b
f (Vector a %1 -> Ur b)
%1 -> (Array a %1 -> Vector a) %1 -> Array a %1 -> Ur b
forall b c a. (b %1 -> c) %1 -> (a %1 -> b) %1 -> a %1 -> c
. Array a %1 -> Vector a
forall a. HasCallStack => Array a %1 -> Vector a
fromArray)

-- | Allocate a constant vector of a given non-negative size (and error on a
-- bad size)
constant :: HasCallStack =>
  Int -> a -> (Vector a %1-> Ur b) %1-> Ur b
constant :: forall a b.
HasCallStack =>
Int -> a -> (Vector a %1 -> Ur b) %1 -> Ur b
constant Int
size' a
x Vector a %1 -> Ur b
f
  | Int
size' Int %1 -> Int %1 -> Bool
forall a. Ord a => a %1 -> a %1 -> Bool
< Int
0 =
      ([Char] -> x %1 -> x
forall a. HasCallStack => [Char] -> a
error ([Char]
"Trying to construct a vector of size " [Char] %1 -> [Char] %1 -> [Char]
forall a. [a] %1 -> [a] %1 -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
size') :: x %1-> x)
      (Vector a %1 -> Ur b
f Vector a
forall a. HasCallStack => a
undefined)
  | Bool
otherwise = Int -> a -> (Array a %1 -> Ur b) %1 -> Ur b
forall a b.
HasCallStack =>
Int -> a -> (Array a %1 -> Ur b) %1 -> Ur b
Array.alloc Int
size' a
x (Vector a %1 -> Ur b
f (Vector a %1 -> Ur b)
%1 -> (Array a %1 -> Vector a) %1 -> Array a %1 -> Ur b
forall b c a. (b %1 -> c) %1 -> (a %1 -> b) %1 -> a %1 -> c
. Array a %1 -> Vector a
forall a. HasCallStack => Array a %1 -> Vector a
fromArray)

-- | Allocator from a list
fromList :: HasCallStack => [a] -> (Vector a %1-> Ur b) %1-> Ur b
fromList :: forall a b. HasCallStack => [a] -> (Vector a %1 -> Ur b) %1 -> Ur b
fromList [a]
xs Vector a %1 -> Ur b
f = [a] -> (Array a %1 -> Ur b) %1 -> Ur b
forall a b. HasCallStack => [a] -> (Array a %1 -> Ur b) %1 -> Ur b
Array.fromList [a]
xs (Vector a %1 -> Ur b
f (Vector a %1 -> Ur b)
%1 -> (Array a %1 -> Vector a) %1 -> Array a %1 -> Ur b
forall b c a. (b %1 -> c) %1 -> (a %1 -> b) %1 -> a %1 -> c
. Array a %1 -> Vector a
forall a. HasCallStack => Array a %1 -> Vector a
fromArray)

-- | Number of elements inside the vector.
--
-- This might be different than how much actual memory the vector is using.
-- For that, see: 'capacity'.
size :: Vector a %1-> (Ur Int, Vector a)
size :: forall a. Vector a %1 -> (Ur Int, Vector a)
size (Vec Int
size' Array a
arr) = (Int -> Ur Int
forall a. a -> Ur a
Ur Int
size', Int -> Array a %1 -> Vector a
forall a. Int -> Array a -> Vector a
Vec Int
size' Array a
arr)

-- | Capacity of a vector. In other words, the number of elements
-- the vector can contain before it is copied to a bigger array.
capacity :: Vector a %1-> (Ur Int, Vector a)
capacity :: forall a. Vector a %1 -> (Ur Int, Vector a)
capacity (Vec Int
s Array a
arr) =
  Array a %1 -> (Ur Int, Array a)
forall a. Array a %1 -> (Ur Int, Array a)
Array.size Array a
arr (Ur Int, Array a)
%1 -> ((Ur Int, Array a) %1 -> (Ur Int, Vector a))
%1 -> (Ur Int, Vector a)
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \(Ur Int
cap, Array a
arr') -> (Ur Int
cap, Int -> Array a %1 -> Vector a
forall a. Int -> Array a -> Vector a
Vec Int
s Array a
arr')

-- | Insert at the end of the vector. This will grow the vector if there
-- is no empty space.
push :: a -> Vector a %1-> Vector a
push :: forall a. a -> Vector a %1 -> Vector a
push a
x Vector a
vec =
  Int -> Vector a %1 -> Vector a
forall a. HasCallStack => Int -> Vector a %1 -> Vector a
growToFit Int
1 Vector a
vec Vector a %1 -> (Vector a %1 -> Vector a) %1 -> Vector a
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \(Vec Int
s Array a
arr) ->
    Int -> a -> Vector a %1 -> Vector a
forall a. HasCallStack => Int -> a -> Vector a %1 -> Vector a
unsafeSet Int
s a
x (Int -> Array a %1 -> Vector a
forall a. Int -> Array a -> Vector a
Vec (Int
s Int %1 -> Int %1 -> Int
forall a. Additive a => a %1 -> a %1 -> a
+ Int
1) Array a
arr)

-- | Pop from the end of the vector. This will never shrink the vector, use
-- 'shrinkToFit' to remove the wasted space.
pop :: Vector a %1-> (Ur (Maybe a), Vector a)
pop :: forall a. Vector a %1 -> (Ur (Maybe a), Vector a)
pop Vector a
vec =
  Vector a %1 -> (Ur Int, Vector a)
forall a. Vector a %1 -> (Ur Int, Vector a)
size Vector a
vec (Ur Int, Vector a)
%1 -> ((Ur Int, Vector a) %1 -> (Ur (Maybe a), Vector a))
%1 -> (Ur (Maybe a), Vector a)
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \case
    (Ur Int
0, Vector a
vec') ->
      (Maybe a -> Ur (Maybe a)
forall a. a -> Ur a
Ur Maybe a
forall a. Maybe a
Nothing, Vector a
vec')
    (Ur Int
s, Vector a
vec') ->
      Int -> Vector a %1 -> (Ur a, Vector a)
forall a. HasCallStack => Int -> Vector a %1 -> (Ur a, Vector a)
get (Int
sInt %1 -> Int %1 -> Int
forall a. AdditiveGroup a => a %1 -> a %1 -> a
-Int
1) Vector a
vec' (Ur a, Vector a)
%1 -> ((Ur a, Vector a) %1 -> (Ur (Maybe a), Vector a))
%1 -> (Ur (Maybe a), Vector a)
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \(Ur a
a, Vec Int
_ Array a
arr) ->
        ( Maybe a -> Ur (Maybe a)
forall a. a -> Ur a
Ur (a -> Maybe a
forall a. a -> Maybe a
Just a
a)
        , Int -> Array a %1 -> Vector a
forall a. Int -> Array a -> Vector a
Vec (Int
sInt %1 -> Int %1 -> Int
forall a. AdditiveGroup a => a %1 -> a %1 -> a
-Int
1) Array a
arr
        )

-- | Write to an element . Note: this will not write to elements beyond the
-- current size of the vector and will error instead.
set :: HasCallStack => Int -> a -> Vector a %1-> Vector a
set :: forall a. HasCallStack => Int -> a -> Vector a %1 -> Vector a
set Int
ix a
val Vector a
vec =
  Int -> a -> Vector a %1 -> Vector a
forall a. HasCallStack => Int -> a -> Vector a %1 -> Vector a
unsafeSet Int
ix a
val (Int -> Vector a %1 -> Vector a
forall a. HasCallStack => Int -> Vector a %1 -> Vector a
assertIndexInRange Int
ix Vector a
vec)

-- | Same as 'write', but does not do bounds-checking. The behaviour is undefined
-- when passed an invalid index.
unsafeSet :: HasCallStack => Int -> a -> Vector a %1-> Vector a
unsafeSet :: forall a. HasCallStack => Int -> a -> Vector a %1 -> Vector a
unsafeSet Int
ix a
val (Vec Int
size' Array a
arr) =
  Int -> Array a %1 -> Vector a
forall a. Int -> Array a -> Vector a
Vec Int
size' (Int -> a -> Array a %1 -> Array a
forall a. Int -> a -> Array a %1 -> Array a
Array.unsafeSet Int
ix a
val Array a
arr)

-- | Read from a vector, with an in-range index and error for an index that is
-- out of range (with the usual range @0..size-1@).
get :: HasCallStack => Int -> Vector a %1-> (Ur a, Vector a)
get :: forall a. HasCallStack => Int -> Vector a %1 -> (Ur a, Vector a)
get Int
ix Vector a
vec =
  Int -> Vector a %1 -> (Ur a, Vector a)
forall a. HasCallStack => Int -> Vector a %1 -> (Ur a, Vector a)
unsafeGet Int
ix (Int -> Vector a %1 -> Vector a
forall a. HasCallStack => Int -> Vector a %1 -> Vector a
assertIndexInRange Int
ix Vector a
vec)

-- | Same as 'read', but does not do bounds-checking. The behaviour is undefined
-- when passed an invalid index.
unsafeGet :: HasCallStack => Int -> Vector a %1-> (Ur a, Vector a)
unsafeGet :: forall a. HasCallStack => Int -> Vector a %1 -> (Ur a, Vector a)
unsafeGet Int
ix (Vec Int
size' Array a
arr) =
  Int -> Array a %1 -> (Ur a, Array a)
forall a. Int -> Array a %1 -> (Ur a, Array a)
Array.unsafeGet Int
ix Array a
arr
    (Ur a, Array a)
%1 -> ((Ur a, Array a) %1 -> (Ur a, Vector a))
%1 -> (Ur a, Vector a)
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \(Ur a
val, Array a
arr') -> (Ur a
val, Int -> Array a %1 -> Vector a
forall a. Int -> Array a -> Vector a
Vec Int
size' Array a
arr')

-- | Same as 'modify', but does not do bounds-checking.
unsafeModify :: HasCallStack => (a -> (a, b)) -> Int
             -> Vector a %1-> (Ur b, Vector a)
unsafeModify :: forall a b.
HasCallStack =>
(a -> (a, b)) -> Int -> Vector a %1 -> (Ur b, Vector a)
unsafeModify a -> (a, b)
f Int
ix (Vec Int
size' Array a
arr) =
  Int -> Array a %1 -> (Ur a, Array a)
forall a. Int -> Array a %1 -> (Ur a, Array a)
Array.unsafeGet Int
ix Array a
arr (Ur a, Array a)
%1 -> ((Ur a, Array a) %1 -> (Ur b, Vector a))
%1 -> (Ur b, Vector a)
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \(Ur a
old, Array a
arr') ->
    case a -> (a, b)
f a
old of
      (a
a, b
b) -> Int -> a -> Array a %1 -> Array a
forall a. Int -> a -> Array a %1 -> Array a
Array.unsafeSet Int
ix a
a Array a
arr' Array a
%1 -> (Array a %1 -> (Ur b, Vector a)) %1 -> (Ur b, Vector a)
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \Array a
arr'' ->
        (b -> Ur b
forall a. a -> Ur a
Ur b
b, Int -> Array a %1 -> Vector a
forall a. Int -> Array a -> Vector a
Vec Int
size' Array a
arr'')

-- | Modify a value inside a vector, with an ability to return an extra
-- information. Errors if the index is out of bounds.
modify :: HasCallStack => (a -> (a, b)) -> Int
       -> Vector a %1-> (Ur b, Vector a)
modify :: forall a b.
HasCallStack =>
(a -> (a, b)) -> Int -> Vector a %1 -> (Ur b, Vector a)
modify a -> (a, b)
f Int
ix Vector a
vec = (a -> (a, b)) -> Int -> Vector a %1 -> (Ur b, Vector a)
forall a b.
HasCallStack =>
(a -> (a, b)) -> Int -> Vector a %1 -> (Ur b, Vector a)
unsafeModify a -> (a, b)
f Int
ix (Int -> Vector a %1 -> Vector a
forall a. HasCallStack => Int -> Vector a %1 -> Vector a
assertIndexInRange Int
ix Vector a
vec)

-- | Same as 'modify', but without the ability to return extra information.
modify_ :: HasCallStack => (a -> a) -> Int -> Vector a %1-> Vector a
modify_ :: forall a.
HasCallStack =>
(a -> a) -> Int -> Vector a %1 -> Vector a
modify_ a -> a
f Int
ix Vector a
vec =
  (a -> (a, ())) -> Int -> Vector a %1 -> (Ur (), Vector a)
forall a b.
HasCallStack =>
(a -> (a, b)) -> Int -> Vector a %1 -> (Ur b, Vector a)
modify (\a
a -> (a -> a
f a
a, ())) Int
ix Vector a
vec
    (Ur (), Vector a)
%1 -> ((Ur (), Vector a) %1 -> Vector a) %1 -> Vector a
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \(Ur (), Vector a
vec') -> Vector a
vec'

-- | Return the vector elements as a lazy list.
toList :: Vector a %1-> Ur [a]
toList :: forall a. Vector a %1 -> Ur [a]
toList (Vec Int
s Array a
arr) =
  Array a %1 -> Ur [a]
forall a. Array a %1 -> Ur [a]
Array.toList Array a
arr Ur [a] %1 -> (Ur [a] %1 -> Ur [a]) %1 -> Ur [a]
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \(Ur [a]
xs) ->
    [a] -> Ur [a]
forall a. a -> Ur a
Ur (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
Prelude.take Int
s [a]
xs)

-- | Filters the vector in-place. It does not deallocate unused capacity,
-- use 'shrinkToFit' for that if necessary.
filter :: Vector a %1-> (a -> Bool) -> Vector a
filter :: forall a. Vector a %1 -> (a -> Bool) -> Vector a
filter Vector a
v a -> Bool
f = Vector a %1 -> (a -> Maybe a) -> Vector a
forall a b. Vector a %1 -> (a -> Maybe b) -> Vector b
mapMaybe Vector a
v (\a
a -> if a -> Bool
f a
a then a -> Maybe a
forall a. a -> Maybe a
Just a
a else Maybe a
forall a. Maybe a
Nothing)
-- TODO A slightly more efficient version exists, where we skip the writes
-- until the first time the predicate fails. However that requires duplicating
-- most of the logic at `mapMaybe`, so lets not until we have benchmarks to
-- see the advantage.

-- | A version of 'fmap' which can throw out elements.
mapMaybe :: Vector a %1-> (a -> Maybe b) -> Vector b
mapMaybe :: forall a b. Vector a %1 -> (a -> Maybe b) -> Vector b
mapMaybe Vector a
vec (a -> Maybe b
f :: a -> Maybe b) =
  Vector a %1 -> (Ur Int, Vector a)
forall a. Vector a %1 -> (Ur Int, Vector a)
size Vector a
vec (Ur Int, Vector a)
%1 -> ((Ur Int, Vector a) %1 -> Vector b) %1 -> Vector b
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \(Ur Int
s, Vector a
vec') -> Int -> Int -> Int -> Vector a %1 -> Vector b
go Int
0 Int
0 Int
s Vector a
vec'
 where
  go :: Int -- ^ read cursor
     -> Int -- ^ write cursor
     -> Int -- ^ input size
     -> Vector a %1-> Vector b
  go :: Int -> Int -> Int -> Vector a %1 -> Vector b
go Int
r Int
w Int
s Vector a
vec'
    -- If we processed all elements, set the capacity after the last written
    -- index and coerce the result to the correct type.
    | Int
r Int %1 -> Int %1 -> Bool
forall a. Eq a => a %1 -> a %1 -> Bool
== Int
s =
        Vector a
vec' Vector a %1 -> (Vector a %1 -> Vector b) %1 -> Vector b
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \(Vec Int
_ Array a
arr) ->
          Int -> Array b %1 -> Vector b
forall a. Int -> Array a -> Vector a
Vec Int
w (Array a %1 -> Array b
forall a b. a %1 -> b
Unsafe.coerce Array a
arr)
    -- Otherwise, read an element, write if the predicate is true and advance
    -- the write cursor; otherwise keep the write cursor skipping the element.
    | Bool
otherwise =
        Int -> Vector a %1 -> (Ur a, Vector a)
forall a. HasCallStack => Int -> Vector a %1 -> (Ur a, Vector a)
unsafeGet Int
r Vector a
vec' (Ur a, Vector a)
%1 -> ((Ur a, Vector a) %1 -> Vector b) %1 -> Vector b
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \case
          (Ur a
a, Vector a
vec'')
            | Just b
b <- a -> Maybe b
f a
a ->
                Int -> Int -> Int -> Vector a %1 -> Vector b
go (Int
rInt %1 -> Int %1 -> Int
forall a. Additive a => a %1 -> a %1 -> a
+Int
1) (Int
wInt %1 -> Int %1 -> Int
forall a. Additive a => a %1 -> a %1 -> a
+Int
1) Int
s (Int -> a -> Vector a %1 -> Vector a
forall a. HasCallStack => Int -> a -> Vector a %1 -> Vector a
unsafeSet Int
w (b %1 -> a
forall a b. a %1 -> b
Unsafe.coerce b
b) Vector a
vec'')
            | Bool
otherwise ->
                Int -> Int -> Int -> Vector a %1 -> Vector b
go (Int
rInt %1 -> Int %1 -> Int
forall a. Additive a => a %1 -> a %1 -> a
+Int
1) Int
w Int
s Vector a
vec''

-- | Resize the vector to not have any wasted memory (size == capacity). This
-- returns a semantically identical vector.
shrinkToFit :: Vector a %1-> Vector a
shrinkToFit :: forall a. Vector a %1 -> Vector a
shrinkToFit Vector a
vec =
  Vector a %1 -> (Ur Int, Vector a)
forall a. Vector a %1 -> (Ur Int, Vector a)
capacity Vector a
vec (Ur Int, Vector a)
%1 -> ((Ur Int, Vector a) %1 -> Vector a) %1 -> Vector a
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \(Ur Int
cap, Vector a
vec') ->
    Vector a %1 -> (Ur Int, Vector a)
forall a. Vector a %1 -> (Ur Int, Vector a)
size Vector a
vec' (Ur Int, Vector a)
%1 -> ((Ur Int, Vector a) %1 -> Vector a) %1 -> Vector a
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \(Ur Int
s', Vector a
vec'') ->
      if Int
cap Int %1 -> Int %1 -> Bool
forall a. Ord a => a %1 -> a %1 -> Bool
> Int
s'
      then Int -> Vector a %1 -> Vector a
forall a. HasCallStack => Int -> Vector a %1 -> Vector a
unsafeResize Int
s' Vector a
vec''
      else Vector a
vec''

-- | Return a slice of the vector with given size, starting from an offset.
--
-- Start offset + target size should be within the input vector, and both should
-- be non-negative.
--
-- This is a constant time operation if the start offset is 0. Use 'shrinkToFit'
-- to remove the possible wasted space if necessary.
slice :: Int -> Int -> Vector a %1-> Vector a
slice :: forall a. Int -> Int -> Vector a %1 -> Vector a
slice Int
from Int
newSize (Vec Int
oldSize Array a
arr) =
  if Int
oldSize Int %1 -> Int %1 -> Bool
forall a. Ord a => a %1 -> a %1 -> Bool
< Int
from Int %1 -> Int %1 -> Int
forall a. Additive a => a %1 -> a %1 -> a
+ Int
newSize
  then Array a
arr Array a %1 -> Vector a %1 -> Vector a
forall a b. Consumable a => a %1 -> b %1 -> b
`lseq` [Char] -> Vector a
forall a. HasCallStack => [Char] -> a
error [Char]
"Slice index out of bounds"
  else if Int
from Int %1 -> Int %1 -> Bool
forall a. Eq a => a %1 -> a %1 -> Bool
== Int
0
       then Int -> Array a %1 -> Vector a
forall a. Int -> Array a -> Vector a
Vec Int
newSize Array a
arr
       else Int -> Int -> Array a %1 -> (Array a, Array a)
forall a.
HasCallStack =>
Int -> Int -> Array a %1 -> (Array a, Array a)
Array.slice Int
from Int
newSize Array a
arr (Array a, Array a)
%1 -> ((Array a, Array a) %1 -> Vector a) %1 -> Vector a
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \(Array a
oldArr, Array a
newArr) ->
              Array a
oldArr Array a %1 -> Vector a %1 -> Vector a
forall a b. Consumable a => a %1 -> b %1 -> b
`lseq` Array a %1 -> Vector a
forall a. HasCallStack => Array a %1 -> Vector a
fromArray Array a
newArr

-- | /O(1)/ Convert a 'Vector' to an immutable 'Vector.Vector' (from
-- 'vector' package).
freeze :: Vector a %1-> Ur (Vector.Vector a)
freeze :: forall a. Vector a %1 -> Ur (Vector a)
freeze (Vec Int
sz Array a
arr) =
  Array a %1 -> Ur (Vector a)
forall a. Array a %1 -> Ur (Vector a)
Array.freeze Array a
arr
    Ur (Vector a)
%1 -> (Ur (Vector a) %1 -> Ur (Vector a)) %1 -> Ur (Vector a)
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \(Ur Vector a
vec) -> Vector a -> Ur (Vector a)
forall a. a -> Ur a
Ur (Int -> Vector a -> Vector a
forall a. Int -> Vector a -> Vector a
Vector.take Int
sz Vector a
vec)

-- | Same as 'set', but takes the 'Vector' as the first parameter.
write :: HasCallStack => Vector a %1-> Int -> a -> Vector a
write :: forall a. HasCallStack => Vector a %1 -> Int -> a -> Vector a
write Vector a
arr Int
i a
a = Int -> a -> Vector a %1 -> Vector a
forall a. HasCallStack => Int -> a -> Vector a %1 -> Vector a
set Int
i a
a Vector a
arr

-- | Same as 'unsafeSafe', but takes the 'Vector' as the first parameter.
unsafeWrite ::  Vector a %1-> Int -> a -> Vector a
unsafeWrite :: forall a. Vector a %1 -> Int -> a -> Vector a
unsafeWrite Vector a
arr Int
i a
a = Int -> a -> Vector a %1 -> Vector a
forall a. HasCallStack => Int -> a -> Vector a %1 -> Vector a
unsafeSet Int
i a
a Vector a
arr

-- | Same as 'get', but takes the 'Vector' as the first parameter.
read :: HasCallStack => Vector a %1-> Int -> (Ur a, Vector a)
read :: forall a. HasCallStack => Vector a %1 -> Int -> (Ur a, Vector a)
read Vector a
arr Int
i = Int -> Vector a %1 -> (Ur a, Vector a)
forall a. HasCallStack => Int -> Vector a %1 -> (Ur a, Vector a)
get Int
i Vector a
arr

-- | Same as 'unsafeGet', but takes the 'Vector' as the first parameter.
unsafeRead :: Vector a %1-> Int -> (Ur a, Vector a)
unsafeRead :: forall a. Vector a %1 -> Int -> (Ur a, Vector a)
unsafeRead Vector a
arr Int
i = Int -> Vector a %1 -> (Ur a, Vector a)
forall a. HasCallStack => Int -> Vector a %1 -> (Ur a, Vector a)
unsafeGet Int
i Vector a
arr

-- # Instances
-------------------------------------------------------------------------------

instance Consumable (Vector a) where
  consume :: Vector a %1 -> ()
consume (Vec Int
_ Array a
arr) = Array a %1 -> ()
forall a. Consumable a => a %1 -> ()
consume Array a
arr

instance Dupable (Vector a) where
  dup2 :: Vector a %1 -> (Vector a, Vector a)
dup2 (Vec Int
i Array a
arr) = Array a %1 -> (Array a, Array a)
forall a. Dupable a => a %1 -> (a, a)
dup2 Array a
arr (Array a, Array a)
%1 -> ((Array a, Array a) %1 -> (Vector a, Vector a))
%1 -> (Vector a, Vector a)
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \(Array a
a1, Array a
a2) ->
    (Int -> Array a %1 -> Vector a
forall a. Int -> Array a -> Vector a
Vec Int
i Array a
a1, Int -> Array a %1 -> Vector a
forall a. Int -> Array a -> Vector a
Vec Int
i Array a
a2)

-- There is no way to get an unrestricted vector. So the below instance
-- is just to satisfy the linear Semigroup's constraint.
instance Prelude.Semigroup (Vector a) where
  Vector a
v1 <> :: Vector a -> Vector a -> Vector a
<> Vector a
v2 = Vector a
v1 Vector a %1 -> Vector a %1 -> Vector a
forall a. Semigroup a => a %1 -> a %1 -> a
Data.Monoid.Linear.<> Vector a
v2

instance Semigroup (Vector a) where
  -- This operation tries to use the existing capacity of v1 when possible.
  Vector a
v1 <> :: Vector a %1 -> Vector a %1 -> Vector a
<> Vector a
v2 =
    Vector a %1 -> (Ur Int, Vector a)
forall a. Vector a %1 -> (Ur Int, Vector a)
size Vector a
v2 (Ur Int, Vector a)
%1 -> ((Ur Int, Vector a) %1 -> Vector a) %1 -> Vector a
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \(Ur Int
s2, Vector a
v2') ->
      Int -> Vector a %1 -> Vector a
forall a. HasCallStack => Int -> Vector a %1 -> Vector a
growToFit Int
s2 Vector a
v1 Vector a %1 -> (Vector a %1 -> Vector a) %1 -> Vector a
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \Vector a
v1' ->
        Vector a %1 -> Ur [a]
forall a. Vector a %1 -> Ur [a]
toList Vector a
v2' Ur [a] %1 -> (Ur [a] %1 -> Vector a) %1 -> Vector a
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \(Ur [a]
xs) ->
          [a] -> Vector a %1 -> Vector a
go [a]
xs Vector a
v1'
   where
     go :: [a] -> Vector a %1-> Vector a
     go :: [a] -> Vector a %1 -> Vector a
go [] Vector a
vec = Vector a
vec
     go (a
x:[a]
xs) (Vec Int
sz Array a
arr) =
       Int -> a -> Vector a %1 -> Vector a
forall a. HasCallStack => Int -> a -> Vector a %1 -> Vector a
unsafeSet Int
sz a
x (Int -> Array a %1 -> Vector a
forall a. Int -> Array a -> Vector a
Vec (Int
szInt %1 -> Int %1 -> Int
forall a. Additive a => a %1 -> a %1 -> a
+Int
1) Array a
arr)
         Vector a %1 -> (Vector a %1 -> Vector a) %1 -> Vector a
forall a b. a %1 -> (a %1 -> b) %1 -> b
& [a] -> Vector a %1 -> Vector a
go [a]
xs

instance Data.Functor Vector where
  fmap :: forall a b. (a %1 -> b) -> Vector a %1 -> Vector b
fmap a %1 -> b
f Vector a
vec = Vector a %1 -> (a -> Maybe b) -> Vector b
forall a b. Vector a %1 -> (a -> Maybe b) -> Vector b
mapMaybe Vector a
vec (\a
a -> b -> Maybe b
forall a. a -> Maybe a
Just (a %1 -> b
f a
a))

-- # Internal library
-------------------------------------------------------------------------------

-- | Grows the vector to the closest power of growthFactor to
-- fit at least n more elements.
growToFit :: HasCallStack => Int -> Vector a %1-> Vector a
growToFit :: forall a. HasCallStack => Int -> Vector a %1 -> Vector a
growToFit Int
n Vector a
vec =
  Vector a %1 -> (Ur Int, Vector a)
forall a. Vector a %1 -> (Ur Int, Vector a)
capacity Vector a
vec (Ur Int, Vector a)
%1 -> ((Ur Int, Vector a) %1 -> Vector a) %1 -> Vector a
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \(Ur Int
cap, Vector a
vec') ->
    Vector a %1 -> (Ur Int, Vector a)
forall a. Vector a %1 -> (Ur Int, Vector a)
size Vector a
vec' (Ur Int, Vector a)
%1 -> ((Ur Int, Vector a) %1 -> Vector a) %1 -> Vector a
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \(Ur Int
s', Vector a
vec'') ->
      if Int
s' Int %1 -> Int %1 -> Int
forall a. Additive a => a %1 -> a %1 -> a
+ Int
n Int %1 -> Int %1 -> Bool
forall a. Ord a => a %1 -> a %1 -> Bool
<= Int
cap
      then Vector a
vec''
      else
        let -- Calculate the closest power of growth factor
            -- larger than required size.
            newSize :: Int
newSize =
              Int
constGrowthFactor -- This constant is defined above.
                Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^ (Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
ceiling :: Double -> Int)
                    (Double -> Double -> Double
forall a. Floating a => a -> a -> a
logBase
                      (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
constGrowthFactor)
                      (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
s' Int %1 -> Int %1 -> Int
forall a. Additive a => a %1 -> a %1 -> a
+ Int
n))) -- this is always
                                               -- > 0 because of
                                               -- the if condition
        in  Int -> Vector a %1 -> Vector a
forall a. HasCallStack => Int -> Vector a %1 -> Vector a
unsafeResize
              Int
newSize
              Vector a
vec''

-- | Resize the vector to a non-negative size. In-range elements are preserved,
-- the possible new elements are bottoms.
unsafeResize :: HasCallStack => Int -> Vector a %1-> Vector a
unsafeResize :: forall a. HasCallStack => Int -> Vector a %1 -> Vector a
unsafeResize Int
newSize (Vec Int
size' Array a
ma) =
  Int -> Array a %1 -> Vector a
forall a. Int -> Array a -> Vector a
Vec
    (Int %1 -> Int %1 -> Int
forall a. (Dupable a, Ord a) => a %1 -> a %1 -> a
min Int
size' Int
newSize)
    (Int -> a -> Array a %1 -> Array a
forall a. HasCallStack => Int -> a -> Array a %1 -> Array a
Array.resize
      Int
newSize
      ([Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"access to uninitialized vector index")
      Array a
ma
    )

-- | Check if given index is within the Vector, otherwise panic.
assertIndexInRange :: HasCallStack => Int -> Vector a %1-> Vector a
assertIndexInRange :: forall a. HasCallStack => Int -> Vector a %1 -> Vector a
assertIndexInRange Int
i Vector a
vec =
  Vector a %1 -> (Ur Int, Vector a)
forall a. Vector a %1 -> (Ur Int, Vector a)
size Vector a
vec (Ur Int, Vector a)
%1 -> ((Ur Int, Vector a) %1 -> Vector a) %1 -> Vector a
forall a b. a %1 -> (a %1 -> b) %1 -> b
& \(Ur Int
s, Vector a
vec') ->
    if Int
0 Int %1 -> Int %1 -> Bool
forall a. Ord a => a %1 -> a %1 -> Bool
<= Int
i Bool %1 -> Bool %1 -> Bool
&& Int
i Int %1 -> Int %1 -> Bool
forall a. Ord a => a %1 -> a %1 -> Bool
< Int
s
    then Vector a
vec'
    else Vector a
vec' Vector a %1 -> Vector a %1 -> Vector a
forall a b. Consumable a => a %1 -> b %1 -> b
`lseq` [Char] -> Vector a
forall a. HasCallStack => [Char] -> a
error [Char]
"Vector: index out of bounds"