Copyright | (c) 2020 Composewell Technologies |
---|---|
License | BSD3-3-Clause |
Maintainer | streamly@composewell.com |
Stability | experimental |
Portability | GHC |
Safe Haskell | None |
Language | Haskell2010 |
Unboxed pinned mutable array type for Storable
types with an option to use
foreign (non-GHC) memory allocators. Fulfils the following goals:
- Random access (array)
- Efficient storage (unboxed)
- Performance (unboxed access)
- Performance - in-place operations (mutable)
- Performance - GC (pinned, mutable)
- interfacing with OS (pinned)
- Fragmentation control (foreign allocators)
Stream and Fold APIs allow easy, efficient and convenient operations on arrays.
Synopsis
- data Array a = Array {}
- mutableArray :: ForeignPtr a -> Ptr a -> Ptr a -> Array a
- unsafeWithNewArray :: forall a. Storable a => Int -> (Ptr a -> IO ()) -> IO (Array a)
- newArray :: forall a. Storable a => Int -> IO (Array a)
- newArrayAligned :: forall a. Storable a => Int -> Int -> IO (Array a)
- newArrayAlignedUnmanaged :: forall a. Storable a => Int -> Int -> IO (Array a)
- newArrayAlignedAllocWith :: forall a. Storable a => (Int -> Int -> IO (ForeignPtr a)) -> Int -> Int -> IO (Array a)
- fromList :: Storable a => [a] -> Array a
- fromListN :: Storable a => Int -> [a] -> Array a
- fromStreamDN :: forall m a. (MonadIO m, Storable a) => Int -> Stream m a -> m (Array a)
- fromStreamD :: (MonadIO m, Storable a) => Stream m a -> m (Array a)
- realloc :: forall a. Storable a => Int -> Array a -> IO (Array a)
- shrinkToFit :: forall a. Storable a => Array a -> IO (Array a)
- length :: forall a. Storable a => Array a -> Int
- byteLength :: Array a -> Int
- byteCapacity :: Array a -> Int
- unsafeIndexIO :: forall a. Storable a => Array a -> Int -> IO a
- unsafeIndex :: forall a. Storable a => Array a -> Int -> a
- unsafeWriteIndex :: forall a. Storable a => Array a -> Int -> a -> IO (Array a)
- unsafeSnoc :: forall a. Storable a => Array a -> a -> IO (Array a)
- snoc :: forall a. Storable a => Array a -> a -> IO (Array a)
- foldl' :: forall a b. Storable a => (b -> a -> b) -> b -> Array a -> b
- foldr :: Storable a => (a -> b -> b) -> b -> Array a -> b
- toArrayMinChunk :: forall m a. (MonadIO m, Storable a) => Int -> Int -> Fold m a (Array a)
- writeNAllocWith :: forall m a. (MonadIO m, Storable a) => (Int -> IO (Array a)) -> Int -> Fold m a (Array a)
- writeN :: forall m a. (MonadIO m, Storable a) => Int -> Fold m a (Array a)
- writeNUnsafe :: forall m a. (MonadIO m, Storable a) => Int -> Fold m a (Array a)
- data ArrayUnsafe a = ArrayUnsafe !(ForeignPtr a) !(Ptr a)
- writeNAligned :: forall m a. (MonadIO m, Storable a) => Int -> Int -> Fold m a (Array a)
- writeNAlignedUnmanaged :: forall m a. (MonadIO m, Storable a) => Int -> Int -> Fold m a (Array a)
- write :: forall m a. (MonadIO m, Storable a) => Fold m a (Array a)
- writeAligned :: forall m a. (MonadIO m, Storable a) => Int -> Fold m a (Array a)
- data ReadUState a
- read :: forall m a. (Monad m, Storable a) => Unfold m (Array a) a
- readRev :: forall m a. (Monad m, Storable a) => Unfold m (Array a) a
- producer :: forall m a. (Monad m, Storable a) => Producer m (Array a) a
- flattenArrays :: forall m a. (MonadIO m, Storable a) => Stream m (Array a) -> Stream m a
- flattenArraysRev :: forall m a. (MonadIO m, Storable a) => Stream m (Array a) -> Stream m a
- toStreamD :: forall m a. (Monad m, Storable a) => Array a -> Stream m a
- toStreamDRev :: forall m a. (Monad m, Storable a) => Array a -> Stream m a
- toStreamK :: forall t m a. (IsStream t, Storable a) => Array a -> t m a
- toStreamKRev :: forall t m a. (IsStream t, Storable a) => Array a -> t m a
- toList :: Storable a => Array a -> [a]
- spliceWith :: MonadIO m => Array a -> Array a -> m (Array a)
- spliceWithDoubling :: (MonadIO m, Storable a) => Array a -> Array a -> m (Array a)
- spliceTwo :: (MonadIO m, Storable a) => Array a -> Array a -> m (Array a)
- breakOn :: MonadIO m => Word8 -> Array Word8 -> m (Array Word8, Maybe (Array Word8))
- splitAt :: forall a. Storable a => Int -> Array a -> (Array a, Array a)
- arraysOf :: forall m a. (MonadIO m, Storable a) => Int -> Stream m a -> Stream m (Array a)
- bufferChunks :: (MonadIO m, Storable a) => Stream m a -> m (Stream m (Array a))
- writeChunks :: Int -> Fold m a (Stream m (Array a))
- defaultChunkSize :: Int
- mkChunkSize :: Int -> Int
- mkChunkSizeKB :: Int -> Int
- bytesToElemCount :: Storable a => a -> Int -> Int
- unsafeInlineIO :: IO a -> a
- memcpy :: Ptr Word8 -> Ptr Word8 -> Int -> IO ()
- memcmp :: Ptr Word8 -> Ptr Word8 -> Int -> IO Bool
Type
We can use a Storable
constraint in the Array type and the constraint can
be automatically provided to a function that pattern matches on the Array
type. However, it has huge performance cost, so we do not use it.
Investigate a GHC improvement possiblity.
XXX Rename the fields to better names.
Instances
Storable a => IsList (Array a) Source # | |
(Storable a, Eq a) => Eq (Array a) Source # | |
(Storable a, Ord a) => Ord (Array a) Source # | |
(Storable a, Read a, Show a) => Read (Array a) Source # | |
(Show a, Storable a) => Show (Array a) Source # | |
a ~ Char => IsString (Array a) Source # | |
Defined in Streamly.Internal.Data.Array.Foreign.Mut.Type fromString :: String -> Array a # | |
Storable a => Semigroup (Array a) Source # | Copies the two arrays into a newly allocated array. |
Storable a => Monoid (Array a) Source # | |
(Storable a, NFData a) => NFData (Array a) Source # | |
type Item (Array a) Source # | |
Construction
mutableArray :: ForeignPtr a -> Ptr a -> Ptr a -> Array a Source #
unsafeWithNewArray :: forall a. Storable a => Int -> (Ptr a -> IO ()) -> IO (Array a) Source #
Allocate an Array of the given size and run an IO action passing the array start pointer.
newArray :: forall a. Storable a => Int -> IO (Array a) Source #
Allocate an array that can hold count
items. The memory of the array is
uninitialized.
Note that this is internal routine, the reference to this array cannot be given out until the array has been written to and frozen.
newArrayAlignedUnmanaged :: forall a. Storable a => Int -> Int -> IO (Array a) Source #
Allocate a new array aligned to the specified alignmend and using unmanaged pinned memory. The memory will not be automatically freed by GHC. This could be useful in allocate once global data structures. Use carefully as incorrect use can lead to memory leak.
newArrayAlignedAllocWith :: forall a. Storable a => (Int -> Int -> IO (ForeignPtr a)) -> Int -> Int -> IO (Array a) Source #
allocate a new array using the provided allocator function.
From containers
fromList :: Storable a => [a] -> Array a Source #
Create an Array
from a list. The list must be of finite size.
Since: 0.7.0
fromListN :: Storable a => Int -> [a] -> Array a Source #
Create an Array
from the first N elements of a list. The array is
allocated to size N, if the list terminates before N elements then the
array may hold less than N elements.
Since: 0.7.0
fromStreamDN :: forall m a. (MonadIO m, Storable a) => Int -> Stream m a -> m (Array a) Source #
Use the writeN
fold instead.
fromStreamDN n = D.fold (writeN n)
fromStreamD :: (MonadIO m, Storable a) => Stream m a -> m (Array a) Source #
We could take the approach of doubling the memory allocation on each overflow. This would result in more or less the same amount of copying as in the chunking approach. However, if we have to shrink in the end then it may result in an extra copy of the entire data.
fromStreamD = StreamD.fold Array.write
Resizing
shrinkToFit :: forall a. Storable a => Array a -> IO (Array a) Source #
Remove the free space from an Array.
Size
length :: forall a. Storable a => Array a -> Int Source #
O(1) Get the length of the array i.e. the number of elements in the array.
Since: 0.7.0
byteLength :: Array a -> Int Source #
O(1) Get the byte length of the array.
Since: 0.7.0
byteCapacity :: Array a -> Int Source #
Get the total capacity of an array. An array may have space reserved beyond the current used length of the array.
Pre-release
Random access
unsafeIndexIO :: forall a. Storable a => Array a -> Int -> IO a Source #
Return element at the specified index without checking the bounds.
Unsafe because it does not check the bounds of the array.
unsafeIndex :: forall a. Storable a => Array a -> Int -> a Source #
Return element at the specified index without checking the bounds.
Mutation
Folding
foldl' :: forall a b. Storable a => (b -> a -> b) -> b -> Array a -> b Source #
Strict left fold of an array.
Composable Folds
writeNAllocWith :: forall m a. (MonadIO m, Storable a) => (Int -> IO (Array a)) -> Int -> Fold m a (Array a) Source #
writeN :: forall m a. (MonadIO m, Storable a) => Int -> Fold m a (Array a) Source #
writeN n
folds a maximum of n
elements from the input stream to an
Array
.
writeN n = Fold.take n writeNUnsafe
Since: 0.7.0
writeNUnsafe :: forall m a. (MonadIO m, Storable a) => Int -> Fold m a (Array a) Source #
Like writeN
but does not check the array bounds when writing. The fold
driver must not call the step function more than n
times otherwise it will
corrupt the memory and crash. This function exists mainly because any
conditional in the step function blocks fusion causing 10x performance
slowdown.
Since: 0.7.0
data ArrayUnsafe a Source #
ArrayUnsafe !(ForeignPtr a) !(Ptr a) |
writeNAligned :: forall m a. (MonadIO m, Storable a) => Int -> Int -> Fold m a (Array a) Source #
writeNAligned alignment n
folds a maximum of n
elements from the input
stream to an Array
aligned to the given size.
Pre-release
writeNAlignedUnmanaged :: forall m a. (MonadIO m, Storable a) => Int -> Int -> Fold m a (Array a) Source #
writeNAlignedUnmanaged n
folds a maximum of n
elements from the input
stream to an Array
aligned to the given size and using unmanaged memory.
This could be useful to allocate memory that we need to allocate only once
in the lifetime of the program.
Pre-release
write :: forall m a. (MonadIO m, Storable a) => Fold m a (Array a) Source #
Fold the whole input to a single array.
Caution! Do not use this on infinite streams.
Since: 0.7.0
writeAligned :: forall m a. (MonadIO m, Storable a) => Int -> Fold m a (Array a) Source #
Like write
but the array memory is aligned according to the specified
alignment size. This could be useful when we have specific alignment, for
example, cache aligned arrays for lookup table etc.
Caution! Do not use this on infinite streams.
Since: 0.7.0
Unfolds
data ReadUState a Source #
read :: forall m a. (Monad m, Storable a) => Unfold m (Array a) a Source #
Unfold an array into a stream.
Since: 0.7.0
readRev :: forall m a. (Monad m, Storable a) => Unfold m (Array a) a Source #
Unfold an array into a stream in reverse order.
Pre-release
producer :: forall m a. (Monad m, Storable a) => Producer m (Array a) a Source #
Resumable unfold of an array.
flattenArrays :: forall m a. (MonadIO m, Storable a) => Stream m (Array a) -> Stream m a Source #
Use the "read" unfold instead.
flattenArrays = unfoldMany read
We can try this if there are any fusion issues in the unfold.
flattenArraysRev :: forall m a. (MonadIO m, Storable a) => Stream m (Array a) -> Stream m a Source #
Use the "readRev" unfold instead.
flattenArrays = unfoldMany readRev
We can try this if there are any fusion issues in the unfold.
To containers
toStreamD :: forall m a. (Monad m, Storable a) => Array a -> Stream m a Source #
Use the read
unfold instead.
toStreamD = D.unfold read
We can try this if the unfold has any performance issues.
toStreamDRev :: forall m a. (Monad m, Storable a) => Array a -> Stream m a Source #
Use the readRev
unfold instead.
toStreamDRev = D.unfold readRev
We can try this if the unfold has any perf issues.
Combining
spliceWith :: MonadIO m => Array a -> Array a -> m (Array a) Source #
Splice an array into a pre-reserved mutable array. The user must ensure that there is enough space in the mutable array, otherwise the splicing fails.
spliceWithDoubling :: (MonadIO m, Storable a) => Array a -> Array a -> m (Array a) Source #
Splice a new array into a preallocated mutable array, doubling the space if there is no space in the target array.
spliceTwo :: (MonadIO m, Storable a) => Array a -> Array a -> m (Array a) Source #
Copy two arrays into a newly allocated array.
Splitting
breakOn :: MonadIO m => Word8 -> Array Word8 -> m (Array Word8, Maybe (Array Word8)) Source #
Drops the separator byte
splitAt :: forall a. Storable a => Int -> Array a -> (Array a, Array a) Source #
Create two slices of an array without copying the original array. The
specified index i
is the first index of the second slice.
Since: 0.7.0
Stream of arrays
arraysOf :: forall m a. (MonadIO m, Storable a) => Int -> Stream m a -> Stream m (Array a) Source #
arraysOf n stream
groups the input stream into a stream of
arrays of size n.
arraysOf n = StreamD.foldMany (Array.writeN n)
Pre-release
bufferChunks :: (MonadIO m, Storable a) => Stream m a -> m (Stream m (Array a)) Source #
Buffer the stream into arrays in memory.
writeChunks :: Int -> Fold m a (Stream m (Array a)) Source #
Buffer a stream into a stream of arrays.
writeChunks = Fold.many Fold.toStream (Array.writeN n)
See bufferChunks
.
Unimplemented
Utilities
defaultChunkSize :: Int Source #
Default maximum buffer size in bytes, for reading from and writing to IO devices, the value is 32KB minus GHC allocation overhead, which is a few bytes, so that the actual allocation is 32KB.
mkChunkSize :: Int -> Int Source #
mkChunkSizeKB :: Int -> Int Source #
unsafeInlineIO :: IO a -> a Source #