1{-# LANGUAGE CPP, ExistentialQuantification, MultiParamTypeClasses, FlexibleInstances, Rank2Types, BangPatterns, KindSignatures, GADTs, ScopedTypeVariables #-} 2 3-- | 4-- Module : Data.Vector.Fusion.Bundle.Monadic 5-- Copyright : (c) Roman Leshchinskiy 2008-2010 6-- License : BSD-style 7-- 8-- Maintainer : Roman Leshchinskiy <rl@cse.unsw.edu.au> 9-- Stability : experimental 10-- Portability : non-portable 11-- 12-- Monadic bundles. 13-- 14 15module Data.Vector.Fusion.Bundle.Monadic ( 16 Bundle(..), Chunk(..), 17 18 -- * Size hints 19 size, sized, 20 21 -- * Length 22 length, null, 23 24 -- * Construction 25 empty, singleton, cons, snoc, replicate, replicateM, generate, generateM, (++), 26 27 -- * Accessing elements 28 head, last, (!!), (!?), 29 30 -- * Substreams 31 slice, init, tail, take, drop, 32 33 -- * Mapping 34 map, mapM, mapM_, trans, unbox, concatMap, flatten, 35 36 -- * Zipping 37 indexed, indexedR, zipWithM_, 38 zipWithM, zipWith3M, zipWith4M, zipWith5M, zipWith6M, 39 zipWith, zipWith3, zipWith4, zipWith5, zipWith6, 40 zip, zip3, zip4, zip5, zip6, 41 42 -- * Comparisons 43 eqBy, cmpBy, 44 45 -- * Filtering 46 filter, filterM, takeWhile, takeWhileM, dropWhile, dropWhileM, 47 48 -- * Searching 49 elem, notElem, find, findM, findIndex, findIndexM, 50 51 -- * Folding 52 foldl, foldlM, foldl1, foldl1M, foldM, fold1M, 53 foldl', foldlM', foldl1', foldl1M', foldM', fold1M', 54 foldr, foldrM, foldr1, foldr1M, 55 56 -- * Specialised folds 57 and, or, concatMapM, 58 59 -- * Unfolding 60 unfoldr, unfoldrM, 61 unfoldrN, unfoldrNM, 62 iterateN, iterateNM, 63 64 -- * Scans 65 prescanl, prescanlM, prescanl', prescanlM', 66 postscanl, postscanlM, postscanl', postscanlM', 67 scanl, scanlM, scanl', scanlM', 68 scanl1, scanl1M, scanl1', scanl1M', 69 70 -- * Enumerations 71 enumFromStepN, enumFromTo, enumFromThenTo, 72 73 -- * Conversions 74 toList, fromList, fromListN, unsafeFromList, 75 fromVector, reVector, fromVectors, concatVectors, 76 fromStream, chunks, elements 77) where 78 79import Data.Vector.Generic.Base 80import qualified Data.Vector.Generic.Mutable.Base as M 81import Data.Vector.Fusion.Bundle.Size 82import Data.Vector.Fusion.Util ( Box(..), delay_inline ) 83import Data.Vector.Fusion.Stream.Monadic ( Stream(..), Step(..) ) 84import qualified Data.Vector.Fusion.Stream.Monadic as S 85import Control.Monad.Primitive 86 87import qualified Data.List as List 88import Data.Char ( ord ) 89import GHC.Base ( unsafeChr ) 90import Control.Monad ( liftM ) 91import Prelude hiding ( length, null, 92 replicate, (++), 93 head, last, (!!), 94 init, tail, take, drop, 95 map, mapM, mapM_, concatMap, 96 zipWith, zipWith3, zip, zip3, 97 filter, takeWhile, dropWhile, 98 elem, notElem, 99 foldl, foldl1, foldr, foldr1, 100 and, or, 101 scanl, scanl1, 102 enumFromTo, enumFromThenTo ) 103 104import Data.Int ( Int8, Int16, Int32 ) 105import Data.Word ( Word8, Word16, Word32, Word64 ) 106 107#if !MIN_VERSION_base(4,8,0) 108import Data.Word ( Word ) 109#endif 110 111#include "vector.h" 112#include "MachDeps.h" 113 114#if WORD_SIZE_IN_BITS > 32 115import Data.Int ( Int64 ) 116#endif 117 118data Chunk v a = Chunk Int (forall m. (PrimMonad m, Vector v a) => Mutable v (PrimState m) a -> m ()) 119 120-- | Monadic streams 121data Bundle m v a = Bundle { sElems :: Stream m a 122 , sChunks :: Stream m (Chunk v a) 123 , sVector :: Maybe (v a) 124 , sSize :: Size 125 } 126 127fromStream :: Monad m => Stream m a -> Size -> Bundle m v a 128{-# INLINE fromStream #-} 129fromStream (Stream step t) sz = Bundle (Stream step t) (Stream step' t) Nothing sz 130 where 131 step' s = do r <- step s 132 return $ fmap (\x -> Chunk 1 (\v -> M.basicUnsafeWrite v 0 x)) r 133 134chunks :: Bundle m v a -> Stream m (Chunk v a) 135{-# INLINE chunks #-} 136chunks = sChunks 137 138elements :: Bundle m v a -> Stream m a 139{-# INLINE elements #-} 140elements = sElems 141 142-- | 'Size' hint of a 'Bundle' 143size :: Bundle m v a -> Size 144{-# INLINE size #-} 145size = sSize 146 147-- | Attach a 'Size' hint to a 'Bundle' 148sized :: Bundle m v a -> Size -> Bundle m v a 149{-# INLINE_FUSED sized #-} 150sized s sz = s { sSize = sz } 151 152-- Length 153-- ------ 154 155-- | Length of a 'Bundle' 156length :: Monad m => Bundle m v a -> m Int 157{-# INLINE_FUSED length #-} 158length Bundle{sSize = Exact n} = return n 159length Bundle{sChunks = s} = S.foldl' (\n (Chunk k _) -> n+k) 0 s 160 161-- | Check if a 'Bundle' is empty 162null :: Monad m => Bundle m v a -> m Bool 163{-# INLINE_FUSED null #-} 164null Bundle{sSize = Exact n} = return (n == 0) 165null Bundle{sChunks = s} = S.foldr (\(Chunk n _) z -> n == 0 && z) True s 166 167-- Construction 168-- ------------ 169 170-- | Empty 'Bundle' 171empty :: Monad m => Bundle m v a 172{-# INLINE_FUSED empty #-} 173empty = fromStream S.empty (Exact 0) 174 175-- | Singleton 'Bundle' 176singleton :: Monad m => a -> Bundle m v a 177{-# INLINE_FUSED singleton #-} 178singleton x = fromStream (S.singleton x) (Exact 1) 179 180-- | Replicate a value to a given length 181replicate :: Monad m => Int -> a -> Bundle m v a 182{-# INLINE_FUSED replicate #-} 183replicate n x = Bundle (S.replicate n x) 184 (S.singleton $ Chunk len (\v -> M.basicSet v x)) 185 Nothing 186 (Exact len) 187 where 188 len = delay_inline max n 0 189 190-- | Yield a 'Bundle' of values obtained by performing the monadic action the 191-- given number of times 192replicateM :: Monad m => Int -> m a -> Bundle m v a 193{-# INLINE_FUSED replicateM #-} 194-- NOTE: We delay inlining max here because GHC will create a join point for 195-- the call to newArray# otherwise which is not really nice. 196replicateM n p = fromStream (S.replicateM n p) (Exact (delay_inline max n 0)) 197 198generate :: Monad m => Int -> (Int -> a) -> Bundle m v a 199{-# INLINE generate #-} 200generate n f = generateM n (return . f) 201 202-- | Generate a stream from its indices 203generateM :: Monad m => Int -> (Int -> m a) -> Bundle m v a 204{-# INLINE_FUSED generateM #-} 205generateM n f = fromStream (S.generateM n f) (Exact (delay_inline max n 0)) 206 207-- | Prepend an element 208cons :: Monad m => a -> Bundle m v a -> Bundle m v a 209{-# INLINE cons #-} 210cons x s = singleton x ++ s 211 212-- | Append an element 213snoc :: Monad m => Bundle m v a -> a -> Bundle m v a 214{-# INLINE snoc #-} 215snoc s x = s ++ singleton x 216 217infixr 5 ++ 218-- | Concatenate two 'Bundle's 219(++) :: Monad m => Bundle m v a -> Bundle m v a -> Bundle m v a 220{-# INLINE_FUSED (++) #-} 221Bundle sa ta _ na ++ Bundle sb tb _ nb = Bundle (sa S.++ sb) (ta S.++ tb) Nothing (na + nb) 222 223-- Accessing elements 224-- ------------------ 225 226-- | First element of the 'Bundle' or error if empty 227head :: Monad m => Bundle m v a -> m a 228{-# INLINE_FUSED head #-} 229head = S.head . sElems 230 231-- | Last element of the 'Bundle' or error if empty 232last :: Monad m => Bundle m v a -> m a 233{-# INLINE_FUSED last #-} 234last = S.last . sElems 235 236infixl 9 !! 237-- | Element at the given position 238(!!) :: Monad m => Bundle m v a -> Int -> m a 239{-# INLINE (!!) #-} 240b !! i = sElems b S.!! i 241 242infixl 9 !? 243-- | Element at the given position or 'Nothing' if out of bounds 244(!?) :: Monad m => Bundle m v a -> Int -> m (Maybe a) 245{-# INLINE (!?) #-} 246b !? i = sElems b S.!? i 247 248-- Substreams 249-- ---------- 250 251-- | Extract a substream of the given length starting at the given position. 252slice :: Monad m => Int -- ^ starting index 253 -> Int -- ^ length 254 -> Bundle m v a 255 -> Bundle m v a 256{-# INLINE slice #-} 257slice i n s = take n (drop i s) 258 259-- | All but the last element 260init :: Monad m => Bundle m v a -> Bundle m v a 261{-# INLINE_FUSED init #-} 262init Bundle{sElems = s, sSize = sz} = fromStream (S.init s) (sz-1) 263 264-- | All but the first element 265tail :: Monad m => Bundle m v a -> Bundle m v a 266{-# INLINE_FUSED tail #-} 267tail Bundle{sElems = s, sSize = sz} = fromStream (S.tail s) (sz-1) 268 269-- | The first @n@ elements 270take :: Monad m => Int -> Bundle m v a -> Bundle m v a 271{-# INLINE_FUSED take #-} 272take n Bundle{sElems = s, sSize = sz} = fromStream (S.take n s) (smallerThan n sz) 273 274-- | All but the first @n@ elements 275drop :: Monad m => Int -> Bundle m v a -> Bundle m v a 276{-# INLINE_FUSED drop #-} 277drop n Bundle{sElems = s, sSize = sz} = 278 fromStream (S.drop n s) (clampedSubtract sz (Exact n)) 279 280-- Mapping 281-- ------- 282 283instance Monad m => Functor (Bundle m v) where 284 {-# INLINE fmap #-} 285 fmap = map 286 287-- | Map a function over a 'Bundle' 288map :: Monad m => (a -> b) -> Bundle m v a -> Bundle m v b 289{-# INLINE map #-} 290map f = mapM (return . f) 291 292-- | Map a monadic function over a 'Bundle' 293mapM :: Monad m => (a -> m b) -> Bundle m v a -> Bundle m v b 294{-# INLINE_FUSED mapM #-} 295mapM f Bundle{sElems = s, sSize = n} = fromStream (S.mapM f s) n 296 297-- | Execute a monadic action for each element of the 'Bundle' 298mapM_ :: Monad m => (a -> m b) -> Bundle m v a -> m () 299{-# INLINE_FUSED mapM_ #-} 300mapM_ m = S.mapM_ m . sElems 301 302-- | Transform a 'Bundle' to use a different monad 303trans :: (Monad m, Monad m') => (forall z. m z -> m' z) 304 -> Bundle m v a -> Bundle m' v a 305{-# INLINE_FUSED trans #-} 306trans f Bundle{sElems = s, sChunks = cs, sVector = v, sSize = n} 307 = Bundle { sElems = S.trans f s, sChunks = S.trans f cs, sVector = v, sSize = n } 308 309unbox :: Monad m => Bundle m v (Box a) -> Bundle m v a 310{-# INLINE_FUSED unbox #-} 311unbox Bundle{sElems = s, sSize = n} = fromStream (S.unbox s) n 312 313-- Zipping 314-- ------- 315 316-- | Pair each element in a 'Bundle' with its index 317indexed :: Monad m => Bundle m v a -> Bundle m v (Int,a) 318{-# INLINE_FUSED indexed #-} 319indexed Bundle{sElems = s, sSize = n} = fromStream (S.indexed s) n 320 321-- | Pair each element in a 'Bundle' with its index, starting from the right 322-- and counting down 323indexedR :: Monad m => Int -> Bundle m v a -> Bundle m v (Int,a) 324{-# INLINE_FUSED indexedR #-} 325indexedR m Bundle{sElems = s, sSize = n} = fromStream (S.indexedR m s) n 326 327-- | Zip two 'Bundle's with the given monadic function 328zipWithM :: Monad m => (a -> b -> m c) -> Bundle m v a -> Bundle m v b -> Bundle m v c 329{-# INLINE_FUSED zipWithM #-} 330zipWithM f Bundle{sElems = sa, sSize = na} 331 Bundle{sElems = sb, sSize = nb} = fromStream (S.zipWithM f sa sb) (smaller na nb) 332 333-- FIXME: This might expose an opportunity for inplace execution. 334{-# RULES 335 336"zipWithM xs xs [Vector.Bundle]" forall f xs. 337 zipWithM f xs xs = mapM (\x -> f x x) xs #-} 338 339 340zipWithM_ :: Monad m => (a -> b -> m c) -> Bundle m v a -> Bundle m v b -> m () 341{-# INLINE zipWithM_ #-} 342zipWithM_ f sa sb = S.zipWithM_ f (sElems sa) (sElems sb) 343 344zipWith3M :: Monad m => (a -> b -> c -> m d) -> Bundle m v a -> Bundle m v b -> Bundle m v c -> Bundle m v d 345{-# INLINE_FUSED zipWith3M #-} 346zipWith3M f Bundle{sElems = sa, sSize = na} 347 Bundle{sElems = sb, sSize = nb} 348 Bundle{sElems = sc, sSize = nc} 349 = fromStream (S.zipWith3M f sa sb sc) (smaller na (smaller nb nc)) 350 351zipWith4M :: Monad m => (a -> b -> c -> d -> m e) 352 -> Bundle m v a -> Bundle m v b -> Bundle m v c -> Bundle m v d 353 -> Bundle m v e 354{-# INLINE zipWith4M #-} 355zipWith4M f sa sb sc sd 356 = zipWithM (\(a,b) (c,d) -> f a b c d) (zip sa sb) (zip sc sd) 357 358zipWith5M :: Monad m => (a -> b -> c -> d -> e -> m f) 359 -> Bundle m v a -> Bundle m v b -> Bundle m v c -> Bundle m v d 360 -> Bundle m v e -> Bundle m v f 361{-# INLINE zipWith5M #-} 362zipWith5M f sa sb sc sd se 363 = zipWithM (\(a,b,c) (d,e) -> f a b c d e) (zip3 sa sb sc) (zip sd se) 364 365zipWith6M :: Monad m => (a -> b -> c -> d -> e -> f -> m g) 366 -> Bundle m v a -> Bundle m v b -> Bundle m v c -> Bundle m v d 367 -> Bundle m v e -> Bundle m v f -> Bundle m v g 368{-# INLINE zipWith6M #-} 369zipWith6M fn sa sb sc sd se sf 370 = zipWithM (\(a,b,c) (d,e,f) -> fn a b c d e f) (zip3 sa sb sc) 371 (zip3 sd se sf) 372 373zipWith :: Monad m => (a -> b -> c) -> Bundle m v a -> Bundle m v b -> Bundle m v c 374{-# INLINE zipWith #-} 375zipWith f = zipWithM (\a b -> return (f a b)) 376 377zipWith3 :: Monad m => (a -> b -> c -> d) 378 -> Bundle m v a -> Bundle m v b -> Bundle m v c -> Bundle m v d 379{-# INLINE zipWith3 #-} 380zipWith3 f = zipWith3M (\a b c -> return (f a b c)) 381 382zipWith4 :: Monad m => (a -> b -> c -> d -> e) 383 -> Bundle m v a -> Bundle m v b -> Bundle m v c -> Bundle m v d 384 -> Bundle m v e 385{-# INLINE zipWith4 #-} 386zipWith4 f = zipWith4M (\a b c d -> return (f a b c d)) 387 388zipWith5 :: Monad m => (a -> b -> c -> d -> e -> f) 389 -> Bundle m v a -> Bundle m v b -> Bundle m v c -> Bundle m v d 390 -> Bundle m v e -> Bundle m v f 391{-# INLINE zipWith5 #-} 392zipWith5 f = zipWith5M (\a b c d e -> return (f a b c d e)) 393 394zipWith6 :: Monad m => (a -> b -> c -> d -> e -> f -> g) 395 -> Bundle m v a -> Bundle m v b -> Bundle m v c -> Bundle m v d 396 -> Bundle m v e -> Bundle m v f -> Bundle m v g 397{-# INLINE zipWith6 #-} 398zipWith6 fn = zipWith6M (\a b c d e f -> return (fn a b c d e f)) 399 400zip :: Monad m => Bundle m v a -> Bundle m v b -> Bundle m v (a,b) 401{-# INLINE zip #-} 402zip = zipWith (,) 403 404zip3 :: Monad m => Bundle m v a -> Bundle m v b -> Bundle m v c -> Bundle m v (a,b,c) 405{-# INLINE zip3 #-} 406zip3 = zipWith3 (,,) 407 408zip4 :: Monad m => Bundle m v a -> Bundle m v b -> Bundle m v c -> Bundle m v d 409 -> Bundle m v (a,b,c,d) 410{-# INLINE zip4 #-} 411zip4 = zipWith4 (,,,) 412 413zip5 :: Monad m => Bundle m v a -> Bundle m v b -> Bundle m v c -> Bundle m v d 414 -> Bundle m v e -> Bundle m v (a,b,c,d,e) 415{-# INLINE zip5 #-} 416zip5 = zipWith5 (,,,,) 417 418zip6 :: Monad m => Bundle m v a -> Bundle m v b -> Bundle m v c -> Bundle m v d 419 -> Bundle m v e -> Bundle m v f -> Bundle m v (a,b,c,d,e,f) 420{-# INLINE zip6 #-} 421zip6 = zipWith6 (,,,,,) 422 423-- Comparisons 424-- ----------- 425 426-- | Check if two 'Bundle's are equal 427eqBy :: (Monad m) => (a -> b -> Bool) -> Bundle m v a -> Bundle m v b -> m Bool 428{-# INLINE_FUSED eqBy #-} 429eqBy eq x y 430 | sizesAreDifferent (sSize x) (sSize y) = return False 431 | otherwise = S.eqBy eq (sElems x) (sElems y) 432 where 433 sizesAreDifferent :: Size -> Size -> Bool 434 sizesAreDifferent (Exact a) (Exact b) = a /= b 435 sizesAreDifferent (Exact a) (Max b) = a > b 436 sizesAreDifferent (Max a) (Exact b) = a < b 437 sizesAreDifferent _ _ = False 438 439-- | Lexicographically compare two 'Bundle's 440cmpBy :: (Monad m) => (a -> b -> Ordering) -> Bundle m v a -> Bundle m v b -> m Ordering 441{-# INLINE_FUSED cmpBy #-} 442cmpBy cmp x y = S.cmpBy cmp (sElems x) (sElems y) 443 444-- Filtering 445-- --------- 446 447-- | Drop elements which do not satisfy the predicate 448filter :: Monad m => (a -> Bool) -> Bundle m v a -> Bundle m v a 449{-# INLINE filter #-} 450filter f = filterM (return . f) 451 452-- | Drop elements which do not satisfy the monadic predicate 453filterM :: Monad m => (a -> m Bool) -> Bundle m v a -> Bundle m v a 454{-# INLINE_FUSED filterM #-} 455filterM f Bundle{sElems = s, sSize = n} = fromStream (S.filterM f s) (toMax n) 456 457-- | Longest prefix of elements that satisfy the predicate 458takeWhile :: Monad m => (a -> Bool) -> Bundle m v a -> Bundle m v a 459{-# INLINE takeWhile #-} 460takeWhile f = takeWhileM (return . f) 461 462-- | Longest prefix of elements that satisfy the monadic predicate 463takeWhileM :: Monad m => (a -> m Bool) -> Bundle m v a -> Bundle m v a 464{-# INLINE_FUSED takeWhileM #-} 465takeWhileM f Bundle{sElems = s, sSize = n} = fromStream (S.takeWhileM f s) (toMax n) 466 467-- | Drop the longest prefix of elements that satisfy the predicate 468dropWhile :: Monad m => (a -> Bool) -> Bundle m v a -> Bundle m v a 469{-# INLINE dropWhile #-} 470dropWhile f = dropWhileM (return . f) 471 472-- | Drop the longest prefix of elements that satisfy the monadic predicate 473dropWhileM :: Monad m => (a -> m Bool) -> Bundle m v a -> Bundle m v a 474{-# INLINE_FUSED dropWhileM #-} 475dropWhileM f Bundle{sElems = s, sSize = n} = fromStream (S.dropWhileM f s) (toMax n) 476 477-- Searching 478-- --------- 479 480infix 4 `elem` 481-- | Check whether the 'Bundle' contains an element 482elem :: (Monad m, Eq a) => a -> Bundle m v a -> m Bool 483{-# INLINE_FUSED elem #-} 484elem x = S.elem x . sElems 485 486infix 4 `notElem` 487-- | Inverse of `elem` 488notElem :: (Monad m, Eq a) => a -> Bundle m v a -> m Bool 489{-# INLINE notElem #-} 490notElem x = S.notElem x . sElems 491 492-- | Yield 'Just' the first element that satisfies the predicate or 'Nothing' 493-- if no such element exists. 494find :: Monad m => (a -> Bool) -> Bundle m v a -> m (Maybe a) 495{-# INLINE find #-} 496find f = findM (return . f) 497 498-- | Yield 'Just' the first element that satisfies the monadic predicate or 499-- 'Nothing' if no such element exists. 500findM :: Monad m => (a -> m Bool) -> Bundle m v a -> m (Maybe a) 501{-# INLINE_FUSED findM #-} 502findM f = S.findM f . sElems 503 504-- | Yield 'Just' the index of the first element that satisfies the predicate 505-- or 'Nothing' if no such element exists. 506findIndex :: Monad m => (a -> Bool) -> Bundle m v a -> m (Maybe Int) 507{-# INLINE_FUSED findIndex #-} 508findIndex f = findIndexM (return . f) 509 510-- | Yield 'Just' the index of the first element that satisfies the monadic 511-- predicate or 'Nothing' if no such element exists. 512findIndexM :: Monad m => (a -> m Bool) -> Bundle m v a -> m (Maybe Int) 513{-# INLINE_FUSED findIndexM #-} 514findIndexM f = S.findIndexM f . sElems 515 516-- Folding 517-- ------- 518 519-- | Left fold 520foldl :: Monad m => (a -> b -> a) -> a -> Bundle m v b -> m a 521{-# INLINE foldl #-} 522foldl f = foldlM (\a b -> return (f a b)) 523 524-- | Left fold with a monadic operator 525foldlM :: Monad m => (a -> b -> m a) -> a -> Bundle m v b -> m a 526{-# INLINE_FUSED foldlM #-} 527foldlM m z = S.foldlM m z . sElems 528 529-- | Same as 'foldlM' 530foldM :: Monad m => (a -> b -> m a) -> a -> Bundle m v b -> m a 531{-# INLINE foldM #-} 532foldM = foldlM 533 534-- | Left fold over a non-empty 'Bundle' 535foldl1 :: Monad m => (a -> a -> a) -> Bundle m v a -> m a 536{-# INLINE foldl1 #-} 537foldl1 f = foldl1M (\a b -> return (f a b)) 538 539-- | Left fold over a non-empty 'Bundle' with a monadic operator 540foldl1M :: Monad m => (a -> a -> m a) -> Bundle m v a -> m a 541{-# INLINE_FUSED foldl1M #-} 542foldl1M f = S.foldl1M f . sElems 543 544-- | Same as 'foldl1M' 545fold1M :: Monad m => (a -> a -> m a) -> Bundle m v a -> m a 546{-# INLINE fold1M #-} 547fold1M = foldl1M 548 549-- | Left fold with a strict accumulator 550foldl' :: Monad m => (a -> b -> a) -> a -> Bundle m v b -> m a 551{-# INLINE foldl' #-} 552foldl' f = foldlM' (\a b -> return (f a b)) 553 554-- | Left fold with a strict accumulator and a monadic operator 555foldlM' :: Monad m => (a -> b -> m a) -> a -> Bundle m v b -> m a 556{-# INLINE_FUSED foldlM' #-} 557foldlM' m z = S.foldlM' m z . sElems 558 559-- | Same as 'foldlM'' 560foldM' :: Monad m => (a -> b -> m a) -> a -> Bundle m v b -> m a 561{-# INLINE foldM' #-} 562foldM' = foldlM' 563 564-- | Left fold over a non-empty 'Bundle' with a strict accumulator 565foldl1' :: Monad m => (a -> a -> a) -> Bundle m v a -> m a 566{-# INLINE foldl1' #-} 567foldl1' f = foldl1M' (\a b -> return (f a b)) 568 569-- | Left fold over a non-empty 'Bundle' with a strict accumulator and a 570-- monadic operator 571foldl1M' :: Monad m => (a -> a -> m a) -> Bundle m v a -> m a 572{-# INLINE_FUSED foldl1M' #-} 573foldl1M' f = S.foldl1M' f . sElems 574 575-- | Same as 'foldl1M'' 576fold1M' :: Monad m => (a -> a -> m a) -> Bundle m v a -> m a 577{-# INLINE fold1M' #-} 578fold1M' = foldl1M' 579 580-- | Right fold 581foldr :: Monad m => (a -> b -> b) -> b -> Bundle m v a -> m b 582{-# INLINE foldr #-} 583foldr f = foldrM (\a b -> return (f a b)) 584 585-- | Right fold with a monadic operator 586foldrM :: Monad m => (a -> b -> m b) -> b -> Bundle m v a -> m b 587{-# INLINE_FUSED foldrM #-} 588foldrM f z = S.foldrM f z . sElems 589 590-- | Right fold over a non-empty stream 591foldr1 :: Monad m => (a -> a -> a) -> Bundle m v a -> m a 592{-# INLINE foldr1 #-} 593foldr1 f = foldr1M (\a b -> return (f a b)) 594 595-- | Right fold over a non-empty stream with a monadic operator 596foldr1M :: Monad m => (a -> a -> m a) -> Bundle m v a -> m a 597{-# INLINE_FUSED foldr1M #-} 598foldr1M f = S.foldr1M f . sElems 599 600-- Specialised folds 601-- ----------------- 602 603and :: Monad m => Bundle m v Bool -> m Bool 604{-# INLINE_FUSED and #-} 605and = S.and . sElems 606 607or :: Monad m => Bundle m v Bool -> m Bool 608{-# INLINE_FUSED or #-} 609or = S.or . sElems 610 611concatMap :: Monad m => (a -> Bundle m v b) -> Bundle m v a -> Bundle m v b 612{-# INLINE concatMap #-} 613concatMap f = concatMapM (return . f) 614 615concatMapM :: Monad m => (a -> m (Bundle m v b)) -> Bundle m v a -> Bundle m v b 616{-# INLINE_FUSED concatMapM #-} 617concatMapM f Bundle{sElems = s} = fromStream (S.concatMapM (liftM sElems . f) s) Unknown 618 619-- | Create a 'Bundle' of values from a 'Bundle' of streamable things 620flatten :: Monad m => (a -> m s) -> (s -> m (Step s b)) -> Size 621 -> Bundle m v a -> Bundle m v b 622{-# INLINE_FUSED flatten #-} 623flatten mk istep sz Bundle{sElems = s} = fromStream (S.flatten mk istep s) sz 624 625-- Unfolding 626-- --------- 627 628-- | Unfold 629unfoldr :: Monad m => (s -> Maybe (a, s)) -> s -> Bundle m u a 630{-# INLINE_FUSED unfoldr #-} 631unfoldr f = unfoldrM (return . f) 632 633-- | Unfold with a monadic function 634unfoldrM :: Monad m => (s -> m (Maybe (a, s))) -> s -> Bundle m u a 635{-# INLINE_FUSED unfoldrM #-} 636unfoldrM f s = fromStream (S.unfoldrM f s) Unknown 637 638-- | Unfold at most @n@ elements 639unfoldrN :: Monad m => Int -> (s -> Maybe (a, s)) -> s -> Bundle m u a 640{-# INLINE_FUSED unfoldrN #-} 641unfoldrN n f = unfoldrNM n (return . f) 642 643-- | Unfold at most @n@ elements with a monadic functions 644unfoldrNM :: Monad m => Int -> (s -> m (Maybe (a, s))) -> s -> Bundle m u a 645{-# INLINE_FUSED unfoldrNM #-} 646unfoldrNM n f s = fromStream (S.unfoldrNM n f s) (Max (delay_inline max n 0)) 647 648-- | Apply monadic function n times to value. Zeroth element is original value. 649iterateNM :: Monad m => Int -> (a -> m a) -> a -> Bundle m u a 650{-# INLINE_FUSED iterateNM #-} 651iterateNM n f x0 = fromStream (S.iterateNM n f x0) (Exact (delay_inline max n 0)) 652 653-- | Apply function n times to value. Zeroth element is original value. 654iterateN :: Monad m => Int -> (a -> a) -> a -> Bundle m u a 655{-# INLINE_FUSED iterateN #-} 656iterateN n f x0 = iterateNM n (return . f) x0 657 658-- Scans 659-- ----- 660 661-- | Prefix scan 662prescanl :: Monad m => (a -> b -> a) -> a -> Bundle m v b -> Bundle m v a 663{-# INLINE prescanl #-} 664prescanl f = prescanlM (\a b -> return (f a b)) 665 666-- | Prefix scan with a monadic operator 667prescanlM :: Monad m => (a -> b -> m a) -> a -> Bundle m v b -> Bundle m v a 668{-# INLINE_FUSED prescanlM #-} 669prescanlM f z Bundle{sElems = s, sSize = sz} = fromStream (S.prescanlM f z s) sz 670 671-- | Prefix scan with strict accumulator 672prescanl' :: Monad m => (a -> b -> a) -> a -> Bundle m v b -> Bundle m v a 673{-# INLINE prescanl' #-} 674prescanl' f = prescanlM' (\a b -> return (f a b)) 675 676-- | Prefix scan with strict accumulator and a monadic operator 677prescanlM' :: Monad m => (a -> b -> m a) -> a -> Bundle m v b -> Bundle m v a 678{-# INLINE_FUSED prescanlM' #-} 679prescanlM' f z Bundle{sElems = s, sSize = sz} = fromStream (S.prescanlM' f z s) sz 680 681-- | Suffix scan 682postscanl :: Monad m => (a -> b -> a) -> a -> Bundle m v b -> Bundle m v a 683{-# INLINE postscanl #-} 684postscanl f = postscanlM (\a b -> return (f a b)) 685 686-- | Suffix scan with a monadic operator 687postscanlM :: Monad m => (a -> b -> m a) -> a -> Bundle m v b -> Bundle m v a 688{-# INLINE_FUSED postscanlM #-} 689postscanlM f z Bundle{sElems = s, sSize = sz} = fromStream (S.postscanlM f z s) sz 690 691-- | Suffix scan with strict accumulator 692postscanl' :: Monad m => (a -> b -> a) -> a -> Bundle m v b -> Bundle m v a 693{-# INLINE postscanl' #-} 694postscanl' f = postscanlM' (\a b -> return (f a b)) 695 696-- | Suffix scan with strict acccumulator and a monadic operator 697postscanlM' :: Monad m => (a -> b -> m a) -> a -> Bundle m v b -> Bundle m v a 698{-# INLINE_FUSED postscanlM' #-} 699postscanlM' f z Bundle{sElems = s, sSize = sz} = fromStream (S.postscanlM' f z s) sz 700 701-- | Haskell-style scan 702scanl :: Monad m => (a -> b -> a) -> a -> Bundle m v b -> Bundle m v a 703{-# INLINE scanl #-} 704scanl f = scanlM (\a b -> return (f a b)) 705 706-- | Haskell-style scan with a monadic operator 707scanlM :: Monad m => (a -> b -> m a) -> a -> Bundle m v b -> Bundle m v a 708{-# INLINE scanlM #-} 709scanlM f z s = z `cons` postscanlM f z s 710 711-- | Haskell-style scan with strict accumulator 712scanl' :: Monad m => (a -> b -> a) -> a -> Bundle m v b -> Bundle m v a 713{-# INLINE scanl' #-} 714scanl' f = scanlM' (\a b -> return (f a b)) 715 716-- | Haskell-style scan with strict accumulator and a monadic operator 717scanlM' :: Monad m => (a -> b -> m a) -> a -> Bundle m v b -> Bundle m v a 718{-# INLINE scanlM' #-} 719scanlM' f z s = z `seq` (z `cons` postscanlM f z s) 720 721-- | Scan over a non-empty 'Bundle' 722scanl1 :: Monad m => (a -> a -> a) -> Bundle m v a -> Bundle m v a 723{-# INLINE scanl1 #-} 724scanl1 f = scanl1M (\x y -> return (f x y)) 725 726-- | Scan over a non-empty 'Bundle' with a monadic operator 727scanl1M :: Monad m => (a -> a -> m a) -> Bundle m v a -> Bundle m v a 728{-# INLINE_FUSED scanl1M #-} 729scanl1M f Bundle{sElems = s, sSize = sz} = fromStream (S.scanl1M f s) sz 730 731-- | Scan over a non-empty 'Bundle' with a strict accumulator 732scanl1' :: Monad m => (a -> a -> a) -> Bundle m v a -> Bundle m v a 733{-# INLINE scanl1' #-} 734scanl1' f = scanl1M' (\x y -> return (f x y)) 735 736-- | Scan over a non-empty 'Bundle' with a strict accumulator and a monadic 737-- operator 738scanl1M' :: Monad m => (a -> a -> m a) -> Bundle m v a -> Bundle m v a 739{-# INLINE_FUSED scanl1M' #-} 740scanl1M' f Bundle{sElems = s, sSize = sz} = fromStream (S.scanl1M' f s) sz 741 742-- Enumerations 743-- ------------ 744 745-- The Enum class is broken for this, there just doesn't seem to be a 746-- way to implement this generically. We have to specialise for as many types 747-- as we can but this doesn't help in polymorphic loops. 748 749-- | Yield a 'Bundle' of the given length containing the values @x@, @x+y@, 750-- @x+y+y@ etc. 751enumFromStepN :: (Num a, Monad m) => a -> a -> Int -> Bundle m v a 752{-# INLINE_FUSED enumFromStepN #-} 753enumFromStepN x y n = fromStream (S.enumFromStepN x y n) (Exact (delay_inline max n 0)) 754 755-- | Enumerate values 756-- 757-- /WARNING:/ This operation can be very inefficient. If at all possible, use 758-- 'enumFromStepN' instead. 759enumFromTo :: (Enum a, Monad m) => a -> a -> Bundle m v a 760{-# INLINE_FUSED enumFromTo #-} 761enumFromTo x y = fromList [x .. y] 762 763-- NOTE: We use (x+1) instead of (succ x) below because the latter checks for 764-- overflow which can't happen here. 765 766-- FIXME: add "too large" test for Int 767enumFromTo_small :: (Integral a, Monad m) => a -> a -> Bundle m v a 768{-# INLINE_FUSED enumFromTo_small #-} 769enumFromTo_small x y = x `seq` y `seq` fromStream (Stream step (Just x)) (Exact n) 770 where 771 n = delay_inline max (fromIntegral y - fromIntegral x + 1) 0 772 773 {-# INLINE_INNER step #-} 774 step Nothing = return $ Done 775 step (Just z) | z == y = return $ Yield z Nothing 776 | z < y = return $ Yield z (Just (z+1)) 777 | otherwise = return $ Done 778 779{-# RULES 780 781"enumFromTo<Int8> [Bundle]" 782 enumFromTo = enumFromTo_small :: Monad m => Int8 -> Int8 -> Bundle m v Int8 783 784"enumFromTo<Int16> [Bundle]" 785 enumFromTo = enumFromTo_small :: Monad m => Int16 -> Int16 -> Bundle m v Int16 786 787"enumFromTo<Word8> [Bundle]" 788 enumFromTo = enumFromTo_small :: Monad m => Word8 -> Word8 -> Bundle m v Word8 789 790"enumFromTo<Word16> [Bundle]" 791 enumFromTo = enumFromTo_small :: Monad m => Word16 -> Word16 -> Bundle m v Word16 #-} 792 793 794 795#if WORD_SIZE_IN_BITS > 32 796 797{-# RULES 798 799"enumFromTo<Int32> [Bundle]" 800 enumFromTo = enumFromTo_small :: Monad m => Int32 -> Int32 -> Bundle m v Int32 801 802"enumFromTo<Word32> [Bundle]" 803 enumFromTo = enumFromTo_small :: Monad m => Word32 -> Word32 -> Bundle m v Word32 #-} 804 805#endif 806 807-- NOTE: We could implement a generic "too large" test: 808-- 809-- len x y | x > y = 0 810-- | n > 0 && n <= fromIntegral (maxBound :: Int) = fromIntegral n 811-- | otherwise = error 812-- where 813-- n = y-x+1 814-- 815-- Alas, GHC won't eliminate unnecessary comparisons (such as n >= 0 for 816-- unsigned types). See http://hackage.haskell.org/trac/ghc/ticket/3744 817-- 818 819enumFromTo_int :: forall m v. Monad m => Int -> Int -> Bundle m v Int 820{-# INLINE_FUSED enumFromTo_int #-} 821enumFromTo_int x y = x `seq` y `seq` fromStream (Stream step (Just x)) (Exact (len x y)) 822 where 823 {-# INLINE [0] len #-} 824 len :: Int -> Int -> Int 825 len u v | u > v = 0 826 | otherwise = BOUNDS_CHECK(check) "enumFromTo" "vector too large" 827 (n > 0) 828 $ n 829 where 830 n = v-u+1 831 832 {-# INLINE_INNER step #-} 833 step Nothing = return $ Done 834 step (Just z) | z == y = return $ Yield z Nothing 835 | z < y = return $ Yield z (Just (z+1)) 836 | otherwise = return $ Done 837 838enumFromTo_intlike :: (Integral a, Monad m) => a -> a -> Bundle m v a 839{-# INLINE_FUSED enumFromTo_intlike #-} 840enumFromTo_intlike x y = x `seq` y `seq` fromStream (Stream step (Just x)) (Exact (len x y)) 841 where 842 {-# INLINE [0] len #-} 843 len u v | u > v = 0 844 | otherwise = BOUNDS_CHECK(check) "enumFromTo" "vector too large" 845 (n > 0) 846 $ fromIntegral n 847 where 848 n = v-u+1 849 850 {-# INLINE_INNER step #-} 851 step Nothing = return $ Done 852 step (Just z) | z == y = return $ Yield z Nothing 853 | z < y = return $ Yield z (Just (z+1)) 854 | otherwise = return $ Done 855 856{-# RULES 857 858"enumFromTo<Int> [Bundle]" 859 enumFromTo = enumFromTo_int :: Monad m => Int -> Int -> Bundle m v Int 860 861#if WORD_SIZE_IN_BITS > 32 862 863"enumFromTo<Int64> [Bundle]" 864 enumFromTo = enumFromTo_intlike :: Monad m => Int64 -> Int64 -> Bundle m v Int64 #-} 865 866#else 867 868"enumFromTo<Int32> [Bundle]" 869 enumFromTo = enumFromTo_intlike :: Monad m => Int32 -> Int32 -> Bundle m v Int32 #-} 870 871#endif 872 873 874 875enumFromTo_big_word :: (Integral a, Monad m) => a -> a -> Bundle m v a 876{-# INLINE_FUSED enumFromTo_big_word #-} 877enumFromTo_big_word x y = x `seq` y `seq` fromStream (Stream step (Just x)) (Exact (len x y)) 878 where 879 {-# INLINE [0] len #-} 880 len u v | u > v = 0 881 | otherwise = BOUNDS_CHECK(check) "enumFromTo" "vector too large" 882 (n < fromIntegral (maxBound :: Int)) 883 $ fromIntegral (n+1) 884 where 885 n = v-u 886 887 {-# INLINE_INNER step #-} 888 step Nothing = return $ Done 889 step (Just z) | z == y = return $ Yield z Nothing 890 | z < y = return $ Yield z (Just (z+1)) 891 | otherwise = return $ Done 892 893{-# RULES 894 895"enumFromTo<Word> [Bundle]" 896 enumFromTo = enumFromTo_big_word :: Monad m => Word -> Word -> Bundle m v Word 897 898"enumFromTo<Word64> [Bundle]" 899 enumFromTo = enumFromTo_big_word 900 :: Monad m => Word64 -> Word64 -> Bundle m v Word64 901 902#if WORD_SIZE_IN_BITS == 32 903 904"enumFromTo<Word32> [Bundle]" 905 enumFromTo = enumFromTo_big_word 906 :: Monad m => Word32 -> Word32 -> Bundle m v Word32 907 908#endif 909 910"enumFromTo<Integer> [Bundle]" 911 enumFromTo = enumFromTo_big_word 912 :: Monad m => Integer -> Integer -> Bundle m v Integer #-} 913 914 915#if WORD_SIZE_IN_BITS > 32 916 917-- FIXME: the "too large" test is totally wrong 918enumFromTo_big_int :: (Integral a, Monad m) => a -> a -> Bundle m v a 919{-# INLINE_FUSED enumFromTo_big_int #-} 920enumFromTo_big_int x y = x `seq` y `seq` fromStream (Stream step (Just x)) (Exact (len x y)) 921 where 922 {-# INLINE [0] len #-} 923 len u v | u > v = 0 924 | otherwise = BOUNDS_CHECK(check) "enumFromTo" "vector too large" 925 (n > 0 && n <= fromIntegral (maxBound :: Int)) 926 $ fromIntegral n 927 where 928 n = v-u+1 929 930 {-# INLINE_INNER step #-} 931 step Nothing = return $ Done 932 step (Just z) | z == y = return $ Yield z Nothing 933 | z < y = return $ Yield z (Just (z+1)) 934 | otherwise = return $ Done 935 936 937{-# RULES 938 939"enumFromTo<Int64> [Bundle]" 940 enumFromTo = enumFromTo_big_int :: Monad m => Int64 -> Int64 -> Bundle m v Int64 #-} 941 942 943 944#endif 945 946enumFromTo_char :: Monad m => Char -> Char -> Bundle m v Char 947{-# INLINE_FUSED enumFromTo_char #-} 948enumFromTo_char x y = x `seq` y `seq` fromStream (Stream step xn) (Exact n) 949 where 950 xn = ord x 951 yn = ord y 952 953 n = delay_inline max 0 (yn - xn + 1) 954 955 {-# INLINE_INNER step #-} 956 step zn | zn <= yn = return $ Yield (unsafeChr zn) (zn+1) 957 | otherwise = return $ Done 958 959{-# RULES 960 961"enumFromTo<Char> [Bundle]" 962 enumFromTo = enumFromTo_char #-} 963 964 965 966------------------------------------------------------------------------ 967 968-- Specialise enumFromTo for Float and Double. 969-- Also, try to do something about pairs? 970 971enumFromTo_double :: (Monad m, Ord a, RealFrac a) => a -> a -> Bundle m v a 972{-# INLINE_FUSED enumFromTo_double #-} 973enumFromTo_double n m = n `seq` m `seq` fromStream (Stream step ini) (Max (len n lim)) 974 where 975 lim = m + 1/2 -- important to float out 976 977 {-# INLINE [0] len #-} 978 len x y | x > y = 0 979 | otherwise = BOUNDS_CHECK(check) "enumFromTo" "vector too large" 980 (l > 0) 981 $ fromIntegral l 982 where 983 l :: Integer 984 l = truncate (y-x)+2 985 986 {-# INLINE_INNER step #-} 987-- GHC changed definition of Enum for Double in GHC8.6 so we have to 988-- accomodate both definitions in order to preserve validity of 989-- rewrite rule 990-- 991-- ISSUE: https://gitlab.haskell.org/ghc/ghc/issues/15081 992-- COMMIT: https://gitlab.haskell.org/ghc/ghc/commit/4ffaf4b67773af4c72d92bb8b6c87b1a7d34ac0f 993#if MIN_VERSION_base(4,12,0) 994 ini = 0 995 step x | x' <= lim = return $ Yield x' (x+1) 996 | otherwise = return $ Done 997 where 998 x' = x + n 999#else 1000 ini = n 1001 step x | x <= lim = return $ Yield x (x+1) 1002 | otherwise = return $ Done 1003#endif 1004 1005{-# RULES 1006 1007"enumFromTo<Double> [Bundle]" 1008 enumFromTo = enumFromTo_double :: Monad m => Double -> Double -> Bundle m v Double 1009 1010"enumFromTo<Float> [Bundle]" 1011 enumFromTo = enumFromTo_double :: Monad m => Float -> Float -> Bundle m v Float #-} 1012 1013 1014 1015------------------------------------------------------------------------ 1016 1017-- | Enumerate values with a given step. 1018-- 1019-- /WARNING:/ This operation is very inefficient. If at all possible, use 1020-- 'enumFromStepN' instead. 1021enumFromThenTo :: (Enum a, Monad m) => a -> a -> a -> Bundle m v a 1022{-# INLINE_FUSED enumFromThenTo #-} 1023enumFromThenTo x y z = fromList [x, y .. z] 1024 1025-- FIXME: Specialise enumFromThenTo. 1026 1027-- Conversions 1028-- ----------- 1029 1030-- | Convert a 'Bundle' to a list 1031toList :: Monad m => Bundle m v a -> m [a] 1032{-# INLINE toList #-} 1033toList = foldr (:) [] 1034 1035-- | Convert a list to a 'Bundle' 1036fromList :: Monad m => [a] -> Bundle m v a 1037{-# INLINE fromList #-} 1038fromList xs = unsafeFromList Unknown xs 1039 1040-- | Convert the first @n@ elements of a list to a 'Bundle' 1041fromListN :: Monad m => Int -> [a] -> Bundle m v a 1042{-# INLINE_FUSED fromListN #-} 1043fromListN n xs = fromStream (S.fromListN n xs) (Max (delay_inline max n 0)) 1044 1045-- | Convert a list to a 'Bundle' with the given 'Size' hint. 1046unsafeFromList :: Monad m => Size -> [a] -> Bundle m v a 1047{-# INLINE_FUSED unsafeFromList #-} 1048unsafeFromList sz xs = fromStream (S.fromList xs) sz 1049 1050fromVector :: (Monad m, Vector v a) => v a -> Bundle m v a 1051{-# INLINE_FUSED fromVector #-} 1052fromVector v = v `seq` n `seq` Bundle (Stream step 0) 1053 (Stream vstep True) 1054 (Just v) 1055 (Exact n) 1056 where 1057 n = basicLength v 1058 1059 {-# INLINE step #-} 1060 step i | i >= n = return Done 1061 | otherwise = case basicUnsafeIndexM v i of 1062 Box x -> return $ Yield x (i+1) 1063 1064 1065 {-# INLINE vstep #-} 1066 vstep True = return (Yield (Chunk (basicLength v) (\mv -> basicUnsafeCopy mv v)) False) 1067 vstep False = return Done 1068 1069fromVectors :: forall m v a. (Monad m, Vector v a) => [v a] -> Bundle m v a 1070{-# INLINE_FUSED fromVectors #-} 1071fromVectors us = Bundle (Stream pstep (Left us)) 1072 (Stream vstep us) 1073 Nothing 1074 (Exact n) 1075 where 1076 n = List.foldl' (\k v -> k + basicLength v) 0 us 1077 1078 pstep (Left []) = return Done 1079 pstep (Left (v:vs)) = basicLength v `seq` return (Skip (Right (v,0,vs))) 1080 1081 pstep (Right (v,i,vs)) 1082 | i >= basicLength v = return $ Skip (Left vs) 1083 | otherwise = case basicUnsafeIndexM v i of 1084 Box x -> return $ Yield x (Right (v,i+1,vs)) 1085 1086 -- FIXME: work around bug in GHC 7.6.1 1087 vstep :: [v a] -> m (Step [v a] (Chunk v a)) 1088 vstep [] = return Done 1089 vstep (v:vs) = return $ Yield (Chunk (basicLength v) 1090 (\mv -> INTERNAL_CHECK(check) "concatVectors" "length mismatch" 1091 (M.basicLength mv == basicLength v) 1092 $ basicUnsafeCopy mv v)) vs 1093 1094 1095concatVectors :: (Monad m, Vector v a) => Bundle m u (v a) -> Bundle m v a 1096{-# INLINE_FUSED concatVectors #-} 1097concatVectors Bundle{sElems = Stream step t} 1098 = Bundle (Stream pstep (Left t)) 1099 (Stream vstep t) 1100 Nothing 1101 Unknown 1102 where 1103 pstep (Left s) = do 1104 r <- step s 1105 case r of 1106 Yield v s' -> basicLength v `seq` return (Skip (Right (v,0,s'))) 1107 Skip s' -> return (Skip (Left s')) 1108 Done -> return Done 1109 1110 pstep (Right (v,i,s)) 1111 | i >= basicLength v = return (Skip (Left s)) 1112 | otherwise = case basicUnsafeIndexM v i of 1113 Box x -> return (Yield x (Right (v,i+1,s))) 1114 1115 1116 vstep s = do 1117 r <- step s 1118 case r of 1119 Yield v s' -> return (Yield (Chunk (basicLength v) 1120 (\mv -> INTERNAL_CHECK(check) "concatVectors" "length mismatch" 1121 (M.basicLength mv == basicLength v) 1122 $ basicUnsafeCopy mv v)) s') 1123 Skip s' -> return (Skip s') 1124 Done -> return Done 1125 1126reVector :: Monad m => Bundle m u a -> Bundle m v a 1127{-# INLINE_FUSED reVector #-} 1128reVector Bundle{sElems = s, sSize = n} = fromStream s n 1129 1130{-# RULES 1131 1132"reVector [Vector]" 1133 reVector = id 1134 1135"reVector/reVector [Vector]" forall s. 1136 reVector (reVector s) = s #-} 1137 1138 1139 1140