diff --git a/Data/Vector.hs b/Data/Vector.hs --- a/Data/Vector.hs +++ b/Data/Vector.hs @@ -56,10 +56,11 @@ empty, singleton, replicate, generate, iterateN, -- ** Monadic initialisation - replicateM, generateM, create, + replicateM, generateM, iterateNM, create, createT, -- ** Unfolding unfoldr, unfoldrN, + unfoldrM, unfoldrNM, constructN, constructrN, -- ** Enumeration @@ -112,7 +113,9 @@ -- * Working with predicates -- ** Filtering - filter, ifilter, filterM, + filter, ifilter, uniq, + mapMaybe, imapMaybe, + filterM, takeWhile, dropWhile, -- ** Partitioning @@ -143,14 +146,16 @@ prescanl, prescanl', postscanl, postscanl', scanl, scanl', scanl1, scanl1', + iscanl, iscanl', prescanr, prescanr', postscanr, postscanr', scanr, scanr', scanr1, scanr1', + iscanr, iscanr', -- * Conversions -- ** Lists - toList, fromList, fromListN, + toList, Data.Vector.fromList, Data.Vector.fromListN, -- ** Other vector types G.convert, @@ -169,6 +174,9 @@ import Control.Monad.ST ( ST ) import Control.Monad.Primitive + +import Control.Monad.Zip + import Prelude hiding ( length, null, replicate, (++), concat, head, last, @@ -183,15 +191,23 @@ enumFromTo, enumFromThenTo, mapM, mapM_, sequence, sequence_ ) -import Data.Typeable ( Typeable ) -import Data.Data ( Data(..) ) -import Text.Read ( Read(..), readListPrecDefault ) +#if MIN_VERSION_base(4,9,0) +import Data.Functor.Classes (Eq1 (..), Ord1 (..), Read1 (..), Show1 (..)) +#endif -import Data.Monoid ( Monoid(..) ) +import Data.Typeable ( Typeable ) +import Data.Data ( Data(..) ) +import Text.Read ( Read(..), readListPrecDefault ) +import Data.Semigroup ( Semigroup(..) ) + import qualified Control.Applicative as Applicative import qualified Data.Foldable as Foldable import qualified Data.Traversable as Traversable +#if !MIN_VERSION_base(4,8,0) +import Data.Monoid ( Monoid(..) ) +#endif + #if __GLASGOW_HASKELL__ >= 708 import qualified GHC.Exts as Exts (IsList(..)) #endif @@ -216,12 +232,20 @@ readPrec = G.readPrec readListPrec = readListPrecDefault +#if MIN_VERSION_base(4,9,0) +instance Show1 Vector where + liftShowsPrec = G.liftShowsPrec + +instance Read1 Vector where + liftReadsPrec = G.liftReadsPrec +#endif + #if __GLASGOW_HASKELL__ >= 708 instance Exts.IsList (Vector a) where type Item (Vector a) = a - fromList = fromList - fromListN = fromListN + fromList = Data.Vector.fromList + fromListN = Data.Vector.fromListN toList = toList #endif @@ -281,6 +305,21 @@ {-# INLINE (>=) #-} xs >= ys = Bundle.cmp (G.stream xs) (G.stream ys) /= LT +#if MIN_VERSION_base(4,9,0) +instance Eq1 Vector where + liftEq eq xs ys = Bundle.eqBy eq (G.stream xs) (G.stream ys) + +instance Ord1 Vector where + liftCompare cmp xs ys = Bundle.cmpBy cmp (G.stream xs) (G.stream ys) +#endif + +instance Semigroup (Vector a) where + {-# INLINE (<>) #-} + (<>) = (++) + + {-# INLINE sconcat #-} + sconcat = G.concatNE + instance Monoid (Vector a) where {-# INLINE mempty #-} mempty = empty @@ -297,7 +336,7 @@ instance Monad Vector where {-# INLINE return #-} - return = singleton + return = Applicative.pure {-# INLINE (>>=) #-} (>>=) = flip concatMap @@ -312,6 +351,17 @@ {-# INLINE mplus #-} mplus = (++) +instance MonadZip Vector where + {-# INLINE mzip #-} + mzip = zip + + {-# INLINE mzipWith #-} + mzipWith = zipWith + + {-# INLINE munzip #-} + munzip = unzip + + instance Applicative.Applicative Vector where {-# INLINE pure #-} pure = singleton @@ -339,9 +389,43 @@ {-# INLINE foldl1 #-} foldl1 = foldl1 +#if MIN_VERSION_base(4,6,0) + {-# INLINE foldr' #-} + foldr' = foldr' + + {-# INLINE foldl' #-} + foldl' = foldl' +#endif + +#if MIN_VERSION_base(4,8,0) + {-# INLINE toList #-} + toList = toList + + {-# INLINE length #-} + length = length + + {-# INLINE null #-} + null = null + + {-# INLINE elem #-} + elem = elem + + {-# INLINE maximum #-} + maximum = maximum + + {-# INLINE minimum #-} + minimum = minimum + + {-# INLINE sum #-} + sum = sum + + {-# INLINE product #-} + product = product +#endif + instance Traversable.Traversable Vector where {-# INLINE traverse #-} - traverse f xs = fromList Applicative.<$> Traversable.traverse f (toList xs) + traverse f xs = Data.Vector.fromList Applicative.<$> Traversable.traverse f (toList xs) {-# INLINE mapM #-} mapM = mapM @@ -352,12 +436,12 @@ -- Length information -- ------------------ --- | /O(1)/ Yield the length of the vector. +-- | /O(1)/ Yield the length of the vector length :: Vector a -> Int {-# INLINE length #-} length = G.length --- | /O(1)/ Test whether a vector if empty +-- | /O(1)/ Test whether a vector is empty null :: Vector a -> Bool {-# INLINE null #-} null = G.null @@ -575,8 +659,8 @@ {-# INLINE unfoldr #-} unfoldr = G.unfoldr --- | /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 +-- | /O(n)/ Construct a vector with at most @n@ elements by repeatedly applying +-- the generator function to a seed. The generator function yields 'Just' the -- next element and the new seed or 'Nothing' if there are no more elements. -- -- > unfoldrN 3 (\n -> Just (n,n-1)) 10 = <10,9,8> @@ -584,6 +668,22 @@ {-# INLINE unfoldrN #-} unfoldrN = G.unfoldrN +-- | /O(n)/ Construct a vector by repeatedly applying the monadic +-- generator function to a seed. The generator function yields 'Just' +-- the next element and the new seed or 'Nothing' if there are no more +-- elements. +unfoldrM :: (Monad m) => (b -> m (Maybe (a, b))) -> b -> m (Vector a) +{-# INLINE unfoldrM #-} +unfoldrM = G.unfoldrM + +-- | /O(n)/ Construct a vector by repeatedly applying the monadic +-- generator function to a seed. The generator function yields 'Just' +-- the next element and the new seed or 'Nothing' if there are no more +-- elements. +unfoldrNM :: (Monad m) => Int -> (b -> m (Maybe (a, b))) -> b -> m (Vector a) +{-# INLINE unfoldrNM #-} +unfoldrNM = G.unfoldrNM + -- | /O(n)/ Construct a vector with @n@ elements by repeatedly applying the -- generator function to the already constructed part of the vector. -- @@ -677,6 +777,11 @@ {-# INLINE generateM #-} generateM = G.generateM +-- | /O(n)/ Apply monadic function n times to value. Zeroth element is original value. +iterateNM :: Monad m => Int -> (a -> m a) -> a -> m (Vector a) +{-# INLINE iterateNM #-} +iterateNM = G.iterateNM + -- | Execute the monadic action and freeze the resulting vector. -- -- @ @@ -687,8 +792,13 @@ -- NOTE: eta-expanded due to http://hackage.haskell.org/trac/ghc/ticket/4120 create p = G.create p +-- | Execute the monadic action and freeze the resulting vectors. +createT :: Traversable.Traversable f => (forall s. ST s (f (MVector s a))) -> f (Vector a) +{-# INLINE createT #-} +createT p = G.createT p + -- Restricting memory usage -- ------------------------ @@ -917,7 +1027,7 @@ imapM_ = G.imapM_ -- | /O(n)/ Apply the monadic action to all elements of the vector, yielding a --- vector of results. Equvalent to @flip 'mapM'@. +-- vector of results. Equivalent to @flip 'mapM'@. forM :: Monad m => Vector a -> (a -> m b) -> m (Vector b) {-# INLINE forM #-} forM = G.forM @@ -1079,6 +1189,21 @@ {-# INLINE ifilter #-} ifilter = G.ifilter +-- | /O(n)/ Drop repeated adjacent elements. +uniq :: (Eq a) => Vector a -> Vector a +{-# INLINE uniq #-} +uniq = G.uniq + +-- | /O(n)/ Drop elements when predicate returns Nothing +mapMaybe :: (a -> Maybe b) -> Vector a -> Vector b +{-# INLINE mapMaybe #-} +mapMaybe = G.mapMaybe + +-- | /O(n)/ Drop elements when predicate, applied to index and value, returns Nothing +imapMaybe :: (Int -> a -> Maybe b) -> Vector a -> Vector b +{-# INLINE imapMaybe #-} +imapMaybe = G.imapMaybe + -- | /O(n)/ Drop elements that do not satisfy the monadic predicate filterM :: Monad m => (a -> m Bool) -> Vector a -> m (Vector a) {-# INLINE filterM #-} @@ -1453,6 +1578,16 @@ {-# INLINE scanl' #-} scanl' = G.scanl' +-- | /O(n)/ Scan over a vector with its index +iscanl :: (Int -> a -> b -> a) -> a -> Vector b -> Vector a +{-# INLINE iscanl #-} +iscanl = G.iscanl + +-- | /O(n)/ Scan over a vector (strictly) with its index +iscanl' :: (Int -> a -> b -> a) -> a -> Vector b -> Vector a +{-# INLINE iscanl' #-} +iscanl' = G.iscanl' + -- | /O(n)/ Scan over a non-empty vector -- -- > scanl f = @@ -1503,6 +1638,16 @@ {-# INLINE scanr' #-} scanr' = G.scanr' +-- | /O(n)/ Right-to-left scan over a vector with its index +iscanr :: (Int -> a -> b -> b) -> b -> Vector a -> Vector b +{-# INLINE iscanr #-} +iscanr = G.iscanr + +-- | /O(n)/ Right-to-left scan over a vector (strictly) with its index +iscanr' :: (Int -> a -> b -> b) -> b -> Vector a -> Vector b +{-# INLINE iscanr' #-} +iscanr' = G.iscanr' + -- | /O(n)/ Right-to-left scan over a non-empty vector scanr1 :: (a -> a -> a) -> Vector a -> Vector a {-# INLINE scanr1 #-} @@ -1572,4 +1717,3 @@ copy :: PrimMonad m => MVector (PrimState m) a -> Vector a -> m () {-# INLINE copy #-} copy = G.copy - diff --git a/Data/Vector/Fusion/Bundle.hs b/Data/Vector/Fusion/Bundle.hs --- a/Data/Vector/Fusion/Bundle.hs +++ b/Data/Vector/Fusion/Bundle.hs @@ -73,7 +73,7 @@ -- * Monadic combinators mapM, mapM_, zipWithM, zipWithM_, filterM, foldM, fold1M, foldM', fold1M', - eq, cmp + eq, cmp, eqBy, cmpBy ) where import Data.Vector.Generic.Base ( Vector ) @@ -98,6 +98,10 @@ enumFromTo, enumFromThenTo, mapM, mapM_ ) +#if MIN_VERSION_base(4,9,0) +import Data.Functor.Classes (Eq1 (..), Ord1 (..)) +#endif + import GHC.Base ( build ) -- Data.Vector.Internal.Check is unused @@ -111,7 +115,7 @@ 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 + -> (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)) @@ -486,15 +490,23 @@ -- ----------- -- | Check if two 'Bundle's are equal -eq :: Eq a => Bundle v a -> Bundle v a -> Bool +eq :: (Eq a) => Bundle v a -> Bundle v a -> Bool {-# INLINE eq #-} -eq x y = unId (M.eq x y) +eq = eqBy (==) +eqBy :: (a -> b -> Bool) -> Bundle v a -> Bundle v b -> Bool +{-# INLINE eqBy #-} +eqBy e x y = unId (M.eqBy e x y) + -- | Lexicographically compare two 'Bundle's -cmp :: Ord a => Bundle v a -> Bundle v a -> Ordering +cmp :: (Ord a) => Bundle v a -> Bundle v a -> Ordering {-# INLINE cmp #-} -cmp x y = unId (M.cmp x y) +cmp = cmpBy compare +cmpBy :: (a -> b -> Ordering) -> Bundle v a -> Bundle v b -> Ordering +{-# INLINE cmpBy #-} +cmpBy c x y = unId (M.cmpBy c x y) + instance Eq a => Eq (M.Bundle Id v a) where {-# INLINE (==) #-} (==) = eq @@ -502,6 +514,16 @@ instance Ord a => Ord (M.Bundle Id v a) where {-# INLINE compare #-} compare = cmp + +#if MIN_VERSION_base(4,9,0) +instance Eq1 (M.Bundle Id v) where + {-# INLINE liftEq #-} + liftEq = eqBy + +instance Ord1 (M.Bundle Id v) where + {-# INLINE liftCompare #-} + liftCompare = cmpBy +#endif -- Monadic combinators -- ------------------- diff --git a/Data/Vector/Fusion/Bundle/Monadic.hs b/Data/Vector/Fusion/Bundle/Monadic.hs --- a/Data/Vector/Fusion/Bundle/Monadic.hs +++ b/Data/Vector/Fusion/Bundle/Monadic.hs @@ -40,7 +40,7 @@ zip, zip3, zip4, zip5, zip6, -- * Comparisons - eq, cmp, + eqBy, cmpBy, -- * Filtering filter, filterM, takeWhile, takeWhileM, dropWhile, dropWhileM, @@ -101,12 +101,20 @@ scanl, scanl1, enumFromTo, enumFromThenTo ) -import Data.Int ( Int8, Int16, Int32, Int64 ) -import Data.Word ( Word8, Word16, Word32, Word, Word64 ) +import Data.Int ( Int8, Int16, Int32 ) +import Data.Word ( Word8, Word16, Word32, Word64 ) +#if !MIN_VERSION_base(4,8,0) +import Data.Word ( Word ) +#endif + #include "vector.h" #include "MachDeps.h" +#if WORD_SIZE_IN_BITS > 32 +import Data.Int ( Int64 ) +#endif + data Chunk v a = Chunk Int (forall m. (PrimMonad m, Vector v a) => Mutable v (PrimState m) a -> m ()) -- | Monadic streams @@ -416,14 +424,14 @@ -- ----------- -- | 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 +eqBy :: (Monad m) => (a -> b -> Bool) -> Bundle m v a -> Bundle m v b -> m Bool +{-# INLINE_FUSED eqBy #-} +eqBy eq x y = S.eqBy eq (sElems x) (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 +cmpBy :: (Monad m) => (a -> b -> Ordering) -> Bundle m v a -> Bundle m v b -> m Ordering +{-# INLINE_FUSED cmpBy #-} +cmpBy cmp x y = S.cmpBy cmp (sElems x) (sElems y) -- Filtering -- --------- @@ -888,6 +896,7 @@ :: Monad m => Integer -> Integer -> Bundle m v Integer #-} +#if WORD_SIZE_IN_BITS > 32 -- FIXME: the "too large" test is totally wrong enumFromTo_big_int :: (Integral a, Monad m) => a -> a -> Bundle m v a @@ -906,7 +915,6 @@ step z | z <= y = return $ Yield z (z+1) | otherwise = return $ Done -#if WORD_SIZE_IN_BITS > 32 {-# RULES diff --git a/Data/Vector/Fusion/Stream/Monadic.hs b/Data/Vector/Fusion/Stream/Monadic.hs --- a/Data/Vector/Fusion/Stream/Monadic.hs +++ b/Data/Vector/Fusion/Stream/Monadic.hs @@ -37,10 +37,10 @@ zip, zip3, zip4, zip5, zip6, -- * Comparisons - eq, cmp, + eqBy, cmpBy, -- * Filtering - filter, filterM, takeWhile, takeWhileM, dropWhile, dropWhileM, + filter, filterM, uniq, mapMaybe, takeWhile, takeWhileM, dropWhile, dropWhileM, -- * Searching elem, notElem, find, findM, findIndex, findIndexM, @@ -89,8 +89,12 @@ scanl, scanl1, enumFromTo, enumFromThenTo ) -import Data.Int ( Int8, Int16, Int32, Int64 ) +import Data.Int ( Int8, Int16, Int32 ) +import Data.Word ( Word8, Word16, Word32, Word64 ) + +#if !MIN_VERSION_base(4,8,0) import Data.Word ( Word8, Word16, Word32, Word, Word64 ) +#endif #if __GLASGOW_HASKELL__ >= 708 import GHC.Types ( SPEC(..) ) @@ -101,6 +105,10 @@ #include "vector.h" #include "MachDeps.h" +#if WORD_SIZE_IN_BITS > 32 +import Data.Int ( Int64 ) +#endif + #if __GLASGOW_HASKELL__ < 708 data SPEC = SPEC | SPEC2 #if __GLASGOW_HASKELL__ >= 700 @@ -617,9 +625,9 @@ -- ----------- -- | 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 t1) (Stream step2 t2) = eq_loop0 SPEC t1 t2 +eqBy :: (Monad m) => (a -> b -> Bool) -> Stream m a -> Stream m b -> m Bool +{-# INLINE_FUSED eqBy #-} +eqBy eq (Stream step1 t1) (Stream step2 t2) = eq_loop0 SPEC t1 t2 where eq_loop0 !_ s1 s2 = do r <- step1 s1 @@ -632,7 +640,7 @@ r <- step2 s2 case r of Yield y s2' - | x == y -> eq_loop0 SPEC s1 s2' + | eq x y -> eq_loop0 SPEC s1 s2' | otherwise -> return False Skip s2' -> eq_loop1 SPEC x s1 s2' Done -> return False @@ -645,9 +653,9 @@ 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 t1) (Stream step2 t2) = cmp_loop0 SPEC t1 t2 +cmpBy :: (Monad m) => (a -> b -> Ordering) -> Stream m a -> Stream m b -> m Ordering +{-# INLINE_FUSED cmpBy #-} +cmpBy cmp (Stream step1 t1) (Stream step2 t2) = cmp_loop0 SPEC t1 t2 where cmp_loop0 !_ s1 s2 = do r <- step1 s1 @@ -659,7 +667,7 @@ cmp_loop1 !_ x s1 s2 = do r <- step2 s2 case r of - Yield y s2' -> case x `compare` y of + Yield y s2' -> case x `cmp` y of EQ -> cmp_loop0 SPEC s1 s2' c -> return c Skip s2' -> cmp_loop1 SPEC x s1 s2' @@ -680,6 +688,21 @@ {-# INLINE filter #-} filter f = filterM (return . f) +mapMaybe :: Monad m => (a -> Maybe b) -> Stream m a -> Stream m b +{-# INLINE_FUSED mapMaybe #-} +mapMaybe f (Stream step t) = Stream step' t + where + {-# INLINE_INNER step' #-} + step' s = do + r <- step s + case r of + Yield x s' -> do + return $ case f x of + Nothing -> Skip s' + Just b' -> Yield b' s' + Skip s' -> return $ Skip s' + Done -> return $ Done + -- | Drop elements which do not satisfy the monadic predicate filterM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a {-# INLINE_FUSED filterM #-} @@ -696,6 +719,24 @@ Skip s' -> return $ Skip s' Done -> return $ Done +-- | Drop repeated adjacent elements. +uniq :: (Eq a, Monad m) => Stream m a -> Stream m a +{-# INLINE_FUSED uniq #-} +uniq (Stream step st) = Stream step' (Nothing,st) + where + {-# INLINE_INNER step' #-} + step' (Nothing, s) = do r <- step s + case r of + Yield x s' -> return $ Yield x (Just x , s') + Skip s' -> return $ Skip (Nothing, s') + Done -> return Done + step' (Just x0, s) = do r <- step s + case r of + Yield x s' | x == x0 -> return $ Skip (Just x0, s') + | otherwise -> return $ Yield x (Just x , s') + Skip s' -> return $ Skip (Just x0, s') + Done -> return Done + -- | Longest prefix of elements that satisfy the predicate takeWhile :: Monad m => (a -> Bool) -> Stream m a -> Stream m a {-# INLINE takeWhile #-} @@ -1403,6 +1444,8 @@ +#if WORD_SIZE_IN_BITS > 32 + -- 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 #-} @@ -1411,8 +1454,6 @@ {-# INLINE_INNER step #-} step z | z <= y = return $ Yield z (z+1) | otherwise = return $ Done - -#if WORD_SIZE_IN_BITS > 32 {-# RULES diff --git a/Data/Vector/Fusion/Util.hs b/Data/Vector/Fusion/Util.hs --- a/Data/Vector/Fusion/Util.hs +++ b/Data/Vector/Fusion/Util.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} -- | -- Module : Data.Vector.Fusion.Util -- Copyright : (c) Roman Leshchinskiy 2009 @@ -16,7 +17,9 @@ delay_inline, delayed_min ) where +#if !MIN_VERSION_base(4,8,0) import Control.Applicative (Applicative(..)) +#endif -- | Identity monad newtype Id a = Id { unId :: a } @@ -29,7 +32,7 @@ Id f <*> Id x = Id (f x) instance Monad Id where - return = Id + return = pure Id x >>= f = f x -- | Box monad @@ -43,7 +46,7 @@ Box f <*> Box x = Box (f x) instance Monad Box where - return = Box + return = pure Box x >>= f = f x -- | Delay inlining a function until late in the game (simplifier phase 0). @@ -55,4 +58,3 @@ delayed_min :: Int -> Int -> Int {-# INLINE [0] delayed_min #-} delayed_min m n = min m n - diff --git a/Data/Vector/Generic.hs b/Data/Vector/Generic.hs --- a/Data/Vector/Generic.hs +++ b/Data/Vector/Generic.hs @@ -39,17 +39,18 @@ empty, singleton, replicate, generate, iterateN, -- ** Monadic initialisation - replicateM, generateM, create, + replicateM, generateM, iterateNM, create, createT, -- ** Unfolding unfoldr, unfoldrN, + unfoldrM, unfoldrNM, constructN, constructrN, -- ** Enumeration enumFromN, enumFromStepN, enumFromTo, enumFromThenTo, -- ** Concatenation - cons, snoc, (++), concat, + cons, snoc, (++), concat, concatNE, -- ** Restricting memory usage force, @@ -95,7 +96,9 @@ -- * Working with predicates -- ** Filtering - filter, ifilter, filterM, + filter, ifilter, uniq, + mapMaybe, imapMaybe, + filterM, takeWhile, dropWhile, -- ** Partitioning @@ -126,9 +129,11 @@ prescanl, prescanl', postscanl, postscanl', scanl, scanl', scanl1, scanl1', + iscanl, iscanl', prescanr, prescanr', postscanr, postscanr', scanr, scanr', scanr1, scanr1', + iscanr, iscanr', -- * Conversions @@ -153,9 +158,11 @@ -- ** Comparisons eq, cmp, + eqBy, cmpBy, -- ** Show and Read showsPrec, readPrec, + liftShowsPrec, liftReadsPrec, -- ** @Data@ and @Typeable@ gfoldl, dataCast, mkType @@ -194,6 +201,7 @@ showsPrec ) import qualified Text.Read as Read +import qualified Data.List.NonEmpty as NonEmpty #if __GLASGOW_HASKELL__ >= 707 import Data.Typeable ( Typeable, gcast1 ) @@ -212,15 +220,17 @@ mkNoRepType = mkNorepType #endif +import qualified Data.Traversable as T (Traversable(mapM)) + -- Length information -- ------------------ --- | /O(1)/ Yield the length of the vector. +-- | /O(1)/ Yield the length of the vector length :: Vector v a => v a -> Int {-# INLINE length #-} length = Bundle.length . stream --- | /O(1)/ Test whether a vector if empty +-- | /O(1)/ Test whether a vector is empty null :: Vector v a => v a -> Bool {-# INLINE null #-} null = Bundle.null . stream @@ -535,8 +545,8 @@ {-# INLINE unfoldr #-} unfoldr f = unstream . Bundle.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 +-- | /O(n)/ Construct a vector with at most @n@ elements by repeatedly applying +-- the generator function to a seed. The generator function yields 'Just' the -- next element and the new seed or 'Nothing' if there are no more elements. -- -- > unfoldrN 3 (\n -> Just (n,n-1)) 10 = <10,9,8> @@ -544,6 +554,22 @@ {-# INLINE unfoldrN #-} unfoldrN n f = unstream . Bundle.unfoldrN n f +-- | /O(n)/ Construct a vector by repeatedly applying the monadic +-- generator function to a seed. The generator function yields 'Just' +-- the next element and the new seed or 'Nothing' if there are no more +-- elements. +unfoldrM :: (Monad m, Vector v a) => (b -> m (Maybe (a, b))) -> b -> m (v a) +{-# INLINE unfoldrM #-} +unfoldrM f = unstreamM . MBundle.unfoldrM f + +-- | /O(n)/ Construct a vector by repeatedly applying the monadic +-- generator function to a seed. The generator function yields 'Just' +-- the next element and the new seed or 'Nothing' if there are no more +-- elements. +unfoldrNM :: (Monad m, Vector v a) => Int -> (b -> m (Maybe (a, b))) -> b -> m (v a) +{-# INLINE unfoldrNM #-} +unfoldrNM n f = unstreamM . MBundle.unfoldrNM n f + -- | /O(n)/ Construct a vector with @n@ elements by repeatedly applying the -- generator function to the already constructed part of the vector. -- @@ -685,6 +711,10 @@ k `seq` (v,0,k) -} +-- | /O(n)/ Concatenate all vectors in the non-empty list +concatNE :: Vector v a => NonEmpty.NonEmpty (v a) -> v a +concatNE = concat . NonEmpty.toList + -- Monadic initialisation -- ---------------------- @@ -700,6 +730,11 @@ {-# INLINE generateM #-} generateM n f = unstreamM (MBundle.generateM n f) +-- | /O(n)/ Apply monadic function n times to value. Zeroth element is original value. +iterateNM :: (Monad m, Vector v a) => Int -> (a -> m a) -> a -> m (v a) +{-# INLINE iterateNM #-} +iterateNM n f x = unstreamM (MBundle.iterateNM n f x) + -- | Execute the monadic action and freeze the resulting vector. -- -- @ @@ -709,6 +744,13 @@ {-# INLINE create #-} create p = new (New.create p) +-- | Execute the monadic action and freeze the resulting vectors. +createT + :: (T.Traversable f, Vector v a) + => (forall s. ST s (f (Mutable v s a))) -> f (v a) +{-# INLINE createT #-} +createT p = runST (p >>= T.mapM unsafeFreeze) + -- Restricting memory usage -- ------------------------ @@ -1038,7 +1080,7 @@ imapM_ f = Bundle.mapM_ (uncurry f) . Bundle.indexed . stream -- | /O(n)/ Apply the monadic action to all elements of the vector, yielding a --- vector of results. Equvalent to @flip 'mapM'@. +-- vector of results. Equivalent to @flip 'mapM'@. forM :: (Monad m, Vector v a, Vector v b) => v a -> (a -> m b) -> m (v b) {-# INLINE forM #-} forM as f = mapM f as @@ -1275,6 +1317,24 @@ . inplace (S.map snd . S.filter (uncurry f) . S.indexed) toMax . stream +-- | /O(n)/ Drop repeated adjacent elements. +uniq :: (Vector v a, Eq a) => v a -> v a +{-# INLINE uniq #-} +uniq = unstream . inplace S.uniq toMax . stream + +-- | /O(n)/ Drop elements when predicate returns Nothing +mapMaybe :: (Vector v a, Vector v b) => (a -> Maybe b) -> v a -> v b +{-# INLINE mapMaybe #-} +mapMaybe f = unstream . inplace (S.mapMaybe f) toMax . stream + +-- | /O(n)/ Drop elements when predicate, applied to index and value, returns Nothing +imapMaybe :: (Vector v a, Vector v b) => (Int -> a -> Maybe b) -> v a -> v b +{-# INLINE imapMaybe #-} +imapMaybe f = unstream + . inplace (S.mapMaybe (uncurry f) . S.indexed) toMax + . 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 #-} @@ -1721,6 +1781,23 @@ {-# INLINE scanl' #-} scanl' f z = unstream . Bundle.scanl' f z . stream +-- | /O(n)/ Scan over a vector with its index +iscanl :: (Vector v a, Vector v b) => (Int -> a -> b -> a) -> a -> v b -> v a +{-# INLINE iscanl #-} +iscanl f z = + unstream + . inplace (S.scanl (\a (i, b) -> f i a b) z . S.indexed) (+1) + . stream + +-- | /O(n)/ Scan over a vector (strictly) with its index +iscanl' :: (Vector v a, Vector v b) => (Int -> a -> b -> a) -> a -> v b -> v a +{-# INLINE iscanl' #-} +iscanl' f z = + unstream + . inplace (S.scanl' (\a (i, b) -> f i a b) z . S.indexed) (+1) + . stream + + -- | /O(n)/ Scan over a non-empty vector -- -- > scanl f = @@ -1771,6 +1848,26 @@ {-# INLINE scanr' #-} scanr' f z = unstreamR . Bundle.scanl' (flip f) z . streamR +-- | /O(n)/ Right-to-left scan over a vector with its index +iscanr :: (Vector v a, Vector v b) => (Int -> a -> b -> b) -> b -> v a -> v b +{-# INLINE iscanr #-} +iscanr f z v = + unstreamR + . inplace (S.scanl (flip $ uncurry f) z . S.indexedR n) (+1) + . streamR + $ v + where n = length v + +-- | /O(n)/ Right-to-left scan over a vector (strictly) with its index +iscanr' :: (Vector v a, Vector v b) => (Int -> a -> b -> b) -> b -> v a -> v b +{-# INLINE iscanr' #-} +iscanr' f z v = + unstreamR + . inplace (S.scanl' (flip $ uncurry f) z . S.indexedR n) (+1) + . streamR + $ v + where n = length v + -- | /O(n)/ Right-to-left scan over a non-empty vector scanr1 :: Vector v a => (a -> a -> a) -> v a -> v a {-# INLINE scanr1 #-} @@ -2036,6 +2133,11 @@ {-# INLINE eq #-} xs `eq` ys = stream xs == stream ys +-- | /O(n)/ +eqBy :: (Vector v a, Vector v b) => (a -> b -> Bool) -> v a -> v b -> Bool +{-# INLINE eqBy #-} +eqBy e xs ys = Bundle.eqBy e (stream xs) (stream ys) + -- | /O(n)/ Compare two vectors lexicographically. All 'Vector' instances are -- also instances of 'Ord' and it is usually more appropriate to use those. This -- function is primarily intended for implementing 'Ord' instances for new @@ -2044,6 +2146,10 @@ {-# INLINE cmp #-} cmp xs ys = compare (stream xs) (stream ys) +-- | /O(n)/ +cmpBy :: (Vector v a, Vector v b) => (a -> b -> Ordering) -> v a -> v b -> Ordering +cmpBy c xs ys = Bundle.cmpBy c (stream xs) (stream ys) + -- Show -- ---- @@ -2052,6 +2158,10 @@ {-# INLINE showsPrec #-} showsPrec _ = shows . toList +liftShowsPrec :: (Vector v a) => (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> v a -> ShowS +{-# INLINE liftShowsPrec #-} +liftShowsPrec _ s _ = s . toList + -- | Generic definition of 'Text.Read.readPrec' readPrec :: (Vector v a, Read a) => Read.ReadPrec (v a) {-# INLINE readPrec #-} @@ -2059,6 +2169,10 @@ xs <- Read.readPrec return (fromList xs) +-- | /Note:/ uses 'ReadS' +liftReadsPrec :: (Vector v a) => (Int -> Read.ReadS a) -> ReadS [a] -> Int -> Read.ReadS (v a) +liftReadsPrec _ r _ s = [ (fromList v, s') | (v, s') <- r s ] + -- Data and Typeable -- ----------------- @@ -2084,4 +2198,3 @@ => (forall d. Data d => c (t d)) -> Maybe (c (v a)) {-# INLINE dataCast #-} dataCast f = gcast1 f - diff --git a/Data/Vector/Generic/Mutable.hs b/Data/Vector/Generic/Mutable.hs --- a/Data/Vector/Generic/Mutable.hs +++ b/Data/Vector/Generic/Mutable.hs @@ -44,6 +44,7 @@ unsafeRead, unsafeWrite, unsafeModify, unsafeSwap, unsafeExchange, -- * Modifying vectors + nextPermutation, -- ** Filling and copying set, copy, move, unsafeCopy, unsafeMove, @@ -584,7 +585,7 @@ new n = BOUNDS_CHECK(checkLength) "new" n $ unsafeNew n >>= \v -> basicInitialize v >> return v --- | Create a mutable vector of the given length. The length is not checked. +-- | Create a mutable vector of the given length. The memory is not initialized. unsafeNew :: (PrimMonad m, MVector v a) => Int -> m (v (PrimState m) a) {-# INLINE unsafeNew #-} unsafeNew n = UNSAFE_CHECK(checkLength) "unsafeNew" n @@ -768,8 +769,9 @@ -- | Copy a vector. The two vectors must have the same length and may not -- overlap. -copy :: (PrimMonad m, MVector v a) - => v (PrimState m) a -> v (PrimState m) a -> m () +copy :: (PrimMonad m, MVector v a) => v (PrimState m) a -- ^ target + -> v (PrimState m) a -- ^ source + -> m () {-# INLINE copy #-} copy dst src = BOUNDS_CHECK(check) "copy" "overlapping vectors" (not (dst `overlaps` src)) @@ -995,3 +997,38 @@ v2' <- unsafeAppend1 v2 i2 x return (v1, i1, v2', i2+1) +{- +http://en.wikipedia.org/wiki/Permutation#Algorithms_to_generate_permutations + +The following algorithm generates the next permutation lexicographically after +a given permutation. It changes the given permutation in-place. + +1. Find the largest index k such that a[k] < a[k + 1]. If no such index exists, + the permutation is the last permutation. +2. Find the largest index l greater than k such that a[k] < a[l]. +3. Swap the value of a[k] with that of a[l]. +4. Reverse the sequence from a[k + 1] up to and including the final element a[n] +-} + +-- | Compute the next (lexicographically) permutation of given vector in-place. +-- Returns False when input is the last permtuation +nextPermutation :: (PrimMonad m,Ord e,MVector v e) => v (PrimState m) e -> m Bool +nextPermutation v + | dim < 2 = return False + | otherwise = do + val <- unsafeRead v 0 + (k,l) <- loop val (-1) 0 val 1 + if k < 0 + then return False + else unsafeSwap v k l >> + reverse (unsafeSlice (k+1) (dim-k-1) v) >> + return True + where loop !kval !k !l !prev !i + | i == dim = return (k,l) + | otherwise = do + cur <- unsafeRead v i + -- TODO: make tuple unboxed + let (kval',k') = if prev < cur then (prev,i-1) else (kval,k) + l' = if kval' < cur then i else l + loop kval' k' l' cur (i+1) + dim = length v diff --git a/Data/Vector/Mutable.hs b/Data/Vector/Mutable.hs --- a/Data/Vector/Mutable.hs +++ b/Data/Vector/Mutable.hs @@ -44,6 +44,7 @@ unsafeRead, unsafeWrite, unsafeModify, unsafeSwap, -- * Modifying vectors + nextPermutation, -- ** Filling and copying set, copy, move, unsafeCopy, unsafeMove @@ -54,7 +55,7 @@ import Data.Primitive.Array import Control.Monad.Primitive -import Prelude hiding ( length, null, replicate, reverse, map, read, +import Prelude hiding ( length, null, replicate, reverse, read, take, drop, splitAt, init, tail ) import Data.Typeable ( Typeable ) @@ -268,7 +269,7 @@ {-# INLINE new #-} new = G.new --- | Create a mutable vector of the given length. The length is not checked. +-- | Create a mutable vector of the given length. The memory is not initialized. unsafeNew :: PrimMonad m => Int -> m (MVector (PrimState m) a) {-# INLINE unsafeNew #-} unsafeNew = G.unsafeNew @@ -408,3 +409,8 @@ {-# INLINE unsafeMove #-} unsafeMove = G.unsafeMove +-- | Compute the next (lexicographically) permutation of given vector in-place. +-- Returns False when input is the last permtuation +nextPermutation :: (PrimMonad m,Ord e) => MVector (PrimState m) e -> m Bool +{-# INLINE nextPermutation #-} +nextPermutation = G.nextPermutation diff --git a/Data/Vector/Primitive.hs b/Data/Vector/Primitive.hs --- a/Data/Vector/Primitive.hs +++ b/Data/Vector/Primitive.hs @@ -42,10 +42,11 @@ empty, singleton, replicate, generate, iterateN, -- ** Monadic initialisation - replicateM, generateM, create, + replicateM, generateM, iterateNM, create, createT, -- ** Unfolding unfoldr, unfoldrN, + unfoldrM, unfoldrNM, constructN, constructrN, -- ** Enumeration @@ -91,7 +92,9 @@ -- * Working with predicates -- ** Filtering - filter, ifilter, filterM, + filter, ifilter, uniq, + mapMaybe, imapMaybe, + filterM, takeWhile, dropWhile, -- ** Partitioning @@ -160,11 +163,15 @@ enumFromTo, enumFromThenTo, mapM, mapM_ ) -import Data.Typeable ( Typeable ) -import Data.Data ( Data(..) ) -import Text.Read ( Read(..), readListPrecDefault ) +import Data.Typeable ( Typeable ) +import Data.Data ( Data(..) ) +import Text.Read ( Read(..), readListPrecDefault ) +import Data.Semigroup ( Semigroup(..) ) +#if !MIN_VERSION_base(4,8,0) import Data.Monoid ( Monoid(..) ) +import Data.Traversable ( Traversable ) +#endif #if __GLASGOW_HASKELL__ >= 708 import qualified GHC.Exts as Exts @@ -248,6 +255,13 @@ {-# INLINE (>=) #-} xs >= ys = Bundle.cmp (G.stream xs) (G.stream ys) /= LT +instance Prim a => Semigroup (Vector a) where + {-# INLINE (<>) #-} + (<>) = (++) + + {-# INLINE sconcat #-} + sconcat = G.concatNE + instance Prim a => Monoid (Vector a) where {-# INLINE mempty #-} mempty = empty @@ -270,12 +284,12 @@ -- Length -- ------ --- | /O(1)/ Yield the length of the vector. +-- | /O(1)/ Yield the length of the vector length :: Prim a => Vector a -> Int {-# INLINE length #-} length = G.length --- | /O(1)/ Test whether a vector if empty +-- | /O(1)/ Test whether a vector is empty null :: Prim a => Vector a -> Bool {-# INLINE null #-} null = G.null @@ -494,8 +508,8 @@ {-# INLINE unfoldr #-} unfoldr = G.unfoldr --- | /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 +-- | /O(n)/ Construct a vector with at most @n@ elements by repeatedly applying +-- the generator function to a seed. The generator function yields 'Just' the -- next element and the new seed or 'Nothing' if there are no more elements. -- -- > unfoldrN 3 (\n -> Just (n,n-1)) 10 = <10,9,8> @@ -503,6 +517,22 @@ {-# INLINE unfoldrN #-} unfoldrN = G.unfoldrN +-- | /O(n)/ Construct a vector by repeatedly applying the monadic +-- generator function to a seed. The generator function yields 'Just' +-- the next element and the new seed or 'Nothing' if there are no more +-- elements. +unfoldrM :: (Monad m, Prim a) => (b -> m (Maybe (a, b))) -> b -> m (Vector a) +{-# INLINE unfoldrM #-} +unfoldrM = G.unfoldrM + +-- | /O(n)/ Construct a vector by repeatedly applying the monadic +-- generator function to a seed. The generator function yields 'Just' +-- the next element and the new seed or 'Nothing' if there are no more +-- elements. +unfoldrNM :: (Monad m, Prim a) => Int -> (b -> m (Maybe (a, b))) -> b -> m (Vector a) +{-# INLINE unfoldrNM #-} +unfoldrNM = G.unfoldrNM + -- | /O(n)/ Construct a vector with @n@ elements by repeatedly applying the -- generator function to the already constructed part of the vector. -- @@ -596,6 +626,11 @@ {-# INLINE generateM #-} generateM = G.generateM +-- | /O(n)/ Apply monadic function n times to value. Zeroth element is original value. +iterateNM :: (Monad m, Prim a) => Int -> (a -> m a) -> a -> m (Vector a) +{-# INLINE iterateNM #-} +iterateNM = G.iterateNM + -- | Execute the monadic action and freeze the resulting vector. -- -- @ @@ -606,6 +641,11 @@ -- NOTE: eta-expanded due to http://hackage.haskell.org/trac/ghc/ticket/4120 create p = G.create p +-- | Execute the monadic action and freeze the resulting vectors. +createT :: (Traversable f, Prim a) => (forall s. ST s (f (MVector s a))) -> f (Vector a) +{-# INLINE createT #-} +createT p = G.createT p + -- Restricting memory usage -- ------------------------ @@ -773,7 +813,7 @@ mapM_ = G.mapM_ -- | /O(n)/ Apply the monadic action to all elements of the vector, yielding a --- vector of results. Equvalent to @flip 'mapM'@. +-- vector of results. Equivalent to @flip 'mapM'@. forM :: (Monad m, Prim a, Prim b) => Vector a -> (a -> m b) -> m (Vector b) {-# INLINE forM #-} forM = G.forM @@ -888,6 +928,21 @@ {-# INLINE ifilter #-} ifilter = G.ifilter +-- | /O(n)/ Drop repeated adjacent elements. +uniq :: (Prim a, Eq a) => Vector a -> Vector a +{-# INLINE uniq #-} +uniq = G.uniq + +-- | /O(n)/ Drop elements when predicate returns Nothing +mapMaybe :: (Prim a, Prim b) => (a -> Maybe b) -> Vector a -> Vector b +{-# INLINE mapMaybe #-} +mapMaybe = G.mapMaybe + +-- | /O(n)/ Drop elements when predicate, applied to index and value, returns Nothing +imapMaybe :: (Prim a, Prim b) => (Int -> a -> Maybe b) -> Vector a -> Vector b +{-# INLINE imapMaybe #-} +imapMaybe = G.imapMaybe + -- | /O(n)/ Drop elements that do not satisfy the monadic predicate filterM :: (Monad m, Prim a) => (a -> m Bool) -> Vector a -> m (Vector a) {-# INLINE filterM #-} @@ -1336,5 +1391,3 @@ copy :: (Prim a, PrimMonad m) => MVector (PrimState m) a -> Vector a -> m () {-# INLINE copy #-} copy = G.copy - - diff --git a/Data/Vector/Primitive/Mutable.hs b/Data/Vector/Primitive/Mutable.hs --- a/Data/Vector/Primitive/Mutable.hs +++ b/Data/Vector/Primitive/Mutable.hs @@ -44,6 +44,7 @@ unsafeRead, unsafeWrite, unsafeModify, unsafeSwap, -- * Modifying vectors + nextPermutation, -- ** Filling and copying set, copy, move, unsafeCopy, unsafeMove @@ -211,7 +212,7 @@ {-# INLINE new #-} new = G.new --- | Create a mutable vector of the given length. The length is not checked. +-- | Create a mutable vector of the given length. The memory is not initialized. unsafeNew :: (PrimMonad m, Prim a) => Int -> m (MVector (PrimState m) a) {-# INLINE unsafeNew #-} unsafeNew = G.unsafeNew @@ -317,7 +318,9 @@ -- | Copy a vector. The two vectors must have the same length and may not -- overlap. copy :: (PrimMonad m, Prim a) - => MVector (PrimState m) a -> MVector (PrimState m) a -> m () + => MVector (PrimState m) a -- ^ target + -> MVector (PrimState m) a -- ^ source + -> m () {-# INLINE copy #-} copy = G.copy @@ -356,3 +359,8 @@ {-# INLINE unsafeMove #-} unsafeMove = G.unsafeMove +-- | Compute the next (lexicographically) permutation of given vector in-place. +-- Returns False when input is the last permtuation +nextPermutation :: (PrimMonad m,Ord e,Prim e) => MVector (PrimState m) e -> m Bool +{-# INLINE nextPermutation #-} +nextPermutation = G.nextPermutation diff --git a/Data/Vector/Storable.hs b/Data/Vector/Storable.hs --- a/Data/Vector/Storable.hs +++ b/Data/Vector/Storable.hs @@ -39,10 +39,11 @@ empty, singleton, replicate, generate, iterateN, -- ** Monadic initialisation - replicateM, generateM, create, + replicateM, generateM, iterateNM, create, createT, -- ** Unfolding unfoldr, unfoldrN, + unfoldrM, unfoldrNM, constructN, constructrN, -- ** Enumeration @@ -88,7 +89,9 @@ -- * Working with predicates -- ** Filtering - filter, ifilter, filterM, + filter, ifilter, uniq, + mapMaybe, imapMaybe, + filterM, takeWhile, dropWhile, -- ** Partitioning @@ -165,11 +168,15 @@ enumFromTo, enumFromThenTo, mapM, mapM_ ) -import Data.Typeable ( Typeable ) -import Data.Data ( Data(..) ) -import Text.Read ( Read(..), readListPrecDefault ) +import Data.Typeable ( Typeable ) +import Data.Data ( Data(..) ) +import Text.Read ( Read(..), readListPrecDefault ) +import Data.Semigroup ( Semigroup(..) ) +#if !MIN_VERSION_base(4,8,0) import Data.Monoid ( Monoid(..) ) +import Data.Traversable ( Traversable ) +#endif #if __GLASGOW_HASKELL__ >= 708 import qualified GHC.Exts as Exts @@ -257,6 +264,13 @@ {-# INLINE (>=) #-} xs >= ys = Bundle.cmp (G.stream xs) (G.stream ys) /= LT +instance Storable a => Semigroup (Vector a) where + {-# INLINE (<>) #-} + (<>) = (++) + + {-# INLINE sconcat #-} + sconcat = G.concatNE + instance Storable a => Monoid (Vector a) where {-# INLINE mempty #-} mempty = empty @@ -280,12 +294,12 @@ -- Length -- ------ --- | /O(1)/ Yield the length of the vector. +-- | /O(1)/ Yield the length of the vector length :: Storable a => Vector a -> Int {-# INLINE length #-} length = G.length --- | /O(1)/ Test whether a vector if empty +-- | /O(1)/ Test whether a vector is empty null :: Storable a => Vector a -> Bool {-# INLINE null #-} null = G.null @@ -504,8 +518,8 @@ {-# INLINE unfoldr #-} unfoldr = G.unfoldr --- | /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 +-- | /O(n)/ Construct a vector with at most @n@ elements by repeatedly applying +-- the generator function to a seed. The generator function yields 'Just' the -- next element and the new seed or 'Nothing' if there are no more elements. -- -- > unfoldrN 3 (\n -> Just (n,n-1)) 10 = <10,9,8> @@ -513,6 +527,22 @@ {-# INLINE unfoldrN #-} unfoldrN = G.unfoldrN +-- | /O(n)/ Construct a vector by repeatedly applying the monadic +-- generator function to a seed. The generator function yields 'Just' +-- the next element and the new seed or 'Nothing' if there are no more +-- elements. +unfoldrM :: (Monad m, Storable a) => (b -> m (Maybe (a, b))) -> b -> m (Vector a) +{-# INLINE unfoldrM #-} +unfoldrM = G.unfoldrM + +-- | /O(n)/ Construct a vector by repeatedly applying the monadic +-- generator function to a seed. The generator function yields 'Just' +-- the next element and the new seed or 'Nothing' if there are no more +-- elements. +unfoldrNM :: (Monad m, Storable a) => Int -> (b -> m (Maybe (a, b))) -> b -> m (Vector a) +{-# INLINE unfoldrNM #-} +unfoldrNM = G.unfoldrNM + -- | /O(n)/ Construct a vector with @n@ elements by repeatedly applying the -- generator function to the already constructed part of the vector. -- @@ -606,6 +636,11 @@ {-# INLINE generateM #-} generateM = G.generateM +-- | /O(n)/ Apply monadic function n times to value. Zeroth element is original value. +iterateNM :: (Monad m, Storable a) => Int -> (a -> m a) -> a -> m (Vector a) +{-# INLINE iterateNM #-} +iterateNM = G.iterateNM + -- | Execute the monadic action and freeze the resulting vector. -- -- @ @@ -616,6 +651,11 @@ -- NOTE: eta-expanded due to http://hackage.haskell.org/trac/ghc/ticket/4120 create p = G.create p +-- | Execute the monadic action and freeze the resulting vectors. +createT :: (Traversable f, Storable a) => (forall s. ST s (f (MVector s a))) -> f (Vector a) +{-# INLINE createT #-} +createT p = G.createT p + -- Restricting memory usage -- ------------------------ @@ -783,7 +823,7 @@ mapM_ = G.mapM_ -- | /O(n)/ Apply the monadic action to all elements of the vector, yielding a --- vector of results. Equvalent to @flip 'mapM'@. +-- vector of results. Equivalent to @flip 'mapM'@. forM :: (Monad m, Storable a, Storable b) => Vector a -> (a -> m b) -> m (Vector b) {-# INLINE forM #-} forM = G.forM @@ -898,6 +938,21 @@ {-# INLINE ifilter #-} ifilter = G.ifilter +-- | /O(n)/ Drop repeated adjacent elements. +uniq :: (Storable a, Eq a) => Vector a -> Vector a +{-# INLINE uniq #-} +uniq = G.uniq + +-- | /O(n)/ Drop elements when predicate returns Nothing +mapMaybe :: (Storable a, Storable b) => (a -> Maybe b) -> Vector a -> Vector b +{-# INLINE mapMaybe #-} +mapMaybe = G.mapMaybe + +-- | /O(n)/ Drop elements when predicate, applied to index and value, returns Nothing +imapMaybe :: (Storable a, Storable b) => (Int -> a -> Maybe b) -> Vector a -> Vector b +{-# INLINE imapMaybe #-} +imapMaybe = G.imapMaybe + -- | /O(n)/ Drop elements that do not satisfy the monadic predicate filterM :: (Monad m, Storable a) => (a -> m Bool) -> Vector a -> m (Vector a) {-# INLINE filterM #-} @@ -1432,5 +1487,3 @@ unsafeWith :: Storable a => Vector a -> (Ptr a -> IO b) -> IO b {-# INLINE unsafeWith #-} unsafeWith (Vector _ fp) = withForeignPtr fp - - diff --git a/Data/Vector/Storable/Mutable.hs b/Data/Vector/Storable/Mutable.hs --- a/Data/Vector/Storable/Mutable.hs +++ b/Data/Vector/Storable/Mutable.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE CPP, DeriveDataTypeable, MultiParamTypeClasses, FlexibleInstances, ScopedTypeVariables #-} +{-# LANGUAGE CPP, DeriveDataTypeable, FlexibleInstances, MagicHash, MultiParamTypeClasses, ScopedTypeVariables #-} -- | -- Module : Data.Vector.Storable.Mutable @@ -65,8 +65,13 @@ import Foreign.Storable import Foreign.ForeignPtr -#if __GLASGOW_HASKELL__ >= 605 -import GHC.ForeignPtr (mallocPlainForeignPtrBytes) +#if __GLASGOW_HASKELL__ >= 706 +import GHC.ForeignPtr (mallocPlainForeignPtrAlignedBytes) +#elif __GLASGOW_HASKELL__ >= 700 +import Data.Primitive.ByteArray (MutableByteArray(..), newAlignedPinnedByteArray, + unsafeFreezeByteArray) +import GHC.Prim (byteArrayContents#, unsafeCoerce#) +import GHC.ForeignPtr #endif import Foreign.Ptr @@ -201,11 +206,26 @@ {-# INLINE mallocVector #-} mallocVector :: Storable a => Int -> IO (ForeignPtr a) mallocVector = -#if __GLASGOW_HASKELL__ >= 605 - doMalloc undefined - where - doMalloc :: Storable b => b -> Int -> IO (ForeignPtr b) - doMalloc dummy size = mallocPlainForeignPtrBytes (size * sizeOf dummy) +#if __GLASGOW_HASKELL__ >= 706 + doMalloc undefined + where + doMalloc :: Storable b => b -> Int -> IO (ForeignPtr b) + doMalloc dummy size = + mallocPlainForeignPtrAlignedBytes (size * sizeOf dummy) (alignment dummy) +#elif __GLASGOW_HASKELL__ >= 700 + doMalloc undefined + where + doMalloc :: Storable b => b -> Int -> IO (ForeignPtr b) + doMalloc dummy size = do + arr@(MutableByteArray arr#) <- newAlignedPinnedByteArray arrSize arrAlign + newConcForeignPtr + (Ptr (byteArrayContents# (unsafeCoerce# arr#))) + -- Keep reference to mutable byte array until whole ForeignPtr goes out + -- of scope. + (touch arr) + where + arrSize = size * sizeOf dummy + arrAlign = alignment dummy #else mallocForeignPtrArray #endif @@ -293,7 +313,7 @@ {-# INLINE new #-} new = G.new --- | Create a mutable vector of the given length. The length is not checked. +-- | Create a mutable vector of the given length. The memory is not initialized. unsafeNew :: (PrimMonad m, Storable a) => Int -> m (MVector (PrimState m) a) {-# INLINE unsafeNew #-} unsafeNew = G.unsafeNew @@ -322,14 +342,14 @@ -- | Grow a vector by the given number of elements. The number must be -- positive. grow :: (PrimMonad m, Storable a) - => MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a) + => MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a) {-# INLINE grow #-} grow = G.grow -- | Grow a vector by the given number of elements. The number must be -- positive but this is not checked. unsafeGrow :: (PrimMonad m, Storable a) - => MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a) + => MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a) {-# INLINE unsafeGrow #-} unsafeGrow = G.unsafeGrow @@ -401,7 +421,9 @@ -- | Copy a vector. The two vectors must have the same length and may not -- overlap. copy :: (PrimMonad m, Storable a) - => MVector (PrimState m) a -> MVector (PrimState m) a -> m () + => MVector (PrimState m) a -- ^ target + -> MVector (PrimState m) a -- ^ source + -> m () {-# INLINE copy #-} copy = G.copy @@ -422,7 +444,7 @@ -- copied to a temporary vector and then the temporary vector was copied -- to the target vector. move :: (PrimMonad m, Storable a) - => MVector (PrimState m) a -> MVector (PrimState m) a -> m () + => MVector (PrimState m) a -> MVector (PrimState m) a -> m () {-# INLINE move #-} move = G.move @@ -434,9 +456,9 @@ -- copied to a temporary vector and then the temporary vector was copied -- to the target vector. unsafeMove :: (PrimMonad m, Storable a) - => MVector (PrimState m) a -- ^ target - -> MVector (PrimState m) a -- ^ source - -> m () + => MVector (PrimState m) a -- ^ target + -> MVector (PrimState m) a -- ^ source + -> m () {-# INLINE unsafeMove #-} unsafeMove = G.unsafeMove diff --git a/Data/Vector/Unboxed.hs b/Data/Vector/Unboxed.hs --- a/Data/Vector/Unboxed.hs +++ b/Data/Vector/Unboxed.hs @@ -62,10 +62,11 @@ empty, singleton, replicate, generate, iterateN, -- ** Monadic initialisation - replicateM, generateM, create, + replicateM, generateM, iterateNM, create, createT, -- ** Unfolding unfoldr, unfoldrN, + unfoldrM, unfoldrNM, constructN, constructrN, -- ** Enumeration @@ -118,7 +119,9 @@ -- * Working with predicates -- ** Filtering - filter, ifilter, filterM, + filter, ifilter, uniq, + mapMaybe, imapMaybe, + filterM, takeWhile, dropWhile, -- ** Partitioning @@ -184,9 +187,13 @@ enumFromTo, enumFromThenTo, mapM, mapM_ ) -import Text.Read ( Read(..), readListPrecDefault ) +import Text.Read ( Read(..), readListPrecDefault ) +import Data.Semigroup ( Semigroup(..) ) +#if !MIN_VERSION_base(4,8,0) import Data.Monoid ( Monoid(..) ) +import Data.Traversable ( Traversable ) +#endif #if __GLASGOW_HASKELL__ >= 708 import qualified GHC.Exts as Exts (IsList(..)) @@ -220,6 +227,13 @@ {-# INLINE (>=) #-} xs >= ys = Bundle.cmp (G.stream xs) (G.stream ys) /= LT +instance Unbox a => Semigroup (Vector a) where + {-# INLINE (<>) #-} + (<>) = (++) + + {-# INLINE sconcat #-} + sconcat = G.concatNE + instance Unbox a => Monoid (Vector a) where {-# INLINE mempty #-} mempty = empty @@ -250,12 +264,12 @@ -- Length information -- ------------------ --- | /O(1)/ Yield the length of the vector. +-- | /O(1)/ Yield the length of the vector length :: Unbox a => Vector a -> Int {-# INLINE length #-} length = G.length --- | /O(1)/ Test whether a vector if empty +-- | /O(1)/ Test whether a vector is empty null :: Unbox a => Vector a -> Bool {-# INLINE null #-} null = G.null @@ -473,8 +487,8 @@ {-# INLINE unfoldr #-} unfoldr = G.unfoldr --- | /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 +-- | /O(n)/ Construct a vector with at most @n@ elements by repeatedly applying +-- the generator function to a seed. The generator function yields 'Just' the -- next element and the new seed or 'Nothing' if there are no more elements. -- -- > unfoldrN 3 (\n -> Just (n,n-1)) 10 = <10,9,8> @@ -482,6 +496,22 @@ {-# INLINE unfoldrN #-} unfoldrN = G.unfoldrN +-- | /O(n)/ Construct a vector by repeatedly applying the monadic +-- generator function to a seed. The generator function yields 'Just' +-- the next element and the new seed or 'Nothing' if there are no more +-- elements. +unfoldrM :: (Monad m, Unbox a) => (b -> m (Maybe (a, b))) -> b -> m (Vector a) +{-# INLINE unfoldrM #-} +unfoldrM = G.unfoldrM + +-- | /O(n)/ Construct a vector by repeatedly applying the monadic +-- generator function to a seed. The generator function yields 'Just' +-- the next element and the new seed or 'Nothing' if there are no more +-- elements. +unfoldrNM :: (Monad m, Unbox a) => Int -> (b -> m (Maybe (a, b))) -> b -> m (Vector a) +{-# INLINE unfoldrNM #-} +unfoldrNM = G.unfoldrNM + -- | /O(n)/ Construct a vector with @n@ elements by repeatedly applying the -- generator function to the already constructed part of the vector. -- @@ -575,6 +605,11 @@ {-# INLINE generateM #-} generateM = G.generateM +-- | /O(n)/ Apply monadic function n times to value. Zeroth element is original value. +iterateNM :: (Monad m, Unbox a) => Int -> (a -> m a) -> a -> m (Vector a) +{-# INLINE iterateNM #-} +iterateNM = G.iterateNM + -- | Execute the monadic action and freeze the resulting vector. -- -- @ @@ -585,6 +620,11 @@ -- NOTE: eta-expanded due to http://hackage.haskell.org/trac/ghc/ticket/4120 create p = G.create p +-- | Execute the monadic action and freeze the resulting vectors. +createT :: (Traversable f, Unbox a) => (forall s. ST s (f (MVector s a))) -> f (Vector a) +{-# INLINE createT #-} +createT p = G.createT p + -- Restricting memory usage -- ------------------------ @@ -820,7 +860,7 @@ imapM_ = G.imapM_ -- | /O(n)/ Apply the monadic action to all elements of the vector, yielding a --- vector of results. Equvalent to @flip 'mapM'@. +-- vector of results. Equivalent to @flip 'mapM'@. forM :: (Monad m, Unbox a, Unbox b) => Vector a -> (a -> m b) -> m (Vector b) {-# INLINE forM #-} forM = G.forM @@ -939,12 +979,27 @@ {-# INLINE filter #-} filter = G.filter +-- | /O(n)/ Drop repeated adjacent elements. +uniq :: (Unbox a, Eq a) => Vector a -> Vector a +{-# INLINE uniq #-} +uniq = G.uniq + -- | /O(n)/ Drop elements that do not satisfy the predicate which is applied to -- values and their indices ifilter :: Unbox a => (Int -> a -> Bool) -> Vector a -> Vector a {-# INLINE ifilter #-} ifilter = G.ifilter +-- | /O(n)/ Drop elements when predicate returns Nothing +mapMaybe :: (Unbox a, Unbox b) => (a -> Maybe b) -> Vector a -> Vector b +{-# INLINE mapMaybe #-} +mapMaybe = G.mapMaybe + +-- | /O(n)/ Drop elements when predicate, applied to index and value, returns Nothing +imapMaybe :: (Unbox a, Unbox b) => (Int -> a -> Maybe b) -> Vector a -> Vector b +{-# INLINE imapMaybe #-} +imapMaybe = G.imapMaybe + -- | /O(n)/ Drop elements that do not satisfy the monadic predicate filterM :: (Monad m, Unbox a) => (a -> m Bool) -> Vector a -> m (Vector a) {-# INLINE filterM #-} @@ -1431,4 +1486,3 @@ #define DEFINE_IMMUTABLE #include "unbox-tuple-instances" - diff --git a/Data/Vector/Unboxed/Base.hs b/Data/Vector/Unboxed/Base.hs --- a/Data/Vector/Unboxed/Base.hs +++ b/Data/Vector/Unboxed/Base.hs @@ -30,19 +30,19 @@ import Control.Monad.Primitive import Control.Monad ( liftM ) -import Data.Word ( Word, Word8, Word16, Word32, Word64 ) +import Data.Word ( Word8, Word16, Word32, Word64 ) import Data.Int ( Int8, Int16, Int32, Int64 ) import Data.Complex +#if !MIN_VERSION_base(4,8,0) +import Data.Word ( Word ) +#endif + #if __GLASGOW_HASKELL__ >= 707 import Data.Typeable ( Typeable ) #else import Data.Typeable ( Typeable1(..), Typeable2(..), mkTyConApp, -#if MIN_VERSION_base(4,4,0) mkTyCon3 -#else - mkTyCon -#endif ) #endif @@ -72,11 +72,7 @@ deriving instance Typeable Vector deriving instance Typeable MVector #else -#if MIN_VERSION_base(4,4,0) vectorTyCon = mkTyCon3 "vector" -#else -vectorTyCon m s = mkTyCon $ m ++ "." ++ s -#endif instance Typeable1 Vector where typeOf1 _ = mkTyConApp (vectorTyCon "Data.Vector.Unboxed" "Vector") [] @@ -357,9 +353,9 @@ newtype instance MVector s (Complex a) = MV_Complex (MVector s (a,a)) newtype instance Vector (Complex a) = V_Complex (Vector (a,a)) -instance (RealFloat a, Unbox a) => Unbox (Complex a) +instance (Unbox a) => Unbox (Complex a) -instance (RealFloat a, Unbox a) => M.MVector MVector (Complex a) where +instance (Unbox a) => M.MVector MVector (Complex a) where {-# INLINE basicLength #-} {-# INLINE basicUnsafeSlice #-} {-# INLINE basicOverlaps #-} @@ -386,7 +382,7 @@ basicUnsafeMove (MV_Complex v1) (MV_Complex v2) = M.basicUnsafeMove v1 v2 basicUnsafeGrow (MV_Complex v) n = MV_Complex `liftM` M.basicUnsafeGrow v n -instance (RealFloat a, Unbox a) => G.Vector Vector (Complex a) where +instance (Unbox a) => G.Vector Vector (Complex a) where {-# INLINE basicUnsafeFreeze #-} {-# INLINE basicUnsafeThaw #-} {-# INLINE basicLength #-} @@ -410,4 +406,3 @@ #define DEFINE_INSTANCES #include "unbox-tuple-instances" - diff --git a/Data/Vector/Unboxed/Mutable.hs b/Data/Vector/Unboxed/Mutable.hs --- a/Data/Vector/Unboxed/Mutable.hs +++ b/Data/Vector/Unboxed/Mutable.hs @@ -48,6 +48,7 @@ unsafeRead, unsafeWrite, unsafeModify, unsafeSwap, -- * Modifying vectors + nextPermutation, -- ** Filling and copying set, copy, move, unsafeCopy, unsafeMove @@ -149,7 +150,7 @@ {-# INLINE new #-} new = G.new --- | Create a mutable vector of the given length. The length is not checked. +-- | Create a mutable vector of the given length. The memory is not initialized. unsafeNew :: (PrimMonad m, Unbox a) => Int -> m (MVector (PrimState m) a) {-# INLINE unsafeNew #-} unsafeNew = G.unsafeNew @@ -255,7 +256,9 @@ -- | Copy a vector. The two vectors must have the same length and may not -- overlap. copy :: (PrimMonad m, Unbox a) - => MVector (PrimState m) a -> MVector (PrimState m) a -> m () + => MVector (PrimState m) a -- ^ target + -> MVector (PrimState m) a -- ^ source + -> m () {-# INLINE copy #-} copy = G.copy @@ -294,6 +297,11 @@ {-# INLINE unsafeMove #-} unsafeMove = G.unsafeMove +-- | Compute the next (lexicographically) permutation of given vector in-place. +-- Returns False when input is the last permtuation +nextPermutation :: (PrimMonad m,Ord e,Unbox e) => MVector (PrimState m) e -> m Bool +{-# INLINE nextPermutation #-} +nextPermutation = G.nextPermutation + #define DEFINE_MUTABLE #include "unbox-tuple-instances" - diff --git a/changelog b/changelog --- a/changelog +++ b/changelog @@ -1,3 +1,15 @@ +Changes in version 0.12.0.0 + + * Documentation fixes/additions + * New functions: createT, iscanl/r, iterateNM, unfoldrM, uniq + * New instances for various vector types: Semigroup, MonadZip + * Made `Storable` vectors respect memory alignment + * Changed some macros to ConstraintKinds + - Dropped compatibility with old GHCs to support this + * Add `Eq1`, `Ord1`, `Show1`, and `Read1` `Vector` instances, and related + helper functions. + * Relax context for `Unbox (Complex a)`. + Changes in version 0.11.0.0 * Define `Applicative` instances for `Data.Vector.Fusion.Util.{Box,Id}` diff --git a/include/vector.h b/include/vector.h --- a/include/vector.h +++ b/include/vector.h @@ -18,4 +18,3 @@ #define PHASE_STREAM Please use "PHASE_FUSED" instead #define INLINE_STREAM Please use "INLINE_FUSED" instead - diff --git a/internal/GenUnboxTuple.hs b/internal/GenUnboxTuple.hs --- a/internal/GenUnboxTuple.hs +++ b/internal/GenUnboxTuple.hs @@ -33,12 +33,12 @@ ] where - vars = map char $ take n ['a'..] + vars = map (\c -> text ['_',c]) $ take n ['a'..] varss = map (<> char 's') vars tuple xs = parens $ hsep $ punctuate comma xs vtuple xs = parens $ sep $ punctuate comma xs con s = text s <> char '_' <> int n - var c = text (c : "_") + var c = text ('_' : c : "_") data_instance ty c = hang (hsep [text "data instance", text ty, tuple vars]) @@ -177,6 +177,9 @@ <+> parens (var 'm' <> char '+' <> var 'n') <+> sep (map (<> char '\'') varss)) + gen_initialize rec + = (pat "MV", mk_do [qM rec <+> vs | vs <- varss] empty) + gen_unsafeFreeze rec = (pat "MV", mk_do [vs <> char '\'' <+> text "<-" <+> qG rec <+> vs | vs <- varss] @@ -224,7 +227,8 @@ ,("basicSet", gen_set) ,("basicUnsafeCopy", gen_unsafeCopy "MV" qM) ,("basicUnsafeMove", gen_unsafeMove) - ,("basicUnsafeGrow", gen_unsafeGrow)] + ,("basicUnsafeGrow", gen_unsafeGrow) + ,("basicInitialize", gen_initialize)] methods_Vector = [("basicUnsafeFreeze", gen_unsafeFreeze) ,("basicUnsafeThaw", gen_unsafeThaw) diff --git a/tests/Main.hs b/tests/Main.hs --- a/tests/Main.hs +++ b/tests/Main.hs @@ -1,12 +1,15 @@ module Main (main) where import qualified Tests.Vector +import qualified Tests.Vector.UnitTests import qualified Tests.Bundle import qualified Tests.Move import Test.Framework (defaultMain) +main :: IO () main = defaultMain $ Tests.Bundle.tests ++ Tests.Vector.tests + ++ Tests.Vector.UnitTests.tests ++ Tests.Move.tests diff --git a/tests/Tests/Move.hs b/tests/Tests/Move.hs --- a/tests/Tests/Move.hs +++ b/tests/Tests/Move.hs @@ -6,6 +6,10 @@ import Utilities () +import Control.Monad (replicateM) +import Control.Monad.ST (runST) +import Data.List (sort,permutations) + import qualified Data.Vector.Generic as G import qualified Data.Vector.Generic.Mutable as M @@ -28,8 +32,18 @@ actual <- return $ G.modify (\ mv -> M.move (M.slice dstOff len mv) (M.slice srcOff len mv)) v unProperty $ counterexample ("Move: " ++ show (v, dstOff, srcOff, len)) (expected == actual)) +checkPermutations :: Int -> Bool +checkPermutations n = runST $ do + vec <- U.thaw (U.fromList [1..n]) + res <- replicateM (product [1..n]) $ M.nextPermutation vec >> U.freeze vec >>= return . U.toList + return $! ([1..n] : res) == sort (permutations [1..n]) ++ [[n,n-1..1]] + +testPermutations :: Bool +testPermutations = all checkPermutations [1..7] + tests = [testProperty "Data.Vector.Mutable (Move)" (testMove :: V.Vector Int -> Property), testProperty "Data.Vector.Primitive.Mutable (Move)" (testMove :: P.Vector Int -> Property), testProperty "Data.Vector.Unboxed.Mutable (Move)" (testMove :: U.Vector Int -> Property), - testProperty "Data.Vector.Storable.Mutable (Move)" (testMove :: S.Vector Int -> Property)] + testProperty "Data.Vector.Storable.Mutable (Move)" (testMove :: S.Vector Int -> Property), + testProperty "Data.Vector.Generic.Mutable (nextPermutation)" testPermutations] diff --git a/tests/Tests/Vector.hs b/tests/Tests/Vector.hs --- a/tests/Tests/Vector.hs +++ b/tests/Tests/Vector.hs @@ -1,8 +1,13 @@ +{-# LANGUAGE ConstraintKinds #-} module Tests.Vector (tests) where import Boilerplater import Utilities as Util +import Data.Functor.Identity +import qualified Data.Traversable as T (Traversable(..)) +import Data.Foldable (Foldable(foldMap)) + import qualified Data.Vector.Generic as V import qualified Data.Vector import qualified Data.Vector.Primitive @@ -24,14 +29,13 @@ import Data.Functor.Identity import Control.Monad.Trans.Writer -#define COMMON_CONTEXT(a, v) \ - VANILLA_CONTEXT(a, v), VECTOR_CONTEXT(a, v) - -#define VANILLA_CONTEXT(a, v) \ - Eq a, Show a, Arbitrary a, CoArbitrary a, TestData a, Model a ~ a, EqTest a ~ Property +import Control.Monad.Zip -#define VECTOR_CONTEXT(a, v) \ - Eq (v a), Show (v a), Arbitrary (v a), CoArbitrary (v a), TestData (v a), Model (v a) ~ [a], EqTest (v a) ~ Property, V.Vector v a +type CommonContext a v = (VanillaContext a, VectorContext a v) +type VanillaContext a = ( Eq a , Show a, Arbitrary a, CoArbitrary a + , TestData a, Model a ~ a, EqTest a ~ Property) +type VectorContext a v = ( Eq (v a), Show (v a), Arbitrary (v a), CoArbitrary (v a) + , TestData (v a), Model (v a) ~ [a], EqTest (v a) ~ Property, V.Vector v a) -- TODO: implement Vector equivalents of list functions for some of the commented out properties @@ -66,7 +70,15 @@ -- TODO: test non-IVector stuff? -testSanity :: forall a v. (COMMON_CONTEXT(a, v)) => v a -> [Test] +#if !MIN_VERSION_base(4,7,0) +instance Foldable ((,) a) where + foldMap f (_, b) = f b + +instance T.Traversable ((,) a) where + traverse f (a, b) = fmap ((,) a) $ f b +#endif + +testSanity :: forall a v. (CommonContext a v) => v a -> [Test] testSanity _ = [ testProperty "fromList.toList == id" prop_fromList_toList, testProperty "toList.fromList == id" prop_toList_fromList, @@ -79,7 +91,7 @@ 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 -testPolymorphicFunctions :: forall a v. (COMMON_CONTEXT(a, v), VECTOR_CONTEXT(Int, v)) => v a -> [Test] +testPolymorphicFunctions :: forall a v. (CommonContext a v, VectorContext Int v) => v a -> [Test] testPolymorphicFunctions _ = $(testProperties [ 'prop_eq, @@ -102,13 +114,14 @@ -- Initialisation (FIXME) 'prop_empty, 'prop_singleton, 'prop_replicate, - 'prop_generate, 'prop_iterateN, + 'prop_generate, 'prop_iterateN, 'prop_iterateNM, -- Monadic initialisation (FIXME) + 'prop_createT, {- 'prop_replicateM, 'prop_generateM, 'prop_create, -} - -- Unfolding (FIXME) - {- 'prop_unfoldr, prop_unfoldrN, -} + -- Unfolding + 'prop_unfoldr, 'prop_unfoldrN, 'prop_unfoldrM, 'prop_unfoldrNM, 'prop_constructN, 'prop_constructrN, -- Enumeration? (FIXME?) @@ -159,6 +172,8 @@ -- Filtering 'prop_filter, 'prop_ifilter, {- prop_filterM, -} + 'prop_uniq, + 'prop_mapMaybe, 'prop_imapMaybe, 'prop_takeWhile, 'prop_dropWhile, -- Paritioning @@ -191,10 +206,12 @@ 'prop_prescanl, 'prop_prescanl', 'prop_postscanl, 'prop_postscanl', 'prop_scanl, 'prop_scanl', 'prop_scanl1, 'prop_scanl1', + 'prop_iscanl, 'prop_iscanl', 'prop_prescanr, 'prop_prescanr', 'prop_postscanr, 'prop_postscanr', - 'prop_scanr, 'prop_scanr', 'prop_scanr1, 'prop_scanr1' + 'prop_scanr, 'prop_scanr', 'prop_scanr1, 'prop_scanr1', + 'prop_iscanr, 'prop_iscanr' ]) where -- Prelude @@ -216,6 +233,10 @@ = (\n _ -> n < 1000) ===> V.generate `eq` Util.generate prop_iterateN :: P (Int -> (a -> a) -> a -> v a) = (\n _ _ -> n < 1000) ===> V.iterateN `eq` (\n f -> take n . iterate f) + prop_iterateNM :: P (Int -> (a -> Writer [Int] a) -> a -> Writer [Int] (v a)) + = (\n _ _ -> n < 1000) ===> V.iterateNM `eq` Util.iterateNM + prop_createT :: P ((a, v a) -> (a, v a)) + prop_createT = (\v -> V.createT (T.mapM V.thaw v)) `eq` id prop_head :: P (v a -> a) = not . V.null ===> V.head `eq` head prop_last :: P (v a -> a) = not . V.null ===> V.last `eq` last @@ -292,6 +313,8 @@ prop_filter :: P ((a -> Bool) -> v a -> v a) = V.filter `eq` filter prop_ifilter :: P ((Int -> a -> Bool) -> v a -> v a) = V.ifilter `eq` ifilter + prop_mapMaybe :: P ((a -> Maybe a) -> v a -> v a) = V.mapMaybe `eq` mapMaybe + prop_imapMaybe :: P ((Int -> a -> Maybe a) -> v a -> v a) = V.imapMaybe `eq` imapMaybe prop_takeWhile :: P ((a -> Bool) -> v a -> v a) = V.takeWhile `eq` takeWhile prop_dropWhile :: P ((a -> Bool) -> v a -> v a) = V.dropWhile `eq` dropWhile prop_partition :: P ((a -> Bool) -> v a -> (v a, v a)) @@ -357,6 +380,10 @@ V.scanl1 `eq` scanl1 prop_scanl1' :: P ((a -> a -> a) -> v a -> v a) = notNull2 ===> V.scanl1' `eq` scanl1 + prop_iscanl :: P ((Int -> a -> a -> a) -> a -> v a -> v a) + = V.iscanl `eq` iscanl + prop_iscanl' :: P ((Int -> a -> a -> a) -> a -> v a -> v a) + = V.iscanl' `eq` iscanl prop_prescanr :: P ((a -> a -> a) -> a -> v a -> v a) = V.prescanr `eq` prescanr @@ -370,6 +397,10 @@ = V.scanr `eq` scanr prop_scanr' :: P ((a -> a -> a) -> a -> v a -> v a) = V.scanr' `eq` scanr + prop_iscanr :: P ((Int -> a -> a -> a) -> a -> v a -> v a) + = V.iscanr `eq` iscanr + prop_iscanr' :: P ((Int -> a -> a -> a) -> a -> v a -> v a) + = V.iscanr' `eq` iscanr prop_scanr1 :: P ((a -> a -> a) -> v a -> v a) = notNull2 ===> V.scanr1 `eq` scanr1 prop_scanr1' :: P ((a -> a -> a) -> v a -> v a) = notNull2 ===> @@ -380,6 +411,8 @@ where prop :: P ((a -> v a) -> v a -> v a) = V.concatMap `eq` concatMap + prop_uniq :: P (v a -> v a) + = V.uniq `eq` (map head . group) --prop_span = (V.span :: (a -> Bool) -> v a -> (v a, v a)) `eq2` span --prop_break = (V.break :: (a -> Bool) -> v a -> (v a, v a)) `eq2` break --prop_splitAt = (V.splitAt :: Int -> v a -> (v a, v a)) `eq2` splitAt @@ -402,12 +435,26 @@ -- Because the vectors are strict, we need to be totally sure that the unfold eventually terminates. This -- is achieved by injecting our own bit of state into the unfold - the maximum number of unfolds allowed. - limitUnfolds f (theirs, ours) | ours >= 0 - , Just (out, theirs') <- f theirs = Just (out, (theirs', ours - 1)) - | otherwise = Nothing + limitUnfolds f (theirs, ours) + | ours > 0 + , Just (out, theirs') <- f theirs = Just (out, (theirs', ours - 1)) + | otherwise = Nothing + limitUnfoldsM f (theirs, ours) + | ours > 0 = do r <- f theirs + return $ (\(a,b) -> (a,(b,ours - 1))) `fmap` r + | otherwise = return Nothing + + prop_unfoldr :: P (Int -> (Int -> Maybe (a,Int)) -> Int -> v a) = (\n f a -> V.unfoldr (limitUnfolds f) (a, n)) `eq` (\n f a -> unfoldr (limitUnfolds f) (a, n)) + prop_unfoldrN :: P (Int -> (Int -> Maybe (a,Int)) -> Int -> v a) + = V.unfoldrN `eq` (\n f a -> unfoldr (limitUnfolds f) (a, n)) + prop_unfoldrM :: P (Int -> (Int -> Writer [Int] (Maybe (a,Int))) -> Int -> Writer [Int] (v a)) + = (\n f a -> V.unfoldrM (limitUnfoldsM f) (a,n)) + `eq` (\n f a -> Util.unfoldrM (limitUnfoldsM f) (a, n)) + prop_unfoldrNM :: P (Int -> (Int -> Writer [Int] (Maybe (a,Int))) -> Int -> Writer [Int] (v a)) + = V.unfoldrNM `eq` (\n f a -> Util.unfoldrM (limitUnfoldsM f) (a, n)) prop_constructN = \f -> forAll (choose (0,20)) $ \n -> unP prop n f where @@ -423,15 +470,22 @@ constructrN xs 0 _ = xs constructrN xs n f = constructrN (f xs : xs) (n-1) f -testTuplyFunctions:: forall a v. (COMMON_CONTEXT(a, v), VECTOR_CONTEXT((a, a), v), VECTOR_CONTEXT((a, a, a), v)) => v a -> [Test] -testTuplyFunctions _ = $(testProperties ['prop_zip, 'prop_zip3, 'prop_unzip, 'prop_unzip3]) +testTuplyFunctions:: forall a v. (CommonContext a v, VectorContext (a, a) v, VectorContext (a, a, a) v) => v a -> [Test] +testTuplyFunctions _ = $(testProperties [ 'prop_zip, 'prop_zip3 + , 'prop_unzip, 'prop_unzip3 + , 'prop_mzip, 'prop_munzip + ]) where prop_zip :: P (v a -> v a -> v (a, a)) = V.zip `eq` zip prop_zip3 :: P (v a -> v a -> v a -> v (a, a, a)) = V.zip3 `eq` zip3 prop_unzip :: P (v (a, a) -> (v a, v a)) = V.unzip `eq` unzip prop_unzip3 :: P (v (a, a, a) -> (v a, v a, v a)) = V.unzip3 `eq` unzip3 + prop_mzip :: P (Data.Vector.Vector a -> Data.Vector.Vector a -> Data.Vector.Vector (a, a)) + = mzip `eq` zip + prop_munzip :: P (Data.Vector.Vector (a, a) -> (Data.Vector.Vector a, Data.Vector.Vector a)) + = munzip `eq` unzip -testOrdFunctions :: forall a v. (COMMON_CONTEXT(a, v), Ord a, Ord (v a)) => v a -> [Test] +testOrdFunctions :: forall a v. (CommonContext a v, Ord a, Ord (v a)) => v a -> [Test] testOrdFunctions _ = $(testProperties ['prop_compare, 'prop_maximum, 'prop_minimum, @@ -443,7 +497,7 @@ prop_minIndex :: P (v a -> Int) = not . V.null ===> V.minIndex `eq` minIndex prop_maxIndex :: P (v a -> Int) = not . V.null ===> V.maxIndex `eq` maxIndex -testEnumFunctions :: forall a v. (COMMON_CONTEXT(a, v), Enum a, Ord a, Num a, Random a) => v a -> [Test] +testEnumFunctions :: forall a v. (CommonContext a v, Enum a, Ord a, Num a, Random a) => v a -> [Test] testEnumFunctions _ = $(testProperties [ 'prop_enumFromN, 'prop_enumFromThenN, 'prop_enumFromTo, 'prop_enumFromThenTo]) @@ -474,7 +528,7 @@ where d = abs (j-i) -testMonoidFunctions :: forall a v. (COMMON_CONTEXT(a, v), Monoid (v a)) => v a -> [Test] +testMonoidFunctions :: forall a v. (CommonContext a v, Monoid (v a)) => v a -> [Test] testMonoidFunctions _ = $(testProperties [ 'prop_mempty, 'prop_mappend, 'prop_mconcat ]) where @@ -482,20 +536,20 @@ prop_mappend :: P (v a -> v a -> v a) = mappend `eq` mappend prop_mconcat :: P ([v a] -> v a) = mconcat `eq` mconcat -testFunctorFunctions :: forall a v. (COMMON_CONTEXT(a, v), Functor v) => v a -> [Test] +testFunctorFunctions :: forall a v. (CommonContext a v, Functor v) => v a -> [Test] testFunctorFunctions _ = $(testProperties [ 'prop_fmap ]) where prop_fmap :: P ((a -> a) -> v a -> v a) = fmap `eq` fmap -testMonadFunctions :: forall a v. (COMMON_CONTEXT(a, v), Monad v) => v a -> [Test] +testMonadFunctions :: forall a v. (CommonContext a v, Monad v) => v a -> [Test] testMonadFunctions _ = $(testProperties [ 'prop_return, 'prop_bind ]) where prop_return :: P (a -> v a) = return `eq` return prop_bind :: P (v a -> (a -> v a) -> v a) = (>>=) `eq` (>>=) -testApplicativeFunctions :: forall a v. (COMMON_CONTEXT(a, v), V.Vector v (a -> a), Applicative.Applicative v) => v a -> [Test] +testApplicativeFunctions :: forall a v. (CommonContext a v, V.Vector v (a -> a), Applicative.Applicative v) => v a -> [Test] testApplicativeFunctions _ = $(testProperties [ 'prop_applicative_pure, 'prop_applicative_appl ]) where @@ -504,7 +558,7 @@ prop_applicative_appl :: [a -> a] -> P (v a -> v a) = \fs -> (Applicative.<*>) (V.fromList fs) `eq` (Applicative.<*>) fs -testAlternativeFunctions :: forall a v. (COMMON_CONTEXT(a, v), Applicative.Alternative v) => v a -> [Test] +testAlternativeFunctions :: forall a v. (CommonContext a v, Applicative.Alternative v) => v a -> [Test] testAlternativeFunctions _ = $(testProperties [ 'prop_alternative_empty, 'prop_alternative_or ]) where @@ -512,19 +566,19 @@ prop_alternative_or :: P (v a -> v a -> v a) = (Applicative.<|>) `eq` (Applicative.<|>) -testBoolFunctions :: forall v. (COMMON_CONTEXT(Bool, v)) => v Bool -> [Test] +testBoolFunctions :: forall v. (CommonContext Bool v) => v Bool -> [Test] testBoolFunctions _ = $(testProperties ['prop_and, 'prop_or]) where prop_and :: P (v Bool -> Bool) = V.and `eq` and prop_or :: P (v Bool -> Bool) = V.or `eq` or -testNumFunctions :: forall a v. (COMMON_CONTEXT(a, v), Num a) => v a -> [Test] +testNumFunctions :: forall a v. (CommonContext a v, Num a) => v a -> [Test] testNumFunctions _ = $(testProperties ['prop_sum, 'prop_product]) where prop_sum :: P (v a -> a) = V.sum `eq` sum prop_product :: P (v a -> a) = V.product `eq` product -testNestedVectorFunctions :: forall a v. (COMMON_CONTEXT(a, v)) => v a -> [Test] +testNestedVectorFunctions :: forall a v. (CommonContext a v) => v a -> [Test] testNestedVectorFunctions _ = $(testProperties []) where -- Prelude @@ -536,7 +590,7 @@ --prop_inits = V.inits `eq1` (inits :: v a -> [v a]) --prop_tails = V.tails `eq1` (tails :: v a -> [v a]) -testGeneralBoxedVector :: forall a. (COMMON_CONTEXT(a, Data.Vector.Vector), Ord a) => Data.Vector.Vector a -> [Test] +testGeneralBoxedVector :: forall a. (CommonContext a Data.Vector.Vector, Ord a) => Data.Vector.Vector a -> [Test] testGeneralBoxedVector dummy = concatMap ($ dummy) [ testSanity, testPolymorphicFunctions, @@ -556,7 +610,7 @@ , testBoolFunctions ] -testNumericBoxedVector :: forall a. (COMMON_CONTEXT(a, Data.Vector.Vector), Ord a, Num a, Enum a, Random a) => Data.Vector.Vector a -> [Test] +testNumericBoxedVector :: forall a. (CommonContext a Data.Vector.Vector, Ord a, Num a, Enum a, Random a) => Data.Vector.Vector a -> [Test] testNumericBoxedVector dummy = concatMap ($ dummy) [ testGeneralBoxedVector @@ -565,7 +619,7 @@ ] -testGeneralPrimitiveVector :: forall a. (COMMON_CONTEXT(a, Data.Vector.Primitive.Vector), Data.Vector.Primitive.Prim a, Ord a) => Data.Vector.Primitive.Vector a -> [Test] +testGeneralPrimitiveVector :: forall a. (CommonContext a Data.Vector.Primitive.Vector, Data.Vector.Primitive.Prim a, Ord a) => Data.Vector.Primitive.Vector a -> [Test] testGeneralPrimitiveVector dummy = concatMap ($ dummy) [ testSanity, testPolymorphicFunctions, @@ -573,7 +627,7 @@ testMonoidFunctions ] -testNumericPrimitiveVector :: forall a. (COMMON_CONTEXT(a, Data.Vector.Primitive.Vector), Data.Vector.Primitive.Prim a, Ord a, Num a, Enum a, Random a) => Data.Vector.Primitive.Vector a -> [Test] +testNumericPrimitiveVector :: forall a. (CommonContext a Data.Vector.Primitive.Vector, Data.Vector.Primitive.Prim a, Ord a, Num a, Enum a, Random a) => Data.Vector.Primitive.Vector a -> [Test] testNumericPrimitiveVector dummy = concatMap ($ dummy) [ testGeneralPrimitiveVector @@ -582,7 +636,7 @@ ] -testGeneralStorableVector :: forall a. (COMMON_CONTEXT(a, Data.Vector.Storable.Vector), Data.Vector.Storable.Storable a, Ord a) => Data.Vector.Storable.Vector a -> [Test] +testGeneralStorableVector :: forall a. (CommonContext a Data.Vector.Storable.Vector, Data.Vector.Storable.Storable a, Ord a) => Data.Vector.Storable.Vector a -> [Test] testGeneralStorableVector dummy = concatMap ($ dummy) [ testSanity, testPolymorphicFunctions, @@ -590,7 +644,7 @@ testMonoidFunctions ] -testNumericStorableVector :: forall a. (COMMON_CONTEXT(a, Data.Vector.Storable.Vector), Data.Vector.Storable.Storable a, Ord a, Num a, Enum a, Random a) => Data.Vector.Storable.Vector a -> [Test] +testNumericStorableVector :: forall a. (CommonContext a Data.Vector.Storable.Vector, Data.Vector.Storable.Storable a, Ord a, Num a, Enum a, Random a) => Data.Vector.Storable.Vector a -> [Test] testNumericStorableVector dummy = concatMap ($ dummy) [ testGeneralStorableVector @@ -599,7 +653,7 @@ ] -testGeneralUnboxedVector :: forall a. (COMMON_CONTEXT(a, Data.Vector.Unboxed.Vector), Data.Vector.Unboxed.Unbox a, Ord a) => Data.Vector.Unboxed.Vector a -> [Test] +testGeneralUnboxedVector :: forall a. (CommonContext a Data.Vector.Unboxed.Vector, Data.Vector.Unboxed.Unbox a, Ord a) => Data.Vector.Unboxed.Vector a -> [Test] testGeneralUnboxedVector dummy = concatMap ($ dummy) [ testSanity, testPolymorphicFunctions, @@ -618,7 +672,7 @@ , testBoolFunctions ] -testNumericUnboxedVector :: forall a. (COMMON_CONTEXT(a, Data.Vector.Unboxed.Vector), Data.Vector.Unboxed.Unbox a, Ord a, Num a, Enum a, Random a) => Data.Vector.Unboxed.Vector a -> [Test] +testNumericUnboxedVector :: forall a. (CommonContext a Data.Vector.Unboxed.Vector, Data.Vector.Unboxed.Unbox a, Ord a, Num a, Enum a, Random a) => Data.Vector.Unboxed.Vector a -> [Test] testNumericUnboxedVector dummy = concatMap ($ dummy) [ testGeneralUnboxedVector @@ -626,7 +680,7 @@ , testEnumFunctions ] -testTupleUnboxedVector :: forall a. (COMMON_CONTEXT(a, Data.Vector.Unboxed.Vector), Data.Vector.Unboxed.Unbox a, Ord a) => Data.Vector.Unboxed.Vector a -> [Test] +testTupleUnboxedVector :: forall a. (CommonContext a Data.Vector.Unboxed.Vector, Data.Vector.Unboxed.Unbox a, Ord a) => Data.Vector.Unboxed.Vector a -> [Test] testTupleUnboxedVector dummy = concatMap ($ dummy) [ testGeneralUnboxedVector @@ -643,10 +697,10 @@ testGroup "Data.Vector.Storable.Vector (Double)" (testNumericStorableVector (undefined :: Data.Vector.Storable.Vector Double)), testGroup "Data.Vector.Unboxed.Vector ()" (testUnitUnboxedVector (undefined :: Data.Vector.Unboxed.Vector ())), + testGroup "Data.Vector.Unboxed.Vector (Bool)" (testBoolUnboxedVector (undefined :: Data.Vector.Unboxed.Vector Bool)), testGroup "Data.Vector.Unboxed.Vector (Int)" (testNumericUnboxedVector (undefined :: Data.Vector.Unboxed.Vector Int)), testGroup "Data.Vector.Unboxed.Vector (Double)" (testNumericUnboxedVector (undefined :: Data.Vector.Unboxed.Vector Double)), testGroup "Data.Vector.Unboxed.Vector (Int,Bool)" (testTupleUnboxedVector (undefined :: Data.Vector.Unboxed.Vector (Int,Bool))), testGroup "Data.Vector.Unboxed.Vector (Int,Bool,Int)" (testTupleUnboxedVector (undefined :: Data.Vector.Unboxed.Vector (Int,Bool,Int))) ] - diff --git a/tests/Utilities.hs b/tests/Utilities.hs --- a/tests/Utilities.hs +++ b/tests/Utilities.hs @@ -16,6 +16,7 @@ import Data.Functor.Identity import Data.List ( sortBy ) import Data.Monoid +import Data.Maybe (catMaybes) instance Show a => Show (S.Bundle v a) where show s = "Data.Vector.Fusion.Bundle.fromList " ++ show (S.toList s) @@ -51,14 +52,10 @@ instance CoArbitrary a => CoArbitrary (S.Bundle v a) where coarbitrary = coarbitrary . S.toList -instance Arbitrary a => Arbitrary (Identity a) where - arbitrary = fmap Identity arbitrary - -instance CoArbitrary a => CoArbitrary (Identity a) where - coarbitrary = coarbitrary . runIdentity - -instance Arbitrary a => Arbitrary (Writer a ()) where - arbitrary = fmap (writer . ((,) ())) arbitrary +instance (Arbitrary a, Arbitrary b) => Arbitrary (Writer a b) where + arbitrary = do b <- arbitrary + a <- arbitrary + return $ writer (b,a) instance CoArbitrary a => CoArbitrary (Writer a ()) where coarbitrary = coarbitrary . runWriter @@ -153,13 +150,13 @@ type EqTest (Identity a) = Property equal = (property .) . on (==) runIdentity -instance (Eq a, TestData a, Monoid a) => TestData (Writer a ()) where - type Model (Writer a ()) = Writer (Model a) () +instance (Eq a, TestData a, Eq b, TestData b, Monoid a) => TestData (Writer a b) where + type Model (Writer a b) = Writer (Model a) (Model b) model = mapWriter model unmodel = mapWriter unmodel - type EqTest (Writer a ()) = Property - equal = (property .) . on (==) execWriter + type EqTest (Writer a b) = Property + equal = (property .) . on (==) runWriter instance (Eq a, Eq b, TestData a, TestData b) => TestData (a,b) where type Model (a,b) = (Model a, Model b) @@ -218,7 +215,7 @@ -- Generators index_value_pairs :: Arbitrary a => Int -> Gen [(Int,a)] -index_value_pairs 0 = return [] +index_value_pairs 0 = return [] index_value_pairs m = sized $ \n -> do len <- choose (0,n) @@ -253,7 +250,7 @@ go (x:xs) ((i,y) : ps) j | i == j = go (f x y : xs) ps j go (x:xs) ps j = x : go xs ps (j+1) - go [] _ _ = [] + go [] _ _ = [] (//) :: [a] -> [(Int, a)] -> [a] xs // ps = go xs ps' 0 @@ -292,11 +289,23 @@ ifilter :: (Int -> a -> Bool) -> [a] -> [a] ifilter f = map snd . withIndexFirst filter f +mapMaybe :: (a -> Maybe b) -> [a] -> [b] +mapMaybe f = catMaybes . map f + +imapMaybe :: (Int -> a -> Maybe b) -> [a] -> [b] +imapMaybe f = catMaybes . withIndexFirst map f + indexedLeftFold fld f z = fld (uncurry . f) z . zip [0..] ifoldl :: (a -> Int -> a -> a) -> a -> [a] -> a ifoldl = indexedLeftFold foldl +iscanl :: (Int -> a -> b -> a) -> a -> [b] -> [a] +iscanl f z = scanl (\a (i, b) -> f i a b) z . zip [0..] + +iscanr :: (Int -> a -> b -> b) -> b -> [a] -> [b] +iscanr f z = scanr (uncurry f) z . zip [0..] + ifoldr :: (Int -> a -> b -> b) -> b -> [a] -> b ifoldr f z = foldr (uncurry f) z . zip [0..] @@ -318,3 +327,24 @@ imax (i,x) (j,y) | x >= y = (i,x) | otherwise = (j,y) +iterateNM :: Monad m => Int -> (a -> m a) -> a -> m [a] +iterateNM n f x + | n <= 0 = return [] + | n == 1 = return [x] + | otherwise = do x' <- f x + xs <- iterateNM (n-1) f x' + return (x : xs) + +unfoldrM :: Monad m => (b -> m (Maybe (a,b))) -> b -> m [a] +unfoldrM step b0 = do + r <- step b0 + case r of + Nothing -> return [] + Just (a,b) -> do as <- unfoldrM step b + return (a : as) + + +limitUnfolds f (theirs, ours) + | ours >= 0 + , Just (out, theirs') <- f theirs = Just (out, (theirs', ours - 1)) + | otherwise = Nothing diff --git a/vector.cabal b/vector.cabal --- a/vector.cabal +++ b/vector.cabal @@ -1,5 +1,5 @@ Name: vector -Version: 0.11.0.0 +Version: 0.12.0.0 -- don't forget to update the changelog file! License: BSD3 License-File: LICENSE @@ -34,10 +34,18 @@ . * +Tested-With: + GHC == 7.4.2, + GHC == 7.6.3, + GHC == 7.8.4, + GHC == 7.10.3, + GHC == 8.0.1 + Cabal-Version: >=1.10 Build-Type: Simple Extra-Source-Files: + changelog README.md tests/LICENSE tests/Setup.hs @@ -83,6 +91,10 @@ Default: False Manual: True +Flag Wall + Description: Enable all -Wall warnings + Default: False + Manual: True Library Default-Language: Haskell2010 @@ -137,13 +149,21 @@ Install-Includes: vector.h - Build-Depends: base >= 4.3 && < 4.9 + Build-Depends: base >= 4.5 && < 4.10 , primitive >= 0.5.0.1 && < 0.7 - , ghc-prim >= 0.2 && < 0.5 + , ghc-prim >= 0.2 && < 0.6 , deepseq >= 1.1 && < 1.5 + if !impl(ghc > 8.0) + Build-Depends: semigroups >= 0.18 && < 0.19 - Ghc-Options: -O2 -Wall -fno-warn-orphans + Ghc-Options: -O2 -Wall + if !flag(Wall) + Ghc-Options: -fno-warn-orphans + + if impl(ghc >= 8.0) && impl(ghc < 8.1) + Ghc-Options: -Wno-redundant-constraints + if flag(BoundsChecks) cpp-options: -DVECTOR_BOUNDS_CHECKS @@ -164,9 +184,10 @@ type: exitcode-stdio-1.0 Main-Is: Main.hs hs-source-dirs: tests - Build-Depends: base >= 4 && < 5, template-haskell, vector, + Build-Depends: base >= 4.5 && < 5, template-haskell, vector, random, - QuickCheck >= 2.7 && < 2.8 , test-framework, test-framework-quickcheck2, + QuickCheck >= 2.9 && < 2.10 , HUnit, test-framework, + test-framework-hunit, test-framework-quickcheck2, transformers >= 0.2.0.0 default-extensions: CPP, @@ -180,16 +201,23 @@ TemplateHaskell Ghc-Options: -O0 - Ghc-Options: -Wall -fno-warn-orphans -fno-warn-missing-signatures + Ghc-Options: -Wall + if !flag(Wall) + Ghc-Options: -fno-warn-orphans -fno-warn-missing-signatures + if impl(ghc >= 8.0) && impl( ghc < 8.1) + Ghc-Options: -Wno-redundant-constraints + + test-suite vector-tests-O2 Default-Language: Haskell2010 type: exitcode-stdio-1.0 Main-Is: Main.hs hs-source-dirs: tests - Build-Depends: base >= 4 && < 5, template-haskell, vector, + Build-Depends: base >= 4.5 && < 5, template-haskell, vector, random, - QuickCheck >= 2.7, test-framework, test-framework-quickcheck2, + QuickCheck >= 2.9 && < 2.10 , HUnit, test-framework, + test-framework-hunit, test-framework-quickcheck2, transformers >= 0.2.0.0 default-extensions: CPP, @@ -202,5 +230,10 @@ TypeFamilies, TemplateHaskell - Ghc-Options: -O2 - Ghc-Options: -Wall -fno-warn-orphans -fno-warn-missing-signatures + Ghc-Options: -O2 -Wall + + if !flag(Wall) + Ghc-Options: -fno-warn-orphans -fno-warn-missing-signatures + if impl(ghc >= 8.0) && impl(ghc < 8.1) + Ghc-Options: -Wno-redundant-constraints +