short-vec-0.1.0.0: A length-indexed vector type build on 'SmallArray#'
Safe HaskellNone
LanguageHaskell2010

Data.Vec.Short.Internal

Description

An implementation of short vectors.

The underlying implementation uses the SmallArray# primitive, which lacks the "card marking" of Array#: the upside being that it avoids the overhead of maintaining the card state, the downside being that the garbage collector must scan through the entire array rather than just the parts marked as having changed since the last GC. Using SmallArray# is typically a win for arrays with fewer than 128 elements.

Synopsis

Documentation

prim_ :: (State# s -> State# s) -> ST s () Source #

Wrap stateful primops which don't return a value.

data Vec (n :: Nat) (a :: Type) Source #

Vec n a is an element-lazy array of n values of type a.

This comes with a fusion framework, so many intermediate vectors are optimized away, and generally the only Vecs that correspond to actual arrays are those stored in data constructors, accessed multiple times, or appearing as inputs or outputs of non-inlinable functions. Additionally, some operations that rely on building up a vector incrementally (as opposed to computing each index independently of the others) cannot be fused; notably fromList, traverse, iterate, and vscanl; these will always construct real arrays for their results.

Most operations are access-strict unless otherwise noted, which means that forcing the result (usually a Vec, but possibly something else, like with foldMap) eagerly performs all indexing and drops references to any input arrays.

Constructors

V# (SmallArray# a) 

Instances

Instances details
KnownNat n => Monad (Vec n) Source # 
Instance details

Defined in Data.Vec.Short.Internal

Methods

(>>=) :: Vec n a -> (a -> Vec n b) -> Vec n b #

(>>) :: Vec n a -> Vec n b -> Vec n b #

return :: a -> Vec n a #

Functor (Vec n) Source # 
Instance details

Defined in Data.Vec.Short.Internal

Methods

fmap :: (a -> b) -> Vec n a -> Vec n b #

(<$) :: a -> Vec n b -> Vec n a #

KnownNat n => Applicative (Vec n) Source # 
Instance details

Defined in Data.Vec.Short.Internal

Methods

pure :: a -> Vec n a #

(<*>) :: Vec n (a -> b) -> Vec n a -> Vec n b #

liftA2 :: (a -> b -> c) -> Vec n a -> Vec n b -> Vec n c #

(*>) :: Vec n a -> Vec n b -> Vec n b #

(<*) :: Vec n a -> Vec n b -> Vec n a #

Foldable (Vec n) Source # 
Instance details

Defined in Data.Vec.Short.Internal

Methods

fold :: Monoid m => Vec n m -> m #

foldMap :: Monoid m => (a -> m) -> Vec n a -> m #

foldMap' :: Monoid m => (a -> m) -> Vec n a -> m #

foldr :: (a -> b -> b) -> b -> Vec n a -> b #

foldr' :: (a -> b -> b) -> b -> Vec n a -> b #

foldl :: (b -> a -> b) -> b -> Vec n a -> b #

foldl' :: (b -> a -> b) -> b -> Vec n a -> b #

foldr1 :: (a -> a -> a) -> Vec n a -> a #

foldl1 :: (a -> a -> a) -> Vec n a -> a #

toList :: Vec n a -> [a] #

null :: Vec n a -> Bool #

length :: Vec n a -> Int #

elem :: Eq a => a -> Vec n a -> Bool #

maximum :: Ord a => Vec n a -> a #

minimum :: Ord a => Vec n a -> a #

sum :: Num a => Vec n a -> a #

product :: Num a => Vec n a -> a #

Traversable (Vec n) Source # 
Instance details

Defined in Data.Vec.Short.Internal

Methods

traverse :: Applicative f => (a -> f b) -> Vec n a -> f (Vec n b) #

sequenceA :: Applicative f => Vec n (f a) -> f (Vec n a) #

mapM :: Monad m => (a -> m b) -> Vec n a -> m (Vec n b) #

sequence :: Monad m => Vec n (m a) -> m (Vec n a) #

KnownNat n => Distributive (Vec n) Source # 
Instance details

Defined in Data.Vec.Short.Internal

Methods

distribute :: Functor f => f (Vec n a) -> Vec n (f a) #

collect :: Functor f => (a -> Vec n b) -> f a -> Vec n (f b) #

distributeM :: Monad m => m (Vec n a) -> Vec n (m a) #

collectM :: Monad m => (a -> Vec n b) -> m a -> Vec n (m b) #

KnownNat n => Representable (Vec n) Source # 
Instance details

Defined in Data.Vec.Short.Internal

Associated Types

type Rep (Vec n) #

Methods

tabulate :: (Rep (Vec n) -> a) -> Vec n a #

index :: Vec n a -> Rep (Vec n) -> a #

Apply (Vec n) Source # 
Instance details

Defined in Data.Vec.Short.Internal

Methods

(<.>) :: Vec n (a -> b) -> Vec n a -> Vec n b #

(.>) :: Vec n a -> Vec n b -> Vec n b #

(<.) :: Vec n a -> Vec n b -> Vec n a #

liftF2 :: (a -> b -> c) -> Vec n a -> Vec n b -> Vec n c #

Bind (Vec n) Source # 
Instance details

Defined in Data.Vec.Short.Internal

Methods

(>>-) :: Vec n a -> (a -> Vec n b) -> Vec n b #

join :: Vec n (Vec n a) -> Vec n a #

FunctorWithIndex (Fin n) (Vec n) Source # 
Instance details

Defined in Data.Vec.Short.Internal

Methods

imap :: (Fin n -> a -> b) -> Vec n a -> Vec n b #

KnownNat n => FoldableWithIndex (Fin n) (Vec n) Source # 
Instance details

Defined in Data.Vec.Short.Internal

Methods

ifoldMap :: Monoid m => (Fin n -> a -> m) -> Vec n a -> m #

ifoldMap' :: Monoid m => (Fin n -> a -> m) -> Vec n a -> m #

ifoldr :: (Fin n -> a -> b -> b) -> b -> Vec n a -> b #

ifoldl :: (Fin n -> b -> a -> b) -> b -> Vec n a -> b #

ifoldr' :: (Fin n -> a -> b -> b) -> b -> Vec n a -> b #

ifoldl' :: (Fin n -> b -> a -> b) -> b -> Vec n a -> b #

KnownNat n => TraversableWithIndex (Fin n) (Vec n) Source # 
Instance details

Defined in Data.Vec.Short.Internal

Methods

itraverse :: Applicative f => (Fin n -> a -> f b) -> Vec n a -> f (Vec n b) #

KnownNat n => IsList (Vec n a) Source # 
Instance details

Defined in Data.Vec.Short.Internal

Associated Types

type Item (Vec n a) #

Methods

fromList :: [Item (Vec n a)] -> Vec n a #

fromListN :: Int -> [Item (Vec n a)] -> Vec n a #

toList :: Vec n a -> [Item (Vec n a)] #

Eq a => Eq (Vec n a) Source # 
Instance details

Defined in Data.Vec.Short.Internal

Methods

(==) :: Vec n a -> Vec n a -> Bool #

(/=) :: Vec n a -> Vec n a -> Bool #

(KnownNat n, Data a) => Data (Vec n a) Source # 
Instance details

Defined in Data.Vec.Short.Internal

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Vec n a -> c (Vec n a) #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (Vec n a) #

toConstr :: Vec n a -> Constr #

dataTypeOf :: Vec n a -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c (Vec n a)) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Vec n a)) #

