storablevector 0.2.11 → 0.2.12
raw patch · 10 files changed
+1256/−314 lines, 10 filesdep ~deepseqdep ~syb
Dependency ranges changed: deepseq, syb
Files
- speedtest/Pointer.hs +2/−2
- speedtest/SpeedTestChorus.hs +4/−4
- src/Data/StorableVector.hs +61/−14
- src/Data/StorableVector/Lazy.hs +98/−59
- src/Data/StorableVector/Lazy/Typed.hs +707/−0
- storablevector.cabal +10/−5
- tests/Alternative/Lazy.hs +71/−0
- tests/Test.hs +10/−230
- tests/Test/Lazy.hs +61/−0
- tests/Test/Strict.hs +232/−0
speedtest/Pointer.hs view
@@ -1,5 +1,5 @@-{-# OPTIONS_GHC -funbox-strict-fields -ddump-simpl-stats -O2 #-}-{- -dverbose-core2core -}+{-# OPTIONS_GHC -funbox-strict-fields -O2 #-}+{- -dverbose-core2core -ddump-simpl-stats -} module Main (main) where import qualified Data.StorableVector.Lazy as SV
speedtest/SpeedTestChorus.hs view
@@ -1,5 +1,6 @@-{-# OPTIONS_GHC -funbox-strict-fields -ddump-simpl -ddump-asm -O #-}+{-# OPTIONS_GHC -funbox-strict-fields -O #-} {-# LANGUAGE ExistentialQuantification #-}+{- -ddump-simpl -ddump-asm -} {- -dverbose-core2core -ddump-simpl-stats -} -- I use the dump options only in the main module and not in Cabal -- in order to get only code for the main module and not all modules@@ -33,7 +34,7 @@ -- import qualified Data.StorableVector.Private as SVP import qualified Control.Monad.ST.Strict as StrictST-import Control.Monad.ST.Lazy (ST, runST, strictToLazyST, )+import Control.Monad.ST.Lazy (strictToLazyST, ) import Foreign.Storable (Storable, ) import GHC.Float (float2Int, int2Float, double2Int, int2Double, )@@ -290,8 +291,7 @@ {-# INLINE runGeneratorMonolithic #-} runGeneratorMonolithic :: Storable a => Int -> Generator a -> SV.Vector a-runGeneratorMonolithic size (Generator f s) =- fst $ SV.unfoldrN size f s+runGeneratorMonolithic n (Generator f s) = fst $ SV.unfoldrN n f s {- SPECIALISE INLINE generator0Gen :: Float -> Float -> Generator Float -} {-# INLINE generator0Gen #-}
src/Data/StorableVector.hs view
@@ -7,7 +7,7 @@ -- (c) Don Stewart 2005-2006 -- (c) Bjorn Bringert 2006 -- (c) Spencer Janssen 2006--- (c) Henning Thielemann 2008-2013+-- (c) Henning Thielemann 2008-2017 -- -- -- License : BSD-style@@ -68,6 +68,7 @@ -- * Transforming 'Vector's map,+ mapIndexed, reverse, intersperse, transpose,@@ -83,6 +84,7 @@ -- ** Special folds concat, concatMap,+ foldMap, monoidConcatMap, any, all,@@ -99,7 +101,8 @@ -- ** Accumulating maps mapAccumL, mapAccumR,- mapIndexed,+ crochetL,+ crochetLResult, -- ** Unfolding 'Vector's replicate,@@ -218,7 +221,6 @@ import Data.Either (Either(Left, Right), ) import Data.Maybe.HT (toMaybe, ) import Data.Maybe (Maybe(Just, Nothing), maybe, fromMaybe, isJust, )-import Data.Bool.HT (if', ) import Data.Bool (Bool(False, True), not, otherwise, (&&), (||), ) import Data.Ord (Ord, min, max, (<), (<=), (>), (>=), ) import Data.Eq (Eq, (==), (/=), )@@ -429,10 +431,7 @@ -- | /O(n)/ Append two Vectors append :: (Storable a) => Vector a -> Vector a -> Vector a-append xs ys =- if' (null xs) ys $- if' (null ys) xs $- concat [xs,ys]+append xs ys = concat [xs,ys] {-# INLINE append #-} -- ---------------------------------------------------------------------@@ -620,11 +619,19 @@ -- --------------------------------------------------------------------- -- Special folds +{-+We filter out empty chunks in order to benefit from the special cases+zero chunks and one chunk.+In the other cases the preprocessing does not help much.+-} -- | /O(n)/ Concatenate a list of 'Vector's. concat :: (Storable a) => [Vector a] -> Vector a-concat [] = empty-concat [ps] = ps-concat xs = unsafeCreate len $ \ptr -> go ptr xs+concat = concatCore . List.filter (not . null)++concatCore :: (Storable a) => [Vector a] -> Vector a+concatCore [] = empty+concatCore [ps] = ps+concatCore xs = unsafeCreate len $ \ptr -> go ptr xs where len = P.sum . P.map length $ xs go = Strict.arguments2 $ \ptr ->@@ -639,11 +646,15 @@ concatMap f = concat . unpackWith f {-# INLINE concatMap #-} --- | This is like @foldMap@ or @mconcat . map f@,+-- | This is like @mconcat . map f@, -- but in many cases the result of @f@ will not be storable.+foldMap :: (Storable a, Monoid m) => (a -> m) -> Vector a -> m+foldMap f = foldr (mappend . f) mempty+{-# INLINE foldMap #-}++{-# DEPRECATED monoidConcatMap "Use foldMap instead." #-} monoidConcatMap :: (Storable a, Monoid m) => (a -> m) -> Vector a -> m-monoidConcatMap f =- foldr (mappend . f) mempty+monoidConcatMap = foldMap {-# INLINE monoidConcatMap #-} -- | /O(n)/ Applied to a predicate and a 'Vector', 'any' determines if@@ -732,6 +743,33 @@ in (acc2, bs) {-# INLINE mapAccumR #-} +crochetLResult ::+ (Storable x, Storable y) =>+ (x -> acc -> Maybe (y, acc))+ -> acc+ -> Vector x+ -> (Vector y, Maybe acc)+crochetLResult f acc0 x0 =+ mapSnd (fmap fst) $+ unfoldrN+ (length x0)+ (\(acc,xt) ->+ do (x,xs) <- viewL xt+ (y,acc') <- f x acc+ return (y, (acc',xs)))+ (acc0, x0)+{-# INLINE crochetLResult #-}++crochetL ::+ (Storable x, Storable y) =>+ (x -> acc -> Maybe (y, acc))+ -> acc+ -> Vector x+ -> Vector y+crochetL f acc = fst . crochetLResult f acc+{-# INLINE crochetL #-}++ -- | /O(n)/ map functions, provided with the index at each position mapIndexed :: (Storable a, Storable b) => (Int -> a -> b) -> Vector a -> Vector b mapIndexed f = snd . mapAccumL (\i e -> (i + 1, f i e)) 0@@ -1400,7 +1438,14 @@ -- | /O(l/n)/ 'sieve' selects every 'n'th element. sieve :: (Storable a) => Int -> Vector a -> Vector a-sieve n (SV fp s l) =+sieve n xs =+ case P.compare n 1 of+ P.LT -> error "sieve: non-positive step size"+ P.EQ -> xs+ P.GT -> sieveCore n xs++sieveCore :: (Storable a) => Int -> Vector a -> Vector a+sieveCore n (SV fp s l) = let end = s+l in fst $ unfoldrN (- div (-l) n)@@ -1423,6 +1468,8 @@ -- Restriction is that all input vector must have equal length. -- @interleave [pack "adgj", pack "behk", pack "cfil"] = pack ['a'..'l']@ interleave :: (Storable a) => [Vector a] -> Vector a+interleave [] = empty+interleave [xs] = xs interleave vs = Unsafe.performIO $ MC.runContT
src/Data/StorableVector/Lazy.hs view
@@ -1,5 +1,5 @@ {- |-Chunky signal stream build on StorableVector.+Chunky signal stream built on StorableVector. Hints for fusion: - Higher order functions should always be inlined in the end@@ -42,6 +42,7 @@ foldl, foldl', foldr,+ foldMap, monoidConcatMap, any, all,@@ -69,6 +70,7 @@ zipWith, zipWith3, zipWith4,+ zipWithAppend, zipWithLastPattern, zipWithLastPattern3, zipWithLastPattern4,@@ -79,6 +81,7 @@ deinterleave, interleaveFirstPattern, pad,+ compact, fromChunk, hGetContentsAsync, hGetContentsSync,@@ -111,7 +114,7 @@ import Data.Monoid (Monoid, mempty, mappend, mconcat, ) -- import Control.Arrow ((***))-import Control.Monad (liftM, liftM2, liftM3, liftM4, {- guard, -} )+import Control.Monad (liftM, liftM2, liftM3, liftM4, mfilter, ) import qualified System.IO as IO@@ -124,7 +127,7 @@ import qualified System.IO.Error as Exc import qualified System.Unsafe as Unsafe -import Test.QuickCheck (Arbitrary(..))+import qualified Test.QuickCheck as QC {-@@ -137,7 +140,7 @@ import Data.Either (Either(Left, Right), either, ) import Data.Maybe (Maybe(Just, Nothing), maybe, )-import Data.Function (const, flip, ($), (.), )+import Data.Function (const, flip, id, ($), (.), ) import Data.Tuple (fst, snd, uncurry, ) import Data.Bool (Bool(True,False), not, (&&), ) import Data.Ord (Ord, (<), (>), (<=), (>=), min, max, )@@ -168,8 +171,8 @@ (showString "VectorLazy.fromChunks " . showsPrec 10 (chunks xs)) -instance (Storable a, Arbitrary a) => Arbitrary (Vector a) where- arbitrary = liftM2 pack arbitrary arbitrary+instance (Storable a, QC.Arbitrary a) => QC.Arbitrary (Vector a) where+ arbitrary = liftM2 pack QC.arbitrary QC.arbitrary instance (Storable a) => NFData (Vector a) where rnf = rnf . List.map rnf . chunks@@ -179,8 +182,8 @@ newtype ChunkSize = ChunkSize Int deriving (Eq, Ord, Show) -instance Arbitrary ChunkSize where- arbitrary = fmap (ChunkSize . max 1 . min 2048) arbitrary+instance QC.Arbitrary ChunkSize where+ arbitrary = fmap ChunkSize $ QC.choose (1,2048) {- ToDo:@@ -236,10 +239,12 @@ unpack = List.concatMap V.unpack . chunks +{-# WARNING packWith "It seems to be used nowhere and might be removed." #-} {-# INLINE packWith #-} packWith :: (Storable b) => ChunkSize -> (a -> b) -> [a] -> Vector b packWith size f = unfoldr size (fmap (mapFst f) . ListHT.viewL) +{-# WARNING unpackWith "It seems to be used nowhere and might be removed." #-} {-# INLINE unpackWith #-} unpackWith :: (Storable a) => (a -> b) -> Vector a -> [b] unpackWith f = List.concatMap (V.unpackWith f) . chunks@@ -426,13 +431,14 @@ foldr f x0 = List.foldr (flip (V.foldr f)) x0 . chunks -{- |-@foldMap@--}+{-# INLINE foldMap #-}+foldMap :: (Storable a, Monoid m) => (a -> m) -> Vector a -> m+foldMap f = List.foldr (mappend . V.foldMap f) mempty . chunks++{-# DEPRECATED monoidConcatMap "Use foldMap instead." #-} {-# INLINE monoidConcatMap #-} monoidConcatMap :: (Storable a, Monoid m) => (a -> m) -> Vector a -> m-monoidConcatMap f =- List.foldr (mappend . V.monoidConcatMap f) mempty . chunks+monoidConcatMap = foldMap {-# INLINE any #-} any :: (Storable a) => (a -> Bool) -> Vector a -> Bool@@ -442,17 +448,19 @@ all :: (Storable a) => (a -> Bool) -> Vector a -> Bool all p = List.all (V.all p) . chunks -maximum :: (Storable a, Ord a) => Vector a -> a-maximum =- List.maximum . List.map V.maximum . chunks--- List.foldl1' max . List.map V.maximum . chunks+maximum, _maximum :: (Storable a, Ord a) => Vector a -> a+maximum = List.maximum . List.map V.maximum . chunks+_maximum = List.foldl1' max . List.map V.maximum . chunks -minimum :: (Storable a, Ord a) => Vector a -> a-minimum =- List.minimum . List.map V.minimum . chunks--- List.foldl1' min . List.map V.minimum . chunks+minimum, _minimum :: (Storable a, Ord a) => Vector a -> a+minimum = List.minimum . List.map V.minimum . chunks+_minimum = List.foldl1' min . List.map V.minimum . chunks {-+It is not clear whether this implementation is good.+Associativity depends on the chunk structure,+but in principle chunks could be summed in parallel.+ sum :: (Storable a, Num a) => Vector a -> a sum = List.sum . List.map V.sum . chunks@@ -538,21 +546,14 @@ List.mapAccumR (V.mapAccumR f) start . chunks +{-# DEPRECATED crochetLChunk "Use Storable.Vector.crochetLResult" #-} {-# INLINE crochetLChunk #-} crochetLChunk :: (Storable x, Storable y) => (x -> acc -> Maybe (y, acc)) -> acc -> V.Vector x -> (V.Vector y, Maybe acc)-crochetLChunk f acc0 x0 =- mapSnd (fmap fst) $- V.unfoldrN- (V.length x0)- (\(acc,xt) ->- do (x,xs) <- V.viewL xt- (y,acc') <- f x acc- return (y, (acc',xs)))- (acc0, x0)+crochetLChunk = V.crochetLResult {-# INLINE crochetL #-} crochetL :: (Storable x, Storable y) =>@@ -564,7 +565,7 @@ SV . List.unfoldr (\(xt,acc) -> do (x,xs) <- ListHT.viewL xt acc' <- acc- return $ mapSnd ((,) xs) $ crochetLChunk f acc' x) .+ return $ mapSnd ((,) xs) $ V.crochetLResult f acc' x) . flip (,) (Just acc0) . chunks @@ -676,7 +677,7 @@ {-# INLINE span #-}-span :: (Storable a) => (a -> Bool) -> Vector a -> (Vector a, Vector a)+span, _span :: (Storable a) => (a -> Bool) -> Vector a -> (Vector a, Vector a) span p = let recourse [] = ([],[]) recourse (x:xs) =@@ -685,16 +686,17 @@ then mapFst (x:) (recourse xs) else (chunks $ fromChunk y, (z:xs)) in mapPair (SV, SV) . recourse . chunks-{--span _ (SV []) = (empty, empty)-span p (SV (x:xs)) =- let (y,z) = V.span p x- in if V.length y == 0- then mapFst (SV . (x:) . chunks) (span p (SV xs))- else (SV [y], SV (z:xs))--} +_span p =+ let recourse (SV []) = (empty, empty)+ recourse (SV (x:xs)) =+ let (y,z) = V.span p x+ in if V.length y == 0+ then mapFst (SV . (x:) . chunks) (recourse (SV xs))+ else (SV [y], SV (z:xs))+ in recourse + -- * other functions @@ -714,15 +716,7 @@ -> Vector a -> Vector b -> Vector c-zipWith f as0 bs0 =- let recourse at@(a:_) bt@(b:_) =- let z = V.zipWith f a b- n = V.length z- in z : recourse- (chunks $ drop n $ fromChunks at)- (chunks $ drop n $ fromChunks bt)- recourse _ _ = []- in fromChunks $ recourse (chunks as0) (chunks bs0)+zipWith = zipWithCont (const empty) (const empty) {-# INLINE zipWith3 #-} zipWith3 :: (Storable a, Storable b, Storable c, Storable d) =>@@ -764,6 +758,34 @@ recourse (chunks as0) (chunks bs0) (chunks cs0) (chunks ds0) +{-# INLINE zipWithAppend #-}+zipWithAppend :: (Storable a) =>+ (a -> a -> a)+ -> Vector a+ -> Vector a+ -> Vector a+zipWithAppend = zipWithCont id id++{-# INLINE zipWithCont #-}+zipWithCont :: (Storable a, Storable b, Storable c) =>+ (Vector a -> Vector c)+ -> (Vector b -> Vector c)+ -> (a -> b -> c)+ -> Vector a+ -> Vector b+ -> Vector c+zipWithCont ga gb f as0 bs0 =+ let recourse at@(a:_) bt@(b:_) =+ let z = V.zipWith f a b+ n = V.length z+ in z : recourse+ (chunks $ drop n $ fromChunks at)+ (chunks $ drop n $ fromChunks bt)+ recourse [] bs = chunks $ gb $ fromChunks bs+ recourse as [] = chunks $ ga $ fromChunks as+ in fromChunks $ recourse (chunks as0) (chunks bs0)++ {- | Preserves chunk pattern of the last argument. -}@@ -774,8 +796,7 @@ -> Vector b -> Vector c zipWithLastPattern f =- crochetL (\y -> liftM (mapFst (flip f y)) . Ptr.viewL)- . pointer+ crochetL (\y -> liftM (mapFst (flip f y)) . Ptr.viewL) . pointer {- | Preserves chunk pattern of the last argument.@@ -834,8 +855,7 @@ zipWithSize3 size f s0 s1 s2 = unfoldr size (\(xt,yt,zt) -> liftM3- (\(x,xs) (y,ys) (z,zs) ->- (f x y z, (xs,ys,zs)))+ (\(x,xs) (y,ys) (z,zs) -> (f x y z, (xs,ys,zs))) (Ptr.viewL xt) (Ptr.viewL yt) (Ptr.viewL zt))@@ -849,8 +869,7 @@ zipWithSize4 size f s0 s1 s2 s3 = unfoldr size (\(xt,yt,zt,wt) -> liftM4- (\(x,xs) (y,ys) (z,zs) (w,ws) ->- (f x y z w, (xs,ys,zs,ws)))+ (\(x,xs) (y,ys) (z,zs) (w,ws) -> (f x y z w, (xs,ys,zs,ws))) (Ptr.viewL xt) (Ptr.viewL yt) (Ptr.viewL zt)@@ -881,7 +900,8 @@ All input vectors must have the same length. -} {-# INLINE interleaveFirstPattern #-}-interleaveFirstPattern :: (Storable a) => [Vector a] -> Vector a+interleaveFirstPattern, _interleaveFirstPattern ::+ (Storable a) => [Vector a] -> Vector a interleaveFirstPattern [] = empty interleaveFirstPattern vss@(vs:_) = let pattern = List.map V.length $ chunks vs@@ -893,8 +913,8 @@ in fromChunks $ List.map V.interleave $ List.transpose $ List.map split vss -{--interleaveFirstPattern vss@(vs:_) =+_interleaveFirstPattern [] = empty+_interleaveFirstPattern vss@(vs:_) = fromChunks . snd . List.mapAccumL (\xss n ->@@ -903,7 +923,6 @@ List.unzip $ List.map (splitAt n) xss) vss . List.map V.length . chunks $ vs--} @@ -922,6 +941,7 @@ x:xs -> x : recourse (n - V.length x) xs in SV . recourse n0 . chunks +{-# WARNING padAlt "use 'pad' instead" #-} padAlt :: (Storable a) => ChunkSize -> a -> Int -> Vector a -> Vector a padAlt size x n xs = append xs@@ -930,13 +950,32 @@ then replicate size (n-m) x else empty) +compact :: (Storable a) => ChunkSize -> Vector a -> Vector a+compact size (SV xs) =+ SV $ List.map V.concat $+ compactGen+ (\x y -> mfilter (<=size) $ Just $ mappend x y)+ (ChunkSize . V.length) xs +compactGen :: (b -> b -> Maybe b) -> (a -> b) -> [a] -> [[a]]+compactGen _ _ [] = []+compactGen plus measure (x0:xs0) =+ uncurry (:) $ mapFst (x0:) $+ List.foldr+ (\y go s0 ->+ let ym = measure y+ in case plus s0 ym of+ Just s1 -> mapFst (y:) $ go s1+ Nothing -> ([], uncurry (:) $ mapFst (y:) $ go ym))+ (const ([], [])) xs0 (measure x0) + -- * Helper functions for StorableVector +{-# WARNING cancelNullVector "do not use it" #-} {-# INLINE cancelNullVector #-} cancelNullVector :: (V.Vector a, b) -> Maybe (V.Vector a, b) cancelNullVector y =
+ src/Data/StorableVector/Lazy/Typed.hs view
@@ -0,0 +1,707 @@+{- |+Like "Data.StorableVector.Lazy"+but the maximum chunk size is encoded in a type parameter.+This way, you do not need to pass a chunk size parameter at various places.+The API becomes more like the one for lists and 'ByteString's.+-}+module Data.StorableVector.Lazy.Typed (+ Vector,+ DefaultVector,+ Size,+ ChunkSize,+ chunkSize,+ lazyChunkSize,+ DefaultChunkSize,+ Size1024,+ empty,+ singleton,+ toVectorLazy,+ fromVectorLazy,+ chunks,+ fromChunks,+ pack,+ unpack,+ unfoldr,+ unfoldrResult,+ sample,+ sampleN,+ iterate,+ repeat,+ cycle,+ replicate,+ null,+ length,+ equal,+ index,+ cons,+ append,+ extendL,+ concat,+ sliceVertical,+ snoc,+ map,+ reverse,+ foldl,+ foldl',+ foldr,+ foldMap,+ any,+ all,+ maximum,+ minimum,+ viewL,+ viewR,+ switchL,+ switchR,+ scanl,+ mapAccumL,+ mapAccumR,+ crochetL,+ take,+ takeEnd,+ drop,+ splitAt,+ dropMarginRem,+ dropMargin,+ dropWhile,+ takeWhile,+ span,+ filter,+ zipWith,+ zipWith3,+ zipWith4,+ zipWithAppend,+ zipWithLastPattern,+ zipWithLastPattern3,+ zipWithLastPattern4,+ zipWithSize,+ zipWithSize3,+ zipWithSize4,+ sieve,+ deinterleave,+ interleaveFirstPattern,+ pad,+ hGetContentsAsync,+ hGetContentsSync,+ hPut,+ readFileAsync,+ writeFile,+ appendFile,+ interact,+ ) where++import qualified Data.StorableVector.Lazy as SVL+import qualified Data.StorableVector as V+import qualified Data.List as List++import Foreign.Storable (Storable)+import System.IO (IO, FilePath, Handle)+import Test.QuickCheck (Arbitrary(arbitrary))++import Control.DeepSeq (NFData, rnf)+import Control.Monad (fmap)++import Data.Function.HT (compose2)+import Data.Tuple.HT (mapPair, mapFst, mapSnd)+import Data.Maybe.HT (toMaybe)+import Data.Monoid (Monoid, mempty, mappend, mconcat)+import Data.Either (Either)+import Data.Maybe (Maybe(Just))+import Data.Function (flip, ($), (.))+import Data.Tuple (fst)+import Data.Bool (Bool)+import Data.Ord (Ord, (<), (>=))+import Data.Eq (Eq, (==))+import Text.Show (Show, showsPrec, showParen, showString)+import Prelude (IOError, Int, succ)+++{- |+A @Vector size a@ represents a chunky storable vector+with maximum chunk size expressed by type parameter @size@.+-}+newtype Vector size a = SV {plain :: SVL.Vector a}+++newtype ChunkSize size = ChunkSize Int++lazyChunkSize :: ChunkSize size -> SVL.ChunkSize+lazyChunkSize (ChunkSize size) = SVL.chunkSize size++class Size size where+ chunkSize :: ChunkSize size++instance Size Size1024 where+ chunkSize = ChunkSize 1024++_dummySize :: Size1024+_dummySize = Size1024++type DefaultChunkSize = Size1024+data Size1024 = Size1024++type DefaultVector = Vector DefaultChunkSize+++withChunkSize ::+ (Size size) => (ChunkSize size -> Vector size a) -> Vector size a+withChunkSize f = f chunkSize++withLazyChunkSize ::+ (Size size) => (SVL.ChunkSize -> SVL.Vector a) -> Vector size a+withLazyChunkSize f = withChunkSize $ lift0 . f . lazyChunkSize++getChunkSize :: (Size size) => Vector size a -> ChunkSize size+getChunkSize _ = chunkSize+++lift0 :: SVL.Vector a -> Vector size a+lift0 = SV++lift1 ::+ (SVL.Vector a -> SVL.Vector b) ->+ Vector size a -> Vector size b+lift1 f (SV a) = SV (f a)++lift2 ::+ (SVL.Vector a -> SVL.Vector b -> SVL.Vector c) ->+ Vector size a -> Vector size b -> Vector size c+lift2 f (SV a) (SV b) = SV (f a b)++lift3 ::+ (SVL.Vector a -> SVL.Vector b -> SVL.Vector c -> SVL.Vector d) ->+ Vector size a -> Vector size b -> Vector size c -> Vector size d+lift3 f (SV a) (SV b) (SV c) = SV (f a b c)++lift4 ::+ (SVL.Vector a -> SVL.Vector b -> SVL.Vector c -> SVL.Vector d ->+ SVL.Vector e) ->+ Vector size a -> Vector size b -> Vector size c -> Vector size d ->+ Vector size e+lift4 f (SV a) (SV b) (SV c) (SV d) = SV (f a b c d)+++instance (Size size, Storable a) => Monoid (Vector size a) where+ mempty = empty+ mappend = append+ mconcat = concat++instance (Size size, Storable a, Eq a) => Eq (Vector size a) where+ (==) = equal++instance (Size size, Storable a, Show a) => Show (Vector size a) where+ showsPrec p xs =+ showParen (p>=10)+ (showString "VectorLazyTyped.fromChunks " .+ showsPrec 10 (SVL.chunks $ plain xs))++{- |+This generates chunks of maximum size.+If you want to have chunks of varying size, use++> fromChunks <$> arbitrary++instead.+-}+instance (Size size, Storable a, Arbitrary a) => Arbitrary (Vector size a) where+ arbitrary = fmap pack arbitrary++instance (Size size, Storable a) => NFData (Vector size a) where+ rnf = rnf . plain+++-- * Introducing and eliminating 'Vector's++{-# INLINE empty #-}+empty :: (Storable a) => Vector size a+empty = lift0 SVL.empty++{-# INLINE singleton #-}+singleton :: (Storable a) => a -> Vector size a+singleton = lift0 . SVL.singleton++toVectorLazy :: Vector size a -> SVL.Vector a+toVectorLazy = plain++{- |+This will maintain all laziness breaks,+but if chunks are too big, they will be split.+-}+fromVectorLazy :: (Size size, Storable a) => SVL.Vector a -> Vector size a+fromVectorLazy = fromChunks . SVL.chunks++chunks :: Vector size a -> [V.Vector a]+chunks = SVL.chunks . plain++fromChunks :: (Size size, Storable a) => [V.Vector a] -> Vector size a+fromChunks xs =+ withChunkSize $ \(ChunkSize size) ->+ fromChunksUnchecked $ List.concatMap (V.sliceVertical size) xs++fromChunksUnchecked :: (Storable a) => [V.Vector a] -> Vector size a+fromChunksUnchecked = lift0 . SVL.fromChunks++pack :: (Size size, Storable a) => [a] -> Vector size a+pack xs = withLazyChunkSize $ \size -> SVL.pack size xs++unpack :: (Storable a) => Vector size a -> [a]+unpack = SVL.unpack . plain+++{-# INLINE unfoldr #-}+unfoldr :: (Size size, Storable b) =>+ (a -> Maybe (b,a)) ->+ a ->+ Vector size b+unfoldr f a =+ withLazyChunkSize $ \cs -> SVL.unfoldr cs f a++{-# INLINE unfoldrResult #-}+unfoldrResult :: (Size size, Storable b) =>+ (a -> Either c (b, a)) ->+ a ->+ (Vector size b, c)+unfoldrResult f a =+ let x =+ mapFst lift0 $+ SVL.unfoldrResult (lazyChunkSize $ getChunkSize $ fst x) f a+ in x+++{-# INLINE sample #-}+sample, _sample :: (Size size, Storable a) => (Int -> a) -> Vector size a+sample f = withLazyChunkSize $ \cs -> SVL.sample cs f++_sample f = unfoldr (\i -> Just (f i, succ i)) 0++{-# INLINE sampleN #-}+sampleN, _sampleN ::+ (Size size, Storable a) => Int -> (Int -> a) -> Vector size a+sampleN n f = withLazyChunkSize $ \cs -> SVL.sampleN cs n f++_sampleN n f = unfoldr (\i -> toMaybe (i<n) (f i, succ i)) 0+++{-# INLINE iterate #-}+iterate :: (Size size, Storable a) => (a -> a) -> a -> Vector size a+iterate f a = withLazyChunkSize $ \cs -> SVL.iterate cs f a++repeat :: (Size size, Storable a) => a -> Vector size a+repeat a = withLazyChunkSize $ \cs -> SVL.repeat cs a++cycle :: (Size size, Storable a) => Vector size a -> Vector size a+cycle = lift1 SVL.cycle++replicate :: (Size size, Storable a) => Int -> a -> Vector size a+replicate n a = withLazyChunkSize $ \cs -> SVL.replicate cs n a++++-- * Basic interface++{-# INLINE null #-}+null :: (Size size, Storable a) => Vector size a -> Bool+null = SVL.null . plain++length :: Vector size a -> Int+length = SVL.length . plain++equal :: (Size size, Storable a, Eq a) => Vector size a -> Vector size a -> Bool+equal = compose2 SVL.equal plain++index :: (Size size, Storable a) => Vector size a -> Int -> a+index (SV xs) = SVL.index xs+++{-# INLINE cons #-}+cons :: (Size size, Storable a) => a -> Vector size a -> Vector size a+cons x = lift1 (SVL.cons x)++infixr 5 `append`++{-# INLINE append #-}+append ::+ (Size size, Storable a) => Vector size a -> Vector size a -> Vector size a+append = lift2 SVL.append+++{- |+@extendL x y@+prepends the chunk @x@ and merges it with the first chunk of @y@+if the total size is at most @size@.+This way you can prepend small chunks+while asserting a reasonable average size for chunks.+The prepended chunk must be smaller than the maximum chunk size in the Vector.+This is not checked.+-}+extendL ::+ (Size size, Storable a) => V.Vector a -> Vector size a -> Vector size a+extendL x ys = withLazyChunkSize $ \cs -> SVL.extendL cs x (plain ys)+++concat :: (Size size, Storable a) => [Vector size a] -> Vector size a+concat = lift0 . SVL.concat . List.map plain++sliceVertical ::+ (Size size, Storable a) => Int -> Vector size a -> [Vector size a]+sliceVertical n = List.map lift0 . SVL.sliceVertical n . plain++{-# INLINE snoc #-}+snoc :: (Size size, Storable a) => Vector size a -> a -> Vector size a+snoc = flip $ \x -> lift1 (flip SVL.snoc x)+++-- * Transformations++{-# INLINE map #-}+map :: (Size size, Storable x, Storable y) =>+ (x -> y)+ -> Vector size x+ -> Vector size y+map f = lift1 (SVL.map f)+++reverse :: (Size size, Storable a) => Vector size a -> Vector size a+reverse = lift1 SVL.reverse+++-- * Reducing 'Vector's++{-# INLINE foldl #-}+foldl :: (Size size, Storable b) => (a -> b -> a) -> a -> Vector size b -> a+foldl f x0 = SVL.foldl f x0 . plain++{-# INLINE foldl' #-}+foldl' :: (Size size, Storable b) => (a -> b -> a) -> a -> Vector size b -> a+foldl' f x0 = SVL.foldl' f x0 . plain++{-# INLINE foldr #-}+foldr :: (Size size, Storable b) => (b -> a -> a) -> a -> Vector size b -> a+foldr f x0 = SVL.foldr f x0 . plain+++{-# INLINE foldMap #-}+foldMap ::+ (Size size, Storable a, Monoid m) => (a -> m) -> Vector size a -> m+foldMap f = SVL.foldMap f . plain++{-# INLINE any #-}+any :: (Size size, Storable a) => (a -> Bool) -> Vector size a -> Bool+any p = SVL.any p . plain++{-# INLINE all #-}+all :: (Size size, Storable a) => (a -> Bool) -> Vector size a -> Bool+all p = SVL.all p . plain++maximum :: (Size size, Storable a, Ord a) => Vector size a -> a+maximum = SVL.maximum . plain++minimum :: (Size size, Storable a, Ord a) => Vector size a -> a+minimum = SVL.minimum . plain+++-- * inspecting a vector++{-# INLINE viewL #-}+viewL :: (Size size, Storable a) => Vector size a -> Maybe (a, Vector size a)+viewL = fmap (mapSnd lift0) . SVL.viewL . plain++{-# INLINE viewR #-}+viewR :: (Size size, Storable a) => Vector size a -> Maybe (Vector size a, a)+viewR = fmap (mapFst lift0) . SVL.viewR . plain++{-# INLINE switchL #-}+switchL ::+ (Size size, Storable a) =>+ b -> (a -> Vector size a -> b) -> Vector size a -> b+switchL n j = SVL.switchL n (\a -> j a . lift0) . plain++{-# INLINE switchR #-}+switchR ::+ (Size size, Storable a) =>+ b -> (Vector size a -> a -> b) -> Vector size a -> b+switchR n j = SVL.switchR n (j . lift0) . plain+++{-# INLINE scanl #-}+scanl :: (Size size, Storable a, Storable b) =>+ (a -> b -> a) -> a -> Vector size b -> Vector size a+scanl f start = lift1 $ SVL.scanl f start++{-# INLINE mapAccumL #-}+mapAccumL :: (Size size, Storable a, Storable b) =>+ (acc -> a -> (acc, b)) -> acc -> Vector size a -> (acc, Vector size b)+mapAccumL f start = mapSnd lift0 . SVL.mapAccumL f start . plain++{-# INLINE mapAccumR #-}+mapAccumR :: (Size size, Storable a, Storable b) =>+ (acc -> a -> (acc, b)) -> acc -> Vector size a -> (acc, Vector size b)+mapAccumR f start = mapSnd lift0 . SVL.mapAccumR f start . plain++{-# INLINE crochetL #-}+crochetL ::+ (Size size, Storable x, Storable y) =>+ (x -> acc -> Maybe (y, acc))+ -> acc+ -> Vector size x+ -> Vector size y+crochetL f acc0 = lift1 $ SVL.crochetL f acc0++++-- * sub-vectors++{-# INLINE take #-}+take :: (Size size, Storable a) => Int -> Vector size a -> Vector size a+take n = lift1 $ SVL.take n++{-# INLINE takeEnd #-}+takeEnd :: (Size size, Storable a) => Int -> Vector size a -> Vector size a+takeEnd n = lift1 $ SVL.takeEnd n++{-# INLINE drop #-}+drop :: (Size size, Storable a) => Int -> Vector size a -> Vector size a+drop n = lift1 $ SVL.drop n++{-# INLINE splitAt #-}+splitAt ::+ (Size size, Storable a) =>+ Int -> Vector size a -> (Vector size a, Vector size a)+splitAt n =+ mapPair (lift0, lift0) . SVL.splitAt n . plain++++{-# INLINE dropMarginRem #-}+dropMarginRem ::+ (Size size, Storable a) =>+ Int -> Int -> Vector size a -> (Int, Vector size a)+dropMarginRem n m = mapSnd lift0 . SVL.dropMarginRem n m . plain++{-# INLINE dropMargin #-}+dropMargin ::+ (Size size, Storable a) => Int -> Int -> Vector size a -> Vector size a+dropMargin n m = lift1 $ SVL.dropMargin n m++++{-# INLINE dropWhile #-}+dropWhile ::+ (Size size, Storable a) => (a -> Bool) -> Vector size a -> Vector size a+dropWhile p = lift1 $ SVL.dropWhile p++{-# INLINE takeWhile #-}+takeWhile ::+ (Size size, Storable a) => (a -> Bool) -> Vector size a -> Vector size a+takeWhile p = lift1 $ SVL.takeWhile p+++{-# INLINE span #-}+span ::+ (Size size, Storable a) =>+ (a -> Bool) -> Vector size a -> (Vector size a, Vector size a)+span p = mapPair (lift0, lift0) . SVL.span p . plain++++-- * other functions+++{-# INLINE filter #-}+filter ::+ (Size size, Storable a) => (a -> Bool) -> Vector size a -> Vector size a+filter p = lift1 $ SVL.filter p+++{- |+Generates laziness breaks+wherever one of the input signals has a chunk boundary.+-}+{-# INLINE zipWith #-}+zipWith :: (Size size, Storable a, Storable b, Storable c) =>+ (a -> b -> c)+ -> Vector size a+ -> Vector size b+ -> Vector size c+zipWith f = lift2 $ SVL.zipWith f++{-# INLINE zipWith3 #-}+zipWith3 :: (Size size, Storable a, Storable b, Storable c, Storable d) =>+ (a -> b -> c -> d)+ -> Vector size a+ -> Vector size b+ -> Vector size c+ -> Vector size d+zipWith3 f = lift3 $ SVL.zipWith3 f++{-# INLINE zipWith4 #-}+zipWith4 ::+ (Size size, Storable a, Storable b, Storable c, Storable d, Storable e) =>+ (a -> b -> c -> d -> e)+ -> Vector size a+ -> Vector size b+ -> Vector size c+ -> Vector size d+ -> Vector size e+zipWith4 f = lift4 $ SVL.zipWith4 f+++{-# INLINE zipWithAppend #-}+zipWithAppend :: (Size size, Storable a) =>+ (a -> a -> a)+ -> Vector size a+ -> Vector size a+ -> Vector size a+zipWithAppend f = lift2 $ SVL.zipWithAppend f++++{- |+Preserves chunk pattern of the last argument.+-}+{-# INLINE zipWithLastPattern #-}+zipWithLastPattern :: (Size size, Storable a, Storable b, Storable c) =>+ (a -> b -> c)+ -> Vector size a+ -> Vector size b+ -> Vector size c+zipWithLastPattern f = lift2 $ SVL.zipWithLastPattern f++{- |+Preserves chunk pattern of the last argument.+-}+{-# INLINE zipWithLastPattern3 #-}+zipWithLastPattern3 ::+ (Size size, Storable a, Storable b, Storable c, Storable d) =>+ (a -> b -> c -> d) ->+ (Vector size a -> Vector size b -> Vector size c -> Vector size d)+zipWithLastPattern3 f = lift3 $ SVL.zipWithLastPattern3 f++{- |+Preserves chunk pattern of the last argument.+-}+{-# INLINE zipWithLastPattern4 #-}+zipWithLastPattern4 ::+ (Size size, Storable a, Storable b, Storable c, Storable d, Storable e) =>+ (a -> b -> c -> d -> e) ->+ (Vector size a -> Vector size b -> Vector size c -> Vector size d -> Vector size e)+zipWithLastPattern4 f = lift4 $ SVL.zipWithLastPattern4 f+++{-# INLINE zipWithSize #-}+zipWithSize :: (Size size, Storable a, Storable b, Storable c) =>+ (a -> b -> c)+ -> Vector size a+ -> Vector size b+ -> Vector size c+zipWithSize f a b =+ withLazyChunkSize $ \cs -> SVL.zipWithSize cs f (plain a) (plain b)++{-# INLINE zipWithSize3 #-}+zipWithSize3 ::+ (Size size, Storable a, Storable b, Storable c, Storable d) =>+ (a -> b -> c -> d) ->+ (Vector size a -> Vector size b -> Vector size c -> Vector size d)+zipWithSize3 f a b c =+ withLazyChunkSize $ \cs ->+ SVL.zipWithSize3 cs f (plain a) (plain b) (plain c)++{-# INLINE zipWithSize4 #-}+zipWithSize4 ::+ (Size size, Storable a, Storable b, Storable c, Storable d, Storable e) =>+ (a -> b -> c -> d -> e) ->+ (Vector size a -> Vector size b -> Vector size c -> Vector size d -> Vector size e)+zipWithSize4 f a b c d =+ withLazyChunkSize $ \cs ->+ SVL.zipWithSize4 cs f (plain a) (plain b) (plain c) (plain d)+++-- * interleaved vectors++{-# INLINE sieve #-}+sieve :: (Size size, Storable a) => Int -> Vector size a -> Vector size a+sieve n = lift1 $ SVL.sieve n++{-# INLINE deinterleave #-}+deinterleave ::+ (Size size, Storable a) => Int -> Vector size a -> [Vector size a]+deinterleave n =+ List.map lift0 . SVL.deinterleave n . plain++{- |+Interleave lazy vectors+while maintaining the chunk pattern of the first vector.+All input vectors must have the same length.+-}+{-# INLINE interleaveFirstPattern #-}+interleaveFirstPattern ::+ (Size size, Storable a) => [Vector size a] -> Vector size a+interleaveFirstPattern = lift0 . SVL.interleaveFirstPattern . List.map plain++++{- |+Ensure a minimal length of the list by appending pad values.+-}+{- disabled INLINE pad -}+pad ::+ (Size size, Storable a) =>+ a -> Int -> Vector size a -> Vector size a+pad y n xs = withLazyChunkSize $ \cs -> SVL.pad cs y n $ plain xs++++++-- * IO++withIOErrorChunkSize ::+ (Size size) =>+ (ChunkSize size -> IO (IOError, Vector size a)) ->+ IO (IOError, Vector size a)+withIOErrorChunkSize act = act chunkSize++hGetContentsAsync :: (Size size, Storable a) =>+ Handle -> IO (IOError, Vector size a)+hGetContentsAsync h =+ withIOErrorChunkSize $ \cs ->+ fmap (mapSnd lift0) $ SVL.hGetContentsAsync (lazyChunkSize cs) h+++withIOChunkSize ::+ (Size size) =>+ (ChunkSize size -> IO (Vector size a)) ->+ IO (Vector size a)+withIOChunkSize act = act chunkSize++hGetContentsSync ::+ (Size size, Storable a) =>+ Handle -> IO (Vector size a)+hGetContentsSync h =+ withIOChunkSize $ \cs ->+ fmap lift0 $ SVL.hGetContentsSync (lazyChunkSize cs) h++hPut :: (Size size, Storable a) => Handle -> Vector size a -> IO ()+hPut h = SVL.hPut h . plain++readFileAsync ::+ (Size size, Storable a) => FilePath -> IO (IOError, Vector size a)+readFileAsync path =+ withIOErrorChunkSize $ \cs ->+ fmap (mapSnd lift0) $ SVL.readFileAsync (lazyChunkSize cs) path++writeFile :: (Size size, Storable a) => FilePath -> Vector size a -> IO ()+writeFile path = SVL.writeFile path . plain++appendFile :: (Size size, Storable a) => FilePath -> Vector size a -> IO ()+appendFile path = SVL.appendFile path . plain++interact ::+ (Size size, Storable a) =>+ (Vector size a -> Vector size a) -> IO ()+interact = interactAux chunkSize++interactAux ::+ (Size size, Storable a) =>+ ChunkSize size -> (Vector size a -> Vector size a) -> IO ()+interactAux cs f = SVL.interact (lazyChunkSize cs) (plain . f . lift0)
storablevector.cabal view
@@ -1,5 +1,5 @@ Name: storablevector-Version: 0.2.11+Version: 0.2.12 Category: Data Synopsis: Fast, packed, strict storable arrays with a list interface like ByteString Description:@@ -48,7 +48,7 @@ Source-Repository this type: darcs location: http://code.haskell.org/storablevector/- tag: 0.2.11+ tag: 0.2.12 Library@@ -71,7 +71,7 @@ If flag(separateSYB) Build-Depends: base >=4 && <5,- syb >=0.1 && <0.7+ syb >=0.1 && <0.8 Else Build-Depends: base >=3 && <4@@ -90,6 +90,7 @@ Data.StorableVector.Lazy.Builder Data.StorableVector.Lazy.Pattern Data.StorableVector.Lazy.Pointer+ Data.StorableVector.Lazy.Typed Data.StorableVector.ST.Strict Data.StorableVector.ST.Lazy @@ -111,7 +112,11 @@ Default-Language: Haskell98 Hs-Source-Dirs: tests Main-Is: Test.hs- Other-Modules: Test.Utility+ Other-Modules:+ Alternative.Lazy+ Test.Lazy+ Test.Strict+ Test.Utility Build-Depends: storablevector, bytestring >=0.9 && <0.11,@@ -137,7 +142,7 @@ Build-Depends: storablevector, sample-frame >=0.0.1 && <0.1,- deepseq >=1.1 && <1.4+ deepseq If flag(splitBase) Build-Depends: base >= 3 && <5 Else
+ tests/Alternative/Lazy.hs view
@@ -0,0 +1,71 @@+{- |+Alternative implementations for functions in "Data.StorableVector.Lazy".+We want to use it for testing against the prefered implementations.+-}+module Alternative.Lazy where++import qualified Data.List.Match as Match+import qualified Data.List as List+import Data.Tuple.HT (mapFst)+import Data.Maybe.HT (toMaybe)+++-- compact0 2 [] = [[]] - bad+-- compact0 2 [10] = [[],[10]] - bad+compact0 :: Int -> [Int] -> [[Int]]+compact0 maxS =+ let go _ xs [] = [xs]+ go s0 xs (y:ys) =+ let s1 = s0+y+ in if s1<=maxS+ then go s1 (xs++[y]) ys+ else xs : go y [y] ys+ in go 0 []++-- compact1 2 [] = [[]] - bad+-- compact1 2 [10] = [[],[10]] - bad+compact1 :: Int -> [Int] -> [[Int]]+compact1 maxS =+ let go _ [] = ([], [])+ go s0 (y:ys) =+ let s1 = s0+y+ in if s1<=maxS+ then mapFst (y:) $ go s1 ys+ else ([], uncurry (:) $ mapFst (y:) $ go y ys)+ in uncurry (:) . go 0++compact2 :: Int -> [Int] -> [[Int]]+compact2 maxS =+ let go _ [] = ([], [])+ go s0 (y:ys) =+ let s1 = s0+y+ in if s1<=maxS+ then mapFst (y:) $ go s1 ys+ else ([], uncurry (:) $ mapFst (y:) $ go y ys)+ in (\(xs,xss) -> if List.null xs then xss else xs:xss) . go 0++{- |+This is the counterpart to the actual implementation in StorableVector.Lazy.+-}+compact3 :: Int -> [Int] -> [[Int]]+compact3 maxS =+ (\(xs,xss) -> if List.null xs then xss else xs:xss) .+ (\xs ->+ List.foldr+ (\y go s0 ->+ let s1 = s0+y+ in if s1<=maxS+ then mapFst (y:) $ go s1+ else ([], uncurry (:) $ mapFst (y:) $ go y))+ (const ([], [])) xs 0)++compact4 :: Int -> [Int] -> [[Int]]+compact4 maxS =+ List.unfoldr $ \xs -> toMaybe (not $ List.null xs) $+ Match.splitAt+ (minLength1 $ List.takeWhile (<= maxS) $+ List.tail $ List.scanl (+) 0 xs)+ xs++minLength1 :: [Int] -> [Int]+minLength1 = (0:) . List.drop 1
tests/Test.hs view
@@ -1,235 +1,15 @@-import qualified Data.StorableVector as V-import qualified Data.ByteString as P-import qualified Data.List.HT as ListHT-import Test.QuickCheck.Modifiers (Positive(Positive), )-import Test.QuickCheck (Property, quickCheck, )-import Test.Utility- (V, W, X, P, applyId, applyModel,- eq0, eq1, eq2, eqnotnull1, eqnotnull2, eqnotnull3, )-import Text.Printf (printf)----- * compare Data.StorableVector <=> ByteString--limit :: Int -> Int-limit = flip mod 10000--prop_concatVP :: [V] -> Bool-prop_nullVP :: V -> Bool-prop_reverseVP :: V -> Bool-prop_transposeVP :: [V] -> Bool-prop_groupVP :: V -> Bool-prop_initsVP :: V -> Bool-prop_tailsVP :: V -> Bool-prop_allVP :: (W -> Bool) -> V -> Bool-prop_anyVP :: (W -> Bool) -> V -> Bool-prop_appendVP :: V -> V -> Bool-prop_breakVP :: (W -> Bool) -> V -> Bool-prop_concatMapVP :: (W -> V) -> V -> Bool-prop_consVP :: W -> V -> Bool-prop_countVP :: W -> V -> Bool-prop_dropVP :: X -> V -> Bool-prop_dropWhileVP :: (W -> Bool) -> V -> Bool-prop_filterVP :: (W -> Bool) -> V -> Bool-prop_findVP :: (W -> Bool) -> V -> Bool-prop_findIndexVP :: (W -> Bool) -> V -> Bool-prop_findIndicesVP :: (W -> Bool) -> V -> Bool-prop_isPrefixOfVP :: V -> V -> Bool-prop_mapVP :: (W -> W) -> V -> Bool-prop_replicateVP :: X -> W -> Bool-prop_iterateVP :: X -> (W -> W) -> W -> Bool-prop_snocVP :: V -> W -> Bool-prop_spanVP :: (W -> Bool) -> V -> Bool-prop_splitVP :: W -> V -> Bool-prop_splitAtVP :: X -> V -> Bool-prop_sieveVP :: Positive X -> V -> Bool-prop_sliceVerticalVP :: Positive X -> V -> Bool-prop_deinterleaveVP :: Positive X -> V -> Bool-prop_interleaveVP :: Positive X -> V -> Bool-prop_takeVP :: X -> V -> Bool-prop_takeWhileVP :: (W -> Bool) -> V -> Bool-prop_elemVP :: W -> V -> Bool-prop_notElemVP :: W -> V -> Bool-prop_elemIndexVP :: W -> V -> Bool-prop_elemIndicesVP :: W -> V -> Bool-prop_lengthVP :: V -> Bool-prop_headVP :: V -> Property-prop_initVP :: V -> Property-prop_lastVP :: V -> Property-prop_maximumVP :: V -> Property-prop_minimumVP :: V -> Property-prop_tailVP :: V -> Property-prop_foldl1VP :: (W -> W -> W) -> V -> Property-prop_foldl1VP' :: (W -> W -> W) -> V -> Property-prop_foldr1VP :: (W -> W -> W) -> V -> Property-prop_scanlVP :: (W -> W -> W) -> W -> V -> Property-prop_scanrVP :: (W -> W -> W) -> W -> V -> Property-prop_eqVP :: V -> V -> Bool-prop_foldlVP :: (X -> W -> X) -> X -> V -> Bool-prop_foldlVP' :: (X -> W -> X) -> X -> V -> Bool-prop_foldrVP :: (W -> X -> X) -> X -> V -> Bool-prop_mapAccumLVP :: (X -> W -> (X, W)) -> X -> V -> Bool-prop_mapAccumRVP :: (X -> W -> (X, W)) -> X -> V -> Bool-prop_zipWithVP :: (W -> W -> W) -> V -> V -> Bool--prop_concatVP = V.concat `eq1` P.concat-prop_nullVP = V.null `eq1` P.null-prop_reverseVP = V.reverse `eq1` P.reverse-prop_transposeVP = V.transpose `eq1` P.transpose-prop_groupVP = V.group `eq1` P.group-prop_initsVP = V.inits `eq1` P.inits-prop_tailsVP = V.tails `eq1` P.tails-prop_allVP = V.all `eq2` P.all-prop_anyVP = V.any `eq2` P.any-prop_appendVP = V.append `eq2` P.append-prop_breakVP = V.break `eq2` P.break-prop_concatMapVP = V.concatMap `eq2` P.concatMap-prop_consVP = V.cons `eq2` P.cons-prop_countVP = V.count `eq2` P.count-prop_dropVP = V.drop `eq2` P.drop-prop_dropWhileVP = V.dropWhile `eq2` P.dropWhile-prop_filterVP = V.filter `eq2` P.filter-prop_findVP = V.find `eq2` P.find-prop_findIndexVP = V.findIndex `eq2` P.findIndex-prop_findIndicesVP = V.findIndices `eq2` P.findIndices-prop_isPrefixOfVP = V.isPrefixOf `eq2` P.isPrefixOf-prop_mapVP = V.map `eq2` P.map-prop_replicateVP = (\n -> V.replicate n `eq1` P.replicate n) . limit-prop_iterateVP = (\n f -> V.iterateN n f `eq1` P.pack . take n . iterate f) . limit-prop_snocVP = V.snoc `eq2` P.snoc-prop_spanVP = V.span `eq2` P.span-prop_splitVP = V.split `eq2` P.split-prop_splitAtVP = V.splitAt `eq2` P.splitAt-prop_takeVP = V.take `eq2` P.take-prop_takeWhileVP = V.takeWhile `eq2` P.takeWhile-prop_elemVP = V.elem `eq2` P.elem-prop_notElemVP = V.notElem `eq2` P.notElem-prop_elemIndexVP = V.elemIndex `eq2` P.elemIndex-prop_elemIndicesVP = V.elemIndices `eq2` P.elemIndices-prop_lengthVP = V.length `eq1` P.length--prop_headVP = V.head `eqnotnull1` P.head-prop_initVP = V.init `eqnotnull1` P.init-prop_lastVP = V.last `eqnotnull1` P.last-prop_maximumVP = V.maximum `eqnotnull1` P.maximum-prop_minimumVP = V.minimum `eqnotnull1` P.minimum-prop_tailVP = V.tail `eqnotnull1` P.tail-prop_foldl1VP = V.foldl1 `eqnotnull2` P.foldl1-prop_foldl1VP' = V.foldl1' `eqnotnull2` P.foldl1'-prop_foldr1VP = V.foldr1 `eqnotnull2` P.foldr1-prop_scanlVP = V.scanl `eqnotnull3` P.scanl-prop_scanrVP = V.scanr `eqnotnull3` P.scanr--prop_sliceVerticalVP (Positive n) =- V.sliceVertical n `eq1` (ListHT.sliceVertical n :: [W] -> [[W]])--prop_sieveVP (Positive n) =- V.sieve n `eq1` (ListHT.sieve n :: [W] -> [W])--prop_deinterleaveVP (Positive n) =- V.deinterleave n `eq1` (ListHT.sliceHorizontal n :: [W] -> [[W]])--prop_interleaveVP (Positive n) xs =- let xss = ListHT.switchR [] const $ V.sliceVertical n xs- in V.interleave xss == V.concat (V.transpose xss)--prop_eqVP =- eq2- ((==) :: V -> V -> Bool)- ((==) :: P -> P -> Bool)-prop_foldlVP f b as =- uncurry eq0- ((V.foldl, P.foldl) `applyId` f `applyId` b `applyModel` as)-prop_foldlVP' f b as =- uncurry eq0- ((V.foldl', P.foldl') `applyId` f `applyId` b `applyModel` as)-prop_foldrVP f b as =- uncurry eq0- ((V.foldr, P.foldr) `applyId` f `applyId` b `applyModel` as)-prop_mapAccumLVP f b as =- uncurry eq0- ((V.mapAccumL, P.mapAccumL) `applyId` f `applyId` b `applyModel` as)-prop_mapAccumRVP f b as =- uncurry eq0- ((V.mapAccumR, P.mapAccumR) `applyId` f `applyId` b `applyModel` as)-prop_zipWithVP f xs ys =- uncurry eq0- ((V.zipWith f, \x y -> P.pack (P.zipWith f x y)) `applyModel` xs `applyModel` ys)+module Main (main) where -prop_unfoldrVP :: Int -> (X -> Maybe (W, X)) -> X -> Bool-prop_unfoldrVP n0 f =- let n = limit n0- in eq1- (fst . V.unfoldrN n f)- (fst . P.unfoldrN n f)+import qualified Test.Lazy as Lazy+import qualified Test.Strict as Strict+import Text.Printf (printf) -vp_tests :: [(String, IO ())]-vp_tests =- ("all", quickCheck prop_allVP) :- ("any", quickCheck prop_anyVP) :- ("append", quickCheck prop_appendVP) :- ("concat", quickCheck prop_concatVP) :- ("cons", quickCheck prop_consVP) :- ("eq", quickCheck prop_eqVP) :- ("filter", quickCheck prop_filterVP) :- ("find", quickCheck prop_findVP) :- ("findIndex", quickCheck prop_findIndexVP) :- ("findIndices", quickCheck prop_findIndicesVP) :- ("foldl", quickCheck prop_foldlVP) :- ("foldl'", quickCheck prop_foldlVP') :- ("foldl1", quickCheck prop_foldl1VP) :- ("foldl1'", quickCheck prop_foldl1VP') :- ("foldr", quickCheck prop_foldrVP) :- ("foldr1", quickCheck prop_foldr1VP) :- ("mapAccumL", quickCheck prop_mapAccumLVP) :- ("mapAccumR", quickCheck prop_mapAccumRVP) :- ("zipWith", quickCheck prop_zipWithVP) :- ("unfoldr", quickCheck prop_unfoldrVP) :- ("head", quickCheck prop_headVP) :- ("init", quickCheck prop_initVP) :- ("isPrefixOf", quickCheck prop_isPrefixOfVP) :- ("last", quickCheck prop_lastVP) :- ("length", quickCheck prop_lengthVP) :- ("map", quickCheck prop_mapVP) :- ("maximum", quickCheck prop_maximumVP) :- ("minimum", quickCheck prop_minimumVP) :- ("null", quickCheck prop_nullVP) :- ("reverse", quickCheck prop_reverseVP) :- ("snoc", quickCheck prop_snocVP) :- ("tail", quickCheck prop_tailVP) :- ("scanl", quickCheck prop_scanlVP) :- ("scanr", quickCheck prop_scanrVP) :- ("transpose", quickCheck prop_transposeVP) :- ("replicate", quickCheck prop_replicateVP) :- ("iterateN", quickCheck prop_iterateVP) :- ("take", quickCheck prop_takeVP) :- ("drop", quickCheck prop_dropVP) :- ("splitAt", quickCheck prop_splitAtVP) :- ("takeWhile", quickCheck prop_takeWhileVP) :- ("dropWhile", quickCheck prop_dropWhileVP) :- ("break", quickCheck prop_breakVP) :- ("span", quickCheck prop_spanVP) :- ("split", quickCheck prop_splitVP) :- ("count", quickCheck prop_countVP) :- ("group", quickCheck prop_groupVP) :- ("inits", quickCheck prop_initsVP) :- ("tails", quickCheck prop_tailsVP) :- ("elem", quickCheck prop_elemVP) :- ("notElem", quickCheck prop_notElemVP) :- ("elemIndex", quickCheck prop_elemIndexVP) :- ("elemIndices", quickCheck prop_elemIndicesVP) :- ("concatMap", quickCheck prop_concatMapVP) :- ("sieve", quickCheck prop_sieveVP) :- ("sliceVertical", quickCheck prop_sliceVerticalVP) :- ("deinterleave", quickCheck prop_deinterleaveVP) :- ("interleave", quickCheck prop_interleaveVP) :- []-+run :: String -> [(String, IO ())] -> IO ()+run prefix tests =+ mapM_ (\(s,a) -> printf "%-25s: " (prefix ++ "." ++ s) >> a) tests main :: IO ()-main = run vp_tests--run :: [(String, IO ())] -> IO ()-run tests = do- mapM_ (\(s,a) -> printf "%-25s: " s >> a) tests+main = do+ run "SV" Strict.vp_tests+ run "SVL" Lazy.tests
+ tests/Test/Lazy.hs view
@@ -0,0 +1,61 @@+module Test.Lazy (tests) where++import qualified Alternative.Lazy as AltLazy++import qualified Data.StorableVector.Lazy as VL+import qualified Data.StorableVector as V+import qualified Data.List.HT as ListHT+import qualified Data.List as List+import qualified Data.Word as Word++import Foreign.Storable (Storable)++import Test.QuickCheck (quickCheck)+++type W = Word.Word16++compactEqual :: VL.ChunkSize -> [V.Vector W] -> Bool+compactEqual chunkSize chunks =+ let xs = VL.fromChunks chunks+ in VL.unpack xs == VL.unpack (VL.compact chunkSize xs)++fromChunksLimited ::+ (Storable a) => VL.ChunkSize -> [V.Vector a] -> VL.Vector a+fromChunksLimited (VL.ChunkSize size) =+ VL.fromChunks . List.concatMap (V.sliceVertical size)++compactLimit :: VL.ChunkSize -> [V.Vector W] -> Bool+compactLimit chunkSize =+ all ((<=chunkSize) . VL.chunkSize . V.length) .+ VL.chunks . VL.compact chunkSize . fromChunksLimited chunkSize++compactMax :: VL.ChunkSize -> [V.Vector W] -> Bool+compactMax chunkSize =+ all ((>chunkSize) . VL.chunkSize) .+ ListHT.mapAdjacent (+) . map V.length .+ VL.chunks . VL.compact chunkSize . fromChunksLimited chunkSize++compactAlt :: VL.ChunkSize -> [V.Vector W] -> Bool+compactAlt chunkSize@(VL.ChunkSize size) chunks =+ let xs = fromChunksLimited chunkSize chunks+ in (map sum $ AltLazy.compact3 size $ map V.length $ VL.chunks xs)+ ==+ (map V.length $ VL.chunks $ VL.compact chunkSize xs)++compactAltLens ::+ (Int -> [Int] -> [[Int]]) -> VL.ChunkSize -> [V.Vector W] -> Bool+compactAltLens compactLens chunkSize@(VL.ChunkSize size) chunks =+ let lens = map V.length $ VL.chunks $ fromChunksLimited chunkSize chunks+ in AltLazy.compact3 size lens == compactLens size lens+++tests :: [(String, IO ())]+tests =+ ("compactEqual", quickCheck compactEqual) :+ ("compactLimit", quickCheck compactLimit) :+ ("compactMax", quickCheck compactMax) :+ ("compactAlt", quickCheck compactAlt) :+ ("compactAlt2", quickCheck $ compactAltLens AltLazy.compact2) :+ ("compactAlt4", quickCheck $ compactAltLens AltLazy.compact4) :+ []
+ tests/Test/Strict.hs view
@@ -0,0 +1,232 @@+module Test.Strict where++import qualified Data.StorableVector as V+import qualified Data.ByteString as P+import qualified Data.List.HT as ListHT++import qualified Test.QuickCheck as QC+import Test.QuickCheck.Modifiers (Positive(Positive), )+import Test.QuickCheck (Property, quickCheck, )+import Test.Utility+ (V, W, X, P, applyId, applyModel,+ eq0, eq1, eq2, eqnotnull1, eqnotnull2, eqnotnull3, )+++-- * compare Data.StorableVector <=> ByteString++newtype Size = Size {getSize :: Int}+ deriving (Show)++instance QC.Arbitrary Size where+ arbitrary = fmap Size $ QC.choose (0,10000)++prop_concatVP :: [V] -> Bool+prop_nullVP :: V -> Bool+prop_reverseVP :: V -> Bool+prop_transposeVP :: [V] -> Bool+prop_groupVP :: V -> Bool+prop_initsVP :: V -> Bool+prop_tailsVP :: V -> Bool+prop_allVP :: (W -> Bool) -> V -> Bool+prop_anyVP :: (W -> Bool) -> V -> Bool+prop_appendVP :: V -> V -> Bool+prop_breakVP :: (W -> Bool) -> V -> Bool+prop_concatMapVP :: (W -> V) -> V -> Bool+prop_consVP :: W -> V -> Bool+prop_countVP :: W -> V -> Bool+prop_dropVP :: X -> V -> Bool+prop_dropWhileVP :: (W -> Bool) -> V -> Bool+prop_filterVP :: (W -> Bool) -> V -> Bool+prop_findVP :: (W -> Bool) -> V -> Bool+prop_findIndexVP :: (W -> Bool) -> V -> Bool+prop_findIndicesVP :: (W -> Bool) -> V -> Bool+prop_isPrefixOfVP :: V -> V -> Bool+prop_mapVP :: (W -> W) -> V -> Bool+prop_replicateVP :: Size -> W -> Bool+prop_iterateVP :: Size -> (W -> W) -> W -> Bool+prop_snocVP :: V -> W -> Bool+prop_spanVP :: (W -> Bool) -> V -> Bool+prop_splitVP :: W -> V -> Bool+prop_splitAtVP :: X -> V -> Bool+prop_sieveVP :: Positive X -> V -> Bool+prop_sliceVerticalVP :: Positive X -> V -> Bool+prop_deinterleaveVP :: Positive X -> V -> Bool+prop_interleaveVP :: Positive X -> V -> Bool+prop_takeVP :: X -> V -> Bool+prop_takeWhileVP :: (W -> Bool) -> V -> Bool+prop_elemVP :: W -> V -> Bool+prop_notElemVP :: W -> V -> Bool+prop_elemIndexVP :: W -> V -> Bool+prop_elemIndicesVP :: W -> V -> Bool+prop_lengthVP :: V -> Bool+prop_headVP :: V -> Property+prop_initVP :: V -> Property+prop_lastVP :: V -> Property+prop_maximumVP :: V -> Property+prop_minimumVP :: V -> Property+prop_tailVP :: V -> Property+prop_foldl1VP :: (W -> W -> W) -> V -> Property+prop_foldl1VP' :: (W -> W -> W) -> V -> Property+prop_foldr1VP :: (W -> W -> W) -> V -> Property+prop_scanlVP :: (W -> W -> W) -> W -> V -> Property+prop_scanrVP :: (W -> W -> W) -> W -> V -> Property+prop_eqVP :: V -> V -> Bool+prop_foldlVP :: (X -> W -> X) -> X -> V -> Bool+prop_foldlVP' :: (X -> W -> X) -> X -> V -> Bool+prop_foldrVP :: (W -> X -> X) -> X -> V -> Bool+prop_mapAccumLVP :: (X -> W -> (X, W)) -> X -> V -> Bool+prop_mapAccumRVP :: (X -> W -> (X, W)) -> X -> V -> Bool+prop_zipWithVP :: (W -> W -> W) -> V -> V -> Bool++prop_concatVP = V.concat `eq1` P.concat+prop_nullVP = V.null `eq1` P.null+prop_reverseVP = V.reverse `eq1` P.reverse+prop_transposeVP = V.transpose `eq1` P.transpose+prop_groupVP = V.group `eq1` P.group+prop_initsVP = V.inits `eq1` P.inits+prop_tailsVP = V.tails `eq1` P.tails+prop_allVP = V.all `eq2` P.all+prop_anyVP = V.any `eq2` P.any+prop_appendVP = V.append `eq2` P.append+prop_breakVP = V.break `eq2` P.break+prop_concatMapVP = V.concatMap `eq2` P.concatMap+prop_consVP = V.cons `eq2` P.cons+prop_countVP = V.count `eq2` P.count+prop_dropVP = V.drop `eq2` P.drop+prop_dropWhileVP = V.dropWhile `eq2` P.dropWhile+prop_filterVP = V.filter `eq2` P.filter+prop_findVP = V.find `eq2` P.find+prop_findIndexVP = V.findIndex `eq2` P.findIndex+prop_findIndicesVP = V.findIndices `eq2` P.findIndices+prop_isPrefixOfVP = V.isPrefixOf `eq2` P.isPrefixOf+prop_mapVP = V.map `eq2` P.map+prop_replicateVP = (\n -> V.replicate n `eq1` P.replicate n) . getSize+prop_iterateVP = (\n f -> V.iterateN n f `eq1` P.pack . take n . iterate f) . getSize+prop_snocVP = V.snoc `eq2` P.snoc+prop_spanVP = V.span `eq2` P.span+prop_splitVP = V.split `eq2` P.split+prop_splitAtVP = V.splitAt `eq2` P.splitAt+prop_takeVP = V.take `eq2` P.take+prop_takeWhileVP = V.takeWhile `eq2` P.takeWhile+prop_elemVP = V.elem `eq2` P.elem+prop_notElemVP = V.notElem `eq2` P.notElem+prop_elemIndexVP = V.elemIndex `eq2` P.elemIndex+prop_elemIndicesVP = V.elemIndices `eq2` P.elemIndices+prop_lengthVP = V.length `eq1` P.length++prop_headVP = V.head `eqnotnull1` P.head+prop_initVP = V.init `eqnotnull1` P.init+prop_lastVP = V.last `eqnotnull1` P.last+prop_maximumVP = V.maximum `eqnotnull1` P.maximum+prop_minimumVP = V.minimum `eqnotnull1` P.minimum+prop_tailVP = V.tail `eqnotnull1` P.tail+prop_foldl1VP = V.foldl1 `eqnotnull2` P.foldl1+prop_foldl1VP' = V.foldl1' `eqnotnull2` P.foldl1'+prop_foldr1VP = V.foldr1 `eqnotnull2` P.foldr1+prop_scanlVP = V.scanl `eqnotnull3` P.scanl+prop_scanrVP = V.scanr `eqnotnull3` P.scanr++prop_sliceVerticalVP (Positive n) =+ V.sliceVertical n `eq1` (ListHT.sliceVertical n :: [W] -> [[W]])++prop_sieveVP (Positive n) =+ V.sieve n `eq1` (ListHT.sieve n :: [W] -> [W])++prop_deinterleaveVP (Positive n) =+ V.deinterleave n `eq1` (ListHT.sliceHorizontal n :: [W] -> [[W]])++prop_interleaveVP (Positive n) xs =+ let xss = ListHT.switchR [] const $ V.sliceVertical n xs+ in V.interleave xss == V.concat (V.transpose xss)++prop_eqVP =+ eq2+ ((==) :: V -> V -> Bool)+ ((==) :: P -> P -> Bool)+prop_foldlVP f b as =+ uncurry eq0+ ((V.foldl, P.foldl) `applyId` f `applyId` b `applyModel` as)+prop_foldlVP' f b as =+ uncurry eq0+ ((V.foldl', P.foldl') `applyId` f `applyId` b `applyModel` as)+prop_foldrVP f b as =+ uncurry eq0+ ((V.foldr, P.foldr) `applyId` f `applyId` b `applyModel` as)+prop_mapAccumLVP f b as =+ uncurry eq0+ ((V.mapAccumL, P.mapAccumL) `applyId` f `applyId` b `applyModel` as)+prop_mapAccumRVP f b as =+ uncurry eq0+ ((V.mapAccumR, P.mapAccumR) `applyId` f `applyId` b `applyModel` as)+prop_zipWithVP f xs ys =+ uncurry eq0+ ((V.zipWith f, \x y -> P.pack (P.zipWith f x y)) `applyModel` xs `applyModel` ys)++prop_unfoldrVP :: Size -> (X -> Maybe (W, X)) -> X -> Bool+prop_unfoldrVP n f =+ eq1+ (V.unfoldrN (getSize n) f)+ (P.unfoldrN (getSize n) f)+++vp_tests :: [(String, IO ())]+vp_tests =+ ("all", quickCheck prop_allVP) :+ ("any", quickCheck prop_anyVP) :+ ("append", quickCheck prop_appendVP) :+ ("concat", quickCheck prop_concatVP) :+ ("cons", quickCheck prop_consVP) :+ ("eq", quickCheck prop_eqVP) :+ ("filter", quickCheck prop_filterVP) :+ ("find", quickCheck prop_findVP) :+ ("findIndex", quickCheck prop_findIndexVP) :+ ("findIndices", quickCheck prop_findIndicesVP) :+ ("foldl", quickCheck prop_foldlVP) :+ ("foldl'", quickCheck prop_foldlVP') :+ ("foldl1", quickCheck prop_foldl1VP) :+ ("foldl1'", quickCheck prop_foldl1VP') :+ ("foldr", quickCheck prop_foldrVP) :+ ("foldr1", quickCheck prop_foldr1VP) :+ ("mapAccumL", quickCheck prop_mapAccumLVP) :+ ("mapAccumR", quickCheck prop_mapAccumRVP) :+ ("zipWith", quickCheck prop_zipWithVP) :+ ("unfoldr", quickCheck prop_unfoldrVP) :+ ("head", quickCheck prop_headVP) :+ ("init", quickCheck prop_initVP) :+ ("isPrefixOf", quickCheck prop_isPrefixOfVP) :+ ("last", quickCheck prop_lastVP) :+ ("length", quickCheck prop_lengthVP) :+ ("map", quickCheck prop_mapVP) :+ ("maximum", quickCheck prop_maximumVP) :+ ("minimum", quickCheck prop_minimumVP) :+ ("null", quickCheck prop_nullVP) :+ ("reverse", quickCheck prop_reverseVP) :+ ("snoc", quickCheck prop_snocVP) :+ ("tail", quickCheck prop_tailVP) :+ ("scanl", quickCheck prop_scanlVP) :+ ("scanr", quickCheck prop_scanrVP) :+ ("transpose", quickCheck prop_transposeVP) :+ ("replicate", quickCheck prop_replicateVP) :+ ("iterateN", quickCheck prop_iterateVP) :+ ("take", quickCheck prop_takeVP) :+ ("drop", quickCheck prop_dropVP) :+ ("splitAt", quickCheck prop_splitAtVP) :+ ("takeWhile", quickCheck prop_takeWhileVP) :+ ("dropWhile", quickCheck prop_dropWhileVP) :+ ("break", quickCheck prop_breakVP) :+ ("span", quickCheck prop_spanVP) :+ ("split", quickCheck prop_splitVP) :+ ("count", quickCheck prop_countVP) :+ ("group", quickCheck prop_groupVP) :+ ("inits", quickCheck prop_initsVP) :+ ("tails", quickCheck prop_tailsVP) :+ ("elem", quickCheck prop_elemVP) :+ ("notElem", quickCheck prop_notElemVP) :+ ("elemIndex", quickCheck prop_elemIndexVP) :+ ("elemIndices", quickCheck prop_elemIndicesVP) :+ ("concatMap", quickCheck prop_concatMapVP) :+ ("sieve", quickCheck prop_sieveVP) :+ ("sliceVertical", quickCheck prop_sliceVerticalVP) :+ ("deinterleave", quickCheck prop_deinterleaveVP) :+ ("interleave", quickCheck prop_interleaveVP) :+ []