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.
102#include "ArrayMacros.h"
104import Control.Monad.IO.Class (MonadIO(..))
105-- import Data.Bifunctor (first)
106-- import Data.Either (fromRight)
107import Data.Functor.Identity (Identity)
108import Data.Proxy (Proxy(..))
109import Data.Word (Word8)
110import Foreign.C.String (CString)
111import Foreign.Ptr (castPtr)
112import Foreign.Storable (Storable)
113import GHC.Types (SPEC(..))
114import Streamly.Internal.Data.Unbox (Unbox(..))
115import Prelude hiding (length, null, last, map, (!!), read, concat)
117import Streamly.Internal.Data.MutByteArray.Type (PinnedState(..), MutByteArray)
118import Streamly.Internal.Data.Serialize.Type (Serialize)
119import Streamly.Internal.Data.Fold.Type (Fold(..))
120import Streamly.Internal.Data.Parser (Parser(..), Initial(..), ParseError(..))
121import Streamly.Internal.Data.Stream (Stream(..))
122import Streamly.Internal.Data.StreamK (StreamK)
123import Streamly.Internal.Data.SVar.Type (adaptState, defState)
124import Streamly.Internal.Data.Tuple.Strict (Tuple'(..), Tuple3Fused'(..))
125import Streamly.Internal.Data.Unfold.Type (Unfold(..))
126import Streamly.Internal.System.IO (unsafeInlineIO)
128import qualified Streamly.Internal.Data.Fold.Type as Fold
129import qualified Streamly.Internal.Data.Serialize.Type as Serialize
130import qualified Streamly.Internal.Data.MutByteArray.Type as MBA
131import qualified Streamly.Internal.Data.MutArray as MA
132import qualified Streamly.Internal.Data.Fold as FL
133import qualified Streamly.Internal.Data.Ring as RB
134import qualified Streamly.Internal.Data.Parser as Parser
135-- import qualified Streamly.Internal.Data.ParserK as ParserK
136import qualified Streamly.Internal.Data.Stream as D
137import qualified Streamly.Internal.Data.Stream as Stream
138import qualified Streamly.Internal.Data.StreamK as StreamK
139import qualified Streamly.Internal.Data.Unfold as Unfold
140import qualified Prelude
142import Streamly.Internal.Data.Array.Type
144#include "DocTestDataArray.hs"
150-- * Arrays are finite and fixed in size
151-- * provide /O(1)/ access to elements
152-- * store only data and not functions
153-- * provide efficient IO interfacing
155-- 'Foldable' instance is not provided because the implementation would be much
156-- less efficient compared to folding via streams. 'Semigroup' and 'Monoid'
157-- instances should be used with care; concatenating arrays using binary
158-- operations can be highly inefficient. Instead, use
159-- 'Streamly.Internal.Data.Stream.Chunked.toArray' to concatenate N
162-- Each array is one pointer visible to the GC. Too many small arrays (e.g.
163-- single byte) are only as good as holding those elements in a Haskell list.
164-- However, small arrays can be compacted into large ones to reduce the
165-- overhead. To hold 32GB memory in 32k sized buffers we need 1 million arrays
166-- if we use one array for each chunk. This is still significant to add
169-------------------------------------------------------------------------------
171-------------------------------------------------------------------------------
175-- >>> null arr = Array.byteLength arr == 0
179null :: Array a -> Bool
180null arr = byteLength arr == 0
182-- | Like 'getIndex' but indexes the array in reverse from the end.
185{-# INLINE getIndexRev #-}
186getIndexRev :: forall a. Unbox a => Int -> Array a -> Maybe a
190 let elemPtr = RINDEX_OF(arrEnd arr, i, a)
191 if i >= 0 && elemPtr >= arrStart arr
192 then Just <$> peekAt elemPtr (arrContents arr)
197-- >>> last arr = Array.getIndexRev arr 0
201last :: Unbox a => Array a -> Maybe a
204-------------------------------------------------------------------------------
205-- Folds with Array as the container
206-------------------------------------------------------------------------------
208-- XXX We should generate this from Ring.
210-- | @writeLastN n@ folds a maximum of @n@ elements from the end of the input
211-- stream to an 'Array'.
213{-# INLINE writeLastN #-}
215 (Storable a, Unbox a, MonadIO m) => Int -> Fold m a (Array a)
217 | n <= 0 = fmap (const mempty) FL.drain
218 | otherwise = unsafeFreeze <$> Fold step initial done done
222 step (Tuple3Fused' rb rh i) a = do
223 rh1 <- liftIO $ RB.unsafeInsert rb rh a
224 return $ FL.Partial $ Tuple3Fused' rb rh1 (i + 1)
227 let f (a, b) = FL.Partial $ Tuple3Fused' a b (0 :: Int)
228 in fmap f $ liftIO $ RB.new n
230 done (Tuple3Fused' rb rh i) = do
232 -- XXX We should write a read unfold for ring.
233 foldFunc i rh MA.snocUnsafe arr rb
236 | i < n = RB.unsafeFoldRingM
237 | otherwise = RB.unsafeFoldRingFullM
239-------------------------------------------------------------------------------
241-------------------------------------------------------------------------------
243-------------------------------------------------------------------------------
245-------------------------------------------------------------------------------
247-- | Given a sorted array, perform a binary search to find the given element.
248-- Returns the index of the element if found.
251{-# INLINE binarySearch #-}
252binarySearch :: a -> Array a -> Maybe Int
253binarySearch = undefined
255-- find/findIndex etc can potentially be implemented more efficiently on arrays
256-- compared to streams by using SIMD instructions.
257-- We can also return a bit array instead.
261-- | Perform a linear search to find all the indices where a given element is
262-- present in an array.
265indexFinder :: (a -> Bool) -> Unfold Identity (Array a) Int
266indexFinder = undefined
270findIndicesOf :: (a -> Bool) -> Array a -> Stream Identity Int
271findIndicesOf p = Stream.unfold (indexFinder p)
274findIndexOf :: (a -> Bool) -> Array a -> Maybe Int
275findIndexOf p = Unfold.fold Fold.one . Stream.unfold (indexFinder p)
277find :: (a -> Bool) -> Array a -> Bool
278find = Unfold.fold Fold.null . Stream.unfold (indexFinder p)
281-------------------------------------------------------------------------------
283-------------------------------------------------------------------------------
285-- XXX We can potentially use SIMD instructions on arrays to fold faster.
287-------------------------------------------------------------------------------
289-------------------------------------------------------------------------------
291-- | /O(1)/ Slice an array in constant time.
293-- Caution: The bounds of the slice are not checked.
298{-# INLINE getSliceUnsafe #-}
301 => Int -- ^ starting index
302 -> Int -- ^ length of the slice
305getSliceUnsafe index len (Array contents start e) =
306 let size = SIZE_OF(a)
307 start1 = start + (index * size)
308 end1 = start1 + (len * size)
309 in assert (end1 <= e) (Array contents start1 end1)
311-- | Split the array into a stream of slices using a predicate. The element
312-- matching the predicate is dropped.
315{-# INLINE splitOn #-}
316splitOn :: (Monad m, Unbox a) =>
317 (a -> Bool) -> Array a -> Stream m (Array a)
318splitOn predicate arr =
319 fmap (\(i, len) -> getSliceUnsafe i len arr)
320 $ D.indexOnSuffix predicate (read arr)
322{-# INLINE sliceIndexerFromLen #-}
323sliceIndexerFromLen :: forall m a. (Monad m, Unbox a)
324 => Int -- ^ from index
325 -> Int -- ^ length of the slice
326 -> Unfold m (Array a) (Int, Int)
327sliceIndexerFromLen from len =
328 Unfold.lmap unsafeThaw (MA.sliceIndexerFromLen from len)
330{-# DEPRECATED genSlicesFromLen "Please use sliceIndexerFromLen instead." #-}
331{-# INLINE genSlicesFromLen #-}
332genSlicesFromLen :: forall m a. (Monad m, Unbox a)
333 => Int -- ^ from index
334 -> Int -- ^ length of the slice
335 -> Unfold m (Array a) (Int, Int)
336genSlicesFromLen = sliceIndexerFromLen
338-- | Generate a stream of slices of specified length from an array, starting
339-- from the supplied array index. The last slice may be shorter than the
343{-# INLINE slicerFromLen #-}
344slicerFromLen :: forall m a. (Monad m, Unbox a)
345 => Int -- ^ from index
346 -> Int -- ^ length of the slice
347 -> Unfold m (Array a) (Array a)
348slicerFromLen from len =
350 $ Unfold.lmap unsafeThaw (MA.slicerFromLen from len)
352{-# DEPRECATED getSlicesFromLen "Please use slicerFromLen instead." #-}
353{-# INLINE getSlicesFromLen #-}
354getSlicesFromLen :: forall m a. (Monad m, Unbox a)
355 => Int -- ^ from index
356 -> Int -- ^ length of the slice
357 -> Unfold m (Array a) (Array a)
358getSlicesFromLen = slicerFromLen
360-------------------------------------------------------------------------------
361-- Random reads and writes
362-------------------------------------------------------------------------------
364-- XXX Change this to a partial function instead of a Maybe type? And use
365-- MA.getIndex instead.
367-- | /O(1)/ Lookup the element at the given index. Index starts from 0.
369{-# INLINE getIndex #-}
370getIndex :: forall a. Unbox a => Int -> Array a -> Maybe a
374 let elemPtr = INDEX_OF(arrStart arr, i, a)
375 if i >= 0 && INDEX_VALID(elemPtr, arrEnd arr, a)
376 then Just <$> peekAt elemPtr (arrContents arr)
379-- | Given a stream of array indices, read the elements on those indices from
380-- the supplied Array. An exception is thrown if an index is out of bounds.
382-- This is the most general operation. We can implement other operations in
387-- let u = lmap (\arr -> (0, length arr - 1)) Unfold.enumerateFromTo
388-- in Unfold.lmap f (indexReader arr)
391-- let i = length arr - 1
392-- in Unfold.lmap f (indexReaderFromThenTo i (i - 1) 0)
396{-# INLINE indexReader #-}
397indexReader :: (Monad m, Unbox a) => Stream m Int -> Unfold m (Array a) a
399 let unf = MA.indexReaderWith (return . unsafeInlineIO) m
400 in Unfold.lmap unsafeThaw unf
402-- XXX DO NOT REMOVE, change the signature to use Stream instead of unfold
403{-# DEPRECATED getIndices "Please use getIndices instead." #-}
404{-# INLINE getIndices #-}
405getIndices :: (Monad m, Unbox a) => Stream m Int -> Unfold m (Array a) a
406getIndices = indexReader
408-- | Unfolds @(from, then, to, array)@ generating a finite stream whose first
409-- element is the array value from the index @from@ and the successive elements
410-- are from the indices in increments of @then@ up to @to@. Index enumeration
411-- can occur downwards or upwards depending on whether @then@ comes before or
415-- getIndicesFromThenTo =
416-- let f (from, next, to, arr) =
417-- (Stream.enumerateFromThenTo from next to, arr)
418-- in Unfold.lmap f getIndices
422{-# INLINE indexReaderFromThenTo #-}
423indexReaderFromThenTo :: Unfold m (Int, Int, Int, Array a) a
424indexReaderFromThenTo = undefined
426-------------------------------------------------------------------------------
427-- Transform via stream operations
428-------------------------------------------------------------------------------
430-- for non-length changing operations we can use the original length for
431-- allocation. If we can predict the length then we can use the prediction for
432-- new allocation. Otherwise we can use a hint and adjust dynamically.
435-- | Transform an array into another array using a pipe transformation
438{-# INLINE runPipe #-}
439runPipe :: (MonadIO m, Unbox a, Unbox b)
440 => Pipe m a b -> Array a -> m (Array b)
441runPipe f arr = P.runPipe (toArrayMinChunk (length arr)) $ f (read arr)
444-- XXX For transformations that cannot change the number of elements e.g. "map"
445-- we can use a predetermined array length.
447-- | Transform an array into another array using a stream transformation
451{-# INLINE streamTransform #-}
452streamTransform :: forall m a b. (MonadIO m, Unbox a, Unbox b)
453 => (Stream m a -> Stream m b) -> Array a -> m (Array b)
454streamTransform f arr =
455 Stream.fold (createWith (length arr)) $ f (read arr)
457-------------------------------------------------------------------------------
459-------------------------------------------------------------------------------
461-- | Cast an array having elements of type @a@ into an array having elements of
462-- type @b@. The array size must be a multiple of the size of type @b@
463-- otherwise accessing the last element of the array may result into a crash or
473castUnsafe (Array contents start end) =
474 Array contents start end
476-- | Cast an @Array a@ into an @Array Word8@.
479asBytes :: Array a -> Array Word8
482-- | Cast an array having elements of type @a@ into an array having elements of
483-- type @b@. The length of the array should be a multiple of the size of the
484-- target element otherwise 'Nothing' is returned.
487cast :: forall a b. (Unbox b) => Array a -> Maybe (Array b)
489 let len = byteLength arr
490 r = len `mod` SIZE_OF(b)
493 else Just $ castUnsafe arr
495-- | Convert an array of any type into a null terminated CString Ptr. If the
496-- array is unpinned it is first converted to a pinned array which requires a
501-- /O(n) Time: (creates a copy of the array)/
505asCStringUnsafe :: Array a -> (CString -> IO b) -> IO b
506asCStringUnsafe arr act = do
507 let arr1 = asBytes arr <> fromList [0]
508 -- unsafePinnedAsPtr makes sure the array is pinned
509 unsafePinnedAsPtr arr1 $ \ptr -> act (castPtr ptr)
511-------------------------------------------------------------------------------
513-------------------------------------------------------------------------------
515-- XXX We can directly use toStreamD and D.fold here.
517-- | Fold an array using a 'Fold'.
521fold :: forall m a b. (Monad m, Unbox a) => Fold m a b -> Array a -> m b
522fold f arr = Stream.fold f (read arr)
524-- | Fold an array using a stream fold operation.
527{-# INLINE streamFold #-}
528streamFold :: (Monad m, Unbox a) => (Stream m a -> m b) -> Array a -> m b
529streamFold f arr = f (read arr)
531--------------------------------------------------------------------------------
533--------------------------------------------------------------------------------
535{-# INLINE encodeAs #-}
536encodeAs :: forall a. Serialize a => PinnedState -> a -> Array Word8
539 let len = Serialize.addSizeTo 0 a
540 mbarr <- MBA.newBytesAs ps len
541 off <- Serialize.serializeAt 0 mbarr a
543 pure $ Array mbarr 0 off
547-- 1. Identity: @deserialize . serialize == id@
548-- 2. Encoded equivalence: @serialize a == serialize a@
549{-# INLINE serialize #-}
550serialize :: Serialize a => a -> Array Word8
551serialize = encodeAs Unpinned
553-- | Serialize a Haskell type to a pinned byte array. The array is allocated
554-- using pinned memory so that it can be used directly in OS APIs for writing
555-- to file or sending over the network.
558-- 1. Identity: @deserialize . pinnedSerialize == id@
559-- 2. Encoded equivalence: @pinnedSerialize a == pinnedSerialize a@
560{-# INLINE pinnedSerialize #-}
561pinnedSerialize :: Serialize a => a -> Array Word8
562pinnedSerialize = encodeAs Pinned
564-- | Decode a Haskell type from a byte array containing its serialized
566{-# INLINE deserialize #-}
567deserialize :: Serialize a => Array Word8 -> a
568deserialize arr@(Array {..}) = unsafeInlineIO $ do
569 let lenArr = length arr
571 Serialize.deserializeAt arrStart arrContents (arrStart + lenArr)
572 assertM(off == arrStart + lenArr)
575-------------------------------------------------------------------------------
577-------------------------------------------------------------------------------
579-- TODO: efficiently compare two streams of arrays. Two streams can have chunks
580-- of different sizes, we can handle that in the stream comparison abstraction.
581-- This could be useful e.g. to fast compare whether two files differ.
583-- | Insert the given element between arrays and flatten.
585-- >>> interpose x = Stream.interpose x Array.reader
587{-# INLINE interpose #-}
588interpose :: (Monad m, Unbox a) => a -> Stream m (Array a) -> Stream m a
589interpose x = D.interpose x reader
593 | InnerLoop s !MutByteArray !Int !Int
595-- | Insert the given element after each array and flatten. This is similar to
598-- >>> interposeSuffix x = Stream.interposeSuffix x Array.reader
600{-# INLINE_NORMAL interposeSuffix #-}
601interposeSuffix :: forall m a. (Monad m, Unbox a)
602 => a -> Stream m (Array a) -> Stream m a
603-- This does not require MonadIO constraint.
604-- interposeSuffix x = D.interposeSuffix x reader
605interposeSuffix sep (D.Stream step state) = D.Stream step' (OuterLoop state)
609 {-# INLINE_LATE step' #-}
610 step' gst (OuterLoop st) = do
611 r <- step (adaptState gst) st
613 D.Yield Array{..} s ->
614 D.Skip (InnerLoop s arrContents arrStart arrEnd)
615 D.Skip s -> D.Skip (OuterLoop s)
618 step' _ (InnerLoop st _ p end) | p == end =
619 return $ D.Yield sep $ OuterLoop st
621 step' _ (InnerLoop st contents p end) = do
622 x <- pure $ unsafeInlineIO $ peekAt p contents
623 return $ D.Yield x (InnerLoop st contents (INDEX_NEXT(p,a)) end)
625-- | Insert the given array after each array and flatten.
627-- >>> intercalateSuffix = Stream.intercalateSuffix Array.reader
629{-# INLINE intercalateSuffix #-}
630intercalateSuffix :: (Monad m, Unbox a)
631 => Array a -> Stream m (Array a) -> Stream m a
632intercalateSuffix = D.intercalateSuffix reader
634-- | @compactLE n@ coalesces adjacent arrays in the input stream
635-- only if the combined size would be less than or equal to n.
637-- Generates unpinned arrays irrespective of the pinning status of input
639{-# INLINE_NORMAL compactLE #-}
640compactLE :: (MonadIO m, Unbox a)
641 => Int -> Stream m (Array a) -> Stream m (Array a)
643 D.map unsafeFreeze $ MA.compactLE n $ D.map unsafeThaw stream
645-- | Pinned version of 'compactLE'.
646{-# INLINE_NORMAL pinnedCompactLE #-}
647pinnedCompactLE :: (MonadIO m, Unbox a)
648 => Int -> Stream m (Array a) -> Stream m (Array a)
649pinnedCompactLE n stream =
650 D.map unsafeFreeze $ MA.pinnedCompactLE n $ D.map unsafeThaw stream
652-- | Split a stream of arrays on a given separator byte, dropping the separator
653-- and coalescing all the arrays between two separators into a single array.
655{-# INLINE compactOnByte #-}
659 -> Stream m (Array Word8)
660 -> Stream m (Array Word8)
662 fmap unsafeFreeze . MA.compactOnByte byte . fmap unsafeThaw
664-- | Like 'compactOnByte' considers the separator in suffix position instead of
666{-# INLINE compactOnByteSuffix #-}
670 -> Stream m (Array Word8)
671 -> Stream m (Array Word8)
672compactOnByteSuffix byte =
673 fmap unsafeFreeze . MA.compactOnByteSuffix byte . fmap unsafeThaw
675-------------------------------------------------------------------------------
676-- Folding Streams of Arrays
677-------------------------------------------------------------------------------
679-- XXX This should not be used for breaking a stream as the D.cons used in
680-- reconstructing the stream could be very bad for performance. This can only
681-- be useful in folding without breaking.
682{-# INLINE_NORMAL foldBreakChunks #-}
683foldBreakChunks :: forall m a b. (MonadIO m, Unbox a) =>
684 Fold m a b -> Stream m (Array a) -> m (b, Stream m (Array a))
685foldBreakChunks (Fold fstep initial _ final) stream@(Stream step state) = do
688 Fold.Partial fs -> go SPEC state fs
689 Fold.Done fb -> return $! (fb, stream)
695 r <- step defState st
697 Stream.Yield (Array contents start end) s ->
698 let fp = Tuple' end contents
699 in goArray SPEC s fp start fs
700 Stream.Skip s -> go SPEC s fs
705 goArray !_ s (Tuple' end _) !cur !fs
708 goArray !_ st fp@(Tuple' end contents) !cur !fs = do
709 x <- liftIO $ peekAt cur contents
711 let next = INDEX_NEXT(cur,a)
714 let arr = Array contents next end
715 return $! (b, D.cons arr (D.Stream step st))
716 Fold.Partial fs1 -> goArray SPEC st fp next fs1
718-- This may be more robust wrt fusion compared to unfoldMany?
720-- | Fold a stream of arrays using a 'Fold'. This is equivalent to the
723-- >>> foldChunks f = Stream.fold f . Stream.unfoldMany Array.reader
725foldChunks :: (MonadIO m, Unbox a) => Fold m a b -> Stream m (Array a) -> m b
726foldChunks f s = fmap fst (foldBreakChunks f s)
727-- foldStream f = Stream.fold f . Stream.unfoldMany reader
729-- | Fold a stream of arrays using a 'Fold' and return the remaining stream.
731-- The following alternative to this function allows composing the fold using
735-- foldBreakStreamK f s =
736-- fmap (first (fromRight undefined))
737-- $ StreamK.parseBreakChunks (ParserK.adaptC (Parser.fromFold f)) s
740-- We can compare perf and remove this one or define it in terms of that.
742foldBreakChunksK :: forall m a b. (MonadIO m, Unbox a) =>
743 Fold m a b -> StreamK m (Array a) -> m (b, StreamK m (Array a))
745foldBreakChunksK f s =
746 fmap (first (fromRight undefined))
747 $ StreamK.parseBreakChunks (ParserK.adaptC (Parser.fromFold f)) s
749foldBreakChunksK (Fold fstep initial _ final) stream = do
752 Fold.Partial fs -> go fs stream
753 Fold.Done fb -> return (fb, stream)
759 let stop = (, StreamK.nil) <$> final fs
760 single a = yieldk a StreamK.nil
761 yieldk (Array contents start end) r =
762 let fp = Tuple' end contents
763 in goArray fs r fp start
764 in StreamK.foldStream defState yieldk single stop st
766 goArray !fs st (Tuple' end _) !cur
769 goArray !fs st fp@(Tuple' end contents) !cur = do
770 x <- liftIO $ peekAt cur contents
772 let next = INDEX_NEXT(cur,a)
775 let arr = Array contents next end
776 return $! (b, StreamK.cons arr st)
777 Fold.Partial fs1 -> goArray fs1 st fp next
780-- This can be generalized to any type provided it can be unfolded to a stream
781-- and it can be combined using a semigroup operation.
783{-# INLINE_NORMAL parseBreakD #-}
785 forall m a b. (MonadIO m, MonadThrow m, Unbox a)
787 -> D.Stream m (Array.Array a)
788 -> m (b, D.Stream m (Array.Array a))
790 (PRD.Parser pstep initial extract) stream@(D.Stream step state) = do
794 PRD.IPartial s -> go SPEC state (List []) s
795 PRD.IDone b -> return (b, stream)
796 PRD.IError err -> throwM $ ParseError err
800 -- "backBuf" contains last few items in the stream that we may have to
803 -- XXX currently we are using a dumb list based approach for backtracking
804 -- buffer. This can be replaced by a sliding/ring buffer using Data.Array.
805 -- That will allow us more efficient random back and forth movement.
806 go !_ st backBuf !pst = do
807 r <- step defState st
809 D.Yield (Array contents start end) s ->
811 (Tuple' end contents) start pst
812 D.Skip s -> go SPEC s backBuf pst
817 -- Use strictness on "cur" to keep it unboxed
818 gobuf !_ s backBuf (Tuple' end _) !cur !pst
820 go SPEC s backBuf pst
821 gobuf !_ s backBuf fp@(Tuple' end contents) !cur !pst = do
822 x <- liftIO $ peekByteIndex contents cur
824 let next = INDEX_NEXT(cur,a)
827 gobuf SPEC s (List []) fp next pst1
828 PR.Partial n pst1 -> do
829 assert (n <= Prelude.length (x:getList backBuf)) (return ())
830 let src0 = Prelude.take n (x:getList backBuf)
831 arr0 = A.fromListN n (Prelude.reverse src0)
832 arr1 = Array contents next end
834 let !(Array cont1 start end1) = src
835 fp1 = Tuple' end1 cont1
836 gobuf SPEC s (List []) fp1 start pst1
837 PR.Continue 0 pst1 ->
838 gobuf SPEC s (List (x:getList backBuf)) fp next pst1
839 PR.Continue n pst1 -> do
840 assert (n <= Prelude.length (x:getList backBuf)) (return ())
841 let (src0, buf1) = splitAt n (x:getList backBuf)
842 arr0 = A.fromListN n (Prelude.reverse src0)
843 arr1 = Array contents next end
845 let !(Array cont1 start end1) = src
846 fp1 = Tuple' end1 cont1
847 gobuf SPEC s (List buf1) fp1 start pst1
849 let arr = Array contents next end
850 return (b, D.cons arr (D.Stream step s))
852 assert (n <= Prelude.length (x:getList backBuf)) (return ())
853 let src0 = Prelude.take n (x:getList backBuf)
854 -- XXX create the array in reverse instead
855 arr0 = A.fromListN n (Prelude.reverse src0)
856 arr1 = Array contents next end
857 -- XXX Use StreamK to avoid adding arbitrary layers of
858 -- constructors every time.
859 str = D.cons arr0 (D.cons arr1 (D.Stream step s))
861 PR.Error err -> throwM $ ParseError err
864-- | Parse an array stream using the supplied 'Parser'. Returns the parse
865-- result and the unconsumed stream. Throws 'ParseError' if the parse fails.
867-- The following alternative to this function allows composing the parser using
870-- >>> parseBreakStreamK p = StreamK.parseBreakChunks (ParserK.adaptC p)
872-- We can compare perf and remove this one or define it in terms of that.
876{-# INLINE_NORMAL parseBreakChunksK #-}
878 forall m a b. (MonadIO m, Unbox a)
880 -> StreamK m (Array a)
881 -> m (Either ParseError b, StreamK m (Array a))
882-- parseBreakStreamK p = StreamK.parseBreakChunks (ParserK.adaptC p)
883parseBreakChunksK (Parser pstep initial extract) stream = do
886 IPartial s -> go s stream []
887 IDone b -> return (Right b, stream)
888 IError err -> return (Left (ParseError err), stream)
892 -- "backBuf" contains last few items in the stream that we may have to
895 -- XXX currently we are using a dumb list based approach for backtracking
896 -- buffer. This can be replaced by a sliding/ring buffer using Data.Array.
897 -- That will allow us more efficient random back and forth movement.
898 go !pst st backBuf = do
899 let stop = goStop pst backBuf -- (, K.nil) <$> extract pst
900 single a = yieldk a StreamK.nil
901 yieldk arr r = goArray pst backBuf r arr
902 in StreamK.foldStream defState yieldk single stop st
904 -- Use strictness on "cur" to keep it unboxed
905 goArray !pst backBuf st (Array _ cur end) | cur == end = go pst st backBuf
906 goArray !pst backBuf st (Array contents cur end) = do
907 x <- liftIO $ peekAt cur contents
909 let next = INDEX_NEXT(cur,a)
911 Parser.Partial 0 s ->
912 goArray s [] st (Array contents next end)
913 Parser.Partial n s -> do
914 assert (n <= Prelude.length (x:backBuf)) (return ())
915 let src0 = Prelude.take n (x:backBuf)
916 arr0 = fromListN n (Prelude.reverse src0)
917 arr1 = Array contents next end
920 Parser.Continue 0 s ->
921 goArray s (x:backBuf) st (Array contents next end)
922 Parser.Continue n s -> do
923 assert (n <= Prelude.length (x:backBuf)) (return ())
924 let (src0, buf1) = Prelude.splitAt n (x:backBuf)
925 arr0 = fromListN n (Prelude.reverse src0)
926 arr1 = Array contents next end
928 goArray s buf1 st src
929 Parser.Done 0 b -> do
930 let arr = Array contents next end
931 return (Right b, StreamK.cons arr st)
932 Parser.Done n b -> do
933 assert (n <= Prelude.length (x:backBuf)) (return ())
934 let src0 = Prelude.take n (x:backBuf)
935 -- XXX Use fromListRevN once implemented
936 -- arr0 = A.fromListRevN n src0
937 arr0 = fromListN n (Prelude.reverse src0)
938 arr1 = Array contents next end
939 str = StreamK.cons arr0 (StreamK.cons arr1 st)
940 return (Right b, str)
941 Parser.Error err -> do
942 let n = Prelude.length backBuf
943 arr0 = fromListN n (Prelude.reverse backBuf)
944 arr1 = Array contents cur end
945 str = StreamK.cons arr0 (StreamK.cons arr1 stream)
946 return (Left (ParseError err), str)
948 -- This is a simplified goArray
949 goExtract !pst backBuf (Array _ cur end)
950 | cur == end = goStop pst backBuf
951 goExtract !pst backBuf (Array contents cur end) = do
952 x <- liftIO $ peekAt cur contents
954 let next = INDEX_NEXT(cur,a)
956 Parser.Partial 0 s ->
957 goExtract s [] (Array contents next end)
958 Parser.Partial n s -> do
959 assert (n <= Prelude.length (x:backBuf)) (return ())
960 let src0 = Prelude.take n (x:backBuf)
961 arr0 = fromListN n (Prelude.reverse src0)
962 arr1 = Array contents next end
965 Parser.Continue 0 s ->
966 goExtract s backBuf (Array contents next end)
967 Parser.Continue n s -> do
968 assert (n <= Prelude.length (x:backBuf)) (return ())
969 let (src0, buf1) = Prelude.splitAt n (x:backBuf)
970 arr0 = fromListN n (Prelude.reverse src0)
971 arr1 = Array contents next end
974 Parser.Done 0 b -> do
975 let arr = Array contents next end
976 return (Right b, StreamK.fromPure arr)
977 Parser.Done n b -> do
978 assert (n <= Prelude.length backBuf) (return ())
979 let src0 = Prelude.take n backBuf
980 -- XXX Use fromListRevN once implemented
981 -- arr0 = A.fromListRevN n src0
982 arr0 = fromListN n (Prelude.reverse src0)
983 arr1 = Array contents next end
984 str = StreamK.cons arr0 (StreamK.fromPure arr1)
985 return (Right b, str)
986 Parser.Error err -> do
987 let n = Prelude.length backBuf
988 arr0 = fromListN n (Prelude.reverse backBuf)
989 arr1 = Array contents cur end
990 str = StreamK.cons arr0 (StreamK.cons arr1 stream)
991 return (Left (ParseError err), str)
993 -- This is a simplified goExtract
994 {-# INLINE goStop #-}
995 goStop !pst backBuf = do
998 Parser.Partial _ _ -> error "Bug: parseBreak: Partial in extract"
999 Parser.Continue 0 s ->
1001 Parser.Continue n s -> do
1002 assert (n <= Prelude.length backBuf) (return ())
1003 let (src0, buf1) = Prelude.splitAt n backBuf
1004 arr = fromListN n (Prelude.reverse src0)
1005 goExtract s buf1 arr
1007 return (Right b, StreamK.nil)
1008 Parser.Done n b -> do
1009 assert (n <= Prelude.length backBuf) (return ())
1010 let src0 = Prelude.take n backBuf
1011 -- XXX Use fromListRevN once implemented
1012 -- arr0 = A.fromListRevN n src0
1013 arr0 = fromListN n (Prelude.reverse src0)
1014 return (Right b, StreamK.fromPure arr0)
1015 Parser.Error err -> do
1016 let n = Prelude.length backBuf
1017 arr0 = fromListN n (Prelude.reverse backBuf)
1018 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