gmapT :: (forall b. Data b => b -> b) -> Vec n a -> Vec n a #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Vec n a -> r #

gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Vec n a -> r #

gmapQ :: (forall d. Data d => d -> u) -> Vec n a -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> Vec n a -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> Vec n a -> m (Vec n a) #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Vec n a -> m (Vec n a) #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Vec n a -> m (Vec n a) #

(KnownNat n, Num a) => Num (Vec n a) Source # 
Instance details

Defined in Data.Vec.Short.Internal

Methods

(+) :: Vec n a -> Vec n a -> Vec n a #

(-) :: Vec n a -> Vec n a -> Vec n a #

(*) :: Vec n a -> Vec n a -> Vec n a #

negate :: Vec n a -> Vec n a #

abs :: Vec n a -> Vec n a #

signum :: Vec n a -> Vec n a #

fromInteger :: Integer -> Vec n a #

Ord a => Ord (Vec n a) Source # 
Instance details

Defined in Data.Vec.Short.Internal

Methods

compare :: Vec n a -> Vec n a -> Ordering #

(<) :: Vec n a -> Vec n a -> Bool #

(<=) :: Vec n a -> Vec n a -> Bool #

(>) :: Vec n a -> Vec n a -> Bool #

(>=) :: Vec n a -> Vec n a -> Bool #

