vector 0.10.9.0 → 0.10.9.1
raw patch · 26 files changed
+1529/−2983 lines, 26 filesdep ~base
Dependency ranges changed: base
Files
- Data/Vector.hs +8/−8
- Data/Vector/Fusion/Bundle.hs +0/−631
- Data/Vector/Fusion/Bundle/Monadic.hs +0/−1098
- Data/Vector/Fusion/Bundle/Size.hs +0/−87
- Data/Vector/Fusion/Stream.hs +634/−0
- Data/Vector/Fusion/Stream/Monadic.hs +196/−321
- Data/Vector/Fusion/Stream/Size.hs +87/−0
- Data/Vector/Generic.hs +231/−232
- Data/Vector/Generic/Base.hs +2/−2
- Data/Vector/Generic/Mutable.hs +93/−182
- Data/Vector/Generic/Mutable/Base.hs +0/−135
- Data/Vector/Generic/New.hs +49/−54
- Data/Vector/Primitive.hs +8/−8
- Data/Vector/Storable.hs +8/−8
- Data/Vector/Unboxed.hs +8/−8
- benchmarks/vector-benchmarks.cabal +2/−2
- include/vector.h +4/−6
- internal/GenUnboxTuple.hs +2/−2
- internal/unbox-tuple-instances +15/−15
- tests/Main.hs +2/−2
- tests/Tests/Bundle.hs +0/−163
- tests/Tests/Stream.hs +163/−0
- tests/Tests/Vector.hs +2/−2
- tests/Utilities.hs +8/−8
- tests/vector-tests.cabal +3/−3
- vector.cabal +4/−6
Data/Vector.hs view
@@ -159,7 +159,7 @@ import qualified Data.Vector.Generic as G import Data.Vector.Mutable ( MVector(..) ) import Data.Primitive.Array-import qualified Data.Vector.Fusion.Bundle as Bundle+import qualified Data.Vector.Fusion.Stream as Stream import Control.DeepSeq ( NFData, rnf ) import Control.Monad ( MonadPlus(..), liftM, ap )@@ -244,27 +244,27 @@ -- See http://trac.haskell.org/vector/ticket/12 instance Eq a => Eq (Vector a) where {-# INLINE (==) #-}- xs == ys = Bundle.eq (G.stream xs) (G.stream ys)+ xs == ys = Stream.eq (G.stream xs) (G.stream ys) {-# INLINE (/=) #-}- xs /= ys = not (Bundle.eq (G.stream xs) (G.stream ys))+ xs /= ys = not (Stream.eq (G.stream xs) (G.stream ys)) -- See http://trac.haskell.org/vector/ticket/12 instance Ord a => Ord (Vector a) where {-# INLINE compare #-}- compare xs ys = Bundle.cmp (G.stream xs) (G.stream ys)+ compare xs ys = Stream.cmp (G.stream xs) (G.stream ys) {-# INLINE (<) #-}- xs < ys = Bundle.cmp (G.stream xs) (G.stream ys) == LT+ xs < ys = Stream.cmp (G.stream xs) (G.stream ys) == LT {-# INLINE (<=) #-}- xs <= ys = Bundle.cmp (G.stream xs) (G.stream ys) /= GT+ xs <= ys = Stream.cmp (G.stream xs) (G.stream ys) /= GT {-# INLINE (>) #-}- xs > ys = Bundle.cmp (G.stream xs) (G.stream ys) == GT+ xs > ys = Stream.cmp (G.stream xs) (G.stream ys) == GT {-# INLINE (>=) #-}- xs >= ys = Bundle.cmp (G.stream xs) (G.stream ys) /= LT+ xs >= ys = Stream.cmp (G.stream xs) (G.stream ys) /= LT instance Monoid (Vector a) where {-# INLINE mempty #-}
− Data/Vector/Fusion/Bundle.hs
@@ -1,631 +0,0 @@-{-# LANGUAGE FlexibleInstances, Rank2Types, BangPatterns #-}---- |--- Module : Data.Vector.Fusion.Bundle--- Copyright : (c) Roman Leshchinskiy 2008-2010--- License : BSD-style------ Maintainer : Roman Leshchinskiy <rl@cse.unsw.edu.au>--- Stability : experimental--- Portability : non-portable--- --- Bundles for stream fusion-----module Data.Vector.Fusion.Bundle (- -- * Types- Step(..), Chunk(..), Bundle, MBundle,-- -- * In-place markers- inplace,-- -- * Size hints- size, sized,-- -- * Length information- length, null,-- -- * Construction- empty, singleton, cons, snoc, replicate, generate, (++),-- -- * Accessing individual elements- head, last, (!!), (!?),-- -- * Substreams- slice, init, tail, take, drop,-- -- * Mapping- map, concatMap, flatten, unbox,- - -- * Zipping- indexed, indexedR,- zipWith, zipWith3, zipWith4, zipWith5, zipWith6,- zip, zip3, zip4, zip5, zip6,-- -- * Filtering- filter, takeWhile, dropWhile,-- -- * Searching- elem, notElem, find, findIndex,-- -- * Folding- foldl, foldl1, foldl', foldl1', foldr, foldr1,-- -- * Specialised folds- and, or,-- -- * Unfolding- unfoldr, unfoldrN, iterateN,-- -- * Scans- prescanl, prescanl',- postscanl, postscanl',- scanl, scanl',- scanl1, scanl1',-- -- * Enumerations- enumFromStepN, enumFromTo, enumFromThenTo,-- -- * Conversions- toList, fromList, fromListN, unsafeFromList, lift,- fromVector, reVector, fromVectors, concatVectors,-- -- * Monadic combinators- mapM, mapM_, zipWithM, zipWithM_, filterM, foldM, fold1M, foldM', fold1M',-- eq, cmp-) where--import Data.Vector.Generic.Base ( Vector )-import Data.Vector.Fusion.Bundle.Size-import Data.Vector.Fusion.Util-import Data.Vector.Fusion.Stream.Monadic ( Stream(..), Step(..), SPEC(..) )-import Data.Vector.Fusion.Bundle.Monadic ( Chunk(..) )-import qualified Data.Vector.Fusion.Bundle.Monadic as M-import qualified Data.Vector.Fusion.Stream.Monadic as S--import Prelude hiding ( length, null,- replicate, (++),- head, last, (!!),- init, tail, take, drop,- map, concatMap,- zipWith, zipWith3, zip, zip3,- filter, takeWhile, dropWhile,- elem, notElem,- foldl, foldl1, foldr, foldr1,- and, or,- scanl, scanl1,- enumFromTo, enumFromThenTo,- mapM, mapM_ )--import GHC.Base ( build )--#include "vector.h"---- | The type of pure streams -type Bundle = M.Bundle Id---- | Alternative name for monadic streams-type MBundle = M.Bundle--inplace :: (forall m. Monad m => S.Stream m a -> S.Stream m b)- -> (Size -> Size) -> Bundle v a -> Bundle v b-{-# INLINE_FUSED inplace #-}-inplace f g b = b `seq` M.fromStream (f (M.elements b)) (g (M.size b))--{-# RULES--"inplace/inplace [Vector]"- forall (f1 :: forall m. Monad m => S.Stream m a -> S.Stream m a)- (f2 :: forall m. Monad m => S.Stream m a -> S.Stream m a)- g1 g2 s.- inplace f1 g1 (inplace f2 g2 s) = inplace (f1 . f2) (g1 . g2) s-- #-}---- | Convert a pure stream to a monadic stream-lift :: Monad m => Bundle v a -> M.Bundle m v a-{-# INLINE_FUSED lift #-}-lift (M.Bundle (Stream step s) (Stream vstep t) v sz)- = M.Bundle (Stream (return . unId . step) s)- (Stream (return . unId . vstep) t) v sz---- | 'Size' hint of a 'Bundle'-size :: Bundle v a -> Size-{-# INLINE size #-}-size = M.size---- | Attach a 'Size' hint to a 'Bundle'-sized :: Bundle v a -> Size -> Bundle v a-{-# INLINE sized #-}-sized = M.sized---- Length--- ---------- | Length of a 'Bundle'-length :: Bundle v a -> Int-{-# INLINE length #-}-length = unId . M.length---- | Check if a 'Bundle' is empty-null :: Bundle v a -> Bool-{-# INLINE null #-}-null = unId . M.null---- Construction--- ---------------- | Empty 'Bundle'-empty :: Bundle v a-{-# INLINE empty #-}-empty = M.empty---- | Singleton 'Bundle'-singleton :: a -> Bundle v a-{-# INLINE singleton #-}-singleton = M.singleton---- | Replicate a value to a given length-replicate :: Int -> a -> Bundle v a-{-# INLINE replicate #-}-replicate = M.replicate---- | Generate a stream from its indices-generate :: Int -> (Int -> a) -> Bundle v a-{-# INLINE generate #-}-generate = M.generate---- | Prepend an element-cons :: a -> Bundle v a -> Bundle v a-{-# INLINE cons #-}-cons = M.cons---- | Append an element-snoc :: Bundle v a -> a -> Bundle v a-{-# INLINE snoc #-}-snoc = M.snoc--infixr 5 ++--- | Concatenate two 'Bundle's-(++) :: Bundle v a -> Bundle v a -> Bundle v a-{-# INLINE (++) #-}-(++) = (M.++)---- Accessing elements--- ---------------------- | First element of the 'Bundle' or error if empty-head :: Bundle v a -> a-{-# INLINE head #-}-head = unId . M.head---- | Last element of the 'Bundle' or error if empty-last :: Bundle v a -> a-{-# INLINE last #-}-last = unId . M.last--infixl 9 !!--- | Element at the given position-(!!) :: Bundle v a -> Int -> a-{-# INLINE (!!) #-}-s !! i = unId (s M.!! i)--infixl 9 !?--- | Element at the given position or 'Nothing' if out of bounds-(!?) :: Bundle v a -> Int -> Maybe a-{-# INLINE (!?) #-}-s !? i = unId (s M.!? i)---- Substreams--- -------------- | Extract a substream of the given length starting at the given position.-slice :: Int -- ^ starting index- -> Int -- ^ length- -> Bundle v a- -> Bundle v a-{-# INLINE slice #-}-slice = M.slice---- | All but the last element-init :: Bundle v a -> Bundle v a-{-# INLINE init #-}-init = M.init---- | All but the first element-tail :: Bundle v a -> Bundle v a-{-# INLINE tail #-}-tail = M.tail---- | The first @n@ elements-take :: Int -> Bundle v a -> Bundle v a-{-# INLINE take #-}-take = M.take---- | All but the first @n@ elements-drop :: Int -> Bundle v a -> Bundle v a-{-# INLINE drop #-}-drop = M.drop---- Mapping--- ------------------- | Map a function over a 'Bundle'-map :: (a -> b) -> Bundle v a -> Bundle v b-{-# INLINE map #-}-map = M.map--unbox :: Bundle v (Box a) -> Bundle v a-{-# INLINE unbox #-}-unbox = M.unbox--concatMap :: (a -> Bundle v b) -> Bundle v a -> Bundle v b-{-# INLINE concatMap #-}-concatMap = M.concatMap---- Zipping--- ----------- | Pair each element in a 'Bundle' with its index-indexed :: Bundle v a -> Bundle v (Int,a)-{-# INLINE indexed #-}-indexed = M.indexed---- | Pair each element in a 'Bundle' with its index, starting from the right--- and counting down-indexedR :: Int -> Bundle v a -> Bundle v (Int,a)-{-# INLINE_FUSED indexedR #-}-indexedR = M.indexedR---- | Zip two 'Bundle's with the given function-zipWith :: (a -> b -> c) -> Bundle v a -> Bundle v b -> Bundle v c-{-# INLINE zipWith #-}-zipWith = M.zipWith---- | Zip three 'Bundle's with the given function-zipWith3 :: (a -> b -> c -> d) -> Bundle v a -> Bundle v b -> Bundle v c -> Bundle v d-{-# INLINE zipWith3 #-}-zipWith3 = M.zipWith3--zipWith4 :: (a -> b -> c -> d -> e)- -> Bundle v a -> Bundle v b -> Bundle v c -> Bundle v d- -> Bundle v e-{-# INLINE zipWith4 #-}-zipWith4 = M.zipWith4--zipWith5 :: (a -> b -> c -> d -> e -> f)- -> Bundle v a -> Bundle v b -> Bundle v c -> Bundle v d- -> Bundle v e -> Bundle v f-{-# INLINE zipWith5 #-}-zipWith5 = M.zipWith5--zipWith6 :: (a -> b -> c -> d -> e -> f -> g)- -> Bundle v a -> Bundle v b -> Bundle v c -> Bundle v d- -> Bundle v e -> Bundle v f -> Bundle v g-{-# INLINE zipWith6 #-}-zipWith6 = M.zipWith6--zip :: Bundle v a -> Bundle v b -> Bundle v (a,b)-{-# INLINE zip #-}-zip = M.zip--zip3 :: Bundle v a -> Bundle v b -> Bundle v c -> Bundle v (a,b,c)-{-# INLINE zip3 #-}-zip3 = M.zip3--zip4 :: Bundle v a -> Bundle v b -> Bundle v c -> Bundle v d- -> Bundle v (a,b,c,d)-{-# INLINE zip4 #-}-zip4 = M.zip4--zip5 :: Bundle v a -> Bundle v b -> Bundle v c -> Bundle v d- -> Bundle v e -> Bundle v (a,b,c,d,e)-{-# INLINE zip5 #-}-zip5 = M.zip5--zip6 :: Bundle v a -> Bundle v b -> Bundle v c -> Bundle v d- -> Bundle v e -> Bundle v f -> Bundle v (a,b,c,d,e,f)-{-# INLINE zip6 #-}-zip6 = M.zip6---- Filtering--- ------------- | Drop elements which do not satisfy the predicate-filter :: (a -> Bool) -> Bundle v a -> Bundle v a-{-# INLINE filter #-}-filter = M.filter---- | Longest prefix of elements that satisfy the predicate-takeWhile :: (a -> Bool) -> Bundle v a -> Bundle v a-{-# INLINE takeWhile #-}-takeWhile = M.takeWhile---- | Drop the longest prefix of elements that satisfy the predicate-dropWhile :: (a -> Bool) -> Bundle v a -> Bundle v a-{-# INLINE dropWhile #-}-dropWhile = M.dropWhile---- Searching--- -----------infix 4 `elem`--- | Check whether the 'Bundle' contains an element-elem :: Eq a => a -> Bundle v a -> Bool-{-# INLINE elem #-}-elem x = unId . M.elem x--infix 4 `notElem`--- | Inverse of `elem`-notElem :: Eq a => a -> Bundle v a -> Bool-{-# INLINE notElem #-}-notElem x = unId . M.notElem x---- | Yield 'Just' the first element matching the predicate or 'Nothing' if no--- such element exists.-find :: (a -> Bool) -> Bundle v a -> Maybe a-{-# INLINE find #-}-find f = unId . M.find f---- | Yield 'Just' the index of the first element matching the predicate or--- 'Nothing' if no such element exists.-findIndex :: (a -> Bool) -> Bundle v a -> Maybe Int-{-# INLINE findIndex #-}-findIndex f = unId . M.findIndex f---- Folding--- ----------- | Left fold-foldl :: (a -> b -> a) -> a -> Bundle v b -> a-{-# INLINE foldl #-}-foldl f z = unId . M.foldl f z---- | Left fold on non-empty 'Bundle's-foldl1 :: (a -> a -> a) -> Bundle v a -> a-{-# INLINE foldl1 #-}-foldl1 f = unId . M.foldl1 f---- | Left fold with strict accumulator-foldl' :: (a -> b -> a) -> a -> Bundle v b -> a-{-# INLINE foldl' #-}-foldl' f z = unId . M.foldl' f z---- | Left fold on non-empty 'Bundle's with strict accumulator-foldl1' :: (a -> a -> a) -> Bundle v a -> a-{-# INLINE foldl1' #-}-foldl1' f = unId . M.foldl1' f---- | Right fold-foldr :: (a -> b -> b) -> b -> Bundle v a -> b-{-# INLINE foldr #-}-foldr f z = unId . M.foldr f z---- | Right fold on non-empty 'Bundle's-foldr1 :: (a -> a -> a) -> Bundle v a -> a-{-# INLINE foldr1 #-}-foldr1 f = unId . M.foldr1 f---- Specialised folds--- -------------------and :: Bundle v Bool -> Bool-{-# INLINE and #-}-and = unId . M.and--or :: Bundle v Bool -> Bool-{-# INLINE or #-}-or = unId . M.or---- Unfolding--- ------------- | Unfold-unfoldr :: (s -> Maybe (a, s)) -> s -> Bundle v a-{-# INLINE unfoldr #-}-unfoldr = M.unfoldr---- | Unfold at most @n@ elements-unfoldrN :: Int -> (s -> Maybe (a, s)) -> s -> Bundle v a-{-# INLINE unfoldrN #-}-unfoldrN = M.unfoldrN---- | Apply function n-1 times to value. Zeroth element is original value.-iterateN :: Int -> (a -> a) -> a -> Bundle v a-{-# INLINE iterateN #-}-iterateN = M.iterateN---- Scans--- --------- | Prefix scan-prescanl :: (a -> b -> a) -> a -> Bundle v b -> Bundle v a-{-# INLINE prescanl #-}-prescanl = M.prescanl---- | Prefix scan with strict accumulator-prescanl' :: (a -> b -> a) -> a -> Bundle v b -> Bundle v a-{-# INLINE prescanl' #-}-prescanl' = M.prescanl'---- | Suffix scan-postscanl :: (a -> b -> a) -> a -> Bundle v b -> Bundle v a-{-# INLINE postscanl #-}-postscanl = M.postscanl---- | Suffix scan with strict accumulator-postscanl' :: (a -> b -> a) -> a -> Bundle v b -> Bundle v a-{-# INLINE postscanl' #-}-postscanl' = M.postscanl'---- | Haskell-style scan-scanl :: (a -> b -> a) -> a -> Bundle v b -> Bundle v a-{-# INLINE scanl #-}-scanl = M.scanl---- | Haskell-style scan with strict accumulator-scanl' :: (a -> b -> a) -> a -> Bundle v b -> Bundle v a-{-# INLINE scanl' #-}-scanl' = M.scanl'---- | Scan over a non-empty 'Bundle'-scanl1 :: (a -> a -> a) -> Bundle v a -> Bundle v a-{-# INLINE scanl1 #-}-scanl1 = M.scanl1---- | Scan over a non-empty 'Bundle' with a strict accumulator-scanl1' :: (a -> a -> a) -> Bundle v a -> Bundle v a-{-# INLINE scanl1' #-}-scanl1' = M.scanl1'----- Comparisons--- --------------- | Check if two 'Bundle's are equal-eq :: Eq a => Bundle v a -> Bundle v a -> Bool-{-# INLINE eq #-}-eq x y = unId (M.eq x y)---- | Lexicographically compare two 'Bundle's-cmp :: Ord a => Bundle v a -> Bundle v a -> Ordering-{-# INLINE cmp #-}-cmp x y = unId (M.cmp x y)--instance Eq a => Eq (M.Bundle Id v a) where- {-# INLINE (==) #-}- (==) = eq--instance Ord a => Ord (M.Bundle Id v a) where- {-# INLINE compare #-}- compare = cmp---- Monadic combinators--- ----------------------- | Apply a monadic action to each element of the stream, producing a monadic--- stream of results-mapM :: Monad m => (a -> m b) -> Bundle v a -> M.Bundle m v b-{-# INLINE mapM #-}-mapM f = M.mapM f . lift---- | Apply a monadic action to each element of the stream-mapM_ :: Monad m => (a -> m b) -> Bundle v a -> m ()-{-# INLINE mapM_ #-}-mapM_ f = M.mapM_ f . lift--zipWithM :: Monad m => (a -> b -> m c) -> Bundle v a -> Bundle v b -> M.Bundle m v c-{-# INLINE zipWithM #-}-zipWithM f as bs = M.zipWithM f (lift as) (lift bs)--zipWithM_ :: Monad m => (a -> b -> m c) -> Bundle v a -> Bundle v b -> m ()-{-# INLINE zipWithM_ #-}-zipWithM_ f as bs = M.zipWithM_ f (lift as) (lift bs)---- | Yield a monadic stream of elements that satisfy the monadic predicate-filterM :: Monad m => (a -> m Bool) -> Bundle v a -> M.Bundle m v a-{-# INLINE filterM #-}-filterM f = M.filterM f . lift---- | Monadic fold-foldM :: Monad m => (a -> b -> m a) -> a -> Bundle v b -> m a-{-# INLINE foldM #-}-foldM m z = M.foldM m z . lift---- | Monadic fold over non-empty stream-fold1M :: Monad m => (a -> a -> m a) -> Bundle v a -> m a-{-# INLINE fold1M #-}-fold1M m = M.fold1M m . lift---- | Monadic fold with strict accumulator-foldM' :: Monad m => (a -> b -> m a) -> a -> Bundle v b -> m a-{-# INLINE foldM' #-}-foldM' m z = M.foldM' m z . lift---- | Monad fold over non-empty stream with strict accumulator-fold1M' :: Monad m => (a -> a -> m a) -> Bundle v a -> m a-{-# INLINE fold1M' #-}-fold1M' m = M.fold1M' m . lift---- Enumerations--- ---------------- | Yield a 'Bundle' of the given length containing the values @x@, @x+y@,--- @x+y+y@ etc.-enumFromStepN :: Num a => a -> a -> Int -> Bundle v a-{-# INLINE enumFromStepN #-}-enumFromStepN = M.enumFromStepN---- | Enumerate values------ /WARNING:/ This operations can be very inefficient. If at all possible, use--- 'enumFromStepN' instead.-enumFromTo :: Enum a => a -> a -> Bundle v a-{-# INLINE enumFromTo #-}-enumFromTo = M.enumFromTo---- | Enumerate values with a given step.------ /WARNING:/ This operations is very inefficient. If at all possible, use--- 'enumFromStepN' instead.-enumFromThenTo :: Enum a => a -> a -> a -> Bundle v a-{-# INLINE enumFromThenTo #-}-enumFromThenTo = M.enumFromThenTo---- Conversions--- --------------- | Convert a 'Bundle' to a list-toList :: Bundle v a -> [a]-{-# INLINE toList #-}--- toList s = unId (M.toList s)-toList s = build (\c n -> toListFB c n s)---- This supports foldr/build list fusion that GHC implements-toListFB :: (a -> b -> b) -> b -> Bundle v a -> b-{-# INLINE [0] toListFB #-}-toListFB c n M.Bundle{M.sElems = Stream step s} = go s- where- go s = case unId (step s) of- Yield x s' -> x `c` go s'- Skip s' -> go s'- Done -> n---- | Create a 'Bundle' from a list-fromList :: [a] -> Bundle v a-{-# INLINE fromList #-}-fromList = M.fromList---- | Create a 'Bundle' from the first @n@ elements of a list------ > fromListN n xs = fromList (take n xs)-fromListN :: Int -> [a] -> Bundle v a-{-# INLINE fromListN #-}-fromListN = M.fromListN--unsafeFromList :: Size -> [a] -> Bundle v a-{-# INLINE unsafeFromList #-}-unsafeFromList = M.unsafeFromList--fromVector :: Vector v a => v a -> Bundle v a-{-# INLINE fromVector #-}-fromVector = M.fromVector--reVector :: Bundle u a -> Bundle v a-{-# INLINE reVector #-}-reVector = M.reVector--fromVectors :: Vector v a => [v a] -> Bundle v a-{-# INLINE fromVectors #-}-fromVectors = M.fromVectors--concatVectors :: Vector v a => Bundle u (v a) -> Bundle v a-{-# INLINE concatVectors #-}-concatVectors = M.concatVectors---- | Create a 'Bundle' of values from a 'Bundle' of streamable things-flatten :: (a -> s) -> (s -> Step s b) -> Size -> Bundle v a -> Bundle v b-{-# INLINE_FUSED flatten #-}-flatten mk istep sz = M.flatten (return . mk) (return . istep) sz . lift-
− Data/Vector/Fusion/Bundle/Monadic.hs
@@ -1,1098 +0,0 @@-{-# LANGUAGE ExistentialQuantification, MultiParamTypeClasses, FlexibleInstances, Rank2Types, BangPatterns, KindSignatures, GADTs, ScopedTypeVariables #-}---- |--- Module : Data.Vector.Fusion.Bundle.Monadic--- Copyright : (c) Roman Leshchinskiy 2008-2010--- License : BSD-style------ Maintainer : Roman Leshchinskiy <rl@cse.unsw.edu.au>--- Stability : experimental--- Portability : non-portable------ Monadic bundles.-----module Data.Vector.Fusion.Bundle.Monadic (- Bundle(..), Chunk(..),-- -- * Size hints- size, sized,-- -- * Length- length, null,-- -- * Construction- empty, singleton, cons, snoc, replicate, replicateM, generate, generateM, (++),-- -- * Accessing elements- head, last, (!!), (!?),-- -- * Substreams- slice, init, tail, take, drop,-- -- * Mapping- map, mapM, mapM_, trans, unbox, concatMap, flatten,- - -- * Zipping- indexed, indexedR, zipWithM_,- zipWithM, zipWith3M, zipWith4M, zipWith5M, zipWith6M,- zipWith, zipWith3, zipWith4, zipWith5, zipWith6,- zip, zip3, zip4, zip5, zip6,-- -- * Comparisons- eq, cmp,-- -- * Filtering- filter, filterM, takeWhile, takeWhileM, dropWhile, dropWhileM,-- -- * Searching- elem, notElem, find, findM, findIndex, findIndexM,-- -- * Folding- foldl, foldlM, foldl1, foldl1M, foldM, fold1M,- foldl', foldlM', foldl1', foldl1M', foldM', fold1M',- foldr, foldrM, foldr1, foldr1M,-- -- * Specialised folds- and, or, concatMapM,-- -- * Unfolding- unfoldr, unfoldrM,- unfoldrN, unfoldrNM,- iterateN, iterateNM,-- -- * Scans- prescanl, prescanlM, prescanl', prescanlM',- postscanl, postscanlM, postscanl', postscanlM',- scanl, scanlM, scanl', scanlM',- scanl1, scanl1M, scanl1', scanl1M',-- -- * Enumerations- enumFromStepN, enumFromTo, enumFromThenTo,-- -- * Conversions- toList, fromList, fromListN, unsafeFromList,- fromVector, reVector, fromVectors, concatVectors,- fromStream, chunks, elements-) where--import Data.Vector.Generic.Base-import qualified Data.Vector.Generic.Mutable.Base as M-import Data.Vector.Fusion.Bundle.Size-import Data.Vector.Fusion.Util ( Box(..), delay_inline )-import Data.Vector.Fusion.Stream.Monadic ( Stream(..), Step(..), SPEC(..) )-import qualified Data.Vector.Fusion.Stream.Monadic as S-import Control.Monad.Primitive--import qualified Data.List as List-import Data.Char ( ord )-import GHC.Base ( unsafeChr )-import Control.Monad ( liftM )-import Prelude hiding ( length, null,- replicate, (++),- head, last, (!!),- init, tail, take, drop,- map, mapM, mapM_, concatMap,- zipWith, zipWith3, zip, zip3,- filter, takeWhile, dropWhile,- elem, notElem,- foldl, foldl1, foldr, foldr1,- and, or,- scanl, scanl1,- enumFromTo, enumFromThenTo )--import Data.Int ( Int8, Int16, Int32, Int64 )-import Data.Word ( Word8, Word16, Word32, Word, Word64 )--#include "vector.h"--data Chunk v a = Chunk Int (forall m. (PrimMonad m, Vector v a) => Mutable v (PrimState m) a -> m ())---- | Monadic streams-data Bundle m v a = Bundle { sElems :: Stream m a- , sChunks :: Stream m (Chunk v a)- , sVector :: Maybe (v a)- , sSize :: Size- }--fromStream :: Monad m => Stream m a -> Size -> Bundle m v a-{-# INLINE fromStream #-}-fromStream (Stream step s) sz = Bundle (Stream step s) (Stream step' s) Nothing sz- where- step' s = do r <- step s- return $ fmap (\x -> Chunk 1 (\v -> M.basicUnsafeWrite v 0 x)) r--chunks :: Bundle m v a -> Stream m (Chunk v a)-{-# INLINE chunks #-}-chunks = sChunks--elements :: Bundle m v a -> Stream m a-{-# INLINE elements #-}-elements = sElems---- | 'Size' hint of a 'Bundle'-size :: Bundle m v a -> Size-{-# INLINE size #-}-size = sSize---- | Attach a 'Size' hint to a 'Bundle'-sized :: Bundle m v a -> Size -> Bundle m v a-{-# INLINE_FUSED sized #-}-sized s sz = s { sSize = sz }---- Length--- ---------- | Length of a 'Bundle'-length :: Monad m => Bundle m v a -> m Int-{-# INLINE_FUSED length #-}-length Bundle{sSize = Exact n} = return n-length Bundle{sChunks = s} = S.foldl' (\n (Chunk k _) -> n+k) 0 s---- | Check if a 'Bundle' is empty-null :: Monad m => Bundle m v a -> m Bool-{-# INLINE_FUSED null #-}-null Bundle{sSize = Exact n} = return (n == 0)-null Bundle{sChunks = s} = S.foldr (\(Chunk n _) z -> n == 0 && z) True s---- Construction--- ---------------- | Empty 'Bundle'-empty :: Monad m => Bundle m v a-{-# INLINE_FUSED empty #-}-empty = fromStream S.empty (Exact 0)---- | Singleton 'Bundle'-singleton :: Monad m => a -> Bundle m v a-{-# INLINE_FUSED singleton #-}-singleton x = fromStream (S.singleton x) (Exact 1)---- | Replicate a value to a given length-replicate :: Monad m => Int -> a -> Bundle m v a-{-# INLINE_FUSED replicate #-}-replicate n x = Bundle (S.replicate n x)- (S.singleton $ Chunk len (\v -> M.basicSet v x))- Nothing- (Exact len)- where- len = delay_inline max n 0---- | Yield a 'Bundle' of values obtained by performing the monadic action the--- given number of times-replicateM :: Monad m => Int -> m a -> Bundle m v a-{-# INLINE_FUSED replicateM #-}--- NOTE: We delay inlining max here because GHC will create a join point for--- the call to newArray# otherwise which is not really nice.-replicateM n p = fromStream (S.replicateM n p) (Exact (delay_inline max n 0))--generate :: Monad m => Int -> (Int -> a) -> Bundle m v a-{-# INLINE generate #-}-generate n f = generateM n (return . f)---- | Generate a stream from its indices-generateM :: Monad m => Int -> (Int -> m a) -> Bundle m v a-{-# INLINE_FUSED generateM #-}-generateM n f = fromStream (S.generateM n f) (Exact (delay_inline max n 0))---- | Prepend an element-cons :: Monad m => a -> Bundle m v a -> Bundle m v a-{-# INLINE cons #-}-cons x s = singleton x ++ s---- | Append an element-snoc :: Monad m => Bundle m v a -> a -> Bundle m v a-{-# INLINE snoc #-}-snoc s x = s ++ singleton x--infixr 5 ++--- | Concatenate two 'Bundle's-(++) :: Monad m => Bundle m v a -> Bundle m v a -> Bundle m v a-{-# INLINE_FUSED (++) #-}-Bundle sa ta _ na ++ Bundle sb tb _ nb = Bundle (sa S.++ sb) (ta S.++ tb) Nothing (na + nb)---- Accessing elements--- ---------------------- | First element of the 'Bundle' or error if empty-head :: Monad m => Bundle m v a -> m a-{-# INLINE_FUSED head #-}-head = S.head . sElems---- | Last element of the 'Bundle' or error if empty-last :: Monad m => Bundle m v a -> m a-{-# INLINE_FUSED last #-}-last = S.last . sElems--infixl 9 !!--- | Element at the given position-(!!) :: Monad m => Bundle m v a -> Int -> m a-{-# INLINE (!!) #-}-b !! i = sElems b S.!! i--infixl 9 !?--- | Element at the given position or 'Nothing' if out of bounds-(!?) :: Monad m => Bundle m v a -> Int -> m (Maybe a)-{-# INLINE (!?) #-}-b !? i = sElems b S.!? i---- Substreams--- -------------- | Extract a substream of the given length starting at the given position.-slice :: Monad m => Int -- ^ starting index- -> Int -- ^ length- -> Bundle m v a- -> Bundle m v a-{-# INLINE slice #-}-slice i n s = take n (drop i s)---- | All but the last element-init :: Monad m => Bundle m v a -> Bundle m v a-{-# INLINE_FUSED init #-}-init Bundle{sElems = s, sSize = sz} = fromStream (S.init s) (sz-1)---- | All but the first element-tail :: Monad m => Bundle m v a -> Bundle m v a-{-# INLINE_FUSED tail #-}-tail Bundle{sElems = s, sSize = sz} = fromStream (S.tail s) (sz-1)---- | The first @n@ elements-take :: Monad m => Int -> Bundle m v a -> Bundle m v a-{-# INLINE_FUSED take #-}-take n Bundle{sElems = s, sSize = sz} = fromStream (S.take n s) (smaller (Exact n) sz)---- | All but the first @n@ elements-drop :: Monad m => Int -> Bundle m v a -> Bundle m v a-{-# INLINE_FUSED drop #-}-drop n Bundle{sElems = s, sSize = sz} = fromStream (S.drop n s) (sz - Exact n)---- Mapping--- ---------instance Monad m => Functor (Bundle m v) where- {-# INLINE fmap #-}- fmap = map---- | Map a function over a 'Bundle'-map :: Monad m => (a -> b) -> Bundle m v a -> Bundle m v b-{-# INLINE map #-}-map f = mapM (return . f)---- | Map a monadic function over a 'Bundle'-mapM :: Monad m => (a -> m b) -> Bundle m v a -> Bundle m v b-{-# INLINE_FUSED mapM #-}-mapM f Bundle{sElems = s, sSize = n} = fromStream (S.mapM f s) n---- | Execute a monadic action for each element of the 'Bundle'-mapM_ :: Monad m => (a -> m b) -> Bundle m v a -> m ()-{-# INLINE_FUSED mapM_ #-}-mapM_ m = S.mapM_ m . sElems---- | Transform a 'Bundle' to use a different monad-trans :: (Monad m, Monad m') => (forall a. m a -> m' a)- -> Bundle m v a -> Bundle m' v a-{-# INLINE_FUSED trans #-}-trans f Bundle{sElems = s, sChunks = cs, sVector = v, sSize = n}- = Bundle { sElems = S.trans f s, sChunks = S.trans f cs, sVector = v, sSize = n }--unbox :: Monad m => Bundle m v (Box a) -> Bundle m v a-{-# INLINE_FUSED unbox #-}-unbox Bundle{sElems = s, sSize = n} = fromStream (S.unbox s) n---- Zipping--- ----------- | Pair each element in a 'Bundle' with its index-indexed :: Monad m => Bundle m v a -> Bundle m v (Int,a)-{-# INLINE_FUSED indexed #-}-indexed Bundle{sElems = s, sSize = n} = fromStream (S.indexed s) n---- | Pair each element in a 'Bundle' with its index, starting from the right--- and counting down-indexedR :: Monad m => Int -> Bundle m v a -> Bundle m v (Int,a)-{-# INLINE_FUSED indexedR #-}-indexedR m Bundle{sElems = s, sSize = n} = fromStream (S.indexedR m s) n---- | Zip two 'Bundle's with the given monadic function-zipWithM :: Monad m => (a -> b -> m c) -> Bundle m v a -> Bundle m v b -> Bundle m v c-{-# INLINE_FUSED zipWithM #-}-zipWithM f Bundle{sElems = sa, sSize = na}- Bundle{sElems = sb, sSize = nb} = fromStream (S.zipWithM f sa sb) (smaller na nb)---- FIXME: This might expose an opportunity for inplace execution.-{-# RULES--"zipWithM xs xs [Vector.Bundle]" forall f xs.- zipWithM f xs xs = mapM (\x -> f x x) xs-- #-}--zipWithM_ :: Monad m => (a -> b -> m c) -> Bundle m v a -> Bundle m v b -> m ()-{-# INLINE zipWithM_ #-}-zipWithM_ f sa sb = S.zipWithM_ f (sElems sa) (sElems sb)--zipWith3M :: Monad m => (a -> b -> c -> m d) -> Bundle m v a -> Bundle m v b -> Bundle m v c -> Bundle m v d-{-# INLINE_FUSED zipWith3M #-}-zipWith3M f Bundle{sElems = sa, sSize = na}- Bundle{sElems = sb, sSize = nb}- Bundle{sElems = sc, sSize = nc}- = fromStream (S.zipWith3M f sa sb sc) (smaller na (smaller nb nc))--zipWith4M :: Monad m => (a -> b -> c -> d -> m e)- -> Bundle m v a -> Bundle m v b -> Bundle m v c -> Bundle m v d- -> Bundle m v e-{-# INLINE zipWith4M #-}-zipWith4M f sa sb sc sd- = zipWithM (\(a,b) (c,d) -> f a b c d) (zip sa sb) (zip sc sd)--zipWith5M :: Monad m => (a -> b -> c -> d -> e -> m f)- -> Bundle m v a -> Bundle m v b -> Bundle m v c -> Bundle m v d- -> Bundle m v e -> Bundle m v f-{-# INLINE zipWith5M #-}-zipWith5M f sa sb sc sd se- = zipWithM (\(a,b,c) (d,e) -> f a b c d e) (zip3 sa sb sc) (zip sd se)--zipWith6M :: Monad m => (a -> b -> c -> d -> e -> f -> m g)- -> Bundle m v a -> Bundle m v b -> Bundle m v c -> Bundle m v d- -> Bundle m v e -> Bundle m v f -> Bundle m v g-{-# INLINE zipWith6M #-}-zipWith6M fn sa sb sc sd se sf- = zipWithM (\(a,b,c) (d,e,f) -> fn a b c d e f) (zip3 sa sb sc)- (zip3 sd se sf)--zipWith :: Monad m => (a -> b -> c) -> Bundle m v a -> Bundle m v b -> Bundle m v c-{-# INLINE zipWith #-}-zipWith f = zipWithM (\a b -> return (f a b))--zipWith3 :: Monad m => (a -> b -> c -> d)- -> Bundle m v a -> Bundle m v b -> Bundle m v c -> Bundle m v d-{-# INLINE zipWith3 #-}-zipWith3 f = zipWith3M (\a b c -> return (f a b c))--zipWith4 :: Monad m => (a -> b -> c -> d -> e)- -> Bundle m v a -> Bundle m v b -> Bundle m v c -> Bundle m v d- -> Bundle m v e-{-# INLINE zipWith4 #-}-zipWith4 f = zipWith4M (\a b c d -> return (f a b c d))--zipWith5 :: Monad m => (a -> b -> c -> d -> e -> f)- -> Bundle m v a -> Bundle m v b -> Bundle m v c -> Bundle m v d- -> Bundle m v e -> Bundle m v f-{-# INLINE zipWith5 #-}-zipWith5 f = zipWith5M (\a b c d e -> return (f a b c d e))--zipWith6 :: Monad m => (a -> b -> c -> d -> e -> f -> g)- -> Bundle m v a -> Bundle m v b -> Bundle m v c -> Bundle m v d- -> Bundle m v e -> Bundle m v f -> Bundle m v g-{-# INLINE zipWith6 #-}-zipWith6 fn = zipWith6M (\a b c d e f -> return (fn a b c d e f))--zip :: Monad m => Bundle m v a -> Bundle m v b -> Bundle m v (a,b)-{-# INLINE zip #-}-zip = zipWith (,)--zip3 :: Monad m => Bundle m v a -> Bundle m v b -> Bundle m v c -> Bundle m v (a,b,c)-{-# INLINE zip3 #-}-zip3 = zipWith3 (,,)--zip4 :: Monad m => Bundle m v a -> Bundle m v b -> Bundle m v c -> Bundle m v d- -> Bundle m v (a,b,c,d)-{-# INLINE zip4 #-}-zip4 = zipWith4 (,,,)--zip5 :: Monad m => Bundle m v a -> Bundle m v b -> Bundle m v c -> Bundle m v d- -> Bundle m v e -> Bundle m v (a,b,c,d,e)-{-# INLINE zip5 #-}-zip5 = zipWith5 (,,,,)--zip6 :: Monad m => Bundle m v a -> Bundle m v b -> Bundle m v c -> Bundle m v d- -> Bundle m v e -> Bundle m v f -> Bundle m v (a,b,c,d,e,f)-{-# INLINE zip6 #-}-zip6 = zipWith6 (,,,,,)---- Comparisons--- --------------- | Check if two 'Bundle's are equal-eq :: (Monad m, Eq a) => Bundle m v a -> Bundle m v a -> m Bool-{-# INLINE_FUSED eq #-}-eq x y = sElems x `S.eq` sElems y---- | Lexicographically compare two 'Bundle's-cmp :: (Monad m, Ord a) => Bundle m v a -> Bundle m v a -> m Ordering-{-# INLINE_FUSED cmp #-}-cmp x y = sElems x `S.cmp` sElems y---- Filtering--- ------------- | Drop elements which do not satisfy the predicate-filter :: Monad m => (a -> Bool) -> Bundle m v a -> Bundle m v a-{-# INLINE filter #-}-filter f = filterM (return . f)---- | Drop elements which do not satisfy the monadic predicate-filterM :: Monad m => (a -> m Bool) -> Bundle m v a -> Bundle m v a-{-# INLINE_FUSED filterM #-}-filterM f Bundle{sElems = s, sSize = n} = fromStream (S.filterM f s) (toMax n)---- | Longest prefix of elements that satisfy the predicate-takeWhile :: Monad m => (a -> Bool) -> Bundle m v a -> Bundle m v a-{-# INLINE takeWhile #-}-takeWhile f = takeWhileM (return . f)---- | Longest prefix of elements that satisfy the monadic predicate-takeWhileM :: Monad m => (a -> m Bool) -> Bundle m v a -> Bundle m v a-{-# INLINE_FUSED takeWhileM #-}-takeWhileM f Bundle{sElems = s, sSize = n} = fromStream (S.takeWhileM f s) (toMax n)---- | Drop the longest prefix of elements that satisfy the predicate-dropWhile :: Monad m => (a -> Bool) -> Bundle m v a -> Bundle m v a-{-# INLINE dropWhile #-}-dropWhile f = dropWhileM (return . f)---- | Drop the longest prefix of elements that satisfy the monadic predicate-dropWhileM :: Monad m => (a -> m Bool) -> Bundle m v a -> Bundle m v a-{-# INLINE_FUSED dropWhileM #-}-dropWhileM f Bundle{sElems = s, sSize = n} = fromStream (S.dropWhileM f s) (toMax n)---- Searching--- -----------infix 4 `elem`--- | Check whether the 'Bundle' contains an element-elem :: (Monad m, Eq a) => a -> Bundle m v a -> m Bool-{-# INLINE_FUSED elem #-}-elem x = S.elem x . sElems--infix 4 `notElem`--- | Inverse of `elem`-notElem :: (Monad m, Eq a) => a -> Bundle m v a -> m Bool-{-# INLINE notElem #-}-notElem x = S.notElem x . sElems---- | Yield 'Just' the first element that satisfies the predicate or 'Nothing'--- if no such element exists.-find :: Monad m => (a -> Bool) -> Bundle m v a -> m (Maybe a)-{-# INLINE find #-}-find f = findM (return . f)---- | Yield 'Just' the first element that satisfies the monadic predicate or--- 'Nothing' if no such element exists.-findM :: Monad m => (a -> m Bool) -> Bundle m v a -> m (Maybe a)-{-# INLINE_FUSED findM #-}-findM f = S.findM f . sElems---- | Yield 'Just' the index of the first element that satisfies the predicate--- or 'Nothing' if no such element exists.-findIndex :: Monad m => (a -> Bool) -> Bundle m v a -> m (Maybe Int)-{-# INLINE_FUSED findIndex #-}-findIndex f = findIndexM (return . f)---- | Yield 'Just' the index of the first element that satisfies the monadic--- predicate or 'Nothing' if no such element exists.-findIndexM :: Monad m => (a -> m Bool) -> Bundle m v a -> m (Maybe Int)-{-# INLINE_FUSED findIndexM #-}-findIndexM f = S.findIndexM f . sElems---- Folding--- ----------- | Left fold-foldl :: Monad m => (a -> b -> a) -> a -> Bundle m v b -> m a-{-# INLINE foldl #-}-foldl f = foldlM (\a b -> return (f a b))---- | Left fold with a monadic operator-foldlM :: Monad m => (a -> b -> m a) -> a -> Bundle m v b -> m a-{-# INLINE_FUSED foldlM #-}-foldlM m z = S.foldlM m z . sElems---- | Same as 'foldlM'-foldM :: Monad m => (a -> b -> m a) -> a -> Bundle m v b -> m a-{-# INLINE foldM #-}-foldM = foldlM---- | Left fold over a non-empty 'Bundle'-foldl1 :: Monad m => (a -> a -> a) -> Bundle m v a -> m a-{-# INLINE foldl1 #-}-foldl1 f = foldl1M (\a b -> return (f a b))---- | Left fold over a non-empty 'Bundle' with a monadic operator-foldl1M :: Monad m => (a -> a -> m a) -> Bundle m v a -> m a-{-# INLINE_FUSED foldl1M #-}-foldl1M f = S.foldl1M f . sElems---- | Same as 'foldl1M'-fold1M :: Monad m => (a -> a -> m a) -> Bundle m v a -> m a-{-# INLINE fold1M #-}-fold1M = foldl1M---- | Left fold with a strict accumulator-foldl' :: Monad m => (a -> b -> a) -> a -> Bundle m v b -> m a-{-# INLINE foldl' #-}-foldl' f = foldlM' (\a b -> return (f a b))---- | Left fold with a strict accumulator and a monadic operator-foldlM' :: Monad m => (a -> b -> m a) -> a -> Bundle m v b -> m a-{-# INLINE_FUSED foldlM' #-}-foldlM' m z = S.foldlM' m z . sElems---- | Same as 'foldlM''-foldM' :: Monad m => (a -> b -> m a) -> a -> Bundle m v b -> m a-{-# INLINE foldM' #-}-foldM' = foldlM'---- | Left fold over a non-empty 'Bundle' with a strict accumulator-foldl1' :: Monad m => (a -> a -> a) -> Bundle m v a -> m a-{-# INLINE foldl1' #-}-foldl1' f = foldl1M' (\a b -> return (f a b))---- | Left fold over a non-empty 'Bundle' with a strict accumulator and a--- monadic operator-foldl1M' :: Monad m => (a -> a -> m a) -> Bundle m v a -> m a-{-# INLINE_FUSED foldl1M' #-}-foldl1M' f = S.foldl1M' f . sElems---- | Same as 'foldl1M''-fold1M' :: Monad m => (a -> a -> m a) -> Bundle m v a -> m a-{-# INLINE fold1M' #-}-fold1M' = foldl1M'---- | Right fold-foldr :: Monad m => (a -> b -> b) -> b -> Bundle m v a -> m b-{-# INLINE foldr #-}-foldr f = foldrM (\a b -> return (f a b))---- | Right fold with a monadic operator-foldrM :: Monad m => (a -> b -> m b) -> b -> Bundle m v a -> m b-{-# INLINE_FUSED foldrM #-}-foldrM f z = S.foldrM f z . sElems---- | Right fold over a non-empty stream-foldr1 :: Monad m => (a -> a -> a) -> Bundle m v a -> m a-{-# INLINE foldr1 #-}-foldr1 f = foldr1M (\a b -> return (f a b))---- | Right fold over a non-empty stream with a monadic operator-foldr1M :: Monad m => (a -> a -> m a) -> Bundle m v a -> m a-{-# INLINE_FUSED foldr1M #-}-foldr1M f = S.foldr1M f . sElems---- Specialised folds--- -------------------and :: Monad m => Bundle m v Bool -> m Bool-{-# INLINE_FUSED and #-}-and = S.and . sElems--or :: Monad m => Bundle m v Bool -> m Bool-{-# INLINE_FUSED or #-}-or = S.or . sElems--concatMap :: Monad m => (a -> Bundle m v b) -> Bundle m v a -> Bundle m v b-{-# INLINE concatMap #-}-concatMap f = concatMapM (return . f)--concatMapM :: Monad m => (a -> m (Bundle m v b)) -> Bundle m v a -> Bundle m v b-{-# INLINE_FUSED concatMapM #-}-concatMapM f Bundle{sElems = s} = fromStream (S.concatMapM (liftM sElems . f) s) Unknown---- | Create a 'Bundle' of values from a 'Bundle' of streamable things-flatten :: Monad m => (a -> m s) -> (s -> m (Step s b)) -> Size- -> Bundle m v a -> Bundle m v b-{-# INLINE_FUSED flatten #-}-flatten mk istep sz Bundle{sElems = s} = fromStream (S.flatten mk istep s) sz---- Unfolding--- ------------- | Unfold-unfoldr :: Monad m => (s -> Maybe (a, s)) -> s -> Bundle m u a-{-# INLINE_FUSED unfoldr #-}-unfoldr f = unfoldrM (return . f)---- | Unfold with a monadic function-unfoldrM :: Monad m => (s -> m (Maybe (a, s))) -> s -> Bundle m u a-{-# INLINE_FUSED unfoldrM #-}-unfoldrM f s = fromStream (S.unfoldrM f s) Unknown---- | Unfold at most @n@ elements-unfoldrN :: Monad m => Int -> (s -> Maybe (a, s)) -> s -> Bundle m u a-{-# INLINE_FUSED unfoldrN #-}-unfoldrN n f = unfoldrNM n (return . f)---- | Unfold at most @n@ elements with a monadic functions-unfoldrNM :: Monad m => Int -> (s -> m (Maybe (a, s))) -> s -> Bundle m u a-{-# INLINE_FUSED unfoldrNM #-}-unfoldrNM n f s = fromStream (S.unfoldrNM n f s) (Max (delay_inline max n 0))---- | Apply monadic function n times to value. Zeroth element is original value.-iterateNM :: Monad m => Int -> (a -> m a) -> a -> Bundle m u a-{-# INLINE_FUSED iterateNM #-}-iterateNM n f x0 = fromStream (S.iterateNM n f x0) (Exact (delay_inline max n 0))---- | Apply function n times to value. Zeroth element is original value.-iterateN :: Monad m => Int -> (a -> a) -> a -> Bundle m u a-{-# INLINE_FUSED iterateN #-}-iterateN n f x0 = iterateNM n (return . f) x0---- Scans--- --------- | Prefix scan-prescanl :: Monad m => (a -> b -> a) -> a -> Bundle m v b -> Bundle m v a-{-# INLINE prescanl #-}-prescanl f = prescanlM (\a b -> return (f a b))---- | Prefix scan with a monadic operator-prescanlM :: Monad m => (a -> b -> m a) -> a -> Bundle m v b -> Bundle m v a-{-# INLINE_FUSED prescanlM #-}-prescanlM f z Bundle{sElems = s, sSize = sz} = fromStream (S.prescanlM f z s) sz---- | Prefix scan with strict accumulator-prescanl' :: Monad m => (a -> b -> a) -> a -> Bundle m v b -> Bundle m v a-{-# INLINE prescanl' #-}-prescanl' f = prescanlM' (\a b -> return (f a b))---- | Prefix scan with strict accumulator and a monadic operator-prescanlM' :: Monad m => (a -> b -> m a) -> a -> Bundle m v b -> Bundle m v a-{-# INLINE_FUSED prescanlM' #-}-prescanlM' f z Bundle{sElems = s, sSize = sz} = fromStream (S.prescanlM' f z s) sz---- | Suffix scan-postscanl :: Monad m => (a -> b -> a) -> a -> Bundle m v b -> Bundle m v a-{-# INLINE postscanl #-}-postscanl f = postscanlM (\a b -> return (f a b))---- | Suffix scan with a monadic operator-postscanlM :: Monad m => (a -> b -> m a) -> a -> Bundle m v b -> Bundle m v a-{-# INLINE_FUSED postscanlM #-}-postscanlM f z Bundle{sElems = s, sSize = sz} = fromStream (S.postscanlM f z s) sz---- | Suffix scan with strict accumulator-postscanl' :: Monad m => (a -> b -> a) -> a -> Bundle m v b -> Bundle m v a-{-# INLINE postscanl' #-}-postscanl' f = postscanlM' (\a b -> return (f a b))---- | Suffix scan with strict acccumulator and a monadic operator-postscanlM' :: Monad m => (a -> b -> m a) -> a -> Bundle m v b -> Bundle m v a-{-# INLINE_FUSED postscanlM' #-}-postscanlM' f z Bundle{sElems = s, sSize = sz} = fromStream (S.postscanlM' f z s) sz---- | Haskell-style scan-scanl :: Monad m => (a -> b -> a) -> a -> Bundle m v b -> Bundle m v a-{-# INLINE scanl #-}-scanl f = scanlM (\a b -> return (f a b))---- | Haskell-style scan with a monadic operator-scanlM :: Monad m => (a -> b -> m a) -> a -> Bundle m v b -> Bundle m v a-{-# INLINE scanlM #-}-scanlM f z s = z `cons` postscanlM f z s---- | Haskell-style scan with strict accumulator-scanl' :: Monad m => (a -> b -> a) -> a -> Bundle m v b -> Bundle m v a-{-# INLINE scanl' #-}-scanl' f = scanlM' (\a b -> return (f a b))---- | Haskell-style scan with strict accumulator and a monadic operator-scanlM' :: Monad m => (a -> b -> m a) -> a -> Bundle m v b -> Bundle m v a-{-# INLINE scanlM' #-}-scanlM' f z s = z `seq` (z `cons` postscanlM f z s)---- | Scan over a non-empty 'Bundle'-scanl1 :: Monad m => (a -> a -> a) -> Bundle m v a -> Bundle m v a-{-# INLINE scanl1 #-}-scanl1 f = scanl1M (\x y -> return (f x y))---- | Scan over a non-empty 'Bundle' with a monadic operator-scanl1M :: Monad m => (a -> a -> m a) -> Bundle m v a -> Bundle m v a-{-# INLINE_FUSED scanl1M #-}-scanl1M f Bundle{sElems = s, sSize = sz} = fromStream (S.scanl1M f s) sz---- | Scan over a non-empty 'Bundle' with a strict accumulator-scanl1' :: Monad m => (a -> a -> a) -> Bundle m v a -> Bundle m v a-{-# INLINE scanl1' #-}-scanl1' f = scanl1M' (\x y -> return (f x y))---- | Scan over a non-empty 'Bundle' with a strict accumulator and a monadic--- operator-scanl1M' :: Monad m => (a -> a -> m a) -> Bundle m v a -> Bundle m v a-{-# INLINE_FUSED scanl1M' #-}-scanl1M' f Bundle{sElems = s, sSize = sz} = fromStream (S.scanl1M' f s) sz---- Enumerations--- ---------------- The Enum class is broken for this, there just doesn't seem to be a--- way to implement this generically. We have to specialise for as many types--- as we can but this doesn't help in polymorphic loops.---- | Yield a 'Bundle' of the given length containing the values @x@, @x+y@,--- @x+y+y@ etc.-enumFromStepN :: (Num a, Monad m) => a -> a -> Int -> Bundle m v a-{-# INLINE_FUSED enumFromStepN #-}-enumFromStepN x y n = fromStream (S.enumFromStepN x y n) (Exact (delay_inline max n 0))---- | Enumerate values------ /WARNING:/ This operation can be very inefficient. If at all possible, use--- 'enumFromStepN' instead.-enumFromTo :: (Enum a, Monad m) => a -> a -> Bundle m v a-{-# INLINE_FUSED enumFromTo #-}-enumFromTo x y = fromList [x .. y]---- NOTE: We use (x+1) instead of (succ x) below because the latter checks for--- overflow which can't happen here.---- FIXME: add "too large" test for Int-enumFromTo_small :: (Integral a, Monad m) => a -> a -> Bundle m v a-{-# INLINE_FUSED enumFromTo_small #-}-enumFromTo_small x y = x `seq` y `seq` fromStream (Stream step x) (Exact n)- where- n = delay_inline max (fromIntegral y - fromIntegral x + 1) 0-- {-# INLINE_INNER step #-}- step x | x <= y = return $ Yield x (x+1)- | otherwise = return $ Done--{-# RULES--"enumFromTo<Int8> [Bundle]"- enumFromTo = enumFromTo_small :: Monad m => Int8 -> Int8 -> Bundle m v Int8--"enumFromTo<Int16> [Bundle]"- enumFromTo = enumFromTo_small :: Monad m => Int16 -> Int16 -> Bundle m v Int16--"enumFromTo<Word8> [Bundle]"- enumFromTo = enumFromTo_small :: Monad m => Word8 -> Word8 -> Bundle m v Word8--"enumFromTo<Word16> [Bundle]"- enumFromTo = enumFromTo_small :: Monad m => Word16 -> Word16 -> Bundle m v Word16-- #-}--#if WORD_SIZE_IN_BITS > 32--{-# RULES--"enumFromTo<Int32> [Bundle]"- enumFromTo = enumFromTo_small :: Monad m => Int32 -> Int32 -> Bundle m v Int32--"enumFromTo<Word32> [Bundle]"- enumFromTo = enumFromTo_small :: Monad m => Word32 -> Word32 -> Bundle m v Word32-- #-}--#endif---- NOTE: We could implement a generic "too large" test:------ len x y | x > y = 0--- | n > 0 && n <= fromIntegral (maxBound :: Int) = fromIntegral n--- | otherwise = error--- where--- n = y-x+1------ Alas, GHC won't eliminate unnecessary comparisons (such as n >= 0 for--- unsigned types). See http://hackage.haskell.org/trac/ghc/ticket/3744-----enumFromTo_int :: forall m v. Monad m => Int -> Int -> Bundle m v Int-{-# INLINE_FUSED enumFromTo_int #-}-enumFromTo_int x y = x `seq` y `seq` fromStream (Stream step x) (Exact (len x y))- where- {-# INLINE [0] len #-}- len :: Int -> Int -> Int- len x y | x > y = 0- | otherwise = BOUNDS_CHECK(check) "enumFromTo" "vector too large"- (n > 0)- $ n- where- n = y-x+1-- {-# INLINE_INNER step #-}- step x | x <= y = return $ Yield x (x+1)- | otherwise = return $ Done--enumFromTo_intlike :: (Integral a, Monad m) => a -> a -> Bundle m v a-{-# INLINE_FUSED enumFromTo_intlike #-}-enumFromTo_intlike x y = x `seq` y `seq` fromStream (Stream step x) (Exact (len x y))- where- {-# INLINE [0] len #-}- len x y | x > y = 0- | otherwise = BOUNDS_CHECK(check) "enumFromTo" "vector too large"- (n > 0)- $ fromIntegral n- where- n = y-x+1-- {-# INLINE_INNER step #-}- step x | x <= y = return $ Yield x (x+1)- | otherwise = return $ Done--{-# RULES--"enumFromTo<Int> [Bundle]"- enumFromTo = enumFromTo_int :: Monad m => Int -> Int -> Bundle m v Int--#if WORD_SIZE_IN_BITS > 32--"enumFromTo<Int64> [Bundle]"- enumFromTo = enumFromTo_intlike :: Monad m => Int64 -> Int64 -> Bundle m v Int64--#else--"enumFromTo<Int32> [Bundle]"- enumFromTo = enumFromTo_intlike :: Monad m => Int32 -> Int32 -> Bundle m v Int32--#endif-- #-}--enumFromTo_big_word :: (Integral a, Monad m) => a -> a -> Bundle m v a-{-# INLINE_FUSED enumFromTo_big_word #-}-enumFromTo_big_word x y = x `seq` y `seq` fromStream (Stream step x) (Exact (len x y))- where- {-# INLINE [0] len #-}- len x y | x > y = 0- | otherwise = BOUNDS_CHECK(check) "enumFromTo" "vector too large"- (n < fromIntegral (maxBound :: Int))- $ fromIntegral (n+1)- where- n = y-x-- {-# INLINE_INNER step #-}- step x | x <= y = return $ Yield x (x+1)- | otherwise = return $ Done--{-# RULES--"enumFromTo<Word> [Bundle]"- enumFromTo = enumFromTo_big_word :: Monad m => Word -> Word -> Bundle m v Word--"enumFromTo<Word64> [Bundle]"- enumFromTo = enumFromTo_big_word- :: Monad m => Word64 -> Word64 -> Bundle m v Word64--#if WORD_SIZE_IN_BITS == 32--"enumFromTo<Word32> [Bundle]"- enumFromTo = enumFromTo_big_word- :: Monad m => Word32 -> Word32 -> Bundle m v Word32--#endif--"enumFromTo<Integer> [Bundle]"- enumFromTo = enumFromTo_big_word- :: Monad m => Integer -> Integer -> Bundle m v Integer-- #-}---- FIXME: the "too large" test is totally wrong-enumFromTo_big_int :: (Integral a, Monad m) => a -> a -> Bundle m v a-{-# INLINE_FUSED enumFromTo_big_int #-}-enumFromTo_big_int x y = x `seq` y `seq` fromStream (Stream step x) (Exact (len x y))- where- {-# INLINE [0] len #-}- len x y | x > y = 0- | otherwise = BOUNDS_CHECK(check) "enumFromTo" "vector too large"- (n > 0 && n <= fromIntegral (maxBound :: Int))- $ fromIntegral n- where- n = y-x+1-- {-# INLINE_INNER step #-}- step x | x <= y = return $ Yield x (x+1)- | otherwise = return $ Done--#if WORD_SIZE_IN_BITS > 32--{-# RULES--"enumFromTo<Int64> [Bundle]"- enumFromTo = enumFromTo_big :: Monad m => Int64 -> Int64 -> Bundle m v Int64-- #-}--#endif--enumFromTo_char :: Monad m => Char -> Char -> Bundle m v Char-{-# INLINE_FUSED enumFromTo_char #-}-enumFromTo_char x y = x `seq` y `seq` fromStream (Stream step xn) (Exact n)- where- xn = ord x- yn = ord y-- n = delay_inline max 0 (yn - xn + 1)-- {-# INLINE_INNER step #-}- step xn | xn <= yn = return $ Yield (unsafeChr xn) (xn+1)- | otherwise = return $ Done--{-# RULES--"enumFromTo<Char> [Bundle]"- enumFromTo = enumFromTo_char-- #-}------------------------------------------------------------------------------ Specialise enumFromTo for Float and Double.--- Also, try to do something about pairs?--enumFromTo_double :: (Monad m, Ord a, RealFrac a) => a -> a -> Bundle m v a-{-# INLINE_FUSED enumFromTo_double #-}-enumFromTo_double n m = n `seq` m `seq` fromStream (Stream step n) (Max (len n m))- where- lim = m + 1/2 -- important to float out-- {-# INLINE [0] len #-}- len x y | x > y = 0- | otherwise = BOUNDS_CHECK(check) "enumFromTo" "vector too large"- (n > 0)- $ fromIntegral n- where- n = truncate (y-x)+2-- {-# INLINE_INNER step #-}- step x | x <= lim = return $ Yield x (x+1)- | otherwise = return $ Done--{-# RULES--"enumFromTo<Double> [Bundle]"- enumFromTo = enumFromTo_double :: Monad m => Double -> Double -> Bundle m v Double--"enumFromTo<Float> [Bundle]"- enumFromTo = enumFromTo_double :: Monad m => Float -> Float -> Bundle m v Float-- #-}------------------------------------------------------------------------------ | Enumerate values with a given step.------ /WARNING:/ This operation is very inefficient. If at all possible, use--- 'enumFromStepN' instead.-enumFromThenTo :: (Enum a, Monad m) => a -> a -> a -> Bundle m v a-{-# INLINE_FUSED enumFromThenTo #-}-enumFromThenTo x y z = fromList [x, y .. z]---- FIXME: Specialise enumFromThenTo.---- Conversions--- --------------- | Convert a 'Bundle' to a list-toList :: Monad m => Bundle m v a -> m [a]-{-# INLINE toList #-}-toList = foldr (:) []---- | Convert a list to a 'Bundle'-fromList :: Monad m => [a] -> Bundle m v a-{-# INLINE fromList #-}-fromList xs = unsafeFromList Unknown xs---- | Convert the first @n@ elements of a list to a 'Bundle'-fromListN :: Monad m => Int -> [a] -> Bundle m v a-{-# INLINE_FUSED fromListN #-}-fromListN n xs = fromStream (S.fromListN n xs) (Max (delay_inline max n 0))---- | Convert a list to a 'Bundle' with the given 'Size' hint. -unsafeFromList :: Monad m => Size -> [a] -> Bundle m v a-{-# INLINE_FUSED unsafeFromList #-}-unsafeFromList sz xs = fromStream (S.fromList xs) sz--fromVector :: (Monad m, Vector v a) => v a -> Bundle m v a-{-# INLINE_FUSED fromVector #-}-fromVector v = v `seq` n `seq` Bundle (Stream step 0)- (Stream vstep True)- (Just v)- (Exact n)- where- n = basicLength v-- {-# INLINE step #-}- step i | i >= n = return Done- | otherwise = case basicUnsafeIndexM v i of- Box x -> return $ Yield x (i+1)-- - {-# INLINE vstep #-}- vstep True = return (Yield (Chunk (basicLength v) (\mv -> basicUnsafeCopy mv v)) False)- vstep False = return Done--fromVectors :: forall m v a. (Monad m, Vector v a) => [v a] -> Bundle m v a-{-# INLINE_FUSED fromVectors #-}-fromVectors vs = Bundle (Stream pstep (Left vs))- (Stream vstep vs)- Nothing- (Exact n) - where- n = List.foldl' (\k v -> k + basicLength v) 0 vs-- pstep (Left []) = return Done- pstep (Left (v:vs)) = basicLength v `seq` return (Skip (Right (v,0,vs)))-- pstep (Right (v,i,vs))- | i >= basicLength v = return $ Skip (Left vs)- | otherwise = case basicUnsafeIndexM v i of- Box x -> return $ Yield x (Right (v,i+1,vs))-- -- FIXME: work around bug in GHC 7.6.1- vstep :: [v a] -> m (Step [v a] (Chunk v a))- vstep [] = return Done- vstep (v:vs) = return $ Yield (Chunk (basicLength v)- (\mv -> INTERNAL_CHECK(check) "concatVectors" "length mismatch"- (M.basicLength mv == basicLength v)- $ basicUnsafeCopy mv v)) vs---concatVectors :: (Monad m, Vector v a) => Bundle m u (v a) -> Bundle m v a-{-# INLINE_FUSED concatVectors #-}-concatVectors Bundle{sElems = Stream step s}- = Bundle (Stream pstep (Left s))- (Stream vstep s)- Nothing- Unknown- where- pstep (Left s) = do- r <- step s- case r of- Yield v s' -> basicLength v `seq` return (Skip (Right (v,0,s')))- Skip s' -> return (Skip (Left s'))- Done -> return Done-- pstep (Right (v,i,s))- | i >= basicLength v = return (Skip (Left s))- | otherwise = case basicUnsafeIndexM v i of- Box x -> return (Yield x (Right (v,i+1,s)))--- vstep s = do- r <- step s- case r of- Yield v s' -> return (Yield (Chunk (basicLength v)- (\mv -> INTERNAL_CHECK(check) "concatVectors" "length mismatch"- (M.basicLength mv == basicLength v)- $ basicUnsafeCopy mv v)) s')- Skip s' -> return (Skip s')- Done -> return Done--reVector :: Monad m => Bundle m u a -> Bundle m v a-{-# INLINE_FUSED reVector #-}-reVector Bundle{sElems = s, sSize = n} = fromStream s n--{-# RULES--"reVector [Vector]"- reVector = id--"reVector/reVector [Vector]" forall s.- reVector (reVector s) = s-- #-}-
− Data/Vector/Fusion/Bundle/Size.hs
@@ -1,87 +0,0 @@--- |--- Module : Data.Vector.Fusion.Bundle.Size--- Copyright : (c) Roman Leshchinskiy 2008-2010--- License : BSD-style------ Maintainer : Roman Leshchinskiy <rl@cse.unsw.edu.au>--- Stability : experimental--- Portability : portable--- --- Size hints for streams.-----module Data.Vector.Fusion.Bundle.Size (- Size(..), smaller, larger, toMax, upperBound-) where--import Data.Vector.Fusion.Util ( delay_inline )---- | Size hint-data Size = Exact Int -- ^ Exact size- | Max Int -- ^ Upper bound on the size- | Unknown -- ^ Unknown size- deriving( Eq, Show )--instance Num Size where- Exact m + Exact n = Exact (m+n)- Exact m + Max n = Max (m+n)-- Max m + Exact n = Max (m+n)- Max m + Max n = Max (m+n)-- _ + _ = Unknown--- Exact m - Exact n = Exact (m-n)- Exact m - Max n = Max m-- Max m - Exact n = Max (m-n)- Max m - Max n = Max m- Max m - Unknown = Max m-- _ - _ = Unknown--- fromInteger n = Exact (fromInteger n)---- | Minimum of two size hints-smaller :: Size -> Size -> Size-{-# INLINE smaller #-}-smaller (Exact m) (Exact n) = Exact (delay_inline min m n)-smaller (Exact m) (Max n) = Max (delay_inline min m n)-smaller (Exact m) Unknown = Max m-smaller (Max m) (Exact n) = Max (delay_inline min m n)-smaller (Max m) (Max n) = Max (delay_inline min m n)-smaller (Max m) Unknown = Max m-smaller Unknown (Exact n) = Max n-smaller Unknown (Max n) = Max n-smaller Unknown Unknown = Unknown---- | Maximum of two size hints-larger :: Size -> Size -> Size-{-# INLINE larger #-}-larger (Exact m) (Exact n) = Exact (delay_inline max m n)-larger (Exact m) (Max n) | m >= n = Exact m- | otherwise = Max n-larger (Max m) (Exact n) | n >= m = Exact n- | otherwise = Max m-larger (Max m) (Max n) = Max (delay_inline max m n)-larger _ _ = Unknown---- | Convert a size hint to an upper bound-toMax :: Size -> Size-toMax (Exact n) = Max n-toMax (Max n) = Max n-toMax Unknown = Unknown---- | Compute the minimum size from a size hint-lowerBound :: Size -> Int-lowerBound (Exact n) = n-lowerBound _ = 0---- | Compute the maximum size from a size hint if possible-upperBound :: Size -> Maybe Int-upperBound (Exact n) = Just n-upperBound (Max n) = Just n-upperBound Unknown = Nothing-
+ Data/Vector/Fusion/Stream.hs view
@@ -0,0 +1,634 @@+{-# LANGUAGE FlexibleInstances, Rank2Types, BangPatterns #-}++-- |+-- Module : Data.Vector.Fusion.Stream+-- Copyright : (c) Roman Leshchinskiy 2008-2010+-- License : BSD-style+--+-- Maintainer : Roman Leshchinskiy <rl@cse.unsw.edu.au>+-- Stability : experimental+-- Portability : non-portable+-- +-- Streams for stream fusion+--++module Data.Vector.Fusion.Stream (+ -- * Types+ Step(..), Stream, MStream,++ -- * In-place markers+ inplace,++ -- * Size hints+ size, sized,++ -- * Length information+ length, null,++ -- * Construction+ empty, singleton, cons, snoc, replicate, generate, (++),++ -- * Accessing individual elements+ head, last, (!!), (!?),++ -- * Substreams+ slice, init, tail, take, drop,++ -- * Mapping+ map, concatMap, flatten, unbox,+ + -- * Zipping+ indexed, indexedR,+ zipWith, zipWith3, zipWith4, zipWith5, zipWith6,+ zip, zip3, zip4, zip5, zip6,++ -- * Filtering+ filter, takeWhile, dropWhile,++ -- * Searching+ elem, notElem, find, findIndex,++ -- * Folding+ foldl, foldl1, foldl', foldl1', foldr, foldr1,++ -- * Specialised folds+ and, or,++ -- * Unfolding+ unfoldr, unfoldrN, iterateN,++ -- * Scans+ prescanl, prescanl',+ postscanl, postscanl',+ scanl, scanl',+ scanl1, scanl1',++ -- * Enumerations+ enumFromStepN, enumFromTo, enumFromThenTo,++ -- * Conversions+ toList, fromList, fromListN, unsafeFromList, liftStream,++ -- * Monadic combinators+ mapM, mapM_, zipWithM, zipWithM_, filterM, foldM, fold1M, foldM', fold1M',++ eq, cmp+) where++import Data.Vector.Fusion.Stream.Size+import Data.Vector.Fusion.Util+import Data.Vector.Fusion.Stream.Monadic ( Step(..), SPEC(..) )+import qualified Data.Vector.Fusion.Stream.Monadic as M++import Prelude hiding ( length, null,+ replicate, (++),+ head, last, (!!),+ init, tail, take, drop,+ map, concatMap,+ zipWith, zipWith3, zip, zip3,+ filter, takeWhile, dropWhile,+ elem, notElem,+ foldl, foldl1, foldr, foldr1,+ and, or,+ scanl, scanl1,+ enumFromTo, enumFromThenTo,+ mapM, mapM_ )++import GHC.Base ( build )++#include "vector.h"++-- | The type of pure streams +type Stream = M.Stream Id++-- | Alternative name for monadic streams+type MStream = M.Stream++inplace :: (forall m. Monad m => M.Stream m a -> M.Stream m b)+ -> Stream a -> Stream b+{-# INLINE_STREAM inplace #-}+inplace f s = s `seq` f s++{-# RULES++"inplace/inplace [Vector]"+ forall (f :: forall m. Monad m => MStream m a -> MStream m a)+ (g :: forall m. Monad m => MStream m a -> MStream m a)+ s.+ inplace f (inplace g s) = inplace (f . g) s++ #-}++-- | Convert a pure stream to a monadic stream+liftStream :: Monad m => Stream a -> M.Stream m a+{-# INLINE_STREAM liftStream #-}+liftStream (M.Stream step s sz) = M.Stream (return . unId . step) s sz++-- | 'Size' hint of a 'Stream'+size :: Stream a -> Size+{-# INLINE size #-}+size = M.size++-- | Attach a 'Size' hint to a 'Stream'+sized :: Stream a -> Size -> Stream a+{-# INLINE sized #-}+sized = M.sized++-- Length+-- ------++-- | Length of a 'Stream'+length :: Stream a -> Int+{-# INLINE length #-}+length = unId . M.length++-- | Check if a 'Stream' is empty+null :: Stream a -> Bool+{-# INLINE null #-}+null = unId . M.null++-- Construction+-- ------------++-- | Empty 'Stream'+empty :: Stream a+{-# INLINE empty #-}+empty = M.empty++-- | Singleton 'Stream'+singleton :: a -> Stream a+{-# INLINE singleton #-}+singleton = M.singleton++-- | Replicate a value to a given length+replicate :: Int -> a -> Stream a+{-# INLINE replicate #-}+replicate = M.replicate++-- | Generate a stream from its indices+generate :: Int -> (Int -> a) -> Stream a+{-# INLINE generate #-}+generate = M.generate++-- | Prepend an element+cons :: a -> Stream a -> Stream a+{-# INLINE cons #-}+cons = M.cons++-- | Append an element+snoc :: Stream a -> a -> Stream a+{-# INLINE snoc #-}+snoc = M.snoc++infixr 5 +++-- | Concatenate two 'Stream's+(++) :: Stream a -> Stream a -> Stream a+{-# INLINE (++) #-}+(++) = (M.++)++-- Accessing elements+-- ------------------++-- | First element of the 'Stream' or error if empty+head :: Stream a -> a+{-# INLINE head #-}+head = unId . M.head++-- | Last element of the 'Stream' or error if empty+last :: Stream a -> a+{-# INLINE last #-}+last = unId . M.last++infixl 9 !!+-- | Element at the given position+(!!) :: Stream a -> Int -> a+{-# INLINE (!!) #-}+s !! i = unId (s M.!! i)++infixl 9 !?+-- | Element at the given position or 'Nothing' if out of bounds+(!?) :: Stream a -> Int -> Maybe a+{-# INLINE (!?) #-}+s !? i = unId (s M.!? i)++-- Substreams+-- ----------++-- | Extract a substream of the given length starting at the given position.+slice :: Int -- ^ starting index+ -> Int -- ^ length+ -> Stream a+ -> Stream a+{-# INLINE slice #-}+slice = M.slice++-- | All but the last element+init :: Stream a -> Stream a+{-# INLINE init #-}+init = M.init++-- | All but the first element+tail :: Stream a -> Stream a+{-# INLINE tail #-}+tail = M.tail++-- | The first @n@ elements+take :: Int -> Stream a -> Stream a+{-# INLINE take #-}+take = M.take++-- | All but the first @n@ elements+drop :: Int -> Stream a -> Stream a+{-# INLINE drop #-}+drop = M.drop++-- Mapping+-- ---------------++-- | Map a function over a 'Stream'+map :: (a -> b) -> Stream a -> Stream b+{-# INLINE map #-}+map = M.map++unbox :: Stream (Box a) -> Stream a+{-# INLINE unbox #-}+unbox = M.unbox++concatMap :: (a -> Stream b) -> Stream a -> Stream b+{-# INLINE concatMap #-}+concatMap = M.concatMap++-- Zipping+-- -------++-- | Pair each element in a 'Stream' with its index+indexed :: Stream a -> Stream (Int,a)+{-# INLINE indexed #-}+indexed = M.indexed++-- | Pair each element in a 'Stream' with its index, starting from the right+-- and counting down+indexedR :: Int -> Stream a -> Stream (Int,a)+{-# INLINE_STREAM indexedR #-}+indexedR = M.indexedR++-- | Zip two 'Stream's with the given function+zipWith :: (a -> b -> c) -> Stream a -> Stream b -> Stream c+{-# INLINE zipWith #-}+zipWith = M.zipWith++-- | Zip three 'Stream's with the given function+zipWith3 :: (a -> b -> c -> d) -> Stream a -> Stream b -> Stream c -> Stream d+{-# INLINE zipWith3 #-}+zipWith3 = M.zipWith3++zipWith4 :: (a -> b -> c -> d -> e)+ -> Stream a -> Stream b -> Stream c -> Stream d+ -> Stream e+{-# INLINE zipWith4 #-}+zipWith4 = M.zipWith4++zipWith5 :: (a -> b -> c -> d -> e -> f)+ -> Stream a -> Stream b -> Stream c -> Stream d+ -> Stream e -> Stream f+{-# INLINE zipWith5 #-}+zipWith5 = M.zipWith5++zipWith6 :: (a -> b -> c -> d -> e -> f -> g)+ -> Stream a -> Stream b -> Stream c -> Stream d+ -> Stream e -> Stream f -> Stream g+{-# INLINE zipWith6 #-}+zipWith6 = M.zipWith6++zip :: Stream a -> Stream b -> Stream (a,b)+{-# INLINE zip #-}+zip = M.zip++zip3 :: Stream a -> Stream b -> Stream c -> Stream (a,b,c)+{-# INLINE zip3 #-}+zip3 = M.zip3++zip4 :: Stream a -> Stream b -> Stream c -> Stream d+ -> Stream (a,b,c,d)+{-# INLINE zip4 #-}+zip4 = M.zip4++zip5 :: Stream a -> Stream b -> Stream c -> Stream d+ -> Stream e -> Stream (a,b,c,d,e)+{-# INLINE zip5 #-}+zip5 = M.zip5++zip6 :: Stream a -> Stream b -> Stream c -> Stream d+ -> Stream e -> Stream f -> Stream (a,b,c,d,e,f)+{-# INLINE zip6 #-}+zip6 = M.zip6++-- Filtering+-- ---------++-- | Drop elements which do not satisfy the predicate+filter :: (a -> Bool) -> Stream a -> Stream a+{-# INLINE filter #-}+filter = M.filter++-- | Longest prefix of elements that satisfy the predicate+takeWhile :: (a -> Bool) -> Stream a -> Stream a+{-# INLINE takeWhile #-}+takeWhile = M.takeWhile++-- | Drop the longest prefix of elements that satisfy the predicate+dropWhile :: (a -> Bool) -> Stream a -> Stream a+{-# INLINE dropWhile #-}+dropWhile = M.dropWhile++-- Searching+-- ---------++infix 4 `elem`+-- | Check whether the 'Stream' contains an element+elem :: Eq a => a -> Stream a -> Bool+{-# INLINE elem #-}+elem x = unId . M.elem x++infix 4 `notElem`+-- | Inverse of `elem`+notElem :: Eq a => a -> Stream a -> Bool+{-# INLINE notElem #-}+notElem x = unId . M.notElem x++-- | Yield 'Just' the first element matching the predicate or 'Nothing' if no+-- such element exists.+find :: (a -> Bool) -> Stream a -> Maybe a+{-# INLINE find #-}+find f = unId . M.find f++-- | Yield 'Just' the index of the first element matching the predicate or+-- 'Nothing' if no such element exists.+findIndex :: (a -> Bool) -> Stream a -> Maybe Int+{-# INLINE findIndex #-}+findIndex f = unId . M.findIndex f++-- Folding+-- -------++-- | Left fold+foldl :: (a -> b -> a) -> a -> Stream b -> a+{-# INLINE foldl #-}+foldl f z = unId . M.foldl f z++-- | Left fold on non-empty 'Stream's+foldl1 :: (a -> a -> a) -> Stream a -> a+{-# INLINE foldl1 #-}+foldl1 f = unId . M.foldl1 f++-- | Left fold with strict accumulator+foldl' :: (a -> b -> a) -> a -> Stream b -> a+{-# INLINE foldl' #-}+foldl' f z = unId . M.foldl' f z++-- | Left fold on non-empty 'Stream's with strict accumulator+foldl1' :: (a -> a -> a) -> Stream a -> a+{-# INLINE foldl1' #-}+foldl1' f = unId . M.foldl1' f++-- | Right fold+foldr :: (a -> b -> b) -> b -> Stream a -> b+{-# INLINE foldr #-}+foldr f z = unId . M.foldr f z++-- | Right fold on non-empty 'Stream's+foldr1 :: (a -> a -> a) -> Stream a -> a+{-# INLINE foldr1 #-}+foldr1 f = unId . M.foldr1 f++-- Specialised folds+-- -----------------++and :: Stream Bool -> Bool+{-# INLINE and #-}+and = unId . M.and++or :: Stream Bool -> Bool+{-# INLINE or #-}+or = unId . M.or++-- Unfolding+-- ---------++-- | Unfold+unfoldr :: (s -> Maybe (a, s)) -> s -> Stream a+{-# INLINE unfoldr #-}+unfoldr = M.unfoldr++-- | Unfold at most @n@ elements+unfoldrN :: Int -> (s -> Maybe (a, s)) -> s -> Stream a+{-# INLINE unfoldrN #-}+unfoldrN = M.unfoldrN++-- | Apply function n-1 times to value. Zeroth element is original value.+iterateN :: Int -> (a -> a) -> a -> Stream a+{-# INLINE iterateN #-}+iterateN = M.iterateN++-- Scans+-- -----++-- | Prefix scan+prescanl :: (a -> b -> a) -> a -> Stream b -> Stream a+{-# INLINE prescanl #-}+prescanl = M.prescanl++-- | Prefix scan with strict accumulator+prescanl' :: (a -> b -> a) -> a -> Stream b -> Stream a+{-# INLINE prescanl' #-}+prescanl' = M.prescanl'++-- | Suffix scan+postscanl :: (a -> b -> a) -> a -> Stream b -> Stream a+{-# INLINE postscanl #-}+postscanl = M.postscanl++-- | Suffix scan with strict accumulator+postscanl' :: (a -> b -> a) -> a -> Stream b -> Stream a+{-# INLINE postscanl' #-}+postscanl' = M.postscanl'++-- | Haskell-style scan+scanl :: (a -> b -> a) -> a -> Stream b -> Stream a+{-# INLINE scanl #-}+scanl = M.scanl++-- | Haskell-style scan with strict accumulator+scanl' :: (a -> b -> a) -> a -> Stream b -> Stream a+{-# INLINE scanl' #-}+scanl' = M.scanl'++-- | Scan over a non-empty 'Stream'+scanl1 :: (a -> a -> a) -> Stream a -> Stream a+{-# INLINE scanl1 #-}+scanl1 = M.scanl1++-- | Scan over a non-empty 'Stream' with a strict accumulator+scanl1' :: (a -> a -> a) -> Stream a -> Stream a+{-# INLINE scanl1' #-}+scanl1' = M.scanl1'+++-- Comparisons+-- -----------++-- FIXME: Move these to Monadic++-- | Check if two 'Stream's are equal+eq :: Eq a => Stream a -> Stream a -> Bool+{-# INLINE_STREAM eq #-}+eq (M.Stream step1 s1 _) (M.Stream step2 s2 _) = eq_loop0 SPEC s1 s2+ where+ eq_loop0 !sPEC s1 s2 = case unId (step1 s1) of+ Yield x s1' -> eq_loop1 SPEC x s1' s2+ Skip s1' -> eq_loop0 SPEC s1' s2+ Done -> null (M.Stream step2 s2 Unknown)++ eq_loop1 !sPEC x s1 s2 = case unId (step2 s2) of+ Yield y s2' -> x == y && eq_loop0 SPEC s1 s2'+ Skip s2' -> eq_loop1 SPEC x s1 s2'+ Done -> False++-- | Lexicographically compare two 'Stream's+cmp :: Ord a => Stream a -> Stream a -> Ordering+{-# INLINE_STREAM cmp #-}+cmp (M.Stream step1 s1 _) (M.Stream step2 s2 _) = cmp_loop0 SPEC s1 s2+ where+ cmp_loop0 !sPEC s1 s2 = case unId (step1 s1) of+ Yield x s1' -> cmp_loop1 SPEC x s1' s2+ Skip s1' -> cmp_loop0 SPEC s1' s2+ Done -> if null (M.Stream step2 s2 Unknown)+ then EQ else LT++ cmp_loop1 !sPEC x s1 s2 = case unId (step2 s2) of+ Yield y s2' -> case x `compare` y of+ EQ -> cmp_loop0 SPEC s1 s2'+ c -> c+ Skip s2' -> cmp_loop1 SPEC x s1 s2'+ Done -> GT++instance Eq a => Eq (M.Stream Id a) where+ {-# INLINE (==) #-}+ (==) = eq++instance Ord a => Ord (M.Stream Id a) where+ {-# INLINE compare #-}+ compare = cmp++-- Monadic combinators+-- -------------------++-- | Apply a monadic action to each element of the stream, producing a monadic+-- stream of results+mapM :: Monad m => (a -> m b) -> Stream a -> M.Stream m b+{-# INLINE mapM #-}+mapM f = M.mapM f . liftStream++-- | Apply a monadic action to each element of the stream+mapM_ :: Monad m => (a -> m b) -> Stream a -> m ()+{-# INLINE mapM_ #-}+mapM_ f = M.mapM_ f . liftStream++zipWithM :: Monad m => (a -> b -> m c) -> Stream a -> Stream b -> M.Stream m c+{-# INLINE zipWithM #-}+zipWithM f as bs = M.zipWithM f (liftStream as) (liftStream bs)++zipWithM_ :: Monad m => (a -> b -> m c) -> Stream a -> Stream b -> m ()+{-# INLINE zipWithM_ #-}+zipWithM_ f as bs = M.zipWithM_ f (liftStream as) (liftStream bs)++-- | Yield a monadic stream of elements that satisfy the monadic predicate+filterM :: Monad m => (a -> m Bool) -> Stream a -> M.Stream m a+{-# INLINE filterM #-}+filterM f = M.filterM f . liftStream++-- | Monadic fold+foldM :: Monad m => (a -> b -> m a) -> a -> Stream b -> m a+{-# INLINE foldM #-}+foldM m z = M.foldM m z . liftStream++-- | Monadic fold over non-empty stream+fold1M :: Monad m => (a -> a -> m a) -> Stream a -> m a+{-# INLINE fold1M #-}+fold1M m = M.fold1M m . liftStream++-- | Monadic fold with strict accumulator+foldM' :: Monad m => (a -> b -> m a) -> a -> Stream b -> m a+{-# INLINE foldM' #-}+foldM' m z = M.foldM' m z . liftStream++-- | Monad fold over non-empty stream with strict accumulator+fold1M' :: Monad m => (a -> a -> m a) -> Stream a -> m a+{-# INLINE fold1M' #-}+fold1M' m = M.fold1M' m . liftStream++-- Enumerations+-- ------------++-- | Yield a 'Stream' of the given length containing the values @x@, @x+y@,+-- @x+y+y@ etc.+enumFromStepN :: Num a => a -> a -> Int -> Stream a+{-# INLINE enumFromStepN #-}+enumFromStepN = M.enumFromStepN++-- | Enumerate values+--+-- /WARNING:/ This operations can be very inefficient. If at all possible, use+-- 'enumFromStepN' instead.+enumFromTo :: Enum a => a -> a -> Stream a+{-# INLINE enumFromTo #-}+enumFromTo = M.enumFromTo++-- | Enumerate values with a given step.+--+-- /WARNING:/ This operations is very inefficient. If at all possible, use+-- 'enumFromStepN' instead.+enumFromThenTo :: Enum a => a -> a -> a -> Stream a+{-# INLINE enumFromThenTo #-}+enumFromThenTo = M.enumFromThenTo++-- Conversions+-- -----------++-- | Convert a 'Stream' to a list+toList :: Stream a -> [a]+{-# INLINE toList #-}+-- toList s = unId (M.toList s)+toList s = build (\c n -> toListFB c n s)++-- This supports foldr/build list fusion that GHC implements+toListFB :: (a -> b -> b) -> b -> Stream a -> b+{-# INLINE [0] toListFB #-}+toListFB c n (M.Stream step s _) = go s+ where+ go s = case unId (step s) of+ Yield x s' -> x `c` go s'+ Skip s' -> go s'+ Done -> n++-- | Create a 'Stream' from a list+fromList :: [a] -> Stream a+{-# INLINE fromList #-}+fromList = M.fromList++-- | Create a 'Stream' from the first @n@ elements of a list+--+-- > fromListN n xs = fromList (take n xs)+fromListN :: Int -> [a] -> Stream a+{-# INLINE fromListN #-}+fromListN = M.fromListN++unsafeFromList :: Size -> [a] -> Stream a+{-# INLINE unsafeFromList #-}+unsafeFromList = M.unsafeFromList++-- | Create a 'Stream' of values from a 'Stream' of streamable things+flatten :: (a -> s) -> (s -> Step s b) -> Size -> Stream a -> Stream b+{-# INLINE_STREAM flatten #-}+flatten mk istep sz = M.flatten (return . mk) (return . istep) sz . liftStream+
Data/Vector/Fusion/Stream/Monadic.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE ExistentialQuantification, MultiParamTypeClasses, FlexibleInstances, Rank2Types, BangPatterns, KindSignatures, GADTs, ScopedTypeVariables #-}+{-# LANGUAGE ExistentialQuantification, Rank2Types, BangPatterns #-} -- | -- Module : Data.Vector.Fusion.Stream.Monadic@@ -15,6 +15,9 @@ module Data.Vector.Fusion.Stream.Monadic ( Stream(..), Step(..), SPEC(..), + -- * Size hints+ size, sized,+ -- * Length length, null, @@ -36,9 +39,6 @@ zipWith, zipWith3, zipWith4, zipWith5, zipWith6, zip, zip3, zip4, zip5, zip6, - -- * Comparisons- eq, cmp,- -- * Filtering filter, filterM, takeWhile, takeWhileM, dropWhile, dropWhileM, @@ -68,12 +68,12 @@ enumFromStepN, enumFromTo, enumFromThenTo, -- * Conversions- toList, fromList, fromListN+ toList, fromList, fromListN, unsafeFromList ) where -import Data.Vector.Fusion.Util ( Box(..) )+import Data.Vector.Fusion.Stream.Size+import Data.Vector.Fusion.Util ( Box(..), delay_inline ) -import qualified Data.List as List import Data.Char ( ord ) import GHC.Base ( unsafeChr ) import Control.Monad ( liftM )@@ -111,52 +111,49 @@ #define EMPTY_STREAM (\s -> ERROR s emptyStream) -- | Result of taking a single step in a stream-data Step s a where- Yield :: a -> s -> Step s a- Skip :: s -> Step s a- Done :: Step s a--instance Functor (Step s) where- {-# INLINE fmap #-}- fmap f (Yield x s) = Yield (f x) s- fmap f (Skip s) = Skip s- fmap f Done = Done+data Step s a = Yield a s -- ^ a new element and a new seed+ | Skip s -- ^ just a new seed+ | Done -- ^ end of stream -- | Monadic streams-data Stream m a = forall s. Stream (s -> m (Step s a)) s+data Stream m a = forall s. Stream (s -> m (Step s a)) s Size +-- | 'Size' hint of a 'Stream'+size :: Stream m a -> Size+{-# INLINE size #-}+size (Stream _ _ sz) = sz++-- | Attach a 'Size' hint to a 'Stream'+sized :: Stream m a -> Size -> Stream m a+{-# INLINE_STREAM sized #-}+sized (Stream step s _) sz = Stream step s sz+ -- Length -- ------ -- | Length of a 'Stream' length :: Monad m => Stream m a -> m Int-{-# INLINE_FUSED length #-}-length = foldl' (\n _ -> n+1) 0+{-# INLINE_STREAM length #-}+length s = foldl' (\n _ -> n+1) 0 s -- | Check if a 'Stream' is empty null :: Monad m => Stream m a -> m Bool-{-# INLINE_FUSED null #-}-null (Stream step s) = null_loop s- where- null_loop s = do- r <- step s- case r of- Yield _ _ -> return False- Skip s' -> null_loop s'- Done -> return True+{-# INLINE_STREAM null #-}+null s = foldr (\_ _ -> False) True s + -- Construction -- ------------ -- | Empty 'Stream' empty :: Monad m => Stream m a-{-# INLINE_FUSED empty #-}-empty = Stream (const (return Done)) ()+{-# INLINE_STREAM empty #-}+empty = Stream (const (return Done)) () (Exact 0) -- | Singleton 'Stream' singleton :: Monad m => a -> Stream m a-{-# INLINE_FUSED singleton #-}-singleton x = Stream (return . step) True+{-# INLINE_STREAM singleton #-}+singleton x = Stream (return . step) True (Exact 1) where {-# INLINE_INNER step #-} step True = Yield x False@@ -164,14 +161,16 @@ -- | Replicate a value to a given length replicate :: Monad m => Int -> a -> Stream m a-{-# INLINE_FUSED replicate #-}+{-# INLINE replicate #-} replicate n x = replicateM n (return x) -- | Yield a 'Stream' of values obtained by performing the monadic action the -- given number of times replicateM :: Monad m => Int -> m a -> Stream m a-{-# INLINE_FUSED replicateM #-}-replicateM n p = Stream step n+{-# INLINE_STREAM replicateM #-}+-- NOTE: We delay inlining max here because GHC will create a join point for+-- the call to newArray# otherwise which is not really nice.+replicateM n p = Stream step n (Exact (delay_inline max n 0)) where {-# INLINE_INNER step #-} step i | i <= 0 = return Done@@ -183,8 +182,8 @@ -- | Generate a stream from its indices generateM :: Monad m => Int -> (Int -> m a) -> Stream m a-{-# INLINE_FUSED generateM #-}-generateM n f = n `seq` Stream step 0+{-# INLINE_STREAM generateM #-}+generateM n f = n `seq` Stream step 0 (Exact (delay_inline max n 0)) where {-# INLINE_INNER step #-} step i | i < n = do@@ -205,8 +204,8 @@ infixr 5 ++ -- | Concatenate two 'Stream's (++) :: Monad m => Stream m a -> Stream m a -> Stream m a-{-# INLINE_FUSED (++) #-}-Stream stepa sa ++ Stream stepb sb = Stream step (Left sa)+{-# INLINE_STREAM (++) #-}+Stream stepa sa na ++ Stream stepb sb nb = Stream step (Left sa) (na + nb) where {-# INLINE_INNER step #-} step (Left sa) = do@@ -227,8 +226,8 @@ -- | First element of the 'Stream' or error if empty head :: Monad m => Stream m a -> m a-{-# INLINE_FUSED head #-}-head (Stream step s) = head_loop SPEC s+{-# INLINE_STREAM head #-}+head (Stream step s _) = head_loop SPEC s where head_loop !sPEC s = do@@ -242,8 +241,8 @@ -- | Last element of the 'Stream' or error if empty last :: Monad m => Stream m a -> m a-{-# INLINE_FUSED last #-}-last (Stream step s) = last_loop0 SPEC s+{-# INLINE_STREAM last #-}+last (Stream step s _) = last_loop0 SPEC s where last_loop0 !sPEC s = do@@ -265,8 +264,8 @@ -- | Element at the given position (!!) :: Monad m => Stream m a -> Int -> m a {-# INLINE (!!) #-}-Stream step s !! i | i < 0 = ERROR "!!" "negative index"- | otherwise = index_loop SPEC s i+Stream step s _ !! i | i < 0 = ERROR "!!" "negative index"+ | otherwise = index_loop SPEC s i where index_loop !sPEC s i = i `seq`@@ -282,7 +281,7 @@ -- | Element at the given position or 'Nothing' if out of bounds (!?) :: Monad m => Stream m a -> Int -> m (Maybe a) {-# INLINE (!?) #-}-Stream step s !? i = index_loop SPEC s i+Stream step s _ !? i = index_loop SPEC s i where index_loop !sPEC s i = i `seq`@@ -307,8 +306,8 @@ -- | All but the last element init :: Monad m => Stream m a -> Stream m a-{-# INLINE_FUSED init #-}-init (Stream step s) = Stream step' (Nothing, s)+{-# INLINE_STREAM init #-}+init (Stream step s sz) = Stream step' (Nothing, s) (sz - 1) where {-# INLINE_INNER step' #-} step' (Nothing, s) = liftM (\r ->@@ -327,8 +326,8 @@ -- | All but the first element tail :: Monad m => Stream m a -> Stream m a-{-# INLINE_FUSED tail #-}-tail (Stream step s) = Stream step' (Left s)+{-# INLINE_STREAM tail #-}+tail (Stream step s sz) = Stream step' (Left s) (sz - 1) where {-# INLINE_INNER step' #-} step' (Left s) = liftM (\r ->@@ -347,8 +346,8 @@ -- | The first @n@ elements take :: Monad m => Int -> Stream m a -> Stream m a-{-# INLINE_FUSED take #-}-take n (Stream step s) = n `seq` Stream step' (s, 0)+{-# INLINE_STREAM take #-}+take n (Stream step s sz) = Stream step' (s, 0) (smaller (Exact n) sz) where {-# INLINE_INNER step' #-} step' (s, i) | i < n = liftM (\r ->@@ -361,8 +360,8 @@ -- | All but the first @n@ elements drop :: Monad m => Int -> Stream m a -> Stream m a-{-# INLINE_FUSED drop #-}-drop n (Stream step s) = Stream step' (s, Just n)+{-# INLINE_STREAM drop #-}+drop n (Stream step s sz) = Stream step' (s, Just n) (sz - Exact n) where {-# INLINE_INNER step' #-} step' (s, Just i) | i > 0 = liftM (\r ->@@ -395,8 +394,8 @@ -- | Map a monadic function over a 'Stream' mapM :: Monad m => (a -> m b) -> Stream m a -> Stream m b-{-# INLINE_FUSED mapM #-}-mapM f (Stream step s) = Stream step' s+{-# INLINE_STREAM mapM #-}+mapM f (Stream step s n) = Stream step' s n where {-# INLINE_INNER step' #-} step' s = do@@ -407,8 +406,8 @@ Done -> return Done consume :: Monad m => Stream m a -> m ()-{-# INLINE_FUSED consume #-}-consume (Stream step s) = consume_loop SPEC s+{-# INLINE_STREAM consume #-}+consume (Stream step s _) = consume_loop SPEC s where consume_loop !sPEC s = do@@ -420,18 +419,18 @@ -- | Execute a monadic action for each element of the 'Stream' mapM_ :: Monad m => (a -> m b) -> Stream m a -> m ()-{-# INLINE_FUSED mapM_ #-}+{-# INLINE_STREAM mapM_ #-} mapM_ m = consume . mapM m -- | Transform a 'Stream' to use a different monad-trans :: (Monad m, Monad m')- => (forall a. m a -> m' a) -> Stream m a -> Stream m' a-{-# INLINE_FUSED trans #-}-trans f (Stream step s) = Stream (f . step) s+trans :: (Monad m, Monad m') => (forall a. m a -> m' a)+ -> Stream m a -> Stream m' a+{-# INLINE_STREAM trans #-}+trans f (Stream step s n) = Stream (f . step) s n unbox :: Monad m => Stream m (Box a) -> Stream m a-{-# INLINE_FUSED unbox #-}-unbox (Stream step s) = Stream step' s+{-# INLINE_STREAM unbox #-}+unbox (Stream step s n) = Stream step' s n where {-# INLINE_INNER step' #-} step' s = do@@ -446,8 +445,8 @@ -- | Pair each element in a 'Stream' with its index indexed :: Monad m => Stream m a -> Stream m (Int,a)-{-# INLINE_FUSED indexed #-}-indexed (Stream step s) = Stream step' (s,0)+{-# INLINE_STREAM indexed #-}+indexed (Stream step s n) = Stream step' (s,0) n where {-# INLINE_INNER step' #-} step' (s,i) = i `seq`@@ -461,8 +460,8 @@ -- | Pair each element in a 'Stream' with its index, starting from the right -- and counting down indexedR :: Monad m => Int -> Stream m a -> Stream m (Int,a)-{-# INLINE_FUSED indexedR #-}-indexedR m (Stream step s) = Stream step' (s,m)+{-# INLINE_STREAM indexedR #-}+indexedR m (Stream step s n) = Stream step' (s,m) n where {-# INLINE_INNER step' #-} step' (s,i) = i `seq`@@ -477,8 +476,9 @@ -- | Zip two 'Stream's with the given monadic function zipWithM :: Monad m => (a -> b -> m c) -> Stream m a -> Stream m b -> Stream m c-{-# INLINE_FUSED zipWithM #-}-zipWithM f (Stream stepa sa) (Stream stepb sb) = Stream step (sa, sb, Nothing)+{-# INLINE_STREAM zipWithM #-}+zipWithM f (Stream stepa sa na) (Stream stepb sb nb)+ = Stream step (sa, sb, Nothing) (smaller na nb) where {-# INLINE_INNER step #-} step (sa, sb, Nothing) = liftM (\r ->@@ -511,10 +511,9 @@ zipWithM_ f sa sb = consume (zipWithM f sa sb) zipWith3M :: Monad m => (a -> b -> c -> m d) -> Stream m a -> Stream m b -> Stream m c -> Stream m d-{-# INLINE_FUSED zipWith3M #-}-zipWith3M f (Stream stepa sa)- (Stream stepb sb)- (Stream stepc sc) = Stream step (sa, sb, sc, Nothing)+{-# INLINE_STREAM zipWith3M #-}+zipWith3M f (Stream stepa sa na) (Stream stepb sb nb) (Stream stepc sc nc)+ = Stream step (sa, sb, sc, Nothing) (smaller na (smaller nb nc)) where {-# INLINE_INNER step #-} step (sa, sb, sc, Nothing) = do@@ -610,65 +609,6 @@ {-# INLINE zip6 #-} zip6 = zipWith6 (,,,,,) --- Comparisons--- --------------- | Check if two 'Stream's are equal-eq :: (Monad m, Eq a) => Stream m a -> Stream m a -> m Bool-{-# INLINE_FUSED eq #-}-eq (Stream step1 s1) (Stream step2 s2) = eq_loop0 SPEC s1 s2- where- eq_loop0 !sPEC s1 s2 = do- r <- step1 s1- case r of- Yield x s1' -> eq_loop1 SPEC x s1' s2- Skip s1' -> eq_loop0 SPEC s1' s2- Done -> eq_null s2-- eq_loop1 !sPEC x s1 s2 = do- r <- step2 s2- case r of- Yield y s2'- | x == y -> eq_loop0 SPEC s1 s2'- | otherwise -> return False- Skip s2' -> eq_loop1 SPEC x s1 s2'- Done -> return False-- eq_null s2 = do- r <- step2 s2- case r of- Yield _ _ -> return False- Skip s2' -> eq_null s2'- Done -> return True---- | Lexicographically compare two 'Stream's-cmp :: (Monad m, Ord a) => Stream m a -> Stream m a -> m Ordering-{-# INLINE_FUSED cmp #-}-cmp (Stream step1 s1) (Stream step2 s2) = cmp_loop0 SPEC s1 s2- where- cmp_loop0 !sPEC s1 s2 = do- r <- step1 s1- case r of- Yield x s1' -> cmp_loop1 SPEC x s1' s2- Skip s1' -> cmp_loop0 SPEC s1' s2- Done -> cmp_null s2-- cmp_loop1 !sPEC x s1 s2 = do- r <- step2 s2- case r of- Yield y s2' -> case x `compare` y of- EQ -> cmp_loop0 SPEC s1 s2'- c -> return c- Skip s2' -> cmp_loop1 SPEC x s1 s2'- Done -> return GT-- cmp_null s2 = do- r <- step2 s2- case r of- Yield _ _ -> return LT- Skip s2' -> cmp_null s2'- Done -> return EQ- -- Filtering -- --------- @@ -679,8 +619,8 @@ -- | Drop elements which do not satisfy the monadic predicate filterM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a-{-# INLINE_FUSED filterM #-}-filterM f (Stream step s) = Stream step' s+{-# INLINE_STREAM filterM #-}+filterM f (Stream step s n) = Stream step' s (toMax n) where {-# INLINE_INNER step' #-} step' s = do@@ -700,8 +640,8 @@ -- | Longest prefix of elements that satisfy the monadic predicate takeWhileM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a-{-# INLINE_FUSED takeWhileM #-}-takeWhileM f (Stream step s) = Stream step' s+{-# INLINE_STREAM takeWhileM #-}+takeWhileM f (Stream step s n) = Stream step' s (toMax n) where {-# INLINE_INNER step' #-} step' s = do@@ -722,8 +662,8 @@ -- | Drop the longest prefix of elements that satisfy the monadic predicate dropWhileM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a-{-# INLINE_FUSED dropWhileM #-}-dropWhileM f (Stream step s) = Stream step' (DropWhile_Drop s)+{-# INLINE_STREAM dropWhileM #-}+dropWhileM f (Stream step s n) = Stream step' (DropWhile_Drop s) (toMax n) where -- NOTE: we jump through hoops here to have only one Yield; local data -- declarations would be nice!@@ -756,8 +696,8 @@ infix 4 `elem` -- | Check whether the 'Stream' contains an element elem :: (Monad m, Eq a) => a -> Stream m a -> m Bool-{-# INLINE_FUSED elem #-}-elem x (Stream step s) = elem_loop SPEC s+{-# INLINE_STREAM elem #-}+elem x (Stream step s _) = elem_loop SPEC s where elem_loop !sPEC s = do@@ -783,8 +723,8 @@ -- | Yield 'Just' the first element that satisfies the monadic predicate or -- 'Nothing' if no such element exists. findM :: Monad m => (a -> m Bool) -> Stream m a -> m (Maybe a)-{-# INLINE_FUSED findM #-}-findM f (Stream step s) = find_loop SPEC s+{-# INLINE_STREAM findM #-}+findM f (Stream step s _) = find_loop SPEC s where find_loop !sPEC s = do@@ -800,14 +740,14 @@ -- | Yield 'Just' the index of the first element that satisfies the predicate -- or 'Nothing' if no such element exists. findIndex :: Monad m => (a -> Bool) -> Stream m a -> m (Maybe Int)-{-# INLINE_FUSED findIndex #-}+{-# INLINE_STREAM findIndex #-} findIndex f = findIndexM (return . f) -- | Yield 'Just' the index of the first element that satisfies the monadic -- predicate or 'Nothing' if no such element exists. findIndexM :: Monad m => (a -> m Bool) -> Stream m a -> m (Maybe Int)-{-# INLINE_FUSED findIndexM #-}-findIndexM f (Stream step s) = findIndex_loop SPEC s 0+{-# INLINE_STREAM findIndexM #-}+findIndexM f (Stream step s _) = findIndex_loop SPEC s 0 where findIndex_loop !sPEC s i = do@@ -830,8 +770,8 @@ -- | Left fold with a monadic operator foldlM :: Monad m => (a -> b -> m a) -> a -> Stream m b -> m a-{-# INLINE_FUSED foldlM #-}-foldlM m z (Stream step s) = foldlM_loop SPEC z s+{-# INLINE_STREAM foldlM #-}+foldlM m z (Stream step s _) = foldlM_loop SPEC z s where foldlM_loop !sPEC z s = do@@ -853,14 +793,14 @@ -- | Left fold over a non-empty 'Stream' with a monadic operator foldl1M :: Monad m => (a -> a -> m a) -> Stream m a -> m a-{-# INLINE_FUSED foldl1M #-}-foldl1M f (Stream step s) = foldl1M_loop SPEC s+{-# INLINE_STREAM foldl1M #-}+foldl1M f (Stream step s sz) = foldl1M_loop SPEC s where foldl1M_loop !sPEC s = do r <- step s case r of- Yield x s' -> foldlM f x (Stream step s')+ Yield x s' -> foldlM f x (Stream step s' (sz - 1)) Skip s' -> foldl1M_loop SPEC s' Done -> EMPTY_STREAM "foldl1M" @@ -876,8 +816,8 @@ -- | Left fold with a strict accumulator and a monadic operator foldlM' :: Monad m => (a -> b -> m a) -> a -> Stream m b -> m a-{-# INLINE_FUSED foldlM' #-}-foldlM' m z (Stream step s) = foldlM'_loop SPEC z s+{-# INLINE_STREAM foldlM' #-}+foldlM' m z (Stream step s _) = foldlM'_loop SPEC z s where foldlM'_loop !sPEC z s = z `seq`@@ -901,14 +841,14 @@ -- | Left fold over a non-empty 'Stream' with a strict accumulator and a -- monadic operator foldl1M' :: Monad m => (a -> a -> m a) -> Stream m a -> m a-{-# INLINE_FUSED foldl1M' #-}-foldl1M' f (Stream step s) = foldl1M'_loop SPEC s+{-# INLINE_STREAM foldl1M' #-}+foldl1M' f (Stream step s sz) = foldl1M'_loop SPEC s where foldl1M'_loop !sPEC s = do r <- step s case r of- Yield x s' -> foldlM' f x (Stream step s')+ Yield x s' -> foldlM' f x (Stream step s' (sz - 1)) Skip s' -> foldl1M'_loop SPEC s' Done -> EMPTY_STREAM "foldl1M'" @@ -924,8 +864,8 @@ -- | Right fold with a monadic operator foldrM :: Monad m => (a -> b -> m b) -> b -> Stream m a -> m b-{-# INLINE_FUSED foldrM #-}-foldrM f z (Stream step s) = foldrM_loop SPEC s+{-# INLINE_STREAM foldrM #-}+foldrM f z (Stream step s _) = foldrM_loop SPEC s where foldrM_loop !sPEC s = do@@ -942,8 +882,8 @@ -- | Right fold over a non-empty stream with a monadic operator foldr1M :: Monad m => (a -> a -> m a) -> Stream m a -> m a-{-# INLINE_FUSED foldr1M #-}-foldr1M f (Stream step s) = foldr1M_loop0 SPEC s+{-# INLINE_STREAM foldr1M #-}+foldr1M f (Stream step s _) = foldr1M_loop0 SPEC s where foldr1M_loop0 !sPEC s = do@@ -965,8 +905,8 @@ -- ----------------- and :: Monad m => Stream m Bool -> m Bool-{-# INLINE_FUSED and #-}-and (Stream step s) = and_loop SPEC s+{-# INLINE_STREAM and #-}+and (Stream step s _) = and_loop SPEC s where and_loop !sPEC s = do@@ -978,8 +918,8 @@ Done -> return True or :: Monad m => Stream m Bool -> m Bool-{-# INLINE_FUSED or #-}-or (Stream step s) = or_loop SPEC s+{-# INLINE_STREAM or #-}+or (Stream step s _) = or_loop SPEC s where or_loop !sPEC s = do@@ -995,8 +935,8 @@ concatMap f = concatMapM (return . f) concatMapM :: Monad m => (a -> m (Stream m b)) -> Stream m a -> Stream m b-{-# INLINE_FUSED concatMapM #-}-concatMapM f (Stream step s) = Stream concatMap_go (Left s)+{-# INLINE_STREAM concatMapM #-}+concatMapM f (Stream step s _) = Stream concatMap_go (Left s) Unknown where concatMap_go (Left s) = do r <- step s@@ -1006,17 +946,18 @@ return $ Skip (Right (b_stream, s')) Skip s' -> return $ Skip (Left s') Done -> return Done- concatMap_go (Right (Stream inner_step inner_s, s)) = do+ concatMap_go (Right (Stream inner_step inner_s sz, s)) = do r <- inner_step inner_s case r of- Yield b inner_s' -> return $ Yield b (Right (Stream inner_step inner_s', s))- Skip inner_s' -> return $ Skip (Right (Stream inner_step inner_s', s))+ Yield b inner_s' -> return $ Yield b (Right (Stream inner_step inner_s' sz, s))+ Skip inner_s' -> return $ Skip (Right (Stream inner_step inner_s' sz, s)) Done -> return $ Skip (Left s) -- | Create a 'Stream' of values from a 'Stream' of streamable things-flatten :: Monad m => (a -> m s) -> (s -> m (Step s b)) -> Stream m a -> Stream m b-{-# INLINE_FUSED flatten #-}-flatten mk istep (Stream ostep t) = Stream step (Left t)+flatten :: Monad m => (a -> m s) -> (s -> m (Step s b)) -> Size+ -> Stream m a -> Stream m b+{-# INLINE_STREAM flatten #-}+flatten mk istep sz (Stream ostep t _) = Stream step (Left t) sz where {-# INLINE_INNER step #-} step (Left t) = do@@ -1041,13 +982,13 @@ -- | Unfold unfoldr :: Monad m => (s -> Maybe (a, s)) -> s -> Stream m a-{-# INLINE_FUSED unfoldr #-}+{-# INLINE_STREAM unfoldr #-} unfoldr f = unfoldrM (return . f) -- | Unfold with a monadic function unfoldrM :: Monad m => (s -> m (Maybe (a, s))) -> s -> Stream m a-{-# INLINE_FUSED unfoldrM #-}-unfoldrM f s = Stream step s+{-# INLINE_STREAM unfoldrM #-}+unfoldrM f s = Stream step s Unknown where {-# INLINE_INNER step #-} step s = liftM (\r ->@@ -1056,14 +997,15 @@ Nothing -> Done ) (f s) +-- | Unfold at most @n@ elements unfoldrN :: Monad m => Int -> (s -> Maybe (a, s)) -> s -> Stream m a-{-# INLINE_FUSED unfoldrN #-}+{-# INLINE_STREAM unfoldrN #-} unfoldrN n f = unfoldrNM n (return . f) -- | Unfold at most @n@ elements with a monadic functions unfoldrNM :: Monad m => Int -> (s -> m (Maybe (a, s))) -> s -> Stream m a-{-# INLINE_FUSED unfoldrNM #-}-unfoldrNM n f s = Stream step (s,n)+{-# INLINE_STREAM unfoldrNM #-}+unfoldrNM n f s = Stream step (s,n) (Max (delay_inline max n 0)) where {-# INLINE_INNER step #-} step (s,n) | n <= 0 = return Done@@ -1075,8 +1017,8 @@ -- | Apply monadic function n times to value. Zeroth element is original value. iterateNM :: Monad m => Int -> (a -> m a) -> a -> Stream m a-{-# INLINE_FUSED iterateNM #-}-iterateNM n f x0 = Stream step (x0,n)+{-# INLINE_STREAM iterateNM #-}+iterateNM n f x0 = Stream step (x0,n) (Exact (delay_inline max n 0)) where {-# INLINE_INNER step #-} step (x,i) | i <= 0 = return Done@@ -1086,7 +1028,7 @@ -- | Apply function n times to value. Zeroth element is original value. iterateN :: Monad m => Int -> (a -> a) -> a -> Stream m a-{-# INLINE_FUSED iterateN #-}+{-# INLINE_STREAM iterateN #-} iterateN n f x0 = iterateNM n (return . f) x0 -- Scans@@ -1099,8 +1041,8 @@ -- | Prefix scan with a monadic operator prescanlM :: Monad m => (a -> b -> m a) -> a -> Stream m b -> Stream m a-{-# INLINE_FUSED prescanlM #-}-prescanlM f z (Stream step s) = Stream step' (s,z)+{-# INLINE_STREAM prescanlM #-}+prescanlM f z (Stream step s sz) = Stream step' (s,z) sz where {-# INLINE_INNER step' #-} step' (s,x) = do@@ -1119,8 +1061,8 @@ -- | Prefix scan with strict accumulator and a monadic operator prescanlM' :: Monad m => (a -> b -> m a) -> a -> Stream m b -> Stream m a-{-# INLINE_FUSED prescanlM' #-}-prescanlM' f z (Stream step s) = Stream step' (s,z)+{-# INLINE_STREAM prescanlM' #-}+prescanlM' f z (Stream step s sz) = Stream step' (s,z) sz where {-# INLINE_INNER step' #-} step' (s,x) = x `seq`@@ -1140,8 +1082,8 @@ -- | Suffix scan with a monadic operator postscanlM :: Monad m => (a -> b -> m a) -> a -> Stream m b -> Stream m a-{-# INLINE_FUSED postscanlM #-}-postscanlM f z (Stream step s) = Stream step' (s,z)+{-# INLINE_STREAM postscanlM #-}+postscanlM f z (Stream step s sz) = Stream step' (s,z) sz where {-# INLINE_INNER step' #-} step' (s,x) = do@@ -1160,8 +1102,8 @@ -- | Suffix scan with strict acccumulator and a monadic operator postscanlM' :: Monad m => (a -> b -> m a) -> a -> Stream m b -> Stream m a-{-# INLINE_FUSED postscanlM' #-}-postscanlM' f z (Stream step s) = z `seq` Stream step' (s,z)+{-# INLINE_STREAM postscanlM' #-}+postscanlM' f z (Stream step s sz) = z `seq` Stream step' (s,z) sz where {-# INLINE_INNER step' #-} step' (s,x) = x `seq`@@ -1201,8 +1143,8 @@ -- | Scan over a non-empty 'Stream' with a monadic operator scanl1M :: Monad m => (a -> a -> m a) -> Stream m a -> Stream m a-{-# INLINE_FUSED scanl1M #-}-scanl1M f (Stream step s) = Stream step' (s, Nothing)+{-# INLINE_STREAM scanl1M #-}+scanl1M f (Stream step s sz) = Stream step' (s, Nothing) sz where {-# INLINE_INNER step' #-} step' (s, Nothing) = do@@ -1229,8 +1171,8 @@ -- | Scan over a non-empty 'Stream' with a strict accumulator and a monadic -- operator scanl1M' :: Monad m => (a -> a -> m a) -> Stream m a -> Stream m a-{-# INLINE_FUSED scanl1M' #-}-scanl1M' f (Stream step s) = Stream step' (s, Nothing)+{-# INLINE_STREAM scanl1M' #-}+scanl1M' f (Stream step s sz) = Stream step' (s, Nothing) sz where {-# INLINE_INNER step' #-} step' (s, Nothing) = do@@ -1260,8 +1202,9 @@ -- | Yield a 'Stream' of the given length containing the values @x@, @x+y@, -- @x+y+y@ etc. enumFromStepN :: (Num a, Monad m) => a -> a -> Int -> Stream m a-{-# INLINE_FUSED enumFromStepN #-}-enumFromStepN x y n = x `seq` y `seq` n `seq` Stream step (x,n)+{-# INLINE_STREAM enumFromStepN #-}+enumFromStepN x y n = x `seq` y `seq` n `seq`+ Stream step (x,n) (Exact (delay_inline max n 0)) where {-# INLINE_INNER step #-} step (x,n) | n > 0 = return $ Yield x (x+y,n-1)@@ -1272,7 +1215,7 @@ -- /WARNING:/ This operation can be very inefficient. If at all possible, use -- 'enumFromStepN' instead. enumFromTo :: (Enum a, Monad m) => a -> a -> Stream m a-{-# INLINE_FUSED enumFromTo #-}+{-# INLINE_STREAM enumFromTo #-} enumFromTo x y = fromList [x .. y] -- NOTE: We use (x+1) instead of (succ x) below because the latter checks for@@ -1280,9 +1223,11 @@ -- FIXME: add "too large" test for Int enumFromTo_small :: (Integral a, Monad m) => a -> a -> Stream m a-{-# INLINE_FUSED enumFromTo_small #-}-enumFromTo_small x y = x `seq` y `seq` Stream step x+{-# INLINE_STREAM enumFromTo_small #-}+enumFromTo_small x y = x `seq` y `seq` Stream step x (Exact n) where+ n = delay_inline max (fromIntegral y - fromIntegral x + 1) 0+ {-# INLINE_INNER step #-} step x | x <= y = return $ Yield x (x+1) | otherwise = return $ Done@@ -1329,16 +1274,15 @@ -- unsigned types). See http://hackage.haskell.org/trac/ghc/ticket/3744 -- -enumFromTo_int :: forall m. Monad m => Int -> Int -> Stream m Int-{-# INLINE_FUSED enumFromTo_int #-}-enumFromTo_int x y = x `seq` y `seq` Stream step x+enumFromTo_int :: (Integral a, Monad m) => a -> a -> Stream m a+{-# INLINE_STREAM enumFromTo_int #-}+enumFromTo_int x y = x `seq` y `seq` Stream step x (Exact (len x y)) where {-# INLINE [0] len #-}- len :: Int -> Int -> Int len x y | x > y = 0 | otherwise = BOUNDS_CHECK(check) "enumFromTo" "vector too large" (n > 0)- $ n+ $ fromIntegral n where n = y-x+1 @@ -1346,14 +1290,6 @@ step x | x <= y = return $ Yield x (x+1) | otherwise = return $ Done -enumFromTo_intlike :: (Integral a, Monad m) => a -> a -> Stream m a-{-# INLINE_FUSED enumFromTo_intlike #-}-enumFromTo_intlike x y = x `seq` y `seq` Stream step x- where- {-# INLINE_INNER step #-}- step x | x <= y = return $ Yield x (x+1)- | otherwise = return $ Done- {-# RULES "enumFromTo<Int> [Stream]"@@ -1362,21 +1298,29 @@ #if WORD_SIZE_IN_BITS > 32 "enumFromTo<Int64> [Stream]"- enumFromTo = enumFromTo_intlike :: Monad m => Int64 -> Int64 -> Stream m Int64+ enumFromTo = enumFromTo_int :: Monad m => Int64 -> Int64 -> Stream m Int64 #else "enumFromTo<Int32> [Stream]"- enumFromTo = enumFromTo_intlike :: Monad m => Int32 -> Int32 -> Stream m Int32+ enumFromTo = enumFromTo_int :: Monad m => Int32 -> Int32 -> Stream m Int32 #endif #-} enumFromTo_big_word :: (Integral a, Monad m) => a -> a -> Stream m a-{-# INLINE_FUSED enumFromTo_big_word #-}-enumFromTo_big_word x y = x `seq` y `seq` Stream step x+{-# INLINE_STREAM enumFromTo_big_word #-}+enumFromTo_big_word x y = x `seq` y `seq` Stream step x (Exact (len x y)) where+ {-# INLINE [0] len #-}+ len x y | x > y = 0+ | otherwise = BOUNDS_CHECK(check) "enumFromTo" "vector too large"+ (n < fromIntegral (maxBound :: Int))+ $ fromIntegral (n+1)+ where+ n = y-x+ {-# INLINE_INNER step #-} step x | x <= y = return $ Yield x (x+1) | otherwise = return $ Done@@ -1406,9 +1350,17 @@ -- FIXME: the "too large" test is totally wrong enumFromTo_big_int :: (Integral a, Monad m) => a -> a -> Stream m a-{-# INLINE_FUSED enumFromTo_big_int #-}-enumFromTo_big_int x y = x `seq` y `seq` Stream step x+{-# INLINE_STREAM enumFromTo_big_int #-}+enumFromTo_big_int x y = x `seq` y `seq` Stream step x (Exact (len x y)) where+ {-# INLINE [0] len #-}+ len x y | x > y = 0+ | otherwise = BOUNDS_CHECK(check) "enumFromTo" "vector too large"+ (n > 0 && n <= fromIntegral (maxBound :: Int))+ $ fromIntegral n+ where+ n = y-x+1+ {-# INLINE_INNER step #-} step x | x <= y = return $ Yield x (x+1) | otherwise = return $ Done@@ -1425,12 +1377,14 @@ #endif enumFromTo_char :: Monad m => Char -> Char -> Stream m Char-{-# INLINE_FUSED enumFromTo_char #-}-enumFromTo_char x y = x `seq` y `seq` Stream step xn+{-# INLINE_STREAM enumFromTo_char #-}+enumFromTo_char x y = x `seq` y `seq` Stream step xn (Exact n) where xn = ord x yn = ord y + n = delay_inline max 0 (yn - xn + 1)+ {-# INLINE_INNER step #-} step xn | xn <= yn = return $ Yield (unsafeChr xn) (xn+1) | otherwise = return $ Done@@ -1448,11 +1402,19 @@ -- Also, try to do something about pairs? enumFromTo_double :: (Monad m, Ord a, RealFrac a) => a -> a -> Stream m a-{-# INLINE_FUSED enumFromTo_double #-}-enumFromTo_double n m = n `seq` m `seq` Stream step n+{-# INLINE_STREAM enumFromTo_double #-}+enumFromTo_double n m = n `seq` m `seq` Stream step n (Max (len n m)) where lim = m + 1/2 -- important to float out + {-# INLINE [0] len #-}+ len x y | x > y = 0+ | otherwise = BOUNDS_CHECK(check) "enumFromTo" "vector too large"+ (n > 0)+ $ fromIntegral n+ where+ n = truncate (y-x)+2+ {-# INLINE_INNER step #-} step x | x <= lim = return $ Yield x (x+1) | otherwise = return $ Done@@ -1474,7 +1436,7 @@ -- /WARNING:/ This operation is very inefficient. If at all possible, use -- 'enumFromStepN' instead. enumFromThenTo :: (Enum a, Monad m) => a -> a -> a -> Stream m a-{-# INLINE_FUSED enumFromThenTo #-}+{-# INLINE_STREAM enumFromThenTo #-} enumFromThenTo x y z = fromList [x, y .. z] -- FIXME: Specialise enumFromThenTo.@@ -1490,110 +1452,23 @@ -- | Convert a list to a 'Stream' fromList :: Monad m => [a] -> Stream m a {-# INLINE fromList #-}-fromList xs = Stream step xs- where- step (x:xs) = return (Yield x xs)- step [] = return Done+fromList xs = unsafeFromList Unknown xs --- | Convert the first @n@ elements of a list to a 'Bundle'+-- | Convert the first @n@ elements of a list to a 'Stream' fromListN :: Monad m => Int -> [a] -> Stream m a-{-# INLINE_FUSED fromListN #-}-fromListN n xs = Stream step (xs,n)+{-# INLINE_STREAM fromListN #-}+fromListN n xs = Stream step (xs,n) (Max (delay_inline max n 0)) where {-# INLINE_INNER step #-} step (xs,n) | n <= 0 = return Done step (x:xs,n) = return (Yield x (xs,n-1)) step ([],n) = return Done -{--fromVector :: (Monad m, Vector v a) => v a -> Stream m a-{-# INLINE_FUSED fromVector #-}-fromVector v = v `seq` n `seq` Stream (Unf step 0)- (Unf vstep True)- (Just v)- (Exact n)- where- n = basicLength v-- {-# INLINE step #-}- step i | i >= n = return Done- | otherwise = case basicUnsafeIndexM v i of- Box x -> return $ Yield x (i+1)-- - {-# INLINE vstep #-}- vstep True = return (Yield (Chunk (basicLength v) (\mv -> basicUnsafeCopy mv v)) False)- vstep False = return Done--fromVectors :: forall m a. (Monad m, Vector v a) => [v a] -> Stream m a-{-# INLINE_FUSED fromVectors #-}-fromVectors vs = Stream (Unf pstep (Left vs))- (Unf vstep vs)- Nothing- (Exact n) - where- n = List.foldl' (\k v -> k + basicLength v) 0 vs-- pstep (Left []) = return Done- pstep (Left (v:vs)) = basicLength v `seq` return (Skip (Right (v,0,vs)))-- pstep (Right (v,i,vs))- | i >= basicLength v = return $ Skip (Left vs)- | otherwise = case basicUnsafeIndexM v i of- Box x -> return $ Yield x (Right (v,i+1,vs))-- -- FIXME: work around bug in GHC 7.6.1- vstep :: [v a] -> m (Step [v a] (Chunk v a))- vstep [] = return Done- vstep (v:vs) = return $ Yield (Chunk (basicLength v)- (\mv -> INTERNAL_CHECK(check) "concatVectors" "length mismatch"- (M.basicLength mv == basicLength v)- $ basicUnsafeCopy mv v)) vs---concatVectors :: (Monad m, Vector v a) => Stream m (v a) -> Stream m a-{-# INLINE_FUSED concatVectors #-}-concatVectors (Stream step s}- = Stream (Unf pstep (Left s))- (Unf vstep s)- Nothing- Unknown+-- | Convert a list to a 'Stream' with the given 'Size' hint. +unsafeFromList :: Monad m => Size -> [a] -> Stream m a+{-# INLINE_STREAM unsafeFromList #-}+unsafeFromList sz xs = Stream step xs sz where- pstep (Left s) = do- r <- step s- case r of- Yield v s' -> basicLength v `seq` return (Skip (Right (v,0,s')))- Skip s' -> return (Skip (Left s'))- Done -> return Done-- pstep (Right (v,i,s))- | i >= basicLength v = return (Skip (Left s))- | otherwise = case basicUnsafeIndexM v i of- Box x -> return (Yield x (Right (v,i+1,s)))--- vstep s = do- r <- step s- case r of- Yield v s' -> return (Yield (Chunk (basicLength v)- (\mv -> INTERNAL_CHECK(check) "concatVectors" "length mismatch"- (M.basicLength mv == basicLength v)- $ basicUnsafeCopy mv v)) s')- Skip s' -> return (Skip s')- Done -> return Done--reVector :: Monad m => Stream m a -> Stream m a-{-# INLINE_FUSED reVector #-}-reVector (Stream step s, sSize = n} = Stream step s n--{-# RULES--"reVector [Vector]"- reVector = id--"reVector/reVector [Vector]" forall s.- reVector (reVector s) = s-- #-}--}+ step (x:xs) = return (Yield x xs)+ step [] = return Done
+ Data/Vector/Fusion/Stream/Size.hs view
@@ -0,0 +1,87 @@+-- |+-- Module : Data.Vector.Fusion.Stream.Size+-- Copyright : (c) Roman Leshchinskiy 2008-2010+-- License : BSD-style+--+-- Maintainer : Roman Leshchinskiy <rl@cse.unsw.edu.au>+-- Stability : experimental+-- Portability : portable+-- +-- Size hints for streams.+--++module Data.Vector.Fusion.Stream.Size (+ Size(..), smaller, larger, toMax, upperBound+) where++import Data.Vector.Fusion.Util ( delay_inline )++-- | Size hint+data Size = Exact Int -- ^ Exact size+ | Max Int -- ^ Upper bound on the size+ | Unknown -- ^ Unknown size+ deriving( Eq, Show )++instance Num Size where+ Exact m + Exact n = Exact (m+n)+ Exact m + Max n = Max (m+n)++ Max m + Exact n = Max (m+n)+ Max m + Max n = Max (m+n)++ _ + _ = Unknown+++ Exact m - Exact n = Exact (m-n)+ Exact m - Max n = Max m++ Max m - Exact n = Max (m-n)+ Max m - Max n = Max m+ Max m - Unknown = Max m++ _ - _ = Unknown+++ fromInteger n = Exact (fromInteger n)++-- | Minimum of two size hints+smaller :: Size -> Size -> Size+{-# INLINE smaller #-}+smaller (Exact m) (Exact n) = Exact (delay_inline min m n)+smaller (Exact m) (Max n) = Max (delay_inline min m n)+smaller (Exact m) Unknown = Max m+smaller (Max m) (Exact n) = Max (delay_inline min m n)+smaller (Max m) (Max n) = Max (delay_inline min m n)+smaller (Max m) Unknown = Max m+smaller Unknown (Exact n) = Max n+smaller Unknown (Max n) = Max n+smaller Unknown Unknown = Unknown++-- | Maximum of two size hints+larger :: Size -> Size -> Size+{-# INLINE larger #-}+larger (Exact m) (Exact n) = Exact (delay_inline max m n)+larger (Exact m) (Max n) | m >= n = Exact m+ | otherwise = Max n+larger (Max m) (Exact n) | n >= m = Exact n+ | otherwise = Max m+larger (Max m) (Max n) = Max (delay_inline max m n)+larger _ _ = Unknown++-- | Convert a size hint to an upper bound+toMax :: Size -> Size+toMax (Exact n) = Max n+toMax (Max n) = Max n+toMax Unknown = Unknown++-- | Compute the minimum size from a size hint+lowerBound :: Size -> Int+lowerBound (Exact n) = n+lowerBound _ = 0++-- | Compute the maximum size from a size hint if possible+upperBound :: Size -> Maybe Int+upperBound (Exact n) = Just n+upperBound (Max n) = Just n+upperBound Unknown = Nothing+
Data/Vector/Generic.hs view
@@ -142,7 +142,7 @@ -- * Fusion support - -- ** Conversion to/from Bundles+ -- ** Conversion to/from Streams stream, unstream, streamR, unstreamR, -- ** Recycling support@@ -168,12 +168,10 @@ import qualified Data.Vector.Generic.New as New import Data.Vector.Generic.New ( New ) -import qualified Data.Vector.Fusion.Bundle as Bundle-import Data.Vector.Fusion.Bundle ( Bundle, MBundle, Step(..), lift, inplace )-import qualified Data.Vector.Fusion.Bundle.Monadic as MBundle-import Data.Vector.Fusion.Stream.Monadic ( Stream )-import qualified Data.Vector.Fusion.Stream.Monadic as S-import Data.Vector.Fusion.Bundle.Size+import qualified Data.Vector.Fusion.Stream as Stream+import Data.Vector.Fusion.Stream ( Stream, MStream, Step(..), inplace, liftStream )+import qualified Data.Vector.Fusion.Stream.Monadic as MStream+import Data.Vector.Fusion.Stream.Size import Data.Vector.Fusion.Util import Control.Monad.ST ( ST, runST )@@ -219,79 +217,93 @@ -- | /O(1)/ Yield the length of the vector. length :: Vector v a => v a -> Int-{-# INLINE length #-}-length = Bundle.length . stream+{-# INLINE_STREAM length #-}+length v = basicLength v +{-# RULES++"length/unstream [Vector]" forall s.+ length (new (New.unstream s)) = Stream.length s++ #-}+ -- | /O(1)/ Test whether a vector if empty null :: Vector v a => v a -> Bool-{-# INLINE null #-}-null = Bundle.null . stream+{-# INLINE_STREAM null #-}+null v = basicLength v == 0 +{-# RULES++"null/unstream [Vector]" forall s.+ null (new (New.unstream s)) = Stream.null s++ #-}+ -- Indexing -- -------- infixl 9 ! -- | O(1) Indexing (!) :: Vector v a => v a -> Int -> a-{-# INLINE_FUSED (!) #-}+{-# INLINE_STREAM (!) #-} (!) v i = BOUNDS_CHECK(checkIndex) "(!)" i (length v) $ unId (basicUnsafeIndexM v i) infixl 9 !? -- | O(1) Safe indexing (!?) :: Vector v a => v a -> Int -> Maybe a-{-# INLINE_FUSED (!?) #-}+{-# INLINE_STREAM (!?) #-} v !? i | i < 0 || i >= length v = Nothing | otherwise = Just $ unsafeIndex v i -- | /O(1)/ First element head :: Vector v a => v a -> a-{-# INLINE_FUSED head #-}+{-# INLINE_STREAM head #-} head v = v ! 0 -- | /O(1)/ Last element last :: Vector v a => v a -> a-{-# INLINE_FUSED last #-}+{-# INLINE_STREAM last #-} last v = v ! (length v - 1) -- | /O(1)/ Unsafe indexing without bounds checking unsafeIndex :: Vector v a => v a -> Int -> a-{-# INLINE_FUSED unsafeIndex #-}+{-# INLINE_STREAM unsafeIndex #-} unsafeIndex v i = UNSAFE_CHECK(checkIndex) "unsafeIndex" i (length v) $ unId (basicUnsafeIndexM v i) -- | /O(1)/ First element without checking if the vector is empty unsafeHead :: Vector v a => v a -> a-{-# INLINE_FUSED unsafeHead #-}+{-# INLINE_STREAM unsafeHead #-} unsafeHead v = unsafeIndex v 0 -- | /O(1)/ Last element without checking if the vector is empty unsafeLast :: Vector v a => v a -> a-{-# INLINE_FUSED unsafeLast #-}+{-# INLINE_STREAM unsafeLast #-} unsafeLast v = unsafeIndex v (length v - 1) {-# RULES "(!)/unstream [Vector]" forall i s.- new (New.unstream s) ! i = s Bundle.!! i+ new (New.unstream s) ! i = s Stream.!! i "(!?)/unstream [Vector]" forall i s.- new (New.unstream s) !? i = s Bundle.!? i+ new (New.unstream s) !? i = s Stream.!? i "head/unstream [Vector]" forall s.- head (new (New.unstream s)) = Bundle.head s+ head (new (New.unstream s)) = Stream.head s "last/unstream [Vector]" forall s.- last (new (New.unstream s)) = Bundle.last s+ last (new (New.unstream s)) = Stream.last s "unsafeIndex/unstream [Vector]" forall i s.- unsafeIndex (new (New.unstream s)) i = s Bundle.!! i+ unsafeIndex (new (New.unstream s)) i = s Stream.!! i "unsafeHead/unstream [Vector]" forall s.- unsafeHead (new (New.unstream s)) = Bundle.head s+ unsafeHead (new (New.unstream s)) = Stream.head s "unsafeLast/unstream [Vector]" forall s.- unsafeLast (new (New.unstream s)) = Bundle.last s+ unsafeLast (new (New.unstream s)) = Stream.last s #-} @@ -318,60 +330,60 @@ -- elements) is evaluated eagerly. -- indexM :: (Vector v a, Monad m) => v a -> Int -> m a-{-# INLINE_FUSED indexM #-}+{-# INLINE_STREAM indexM #-} indexM v i = BOUNDS_CHECK(checkIndex) "indexM" i (length v) $ basicUnsafeIndexM v i -- | /O(1)/ First element of a vector in a monad. See 'indexM' for an -- explanation of why this is useful. headM :: (Vector v a, Monad m) => v a -> m a-{-# INLINE_FUSED headM #-}+{-# INLINE_STREAM headM #-} headM v = indexM v 0 -- | /O(1)/ Last element of a vector in a monad. See 'indexM' for an -- explanation of why this is useful. lastM :: (Vector v a, Monad m) => v a -> m a-{-# INLINE_FUSED lastM #-}+{-# INLINE_STREAM lastM #-} lastM v = indexM v (length v - 1) -- | /O(1)/ Indexing in a monad without bounds checks. See 'indexM' for an -- explanation of why this is useful. unsafeIndexM :: (Vector v a, Monad m) => v a -> Int -> m a-{-# INLINE_FUSED unsafeIndexM #-}+{-# INLINE_STREAM unsafeIndexM #-} unsafeIndexM v i = UNSAFE_CHECK(checkIndex) "unsafeIndexM" i (length v) $ basicUnsafeIndexM v i -- | /O(1)/ First element in a monad without checking for empty vectors. -- See 'indexM' for an explanation of why this is useful. unsafeHeadM :: (Vector v a, Monad m) => v a -> m a-{-# INLINE_FUSED unsafeHeadM #-}+{-# INLINE_STREAM unsafeHeadM #-} unsafeHeadM v = unsafeIndexM v 0 -- | /O(1)/ Last element in a monad without checking for empty vectors. -- See 'indexM' for an explanation of why this is useful. unsafeLastM :: (Vector v a, Monad m) => v a -> m a-{-# INLINE_FUSED unsafeLastM #-}+{-# INLINE_STREAM unsafeLastM #-} unsafeLastM v = unsafeIndexM v (length v - 1) {-# RULES "indexM/unstream [Vector]" forall s i.- indexM (new (New.unstream s)) i = lift s MBundle.!! i+ indexM (new (New.unstream s)) i = liftStream s MStream.!! i "headM/unstream [Vector]" forall s.- headM (new (New.unstream s)) = MBundle.head (lift s)+ headM (new (New.unstream s)) = MStream.head (liftStream s) "lastM/unstream [Vector]" forall s.- lastM (new (New.unstream s)) = MBundle.last (lift s)+ lastM (new (New.unstream s)) = MStream.last (liftStream s) "unsafeIndexM/unstream [Vector]" forall s i.- unsafeIndexM (new (New.unstream s)) i = lift s MBundle.!! i+ unsafeIndexM (new (New.unstream s)) i = liftStream s MStream.!! i "unsafeHeadM/unstream [Vector]" forall s.- unsafeHeadM (new (New.unstream s)) = MBundle.head (lift s)+ unsafeHeadM (new (New.unstream s)) = MStream.head (liftStream s) "unsafeLastM/unstream [Vector]" forall s.- unsafeLastM (new (New.unstream s)) = MBundle.last (lift s)+ unsafeLastM (new (New.unstream s)) = MStream.last (liftStream s) #-} @@ -384,33 +396,33 @@ -> Int -- ^ @n@ length -> v a -> v a-{-# INLINE_FUSED slice #-}+{-# INLINE_STREAM slice #-} slice i n v = BOUNDS_CHECK(checkSlice) "slice" i n (length v) $ basicUnsafeSlice i n v -- | /O(1)/ Yield all but the last element without copying. The vector may not -- be empty. init :: Vector v a => v a -> v a-{-# INLINE_FUSED init #-}+{-# INLINE_STREAM init #-} init v = slice 0 (length v - 1) v -- | /O(1)/ Yield all but the first element without copying. The vector may not -- be empty. tail :: Vector v a => v a -> v a-{-# INLINE_FUSED tail #-}+{-# INLINE_STREAM tail #-} tail v = slice 1 (length v - 1) v -- | /O(1)/ Yield the first @n@ elements without copying. The vector may -- contain less than @n@ elements in which case it is returned unchanged. take :: Vector v a => Int -> v a -> v a-{-# INLINE_FUSED take #-}+{-# INLINE_STREAM take #-} take n v = unsafeSlice 0 (delay_inline min n' (length v)) v where n' = max n 0 -- | /O(1)/ Yield all but the first @n@ elements without copying. The vector may -- contain less than @n@ elements in which case an empty vector is returned. drop :: Vector v a => Int -> v a -> v a-{-# INLINE_FUSED drop #-}+{-# INLINE_STREAM drop #-} drop n v = unsafeSlice (delay_inline min n' len) (delay_inline max 0 (len - n')) v where n' = max n 0@@ -420,7 +432,7 @@ -- -- Note that @'splitAt' n v@ is equivalent to @('take' n v, 'drop' n v)@ -- but slightly more efficient.-{-# INLINE_FUSED splitAt #-}+{-# INLINE_STREAM splitAt #-} splitAt :: Vector v a => Int -> v a -> (v a, v a) splitAt n v = ( unsafeSlice 0 m v , unsafeSlice m (delay_inline max 0 (len - n')) v@@ -436,20 +448,20 @@ -> Int -- ^ @n@ length -> v a -> v a-{-# INLINE_FUSED unsafeSlice #-}+{-# INLINE_STREAM unsafeSlice #-} unsafeSlice i n v = UNSAFE_CHECK(checkSlice) "unsafeSlice" i n (length v) $ basicUnsafeSlice i n v -- | /O(1)/ Yield all but the last element without copying. The vector may not -- be empty but this is not checked. unsafeInit :: Vector v a => v a -> v a-{-# INLINE_FUSED unsafeInit #-}+{-# INLINE_STREAM unsafeInit #-} unsafeInit v = unsafeSlice 0 (length v - 1) v -- | /O(1)/ Yield all but the first element without copying. The vector may not -- be empty but this is not checked. unsafeTail :: Vector v a => v a -> v a-{-# INLINE_FUSED unsafeTail #-}+{-# INLINE_STREAM unsafeTail #-} unsafeTail v = unsafeSlice 1 (length v - 1) v -- | /O(1)/ Yield the first @n@ elements without copying. The vector must@@ -498,31 +510,31 @@ -- | /O(1)/ Empty vector empty :: Vector v a => v a {-# INLINE empty #-}-empty = unstream Bundle.empty+empty = unstream Stream.empty -- | /O(1)/ Vector with exactly one element singleton :: forall v a. Vector v a => a -> v a {-# INLINE singleton #-} singleton x = elemseq (undefined :: v a) x- $ unstream (Bundle.singleton x)+ $ unstream (Stream.singleton x) -- | /O(n)/ Vector of the given length with the same value in each position replicate :: forall v a. Vector v a => Int -> a -> v a {-# INLINE replicate #-} replicate n x = elemseq (undefined :: v a) x $ unstream- $ Bundle.replicate n x+ $ Stream.replicate n x -- | /O(n)/ Construct a vector of the given length by applying the function to -- each index generate :: Vector v a => Int -> (Int -> a) -> v a {-# INLINE generate #-}-generate n f = unstream (Bundle.generate n f)+generate n f = unstream (Stream.generate n f) -- | /O(n)/ Apply function n times to value. Zeroth element is original value. iterateN :: Vector v a => Int -> (a -> a) -> a -> v a {-# INLINE iterateN #-}-iterateN n f x = unstream (Bundle.iterateN n f x)+iterateN n f x = unstream (Stream.iterateN n f x) -- Unfolding -- ---------@@ -535,7 +547,7 @@ -- > = <10,9,8,7,6,5,4,3,2,1> unfoldr :: Vector v a => (b -> Maybe (a, b)) -> b -> v a {-# INLINE unfoldr #-}-unfoldr f = unstream . Bundle.unfoldr f+unfoldr f = unstream . Stream.unfoldr f -- | /O(n)/ Construct a vector with at most @n@ by repeatedly applying the -- generator function to the a seed. The generator function yields 'Just' the@@ -544,7 +556,7 @@ -- > unfoldrN 3 (\n -> Just (n,n-1)) 10 = <10,9,8> unfoldrN :: Vector v a => Int -> (b -> Maybe (a, b)) -> b -> v a {-# INLINE unfoldrN #-}-unfoldrN n f = unstream . Bundle.unfoldrN n f+unfoldrN n f = unstream . Stream.unfoldrN n f -- | /O(n)/ Construct a vector with @n@ elements by repeatedly applying the -- generator function to the already constructed part of the vector.@@ -624,7 +636,7 @@ enumFromStepN x y n = elemseq (undefined :: v a) x $ elemseq (undefined :: v a) y $ unstream- $ Bundle.enumFromStepN x y n+ $ Stream.enumFromStepN x y n -- | /O(n)/ Enumerate values from @x@ to @y@. --@@ -632,7 +644,7 @@ -- 'enumFromN' instead. enumFromTo :: (Vector v a, Enum a) => a -> a -> v a {-# INLINE enumFromTo #-}-enumFromTo x y = unstream (Bundle.enumFromTo x y)+enumFromTo x y = unstream (Stream.enumFromTo x y) -- | /O(n)/ Enumerate values from @x@ to @y@ with a specific step @z@. --@@ -640,7 +652,7 @@ -- 'enumFromStepN' instead. enumFromThenTo :: (Vector v a, Enum a) => a -> a -> a -> v a {-# INLINE enumFromThenTo #-}-enumFromThenTo x y z = unstream (Bundle.enumFromThenTo x y z)+enumFromThenTo x y z = unstream (Stream.enumFromThenTo x y z) -- Concatenation -- -------------@@ -650,7 +662,7 @@ {-# INLINE cons #-} cons x v = elemseq (undefined :: v a) x $ unstream- $ Bundle.cons x+ $ Stream.cons x $ stream v -- | /O(n)/ Append an element@@ -658,34 +670,31 @@ {-# INLINE snoc #-} snoc v x = elemseq (undefined :: v a) x $ unstream- $ Bundle.snoc (stream v) x+ $ Stream.snoc (stream v) x infixr 5 ++ -- | /O(m+n)/ Concatenate two vectors (++) :: Vector v a => v a -> v a -> v a {-# INLINE (++) #-}-v ++ w = unstream (stream v Bundle.++ stream w)+v ++ w = unstream (stream v Stream.++ stream w) -- | /O(n)/ Concatenate all vectors in the list concat :: Vector v a => [v a] -> v a {-# INLINE concat #-}-concat = unstream . Bundle.fromVectors-{--concat vs = unstream (Bundle.flatten mk step (Exact n) (Bundle.fromList vs))+concat vs = unstream (Stream.flatten mk step (Exact n) (Stream.fromList vs)) where n = List.foldl' (\k v -> k + length v) 0 vs {-# INLINE_INNER step #-} step (v,i,k) | i < k = case unsafeIndexM v i of- Box x -> Bundle.Yield x (v,i+1,k)- | otherwise = Bundle.Done+ Box x -> Stream.Yield x (v,i+1,k)+ | otherwise = Stream.Done {-# INLINE mk #-} mk v = let k = length v in k `seq` (v,0,k)--} -- Monadic initialisation -- ----------------------@@ -694,13 +703,13 @@ -- results in a vector. replicateM :: (Monad m, Vector v a) => Int -> m a -> m (v a) {-# INLINE replicateM #-}-replicateM n m = unstreamM (MBundle.replicateM n m)+replicateM n m = unstreamM (MStream.replicateM n m) -- | /O(n)/ Construct a vector of the given length by applying the monadic -- action to each index generateM :: (Monad m, Vector v a) => Int -> (Int -> m a) -> m (v a) {-# INLINE generateM #-}-generateM n f = unstreamM (MBundle.generateM n f)+generateM n f = unstreamM (MStream.generateM n f) -- | Execute the monadic action and freeze the resulting vector. --@@ -727,7 +736,7 @@ force :: Vector v a => v a -> v a -- FIXME: we probably ought to inline this later as the rules still might fire -- otherwise-{-# INLINE_FUSED force #-}+{-# INLINE_STREAM force #-} force v = new (clone v) -- Bulk updates@@ -742,7 +751,7 @@ -> [(Int, a)] -- ^ list of index/value pairs (of length @n@) -> v a {-# INLINE (//) #-}-v // us = update_stream v (Bundle.fromList us)+v // us = update_stream v (Stream.fromList us) -- | /O(m+n)/ For each pair @(i,a)@ from the vector of index/value pairs, -- replace the vector element at position @i@ by @a@.@@ -774,16 +783,16 @@ -> v a -- ^ value vector (of length @n2@) -> v a {-# INLINE update_ #-}-update_ v is w = update_stream v (Bundle.zipWith (,) (stream is) (stream w))+update_ v is w = update_stream v (Stream.zipWith (,) (stream is) (stream w)) -update_stream :: Vector v a => v a -> Bundle u (Int,a) -> v a+update_stream :: Vector v a => v a -> Stream (Int,a) -> v a {-# INLINE update_stream #-}-update_stream = modifyWithBundle M.update+update_stream = modifyWithStream M.update -- | Same as ('//') but without bounds checking. unsafeUpd :: Vector v a => v a -> [(Int, a)] -> v a {-# INLINE unsafeUpd #-}-unsafeUpd v us = unsafeUpdate_stream v (Bundle.fromList us)+unsafeUpd v us = unsafeUpdate_stream v (Stream.fromList us) -- | Same as 'update' but without bounds checking. unsafeUpdate :: (Vector v a, Vector v (Int, a)) => v a -> v (Int, a) -> v a@@ -794,11 +803,11 @@ unsafeUpdate_ :: (Vector v a, Vector v Int) => v a -> v Int -> v a -> v a {-# INLINE unsafeUpdate_ #-} unsafeUpdate_ v is w- = unsafeUpdate_stream v (Bundle.zipWith (,) (stream is) (stream w))+ = unsafeUpdate_stream v (Stream.zipWith (,) (stream is) (stream w)) -unsafeUpdate_stream :: Vector v a => v a -> Bundle u (Int,a) -> v a+unsafeUpdate_stream :: Vector v a => v a -> Stream (Int,a) -> v a {-# INLINE unsafeUpdate_stream #-}-unsafeUpdate_stream = modifyWithBundle M.unsafeUpdate+unsafeUpdate_stream = modifyWithStream M.unsafeUpdate -- Accumulations -- -------------@@ -813,7 +822,7 @@ -> [(Int,b)] -- ^ list of index/value pairs (of length @n@) -> v a {-# INLINE accum #-}-accum f v us = accum_stream f v (Bundle.fromList us)+accum f v us = accum_stream f v (Stream.fromList us) -- | /O(m+n)/ For each pair @(i,b)@ from the vector of pairs, replace the vector -- element @a@ at position @i@ by @f a b@.@@ -847,18 +856,18 @@ -> v b -- ^ value vector (of length @n2@) -> v a {-# INLINE accumulate_ #-}-accumulate_ f v is xs = accum_stream f v (Bundle.zipWith (,) (stream is)+accumulate_ f v is xs = accum_stream f v (Stream.zipWith (,) (stream is) (stream xs)) -accum_stream :: Vector v a => (a -> b -> a) -> v a -> Bundle u (Int,b) -> v a+accum_stream :: Vector v a => (a -> b -> a) -> v a -> Stream (Int,b) -> v a {-# INLINE accum_stream #-}-accum_stream f = modifyWithBundle (M.accum f)+accum_stream f = modifyWithStream (M.accum f) -- | Same as 'accum' but without bounds checking. unsafeAccum :: Vector v a => (a -> b -> a) -> v a -> [(Int,b)] -> v a {-# INLINE unsafeAccum #-}-unsafeAccum f v us = unsafeAccum_stream f v (Bundle.fromList us)+unsafeAccum f v us = unsafeAccum_stream f v (Stream.fromList us) -- | Same as 'accumulate' but without bounds checking. unsafeAccumulate :: (Vector v a, Vector v (Int, b))@@ -871,12 +880,12 @@ => (a -> b -> a) -> v a -> v Int -> v b -> v a {-# INLINE unsafeAccumulate_ #-} unsafeAccumulate_ f v is xs- = unsafeAccum_stream f v (Bundle.zipWith (,) (stream is) (stream xs))+ = unsafeAccum_stream f v (Stream.zipWith (,) (stream is) (stream xs)) unsafeAccum_stream- :: Vector v a => (a -> b -> a) -> v a -> Bundle u (Int,b) -> v a+ :: Vector v a => (a -> b -> a) -> v a -> Stream (Int,b) -> v a {-# INLINE unsafeAccum_stream #-}-unsafeAccum_stream f = modifyWithBundle (M.unsafeAccum f)+unsafeAccum_stream f = modifyWithStream (M.unsafeAccum f) -- Permutations -- ------------@@ -903,8 +912,8 @@ backpermute v is = seq v $ seq n $ unstream- $ Bundle.unbox- $ Bundle.map index+ $ Stream.unbox+ $ Stream.map index $ stream is where n = length v@@ -921,8 +930,8 @@ unsafeBackpermute v is = seq v $ seq n $ unstream- $ Bundle.unbox- $ Bundle.map index+ $ Stream.unbox+ $ Stream.map index $ stream is where n = length v@@ -949,11 +958,11 @@ -- We have to make sure that this is strict in the stream but we can't seq on -- it while fusion is happening. Hence this ugliness.-modifyWithBundle :: Vector v a- => (forall s. Mutable v s a -> Bundle u b -> ST s ())- -> v a -> Bundle u b -> v a-{-# INLINE modifyWithBundle #-}-modifyWithBundle p v s = new (New.modifyWithBundle p (clone v) s)+modifyWithStream :: Vector v a+ => (forall s. Mutable v s a -> Stream b -> ST s ())+ -> v a -> Stream b -> v a+{-# INLINE modifyWithStream #-}+modifyWithStream p v s = new (New.modifyWithStream p (clone v) s) -- Indexing -- --------@@ -961,7 +970,7 @@ -- | /O(n)/ Pair each element in a vector with its index indexed :: (Vector v a, Vector v (Int,a)) => v a -> v (Int,a) {-# INLINE indexed #-}-indexed = unstream . Bundle.indexed . stream+indexed = unstream . Stream.indexed . stream -- Mapping -- -------@@ -969,12 +978,12 @@ -- | /O(n)/ Map a function over a vector map :: (Vector v a, Vector v b) => (a -> b) -> v a -> v b {-# INLINE map #-}-map f = unstream . inplace (S.map f) id . stream+map f = unstream . inplace (MStream.map f) . stream -- | /O(n)/ Apply a function to every element of a vector and its index imap :: (Vector v a, Vector v b) => (Int -> a -> b) -> v a -> v b {-# INLINE imap #-}-imap f = unstream . inplace (S.map (uncurry f) . S.indexed) id+imap f = unstream . inplace (MStream.map (uncurry f) . MStream.indexed) . stream -- | Map a function over a vector and concatenate the results.@@ -982,36 +991,28 @@ {-# INLINE concatMap #-} -- NOTE: We can't fuse concatMap anyway so don't pretend we do. -- This seems to be slightly slower--- concatMap f = concat . Bundle.toList . Bundle.map f . stream+-- concatMap f = concat . Stream.toList . Stream.map f . stream -- Slowest--- concatMap f = unstream . Bundle.concatMap (stream . f) . stream+-- concatMap f = unstream . Stream.concatMap (stream . f) . stream --- Used to be fastest-{-+-- Seems to be fastest concatMap f = unstream- . Bundle.flatten mk step Unknown+ . Stream.flatten mk step Unknown . stream where {-# INLINE_INNER step #-} step (v,i,k) | i < k = case unsafeIndexM v i of- Box x -> Bundle.Yield x (v,i+1,k)- | otherwise = Bundle.Done+ Box x -> Stream.Yield x (v,i+1,k)+ | otherwise = Stream.Done {-# INLINE mk #-} mk x = let v = f x k = length v in k `seq` (v,0,k)--} --- This seems to be fastest now-concatMap f = unstream- . Bundle.concatVectors- . Bundle.map f- . stream- -- Monadic mapping -- --------------- @@ -1019,13 +1020,13 @@ -- vector of results mapM :: (Monad m, Vector v a, Vector v b) => (a -> m b) -> v a -> m (v b) {-# INLINE mapM #-}-mapM f = unstreamM . Bundle.mapM f . stream+mapM f = unstreamM . Stream.mapM f . stream -- | /O(n)/ Apply the monadic action to all elements of a vector and ignore the -- results mapM_ :: (Monad m, Vector v a) => (a -> m b) -> v a -> m () {-# INLINE mapM_ #-}-mapM_ f = Bundle.mapM_ f . stream+mapM_ f = Stream.mapM_ f . stream -- | /O(n)/ Apply the monadic action to all elements of the vector, yielding a -- vector of results. Equvalent to @flip 'mapM'@.@@ -1046,13 +1047,13 @@ zipWith :: (Vector v a, Vector v b, Vector v c) => (a -> b -> c) -> v a -> v b -> v c {-# INLINE zipWith #-}-zipWith f xs ys = unstream (Bundle.zipWith f (stream xs) (stream ys))+zipWith f xs ys = unstream (Stream.zipWith f (stream xs) (stream ys)) -- | Zip three vectors with the given function. zipWith3 :: (Vector v a, Vector v b, Vector v c, Vector v d) => (a -> b -> c -> d) -> v a -> v b -> v c -> v d {-# INLINE zipWith3 #-}-zipWith3 f as bs cs = unstream (Bundle.zipWith3 f (stream as)+zipWith3 f as bs cs = unstream (Stream.zipWith3 f (stream as) (stream bs) (stream cs)) @@ -1060,7 +1061,7 @@ => (a -> b -> c -> d -> e) -> v a -> v b -> v c -> v d -> v e {-# INLINE zipWith4 #-} zipWith4 f as bs cs ds- = unstream (Bundle.zipWith4 f (stream as)+ = unstream (Stream.zipWith4 f (stream as) (stream bs) (stream cs) (stream ds))@@ -1071,7 +1072,7 @@ -> v f {-# INLINE zipWith5 #-} zipWith5 f as bs cs ds es- = unstream (Bundle.zipWith5 f (stream as)+ = unstream (Stream.zipWith5 f (stream as) (stream bs) (stream cs) (stream ds)@@ -1083,7 +1084,7 @@ -> v a -> v b -> v c -> v d -> v e -> v f -> v g {-# INLINE zipWith6 #-} zipWith6 f as bs cs ds es fs- = unstream (Bundle.zipWith6 f (stream as)+ = unstream (Stream.zipWith6 f (stream as) (stream bs) (stream cs) (stream ds)@@ -1096,14 +1097,14 @@ => (Int -> a -> b -> c) -> v a -> v b -> v c {-# INLINE izipWith #-} izipWith f xs ys = unstream- (Bundle.zipWith (uncurry f) (Bundle.indexed (stream xs))+ (Stream.zipWith (uncurry f) (Stream.indexed (stream xs)) (stream ys)) izipWith3 :: (Vector v a, Vector v b, Vector v c, Vector v d) => (Int -> a -> b -> c -> d) -> v a -> v b -> v c -> v d {-# INLINE izipWith3 #-} izipWith3 f as bs cs- = unstream (Bundle.zipWith3 (uncurry f) (Bundle.indexed (stream as))+ = unstream (Stream.zipWith3 (uncurry f) (Stream.indexed (stream as)) (stream bs) (stream cs)) @@ -1111,7 +1112,7 @@ => (Int -> a -> b -> c -> d -> e) -> v a -> v b -> v c -> v d -> v e {-# INLINE izipWith4 #-} izipWith4 f as bs cs ds- = unstream (Bundle.zipWith4 (uncurry f) (Bundle.indexed (stream as))+ = unstream (Stream.zipWith4 (uncurry f) (Stream.indexed (stream as)) (stream bs) (stream cs) (stream ds))@@ -1122,7 +1123,7 @@ -> v e -> v f {-# INLINE izipWith5 #-} izipWith5 f as bs cs ds es- = unstream (Bundle.zipWith5 (uncurry f) (Bundle.indexed (stream as))+ = unstream (Stream.zipWith5 (uncurry f) (Stream.indexed (stream as)) (stream bs) (stream cs) (stream ds)@@ -1134,7 +1135,7 @@ -> v a -> v b -> v c -> v d -> v e -> v f -> v g {-# INLINE izipWith6 #-} izipWith6 f as bs cs ds es fs- = unstream (Bundle.zipWith6 (uncurry f) (Bundle.indexed (stream as))+ = unstream (Stream.zipWith6 (uncurry f) (Stream.indexed (stream as)) (stream bs) (stream cs) (stream ds)@@ -1177,14 +1178,14 @@ => (a -> b -> m c) -> v a -> v b -> m (v c) -- FIXME: specialise for ST and IO? {-# INLINE zipWithM #-}-zipWithM f as bs = unstreamM $ Bundle.zipWithM f (stream as) (stream bs)+zipWithM f as bs = unstreamM $ Stream.zipWithM f (stream as) (stream bs) -- | /O(min(m,n))/ Zip the two vectors with the monadic action and ignore the -- results zipWithM_ :: (Monad m, Vector v a, Vector v b) => (a -> b -> m c) -> v a -> v b -> m () {-# INLINE zipWithM_ #-}-zipWithM_ f as bs = Bundle.zipWithM_ f (stream as) (stream bs)+zipWithM_ f as bs = Stream.zipWithM_ f (stream as) (stream bs) -- Unzipping -- ---------@@ -1237,32 +1238,33 @@ -- | /O(n)/ Drop elements that do not satisfy the predicate filter :: Vector v a => (a -> Bool) -> v a -> v a {-# INLINE filter #-}-filter f = unstream . inplace (S.filter f) toMax . stream+filter f = unstream . inplace (MStream.filter f) . stream -- | /O(n)/ Drop elements that do not satisfy the predicate which is applied to -- values and their indices ifilter :: Vector v a => (Int -> a -> Bool) -> v a -> v a {-# INLINE ifilter #-} ifilter f = unstream- . inplace (S.map snd . S.filter (uncurry f) . S.indexed) toMax+ . inplace (MStream.map snd . MStream.filter (uncurry f)+ . MStream.indexed) . stream -- | /O(n)/ Drop elements that do not satisfy the monadic predicate filterM :: (Monad m, Vector v a) => (a -> m Bool) -> v a -> m (v a) {-# INLINE filterM #-}-filterM f = unstreamM . Bundle.filterM f . stream+filterM f = unstreamM . Stream.filterM f . stream -- | /O(n)/ Yield the longest prefix of elements satisfying the predicate -- without copying. takeWhile :: Vector v a => (a -> Bool) -> v a -> v a {-# INLINE takeWhile #-}-takeWhile f = unstream . Bundle.takeWhile f . stream+takeWhile f = unstream . Stream.takeWhile f . stream -- | /O(n)/ Drop the longest prefix of elements that satisfy the predicate -- without copying. dropWhile :: Vector v a => (a -> Bool) -> v a -> v a {-# INLINE dropWhile #-}-dropWhile f = unstream . Bundle.dropWhile f . stream+dropWhile f = unstream . Stream.dropWhile f . stream -- Parititioning -- -------------@@ -1278,11 +1280,11 @@ -- FIXME: Make this inplace-fusible (look at how stable_partition is -- implemented in C++) -partition_stream :: Vector v a => (a -> Bool) -> Bundle u a -> (v a, v a)-{-# INLINE_FUSED partition_stream #-}+partition_stream :: Vector v a => (a -> Bool) -> Stream a -> (v a, v a)+{-# INLINE_STREAM partition_stream #-} partition_stream f s = s `seq` runST ( do- (mv1,mv2) <- M.partitionBundle f s+ (mv1,mv2) <- M.partitionStream f s v1 <- unsafeFreeze mv1 v2 <- unsafeFreeze mv2 return (v1,v2))@@ -1296,17 +1298,17 @@ unstablePartition f = unstablePartition_stream f . stream unstablePartition_stream- :: Vector v a => (a -> Bool) -> Bundle u a -> (v a, v a)-{-# INLINE_FUSED unstablePartition_stream #-}+ :: Vector v a => (a -> Bool) -> Stream a -> (v a, v a)+{-# INLINE_STREAM unstablePartition_stream #-} unstablePartition_stream f s = s `seq` runST ( do- (mv1,mv2) <- M.unstablePartitionBundle f s+ (mv1,mv2) <- M.unstablePartitionStream f s v1 <- unsafeFreeze mv1 v2 <- unsafeFreeze mv2 return (v1,v2)) unstablePartition_new :: Vector v a => (a -> Bool) -> New v a -> (v a, v a)-{-# INLINE_FUSED unstablePartition_new #-}+{-# INLINE_STREAM unstablePartition_new #-} unstablePartition_new f (New.New p) = runST ( do mv <- p@@ -1347,32 +1349,33 @@ -- | /O(n)/ Check if the vector contains an element elem :: (Vector v a, Eq a) => a -> v a -> Bool {-# INLINE elem #-}-elem x = Bundle.elem x . stream+elem x = Stream.elem x . stream infix 4 `notElem` -- | /O(n)/ Check if the vector does not contain an element (inverse of 'elem') notElem :: (Vector v a, Eq a) => a -> v a -> Bool {-# INLINE notElem #-}-notElem x = Bundle.notElem x . stream+notElem x = Stream.notElem x . stream -- | /O(n)/ Yield 'Just' the first element matching the predicate or 'Nothing' -- if no such element exists. find :: Vector v a => (a -> Bool) -> v a -> Maybe a {-# INLINE find #-}-find f = Bundle.find f . stream+find f = Stream.find f . stream -- | /O(n)/ Yield 'Just' the index of the first element matching the predicate -- or 'Nothing' if no such element exists. findIndex :: Vector v a => (a -> Bool) -> v a -> Maybe Int {-# INLINE findIndex #-}-findIndex f = Bundle.findIndex f . stream+findIndex f = Stream.findIndex f . stream -- | /O(n)/ Yield the indices of elements satisfying the predicate in ascending -- order. findIndices :: (Vector v a, Vector v Int) => (a -> Bool) -> v a -> v Int {-# INLINE findIndices #-} findIndices f = unstream- . inplace (S.map fst . S.filter (f . snd) . S.indexed) toMax+ . inplace (MStream.map fst . MStream.filter (f . snd)+ . MStream.indexed) . stream -- | /O(n)/ Yield 'Just' the index of the first occurence of the given element or@@ -1394,65 +1397,65 @@ -- | /O(n)/ Left fold foldl :: Vector v b => (a -> b -> a) -> a -> v b -> a {-# INLINE foldl #-}-foldl f z = Bundle.foldl f z . stream+foldl f z = Stream.foldl f z . stream -- | /O(n)/ Left fold on non-empty vectors foldl1 :: Vector v a => (a -> a -> a) -> v a -> a {-# INLINE foldl1 #-}-foldl1 f = Bundle.foldl1 f . stream+foldl1 f = Stream.foldl1 f . stream -- | /O(n)/ Left fold with strict accumulator foldl' :: Vector v b => (a -> b -> a) -> a -> v b -> a {-# INLINE foldl' #-}-foldl' f z = Bundle.foldl' f z . stream+foldl' f z = Stream.foldl' f z . stream -- | /O(n)/ Left fold on non-empty vectors with strict accumulator foldl1' :: Vector v a => (a -> a -> a) -> v a -> a {-# INLINE foldl1' #-}-foldl1' f = Bundle.foldl1' f . stream+foldl1' f = Stream.foldl1' f . stream -- | /O(n)/ Right fold foldr :: Vector v a => (a -> b -> b) -> b -> v a -> b {-# INLINE foldr #-}-foldr f z = Bundle.foldr f z . stream+foldr f z = Stream.foldr f z . stream -- | /O(n)/ Right fold on non-empty vectors foldr1 :: Vector v a => (a -> a -> a) -> v a -> a {-# INLINE foldr1 #-}-foldr1 f = Bundle.foldr1 f . stream+foldr1 f = Stream.foldr1 f . stream -- | /O(n)/ Right fold with a strict accumulator foldr' :: Vector v a => (a -> b -> b) -> b -> v a -> b {-# INLINE foldr' #-}-foldr' f z = Bundle.foldl' (flip f) z . streamR+foldr' f z = Stream.foldl' (flip f) z . streamR -- | /O(n)/ Right fold on non-empty vectors with strict accumulator foldr1' :: Vector v a => (a -> a -> a) -> v a -> a {-# INLINE foldr1' #-}-foldr1' f = Bundle.foldl1' (flip f) . streamR+foldr1' f = Stream.foldl1' (flip f) . streamR -- | /O(n)/ Left fold (function applied to each element and its index) ifoldl :: Vector v b => (a -> Int -> b -> a) -> a -> v b -> a {-# INLINE ifoldl #-}-ifoldl f z = Bundle.foldl (uncurry . f) z . Bundle.indexed . stream+ifoldl f z = Stream.foldl (uncurry . f) z . Stream.indexed . stream -- | /O(n)/ Left fold with strict accumulator (function applied to each element -- and its index) ifoldl' :: Vector v b => (a -> Int -> b -> a) -> a -> v b -> a {-# INLINE ifoldl' #-}-ifoldl' f z = Bundle.foldl' (uncurry . f) z . Bundle.indexed . stream+ifoldl' f z = Stream.foldl' (uncurry . f) z . Stream.indexed . stream -- | /O(n)/ Right fold (function applied to each element and its index) ifoldr :: Vector v a => (Int -> a -> b -> b) -> b -> v a -> b {-# INLINE ifoldr #-}-ifoldr f z = Bundle.foldr (uncurry f) z . Bundle.indexed . stream+ifoldr f z = Stream.foldr (uncurry f) z . Stream.indexed . stream -- | /O(n)/ Right fold with strict accumulator (function applied to each -- element and its index) ifoldr' :: Vector v a => (Int -> a -> b -> b) -> b -> v a -> b {-# INLINE ifoldr' #-}-ifoldr' f z xs = Bundle.foldl' (flip (uncurry f)) z- $ Bundle.indexedR (length xs) $ streamR xs+ifoldr' f z xs = Stream.foldl' (flip (uncurry f)) z+ $ Stream.indexedR (length xs) $ streamR xs -- Specialised folds -- -----------------@@ -1460,44 +1463,44 @@ -- | /O(n)/ Check if all elements satisfy the predicate. all :: Vector v a => (a -> Bool) -> v a -> Bool {-# INLINE all #-}-all f = Bundle.and . Bundle.map f . stream+all f = Stream.and . Stream.map f . stream -- | /O(n)/ Check if any element satisfies the predicate. any :: Vector v a => (a -> Bool) -> v a -> Bool {-# INLINE any #-}-any f = Bundle.or . Bundle.map f . stream+any f = Stream.or . Stream.map f . stream -- | /O(n)/ Check if all elements are 'True' and :: Vector v Bool => v Bool -> Bool {-# INLINE and #-}-and = Bundle.and . stream+and = Stream.and . stream -- | /O(n)/ Check if any element is 'True' or :: Vector v Bool => v Bool -> Bool {-# INLINE or #-}-or = Bundle.or . stream+or = Stream.or . stream -- | /O(n)/ Compute the sum of the elements sum :: (Vector v a, Num a) => v a -> a {-# INLINE sum #-}-sum = Bundle.foldl' (+) 0 . stream+sum = Stream.foldl' (+) 0 . stream -- | /O(n)/ Compute the produce of the elements product :: (Vector v a, Num a) => v a -> a {-# INLINE product #-}-product = Bundle.foldl' (*) 1 . stream+product = Stream.foldl' (*) 1 . stream -- | /O(n)/ Yield the maximum element of the vector. The vector may not be -- empty. maximum :: (Vector v a, Ord a) => v a -> a {-# INLINE maximum #-}-maximum = Bundle.foldl1' max . stream+maximum = Stream.foldl1' max . stream -- | /O(n)/ Yield the maximum element of the vector according to the given -- comparison function. The vector may not be empty. maximumBy :: Vector v a => (a -> a -> Ordering) -> v a -> a {-# INLINE maximumBy #-}-maximumBy cmp = Bundle.foldl1' maxBy . stream+maximumBy cmp = Stream.foldl1' maxBy . stream where {-# INLINE maxBy #-} maxBy x y = case cmp x y of@@ -1508,13 +1511,13 @@ -- empty. minimum :: (Vector v a, Ord a) => v a -> a {-# INLINE minimum #-}-minimum = Bundle.foldl1' min . stream+minimum = Stream.foldl1' min . stream -- | /O(n)/ Yield the minimum element of the vector according to the given -- comparison function. The vector may not be empty. minimumBy :: Vector v a => (a -> a -> Ordering) -> v a -> a {-# INLINE minimumBy #-}-minimumBy cmp = Bundle.foldl1' minBy . stream+minimumBy cmp = Stream.foldl1' minBy . stream where {-# INLINE minBy #-} minBy x y = case cmp x y of@@ -1531,7 +1534,7 @@ -- the given comparison function. The vector may not be empty. maxIndexBy :: Vector v a => (a -> a -> Ordering) -> v a -> Int {-# INLINE maxIndexBy #-}-maxIndexBy cmp = fst . Bundle.foldl1' imax . Bundle.indexed . stream+maxIndexBy cmp = fst . Stream.foldl1' imax . Stream.indexed . stream where imax (i,x) (j,y) = i `seq` j `seq` case cmp x y of@@ -1548,7 +1551,7 @@ -- the given comparison function. The vector may not be empty. minIndexBy :: Vector v a => (a -> a -> Ordering) -> v a -> Int {-# INLINE minIndexBy #-}-minIndexBy cmp = fst . Bundle.foldl1' imin . Bundle.indexed . stream+minIndexBy cmp = fst . Stream.foldl1' imin . Stream.indexed . stream where imin (i,x) (j,y) = i `seq` j `seq` case cmp x y of@@ -1561,22 +1564,22 @@ -- | /O(n)/ Monadic fold foldM :: (Monad m, Vector v b) => (a -> b -> m a) -> a -> v b -> m a {-# INLINE foldM #-}-foldM m z = Bundle.foldM m z . stream+foldM m z = Stream.foldM m z . stream -- | /O(n)/ Monadic fold over non-empty vectors fold1M :: (Monad m, Vector v a) => (a -> a -> m a) -> v a -> m a {-# INLINE fold1M #-}-fold1M m = Bundle.fold1M m . stream+fold1M m = Stream.fold1M m . stream -- | /O(n)/ Monadic fold with strict accumulator foldM' :: (Monad m, Vector v b) => (a -> b -> m a) -> a -> v b -> m a {-# INLINE foldM' #-}-foldM' m z = Bundle.foldM' m z . stream+foldM' m z = Stream.foldM' m z . stream -- | /O(n)/ Monadic fold over non-empty vectors with strict accumulator fold1M' :: (Monad m, Vector v a) => (a -> a -> m a) -> v a -> m a {-# INLINE fold1M' #-}-fold1M' m = Bundle.fold1M' m . stream+fold1M' m = Stream.fold1M' m . stream discard :: Monad m => m a -> m () {-# INLINE discard #-}@@ -1585,23 +1588,23 @@ -- | /O(n)/ Monadic fold that discards the result foldM_ :: (Monad m, Vector v b) => (a -> b -> m a) -> a -> v b -> m () {-# INLINE foldM_ #-}-foldM_ m z = discard . Bundle.foldM m z . stream+foldM_ m z = discard . Stream.foldM m z . stream -- | /O(n)/ Monadic fold over non-empty vectors that discards the result fold1M_ :: (Monad m, Vector v a) => (a -> a -> m a) -> v a -> m () {-# INLINE fold1M_ #-}-fold1M_ m = discard . Bundle.fold1M m . stream+fold1M_ m = discard . Stream.fold1M m . stream -- | /O(n)/ Monadic fold with strict accumulator that discards the result foldM'_ :: (Monad m, Vector v b) => (a -> b -> m a) -> a -> v b -> m () {-# INLINE foldM'_ #-}-foldM'_ m z = discard . Bundle.foldM' m z . stream+foldM'_ m z = discard . Stream.foldM' m z . stream -- | /O(n)/ Monad fold over non-empty vectors with strict accumulator -- that discards the result fold1M'_ :: (Monad m, Vector v a) => (a -> a -> m a) -> v a -> m () {-# INLINE fold1M'_ #-}-fold1M'_ m = discard . Bundle.fold1M' m . stream+fold1M'_ m = discard . Stream.fold1M' m . stream -- Monadic sequencing -- ------------------@@ -1629,12 +1632,12 @@ -- prescanl :: (Vector v a, Vector v b) => (a -> b -> a) -> a -> v b -> v a {-# INLINE prescanl #-}-prescanl f z = unstream . inplace (S.prescanl f z) id . stream+prescanl f z = unstream . inplace (MStream.prescanl f z) . stream -- | /O(n)/ Prescan with strict accumulator prescanl' :: (Vector v a, Vector v b) => (a -> b -> a) -> a -> v b -> v a {-# INLINE prescanl' #-}-prescanl' f z = unstream . inplace (S.prescanl' f z) id . stream+prescanl' f z = unstream . inplace (MStream.prescanl' f z) . stream -- | /O(n)/ Scan --@@ -1646,12 +1649,12 @@ -- postscanl :: (Vector v a, Vector v b) => (a -> b -> a) -> a -> v b -> v a {-# INLINE postscanl #-}-postscanl f z = unstream . inplace (S.postscanl f z) id . stream+postscanl f z = unstream . inplace (MStream.postscanl f z) . stream -- | /O(n)/ Scan with strict accumulator postscanl' :: (Vector v a, Vector v b) => (a -> b -> a) -> a -> v b -> v a {-# INLINE postscanl' #-}-postscanl' f z = unstream . inplace (S.postscanl' f z) id . stream+postscanl' f z = unstream . inplace (MStream.postscanl' f z) . stream -- | /O(n)/ Haskell-style scan --@@ -1663,12 +1666,12 @@ -- scanl :: (Vector v a, Vector v b) => (a -> b -> a) -> a -> v b -> v a {-# INLINE scanl #-}-scanl f z = unstream . Bundle.scanl f z . stream+scanl f z = unstream . Stream.scanl f z . stream -- | /O(n)/ Haskell-style scan with strict accumulator scanl' :: (Vector v a, Vector v b) => (a -> b -> a) -> a -> v b -> v a {-# INLINE scanl' #-}-scanl' f z = unstream . Bundle.scanl' f z . stream+scanl' f z = unstream . Stream.scanl' f z . stream -- | /O(n)/ Scan over a non-empty vector --@@ -1678,12 +1681,12 @@ -- scanl1 :: Vector v a => (a -> a -> a) -> v a -> v a {-# INLINE scanl1 #-}-scanl1 f = unstream . inplace (S.scanl1 f) id . stream+scanl1 f = unstream . inplace (MStream.scanl1 f) . stream -- | /O(n)/ Scan over a non-empty vector with a strict accumulator scanl1' :: Vector v a => (a -> a -> a) -> v a -> v a {-# INLINE scanl1' #-}-scanl1' f = unstream . inplace (S.scanl1' f) id . stream+scanl1' f = unstream . inplace (MStream.scanl1' f) . stream -- | /O(n)/ Right-to-left prescan --@@ -1693,43 +1696,43 @@ -- prescanr :: (Vector v a, Vector v b) => (a -> b -> b) -> b -> v a -> v b {-# INLINE prescanr #-}-prescanr f z = unstreamR . inplace (S.prescanl (flip f) z) id . streamR+prescanr f z = unstreamR . inplace (MStream.prescanl (flip f) z) . streamR -- | /O(n)/ Right-to-left prescan with strict accumulator prescanr' :: (Vector v a, Vector v b) => (a -> b -> b) -> b -> v a -> v b {-# INLINE prescanr' #-}-prescanr' f z = unstreamR . inplace (S.prescanl' (flip f) z) id . streamR+prescanr' f z = unstreamR . inplace (MStream.prescanl' (flip f) z) . streamR -- | /O(n)/ Right-to-left scan postscanr :: (Vector v a, Vector v b) => (a -> b -> b) -> b -> v a -> v b {-# INLINE postscanr #-}-postscanr f z = unstreamR . inplace (S.postscanl (flip f) z) id . streamR+postscanr f z = unstreamR . inplace (MStream.postscanl (flip f) z) . streamR -- | /O(n)/ Right-to-left scan with strict accumulator postscanr' :: (Vector v a, Vector v b) => (a -> b -> b) -> b -> v a -> v b {-# INLINE postscanr' #-}-postscanr' f z = unstreamR . inplace (S.postscanl' (flip f) z) id . streamR+postscanr' f z = unstreamR . inplace (MStream.postscanl' (flip f) z) . streamR -- | /O(n)/ Right-to-left Haskell-style scan scanr :: (Vector v a, Vector v b) => (a -> b -> b) -> b -> v a -> v b {-# INLINE scanr #-}-scanr f z = unstreamR . Bundle.scanl (flip f) z . streamR+scanr f z = unstreamR . Stream.scanl (flip f) z . streamR -- | /O(n)/ Right-to-left Haskell-style scan with strict accumulator scanr' :: (Vector v a, Vector v b) => (a -> b -> b) -> b -> v a -> v b {-# INLINE scanr' #-}-scanr' f z = unstreamR . Bundle.scanl' (flip f) z . streamR+scanr' f z = unstreamR . Stream.scanl' (flip f) z . streamR -- | /O(n)/ Right-to-left scan over a non-empty vector scanr1 :: Vector v a => (a -> a -> a) -> v a -> v a {-# INLINE scanr1 #-}-scanr1 f = unstreamR . inplace (S.scanl1 (flip f)) id . streamR+scanr1 f = unstreamR . inplace (MStream.scanl1 (flip f)) . streamR -- | /O(n)/ Right-to-left scan over a non-empty vector with a strict -- accumulator scanr1' :: Vector v a => (a -> a -> a) -> v a -> v a {-# INLINE scanr1' #-}-scanr1' f = unstreamR . inplace (S.scanl1' (flip f)) id . streamR+scanr1' f = unstreamR . inplace (MStream.scanl1' (flip f)) . streamR -- Conversions - Lists -- ------------------------@@ -1737,12 +1740,12 @@ -- | /O(n)/ Convert a vector to a list toList :: Vector v a => v a -> [a] {-# INLINE toList #-}-toList = Bundle.toList . stream+toList = Stream.toList . stream -- | /O(n)/ Convert a list to a vector fromList :: Vector v a => [a] -> v a {-# INLINE fromList #-}-fromList = unstream . Bundle.fromList+fromList = unstream . Stream.fromList -- | /O(n)/ Convert the first @n@ elements of a list to a vector --@@ -1751,7 +1754,7 @@ -- @ fromListN :: Vector v a => Int -> [a] -> v a {-# INLINE fromListN #-}-fromListN n = unstream . Bundle.fromListN n+fromListN n = unstream . Stream.fromListN n -- Conversions - Immutable vectors -- -------------------------------@@ -1759,7 +1762,7 @@ -- | /O(n)/ Convert different vector types convert :: (Vector v a, Vector w a) => v a -> w a {-# INLINE convert #-}-convert = unstream . Bundle.reVector . stream+convert = unstream . stream -- Conversions - Mutable vectors -- -----------------------------@@ -1779,12 +1782,12 @@ -- | /O(1)/ Unsafely convert an immutable vector to a mutable one without -- copying. The immutable vector may not be used after this operation. unsafeThaw :: (PrimMonad m, Vector v a) => v a -> m (Mutable v (PrimState m) a)-{-# INLINE_FUSED unsafeThaw #-}+{-# INLINE_STREAM unsafeThaw #-} unsafeThaw = basicUnsafeThaw -- | /O(n)/ Yield a mutable copy of the immutable vector. thaw :: (PrimMonad m, Vector v a) => v a -> m (Mutable v (PrimState m) a)-{-# INLINE_FUSED thaw #-}+{-# INLINE_STREAM thaw #-} thaw v = do mv <- M.unsafeNew (length v) unsafeCopy mv v@@ -1804,7 +1807,7 @@ -- | /O(n)/ Yield a mutable vector containing copies of each vector in the -- list. thawMany :: (PrimMonad m, Vector v a) => [v a] -> m (Mutable v (PrimState m) a)-{-# INLINE_FUSED thawMany #-}+{-# INLINE_STREAM thawMany #-} -- FIXME: add rule for (stream (new (New.create (thawMany vs)))) -- NOTE: We don't try to consume the list lazily as this wouldn't significantly -- change the space requirements anyway.@@ -1841,16 +1844,13 @@ (M.length dst == length src) $ (dst `seq` src `seq` basicUnsafeCopy dst src) --- Conversions to/from Bundles+-- Conversions to/from Streams -- --------------------------- --- | /O(1)/ Convert a vector to a 'Bundle'-stream :: Vector v a => v a -> Bundle v a-{-# INLINE_FUSED stream #-}-stream v = Bundle.fromVector v--{--stream v = v `seq` n `seq` (Bundle.unfoldr get 0 `Bundle.sized` Exact n)+-- | /O(1)/ Convert a vector to a 'Stream'+stream :: Vector v a => v a -> Stream a+{-# INLINE_STREAM stream #-}+stream v = v `seq` n `seq` (Stream.unfoldr get 0 `Stream.sized` Exact n) where n = length v @@ -1859,10 +1859,9 @@ {-# INLINE get #-} get i | i >= n = Nothing | otherwise = case basicUnsafeIndexM v i of Box x -> Just (x, i+1)--} --- | /O(n)/ Construct a vector from a 'Bundle'-unstream :: Vector v a => Bundle v a -> v a+-- | /O(n)/ Construct a vector from a 'Stream'+unstream :: Vector v a => Stream a -> v a {-# INLINE unstream #-} unstream s = new (New.unstream s) @@ -1878,19 +1877,19 @@ clone (new p) = p "inplace [Vector]"- forall (f :: forall m. Monad m => Stream m a -> Stream m a) g m.- New.unstream (inplace f g (stream (new m))) = New.transform f g m+ forall (f :: forall m. Monad m => MStream m a -> MStream m a) m.+ New.unstream (inplace f (stream (new m))) = New.transform f m "uninplace [Vector]"- forall (f :: forall m. Monad m => Stream m a -> Stream m a) g m.- stream (new (New.transform f g m)) = inplace f g (stream (new m))+ forall (f :: forall m. Monad m => MStream m a -> MStream m a) m.+ stream (new (New.transform f m)) = inplace f (stream (new m)) #-} --- | /O(1)/ Convert a vector to a 'Bundle', proceeding from right to left-streamR :: Vector v a => v a -> Bundle u a-{-# INLINE_FUSED streamR #-}-streamR v = v `seq` n `seq` (Bundle.unfoldr get n `Bundle.sized` Exact n)+-- | /O(1)/ Convert a vector to a 'Stream', proceeding from right to left+streamR :: Vector v a => v a -> Stream a+{-# INLINE_STREAM streamR #-}+streamR v = v `seq` n `seq` (Stream.unfoldr get n `Stream.sized` Exact n) where n = length v @@ -1900,8 +1899,8 @@ in case basicUnsafeIndexM v i' of Box x -> Just (x, i') --- | /O(n)/ Construct a vector from a 'Bundle', proceeding from right to left-unstreamR :: Vector v a => Bundle v a -> v a+-- | /O(n)/ Construct a vector from a 'Stream', proceeding from right to left+unstreamR :: Vector v a => Stream a -> v a {-# INLINE unstreamR #-} unstreamR s = new (New.unstreamR s) @@ -1920,31 +1919,31 @@ New.unstreamR (stream (new p)) = New.modify M.reverse p "inplace right [Vector]"- forall (f :: forall m. Monad m => Stream m a -> Stream m a) g m.- New.unstreamR (inplace f g (streamR (new m))) = New.transformR f g m+ forall (f :: forall m. Monad m => MStream m a -> MStream m a) m.+ New.unstreamR (inplace f (streamR (new m))) = New.transformR f m "uninplace right [Vector]"- forall (f :: forall m. Monad m => Stream m a -> Stream m a) g m.- streamR (new (New.transformR f g m)) = inplace f g (streamR (new m))+ forall (f :: forall m. Monad m => MStream m a -> MStream m a) m.+ streamR (new (New.transformR f m)) = inplace f (streamR (new m)) #-} -unstreamM :: (Monad m, Vector v a) => MBundle m u a -> m (v a)-{-# INLINE_FUSED unstreamM #-}+unstreamM :: (Monad m, Vector v a) => MStream m a -> m (v a)+{-# INLINE_STREAM unstreamM #-} unstreamM s = do- xs <- MBundle.toList s- return $ unstream $ Bundle.unsafeFromList (MBundle.size s) xs+ xs <- MStream.toList s+ return $ unstream $ Stream.unsafeFromList (MStream.size s) xs -unstreamPrimM :: (PrimMonad m, Vector v a) => MBundle m u a -> m (v a)-{-# INLINE_FUSED unstreamPrimM #-}+unstreamPrimM :: (PrimMonad m, Vector v a) => MStream m a -> m (v a)+{-# INLINE_STREAM unstreamPrimM #-} unstreamPrimM s = M.munstream s >>= unsafeFreeze -- FIXME: the next two functions are only necessary for the specialisations-unstreamPrimM_IO :: Vector v a => MBundle IO u a -> IO (v a)+unstreamPrimM_IO :: Vector v a => MStream IO a -> IO (v a) {-# INLINE unstreamPrimM_IO #-} unstreamPrimM_IO = unstreamPrimM -unstreamPrimM_ST :: Vector v a => MBundle (ST s) u a -> ST s (v a)+unstreamPrimM_ST :: Vector v a => MStream (ST s) a -> ST s (v a) {-# INLINE unstreamPrimM_ST #-} unstreamPrimM_ST = unstreamPrimM @@ -1961,13 +1960,13 @@ -- | Construct a vector from a monadic initialiser. new :: Vector v a => New v a -> v a-{-# INLINE_FUSED new #-}+{-# INLINE_STREAM new #-} new m = m `seq` runST (unsafeFreeze =<< New.run m) -- | Convert a vector to an initialiser which, when run, produces a copy of -- the vector. clone :: Vector v a => v a -> New v a-{-# INLINE_FUSED clone #-}+{-# INLINE_STREAM clone #-} clone v = v `seq` New.create ( do mv <- M.new (length v)
Data/Vector/Generic/Base.hs view
@@ -18,8 +18,8 @@ Vector(..), Mutable ) where -import Data.Vector.Generic.Mutable.Base ( MVector )-import qualified Data.Vector.Generic.Mutable.Base as M+import Data.Vector.Generic.Mutable ( MVector )+import qualified Data.Vector.Generic.Mutable as M import Control.Monad.Primitive
Data/Vector/Generic/Mutable.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts, BangPatterns, TypeFamilies, ScopedTypeVariables #-}+{-# LANGUAGE MultiParamTypeClasses, BangPatterns, ScopedTypeVariables #-} -- | -- Module : Data.Vector.Generic.Mutable -- Copyright : (c) Roman Leshchinskiy 2008-2010@@ -49,23 +49,18 @@ -- * Internal operations mstream, mstreamR,- unstream, unstreamR, vunstream,+ unstream, unstreamR, munstream, munstreamR, transform, transformR, fill, fillR, unsafeAccum, accum, unsafeUpdate, update, reverse,- unstablePartition, unstablePartitionBundle, partitionBundle+ unstablePartition, unstablePartitionStream, partitionStream ) where -import Data.Vector.Generic.Mutable.Base-import qualified Data.Vector.Generic.Base as V--import qualified Data.Vector.Fusion.Bundle as Bundle-import Data.Vector.Fusion.Bundle ( Bundle, MBundle, Chunk(..) )-import qualified Data.Vector.Fusion.Bundle.Monadic as MBundle-import Data.Vector.Fusion.Stream.Monadic ( Stream )-import qualified Data.Vector.Fusion.Stream.Monadic as Stream-import Data.Vector.Fusion.Bundle.Size+import qualified Data.Vector.Fusion.Stream as Stream+import Data.Vector.Fusion.Stream ( Stream, MStream )+import qualified Data.Vector.Fusion.Stream.Monadic as MStream+import Data.Vector.Fusion.Stream.Size import Data.Vector.Fusion.Util ( delay_inline ) import Control.Monad.Primitive ( PrimMonad, PrimState )@@ -75,12 +70,23 @@ #include "vector.h" -{--type family Immutable (v :: * -> * -> *) :: * -> *- -- | Class of mutable vectors parametrised with a primitive state token. ---class MBundle.Pointer u a => MVector v a where+-- Minimum complete implementation:+--+-- * 'basicLength'+--+-- * 'basicUnsafeSlice'+--+-- * 'basicOverlaps'+--+-- * 'basicUnsafeNew'+--+-- * 'basicUnsafeRead'+--+-- * 'basicUnsafeWrite'+--+class MVector v a where -- | Length of the mutable vector. This method should not be -- called directly, use 'length' instead. basicLength :: v s a -> Int@@ -122,10 +128,6 @@ -- not be called directly, use 'set' instead. basicSet :: PrimMonad m => v (PrimState m) a -> a -> m () - basicUnsafeCopyPointer :: PrimMonad m => v (PrimState m) a- -> Immutable v a- -> m ()- -- | Copy a vector. The two vectors may not overlap. This method should not -- be called directly, use 'unsafeCopy' instead. basicUnsafeCopy :: PrimMonad m => v (PrimState m) a -- ^ target@@ -168,14 +170,6 @@ | otherwise = basicUnsafeCopy (basicUnsafeSlice i (n-i) v) (basicUnsafeSlice 0 (n-i) v) - {-# INLINE basicUnsafeCopyPointer #-}- basicUnsafeCopyPointer !dst !src = do_copy 0 src- where- do_copy !i p | Just (x,q) <- MBundle.pget p = do- basicUnsafeWrite dst i x- do_copy (i+1) q- | otherwise = return ()- {-# INLINE basicUnsafeCopy #-} basicUnsafeCopy !dst !src = do_copy 0 where@@ -202,8 +196,7 @@ return v' where n = basicLength v--}- + -- ------------------ -- Internal functions -- ------------------@@ -240,9 +233,9 @@ $ unsafeWrite v' i' x return (v', i') -mstream :: (PrimMonad m, MVector v a) => v (PrimState m) a -> Stream m a+mstream :: (PrimMonad m, MVector v a) => v (PrimState m) a -> MStream m a {-# INLINE mstream #-}-mstream v = v `seq` n `seq` (Stream.unfoldrM get 0)+mstream v = v `seq` n `seq` (MStream.unfoldrM get 0 `MStream.sized` Exact n) where n = length v @@ -252,10 +245,10 @@ | otherwise = return $ Nothing fill :: (PrimMonad m, MVector v a)- => v (PrimState m) a -> Stream m a -> m (v (PrimState m) a)+ => v (PrimState m) a -> MStream m a -> m (v (PrimState m) a) {-# INLINE fill #-} fill v s = v `seq` do- n' <- Stream.foldM put 0 s+ n' <- MStream.foldM put 0 s return $ unsafeSlice 0 n' v where {-# INLINE_INNER put #-}@@ -264,15 +257,14 @@ $ unsafeWrite v i x return (i+1) -transform- :: (PrimMonad m, MVector v a)- => (Stream m a -> Stream m a) -> v (PrimState m) a -> m (v (PrimState m) a)-{-# INLINE_FUSED transform #-}+transform :: (PrimMonad m, MVector v a)+ => (MStream m a -> MStream m a) -> v (PrimState m) a -> m (v (PrimState m) a)+{-# INLINE_STREAM transform #-} transform f v = fill v (f (mstream v)) -mstreamR :: (PrimMonad m, MVector v a) => v (PrimState m) a -> Stream m a+mstreamR :: (PrimMonad m, MVector v a) => v (PrimState m) a -> MStream m a {-# INLINE mstreamR #-}-mstreamR v = v `seq` n `seq` (Stream.unfoldrM get n)+mstreamR v = v `seq` n `seq` (MStream.unfoldrM get n `MStream.sized` Exact n) where n = length v @@ -284,10 +276,10 @@ j = i-1 fillR :: (PrimMonad m, MVector v a)- => v (PrimState m) a -> Stream m a -> m (v (PrimState m) a)+ => v (PrimState m) a -> MStream m a -> m (v (PrimState m) a) {-# INLINE fillR #-} fillR v s = v `seq` do- i <- Stream.foldM put n s+ i <- MStream.foldM put n s return $ unsafeSlice i (n-i) v where n = length v@@ -299,28 +291,25 @@ where j = i-1 -transformR- :: (PrimMonad m, MVector v a)- => (Stream m a -> Stream m a) -> v (PrimState m) a -> m (v (PrimState m) a)-{-# INLINE_FUSED transformR #-}+transformR :: (PrimMonad m, MVector v a)+ => (MStream m a -> MStream m a) -> v (PrimState m) a -> m (v (PrimState m) a)+{-# INLINE_STREAM transformR #-} transformR f v = fillR v (f (mstreamR v)) --- | Create a new mutable vector and fill it with elements from the 'Bundle'.--- The vector will grow exponentially if the maximum size of the 'Bundle' is+-- | Create a new mutable vector and fill it with elements from the 'Stream'.+-- The vector will grow exponentially if the maximum size of the 'Stream' is -- unknown.-unstream :: (PrimMonad m, MVector v a)- => Bundle u a -> m (v (PrimState m) a)--- NOTE: replace INLINE_FUSED by INLINE? (also in unstreamR)-{-# INLINE_FUSED unstream #-}-unstream s = munstream (Bundle.lift s)+unstream :: (PrimMonad m, MVector v a) => Stream a -> m (v (PrimState m) a)+-- NOTE: replace INLINE_STREAM by INLINE? (also in unstreamR)+{-# INLINE_STREAM unstream #-}+unstream s = munstream (Stream.liftStream s) -- | Create a new mutable vector and fill it with elements from the monadic -- stream. The vector will grow exponentially if the maximum size of the stream -- is unknown.-munstream :: (PrimMonad m, MVector v a)- => MBundle m u a -> m (v (PrimState m) a)-{-# INLINE_FUSED munstream #-}-munstream s = case upperBound (MBundle.size s) of+munstream :: (PrimMonad m, MVector v a) => MStream m a -> m (v (PrimState m) a)+{-# INLINE_STREAM munstream #-}+munstream s = case upperBound (MStream.size s) of Just n -> munstreamMax s n Nothing -> munstreamUnknown s @@ -330,12 +319,12 @@ -- the shape of the vector) and one for when the vector has grown. To see the -- problem simply compile this: ----- fromList = Data.Vector.Unboxed.unstream . Bundle.fromList+-- fromList = Data.Vector.Unboxed.unstream . Stream.fromList -- -- I'm not sure this still applies (19/04/2010) -munstreamMax :: (PrimMonad m, MVector v a)- => MBundle m u a -> Int -> m (v (PrimState m) a)+munstreamMax+ :: (PrimMonad m, MVector v a) => MStream m a -> Int -> m (v (PrimState m) a) {-# INLINE munstreamMax #-} munstreamMax s n = do@@ -345,17 +334,17 @@ INTERNAL_CHECK(checkIndex) "munstreamMax" i n $ unsafeWrite v i x return (i+1)- n' <- MBundle.foldM' put 0 s+ n' <- MStream.foldM' put 0 s return $ INTERNAL_CHECK(checkSlice) "munstreamMax" 0 n' n $ unsafeSlice 0 n' v -munstreamUnknown :: (PrimMonad m, MVector v a)- => MBundle m u a -> m (v (PrimState m) a)+munstreamUnknown+ :: (PrimMonad m, MVector v a) => MStream m a -> m (v (PrimState m) a) {-# INLINE munstreamUnknown #-} munstreamUnknown s = do v <- unsafeNew 0- (v', n) <- MBundle.foldM put (v, 0) s+ (v', n) <- MStream.foldM put (v, 0) s return $ INTERNAL_CHECK(checkSlice) "munstreamUnknown" 0 n (length v') $ unsafeSlice 0 n v' where@@ -364,103 +353,25 @@ v' <- unsafeAppend1 v i x return (v',i+1) --------- | Create a new mutable vector and fill it with elements from the 'Bundle'.--- The vector will grow exponentially if the maximum size of the 'Bundle' is--- unknown.-vunstream :: (PrimMonad m, V.Vector v a)- => Bundle v a -> m (V.Mutable v (PrimState m) a)--- NOTE: replace INLINE_FUSED by INLINE? (also in unstreamR)-{-# INLINE_FUSED vunstream #-}-vunstream s = vmunstream (Bundle.lift s)---- | Create a new mutable vector and fill it with elements from the monadic--- stream. The vector will grow exponentially if the maximum size of the stream--- is unknown.-vmunstream :: (PrimMonad m, V.Vector v a)- => MBundle m v a -> m (V.Mutable v (PrimState m) a)-{-# INLINE_FUSED vmunstream #-}-vmunstream s = case upperBound (MBundle.size s) of- Just n -> vmunstreamMax s n- Nothing -> vmunstreamUnknown s---- FIXME: I can't think of how to prevent GHC from floating out--- unstreamUnknown. That is bad because SpecConstr then generates two--- specialisations: one for when it is called from unstream (it doesn't know--- the shape of the vector) and one for when the vector has grown. To see the--- problem simply compile this:------ fromList = Data.Vector.Unboxed.unstream . Bundle.fromList------ I'm not sure this still applies (19/04/2010)--vmunstreamMax :: (PrimMonad m, V.Vector v a)- => MBundle m v a -> Int -> m (V.Mutable v (PrimState m) a)-{-# INLINE vmunstreamMax #-}-vmunstreamMax s n- = do- v <- INTERNAL_CHECK(checkLength) "munstreamMax" n- $ unsafeNew n- let {-# INLINE_INNER copy #-}- copy i (Chunk n f) =- INTERNAL_CHECK(checkSlice) "munstreamMax.copy" i n (length v) $ do- f (basicUnsafeSlice i n v)- return (i+n)-- n' <- Stream.foldlM' copy 0 (MBundle.chunks s)- return $ INTERNAL_CHECK(checkSlice) "munstreamMax" 0 n' n- $ unsafeSlice 0 n' v--vmunstreamUnknown :: (PrimMonad m, V.Vector v a)- => MBundle m v a -> m (V.Mutable v (PrimState m) a)-{-# INLINE vmunstreamUnknown #-}-vmunstreamUnknown s- = do- v <- unsafeNew 0- (v', n) <- Stream.foldlM copy (v,0) (MBundle.chunks s)- return $ INTERNAL_CHECK(checkSlice) "munstreamUnknown" 0 n (length v')- $ unsafeSlice 0 n v'- where- {-# INLINE_INNER copy #-}- copy (v,i) (Chunk n f)- = do- let j = i+n- v' <- if basicLength v < j- then unsafeGrow v (delay_inline max (enlarge_delta v) (j - basicLength v))- else return v- INTERNAL_CHECK(checkSlice) "munstreamUnknown.copy" i n (length v')- $ f (basicUnsafeSlice i n v')- return (v',j)------- | Create a new mutable vector and fill it with elements from the 'Bundle'+-- | Create a new mutable vector and fill it with elements from the 'Stream' -- from right to left. The vector will grow exponentially if the maximum size--- of the 'Bundle' is unknown.-unstreamR :: (PrimMonad m, MVector v a)- => Bundle u a -> m (v (PrimState m) a)--- NOTE: replace INLINE_FUSED by INLINE? (also in unstream)-{-# INLINE_FUSED unstreamR #-}-unstreamR s = munstreamR (Bundle.lift s)+-- of the 'Stream' is unknown.+unstreamR :: (PrimMonad m, MVector v a) => Stream a -> m (v (PrimState m) a)+-- NOTE: replace INLINE_STREAM by INLINE? (also in unstream)+{-# INLINE_STREAM unstreamR #-}+unstreamR s = munstreamR (Stream.liftStream s) -- | Create a new mutable vector and fill it with elements from the monadic -- stream from right to left. The vector will grow exponentially if the maximum -- size of the stream is unknown.-munstreamR :: (PrimMonad m, MVector v a)- => MBundle m u a -> m (v (PrimState m) a)-{-# INLINE_FUSED munstreamR #-}-munstreamR s = case upperBound (MBundle.size s) of+munstreamR :: (PrimMonad m, MVector v a) => MStream m a -> m (v (PrimState m) a)+{-# INLINE_STREAM munstreamR #-}+munstreamR s = case upperBound (MStream.size s) of Just n -> munstreamRMax s n Nothing -> munstreamRUnknown s -munstreamRMax :: (PrimMonad m, MVector v a)- => MBundle m u a -> Int -> m (v (PrimState m) a)+munstreamRMax+ :: (PrimMonad m, MVector v a) => MStream m a -> Int -> m (v (PrimState m) a) {-# INLINE munstreamRMax #-} munstreamRMax s n = do@@ -471,17 +382,17 @@ INTERNAL_CHECK(checkIndex) "munstreamRMax" i' n $ unsafeWrite v i' x return i'- i <- MBundle.foldM' put n s+ i <- MStream.foldM' put n s return $ INTERNAL_CHECK(checkSlice) "munstreamRMax" i (n-i) n $ unsafeSlice i (n-i) v -munstreamRUnknown :: (PrimMonad m, MVector v a)- => MBundle m u a -> m (v (PrimState m) a)+munstreamRUnknown+ :: (PrimMonad m, MVector v a) => MStream m a -> m (v (PrimState m) a) {-# INLINE munstreamRUnknown #-} munstreamRUnknown s = do v <- unsafeNew 0- (v', i) <- MBundle.foldM put (v, 0) s+ (v', i) <- MStream.foldM put (v, 0) s let n = length v' return $ INTERNAL_CHECK(checkSlice) "unstreamRUnknown" i (n-i) n $ unsafeSlice i (n-i) v'@@ -599,7 +510,7 @@ -- and fill it with values produced by repeatedly executing the monadic action. replicateM :: (PrimMonad m, MVector v a) => Int -> m a -> m (v (PrimState m) a) {-# INLINE replicateM #-}-replicateM n m = munstream (MBundle.replicateM n m)+replicateM n m = munstream (MStream.replicateM n m) -- | Create a copy of a mutable vector. clone :: (PrimMonad m, MVector v a) => v (PrimState m) a -> m (v (PrimState m) a)@@ -798,9 +709,9 @@ -- ------------ accum :: (PrimMonad m, MVector v a)- => (a -> b -> a) -> v (PrimState m) a -> Bundle u (Int, b) -> m ()+ => (a -> b -> a) -> v (PrimState m) a -> Stream (Int, b) -> m () {-# INLINE accum #-}-accum f !v s = Bundle.mapM_ upd s+accum f !v s = Stream.mapM_ upd s where {-# INLINE_INNER upd #-} upd (i,b) = do@@ -811,9 +722,9 @@ !n = length v update :: (PrimMonad m, MVector v a)- => v (PrimState m) a -> Bundle u (Int, a) -> m ()+ => v (PrimState m) a -> Stream (Int, a) -> m () {-# INLINE update #-}-update !v s = Bundle.mapM_ upd s+update !v s = Stream.mapM_ upd s where {-# INLINE_INNER upd #-} upd (i,b) = BOUNDS_CHECK(checkIndex) "update" i n@@ -822,9 +733,9 @@ !n = length v unsafeAccum :: (PrimMonad m, MVector v a)- => (a -> b -> a) -> v (PrimState m) a -> Bundle u (Int, b) -> m ()+ => (a -> b -> a) -> v (PrimState m) a -> Stream (Int, b) -> m () {-# INLINE unsafeAccum #-}-unsafeAccum f !v s = Bundle.mapM_ upd s+unsafeAccum f !v s = Stream.mapM_ upd s where {-# INLINE_INNER upd #-} upd (i,b) = do@@ -835,9 +746,9 @@ !n = length v unsafeUpdate :: (PrimMonad m, MVector v a)- => v (PrimState m) a -> Bundle u (Int, a) -> m ()+ => v (PrimState m) a -> Stream (Int, a) -> m () {-# INLINE unsafeUpdate #-}-unsafeUpdate !v s = Bundle.mapM_ upd s+unsafeUpdate !v s = Stream.mapM_ upd s where {-# INLINE_INNER upd #-} upd (i,b) = UNSAFE_CHECK(checkIndex) "accum" i n@@ -883,16 +794,16 @@ from_left (i+1) j else from_right i (j-1) -unstablePartitionBundle :: (PrimMonad m, MVector v a)- => (a -> Bool) -> Bundle u a -> m (v (PrimState m) a, v (PrimState m) a)-{-# INLINE unstablePartitionBundle #-}-unstablePartitionBundle f s- = case upperBound (Bundle.size s) of+unstablePartitionStream :: (PrimMonad m, MVector v a)+ => (a -> Bool) -> Stream a -> m (v (PrimState m) a, v (PrimState m) a)+{-# INLINE unstablePartitionStream #-}+unstablePartitionStream f s+ = case upperBound (Stream.size s) of Just n -> unstablePartitionMax f s n Nothing -> partitionUnknown f s unstablePartitionMax :: (PrimMonad m, MVector v a)- => (a -> Bool) -> Bundle u a -> Int+ => (a -> Bool) -> Stream a -> Int -> m (v (PrimState m) a, v (PrimState m) a) {-# INLINE unstablePartitionMax #-} unstablePartitionMax f s n@@ -908,19 +819,19 @@ unsafeWrite v (j-1) x return (i, j-1) - (i,j) <- Bundle.foldM' put (0, n) s+ (i,j) <- Stream.foldM' put (0, n) s return (unsafeSlice 0 i v, unsafeSlice j (n-j) v) -partitionBundle :: (PrimMonad m, MVector v a)- => (a -> Bool) -> Bundle u a -> m (v (PrimState m) a, v (PrimState m) a)-{-# INLINE partitionBundle #-}-partitionBundle f s- = case upperBound (Bundle.size s) of+partitionStream :: (PrimMonad m, MVector v a)+ => (a -> Bool) -> Stream a -> m (v (PrimState m) a, v (PrimState m) a)+{-# INLINE partitionStream #-}+partitionStream f s+ = case upperBound (Stream.size s) of Just n -> partitionMax f s n Nothing -> partitionUnknown f s partitionMax :: (PrimMonad m, MVector v a)- => (a -> Bool) -> Bundle u a -> Int -> m (v (PrimState m) a, v (PrimState m) a)+ => (a -> Bool) -> Stream a -> Int -> m (v (PrimState m) a, v (PrimState m) a) {-# INLINE partitionMax #-} partitionMax f s n = do@@ -938,7 +849,7 @@ unsafeWrite v j' x return (i,j') - (i,j) <- Bundle.foldM' put (0,n) s+ (i,j) <- Stream.foldM' put (0,n) s INTERNAL_CHECK(check) "partitionMax" "invalid indices" (i <= j) $ return () let l = unsafeSlice 0 i v@@ -947,13 +858,13 @@ return (l,r) partitionUnknown :: (PrimMonad m, MVector v a)- => (a -> Bool) -> Bundle u a -> m (v (PrimState m) a, v (PrimState m) a)+ => (a -> Bool) -> Stream a -> m (v (PrimState m) a, v (PrimState m) a) {-# INLINE partitionUnknown #-} partitionUnknown f s = do v1 <- unsafeNew 0 v2 <- unsafeNew 0- (v1', n1, v2', n2) <- Bundle.foldM' put (v1, 0, v2, 0) s+ (v1', n1, v2', n2) <- Stream.foldM' put (v1, 0, v2, 0) s INTERNAL_CHECK(checkSlice) "partitionUnknown" 0 n1 (length v1') $ INTERNAL_CHECK(checkSlice) "partitionUnknown" 0 n2 (length v2') $ return (unsafeSlice 0 n1 v1', unsafeSlice 0 n2 v2')
− Data/Vector/Generic/Mutable/Base.hs
@@ -1,135 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses, BangPatterns #-}--- |--- Module : Data.Vector.Generic.Mutable.Base--- Copyright : (c) Roman Leshchinskiy 2008-2011--- License : BSD-style------ Maintainer : Roman Leshchinskiy <rl@cse.unsw.edu.au>--- Stability : experimental--- Portability : non-portable--- --- Class of mutable vectors -----module Data.Vector.Generic.Mutable.Base (- MVector(..)-) where--import Control.Monad.Primitive ( PrimMonad, PrimState )--#include "vector.h"---- | Class of mutable vectors parametrised with a primitive state token.----class MVector v a where- -- | Length of the mutable vector. This method should not be- -- called directly, use 'length' instead.- basicLength :: v s a -> Int-- -- | Yield a part of the mutable vector without copying it. This method- -- should not be called directly, use 'unsafeSlice' instead.- basicUnsafeSlice :: Int -- ^ starting index- -> Int -- ^ length of the slice- -> v s a- -> v s a-- -- Check whether two vectors overlap. This method should not be- -- called directly, use 'overlaps' instead.- basicOverlaps :: v s a -> v s a -> Bool-- -- | Create a mutable vector of the given length. This method should not be- -- called directly, use 'unsafeNew' instead.- basicUnsafeNew :: PrimMonad m => Int -> m (v (PrimState m) a)-- -- | Create a mutable vector of the given length and fill it with an- -- initial value. This method should not be called directly, use- -- 'replicate' instead.- basicUnsafeReplicate :: PrimMonad m => Int -> a -> m (v (PrimState m) a)-- -- | Yield the element at the given position. This method should not be- -- called directly, use 'unsafeRead' instead.- basicUnsafeRead :: PrimMonad m => v (PrimState m) a -> Int -> m a-- -- | Replace the element at the given position. This method should not be- -- called directly, use 'unsafeWrite' instead.- basicUnsafeWrite :: PrimMonad m => v (PrimState m) a -> Int -> a -> m ()-- -- | Reset all elements of the vector to some undefined value, clearing all- -- references to external objects. This is usually a noop for unboxed- -- vectors. This method should not be called directly, use 'clear' instead.- basicClear :: PrimMonad m => v (PrimState m) a -> m ()-- -- | Set all elements of the vector to the given value. This method should- -- not be called directly, use 'set' instead.- basicSet :: PrimMonad m => v (PrimState m) a -> a -> m ()-- -- | Copy a vector. The two vectors may not overlap. This method should not- -- be called directly, use 'unsafeCopy' instead.- basicUnsafeCopy :: PrimMonad m => v (PrimState m) a -- ^ target- -> v (PrimState m) a -- ^ source- -> m ()-- -- | Move the contents of a vector. The two vectors may overlap. This method- -- should not be called directly, use 'unsafeMove' instead.- basicUnsafeMove :: PrimMonad m => v (PrimState m) a -- ^ target- -> v (PrimState m) a -- ^ source- -> m ()-- -- | Grow a vector by the given number of elements. This method should not be- -- called directly, use 'unsafeGrow' instead.- basicUnsafeGrow :: PrimMonad m => v (PrimState m) a -> Int- -> m (v (PrimState m) a)-- {-# INLINE basicUnsafeReplicate #-}- basicUnsafeReplicate n x- = do- v <- basicUnsafeNew n- basicSet v x- return v-- {-# INLINE basicClear #-}- basicClear _ = return ()-- {-# INLINE basicSet #-}- basicSet !v x- | n == 0 = return ()- | otherwise = do- basicUnsafeWrite v 0 x- do_set 1- where- !n = basicLength v-- do_set i | 2*i < n = do basicUnsafeCopy (basicUnsafeSlice i i v)- (basicUnsafeSlice 0 i v)- do_set (2*i)- | otherwise = basicUnsafeCopy (basicUnsafeSlice i (n-i) v)- (basicUnsafeSlice 0 (n-i) v)-- {-# INLINE basicUnsafeCopy #-}- basicUnsafeCopy !dst !src = do_copy 0- where- !n = basicLength src-- do_copy i | i < n = do- x <- basicUnsafeRead src i- basicUnsafeWrite dst i x- do_copy (i+1)- | otherwise = return ()- - {-# INLINE basicUnsafeMove #-}- basicUnsafeMove !dst !src- | basicOverlaps dst src = do- srcCopy <- basicUnsafeNew (basicLength src)- basicUnsafeCopy srcCopy src- basicUnsafeCopy dst srcCopy- | otherwise = basicUnsafeCopy dst src-- {-# INLINE basicUnsafeGrow #-}- basicUnsafeGrow v by- = do- v' <- basicUnsafeNew (n+by)- basicUnsafeCopy (basicUnsafeSlice 0 n v') v- return v'- where- n = basicLength v-
Data/Vector/Generic/New.hs view
@@ -13,7 +13,7 @@ -- module Data.Vector.Generic.New (- New(..), create, run, runPrim, apply, modify, modifyWithBundle,+ New(..), create, run, runPrim, apply, modify, modifyWithStream, unstream, transform, unstreamR, transformR, slice, init, tail, take, drop, unsafeSlice, unsafeInit, unsafeTail@@ -24,10 +24,8 @@ import Data.Vector.Generic.Base ( Vector, Mutable ) -import Data.Vector.Fusion.Bundle ( Bundle, MBundle )-import qualified Data.Vector.Fusion.Bundle as Bundle-import Data.Vector.Fusion.Stream.Monadic ( Stream )-import Data.Vector.Fusion.Bundle.Size+import Data.Vector.Fusion.Stream ( Stream, MStream )+import qualified Data.Vector.Fusion.Stream as Stream import Control.Monad.Primitive import Control.Monad.ST ( ST )@@ -58,120 +56,117 @@ {-# INLINE modify #-} modify f (New p) = New (do { v <- p; f v; return v }) -modifyWithBundle :: (forall s. Mutable v s a -> Bundle u b -> ST s ())- -> New v a -> Bundle u b -> New v a-{-# INLINE_FUSED modifyWithBundle #-}-modifyWithBundle f (New p) s = s `seq` New (do { v <- p; f v s; return v })+modifyWithStream :: (forall s. Mutable v s a -> Stream b -> ST s ())+ -> New v a -> Stream b -> New v a+{-# INLINE_STREAM modifyWithStream #-}+modifyWithStream f (New p) s = s `seq` New (do { v <- p; f v s; return v }) -unstream :: Vector v a => Bundle v a -> New v a-{-# INLINE_FUSED unstream #-}-unstream s = s `seq` New (MVector.vunstream s)+unstream :: Vector v a => Stream a -> New v a+{-# INLINE_STREAM unstream #-}+unstream s = s `seq` New (MVector.unstream s) -transform- :: Vector v a => (forall m. Monad m => Stream m a -> Stream m a)- -> (Size -> Size) -> New v a -> New v a-{-# INLINE_FUSED transform #-}-transform f g (New p) = New (MVector.transform f =<< p)+transform :: Vector v a =>+ (forall m. Monad m => MStream m a -> MStream m a) -> New v a -> New v a+{-# INLINE_STREAM transform #-}+transform f (New p) = New (MVector.transform f =<< p) {-# RULES "transform/transform [New]"- forall (f1 :: forall m. Monad m => Stream m a -> Stream m a)- (f2 :: forall m. Monad m => Stream m a -> Stream m a)- g1 g2 p .- transform f1 g1 (transform f2 g2 p) = transform (f1 . f2) (g1 . g2) p+ forall (f :: forall m. Monad m => MStream m a -> MStream m a)+ (g :: forall m. Monad m => MStream m a -> MStream m a)+ p .+ transform f (transform g p) = transform (f . g) p "transform/unstream [New]"- forall (f :: forall m. Monad m => Stream m a -> Stream m a)- g s.- transform f g (unstream s) = unstream (Bundle.inplace f g s)+ forall (f :: forall m. Monad m => MStream m a -> MStream m a)+ s.+ transform f (unstream s) = unstream (f s) #-} -unstreamR :: Vector v a => Bundle v a -> New v a-{-# INLINE_FUSED unstreamR #-}+unstreamR :: Vector v a => Stream a -> New v a+{-# INLINE_STREAM unstreamR #-} unstreamR s = s `seq` New (MVector.unstreamR s) -transformR- :: Vector v a => (forall m. Monad m => Stream m a -> Stream m a)- -> (Size -> Size) -> New v a -> New v a-{-# INLINE_FUSED transformR #-}-transformR f g (New p) = New (MVector.transformR f =<< p)+transformR :: Vector v a =>+ (forall m. Monad m => MStream m a -> MStream m a) -> New v a -> New v a+{-# INLINE_STREAM transformR #-}+transformR f (New p) = New (MVector.transformR f =<< p) {-# RULES "transformR/transformR [New]"- forall (f1 :: forall m. Monad m => Stream m a -> Stream m a)- (f2 :: forall m. Monad m => Stream m a -> Stream m a)- g1 g2+ forall (f :: forall m. Monad m => MStream m a -> MStream m a)+ (g :: forall m. Monad m => MStream m a -> MStream m a) p .- transformR f1 g1 (transformR f2 g2 p) = transformR (f1 . f2) (g1 . g2) p+ transformR f (transformR g p) = transformR (f . g) p "transformR/unstreamR [New]"- forall (f :: forall m. Monad m => Stream m a -> Stream m a)- g s.- transformR f g (unstreamR s) = unstreamR (Bundle.inplace f g s)+ forall (f :: forall m. Monad m => MStream m a -> MStream m a)+ s.+ transformR f (unstreamR s) = unstreamR (f s) #-} slice :: Vector v a => Int -> Int -> New v a -> New v a-{-# INLINE_FUSED slice #-}+{-# INLINE_STREAM slice #-} slice i n m = apply (MVector.slice i n) m init :: Vector v a => New v a -> New v a-{-# INLINE_FUSED init #-}+{-# INLINE_STREAM init #-} init m = apply MVector.init m tail :: Vector v a => New v a -> New v a-{-# INLINE_FUSED tail #-}+{-# INLINE_STREAM tail #-} tail m = apply MVector.tail m take :: Vector v a => Int -> New v a -> New v a-{-# INLINE_FUSED take #-}+{-# INLINE_STREAM take #-} take n m = apply (MVector.take n) m drop :: Vector v a => Int -> New v a -> New v a-{-# INLINE_FUSED drop #-}+{-# INLINE_STREAM drop #-} drop n m = apply (MVector.drop n) m unsafeSlice :: Vector v a => Int -> Int -> New v a -> New v a-{-# INLINE_FUSED unsafeSlice #-}+{-# INLINE_STREAM unsafeSlice #-} unsafeSlice i n m = apply (MVector.unsafeSlice i n) m unsafeInit :: Vector v a => New v a -> New v a-{-# INLINE_FUSED unsafeInit #-}+{-# INLINE_STREAM unsafeInit #-} unsafeInit m = apply MVector.unsafeInit m unsafeTail :: Vector v a => New v a -> New v a-{-# INLINE_FUSED unsafeTail #-}+{-# INLINE_STREAM unsafeTail #-} unsafeTail m = apply MVector.unsafeTail m {-# RULES "slice/unstream [New]" forall i n s.- slice i n (unstream s) = unstream (Bundle.slice i n s)+ slice i n (unstream s) = unstream (Stream.slice i n s) "init/unstream [New]" forall s.- init (unstream s) = unstream (Bundle.init s)+ init (unstream s) = unstream (Stream.init s) "tail/unstream [New]" forall s.- tail (unstream s) = unstream (Bundle.tail s)+ tail (unstream s) = unstream (Stream.tail s) "take/unstream [New]" forall n s.- take n (unstream s) = unstream (Bundle.take n s)+ take n (unstream s) = unstream (Stream.take n s) "drop/unstream [New]" forall n s.- drop n (unstream s) = unstream (Bundle.drop n s)+ drop n (unstream s) = unstream (Stream.drop n s) "unsafeSlice/unstream [New]" forall i n s.- unsafeSlice i n (unstream s) = unstream (Bundle.slice i n s)+ unsafeSlice i n (unstream s) = unstream (Stream.slice i n s) "unsafeInit/unstream [New]" forall s.- unsafeInit (unstream s) = unstream (Bundle.init s)+ unsafeInit (unstream s) = unstream (Stream.init s) "unsafeTail/unstream [New]" forall s.- unsafeTail (unstream s) = unstream (Bundle.tail s)+ unsafeTail (unstream s) = unstream (Stream.tail s) #-}
Data/Vector/Primitive.hs view
@@ -136,7 +136,7 @@ import qualified Data.Vector.Generic as G import Data.Vector.Primitive.Mutable ( MVector(..) )-import qualified Data.Vector.Fusion.Bundle as Bundle+import qualified Data.Vector.Fusion.Stream as Stream import Data.Primitive.ByteArray import Data.Primitive ( Prim, sizeOf ) @@ -223,27 +223,27 @@ -- See http://trac.haskell.org/vector/ticket/12 instance (Prim a, Eq a) => Eq (Vector a) where {-# INLINE (==) #-}- xs == ys = Bundle.eq (G.stream xs) (G.stream ys)+ xs == ys = Stream.eq (G.stream xs) (G.stream ys) {-# INLINE (/=) #-}- xs /= ys = not (Bundle.eq (G.stream xs) (G.stream ys))+ xs /= ys = not (Stream.eq (G.stream xs) (G.stream ys)) -- See http://trac.haskell.org/vector/ticket/12 instance (Prim a, Ord a) => Ord (Vector a) where {-# INLINE compare #-}- compare xs ys = Bundle.cmp (G.stream xs) (G.stream ys)+ compare xs ys = Stream.cmp (G.stream xs) (G.stream ys) {-# INLINE (<) #-}- xs < ys = Bundle.cmp (G.stream xs) (G.stream ys) == LT+ xs < ys = Stream.cmp (G.stream xs) (G.stream ys) == LT {-# INLINE (<=) #-}- xs <= ys = Bundle.cmp (G.stream xs) (G.stream ys) /= GT+ xs <= ys = Stream.cmp (G.stream xs) (G.stream ys) /= GT {-# INLINE (>) #-}- xs > ys = Bundle.cmp (G.stream xs) (G.stream ys) == GT+ xs > ys = Stream.cmp (G.stream xs) (G.stream ys) == GT {-# INLINE (>=) #-}- xs >= ys = Bundle.cmp (G.stream xs) (G.stream ys) /= LT+ xs >= ys = Stream.cmp (G.stream xs) (G.stream ys) /= LT instance Prim a => Monoid (Vector a) where {-# INLINE mempty #-}
Data/Vector/Storable.hs view
@@ -139,7 +139,7 @@ import qualified Data.Vector.Generic as G import Data.Vector.Storable.Mutable ( MVector(..) ) import Data.Vector.Storable.Internal-import qualified Data.Vector.Fusion.Bundle as Bundle+import qualified Data.Vector.Fusion.Stream as Stream import Foreign.Storable import Foreign.ForeignPtr@@ -230,27 +230,27 @@ -- See http://trac.haskell.org/vector/ticket/12 instance (Storable a, Eq a) => Eq (Vector a) where {-# INLINE (==) #-}- xs == ys = Bundle.eq (G.stream xs) (G.stream ys)+ xs == ys = Stream.eq (G.stream xs) (G.stream ys) {-# INLINE (/=) #-}- xs /= ys = not (Bundle.eq (G.stream xs) (G.stream ys))+ xs /= ys = not (Stream.eq (G.stream xs) (G.stream ys)) -- See http://trac.haskell.org/vector/ticket/12 instance (Storable a, Ord a) => Ord (Vector a) where {-# INLINE compare #-}- compare xs ys = Bundle.cmp (G.stream xs) (G.stream ys)+ compare xs ys = Stream.cmp (G.stream xs) (G.stream ys) {-# INLINE (<) #-}- xs < ys = Bundle.cmp (G.stream xs) (G.stream ys) == LT+ xs < ys = Stream.cmp (G.stream xs) (G.stream ys) == LT {-# INLINE (<=) #-}- xs <= ys = Bundle.cmp (G.stream xs) (G.stream ys) /= GT+ xs <= ys = Stream.cmp (G.stream xs) (G.stream ys) /= GT {-# INLINE (>) #-}- xs > ys = Bundle.cmp (G.stream xs) (G.stream ys) == GT+ xs > ys = Stream.cmp (G.stream xs) (G.stream ys) == GT {-# INLINE (>=) #-}- xs >= ys = Bundle.cmp (G.stream xs) (G.stream ys) /= LT+ xs >= ys = Stream.cmp (G.stream xs) (G.stream ys) /= LT instance Storable a => Monoid (Vector a) where {-# INLINE mempty #-}
Data/Vector/Unboxed.hs view
@@ -163,7 +163,7 @@ import Data.Vector.Unboxed.Base import qualified Data.Vector.Generic as G-import qualified Data.Vector.Fusion.Bundle as Bundle+import qualified Data.Vector.Fusion.Stream as Stream import Data.Vector.Fusion.Util ( delayed_min ) import Control.Monad.ST ( ST )@@ -193,27 +193,27 @@ -- See http://trac.haskell.org/vector/ticket/12 instance (Unbox a, Eq a) => Eq (Vector a) where {-# INLINE (==) #-}- xs == ys = Bundle.eq (G.stream xs) (G.stream ys)+ xs == ys = Stream.eq (G.stream xs) (G.stream ys) {-# INLINE (/=) #-}- xs /= ys = not (Bundle.eq (G.stream xs) (G.stream ys))+ xs /= ys = not (Stream.eq (G.stream xs) (G.stream ys)) -- See http://trac.haskell.org/vector/ticket/12 instance (Unbox a, Ord a) => Ord (Vector a) where {-# INLINE compare #-}- compare xs ys = Bundle.cmp (G.stream xs) (G.stream ys)+ compare xs ys = Stream.cmp (G.stream xs) (G.stream ys) {-# INLINE (<) #-}- xs < ys = Bundle.cmp (G.stream xs) (G.stream ys) == LT+ xs < ys = Stream.cmp (G.stream xs) (G.stream ys) == LT {-# INLINE (<=) #-}- xs <= ys = Bundle.cmp (G.stream xs) (G.stream ys) /= GT+ xs <= ys = Stream.cmp (G.stream xs) (G.stream ys) /= GT {-# INLINE (>) #-}- xs > ys = Bundle.cmp (G.stream xs) (G.stream ys) == GT+ xs > ys = Stream.cmp (G.stream xs) (G.stream ys) == GT {-# INLINE (>=) #-}- xs >= ys = Bundle.cmp (G.stream xs) (G.stream ys) /= LT+ xs >= ys = Stream.cmp (G.stream xs) (G.stream ys) /= LT instance Unbox a => Monoid (Vector a) where {-# INLINE mempty #-}
benchmarks/vector-benchmarks.cabal view
@@ -1,5 +1,5 @@ Name: vector-benchmarks-Version: 0.10.9+Version: 0.10.0.1 License: BSD3 License-File: LICENSE Author: Roman Leshchinskiy <rl@cse.unsw.edu.au>@@ -14,7 +14,7 @@ Build-Depends: base >= 2 && < 5, array, criterion >= 0.5 && < 0.7, mwc-random >= 0.5 && < 0.13,- vector == 0.10.9+ vector == 0.10.0.1 if impl(ghc<6.13) Ghc-Options: -finline-if-enough-args -fno-method-sharing
include/vector.h view
@@ -1,8 +1,8 @@-#define PHASE_FUSED [1]-#define PHASE_INNER [0]+#define PHASE_STREAM [1]+#define PHASE_INNER [0] -#define INLINE_FUSED INLINE PHASE_FUSED-#define INLINE_INNER INLINE PHASE_INNER+#define INLINE_STREAM INLINE PHASE_STREAM+#define INLINE_INNER INLINE PHASE_INNER #ifndef NOT_VECTOR_MODULE import qualified Data.Vector.Internal.Check as Ck@@ -16,6 +16,4 @@ #define UNSAFE_CHECK(f) (CHECK(f) Ck.Unsafe) #define INTERNAL_CHECK(f) (CHECK(f) Ck.Internal) -#define PHASE_STREAM Please use "PHASE_FUSED" instead-#define INLINE_STREAM Please use "INLINE_FUSED" instead
internal/GenUnboxTuple.hs view
@@ -59,7 +59,7 @@ <+> sep (punctuate (text " ->") [text ty <+> v | v <- vars]) <+> text "->" <+> text ty <+> tuple vars- ,text "{-# INLINE_FUSED" <+> name <+> text "#-}"+ ,text "{-# INLINE_STREAM" <+> name <+> text "#-}" ,name <+> sep varss <+> text "=" <+> con c@@ -84,7 +84,7 @@ 2 $ text "G.stream" <+> parens (name "zip" <+> sep varss) <+> char '='- <+> text "Bundle." <> name "zipWith" <+> tuple (replicate n empty)+ <+> text "Stream." <> name "zipWith" <+> tuple (replicate n empty) <+> sep [parens $ text "G.stream" <+> vs | vs <- varss] $$ text "#-}" where
internal/unbox-tuple-instances view
@@ -105,7 +105,7 @@ -- | /O(1)/ Zip 2 vectors zip :: (Unbox a, Unbox b) => MVector s a -> MVector s b -> MVector s (a, b)-{-# INLINE_FUSED zip #-}+{-# INLINE_STREAM zip #-} zip as bs = MV_2 len (unsafeSlice 0 len as) (unsafeSlice 0 len bs) where len = length as `delayed_min` length bs -- | /O(1)/ Unzip 2 vectors@@ -117,11 +117,11 @@ #ifdef DEFINE_IMMUTABLE -- | /O(1)/ Zip 2 vectors zip :: (Unbox a, Unbox b) => Vector a -> Vector b -> Vector (a, b)-{-# INLINE_FUSED zip #-}+{-# INLINE_STREAM zip #-} zip as bs = V_2 len (unsafeSlice 0 len as) (unsafeSlice 0 len bs) where len = length as `delayed_min` length bs {-# RULES "stream/zip [Vector.Unboxed]" forall as bs .- G.stream (zip as bs) = Bundle.zipWith (,) (G.stream as)+ G.stream (zip as bs) = Stream.zipWith (,) (G.stream as) (G.stream bs) #-} -- | /O(1)/ Unzip 2 vectors@@ -261,7 +261,7 @@ zip3 :: (Unbox a, Unbox b, Unbox c) => MVector s a -> MVector s b -> MVector s c -> MVector s (a, b, c)-{-# INLINE_FUSED zip3 #-}+{-# INLINE_STREAM zip3 #-} zip3 as bs cs = MV_3 len (unsafeSlice 0 len as) (unsafeSlice 0 len bs) (unsafeSlice 0 len cs)@@ -281,14 +281,14 @@ zip3 :: (Unbox a, Unbox b, Unbox c) => Vector a -> Vector b -> Vector c -> Vector (a, b, c)-{-# INLINE_FUSED zip3 #-}+{-# INLINE_STREAM zip3 #-} zip3 as bs cs = V_3 len (unsafeSlice 0 len as) (unsafeSlice 0 len bs) (unsafeSlice 0 len cs) where len = length as `delayed_min` length bs `delayed_min` length cs {-# RULES "stream/zip3 [Vector.Unboxed]" forall as bs cs .- G.stream (zip3 as bs cs) = Bundle.zipWith3 (, ,) (G.stream as)+ G.stream (zip3 as bs cs) = Stream.zipWith3 (, ,) (G.stream as) (G.stream bs) (G.stream cs) #-}@@ -461,7 +461,7 @@ MVector s b -> MVector s c -> MVector s d -> MVector s (a, b, c, d)-{-# INLINE_FUSED zip4 #-}+{-# INLINE_STREAM zip4 #-} zip4 as bs cs ds = MV_4 len (unsafeSlice 0 len as) (unsafeSlice 0 len bs) (unsafeSlice 0 len cs)@@ -488,7 +488,7 @@ Vector b -> Vector c -> Vector d -> Vector (a, b, c, d)-{-# INLINE_FUSED zip4 #-}+{-# INLINE_STREAM zip4 #-} zip4 as bs cs ds = V_4 len (unsafeSlice 0 len as) (unsafeSlice 0 len bs) (unsafeSlice 0 len cs)@@ -499,7 +499,7 @@ length cs `delayed_min` length ds {-# RULES "stream/zip4 [Vector.Unboxed]" forall as bs cs ds .- G.stream (zip4 as bs cs ds) = Bundle.zipWith4 (, , ,) (G.stream as)+ G.stream (zip4 as bs cs ds) = Stream.zipWith4 (, , ,) (G.stream as) (G.stream bs) (G.stream cs) (G.stream ds)@@ -714,7 +714,7 @@ MVector s c -> MVector s d -> MVector s e -> MVector s (a, b, c, d, e)-{-# INLINE_FUSED zip5 #-}+{-# INLINE_STREAM zip5 #-} zip5 as bs cs ds es = MV_5 len (unsafeSlice 0 len as) (unsafeSlice 0 len bs) (unsafeSlice 0 len cs)@@ -750,7 +750,7 @@ Vector c -> Vector d -> Vector e -> Vector (a, b, c, d, e)-{-# INLINE_FUSED zip5 #-}+{-# INLINE_STREAM zip5 #-} zip5 as bs cs ds es = V_5 len (unsafeSlice 0 len as) (unsafeSlice 0 len bs) (unsafeSlice 0 len cs)@@ -767,7 +767,7 @@ bs cs ds- es) = Bundle.zipWith5 (, , , ,) (G.stream as)+ es) = Stream.zipWith5 (, , , ,) (G.stream as) (G.stream bs) (G.stream cs) (G.stream ds)@@ -1013,7 +1013,7 @@ MVector s d -> MVector s e -> MVector s f -> MVector s (a, b, c, d, e, f)-{-# INLINE_FUSED zip6 #-}+{-# INLINE_STREAM zip6 #-} zip6 as bs cs ds es fs = MV_6 len (unsafeSlice 0 len as) (unsafeSlice 0 len bs) (unsafeSlice 0 len cs)@@ -1055,7 +1055,7 @@ Vector d -> Vector e -> Vector f -> Vector (a, b, c, d, e, f)-{-# INLINE_FUSED zip6 #-}+{-# INLINE_STREAM zip6 #-} zip6 as bs cs ds es fs = V_6 len (unsafeSlice 0 len as) (unsafeSlice 0 len bs) (unsafeSlice 0 len cs)@@ -1075,7 +1075,7 @@ cs ds es- fs) = Bundle.zipWith6 (, , , , ,) (G.stream as)+ fs) = Stream.zipWith6 (, , , , ,) (G.stream as) (G.stream bs) (G.stream cs) (G.stream ds)
tests/Main.hs view
@@ -1,12 +1,12 @@ module Main (main) where import qualified Tests.Vector-import qualified Tests.Bundle+import qualified Tests.Stream import qualified Tests.Move import Test.Framework (defaultMain) -main = defaultMain $ Tests.Bundle.tests+main = defaultMain $ Tests.Stream.tests ++ Tests.Vector.tests ++ Tests.Move.tests
− tests/Tests/Bundle.hs
@@ -1,163 +0,0 @@-module Tests.Bundle ( tests ) where--import Boilerplater-import Utilities--import qualified Data.Vector.Fusion.Bundle as S--import Test.QuickCheck--import Test.Framework-import Test.Framework.Providers.QuickCheck2--import Text.Show.Functions ()-import Data.List (foldl', foldl1', unfoldr, find, findIndex)-import System.Random (Random)--#define COMMON_CONTEXT(a) \- VANILLA_CONTEXT(a)--#define VANILLA_CONTEXT(a) \- Eq a, Show a, Arbitrary a, CoArbitrary a, TestData a, Model a ~ a, EqTest a ~ Property--testSanity :: forall v a. (COMMON_CONTEXT(a)) => S.Bundle v a -> [Test]-testSanity _ = [- testProperty "fromList.toList == id" prop_fromList_toList,- testProperty "toList.fromList == id" prop_toList_fromList- ]- where- prop_fromList_toList :: P (S.Bundle v a -> S.Bundle v a)- = (S.fromList . S.toList) `eq` id- prop_toList_fromList :: P ([a] -> [a])- = (S.toList . (S.fromList :: [a] -> S.Bundle v a)) `eq` id--testPolymorphicFunctions :: forall v a. (COMMON_CONTEXT(a)) => S.Bundle v a -> [Test]-testPolymorphicFunctions _ = $(testProperties [- 'prop_eq,-- 'prop_length, 'prop_null,-- 'prop_empty, 'prop_singleton, 'prop_replicate,- 'prop_cons, 'prop_snoc, 'prop_append,-- 'prop_head, 'prop_last, 'prop_index,-- 'prop_extract, 'prop_init, 'prop_tail, 'prop_take, 'prop_drop,-- 'prop_map, 'prop_zipWith, 'prop_zipWith3,- 'prop_filter, 'prop_takeWhile, 'prop_dropWhile,-- 'prop_elem, 'prop_notElem,- 'prop_find, 'prop_findIndex,-- 'prop_foldl, 'prop_foldl1, 'prop_foldl', 'prop_foldl1',- 'prop_foldr, 'prop_foldr1,-- 'prop_prescanl, 'prop_prescanl',- 'prop_postscanl, 'prop_postscanl',- 'prop_scanl, 'prop_scanl', 'prop_scanl1, 'prop_scanl1',-- 'prop_concatMap,- 'prop_unfoldr- ])- where- -- Prelude- prop_eq :: P (S.Bundle v a -> S.Bundle v a -> Bool) = (==) `eq` (==)-- prop_length :: P (S.Bundle v a -> Int) = S.length `eq` length- prop_null :: P (S.Bundle v a -> Bool) = S.null `eq` null- prop_empty :: P (S.Bundle v a) = S.empty `eq` []- prop_singleton :: P (a -> S.Bundle v a) = S.singleton `eq` singleton- prop_replicate :: P (Int -> a -> S.Bundle v a)- = (\n _ -> n < 1000) ===> S.replicate `eq` replicate- prop_cons :: P (a -> S.Bundle v a -> S.Bundle v a) = S.cons `eq` (:)- prop_snoc :: P (S.Bundle v a -> a -> S.Bundle v a) = S.snoc `eq` snoc- prop_append :: P (S.Bundle v a -> S.Bundle v a -> S.Bundle v a) = (S.++) `eq` (++)-- prop_head :: P (S.Bundle v a -> a) = not . S.null ===> S.head `eq` head- prop_last :: P (S.Bundle v a -> a) = not . S.null ===> S.last `eq` last- prop_index = \xs ->- not (S.null xs) ==>- forAll (choose (0, S.length xs-1)) $ \i ->- unP prop xs i- where- prop :: P (S.Bundle v a -> Int -> a) = (S.!!) `eq` (!!)-- prop_extract = \xs ->- forAll (choose (0, S.length xs)) $ \i ->- forAll (choose (0, S.length xs - i)) $ \n ->- unP prop i n xs- where- prop :: P (Int -> Int -> S.Bundle v a -> S.Bundle v a) = S.slice `eq` slice-- prop_tail :: P (S.Bundle v a -> S.Bundle v a) = not . S.null ===> S.tail `eq` tail- prop_init :: P (S.Bundle v a -> S.Bundle v a) = not . S.null ===> S.init `eq` init- prop_take :: P (Int -> S.Bundle v a -> S.Bundle v a) = S.take `eq` take- prop_drop :: P (Int -> S.Bundle v a -> S.Bundle v a) = S.drop `eq` drop-- prop_map :: P ((a -> a) -> S.Bundle v a -> S.Bundle v a) = S.map `eq` map- prop_zipWith :: P ((a -> a -> a) -> S.Bundle v a -> S.Bundle v a -> S.Bundle v a) = S.zipWith `eq` zipWith- prop_zipWith3 :: P ((a -> a -> a -> a) -> S.Bundle v a -> S.Bundle v a -> S.Bundle v a -> S.Bundle v a)- = S.zipWith3 `eq` zipWith3-- prop_filter :: P ((a -> Bool) -> S.Bundle v a -> S.Bundle v a) = S.filter `eq` filter- prop_takeWhile :: P ((a -> Bool) -> S.Bundle v a -> S.Bundle v a) = S.takeWhile `eq` takeWhile- prop_dropWhile :: P ((a -> Bool) -> S.Bundle v a -> S.Bundle v a) = S.dropWhile `eq` dropWhile-- prop_elem :: P (a -> S.Bundle v a -> Bool) = S.elem `eq` elem- prop_notElem :: P (a -> S.Bundle v a -> Bool) = S.notElem `eq` notElem- prop_find :: P ((a -> Bool) -> S.Bundle v a -> Maybe a) = S.find `eq` find- prop_findIndex :: P ((a -> Bool) -> S.Bundle v a -> Maybe Int)- = S.findIndex `eq` findIndex-- prop_foldl :: P ((a -> a -> a) -> a -> S.Bundle v a -> a) = S.foldl `eq` foldl- prop_foldl1 :: P ((a -> a -> a) -> S.Bundle v a -> a) = notNullS2 ===>- S.foldl1 `eq` foldl1- prop_foldl' :: P ((a -> a -> a) -> a -> S.Bundle v a -> a) = S.foldl' `eq` foldl'- prop_foldl1' :: P ((a -> a -> a) -> S.Bundle v a -> a) = notNullS2 ===>- S.foldl1' `eq` foldl1'- prop_foldr :: P ((a -> a -> a) -> a -> S.Bundle v a -> a) = S.foldr `eq` foldr- prop_foldr1 :: P ((a -> a -> a) -> S.Bundle v a -> a) = notNullS2 ===>- S.foldr1 `eq` foldr1-- prop_prescanl :: P ((a -> a -> a) -> a -> S.Bundle v a -> S.Bundle v a)- = S.prescanl `eq` prescanl- prop_prescanl' :: P ((a -> a -> a) -> a -> S.Bundle v a -> S.Bundle v a)- = S.prescanl' `eq` prescanl- prop_postscanl :: P ((a -> a -> a) -> a -> S.Bundle v a -> S.Bundle v a)- = S.postscanl `eq` postscanl- prop_postscanl' :: P ((a -> a -> a) -> a -> S.Bundle v a -> S.Bundle v a)- = S.postscanl' `eq` postscanl- prop_scanl :: P ((a -> a -> a) -> a -> S.Bundle v a -> S.Bundle v a)- = S.scanl `eq` scanl- prop_scanl' :: P ((a -> a -> a) -> a -> S.Bundle v a -> S.Bundle v a)- = S.scanl' `eq` scanl- prop_scanl1 :: P ((a -> a -> a) -> S.Bundle v a -> S.Bundle v a) = notNullS2 ===>- S.scanl1 `eq` scanl1- prop_scanl1' :: P ((a -> a -> a) -> S.Bundle v a -> S.Bundle v a) = notNullS2 ===>- S.scanl1' `eq` scanl1- - prop_concatMap = forAll arbitrary $ \xs ->- forAll (sized (\n -> resize (n `div` S.length xs) arbitrary)) $ \f -> unP prop f xs- where- prop :: P ((a -> S.Bundle v a) -> S.Bundle v a -> S.Bundle v a) = S.concatMap `eq` concatMap-- limitUnfolds f (theirs, ours) | ours >= 0- , Just (out, theirs') <- f theirs = Just (out, (theirs', ours - 1))- | otherwise = Nothing- prop_unfoldr :: P (Int -> (Int -> Maybe (a,Int)) -> Int -> S.Bundle v a)- = (\n f a -> S.unfoldr (limitUnfolds f) (a, n))- `eq` (\n f a -> unfoldr (limitUnfolds f) (a, n))--testBoolFunctions :: forall v. S.Bundle v Bool -> [Test]-testBoolFunctions _ = $(testProperties ['prop_and, 'prop_or ])- where- prop_and :: P (S.Bundle v Bool -> Bool) = S.and `eq` and- prop_or :: P (S.Bundle v Bool -> Bool) = S.or `eq` or--testBundleFunctions = testSanity (undefined :: S.Bundle v Int)- ++ testPolymorphicFunctions (undefined :: S.Bundle v Int)- ++ testBoolFunctions (undefined :: S.Bundle v Bool)--tests = [ testGroup "Data.Vector.Fusion.Bundle" testBundleFunctions ]-
+ tests/Tests/Stream.hs view
@@ -0,0 +1,163 @@+module Tests.Stream ( tests ) where++import Boilerplater+import Utilities++import qualified Data.Vector.Fusion.Stream as S++import Test.QuickCheck++import Test.Framework+import Test.Framework.Providers.QuickCheck2++import Text.Show.Functions ()+import Data.List (foldl', foldl1', unfoldr, find, findIndex)+import System.Random (Random)++#define COMMON_CONTEXT(a) \+ VANILLA_CONTEXT(a)++#define VANILLA_CONTEXT(a) \+ Eq a, Show a, Arbitrary a, CoArbitrary a, TestData a, Model a ~ a, EqTest a ~ Property++testSanity :: forall a. (COMMON_CONTEXT(a)) => S.Stream a -> [Test]+testSanity _ = [+ testProperty "fromList.toList == id" prop_fromList_toList,+ testProperty "toList.fromList == id" prop_toList_fromList+ ]+ where+ prop_fromList_toList :: P (S.Stream a -> S.Stream a)+ = (S.fromList . S.toList) `eq` id+ prop_toList_fromList :: P ([a] -> [a])+ = (S.toList . (S.fromList :: [a] -> S.Stream a)) `eq` id++testPolymorphicFunctions :: forall a. (COMMON_CONTEXT(a)) => S.Stream a -> [Test]+testPolymorphicFunctions _ = $(testProperties [+ 'prop_eq,++ 'prop_length, 'prop_null,++ 'prop_empty, 'prop_singleton, 'prop_replicate,+ 'prop_cons, 'prop_snoc, 'prop_append,++ 'prop_head, 'prop_last, 'prop_index,++ 'prop_extract, 'prop_init, 'prop_tail, 'prop_take, 'prop_drop,++ 'prop_map, 'prop_zipWith, 'prop_zipWith3,+ 'prop_filter, 'prop_takeWhile, 'prop_dropWhile,++ 'prop_elem, 'prop_notElem,+ 'prop_find, 'prop_findIndex,++ 'prop_foldl, 'prop_foldl1, 'prop_foldl', 'prop_foldl1',+ 'prop_foldr, 'prop_foldr1,++ 'prop_prescanl, 'prop_prescanl',+ 'prop_postscanl, 'prop_postscanl',+ 'prop_scanl, 'prop_scanl', 'prop_scanl1, 'prop_scanl1',++ 'prop_concatMap,+ 'prop_unfoldr+ ])+ where+ -- Prelude+ prop_eq :: P (S.Stream a -> S.Stream a -> Bool) = (==) `eq` (==)++ prop_length :: P (S.Stream a -> Int) = S.length `eq` length+ prop_null :: P (S.Stream a -> Bool) = S.null `eq` null+ prop_empty :: P (S.Stream a) = S.empty `eq` []+ prop_singleton :: P (a -> S.Stream a) = S.singleton `eq` singleton+ prop_replicate :: P (Int -> a -> S.Stream a)+ = (\n _ -> n < 1000) ===> S.replicate `eq` replicate+ prop_cons :: P (a -> S.Stream a -> S.Stream a) = S.cons `eq` (:)+ prop_snoc :: P (S.Stream a -> a -> S.Stream a) = S.snoc `eq` snoc+ prop_append :: P (S.Stream a -> S.Stream a -> S.Stream a) = (S.++) `eq` (++)++ prop_head :: P (S.Stream a -> a) = not . S.null ===> S.head `eq` head+ prop_last :: P (S.Stream a -> a) = not . S.null ===> S.last `eq` last+ prop_index = \xs ->+ not (S.null xs) ==>+ forAll (choose (0, S.length xs-1)) $ \i ->+ unP prop xs i+ where+ prop :: P (S.Stream a -> Int -> a) = (S.!!) `eq` (!!)++ prop_extract = \xs ->+ forAll (choose (0, S.length xs)) $ \i ->+ forAll (choose (0, S.length xs - i)) $ \n ->+ unP prop i n xs+ where+ prop :: P (Int -> Int -> S.Stream a -> S.Stream a) = S.slice `eq` slice++ prop_tail :: P (S.Stream a -> S.Stream a) = not . S.null ===> S.tail `eq` tail+ prop_init :: P (S.Stream a -> S.Stream a) = not . S.null ===> S.init `eq` init+ prop_take :: P (Int -> S.Stream a -> S.Stream a) = S.take `eq` take+ prop_drop :: P (Int -> S.Stream a -> S.Stream a) = S.drop `eq` drop++ prop_map :: P ((a -> a) -> S.Stream a -> S.Stream a) = S.map `eq` map+ prop_zipWith :: P ((a -> a -> a) -> S.Stream a -> S.Stream a -> S.Stream a) = S.zipWith `eq` zipWith+ prop_zipWith3 :: P ((a -> a -> a -> a) -> S.Stream a -> S.Stream a -> S.Stream a -> S.Stream a)+ = S.zipWith3 `eq` zipWith3++ prop_filter :: P ((a -> Bool) -> S.Stream a -> S.Stream a) = S.filter `eq` filter+ prop_takeWhile :: P ((a -> Bool) -> S.Stream a -> S.Stream a) = S.takeWhile `eq` takeWhile+ prop_dropWhile :: P ((a -> Bool) -> S.Stream a -> S.Stream a) = S.dropWhile `eq` dropWhile++ prop_elem :: P (a -> S.Stream a -> Bool) = S.elem `eq` elem+ prop_notElem :: P (a -> S.Stream a -> Bool) = S.notElem `eq` notElem+ prop_find :: P ((a -> Bool) -> S.Stream a -> Maybe a) = S.find `eq` find+ prop_findIndex :: P ((a -> Bool) -> S.Stream a -> Maybe Int)+ = S.findIndex `eq` findIndex++ prop_foldl :: P ((a -> a -> a) -> a -> S.Stream a -> a) = S.foldl `eq` foldl+ prop_foldl1 :: P ((a -> a -> a) -> S.Stream a -> a) = notNullS2 ===>+ S.foldl1 `eq` foldl1+ prop_foldl' :: P ((a -> a -> a) -> a -> S.Stream a -> a) = S.foldl' `eq` foldl'+ prop_foldl1' :: P ((a -> a -> a) -> S.Stream a -> a) = notNullS2 ===>+ S.foldl1' `eq` foldl1'+ prop_foldr :: P ((a -> a -> a) -> a -> S.Stream a -> a) = S.foldr `eq` foldr+ prop_foldr1 :: P ((a -> a -> a) -> S.Stream a -> a) = notNullS2 ===>+ S.foldr1 `eq` foldr1++ prop_prescanl :: P ((a -> a -> a) -> a -> S.Stream a -> S.Stream a)+ = S.prescanl `eq` prescanl+ prop_prescanl' :: P ((a -> a -> a) -> a -> S.Stream a -> S.Stream a)+ = S.prescanl' `eq` prescanl+ prop_postscanl :: P ((a -> a -> a) -> a -> S.Stream a -> S.Stream a)+ = S.postscanl `eq` postscanl+ prop_postscanl' :: P ((a -> a -> a) -> a -> S.Stream a -> S.Stream a)+ = S.postscanl' `eq` postscanl+ prop_scanl :: P ((a -> a -> a) -> a -> S.Stream a -> S.Stream a)+ = S.scanl `eq` scanl+ prop_scanl' :: P ((a -> a -> a) -> a -> S.Stream a -> S.Stream a)+ = S.scanl' `eq` scanl+ prop_scanl1 :: P ((a -> a -> a) -> S.Stream a -> S.Stream a) = notNullS2 ===>+ S.scanl1 `eq` scanl1+ prop_scanl1' :: P ((a -> a -> a) -> S.Stream a -> S.Stream a) = notNullS2 ===>+ S.scanl1' `eq` scanl1+ + prop_concatMap = forAll arbitrary $ \xs ->+ forAll (sized (\n -> resize (n `div` S.length xs) arbitrary)) $ \f -> unP prop f xs+ where+ prop :: P ((a -> S.Stream a) -> S.Stream a -> S.Stream a) = S.concatMap `eq` concatMap++ limitUnfolds f (theirs, ours) | ours >= 0+ , Just (out, theirs') <- f theirs = Just (out, (theirs', ours - 1))+ | otherwise = Nothing+ prop_unfoldr :: P (Int -> (Int -> Maybe (a,Int)) -> Int -> S.Stream a)+ = (\n f a -> S.unfoldr (limitUnfolds f) (a, n))+ `eq` (\n f a -> unfoldr (limitUnfolds f) (a, n))++testBoolFunctions :: [Test]+testBoolFunctions = $(testProperties ['prop_and, 'prop_or])+ where+ prop_and :: P (S.Stream Bool -> Bool) = S.and `eq` and+ prop_or :: P (S.Stream Bool -> Bool) = S.or `eq` or++testStreamFunctions = testSanity (undefined :: S.Stream Int)+ ++ testPolymorphicFunctions (undefined :: S.Stream Int)+ ++ testBoolFunctions++tests = [ testGroup "Data.Vector.Fusion.Stream" testStreamFunctions ]+
tests/Tests/Vector.hs view
@@ -8,7 +8,7 @@ import qualified Data.Vector.Primitive import qualified Data.Vector.Storable import qualified Data.Vector.Unboxed-import qualified Data.Vector.Fusion.Bundle as S+import qualified Data.Vector.Fusion.Stream as S import Test.QuickCheck @@ -74,7 +74,7 @@ prop_fromList_toList (v :: v a) = (V.fromList . V.toList) v == v prop_toList_fromList (l :: [a]) = ((V.toList :: v a -> [a]) . V.fromList) l == l prop_unstream_stream (v :: v a) = (V.unstream . V.stream) v == v- prop_stream_unstream (s :: S.Bundle v a) = ((V.stream :: v a -> S.Bundle v a) . V.unstream) s == s+ prop_stream_unstream (s :: S.Stream a) = ((V.stream :: v a -> S.Stream a) . V.unstream) s == s testPolymorphicFunctions :: forall a v. (COMMON_CONTEXT(a, v), VECTOR_CONTEXT(Int, v)) => v a -> [Test] testPolymorphicFunctions _ = $(testProperties [
tests/Utilities.hs view
@@ -8,13 +8,13 @@ import qualified Data.Vector.Primitive as DVP import qualified Data.Vector.Storable as DVS import qualified Data.Vector.Unboxed as DVU-import qualified Data.Vector.Fusion.Bundle as S+import qualified Data.Vector.Fusion.Stream as S import Data.List ( sortBy ) -instance Show a => Show (S.Bundle v a) where- show s = "Data.Vector.Fusion.Bundle.fromList " ++ show (S.toList s)+instance Show a => Show (S.Stream a) where+ show s = "Data.Vector.Fusion.Stream.fromList " ++ show (S.toList s) instance Arbitrary a => Arbitrary (DV.Vector a) where@@ -41,10 +41,10 @@ instance (CoArbitrary a, DVU.Unbox a) => CoArbitrary (DVU.Vector a) where coarbitrary = coarbitrary . DVU.toList -instance Arbitrary a => Arbitrary (S.Bundle v a) where+instance Arbitrary a => Arbitrary (S.Stream a) where arbitrary = fmap S.fromList arbitrary -instance CoArbitrary a => CoArbitrary (S.Bundle v a) where+instance CoArbitrary a => CoArbitrary (S.Stream a) where coarbitrary = coarbitrary . S.toList class (Testable (EqTest a), Conclusion (EqTest a)) => TestData a where@@ -55,12 +55,12 @@ type EqTest a equal :: a -> a -> EqTest a -instance Eq a => TestData (S.Bundle v a) where- type Model (S.Bundle v a) = [a]+instance Eq a => TestData (S.Stream a) where+ type Model (S.Stream a) = [a] model = S.toList unmodel = S.fromList - type EqTest (S.Bundle v a) = Property+ type EqTest (S.Stream a) = Property equal x y = property (x == y) instance Eq a => TestData (DV.Vector a) where
tests/vector-tests.cabal view
@@ -1,5 +1,5 @@ Name: vector-tests-Version: 0.10.9+Version: 0.10.0.1 License: BSD3 License-File: LICENSE Author: Max Bolingbroke, Roman Leshchinskiy@@ -18,7 +18,7 @@ Executable "vector-tests-O0" Main-Is: Main.hs - Build-Depends: base >= 4 && < 5, template-haskell, vector == 0.10.9.0,+ Build-Depends: base >= 4 && < 5, template-haskell, vector == 0.10.9.1, random, QuickCheck >= 2, test-framework, test-framework-quickcheck2 @@ -38,7 +38,7 @@ Executable "vector-tests-O2" Main-Is: Main.hs - Build-Depends: base >= 4 && < 5, template-haskell, vector == 0.10.9.0,+ Build-Depends: base >= 4 && < 5, template-haskell, vector == 0.10.9.1, random, QuickCheck >= 2, test-framework, test-framework-quickcheck2
vector.cabal view
@@ -1,5 +1,5 @@ Name: vector-Version: 0.10.9.0+Version: 0.10.9.1 License: BSD3 License-File: LICENSE Author: Roman Leshchinskiy <rl@cse.unsw.edu.au>@@ -58,7 +58,7 @@ tests/Boilerplater.hs tests/Utilities.hs tests/Tests/Move.hs- tests/Tests/Bundle.hs+ tests/Tests/Stream.hs tests/Tests/Vector.hs benchmarks/vector-benchmarks.cabal benchmarks/LICENSE@@ -99,12 +99,10 @@ Data.Vector.Internal.Check Data.Vector.Fusion.Util+ Data.Vector.Fusion.Stream.Size Data.Vector.Fusion.Stream.Monadic- Data.Vector.Fusion.Bundle.Size- Data.Vector.Fusion.Bundle.Monadic- Data.Vector.Fusion.Bundle+ Data.Vector.Fusion.Stream - Data.Vector.Generic.Mutable.Base Data.Vector.Generic.Mutable Data.Vector.Generic.Base Data.Vector.Generic.New