#include "inline.hs"
module Streamly.Internal.Data.Array.Foreign
(
Array
, A.fromPtr
, A.fromAddr#
, A.fromCString#
, A.fromListN
, A.fromList
, fromStreamN
, fromStream
, A.writeN
, A.writeNAligned
, A.write
, writeLastN
, A.toList
, A.toStream
, A.toStreamRev
, read
, unsafeRead
, A.readRev
, producer
, getIndex
, A.unsafeIndex
, getIndexRev
, last
, getIndices
, getIndicesFromThenTo
, length
, null
, binarySearch
, findIndicesOf
, cast
, asBytes
, unsafeCast
, unsafeAsPtr
, unsafeAsCString
, A.unsafeFreeze
, A.unsafeThaw
, getSliceUnsafe
, genSlicesFromLen
, getSlicesFromLen
, splitOn
, streamTransform
, streamFold
, fold
)
where
import Control.Exception (assert)
import Control.Monad (when)
import Control.Monad.IO.Class (MonadIO(..))
import Data.Functor.Identity (Identity)
#if !(MIN_VERSION_base(4,11,0))
import Data.Semigroup ((<>))
#endif
import Data.Word (Word8)
import Foreign.C.String (CString)
import Foreign.Ptr (plusPtr, castPtr)
import Foreign.Storable (Storable(..))
import Prelude hiding (length, null, last, map, (!!), read, concat)
import GHC.Ptr (Ptr(..))
import Streamly.Internal.Data.Array.Foreign.Mut.Type (ReadUState(..), touch)
import Streamly.Internal.Data.Array.Foreign.Type (Array(..), length)
import Streamly.Internal.Data.Fold.Type (Fold(..))
import Streamly.Internal.Data.Producer.Type (Producer(..))
import Streamly.Internal.Data.Stream.Serial (SerialT(..))
import Streamly.Internal.Data.Tuple.Strict (Tuple3'(..))
import Streamly.Internal.Data.Unfold.Type (Unfold(..))
import Streamly.Internal.System.IO (unsafeInlineIO)
import qualified Streamly.Internal.Data.Array.Foreign.Mut.Type as MA
import qualified Streamly.Internal.Data.Array.Foreign.Mut as MA
import qualified Streamly.Internal.Data.Array.Foreign.Type as A
import qualified Streamly.Internal.Data.Fold as FL
import qualified Streamly.Internal.Data.Producer as Producer
import qualified Streamly.Internal.Data.Stream.IsStream.Type as IsStream
import qualified Streamly.Internal.Data.Stream.Prelude as P
import qualified Streamly.Internal.Data.Stream.StreamD as D
import qualified Streamly.Internal.Data.Unfold as Unfold
import qualified Streamly.Internal.Ring.Foreign as RB
{-# INLINE fromStreamN #-}
fromStreamN :: (MonadIO m, Storable a) => Int -> SerialT m a -> m (Array a)
fromStreamN :: Int -> SerialT m a -> m (Array a)
fromStreamN Int
n (SerialT Stream m a
m) = do
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> m ()
forall a. HasCallStack => [Char] -> a
error [Char]
"writeN: negative write count specified"
Int -> Stream m a -> m (Array a)
forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Int -> Stream m a -> m (Array a)
A.fromStreamDN Int
n (Stream m a -> m (Array a)) -> Stream m a -> m (Array a)
forall a b. (a -> b) -> a -> b
$ Stream m a -> Stream m a
forall (m :: * -> *) a. Applicative m => Stream m a -> Stream m a
D.fromStreamK Stream m a
m
{-# INLINE fromStream #-}
fromStream :: (MonadIO m, Storable a) => SerialT m a -> m (Array a)
fromStream :: SerialT m a -> m (Array a)
fromStream (SerialT Stream m a
m) = Fold m a (Array a) -> Stream m a -> m (Array a)
forall (m :: * -> *) a b.
Monad m =>
Fold m a b -> Stream m a -> m b
P.fold Fold m a (Array a)
forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Fold m a (Array a)
A.write Stream m a
m
{-# INLINE_NORMAL producer #-}
producer :: forall m a. (Monad m, Storable a) => Producer m (Array a) a
producer :: Producer m (Array a) a
producer = (ReadUState a -> m (Step (ReadUState a) a))
-> (Array a -> m (ReadUState a))
-> (ReadUState a -> m (Array a))
-> Producer m (Array a) a
forall (m :: * -> *) a b s.
(s -> m (Step s b)) -> (a -> m s) -> (s -> m a) -> Producer m a b
Producer ReadUState a -> m (Step (ReadUState a) a)
forall (m :: * -> *) a.
(Monad m, Storable a) =>
ReadUState a -> m (Step (ReadUState a) a)
step Array a -> m (ReadUState a)
forall (m :: * -> *) a. Monad m => Array a -> m (ReadUState a)
inject ReadUState a -> m (Array a)
forall (m :: * -> *) a. Monad m => ReadUState a -> m (Array a)
extract
where
{-# INLINE inject #-}
inject :: Array a -> m (ReadUState a)
inject (Array ArrayContents
contents Ptr a
start Ptr a
end) = ReadUState a -> m (ReadUState a)
forall (m :: * -> *) a. Monad m => a -> m a
return (ReadUState a -> m (ReadUState a))
-> ReadUState a -> m (ReadUState a)
forall a b. (a -> b) -> a -> b
$ ArrayContents -> Ptr a -> Ptr a -> ReadUState a
forall a. ArrayContents -> Ptr a -> Ptr a -> ReadUState a
ReadUState ArrayContents
contents Ptr a
end Ptr a
start
{-# INLINE_LATE step #-}
step :: ReadUState a -> m (Step (ReadUState a) a)
step (ReadUState ArrayContents
contents Ptr a
end Ptr a
cur)
| Bool -> Bool -> Bool
forall a. HasCallStack => Bool -> a -> a
assert (Ptr a
cur Ptr a -> Ptr a -> Bool
forall a. Ord a => a -> a -> Bool
<= Ptr a
end) (Ptr a
cur Ptr a -> Ptr a -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr a
end) =
let x :: ()
x = IO () -> ()
forall a. IO a -> a
unsafeInlineIO (IO () -> ()) -> IO () -> ()
forall a b. (a -> b) -> a -> b
$ ArrayContents -> IO ()
touch ArrayContents
contents
in ()
x () -> m (Step (ReadUState a) a) -> m (Step (ReadUState a) a)
`seq` Step (ReadUState a) a -> m (Step (ReadUState a) a)
forall (m :: * -> *) a. Monad m => a -> m a
return Step (ReadUState a) a
forall s a. Step s a
D.Stop
step (ReadUState ArrayContents
contents Ptr a
end Ptr a
cur) = do
let !x :: a
x = IO a -> a
forall a. IO a -> a
unsafeInlineIO (IO a -> a) -> IO a -> a
forall a b. (a -> b) -> a -> b
$ Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
peek Ptr a
cur
cur1 :: Ptr b
cur1 = Ptr a
cur Ptr a -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` a -> Int
forall a. Storable a => a -> Int
sizeOf (a
forall a. HasCallStack => a
undefined :: a)
Step (ReadUState a) a -> m (Step (ReadUState a) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ReadUState a) a -> m (Step (ReadUState a) a))
-> Step (ReadUState a) a -> m (Step (ReadUState a) a)
forall a b. (a -> b) -> a -> b
$ a -> ReadUState a -> Step (ReadUState a) a
forall s a. a -> s -> Step s a
D.Yield a
x (ArrayContents -> Ptr a -> Ptr a -> ReadUState a
forall a. ArrayContents -> Ptr a -> Ptr a -> ReadUState a
ReadUState ArrayContents
contents Ptr a
end Ptr a
forall b. Ptr b
cur1)
extract :: ReadUState a -> m (Array a)
extract (ReadUState ArrayContents
contents Ptr a
end Ptr a
cur) = Array a -> m (Array a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Array a -> m (Array a)) -> Array a -> m (Array a)
forall a b. (a -> b) -> a -> b
$ ArrayContents -> Ptr a -> Ptr a -> Array a
forall a. ArrayContents -> Ptr a -> Ptr a -> Array a
Array ArrayContents
contents Ptr a
cur Ptr a
end
{-# INLINE_NORMAL read #-}
read :: forall m a. (Monad m, Storable a) => Unfold m (Array a) a
read :: Unfold m (Array a) a
read = Producer m (Array a) a -> Unfold m (Array a) a
forall (m :: * -> *) a b. Producer m a b -> Unfold m a b
Producer.simplify Producer m (Array a) a
forall (m :: * -> *) a.
(Monad m, Storable a) =>
Producer m (Array a) a
producer
{-# INLINE_NORMAL unsafeRead #-}
unsafeRead :: forall m a. (Monad m, Storable a) => Unfold m (Array a) a
unsafeRead :: Unfold m (Array a) a
unsafeRead = (ReadUState a -> m (Step (ReadUState a) a))
-> (Array a -> m (ReadUState a)) -> Unfold m (Array a) a
forall (m :: * -> *) a b s.
(s -> m (Step s b)) -> (a -> m s) -> Unfold m a b
Unfold ReadUState a -> m (Step (ReadUState a) a)
forall (m :: * -> *) a.
(Monad m, Storable a) =>
ReadUState a -> m (Step (ReadUState a) a)
step Array a -> m (ReadUState a)
forall (m :: * -> *) a. Monad m => Array a -> m (ReadUState a)
inject
where
inject :: Array a -> m (ReadUState a)
inject (Array ArrayContents
contents Ptr a
start Ptr a
end) =
ReadUState a -> m (ReadUState a)
forall (m :: * -> *) a. Monad m => a -> m a
return (ArrayContents -> Ptr a -> Ptr a -> ReadUState a
forall a. ArrayContents -> Ptr a -> Ptr a -> ReadUState a
ReadUState ArrayContents
contents Ptr a
end Ptr a
start)
{-# INLINE_LATE step #-}
step :: ReadUState a -> m (Step (ReadUState a) a)
step (ReadUState ArrayContents
contents Ptr a
end Ptr a
p) = do
let !x :: a
x = IO a -> a
forall a. IO a -> a
unsafeInlineIO (IO a -> a) -> IO a -> a
forall a b. (a -> b) -> a -> b
$ do
a
r <- Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
peek Ptr a
p
ArrayContents -> IO ()
touch ArrayContents
contents
a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r
let !p1 :: Ptr b
p1 = Ptr a
p Ptr a -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` a -> Int
forall a. Storable a => a -> Int
sizeOf (a
forall a. HasCallStack => a
undefined :: a)
Step (ReadUState a) a -> m (Step (ReadUState a) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ReadUState a) a -> m (Step (ReadUState a) a))
-> Step (ReadUState a) a -> m (Step (ReadUState a) a)
forall a b. (a -> b) -> a -> b
$ a -> ReadUState a -> Step (ReadUState a) a
forall s a. a -> s -> Step s a
D.Yield a
x (ArrayContents -> Ptr a -> Ptr a -> ReadUState a
forall a. ArrayContents -> Ptr a -> Ptr a -> ReadUState a
ReadUState ArrayContents
contents Ptr a
end Ptr a
forall b. Ptr b
p1)
{-# INLINE null #-}
null :: Array a -> Bool
null :: Array a -> Bool
null Array a
arr = Array a -> Int
forall a. Array a -> Int
A.byteLength Array a
arr Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
{-# INLINE getIndexRev #-}
getIndexRev :: forall a. Storable a => Array a -> Int -> Maybe a
getIndexRev :: Array a -> Int -> Maybe a
getIndexRev Array a
arr Int
i =
IO (Maybe a) -> Maybe a
forall a. IO a -> a
unsafeInlineIO
(IO (Maybe a) -> Maybe a) -> IO (Maybe a) -> Maybe a
forall a b. (a -> b) -> a -> b
$ ArrayContents -> Ptr a -> (Ptr a -> IO (Maybe a)) -> IO (Maybe a)
forall (m :: * -> *) a b.
MonadIO m =>
ArrayContents -> Ptr a -> (Ptr a -> m b) -> m b
MA.unsafeWithArrayContents (Array a -> ArrayContents
forall a. Array a -> ArrayContents
arrContents Array a
arr) (Array a -> Ptr a
forall a. Array a -> Ptr a
arrStart Array a
arr)
((Ptr a -> IO (Maybe a)) -> IO (Maybe a))
-> (Ptr a -> IO (Maybe a)) -> IO (Maybe a)
forall a b. (a -> b) -> a -> b
$ \Ptr a
ptr -> do
let elemSize :: Int
elemSize = a -> Int
forall a. Storable a => a -> Int
sizeOf (a
forall a. HasCallStack => a
undefined :: a)
elemPtr :: Ptr b
elemPtr = Array a -> Ptr a
forall a. Array a -> Ptr a
aEnd Array a
arr Ptr a -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int -> Int
forall a. Num a => a -> a
negate (Int
elemSize Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Ptr a
forall b. Ptr b
elemPtr Ptr a -> Ptr a -> Bool
forall a. Ord a => a -> a -> Bool
>= Ptr a
ptr
then a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> IO a -> IO (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
peek Ptr a
forall b. Ptr b
elemPtr
else Maybe a -> IO (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
{-# INLINE last #-}
last :: Storable a => Array a -> Maybe a
last :: Array a -> Maybe a
last Array a
arr = Array a -> Int -> Maybe a
forall a. Storable a => Array a -> Int -> Maybe a
getIndexRev Array a
arr Int
0
{-# INLINE writeLastN #-}
writeLastN :: (Storable a, MonadIO m) => Int -> Fold m a (Array a)
writeLastN :: Int -> Fold m a (Array a)
writeLastN Int
n
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = (() -> Array a) -> Fold m a () -> Fold m a (Array a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Array a -> () -> Array a
forall a b. a -> b -> a
const Array a
forall a. Monoid a => a
mempty) Fold m a ()
forall (m :: * -> *) a. Monad m => Fold m a ()
FL.drain
| Bool
otherwise = Array a -> Array a
forall a. Array a -> Array a
A.unsafeFreeze (Array a -> Array a) -> Fold m a (Array a) -> Fold m a (Array a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Tuple3' (Ring a) (Ptr a) Int
-> a -> m (Step (Tuple3' (Ring a) (Ptr a) Int) (Array a)))
-> m (Step (Tuple3' (Ring a) (Ptr a) Int) (Array a))
-> (Tuple3' (Ring a) (Ptr a) Int -> m (Array a))
-> Fold m a (Array a)
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> Fold m a b
Fold Tuple3' (Ring a) (Ptr a) Int
-> a -> m (Step (Tuple3' (Ring a) (Ptr a) Int) (Array a))
forall (m :: * -> *) a c b.
(MonadIO m, Storable a, Num c) =>
Tuple3' (Ring a) (Ptr a) c
-> a -> m (Step (Tuple3' (Ring a) (Ptr a) c) b)
step m (Step (Tuple3' (Ring a) (Ptr a) Int) (Array a))
forall b. m (Step (Tuple3' (Ring a) (Ptr a) Int) b)
initial Tuple3' (Ring a) (Ptr a) Int -> m (Array a)
forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Tuple3' (Ring a) (Ptr a) Int -> m (Array a)
done
where
step :: Tuple3' (Ring a) (Ptr a) c
-> a -> m (Step (Tuple3' (Ring a) (Ptr a) c) b)
step (Tuple3' Ring a
rb Ptr a
rh c
i) a
a = do
Ptr a
rh1 <- IO (Ptr a) -> m (Ptr a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr a) -> m (Ptr a)) -> IO (Ptr a) -> m (Ptr a)
forall a b. (a -> b) -> a -> b
$ Ring a -> Ptr a -> a -> IO (Ptr a)
forall a. Storable a => Ring a -> Ptr a -> a -> IO (Ptr a)
RB.unsafeInsert Ring a
rb Ptr a
rh a
a
Step (Tuple3' (Ring a) (Ptr a) c) b
-> m (Step (Tuple3' (Ring a) (Ptr a) c) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Tuple3' (Ring a) (Ptr a) c) b
-> m (Step (Tuple3' (Ring a) (Ptr a) c) b))
-> Step (Tuple3' (Ring a) (Ptr a) c) b
-> m (Step (Tuple3' (Ring a) (Ptr a) c) b)
forall a b. (a -> b) -> a -> b
$ Tuple3' (Ring a) (Ptr a) c -> Step (Tuple3' (Ring a) (Ptr a) c) b
forall s b. s -> Step s b
FL.Partial (Tuple3' (Ring a) (Ptr a) c -> Step (Tuple3' (Ring a) (Ptr a) c) b)
-> Tuple3' (Ring a) (Ptr a) c
-> Step (Tuple3' (Ring a) (Ptr a) c) b
forall a b. (a -> b) -> a -> b
$ Ring a -> Ptr a -> c -> Tuple3' (Ring a) (Ptr a) c
forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' Ring a
rb Ptr a
rh1 (c
i c -> c -> c
forall a. Num a => a -> a -> a
+ c
1)
initial :: m (Step (Tuple3' (Ring a) (Ptr a) Int) b)
initial =
let f :: (a, b) -> Step (Tuple3' a b Int) b
f (a
a, b
b) = Tuple3' a b Int -> Step (Tuple3' a b Int) b
forall s b. s -> Step s b
FL.Partial (Tuple3' a b Int -> Step (Tuple3' a b Int) b)
-> Tuple3' a b Int -> Step (Tuple3' a b Int) b
forall a b. (a -> b) -> a -> b
$ a -> b -> Int -> Tuple3' a b Int
forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' a
a b
b (Int
0 :: Int)
in ((Ring a, Ptr a) -> Step (Tuple3' (Ring a) (Ptr a) Int) b)
-> m (Ring a, Ptr a) -> m (Step (Tuple3' (Ring a) (Ptr a) Int) b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Ring a, Ptr a) -> Step (Tuple3' (Ring a) (Ptr a) Int) b
forall a b b. (a, b) -> Step (Tuple3' a b Int) b
f (m (Ring a, Ptr a) -> m (Step (Tuple3' (Ring a) (Ptr a) Int) b))
-> m (Ring a, Ptr a) -> m (Step (Tuple3' (Ring a) (Ptr a) Int) b)
forall a b. (a -> b) -> a -> b
$ IO (Ring a, Ptr a) -> m (Ring a, Ptr a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ring a, Ptr a) -> m (Ring a, Ptr a))
-> IO (Ring a, Ptr a) -> m (Ring a, Ptr a)
forall a b. (a -> b) -> a -> b
$ Int -> IO (Ring a, Ptr a)
forall a. Storable a => Int -> IO (Ring a, Ptr a)
RB.new Int
n
done :: Tuple3' (Ring a) (Ptr a) Int -> m (Array a)
done (Tuple3' Ring a
rb Ptr a
rh Int
i) = do
Array a
arr <- IO (Array a) -> m (Array a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Array a) -> m (Array a)) -> IO (Array a) -> m (Array a)
forall a b. (a -> b) -> a -> b
$ Int -> IO (Array a)
forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Int -> m (Array a)
MA.newArray Int
n
Int
-> Ptr a
-> (Array a -> a -> m (Array a))
-> Array a
-> Ring a
-> m (Array a)
forall (m :: * -> *) a b.
(MonadIO m, Storable a) =>
Int -> Ptr a -> (b -> a -> m b) -> b -> Ring a -> m b
foldFunc Int
i Ptr a
rh Array a -> a -> m (Array a)
forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Array a -> a -> m (Array a)
snoc' Array a
arr Ring a
rb
snoc' :: Array a -> a -> m (Array a)
snoc' Array a
b a
a = IO (Array a) -> m (Array a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Array a) -> m (Array a)) -> IO (Array a) -> m (Array a)
forall a b. (a -> b) -> a -> b
$ Array a -> a -> IO (Array a)
forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Array a -> a -> m (Array a)
MA.snocUnsafe Array a
b a
a
foldFunc :: Int -> Ptr a -> (b -> a -> m b) -> b -> Ring a -> m b
foldFunc Int
i
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n = Ptr a -> (b -> a -> m b) -> b -> Ring a -> m b
forall (m :: * -> *) a b.
(MonadIO m, Storable a) =>
Ptr a -> (b -> a -> m b) -> b -> Ring a -> m b
RB.unsafeFoldRingM
| Bool
otherwise = Ptr a -> (b -> a -> m b) -> b -> Ring a -> m b
forall (m :: * -> *) a b.
(MonadIO m, Storable a) =>
Ptr a -> (b -> a -> m b) -> b -> Ring a -> m b
RB.unsafeFoldRingFullM
{-# INLINE binarySearch #-}
binarySearch :: a -> Array a -> Maybe Int
binarySearch :: a -> Array a -> Maybe Int
binarySearch = a -> Array a -> Maybe Int
forall a. HasCallStack => a
undefined
findIndicesOf :: (a -> Bool) -> Unfold Identity (Array a) Int
findIndicesOf :: (a -> Bool) -> Unfold Identity (Array a) Int
findIndicesOf = (a -> Bool) -> Unfold Identity (Array a) Int
forall a. HasCallStack => a
undefined
{-# INLINE getSliceUnsafe #-}
getSliceUnsafe ::
forall a. Storable a
=> Int
-> Int
-> Array a
-> Array a
getSliceUnsafe :: Int -> Int -> Array a -> Array a
getSliceUnsafe Int
index Int
len (Array ArrayContents
contents Ptr a
start Ptr a
e) =
let size :: Int
size = a -> Int
forall a. Storable a => a -> Int
sizeOf (a
forall a. HasCallStack => a
undefined :: a)
fp1 :: Ptr b
fp1 = Ptr a
start Ptr a -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
index Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
size)
end :: Ptr b
end = Ptr Any
forall b. Ptr b
fp1 Ptr Any -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
size)
in Bool -> Array a -> Array a
forall a. HasCallStack => Bool -> a -> a
assert (Ptr a
forall b. Ptr b
end Ptr a -> Ptr a -> Bool
forall a. Ord a => a -> a -> Bool
<= Ptr a
e) (ArrayContents -> Ptr a -> Ptr a -> Array a
forall a. ArrayContents -> Ptr a -> Ptr a -> Array a
Array ArrayContents
contents Ptr a
forall b. Ptr b
fp1 Ptr a
forall b. Ptr b
end)
{-# INLINE splitOn #-}
splitOn :: (Monad m, Storable a) =>
(a -> Bool) -> Array a -> SerialT m (Array a)
splitOn :: (a -> Bool) -> Array a -> SerialT m (Array a)
splitOn a -> Bool
predicate Array a
arr =
Stream m (Array a) -> SerialT m (Array a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(IsStream t, Monad m) =>
Stream m a -> t m a
IsStream.fromStreamD
(Stream m (Array a) -> SerialT m (Array a))
-> Stream m (Array a) -> SerialT m (Array a)
forall a b. (a -> b) -> a -> b
$ ((Int, Int) -> Array a)
-> Stream m (Int, Int) -> Stream m (Array a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Int
i, Int
len) -> Int -> Int -> Array a -> Array a
forall a. Storable a => Int -> Int -> Array a -> Array a
getSliceUnsafe Int
i Int
len Array a
arr)
(Stream m (Int, Int) -> Stream m (Array a))
-> Stream m (Int, Int) -> Stream m (Array a)
forall a b. (a -> b) -> a -> b
$ (a -> Bool) -> Stream m a -> Stream m (Int, Int)
forall (m :: * -> *) a.
Monad m =>
(a -> Bool) -> Stream m a -> Stream m (Int, Int)
D.sliceOnSuffix a -> Bool
predicate (Array a -> Stream m a
forall (m :: * -> *) a.
(Monad m, Storable a) =>
Array a -> Stream m a
A.toStreamD Array a
arr)
{-# INLINE genSlicesFromLen #-}
genSlicesFromLen :: forall m a. (Monad m, Storable a)
=> Int
-> Int
-> Unfold m (Array a) (Int, Int)
genSlicesFromLen :: Int -> Int -> Unfold m (Array a) (Int, Int)
genSlicesFromLen Int
from Int
len =
(Array a -> Array a)
-> Unfold m (Array a) (Int, Int) -> Unfold m (Array a) (Int, Int)
forall a c (m :: * -> *) b.
(a -> c) -> Unfold m c b -> Unfold m a b
Unfold.lmap Array a -> Array a
forall a. Array a -> Array a
A.unsafeThaw (Int -> Int -> Unfold m (Array a) (Int, Int)
forall (m :: * -> *) a.
(Monad m, Storable a) =>
Int -> Int -> Unfold m (Array a) (Int, Int)
MA.genSlicesFromLen Int
from Int
len)
{-# INLINE getSlicesFromLen #-}
getSlicesFromLen :: forall m a. (Monad m, Storable a)
=> Int
-> Int
-> Unfold m (Array a) (Array a)
getSlicesFromLen :: Int -> Int -> Unfold m (Array a) (Array a)
getSlicesFromLen Int
from Int
len =
(Array a -> Array a)
-> Unfold m (Array a) (Array a) -> Unfold m (Array a) (Array a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Array a -> Array a
forall a. Array a -> Array a
A.unsafeFreeze
(Unfold m (Array a) (Array a) -> Unfold m (Array a) (Array a))
-> Unfold m (Array a) (Array a) -> Unfold m (Array a) (Array a)
forall a b. (a -> b) -> a -> b
$ (Array a -> Array a)
-> Unfold m (Array a) (Array a) -> Unfold m (Array a) (Array a)
forall a c (m :: * -> *) b.
(a -> c) -> Unfold m c b -> Unfold m a b
Unfold.lmap Array a -> Array a
forall a. Array a -> Array a
A.unsafeThaw (Int -> Int -> Unfold m (Array a) (Array a)
forall (m :: * -> *) a.
(Monad m, Storable a) =>
Int -> Int -> Unfold m (Array a) (Array a)
MA.getSlicesFromLen Int
from Int
len)
{-# INLINE getIndex #-}
getIndex :: forall a. Storable a => Array a -> Int -> Maybe a
getIndex :: Array a -> Int -> Maybe a
getIndex Array a
arr Int
i =
IO (Maybe a) -> Maybe a
forall a. IO a -> a
unsafeInlineIO
(IO (Maybe a) -> Maybe a) -> IO (Maybe a) -> Maybe a
forall a b. (a -> b) -> a -> b
$ ArrayContents -> Ptr a -> (Ptr a -> IO (Maybe a)) -> IO (Maybe a)
forall (m :: * -> *) a b.
MonadIO m =>
ArrayContents -> Ptr a -> (Ptr a -> m b) -> m b
MA.unsafeWithArrayContents (Array a -> ArrayContents
forall a. Array a -> ArrayContents
arrContents Array a
arr) (Array a -> Ptr a
forall a. Array a -> Ptr a
arrStart Array a
arr)
((Ptr a -> IO (Maybe a)) -> IO (Maybe a))
-> (Ptr a -> IO (Maybe a)) -> IO (Maybe a)
forall a b. (a -> b) -> a -> b
$ \Ptr a
ptr -> do
let elemSize :: Int
elemSize = a -> Int
forall a. Storable a => a -> Int
sizeOf (a
forall a. HasCallStack => a
undefined :: a)
elemPtr :: Ptr b
elemPtr = Ptr a
ptr Ptr a -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
elemSize Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i)
if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Ptr Any
forall b. Ptr b
elemPtr Ptr Any -> Int -> Ptr a
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
elemSize Ptr a -> Ptr a -> Bool
forall a. Ord a => a -> a -> Bool
<= Array a -> Ptr a
forall a. Array a -> Ptr a
aEnd Array a
arr
then a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> IO a -> IO (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
peek Ptr a
forall b. Ptr b
elemPtr
else Maybe a -> IO (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
{-# INLINE getIndices #-}
getIndices :: Unfold m (Array a) Int -> Unfold m (Array a) a
getIndices :: Unfold m (Array a) Int -> Unfold m (Array a) a
getIndices = Unfold m (Array a) Int -> Unfold m (Array a) a
forall a. HasCallStack => a
undefined
{-# INLINE getIndicesFromThenTo #-}
getIndicesFromThenTo :: Unfold m (Int, Int, Int, Array a) a
getIndicesFromThenTo :: Unfold m (Int, Int, Int, Array a) a
getIndicesFromThenTo = Unfold m (Int, Int, Int, Array a) a
forall a. HasCallStack => a
undefined
{-# INLINE streamTransform #-}
streamTransform :: forall m a b. (MonadIO m, Storable a, Storable b)
=> (SerialT m a -> SerialT m b) -> Array a -> m (Array b)
streamTransform :: (SerialT m a -> SerialT m b) -> Array a -> m (Array b)
streamTransform SerialT m a -> SerialT m b
f Array a
arr =
Fold m b (Array b) -> Stream m b -> m (Array b)
forall (m :: * -> *) a b.
Monad m =>
Fold m a b -> Stream m a -> m b
P.fold (Int -> Fold m b (Array b)
forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Int -> Fold m a (Array a)
A.writeWith (Array a -> Int
forall a. Storable a => Array a -> Int
length Array a
arr)) (Stream m b -> m (Array b)) -> Stream m b -> m (Array b)
forall a b. (a -> b) -> a -> b
$ SerialT m b -> Stream m b
forall (m :: * -> *) a. SerialT m a -> Stream m a
getSerialT (SerialT m b -> Stream m b) -> SerialT m b -> Stream m b
forall a b. (a -> b) -> a -> b
$ SerialT m a -> SerialT m b
f (Array a -> SerialT m a
forall (m :: * -> *) a.
(Monad m, Storable a) =>
Array a -> SerialT m a
A.toStream Array a
arr)
unsafeCast ::
#ifdef DEVBUILD
Storable b =>
#endif
Array a -> Array b
unsafeCast :: Array a -> Array b
unsafeCast (Array ArrayContents
contents Ptr a
start Ptr a
end) =
ArrayContents -> Ptr b -> Ptr b -> Array b
forall a. ArrayContents -> Ptr a -> Ptr a -> Array a
Array ArrayContents
contents (Ptr a -> Ptr b
forall a b. Ptr a -> Ptr b
castPtr Ptr a
start) (Ptr a -> Ptr b
forall a b. Ptr a -> Ptr b
castPtr Ptr a
end)
asBytes :: Array a -> Array Word8
asBytes :: Array a -> Array Word8
asBytes = Array a -> Array Word8
forall a b. Array a -> Array b
unsafeCast
cast :: forall a b. (Storable b) => Array a -> Maybe (Array b)
cast :: Array a -> Maybe (Array b)
cast Array a
arr =
let len :: Int
len = Array a -> Int
forall a. Array a -> Int
A.byteLength Array a
arr
r :: Int
r = Int
len Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` b -> Int
forall a. Storable a => a -> Int
sizeOf (b
forall a. HasCallStack => a
undefined :: b)
in if Int
r Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0
then Maybe (Array b)
forall a. Maybe a
Nothing
else Array b -> Maybe (Array b)
forall a. a -> Maybe a
Just (Array b -> Maybe (Array b)) -> Array b -> Maybe (Array b)
forall a b. (a -> b) -> a -> b
$ Array a -> Array b
forall a b. Array a -> Array b
unsafeCast Array a
arr
unsafeAsPtr :: Array a -> (Ptr b -> IO c) -> IO c
unsafeAsPtr :: Array a -> (Ptr b -> IO c) -> IO c
unsafeAsPtr Array{Ptr a
ArrayContents
aEnd :: Ptr a
arrStart :: Ptr a
arrContents :: ArrayContents
aEnd :: forall a. Array a -> Ptr a
arrStart :: forall a. Array a -> Ptr a
arrContents :: forall a. Array a -> ArrayContents
..} Ptr b -> IO c
act = do
ArrayContents -> Ptr a -> (Ptr a -> IO c) -> IO c
forall (m :: * -> *) a b.
MonadIO m =>
ArrayContents -> Ptr a -> (Ptr a -> m b) -> m b
MA.unsafeWithArrayContents ArrayContents
arrContents Ptr a
arrStart ((Ptr a -> IO c) -> IO c) -> (Ptr a -> IO c) -> IO c
forall a b. (a -> b) -> a -> b
$ \Ptr a
ptr -> Ptr b -> IO c
act (Ptr a -> Ptr b
forall a b. Ptr a -> Ptr b
castPtr Ptr a
ptr)
unsafeAsCString :: Array a -> (CString -> IO b) -> IO b
unsafeAsCString :: Array a -> (CString -> IO b) -> IO b
unsafeAsCString Array a
arr CString -> IO b
act = do
let Array{Ptr Word8
ArrayContents
aEnd :: Ptr Word8
arrStart :: Ptr Word8
arrContents :: ArrayContents
aEnd :: forall a. Array a -> Ptr a
arrStart :: forall a. Array a -> Ptr a
arrContents :: forall a. Array a -> ArrayContents
..} = Array a -> Array Word8
forall a. Array a -> Array Word8
asBytes Array a
arr Array Word8 -> Array Word8 -> Array Word8
forall a. Semigroup a => a -> a -> a
<> [Word8] -> Array Word8
forall a. Storable a => [a] -> Array a
A.fromList [Word8
0]
ArrayContents -> Ptr Word8 -> (Ptr Word8 -> IO b) -> IO b
forall (m :: * -> *) a b.
MonadIO m =>
ArrayContents -> Ptr a -> (Ptr a -> m b) -> m b
MA.unsafeWithArrayContents ArrayContents
arrContents Ptr Word8
arrStart ((Ptr Word8 -> IO b) -> IO b) -> (Ptr Word8 -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr -> CString -> IO b
act (Ptr Word8 -> CString
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
ptr)
{-# INLINE fold #-}
fold :: forall m a b. (MonadIO m, Storable a) => Fold m a b -> Array a -> m b
fold :: Fold m a b -> Array a -> m b
fold Fold m a b
f Array a
arr = Fold m a b -> Stream m a -> m b
forall (m :: * -> *) a b.
Monad m =>
Fold m a b -> Stream m a -> m b
P.fold Fold m a b
f (SerialT m a -> Stream m a
forall (m :: * -> *) a. SerialT m a -> Stream m a
getSerialT (Array a -> SerialT m a
forall (m :: * -> *) a.
(Monad m, Storable a) =>
Array a -> SerialT m a
A.toStream Array a
arr))
{-# INLINE streamFold #-}
streamFold :: (MonadIO m, Storable a) => (SerialT m a -> m b) -> Array a -> m b
streamFold :: (SerialT m a -> m b) -> Array a -> m b
streamFold SerialT m a -> m b
f Array a
arr = SerialT m a -> m b
f (Array a -> SerialT m a
forall (m :: * -> *) a.
(Monad m, Storable a) =>
Array a -> SerialT m a
A.toStream Array a
arr)