max :: Vec n a -> Vec n a -> Vec n a #

min :: Vec n a -> Vec n a -> Vec n a #

(KnownNat n, Read a) => Read (Vec n a) Source # 
Instance details

Defined in Data.Vec.Short.Internal

Methods

readsPrec :: Int -> ReadS (Vec n a) #

readList :: ReadS [Vec n a] #

readPrec :: ReadPrec (Vec n a) #

readListPrec :: ReadPrec [Vec n a] #

Show a => Show (Vec n a) Source # 
Instance details

Defined in Data.Vec.Short.Internal

Methods

showsPrec :: Int -> Vec n a -> ShowS #

show :: Vec n a -> String #

showList :: [Vec n a] -> ShowS #

Semigroup a => Semigroup (Vec n a) Source #

Point-wise (<>).

Instance details

Defined in Data.Vec.Short.Internal

Methods

(<>) :: Vec n a -> Vec n a -> Vec n a #

sconcat :: NonEmpty (Vec n a) -> Vec n a #

stimes :: Integral b => b -> Vec n a -> Vec n a #

(KnownNat n, Monoid a) => Monoid (Vec n a) Source #

Point-wise mempty.

Instance details

Defined in Data.Vec.Short.Internal

Methods

mempty :: Vec n a #

mappend :: Vec n a -> Vec n a -> Vec n a #

mconcat :: [Vec n a] -> Vec n a #

(Arbitrary a, KnownNat n) => Arbitrary (Vec n a) Source # 
Instance details

Defined in Data.Vec.Short.Internal

Methods

arbitrary :: Gen (Vec n a) #

shrink :: Vec n a -> [Vec n a] #

Show a => CoArbitrary (Vec n a) Source # 
Instance details

Defined in Data.Vec.Short.Internal

Methods

coarbitrary :: Vec n a -> Gen b -> Gen b #

(KnownNat n, Default a) => Default (Vec n a) Source # 
Instance details

Defined in Data.Vec.Short.Internal

Methods

def :: Vec n a #

NFData a => NFData (Vec n a) Source # 
Instance details

Defined in Data.Vec.Short.Internal

Methods

rnf :: Vec n a -> () #

Portray a => Portray (Vec n a) Source # 
Instance details

Defined in Data.Vec.Short.Internal

Methods

portray :: Vec n a -> Portrayal #

(Portray a, Diff a) => Diff (Vec n a) Source # 
Instance details

Defined in Data.Vec.Short.Internal

Methods

diff :: Vec n a -> Vec n a -> Maybe Portrayal #

type Rep (Vec n) Source # 
Instance details

Defined in Data.Vec.Short.Internal

type Rep (Vec n) = Fin n
type Item (Vec n a) Source # 
Instance details

Defined in Data.Vec.Short.Internal

type Item (Vec n a) = a

unsafeNewMV :: Int -> a -> ST s (MutableVec s n a) Source #

This function is type-unsafe: because it assumes the Int argument is in fact the reflection of n.

unsafeFreezeMV :: MutableVec s n a -> ST s (Vec n a) Source #

This function is memory-unsafe: because it freezes the MutableVec in place. See [Note MemoryUnsafe].

safeThawMV :: Vec n a -> ST s (MutableVec s n a) Source #

Safely thaw a vector, by allocating a new array and copying the elements over. This is both type-safe and memory-safe.

unsafeCopyVec :: Vec n a -> Int -> MutableVec s m a -> Int -> Int -> ST s () Source #

This function is type-unsafe: because it assumes all the integers are in bounds for their respective arrays. It is also memory-unsafe, because we don't do any dynamic checks on those integers. We could add such, but have avoided doing so for performance reasons. See [Note TypeUnsafe] and [Note MemoryUnsafe].

TODO(b109671227): would assertions really/ affect the performance significantly?

sliceVec :: Vec n a -> Int -> SInt m -> Vec m a Source #

Return a known-length slice of a given vector.

Since the type is insufficiently specific to ensure memory-safety on its own (because the offset argument is just Int), this needs to perform runtime bounds checks to ensure memory safety.

(!) :: Vec n a -> Fin n -> a Source #

Extract the given index from a Vec.

This is subject to fusion if this is the only use of its input, so code like fmap f v ! i (which might arise due to inlining) will optimize to f (v ! i).

indexK :: Vec n a -> Fin n -> (a -> r) -> r Source #

