Safe Haskell | None |
---|---|
Language | Haskell2010 |
Type classes for vectors which are implemented on top of the arrays
and support in-place mutation. API is similar to one used in the
vector
package.
Synopsis
- type Arity n = (ArityPeano (Peano n), KnownNat n, Peano (n + 1) ~ 'S (Peano n))
- arity :: KnownNat n => proxy n -> Int
- type family Mutable (v :: * -> *) :: * -> * -> *
- type family DimM (v :: * -> * -> *) :: Nat
- class Arity (DimM v) => MVector v a where
- copy :: PrimMonad m => v (PrimState m) a -> v (PrimState m) a -> m ()
- move :: PrimMonad m => v (PrimState m) a -> v (PrimState m) a -> m ()
- new :: PrimMonad m => m (v (PrimState m) a)
- unsafeRead :: PrimMonad m => v (PrimState m) a -> Int -> m a
- unsafeWrite :: PrimMonad m => v (PrimState m) a -> Int -> a -> m ()
- lengthM :: forall v s a. Arity (DimM v) => v s a -> Int
- read :: (PrimMonad m, MVector v a) => v (PrimState m) a -> Int -> m a
- write :: (PrimMonad m, MVector v a) => v (PrimState m) a -> Int -> a -> m ()
- clone :: (PrimMonad m, MVector v a) => v (PrimState m) a -> m (v (PrimState m) a)
- replicate :: (PrimMonad m, MVector v a) => a -> m (v (PrimState m) a)
- replicateM :: (PrimMonad m, MVector v a) => m a -> m (v (PrimState m) a)
- generate :: (PrimMonad m, MVector v a) => (Int -> a) -> m (v (PrimState m) a)
- generateM :: (PrimMonad m, MVector v a) => (Int -> m a) -> m (v (PrimState m) a)
- forI :: (PrimMonad m, MVector v a) => v (PrimState m) a -> (Int -> m ()) -> m ()
- class (Dim v ~ DimM (Mutable v), MVector (Mutable v) a) => IVector v a where
- unsafeFreeze :: PrimMonad m => Mutable v (PrimState m) a -> m (v a)
- unsafeThaw :: PrimMonad m => v a -> m (Mutable v (PrimState m) a)
- unsafeIndex :: v a -> Int -> a
- index :: IVector v a => v a -> Int -> a
- freeze :: (PrimMonad m, IVector v a) => Mutable v (PrimState m) a -> m (v a)
- thaw :: (PrimMonad m, IVector v a) => v a -> m (Mutable v (PrimState m) a)
- constructVec :: forall v a. (Arity (Dim v), IVector v a) => Fun (Peano (Dim v)) a (v a)
- inspectVec :: forall v a b. (Arity (Dim v), IVector v a) => v a -> Fun (Peano (Dim v)) a b -> b
Mutable vectors
type Arity n = (ArityPeano (Peano n), KnownNat n, Peano (n + 1) ~ 'S (Peano n)) Source #
Type class for type level number for which we can defined operations over N-ary functions.
type family Mutable (v :: * -> *) :: * -> * -> * Source #
Mutable counterpart of fixed-length vector.
Instances
type Mutable (Vec n) Source # | |
Defined in Data.Vector.Fixed.Boxed | |
type Mutable (Vec n) Source # | |
Defined in Data.Vector.Fixed.Primitive | |
type Mutable (Vec n) Source # | |
Defined in Data.Vector.Fixed.Storable | |
type Mutable (Vec n) Source # | |
Defined in Data.Vector.Fixed.Unboxed |
type family DimM (v :: * -> * -> *) :: Nat Source #
Dimension for mutable vector.
Instances
type DimM (MVec n) Source # | |
Defined in Data.Vector.Fixed.Boxed | |
type DimM (MVec n) Source # | |
Defined in Data.Vector.Fixed.Primitive | |
type DimM (MVec n) Source # | |
Defined in Data.Vector.Fixed.Storable | |
type DimM (MVec n) Source # | |
Defined in Data.Vector.Fixed.Unboxed |
class Arity (DimM v) => MVector v a where Source #
Type class for mutable vectors.
Copy vector. The two vectors may not overlap. Since vectors' length is encoded in the type there is no need in runtime checks.
Copy vector. The two vectors may overlap. Since vectors' length is encoded in the type there is no need in runtime checks.
new :: PrimMonad m => m (v (PrimState m) a) Source #
Allocate new vector
unsafeRead :: PrimMonad m => v (PrimState m) a -> Int -> m a Source #
Read value at index without bound checks.
unsafeWrite :: PrimMonad m => v (PrimState m) a -> Int -> a -> m () Source #
Write value at index without bound checks.
Instances
lengthM :: forall v s a. Arity (DimM v) => v s a -> Int Source #
Length of mutable vector. Function doesn't evaluate its argument.
read :: (PrimMonad m, MVector v a) => v (PrimState m) a -> Int -> m a Source #
Read value at index with bound checks.
write :: (PrimMonad m, MVector v a) => v (PrimState m) a -> Int -> a -> m () Source #
Write value at index with bound checks.
clone :: (PrimMonad m, MVector v a) => v (PrimState m) a -> m (v (PrimState m) a) Source #
Create copy of vector.
Examples:
>>>
import Control.Monad.ST (runST)
>>>
import Data.Vector.Fixed (mk3)
>>>
import Data.Vector.Fixed.Boxed (Vec3)
>>>
import qualified Data.Vector.Fixed.Mutable as M
>>>
let x = runST (do { v <- M.replicate 100; v' <- clone v; M.write v' 0 2; M.unsafeFreeze v' }) :: Vec3 Int
>>>
x
fromList [2,100,100]
Creation
replicate :: (PrimMonad m, MVector v a) => a -> m (v (PrimState m) a) Source #
Create new vector with all elements set to given value.
replicateM :: (PrimMonad m, MVector v a) => m a -> m (v (PrimState m) a) Source #
Create new vector with all elements are generated by provided monadic action.
generate :: (PrimMonad m, MVector v a) => (Int -> a) -> m (v (PrimState m) a) Source #
Create new vector with using function from index to value.
generateM :: (PrimMonad m, MVector v a) => (Int -> m a) -> m (v (PrimState m) a) Source #
Create new vector with using monadic function from index to value.
Loops
forI :: (PrimMonad m, MVector v a) => v (PrimState m) a -> (Int -> m ()) -> m () Source #
Loop which calls function for each index
Immutable vectors
class (Dim v ~ DimM (Mutable v), MVector (Mutable v) a) => IVector v a where Source #
Type class for immutable vectors
unsafeFreeze :: PrimMonad m => Mutable v (PrimState m) a -> m (v a) Source #
Convert vector to immutable state. Mutable vector must not be modified afterwards.
unsafeThaw :: PrimMonad m => v a -> m (Mutable v (PrimState m) a) Source #
O(1) Unsafely convert immutable vector to mutable without copying. Note that this is a very dangerous function and generally it's only safe to read from the resulting vector. In this case, the immutable vector could be used safely as well.
Problems with mutation happen because GHC has a lot of freedom to
introduce sharing. As a result mutable vectors produced by
unsafeThaw
may or may not share the same underlying buffer. For
example:
foo = do let vec = F.generate 10 id mvec <- M.unsafeThaw vec do_something mvec
Here GHC could lift vec
outside of foo which means that all calls to
do_something
will use same buffer with possibly disastrous
results. Whether such aliasing happens or not depends on the program in
question, optimization levels, and GHC flags.
All in all, attempts to modify a vector produced by unsafeThaw
fall out of domain of software engineering and into realm of
black magic, dark rituals, and unspeakable horrors. The only
advice that could be given is: "Don't attempt to mutate a vector
produced by unsafeThaw
unless you know how to prevent GHC from
aliasing buffers accidentally. We don't."
unsafeIndex :: v a -> Int -> a Source #
Get element at specified index without bounds check.
Instances
freeze :: (PrimMonad m, IVector v a) => Mutable v (PrimState m) a -> m (v a) Source #
Safely convert mutable vector to immutable.
thaw :: (PrimMonad m, IVector v a) => v a -> m (Mutable v (PrimState m) a) Source #
Safely convert immutable vector to mutable.