3-- Module : Streamly.Internal.Data.Array
4-- Copyright : (c) 2019 Composewell Technologies
6-- Maintainer : streamly@composewell.com
7-- Stability : experimental
10module Streamly.Internal.Data.Array
19 module Streamly.Internal.Data.Array.Type
29 , last -- XXX getLastIndex?
30 -- , getIndicesFrom -- read from a given position to the end of file
31 -- , getIndicesUpto -- read from beginning up to the given position
33 -- , getIndicesFromRev -- read from a given position to the beginning of file
34 -- , getIndicesUptoRev -- read from end to the given position in file
36 , indexReaderFromThenTo
45 , indexFinder -- see splitOn
62 -- * Streaming Operations
71 -- XXX these are probably not very useful to have in this module as we can
72 -- express these idiomatically using streams.
100#include "ArrayMacros.h"
102import Control.Monad.IO.Class (MonadIO(..))
103-- import Data.Bifunctor (first)
104-- import Data.Either (fromRight)
105import Data.Functor.Identity (Identity)
106import Data.Proxy (Proxy(..))
107import Data.Word (Word8)
108import Foreign.C.String (CString)
109import Foreign.Ptr (castPtr)
110import Foreign.Storable (Storable)
111import GHC.Types (SPEC(..))
112import Streamly.Internal.Data.Unbox (Unbox(..))
113import Prelude hiding (length, null, last, map, (!!), read, concat)
115import Streamly.Internal.Data.MutByteArray.Type (PinnedState(..), MutByteArray)
116import Streamly.Internal.Data.Serialize.Type (Serialize)
117import Streamly.Internal.Data.Fold.Type (Fold(..))
118import Streamly.Internal.Data.Parser (Parser(..), Initial(..), ParseError(..))
119import Streamly.Internal.Data.Stream (Stream(..))
120import Streamly.Internal.Data.StreamK (StreamK)
121import Streamly.Internal.Data.SVar.Type (adaptState, defState)
122import Streamly.Internal.Data.Tuple.Strict (Tuple'(..), Tuple3Fused'(..))
123import Streamly.Internal.Data.Unfold.Type (Unfold(..))
124import Streamly.Internal.System.IO (unsafeInlineIO)
126import qualified Streamly.Internal.Data.Fold.Type as Fold
127import qualified Streamly.Internal.Data.Serialize.Type as Serialize
128import qualified Streamly.Internal.Data.MutByteArray.Type as MBA
129import qualified Streamly.Internal.Data.MutArray as MA
130import qualified Streamly.Internal.Data.Fold as FL
131import qualified Streamly.Internal.Data.Ring as RB
132import qualified Streamly.Internal.Data.Parser as Parser
133-- import qualified Streamly.Internal.Data.ParserK as ParserK
134import qualified Streamly.Internal.Data.Stream as D
135import qualified Streamly.Internal.Data.Stream as Stream
136import qualified Streamly.Internal.Data.StreamK as StreamK
137import qualified Streamly.Internal.Data.Unfold as Unfold
138import qualified Prelude
140import Streamly.Internal.Data.Array.Type
142#include "DocTestDataArray.hs"
148-- * Arrays are finite and fixed in size
149-- * provide /O(1)/ access to elements
150-- * store only data and not functions
151-- * provide efficient IO interfacing
153-- 'Foldable' instance is not provided because the implementation would be much
154-- less efficient compared to folding via streams. 'Semigroup' and 'Monoid'
155-- instances should be used with care; concatenating arrays using binary
156-- operations can be highly inefficient. Instead, use
157-- 'Streamly.Internal.Data.Stream.Chunked.toArray' to concatenate N
160-- Each array is one pointer visible to the GC. Too many small arrays (e.g.
161-- single byte) are only as good as holding those elements in a Haskell list.
162-- However, small arrays can be compacted into large ones to reduce the
163-- overhead. To hold 32GB memory in 32k sized buffers we need 1 million arrays
164-- if we use one array for each chunk. This is still significant to add
167-------------------------------------------------------------------------------
169-------------------------------------------------------------------------------
173-- >>> null arr = Array.byteLength arr == 0
177null :: Array a -> Bool
178null arr = byteLength arr == 0
180-- | Like 'getIndex' but indexes the array in reverse from the end.
183{-# INLINE getIndexRev #-}
184getIndexRev :: forall a. Unbox a => Int -> Array a -> Maybe a
188 let elemPtr = RINDEX_OF(arrEnd arr, i, a)
189 if i >= 0 && elemPtr >= arrStart arr
190 then Just <$> peekAt elemPtr (arrContents arr)
195-- >>> last arr = Array.getIndexRev arr 0
199last :: Unbox a => Array a -> Maybe a
202-------------------------------------------------------------------------------
203-- Folds with Array as the container
204-------------------------------------------------------------------------------
206-- | @writeLastN n@ folds a maximum of @n@ elements from the end of the input
207-- stream to an 'Array'.
209{-# INLINE writeLastN #-}
211 (Storable a, Unbox a, MonadIO m) => Int -> Fold m a (Array a)
213 | n <= 0 = fmap (const mempty) FL.drain
214 | otherwise = unsafeFreeze <$> Fold step initial done done
218 step (Tuple3Fused' rb rh i) a = do
219 rh1 <- liftIO $ RB.unsafeInsert rb rh a
220 return $ FL.Partial $ Tuple3Fused' rb rh1 (i + 1)
223 let f (a, b) = FL.Partial $ Tuple3Fused' a b (0 :: Int)
224 in fmap f $ liftIO $ RB.new n
226 done (Tuple3Fused' rb rh i) = do
228 -- XXX We should write a read unfold for ring.
229 foldFunc i rh MA.snocUnsafe arr rb
232 | i < n = RB.unsafeFoldRingM
233 | otherwise = RB.unsafeFoldRingFullM
235-------------------------------------------------------------------------------
237-------------------------------------------------------------------------------
239-------------------------------------------------------------------------------
241-------------------------------------------------------------------------------
243-- | Given a sorted array, perform a binary search to find the given element.
244-- Returns the index of the element if found.
247{-# INLINE binarySearch #-}
248binarySearch :: a -> Array a -> Maybe Int
249binarySearch = undefined
251-- find/findIndex etc can potentially be implemented more efficiently on arrays
252-- compared to streams by using SIMD instructions.
253-- We can also return a bit array instead.
257-- | Perform a linear search to find all the indices where a given element is
258-- present in an array.
261indexFinder :: (a -> Bool) -> Unfold Identity (Array a) Int
262indexFinder = undefined
266findIndicesOf :: (a -> Bool) -> Array a -> Stream Identity Int
267findIndicesOf p = Stream.unfold (indexFinder p)
270findIndexOf :: (a -> Bool) -> Array a -> Maybe Int
271findIndexOf p = Unfold.fold Fold.one . Stream.unfold (indexFinder p)
273find :: (a -> Bool) -> Array a -> Bool
274find = Unfold.fold Fold.null . Stream.unfold (indexFinder p)
277-------------------------------------------------------------------------------
279-------------------------------------------------------------------------------
281-- XXX We can potentially use SIMD instructions on arrays to fold faster.
283-------------------------------------------------------------------------------
285-------------------------------------------------------------------------------
287-- | /O(1)/ Slice an array in constant time.
289-- Caution: The bounds of the slice are not checked.
294{-# INLINE getSliceUnsafe #-}
297 => Int -- ^ starting index
298 -> Int -- ^ length of the slice
301getSliceUnsafe index len (Array contents start e) =
302 let size = SIZE_OF(a)
303 start1 = start + (index * size)
304 end1 = start1 + (len * size)
305 in assert (end1 <= e) (Array contents start1 end1)
307-- | Split the array into a stream of slices using a predicate. The element
308-- matching the predicate is dropped.
311{-# INLINE splitOn #-}
312splitOn :: (Monad m, Unbox a) =>
313 (a -> Bool) -> Array a -> Stream m (Array a)
314splitOn predicate arr =
315 fmap (\(i, len) -> getSliceUnsafe i len arr)
316 $ D.indexOnSuffix predicate (read arr)
318{-# INLINE sliceIndexerFromLen #-}
319sliceIndexerFromLen :: forall m a. (Monad m, Unbox a)
320 => Int -- ^ from index
321 -> Int -- ^ length of the slice
322 -> Unfold m (Array a) (Int, Int)
323sliceIndexerFromLen from len =
324 Unfold.lmap unsafeThaw (MA.sliceIndexerFromLen from len)
326{-# DEPRECATED genSlicesFromLen "Please use sliceIndexerFromLen instead." #-}
327genSlicesFromLen :: forall m a. (Monad m, Unbox a)
328 => Int -- ^ from index
329 -> Int -- ^ length of the slice
330 -> Unfold m (Array a) (Int, Int)
331genSlicesFromLen = sliceIndexerFromLen
333-- | Generate a stream of slices of specified length from an array, starting
334-- from the supplied array index. The last slice may be shorter than the
338{-# INLINE slicerFromLen #-}
339slicerFromLen :: forall m a. (Monad m, Unbox a)
340 => Int -- ^ from index
341 -> Int -- ^ length of the slice
342 -> Unfold m (Array a) (Array a)
343slicerFromLen from len =
345 $ Unfold.lmap unsafeThaw (MA.slicerFromLen from len)
347{-# DEPRECATED getSlicesFromLen "Please use slicerFromLen instead." #-}
348getSlicesFromLen :: forall m a. (Monad m, Unbox a)
349 => Int -- ^ from index
350 -> Int -- ^ length of the slice
351 -> Unfold m (Array a) (Array a)
352getSlicesFromLen = slicerFromLen
354-------------------------------------------------------------------------------
355-- Random reads and writes
356-------------------------------------------------------------------------------
358-- XXX Change this to a partial function instead of a Maybe type? And use
359-- MA.getIndex instead.
361-- | /O(1)/ Lookup the element at the given index. Index starts from 0.
363{-# INLINE getIndex #-}
364getIndex :: forall a. Unbox a => Int -> Array a -> Maybe a
368 let elemPtr = INDEX_OF(arrStart arr, i, a)
369 if i >= 0 && INDEX_VALID(elemPtr, arrEnd arr, a)
370 then Just <$> peekAt elemPtr (arrContents arr)
373-- | Given a stream of array indices, read the elements on those indices from
374-- the supplied Array. An exception is thrown if an index is out of bounds.
376-- This is the most general operation. We can implement other operations in
381-- let u = lmap (\arr -> (0, length arr - 1)) Unfold.enumerateFromTo
382-- in Unfold.lmap f (indexReader arr)
385-- let i = length arr - 1
386-- in Unfold.lmap f (indexReaderFromThenTo i (i - 1) 0)
390{-# INLINE indexReader #-}
391indexReader :: (Monad m, Unbox a) => Stream m Int -> Unfold m (Array a) a
393 let unf = MA.indexReaderWith (return . unsafeInlineIO) m
394 in Unfold.lmap unsafeThaw unf
396-- XXX DO NOT REMOVE, change the signature to use Stream instead of unfold
397{-# DEPRECATED getIndices "Please use getIndices instead." #-}
398getIndices :: (Monad m, Unbox a) => Stream m Int -> Unfold m (Array a) a
399getIndices = indexReader
401-- | Unfolds @(from, then, to, array)@ generating a finite stream whose first
402-- element is the array value from the index @from@ and the successive elements
403-- are from the indices in increments of @then@ up to @to@. Index enumeration
404-- can occur downwards or upwards depending on whether @then@ comes before or
408-- getIndicesFromThenTo =
409-- let f (from, next, to, arr) =
410-- (Stream.enumerateFromThenTo from next to, arr)
411-- in Unfold.lmap f getIndices
415{-# INLINE indexReaderFromThenTo #-}
416indexReaderFromThenTo :: Unfold m (Int, Int, Int, Array a) a
417indexReaderFromThenTo = undefined
419-------------------------------------------------------------------------------
420-- Transform via stream operations
421-------------------------------------------------------------------------------
423-- for non-length changing operations we can use the original length for
424-- allocation. If we can predict the length then we can use the prediction for
425-- new allocation. Otherwise we can use a hint and adjust dynamically.
428-- | Transform an array into another array using a pipe transformation
431{-# INLINE runPipe #-}
432runPipe :: (MonadIO m, Unbox a, Unbox b)
433 => Pipe m a b -> Array a -> m (Array b)
434runPipe f arr = P.runPipe (toArrayMinChunk (length arr)) $ f (read arr)
437-- XXX For transformations that cannot change the number of elements e.g. "map"
438-- we can use a predetermined array length.
440-- | Transform an array into another array using a stream transformation
444{-# INLINE streamTransform #-}
445streamTransform :: forall m a b. (MonadIO m, Unbox a, Unbox b)
446 => (Stream m a -> Stream m b) -> Array a -> m (Array b)
447streamTransform f arr =
448 Stream.fold (writeWith (length arr)) $ f (read arr)
450-------------------------------------------------------------------------------
452-------------------------------------------------------------------------------
454-- | Cast an array having elements of type @a@ into an array having elements of
455-- type @b@. The array size must be a multiple of the size of type @b@
456-- otherwise accessing the last element of the array may result into a crash or
466castUnsafe (Array contents start end) =
467 Array contents start end
469-- | Cast an @Array a@ into an @Array Word8@.
472asBytes :: Array a -> Array Word8
475-- | Cast an array having elements of type @a@ into an array having elements of
476-- type @b@. The length of the array should be a multiple of the size of the
477-- target element otherwise 'Nothing' is returned.
480cast :: forall a b. (Unbox b) => Array a -> Maybe (Array b)
482 let len = byteLength arr
483 r = len `mod` SIZE_OF(b)
486 else Just $ castUnsafe arr
488-- | Convert an array of any type into a null terminated CString Ptr. If the
489-- array is unpinned it is first converted to a pinned array which requires a
494-- /O(n) Time: (creates a copy of the array)/
498asCStringUnsafe :: Array a -> (CString -> IO b) -> IO b
499asCStringUnsafe arr act = do
500 let arr1 = asBytes arr <> fromList [0]
501 -- asPtrUnsafe makes sure the array is pinned
502 asPtrUnsafe arr1 $ \ptr -> act (castPtr ptr)
504-------------------------------------------------------------------------------
506-------------------------------------------------------------------------------
508-- XXX We can directly use toStreamD and D.fold here.
510-- | Fold an array using a 'Fold'.
514fold :: forall m a b. (Monad m, Unbox a) => Fold m a b -> Array a -> m b
515fold f arr = Stream.fold f (read arr)
517-- | Fold an array using a stream fold operation.
520{-# INLINE streamFold #-}
521streamFold :: (Monad m, Unbox a) => (Stream m a -> m b) -> Array a -> m b
522streamFold f arr = f (read arr)
524--------------------------------------------------------------------------------
526--------------------------------------------------------------------------------
528{-# INLINE encodeAs #-}
529encodeAs :: forall a. Serialize a => PinnedState -> a -> Array Word8
532 let len = Serialize.addSizeTo 0 a
533 mbarr <- MBA.newBytesAs ps len
534 off <- Serialize.serializeAt 0 mbarr a
536 pure $ Array mbarr 0 off
540-- 1. Identity: @deserialize . serialize == id@
541-- 2. Encoded equivalence: @serialize a == serialize a@
542{-# INLINE serialize #-}
543serialize :: Serialize a => a -> Array Word8
544serialize = encodeAs Unpinned
546-- | Serialize a Haskell type to a pinned byte array. The array is allocated
547-- using pinned memory so that it can be used directly in OS APIs for writing
548-- to file or sending over the network.
551-- 1. Identity: @deserialize . pinnedSerialize == id@
552-- 2. Encoded equivalence: @pinnedSerialize a == pinnedSerialize a@
553{-# INLINE pinnedSerialize #-}
554pinnedSerialize :: Serialize a => a -> Array Word8
555pinnedSerialize = encodeAs Pinned
557-- | Decode a Haskell type from a byte array containing its serialized
559{-# INLINE deserialize #-}
560deserialize :: Serialize a => Array Word8 -> a
561deserialize arr@(Array {..}) = unsafeInlineIO $ do
562 let lenArr = length arr
564 Serialize.deserializeAt arrStart arrContents (arrStart + lenArr)
565 assertM(off == arrStart + lenArr)
568-------------------------------------------------------------------------------
570-------------------------------------------------------------------------------
572-- TODO: efficiently compare two streams of arrays. Two streams can have chunks
573-- of different sizes, we can handle that in the stream comparison abstraction.
574-- This could be useful e.g. to fast compare whether two files differ.
576-- | Insert the given element between arrays and flatten.
578-- >>> interpose x = Stream.interpose x Array.reader
580{-# INLINE interpose #-}
581interpose :: (Monad m, Unbox a) => a -> Stream m (Array a) -> Stream m a
582interpose x = D.interpose x reader
586 | InnerLoop s !MutByteArray !Int !Int
588-- | Insert the given element after each array and flatten. This is similar to
591-- >>> interposeSuffix x = Stream.interposeSuffix x Array.reader
593{-# INLINE_NORMAL interposeSuffix #-}
594interposeSuffix :: forall m a. (MonadIO m, Unbox a)
595 => a -> Stream m (Array a) -> Stream m a
596-- This does not require MonadIO constraint.
597-- interposeSuffix x = D.interposeSuffix x reader
598interposeSuffix sep (D.Stream step state) = D.Stream step' (OuterLoop state)
602 {-# INLINE_LATE step' #-}
603 step' gst (OuterLoop st) = do
604 r <- step (adaptState gst) st
606 D.Yield Array{..} s ->
607 D.Skip (InnerLoop s arrContents arrStart arrEnd)
608 D.Skip s -> D.Skip (OuterLoop s)
611 step' _ (InnerLoop st _ p end) | p == end =
612 return $ D.Yield sep $ OuterLoop st
614 step' _ (InnerLoop st contents p end) = do
615 x <- liftIO $ peekAt p contents
616 return $ D.Yield x (InnerLoop st contents (INDEX_NEXT(p,a)) end)
618-- | Insert the given array after each array and flatten.
620-- >>> intercalateSuffix = Stream.intercalateSuffix Array.reader
622{-# INLINE intercalateSuffix #-}
623intercalateSuffix :: (Monad m, Unbox a)
624 => Array a -> Stream m (Array a) -> Stream m a
625intercalateSuffix = D.intercalateSuffix reader
627-- | Split a stream of arrays on a given separator byte, dropping the separator
628-- and coalescing all the arrays between two separators into a single array.
630{-# INLINE compactOnByte #-}
634 -> Stream m (Array Word8)
635 -> Stream m (Array Word8)
637 fmap unsafeFreeze . MA.compactOnByte byte . fmap unsafeThaw
639-- | Like 'compactOnByte' considers the separator in suffix position instead of
641{-# INLINE compactOnByteSuffix #-}
645 -> Stream m (Array Word8)
646 -> Stream m (Array Word8)
647compactOnByteSuffix byte =
648 fmap unsafeFreeze . MA.compactOnByteSuffix byte . fmap unsafeThaw
650-------------------------------------------------------------------------------
651-- Folding Streams of Arrays
652-------------------------------------------------------------------------------
654-- XXX This should not be used for breaking a stream as the D.cons used in
655-- reconstructing the stream could be very bad for performance. This can only
656-- be useful in folding without breaking.
657{-# INLINE_NORMAL foldBreakChunks #-}
658foldBreakChunks :: forall m a b. (MonadIO m, Unbox a) =>
659 Fold m a b -> Stream m (Array a) -> m (b, Stream m (Array a))
660foldBreakChunks (Fold fstep initial _ final) stream@(Stream step state) = do
663 Fold.Partial fs -> go SPEC state fs
664 Fold.Done fb -> return $! (fb, stream)
670 r <- step defState st
672 Stream.Yield (Array contents start end) s ->
673 let fp = Tuple' end contents
674 in goArray SPEC s fp start fs
675 Stream.Skip s -> go SPEC s fs
680 goArray !_ s (Tuple' end _) !cur !fs
683 goArray !_ st fp@(Tuple' end contents) !cur !fs = do
684 x <- liftIO $ peekAt cur contents
686 let next = INDEX_NEXT(cur,a)
689 let arr = Array contents next end
690 return $! (b, D.cons arr (D.Stream step st))
691 Fold.Partial fs1 -> goArray SPEC st fp next fs1
693-- This may be more robust wrt fusion compared to unfoldMany?
695-- | Fold a stream of arrays using a 'Fold'. This is equivalent to the
698-- >>> foldChunks f = Stream.fold f . Stream.unfoldMany Array.reader
700foldChunks :: (MonadIO m, Unbox a) => Fold m a b -> Stream m (Array a) -> m b
701foldChunks f s = fmap fst (foldBreakChunks f s)
702-- foldStream f = Stream.fold f . Stream.unfoldMany reader
704-- | Fold a stream of arrays using a 'Fold' and return the remaining stream.
706-- The following alternative to this function allows composing the fold using
710-- foldBreakStreamK f s =
711-- fmap (first (fromRight undefined))
712-- $ StreamK.parseBreakChunks (ParserK.adaptC (Parser.fromFold f)) s
715-- We can compare perf and remove this one or define it in terms of that.
717foldBreakChunksK :: forall m a b. (MonadIO m, Unbox a) =>
718 Fold m a b -> StreamK m (Array a) -> m (b, StreamK m (Array a))
720foldBreakChunksK f s =
721 fmap (first (fromRight undefined))
722 $ StreamK.parseBreakChunks (ParserK.adaptC (Parser.fromFold f)) s
724foldBreakChunksK (Fold fstep initial _ final) stream = do
727 Fold.Partial fs -> go fs stream
728 Fold.Done fb -> return (fb, stream)
734 let stop = (, StreamK.nil) <$> final fs
735 single a = yieldk a StreamK.nil
736 yieldk (Array contents start end) r =
737 let fp = Tuple' end contents
738 in goArray fs r fp start
739 in StreamK.foldStream defState yieldk single stop st
741 goArray !fs st (Tuple' end _) !cur
744 goArray !fs st fp@(Tuple' end contents) !cur = do
745 x <- liftIO $ peekAt cur contents
747 let next = INDEX_NEXT(cur,a)
750 let arr = Array contents next end
751 return $! (b, StreamK.cons arr st)
752 Fold.Partial fs1 -> goArray fs1 st fp next
755-- This can be generalized to any type provided it can be unfolded to a stream
756-- and it can be combined using a semigroup operation.
758{-# INLINE_NORMAL parseBreakD #-}
760 forall m a b. (MonadIO m, MonadThrow m, Unbox a)
762 -> D.Stream m (Array.Array a)
763 -> m (b, D.Stream m (Array.Array a))
765 (PRD.Parser pstep initial extract) stream@(D.Stream step state) = do
769 PRD.IPartial s -> go SPEC state (List []) s
770 PRD.IDone b -> return (b, stream)
771 PRD.IError err -> throwM $ ParseError err
775 -- "backBuf" contains last few items in the stream that we may have to
778 -- XXX currently we are using a dumb list based approach for backtracking
779 -- buffer. This can be replaced by a sliding/ring buffer using Data.Array.
780 -- That will allow us more efficient random back and forth movement.
781 go !_ st backBuf !pst = do
782 r <- step defState st
784 D.Yield (Array contents start end) s ->
786 (Tuple' end contents) start pst
787 D.Skip s -> go SPEC s backBuf pst
792 -- Use strictness on "cur" to keep it unboxed
793 gobuf !_ s backBuf (Tuple' end _) !cur !pst
795 go SPEC s backBuf pst
796 gobuf !_ s backBuf fp@(Tuple' end contents) !cur !pst = do
797 x <- liftIO $ peekByteIndex contents cur
799 let next = INDEX_NEXT(cur,a)
802 gobuf SPEC s (List []) fp next pst1
803 PR.Partial n pst1 -> do
804 assert (n <= Prelude.length (x:getList backBuf)) (return ())
805 let src0 = Prelude.take n (x:getList backBuf)
806 arr0 = A.fromListN n (Prelude.reverse src0)
807 arr1 = Array contents next end
809 let !(Array cont1 start end1) = src
810 fp1 = Tuple' end1 cont1
811 gobuf SPEC s (List []) fp1 start pst1
812 PR.Continue 0 pst1 ->
813 gobuf SPEC s (List (x:getList backBuf)) fp next pst1
814 PR.Continue n pst1 -> do
815 assert (n <= Prelude.length (x:getList backBuf)) (return ())
816 let (src0, buf1) = splitAt n (x:getList backBuf)
817 arr0 = A.fromListN n (Prelude.reverse src0)
818 arr1 = Array contents next end
820 let !(Array cont1 start end1) = src
821 fp1 = Tuple' end1 cont1
822 gobuf SPEC s (List buf1) fp1 start pst1
824 let arr = Array contents next end
825 return (b, D.cons arr (D.Stream step s))
827 assert (n <= Prelude.length (x:getList backBuf)) (return ())
828 let src0 = Prelude.take n (x:getList backBuf)
829 -- XXX create the array in reverse instead
830 arr0 = A.fromListN n (Prelude.reverse src0)
831 arr1 = Array contents next end
832 -- XXX Use StreamK to avoid adding arbitrary layers of
833 -- constructors every time.
834 str = D.cons arr0 (D.cons arr1 (D.Stream step s))
836 PR.Error err -> throwM $ ParseError err
839-- | Parse an array stream using the supplied 'Parser'. Returns the parse
840-- result and the unconsumed stream. Throws 'ParseError' if the parse fails.
842-- The following alternative to this function allows composing the parser using
845-- >>> parseBreakStreamK p = StreamK.parseBreakChunks (ParserK.adaptC p)
847-- We can compare perf and remove this one or define it in terms of that.
851{-# INLINE_NORMAL parseBreakChunksK #-}
853 forall m a b. (MonadIO m, Unbox a)
855 -> StreamK m (Array a)
856 -> m (Either ParseError b, StreamK m (Array a))
857-- parseBreakStreamK p = StreamK.parseBreakChunks (ParserK.adaptC p)
858parseBreakChunksK (Parser pstep initial extract) stream = do
861 IPartial s -> go s stream []
862 IDone b -> return (Right b, stream)
863 IError err -> return (Left (ParseError err), stream)
867 -- "backBuf" contains last few items in the stream that we may have to
870 -- XXX currently we are using a dumb list based approach for backtracking
871 -- buffer. This can be replaced by a sliding/ring buffer using Data.Array.
872 -- That will allow us more efficient random back and forth movement.
873 go !pst st backBuf = do
874 let stop = goStop pst backBuf -- (, K.nil) <$> extract pst
875 single a = yieldk a StreamK.nil
876 yieldk arr r = goArray pst backBuf r arr
877 in StreamK.foldStream defState yieldk single stop st
879 -- Use strictness on "cur" to keep it unboxed
880 goArray !pst backBuf st (Array _ cur end) | cur == end = go pst st backBuf
881 goArray !pst backBuf st (Array contents cur end) = do
882 x <- liftIO $ peekAt cur contents
884 let next = INDEX_NEXT(cur,a)
886 Parser.Partial 0 s ->
887 goArray s [] st (Array contents next end)
888 Parser.Partial n s -> do
889 assert (n <= Prelude.length (x:backBuf)) (return ())
890 let src0 = Prelude.take n (x:backBuf)
891 arr0 = fromListN n (Prelude.reverse src0)
892 arr1 = Array contents next end
895 Parser.Continue 0 s ->
896 goArray s (x:backBuf) st (Array contents next end)
897 Parser.Continue n s -> do
898 assert (n <= Prelude.length (x:backBuf)) (return ())
899 let (src0, buf1) = Prelude.splitAt n (x:backBuf)
900 arr0 = fromListN n (Prelude.reverse src0)
901 arr1 = Array contents next end
903 goArray s buf1 st src
904 Parser.Done 0 b -> do
905 let arr = Array contents next end
906 return (Right b, StreamK.cons arr st)
907 Parser.Done n b -> do
908 assert (n <= Prelude.length (x:backBuf)) (return ())
909 let src0 = Prelude.take n (x:backBuf)
910 -- XXX Use fromListRevN once implemented
911 -- arr0 = A.fromListRevN n src0
912 arr0 = fromListN n (Prelude.reverse src0)
913 arr1 = Array contents next end
914 str = StreamK.cons arr0 (StreamK.cons arr1 st)
915 return (Right b, str)
916 Parser.Error err -> do
917 let n = Prelude.length backBuf
918 arr0 = fromListN n (Prelude.reverse backBuf)
919 arr1 = Array contents cur end
920 str = StreamK.cons arr0 (StreamK.cons arr1 stream)
921 return (Left (ParseError err), str)
923 -- This is a simplified goArray
924 goExtract !pst backBuf (Array _ cur end)
925 | cur == end = goStop pst backBuf
926 goExtract !pst backBuf (Array contents cur end) = do
927 x <- liftIO $ peekAt cur contents
929 let next = INDEX_NEXT(cur,a)
931 Parser.Partial 0 s ->
932 goExtract s [] (Array contents next end)
933 Parser.Partial n s -> do
934 assert (n <= Prelude.length (x:backBuf)) (return ())
935 let src0 = Prelude.take n (x:backBuf)
936 arr0 = fromListN n (Prelude.reverse src0)
937 arr1 = Array contents next end
940 Parser.Continue 0 s ->
941 goExtract s backBuf (Array contents next end)
942 Parser.Continue n s -> do
943 assert (n <= Prelude.length (x:backBuf)) (return ())
944 let (src0, buf1) = Prelude.splitAt n (x:backBuf)
945 arr0 = fromListN n (Prelude.reverse src0)
946 arr1 = Array contents next end
949 Parser.Done 0 b -> do
950 let arr = Array contents next end
951 return (Right b, StreamK.fromPure arr)
952 Parser.Done n b -> do
953 assert (n <= Prelude.length backBuf) (return ())
954 let src0 = Prelude.take n backBuf
955 -- XXX Use fromListRevN once implemented
956 -- arr0 = A.fromListRevN n src0
957 arr0 = fromListN n (Prelude.reverse src0)
958 arr1 = Array contents next end
959 str = StreamK.cons arr0 (StreamK.fromPure arr1)
960 return (Right b, str)
961 Parser.Error err -> do
962 let n = Prelude.length backBuf
963 arr0 = fromListN n (Prelude.reverse backBuf)
964 arr1 = Array contents cur end
965 str = StreamK.cons arr0 (StreamK.cons arr1 stream)
966 return (Left (ParseError err), str)
968 -- This is a simplified goExtract
969 {-# INLINE goStop #-}
970 goStop !pst backBuf = do
973 Parser.Partial _ _ -> error "Bug: parseBreak: Partial in extract"
974 Parser.Continue 0 s ->
976 Parser.Continue n s -> do
977 assert (n <= Prelude.length backBuf) (return ())
978 let (src0, buf1) = Prelude.splitAt n backBuf
979 arr = fromListN n (Prelude.reverse src0)
982 return (Right b, StreamK.nil)
983 Parser.Done n b -> do
984 assert (n <= Prelude.length backBuf) (return ())
985 let src0 = Prelude.take n backBuf
986 -- XXX Use fromListRevN once implemented
987 -- arr0 = A.fromListRevN n src0
988 arr0 = fromListN n (Prelude.reverse src0)
989 return (Right b, StreamK.fromPure arr0)
990 Parser.Error err -> do
991 let n = Prelude.length backBuf
992 arr0 = fromListN n (Prelude.reverse backBuf)
993 return (Left (ParseError err), StreamK.fromPure arr0)
keysesc to close
- j k
- move down, up
- enter
- open
- esc
- back, or up a level
- 1 2 3 4
- readme, files, commits, refs
- /
- filter
- y
- copy the clone command
- c
- compare the chosen commit with another (or shift-click both)
- ?
- show or hide this list