Eagerly look up the value at a given position, without forcing the value itself.

One of the problems with (!) is that it will hold onto the underlying array until the xs!i expression is forced; which is a source of space leaks. However, forcing the xs!i expression will force not only the array lookup but also the value itself; which can be undesirably strict, thereby ruining the compositionality benefits of laziness. The indexK function is designed to overcome those limitations. That is, forcing the expression indexK xs i k will force the array lookup and the r value; thereby leaving it up to k to decide whether or not to force the a before returning r. So, for example, if we force indexK xs i Just this will force the array lookup, and wrap the unforced element in the Just constructor.

svSize :: Vec n a -> SInt n Source #

Return the size of a vector as SInt.

vSize :: Vec n a -> Int Source #

Dynamically determine the (actual) size/length of the vector, as a standard term-level Int. If you'd rather obtain n at the type-level, and/or to prove that the returned value is indeed the n of the input, see svSize and withSize instead. If you'd rather obtain n statically, see vLength.

access :: Vec n a -> Accessor n a Source #

Convert a Vec into its size and an indexing function.

materialize :: Accessor n a -> Vec n a Source #

Construct an actual Vec from an Accessor.

Strictness properties: forcing the resulting Vec forces all of the unboxed tuple accesses, so you can make Vecs that are strict in whatever you want by controlling what work goes inside/outside the unboxed tuple construction. Generally this is used to force all of the array accessing so that input Vecs are no longer retained after the result is forced; but it's also used to implement element-strict variants of some functions.

tabulateVec :: SInt n -> (Fin n -> a) -> Vec n a Source #

Create a known-length vector using a pure function.

Note if you already have a Vec of the desired length, you can use svSize to get the SInt parameter.

mkVec :: SInt n -> (Fin n -> a) -> Vec n a Source #

Create a known-length vector using a pure function.

Note if you already have a Vec of the desired length, you can use svSize to get the SInt parameter.

tabulateVec' :: SInt n -> (Fin n -> a) -> Vec n a Source #

Element-strict form of mkVec: elements are forced when forcing the Vec.

mkVec' :: SInt n -> (Fin n -> a) -> Vec n a Source #

Element-strict form of mkVec: elements are forced when forcing the Vec.

backpermute :: SInt m -> (Fin m -> Fin n) -> Vec n a -> Vec m a Source #

Construct a vector by choosing an element of another vector for each index.

    backpermute n f v ! i === v ! f i

listVec :: SInt n -> [a] -> Vec n a Source #

Create a vector of the specified length from a list. If n < length xs then the suffix of the vector will be filled with uninitialized values. If n > length xs then the suffix of xs won't be included in the vector. Either way, this function is both type-safe and memory-safe.

withVec :: [a] -> (forall n. Vec n a -> r) -> r Source #

Convert a list to a vector of the same length.

fromListN :: HasCallStack => SInt n -> Int -> [a] -> Vec n a Source #

Convert a list to a vector, given a hint for the length of the list. If the hint does not match the actual length of the list, then the behavior of this function is left unspecified. If the hint does not match the desired n, then we throw an error just like fromList. For a non-errorful version, see withVec instead.

fromList :: HasCallStack => SInt n -> [a] -> Vec n a Source #

Convert a list to a vector, throwing an error if the list has the wrong length. Note: Because this walks xs to check its length, this cannot be used with the list fusion optimization rules.

eqLength :: Int -> [a] -> Bool Source #

An implementation of n == length xs which short-circuits once it can determine the answer, rather than necessarily recursing through the entire list to compute its length.

vecDataType :: DataType Source #

Claim that vecConstr is the only data-constructor of Vec.

vecConstr :: Constr Source #

Treat the fromList function as a data-constructor for Vec.

upd :: Fin n -> Vec n a -> a -> Vec n a Source #

Safely construct a new vector that differs only in one element. This is inefficient, and only intended for internal use.

map' :: (a -> b) -> Vec n a -> Vec n b Source #

An element-strict version of fmap.

imap :: (Fin n -> a -> b) -> Vec n a -> Vec n b Source #

A variant of fmap that provides the index in addition to the element.

withPos :: Vec n a -> Vec n (Fin n, a) Source #

Pair each element of a Vec with its index.

You can also use imap, but there should be no harm in using this because the fusion framework should optimize away the intermediate Vec.

imap' :: (Fin n -> a -> b) -> Vec n a -> Vec n b Source #

