{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE LinearTypes #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -Wno-unbanged-strict-patterns #-}
{-# OPTIONS_HADDOCK hide #-}
module Data.Vector.Mutable.Linear.Internal where
import Data.Array.Mutable.Linear (Array)
import qualified Data.Array.Mutable.Linear as Array
import qualified Data.Functor.Linear as Data
import Data.Monoid.Linear
import qualified Data.Vector as Vector
import GHC.Stack
import Prelude.Linear hiding (filter, mapMaybe, read)
import qualified Unsafe.Linear as Unsafe
import qualified Prelude
constGrowthFactor :: Int
constGrowthFactor :: Int
constGrowthFactor = Int
2
data Vector a where
Vec ::
Int ->
Array a %1 ->
Vector a
fromArray :: (HasCallStack) => Array a %1 -> Vector a
fromArray :: forall a. HasCallStack => Array a %1 -> Vector a
fromArray Array a
arr =
forall a. Array a %1 -> (Ur Int, Array a)
Array.size Array a
arr
forall a b (p :: Multiplicity) (q :: Multiplicity).
a %p -> (a %p -> b) %q -> b
& \(Ur Int
size', Array a
arr') -> forall a. Int -> Array a -> Vector a
Vec Int
size' Array a
arr'
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 = forall a b. HasCallStack => [a] -> (Array a %1 -> Ur b) %1 -> Ur b
Array.fromList [] (Vector a %1 -> Ur b
f forall b c a (q :: Multiplicity) (m :: Multiplicity)
(n :: Multiplicity).
(b %1 -> c) %q -> (a %1 -> b) %m -> a %n -> c
. forall a. HasCallStack => Array a %1 -> Vector a
fromArray)
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' forall a. Ord a => a %1 -> a %1 -> Bool
< Int
0 =
(forall a. HasCallStack => [Char] -> a
error ([Char]
"Trying to construct a vector of size " forall a. [a] %1 -> [a] %1 -> [a]
++ forall a. Show a => a -> [Char]
show Int
size') :: x %1 -> x)
(Vector a %1 -> Ur b
f forall a. HasCallStack => a
undefined)
| Bool
otherwise = 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 forall b c a (q :: Multiplicity) (m :: Multiplicity)
(n :: Multiplicity).
(b %1 -> c) %q -> (a %1 -> b) %m -> a %n -> c
. forall a. HasCallStack => Array a %1 -> Vector a
fromArray)
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 = forall a b. HasCallStack => [a] -> (Array a %1 -> Ur b) %1 -> Ur b
Array.fromList [a]
xs (Vector a %1 -> Ur b
f forall b c a (q :: Multiplicity) (m :: Multiplicity)
(n :: Multiplicity).
(b %1 -> c) %q -> (a %1 -> b) %m -> a %n -> c
. forall a. HasCallStack => Array a %1 -> Vector a
fromArray)
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) = (forall a. a -> Ur a
Ur Int
size', forall a. Int -> Array a -> Vector a
Vec Int
size' Array a
arr)
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) =
forall a. Array a %1 -> (Ur Int, Array a)
Array.size Array a
arr forall a b (p :: Multiplicity) (q :: Multiplicity).
a %p -> (a %p -> b) %q -> b
& \(Ur Int
cap, Array a
arr') -> (Ur Int
cap, forall a. Int -> Array a -> Vector a
Vec Int
s Array a
arr')
push :: a -> Vector a %1 -> Vector a
push :: forall a. a -> Vector a %1 -> Vector a
push a
x Vector a
vec =
forall a. HasCallStack => Int -> Vector a %1 -> Vector a
growToFit Int
1 Vector a
vec forall a b (p :: Multiplicity) (q :: Multiplicity).
a %p -> (a %p -> b) %q -> b
& \(Vec Int
s Array a
arr) ->
forall a. HasCallStack => Int -> a -> Vector a %1 -> Vector a
unsafeSet Int
s a
x (forall a. Int -> Array a -> Vector a
Vec (Int
s forall a. Additive a => a %1 -> a %1 -> a
+ Int
1) Array a
arr)
pop :: Vector a %1 -> (Ur (Maybe a), Vector a)
pop :: forall a. Vector a %1 -> (Ur (Maybe a), Vector a)
pop Vector a
vec =
forall a. Vector a %1 -> (Ur Int, Vector a)
size Vector a
vec forall a b (p :: Multiplicity) (q :: Multiplicity).
a %p -> (a %p -> b) %q -> b
& \case
(Ur Int
0, Vector a
vec') ->
(forall a. a -> Ur a
Ur forall a. Maybe a
Nothing, Vector a
vec')
(Ur Int
s, Vector a
vec') ->
forall a. HasCallStack => Int -> Vector a %1 -> (Ur a, Vector a)
get (Int
s forall a. AdditiveGroup a => a %1 -> a %1 -> a
- Int
1) Vector a
vec' forall a b (p :: Multiplicity) (q :: Multiplicity).
a %p -> (a %p -> b) %q -> b
& \(Ur a
a, Vec Int
_ Array a
arr) ->
( forall a. a -> Ur a
Ur (forall a. a -> Maybe a
Just a
a),
forall a. Int -> Array a -> Vector a
Vec (Int
s forall a. AdditiveGroup a => a %1 -> a %1 -> a
- Int
1) Array a
arr
)
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 =
forall a. HasCallStack => Int -> a -> Vector a %1 -> Vector a
unsafeSet Int
ix a
val (forall a. HasCallStack => Int -> Vector a %1 -> Vector a
assertIndexInRange Int
ix Vector a
vec)
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) =
forall a. Int -> Array a -> Vector a
Vec Int
size' (forall a. Int -> a -> Array a %1 -> Array a
Array.unsafeSet Int
ix a
val Array a
arr)
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 =
forall a. HasCallStack => Int -> Vector a %1 -> (Ur a, Vector a)
unsafeGet Int
ix (forall a. HasCallStack => Int -> Vector a %1 -> Vector a
assertIndexInRange Int
ix Vector a
vec)
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) =
forall a. Int -> Array a %1 -> (Ur a, Array a)
Array.unsafeGet Int
ix Array a
arr
forall a b (p :: Multiplicity) (q :: Multiplicity).
a %p -> (a %p -> b) %q -> b
& \(Ur a
val, Array a
arr') -> (Ur a
val, forall a. Int -> Array a -> Vector a
Vec Int
size' Array a
arr')
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) =
forall a. Int -> Array a %1 -> (Ur a, Array a)
Array.unsafeGet Int
ix Array a
arr forall a b (p :: Multiplicity) (q :: Multiplicity).
a %p -> (a %p -> b) %q -> b
& \(Ur a
old, Array a
arr') ->
case a -> (a, b)
f a
old of
(a
a, b
b) ->
forall a. Int -> a -> Array a %1 -> Array a
Array.unsafeSet Int
ix a
a Array a
arr' forall a b (p :: Multiplicity) (q :: Multiplicity).
a %p -> (a %p -> b) %q -> b
& \Array a
arr'' ->
(forall a. a -> Ur a
Ur b
b, forall a. Int -> Array a -> Vector a
Vec Int
size' Array a
arr'')
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 = forall a b.
HasCallStack =>
(a -> (a, b)) -> Int -> Vector a %1 -> (Ur b, Vector a)
unsafeModify a -> (a, b)
f Int
ix (forall a. HasCallStack => Int -> Vector a %1 -> Vector a
assertIndexInRange Int
ix Vector a
vec)
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 =
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
forall a b (p :: Multiplicity) (q :: Multiplicity).
a %p -> (a %p -> b) %q -> b
& \(Ur (), Vector a
vec') -> Vector a
vec'
toList :: Vector a %1 -> Ur [a]
toList :: forall a. Vector a %1 -> Ur [a]
toList (Vec Int
s Array a
arr) =
forall a. Array a %1 -> Ur [a]
Array.toList Array a
arr forall a b (p :: Multiplicity) (q :: Multiplicity).
a %p -> (a %p -> b) %q -> b
& \(Ur [a]
xs) ->
forall a. a -> Ur a
Ur (forall a. Int -> [a] -> [a]
Prelude.take Int
s [a]
xs)
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 = forall a b. Vector a %1 -> (a -> Maybe b) -> Vector b
mapMaybe Vector a
v (\a
a -> if a -> Bool
f a
a then forall a. a -> Maybe a
Just a
a else forall a. Maybe a
Nothing)
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) =
forall a. Vector a %1 -> (Ur Int, Vector a)
size Vector a
vec forall a b (p :: Multiplicity) (q :: Multiplicity).
a %p -> (a %p -> b) %q -> 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 ->
Int ->
Int ->
Vector a %1 ->
Vector b
go :: Int -> Int -> Int -> Vector a %1 -> Vector b
go Int
r Int
w Int
s Vector a
vec'
| Int
r forall a. Eq a => a %1 -> a %1 -> Bool
== Int
s =
Vector a
vec' forall a b (p :: Multiplicity) (q :: Multiplicity).
a %p -> (a %p -> b) %q -> b
& \(Vec Int
_ Array a
arr) ->
forall a. Int -> Array a -> Vector a
Vec Int
w (forall a b. a %1 -> b
Unsafe.coerce Array a
arr)
| Bool
otherwise =
forall a. HasCallStack => Int -> Vector a %1 -> (Ur a, Vector a)
unsafeGet Int
r Vector a
vec' forall a b (p :: Multiplicity) (q :: Multiplicity).
a %p -> (a %p -> b) %q -> 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
r forall a. Additive a => a %1 -> a %1 -> a
+ Int
1) (Int
w forall a. Additive a => a %1 -> a %1 -> a
+ Int
1) Int
s (forall a. HasCallStack => Int -> a -> Vector a %1 -> Vector a
unsafeSet Int
w (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
r forall a. Additive a => a %1 -> a %1 -> a
+ Int
1) Int
w Int
s Vector a
vec''
shrinkToFit :: Vector a %1 -> Vector a
shrinkToFit :: forall a. Vector a %1 -> Vector a
shrinkToFit Vector a
vec =
forall a. Vector a %1 -> (Ur Int, Vector a)
capacity Vector a
vec forall a b (p :: Multiplicity) (q :: Multiplicity).
a %p -> (a %p -> b) %q -> b
& \(Ur Int
cap, Vector a
vec') ->
forall a. Vector a %1 -> (Ur Int, Vector a)
size Vector a
vec' forall a b (p :: Multiplicity) (q :: Multiplicity).
a %p -> (a %p -> b) %q -> b
& \(Ur Int
s', Vector a
vec'') ->
if Int
cap forall a. Ord a => a %1 -> a %1 -> Bool
> Int
s'
then forall a. HasCallStack => Int -> Vector a %1 -> Vector a
unsafeResize Int
s' Vector a
vec''
else Vector a
vec''
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 forall a. Ord a => a %1 -> a %1 -> Bool
< Int
from forall a. Additive a => a %1 -> a %1 -> a
+ Int
newSize
then Array a
arr forall a b. Consumable a => a %1 -> b %1 -> b
`lseq` forall a. HasCallStack => [Char] -> a
error [Char]
"Slice index out of bounds"
else
if Int
from forall a. Eq a => a %1 -> a %1 -> Bool
== Int
0
then forall a. Int -> Array a -> Vector a
Vec Int
newSize Array a
arr
else
forall a.
HasCallStack =>
Int -> Int -> Array a %1 -> (Array a, Array a)
Array.slice Int
from Int
newSize Array a
arr forall a b (p :: Multiplicity) (q :: Multiplicity).
a %p -> (a %p -> b) %q -> b
& \(Array a
oldArr, Array a
newArr) ->
Array a
oldArr forall a b. Consumable a => a %1 -> b %1 -> b
`lseq` forall a. HasCallStack => Array a %1 -> Vector a
fromArray Array a
newArr
freeze :: Vector a %1 -> Ur (Vector.Vector a)
freeze :: forall a. Vector a %1 -> Ur (Vector a)
freeze (Vec Int
sz Array a
arr) =
forall a. Array a %1 -> Ur (Vector a)
Array.freeze Array a
arr
forall a b (p :: Multiplicity) (q :: Multiplicity).
a %p -> (a %p -> b) %q -> b
& \(Ur Vector a
vec) -> forall a. a -> Ur a
Ur (forall a. Int -> Vector a -> Vector a
Vector.take Int
sz Vector a
vec)
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 = forall a. HasCallStack => Int -> a -> Vector a %1 -> Vector a
set Int
i a
a Vector a
arr
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 = forall a. HasCallStack => Int -> a -> Vector a %1 -> Vector a
unsafeSet Int
i a
a Vector a
arr
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 = forall a. HasCallStack => Int -> Vector a %1 -> (Ur a, Vector a)
get Int
i Vector a
arr
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 = forall a. HasCallStack => Int -> Vector a %1 -> (Ur a, Vector a)
unsafeGet Int
i Vector a
arr
instance Consumable (Vector a) where
consume :: Vector a %1 -> ()
consume (Vec Int
_ Array a
arr) = 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) =
forall a. Dupable a => a %1 -> (a, a)
dup2 Array a
arr forall a b (p :: Multiplicity) (q :: Multiplicity).
a %p -> (a %p -> b) %q -> b
& \(Array a
a1, Array a
a2) ->
(forall a. Int -> Array a -> Vector a
Vec Int
i Array a
a1, forall a. Int -> Array a -> Vector a
Vec Int
i Array a
a2)
instance Prelude.Semigroup (Vector a) where
Vector a
v1 <> :: Vector a -> Vector a -> Vector a
<> Vector a
v2 = Vector a
v1 forall a. Semigroup a => a %1 -> a %1 -> a
Data.Monoid.Linear.<> Vector a
v2
instance Semigroup (Vector a) where
Vector a
v1 <> :: Vector a %1 -> Vector a %1 -> Vector a
<> Vector a
v2 =
forall a. Vector a %1 -> (Ur Int, Vector a)
size Vector a
v2 forall a b (p :: Multiplicity) (q :: Multiplicity).
a %p -> (a %p -> b) %q -> b
& \(Ur Int
s2, Vector a
v2') ->
forall a. HasCallStack => Int -> Vector a %1 -> Vector a
growToFit Int
s2 Vector a
v1 forall a b (p :: Multiplicity) (q :: Multiplicity).
a %p -> (a %p -> b) %q -> b
& \Vector a
v1' ->
forall a. Vector a %1 -> Ur [a]
toList Vector a
v2' forall a b (p :: Multiplicity) (q :: Multiplicity).
a %p -> (a %p -> b) %q -> 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) =
forall a. HasCallStack => Int -> a -> Vector a %1 -> Vector a
unsafeSet Int
sz a
x (forall a. Int -> Array a -> Vector a
Vec (Int
sz forall a. Additive a => a %1 -> a %1 -> a
+ Int
1) Array a
arr)
forall a b (p :: Multiplicity) (q :: Multiplicity).
a %p -> (a %p -> b) %q -> 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 = forall a b. Vector a %1 -> (a -> Maybe b) -> Vector b
mapMaybe Vector a
vec (\a
a -> forall a. a -> Maybe a
Just (a %1 -> b
f a
a))
growToFit :: (HasCallStack) => Int -> Vector a %1 -> Vector a
growToFit :: forall a. HasCallStack => Int -> Vector a %1 -> Vector a
growToFit Int
n Vector a
vec =
forall a. Vector a %1 -> (Ur Int, Vector a)
capacity Vector a
vec forall a b (p :: Multiplicity) (q :: Multiplicity).
a %p -> (a %p -> b) %q -> b
& \(Ur Int
cap, Vector a
vec') ->
forall a. Vector a %1 -> (Ur Int, Vector a)
size Vector a
vec' forall a b (p :: Multiplicity) (q :: Multiplicity).
a %p -> (a %p -> b) %q -> b
& \(Ur Int
s', Vector a
vec'') ->
if Int
s' forall a. Additive a => a %1 -> a %1 -> a
+ Int
n forall a. Ord a => a %1 -> a %1 -> Bool
<= Int
cap
then Vector a
vec''
else
let
newSize :: Int
newSize =
Int
constGrowthFactor
forall a b. (Num a, Integral b) => a -> b -> a
^ (forall a b. (RealFrac a, Integral b) => a -> b
ceiling :: Double -> Int)
( forall a. Floating a => a -> a -> a
logBase
(forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
constGrowthFactor)
(forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
s' forall a. Additive a => a %1 -> a %1 -> a
+ Int
n))
)
in forall a. HasCallStack => Int -> Vector a %1 -> Vector a
unsafeResize
Int
newSize
Vector a
vec''
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) =
forall a. Int -> Array a -> Vector a
Vec
(forall a. (Dupable a, Ord a) => a %1 -> a %1 -> a
min Int
size' Int
newSize)
( forall a. HasCallStack => Int -> a -> Array a %1 -> Array a
Array.resize
Int
newSize
(forall a. HasCallStack => [Char] -> a
error [Char]
"access to uninitialized vector index")
Array a
ma
)
assertIndexInRange :: (HasCallStack) => Int -> Vector a %1 -> Vector a
assertIndexInRange :: forall a. HasCallStack => Int -> Vector a %1 -> Vector a
assertIndexInRange Int
i Vector a
vec =
forall a. Vector a %1 -> (Ur Int, Vector a)
size Vector a
vec forall a b (p :: Multiplicity) (q :: Multiplicity).
a %p -> (a %p -> b) %q -> b
& \(Ur Int
s, Vector a
vec') ->
if Int
0 forall a. Ord a => a %1 -> a %1 -> Bool
<= Int
i Bool %1 -> Bool %1 -> Bool
&& Int
i forall a. Ord a => a %1 -> a %1 -> Bool
< Int
s
then Vector a
vec'
else Vector a
vec' forall a b. Consumable a => a %1 -> b %1 -> b
`lseq` forall a. HasCallStack => [Char] -> a
error [Char]
"Vector: index out of bounds"