An element-strict version of imap.

liftA2Lazy :: SInt n -> (a -> b -> c) -> Vec n a -> Vec n b -> Vec n c Source #

A truly lazy version of liftA2.

As opposed to the actual liftA2 it does not inspect the arguments which makes it possible it to use in code that has lazy knot-tying.

unsafeIndexK :: Vec n a -> Int -> (a -> r) -> r Source #

unsafeIndexK xs i === indexK xs (unsafeFin i)

TODO(b/109672429): try to get rid of all the uses of this function, and other uses of unsafeFin as well.

vscanl :: (b -> a -> b) -> b -> Vec n a -> Vec (1 + n) b Source #

scanl, for Vec.

nil :: Vec 0 a Source #

A zero-length Vec of any element type.

append_ :: Vec n a -> Vec m a -> Vec (n + m) a Source #

Concatenate two Vecs.

(++) :: Vec n a -> Vec m a -> Vec (n + m) a infixr 5 Source #

Concatenate two Vecs.

split :: forall m n a. SInt m -> Vec (m + n) a -> (Vec m a, Vec n a) Source #

Split a vector into two shorter vectors at the given index.

concat :: forall m n a. Vec n (Vec m a) -> Vec (n * m) a Source #

Concatenate a nested Vec into one longer Vec.

reshape :: SInt m -> Vec (n * m) a -> Vec n (Vec m a) Source #

Turn a vector into a vector of vector by chunking it.

concatMap :: forall m n a b. (a -> Vec m b) -> Vec n a -> Vec (n * m) b Source #

Map each element of a Vec to a (same-sized) sub-Vec of the result.

iterate :: SInt n -> (a -> a) -> a -> Vec n a Source #

Generate a Vec by repeated application of a function.

toList (Vec.iterate @n f z) === take (valueOf @n) (Prelude.iterate f z)

iterate' :: SInt n -> (a -> a) -> a -> Vec n a Source #

A strict version of iterate.

rev :: Vec n a -> Vec n a Source #

Return a copy of the array with elements in the reverse order.

rot :: Fin n -> Vec n a -> Vec n a Source #

Rotate a vector right by i positions.

rot 1 [x, y, z] = [z, x, y]

rot_ :: Fin n -> Vec n a -> Vec n a Source #

Rotate a vector right by i positions.

rot 1 [x, y, z] = [z, x, y]

viota :: SInt n -> Vec n (Fin n) Source #

Return a vector with all elements of the type in ascending order.

cross :: Vec m a -> Vec n b -> Vec n (Vec m (a, b)) Source #

One variant of the cross product of two vectors.

insert :: Fin (n + 1) -> a -> Vec n a -> Vec (n + 1) a Source #

Insert an element at the given position in a vector. O(n)

remove :: Fin (n + 1) -> Vec (n + 1) a -> Vec n a Source #

Remove an element at the given position in a vector. O(n)

vsort :: Ord a => Vec n a -> Vec n a Source #

Sort a Vec according to its Ord instance.

vsortBy :: (a -> a -> Ordering) -> Vec n a -> Vec n a Source #

Sort a Vec with a given comparison function.

vsortOn :: Ord b => (a -> b) -> Vec n a -> Vec n a Source #

Sort a Vec with a given sort-key function.

vtranspose :: SInt m -> Vec n (Vec m a) -> Vec m (Vec n a) Source #

Transpose a vector of vectors.

vfindIndex :: (a -> Bool) -> Vec n a -> Maybe (Fin n) Source #

Find the index of the first element, if any, that satisfies a predicate.

vec1 :: a -> Vec 1 a Source #

Create a singleton Vec.

vec2 :: a -> a -> Vec 2 a Source #

Create a Vec from two elements.

vec3 :: a -> a -> a -> Vec 3 a Source #

Create a Vec from three elements.

vec4 :: a -> a -> a -> a -> Vec 4 a Source #

Create a Vec from four elements.

vec6 :: a -> a -> a -> a -> a -> a -> Vec 6 a Source #

Create a Vec from six elements.

vec8 :: a -> a -> a -> a -> a -> a -> a -> a -> Vec 8 a Source #

Create a Vec from eight elements.

valueOf :: forall (n :: Nat) (i :: Type). (KnownNat n, Num i) => i Source #

Get the value of a statically known natural number.

overIx :: Fin n -> (a -> a) -> Vec n a -> Vec n a Source #

Modify the given index of a Vec.