diff --git a/Data/Vector.hs b/Data/Vector.hs --- a/Data/Vector.hs +++ b/Data/Vector.hs @@ -10,7 +10,7 @@ -- Portability : non-portable -- -- A library for boxed vectors (that is, polymorphic arrays capable of --- holding any Haskell value). The vectors come in two flavors: +-- holding any Haskell value). The vectors come in two flavours: -- -- * mutable -- @@ -19,7 +19,7 @@ -- and support a rich interface of both list-like operations, and bulk -- array operations. -- --- For unboxed arrays, use the 'Data.Vector.Unboxed' interface. +-- For unboxed arrays, use "Data.Vector.Unboxed" -- module Data.Vector ( @@ -53,6 +53,7 @@ -- ** Unfolding unfoldr, unfoldrN, + constructN, constructrN, -- ** Enumeration enumFromN, enumFromStepN, enumFromTo, enumFromThenTo, @@ -155,7 +156,7 @@ import Data.Primitive.Array import qualified Data.Vector.Fusion.Stream as Stream -import Control.Monad ( liftM ) +import Control.Monad ( liftM, ap ) import Control.Monad.ST ( ST ) import Control.Monad.Primitive @@ -177,8 +178,12 @@ import Data.Typeable ( Typeable ) import Data.Data ( Data(..) ) +import Text.Read ( Read(..), readListPrecDefault ) import Data.Monoid ( Monoid(..) ) +import qualified Control.Applicative as Applicative +import qualified Data.Foldable as Foldable +import qualified Data.Traversable as Traversable -- | Boxed vectors, supporting efficient slicing. data Vector a = Vector {-# UNPACK #-} !Int @@ -187,8 +192,12 @@ deriving ( Typeable ) instance Show a => Show (Vector a) where - show = (Prelude.++ " :: Data.Vector.Vector") . ("fromList " Prelude.++) . show . toList + showsPrec = G.showsPrec +instance Read a => Read (Vector a) where + readPrec = G.readPrec + readListPrec = readListPrecDefault + instance Data a => Data (Vector a) where gfoldl = G.gfoldl toConstr _ = error "toConstr" @@ -216,6 +225,10 @@ {-# INLINE basicUnsafeIndexM #-} basicUnsafeIndexM (Vector i _ arr) j = indexArrayM arr (i+j) + {-# INLINE basicUnsafeCopy #-} + basicUnsafeCopy (MVector i n dst) (Vector j _ src) + = copyArray dst i src j n + -- See http://trac.haskell.org/vector/ticket/12 instance Eq a => Eq (Vector a) where {-# INLINE (==) #-} @@ -251,6 +264,54 @@ {-# INLINE mconcat #-} mconcat = concat +instance Functor Vector where + {-# INLINE fmap #-} + fmap = map + +instance Monad Vector where + {-# INLINE return #-} + return = singleton + + {-# INLINE (>>=) #-} + (>>=) = flip concatMap + +instance Applicative.Applicative Vector where + {-# INLINE pure #-} + pure = singleton + + {-# INLINE (<*>) #-} + (<*>) = ap + +instance Applicative.Alternative Vector where + {-# INLINE empty #-} + empty = empty + + {-# INLINE (<|>) #-} + (<|>) = (++) + +instance Foldable.Foldable Vector where + {-# INLINE foldr #-} + foldr = foldr + + {-# INLINE foldl #-} + foldl = foldl + + {-# INLINE foldr1 #-} + foldr1 = foldr1 + + {-# INLINE foldl1 #-} + foldl1 = foldl1 + +instance Traversable.Traversable Vector where + {-# INLINE traverse #-} + traverse f xs = fromList Applicative.<$> Traversable.traverse f (toList xs) + + {-# INLINE mapM #-} + mapM = mapM + + {-# INLINE sequence #-} + sequence = sequence + -- Length information -- ------------------ @@ -485,6 +546,25 @@ unfoldrN :: Int -> (b -> Maybe (a, b)) -> b -> Vector a {-# INLINE unfoldrN #-} unfoldrN = G.unfoldrN + +-- | /O(n)/ Construct a vector with @n@ elements by repeatedly applying the +-- generator function to the already constructed part of the vector. +-- +-- > constructN 3 f = let a = f <> ; b = f ; c = f in f +-- +constructN :: Int -> (Vector a -> a) -> Vector a +{-# INLINE constructN #-} +constructN = G.constructN + +-- | /O(n)/ Construct a vector with @n@ elements from right to left by +-- repeatedly applying the generator function to the already constructed part +-- of the vector. +-- +-- > constructrN 3 f = let a = f <> ; b = f ; c = f in f +-- +constructrN :: Int -> (Vector a -> a) -> Vector a +{-# INLINE constructrN #-} +constructrN = G.constructrN -- Enumeration -- ----------- diff --git a/Data/Vector/Fusion/Stream.hs b/Data/Vector/Fusion/Stream.hs --- a/Data/Vector/Fusion/Stream.hs +++ b/Data/Vector/Fusion/Stream.hs @@ -29,7 +29,7 @@ empty, singleton, cons, snoc, replicate, generate, (++), -- * Accessing individual elements - head, last, (!!), + head, last, (!!), (!?), -- * Substreams slice, init, tail, take, drop, @@ -199,10 +199,17 @@ {-# INLINE last #-} last = unId . M.last +infixl 9 !! -- | Element at the given position (!!) :: Stream a -> Int -> a {-# INLINE (!!) #-} s !! i = unId (s M.!! i) + +infixl 9 !? +-- | Element at the given position or 'Nothing' if out of bounds +(!?) :: Stream a -> Int -> Maybe a +{-# INLINE (!?) #-} +s !? i = unId (s M.!? i) -- Substreams -- ---------- 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 @@ -25,7 +25,7 @@ empty, singleton, cons, snoc, replicate, replicateM, generate, generateM, (++), -- * Accessing elements - head, last, (!!), + head, last, (!!), (!?), -- * Substreams slice, init, tail, take, drop, @@ -255,6 +255,7 @@ Skip s' -> last_loop1 SPEC x s' Done -> return x +infixl 9 !! -- | Element at the given position (!!) :: Monad m => Stream m a -> Int -> m a {-# INLINE (!!) #-} @@ -271,6 +272,22 @@ Skip s' -> index_loop SPEC s' i Done -> BOUNDS_ERROR(emptyStream) "!!" +infixl 9 !? +-- | Element at the given position or 'Nothing' if out of bounds +(!?) :: Monad m => Stream m a -> Int -> m (Maybe a) +{-# INLINE (!?) #-} +Stream step s _ !? i = index_loop SPEC s i + where + index_loop !sPEC s i + = i `seq` + do + r <- step s + case r of + Yield x s' | i == 0 -> return (Just x) + | otherwise -> index_loop SPEC s' (i-1) + Skip s' -> index_loop SPEC s' i + Done -> return Nothing + -- Substreams -- ---------- @@ -357,7 +374,6 @@ Done -> Done ) (step s) - -- Mapping -- ------- @@ -944,7 +960,7 @@ case r of Yield a t' -> do s <- mk a - return $ Skip (Right (s,t')) + s `seq` return (Skip (Right (s,t'))) Skip t' -> return $ Skip (Left t') Done -> return $ Done diff --git a/Data/Vector/Fusion/Stream/Monadic/Safe.hs b/Data/Vector/Fusion/Stream/Monadic/Safe.hs new file mode 100644 --- /dev/null +++ b/Data/Vector/Fusion/Stream/Monadic/Safe.hs @@ -0,0 +1,78 @@ +#if __GLASGOW_HASKELL__ >= 701 +{-# LANGUAGE Trustworthy #-} +#endif + +-- | +-- Module : Data.Vector.Fusion.Stream.Monadic.Safe +-- Copyright : (c) Roman Leshchinskiy 2008-2010 +-- License : BSD-style +-- +-- Maintainer : Roman Leshchinskiy +-- Stability : experimental +-- Portability : non-portable +-- +-- Safe interface to "Data.Vector.Fusion.Stream.Monadic" +-- + +module Data.Vector.Fusion.Stream.Monadic.Safe ( + Stream(..), Step(..), + + -- * Size hints + size, sized, + + -- * Length + length, null, + + -- * Construction + empty, singleton, cons, snoc, replicate, replicateM, generate, generateM, (++), + + -- * Accessing elements + head, last, (!!), + + -- * Substreams + slice, init, tail, take, drop, + + -- * Mapping + map, mapM, mapM_, trans, unbox, concatMap, flatten, + + -- * Zipping + indexed, indexedR, zipWithM_, + zipWithM, zipWith3M, zipWith4M, zipWith5M, zipWith6M, + zipWith, zipWith3, zipWith4, zipWith5, zipWith6, + zip, zip3, zip4, zip5, zip6, + + -- * Filtering + filter, filterM, takeWhile, takeWhileM, dropWhile, dropWhileM, + + -- * Searching + elem, notElem, find, findM, findIndex, findIndexM, + + -- * Folding + foldl, foldlM, foldl1, foldl1M, foldM, fold1M, + foldl', foldlM', foldl1', foldl1M', foldM', fold1M', + foldr, foldrM, foldr1, foldr1M, + + -- * Specialised folds + and, or, concatMapM, + + -- * Unfolding + unfoldr, unfoldrM, + unfoldrN, unfoldrNM, + iterateN, iterateNM, + + -- * Scans + prescanl, prescanlM, prescanl', prescanlM', + postscanl, postscanlM, postscanl', postscanlM', + scanl, scanlM, scanl', scanlM', + scanl1, scanl1M, scanl1', scanl1M', + + -- * Enumerations + enumFromStepN, enumFromTo, enumFromThenTo, + + -- * Conversions + toList, fromList, fromListN +) where + +import Data.Vector.Fusion.Stream.Monadic +import Prelude () + diff --git a/Data/Vector/Fusion/Stream/Safe.hs b/Data/Vector/Fusion/Stream/Safe.hs new file mode 100644 --- /dev/null +++ b/Data/Vector/Fusion/Stream/Safe.hs @@ -0,0 +1,82 @@ +#if __GLASGOW_HASKELL__ >= 701 +{-# LANGUAGE Trustworthy #-} +#endif + +-- | +-- Module : Data.Vector.Fusion.Stream.Safe +-- Copyright : (c) Roman Leshchinskiy 2008-2010 +-- License : BSD-style +-- +-- Maintainer : Roman Leshchinskiy +-- Stability : experimental +-- Portability : non-portable +-- +-- Safe interface to "Data.Vector.Fusion.Stream" +-- + +module Data.Vector.Fusion.Stream.Safe ( + -- * Types + Step(..), Stream, MStream, + + -- * In-place markers + inplace, + + -- * Size hints + size, sized, + + -- * Length information + length, null, + + -- * Construction + empty, singleton, cons, snoc, replicate, generate, (++), + + -- * Accessing individual elements + head, last, (!!), + + -- * Substreams + slice, init, tail, take, drop, + + -- * Mapping + map, concatMap, flatten, unbox, + + -- * Zipping + indexed, indexedR, + zipWith, zipWith3, zipWith4, zipWith5, zipWith6, + zip, zip3, zip4, zip5, zip6, + + -- * Filtering + filter, takeWhile, dropWhile, + + -- * Searching + elem, notElem, find, findIndex, + + -- * Folding + foldl, foldl1, foldl', foldl1', foldr, foldr1, + + -- * Specialised folds + and, or, + + -- * Unfolding + unfoldr, unfoldrN, iterateN, + + -- * Scans + prescanl, prescanl', + postscanl, postscanl', + scanl, scanl', + scanl1, scanl1', + + -- * Enumerations + enumFromStepN, enumFromTo, enumFromThenTo, + + -- * Conversions + toList, fromList, fromListN, liftStream, + + -- * Monadic combinators + mapM, mapM_, zipWithM, zipWithM_, filterM, foldM, fold1M, foldM', fold1M', + + eq, cmp +) where + +import Data.Vector.Fusion.Stream +import Prelude () + diff --git a/Data/Vector/Fusion/Stream/Size.hs b/Data/Vector/Fusion/Stream/Size.hs --- a/Data/Vector/Fusion/Stream/Size.hs +++ b/Data/Vector/Fusion/Stream/Size.hs @@ -1,3 +1,8 @@ +#if __GLASGOW_HASKELL__ >= 703 +{-# LANGUAGE Safe #-} +#elif __GLASGOW_HASKELL__ >= 701 +{-# LANGUAGE Trustworthy #-} +#endif -- | -- Module : Data.Vector.Fusion.Stream.Size -- Copyright : (c) Roman Leshchinskiy 2008-2010 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,8 @@ +#if __GLASGOW_HASKELL__ >= 703 +{-# LANGUAGE Safe #-} +#elif __GLASGOW_HASKELL__ >= 701 +{-# LANGUAGE Trustworthy #-} +#endif -- | -- Module : Data.Vector.Fusion.Util -- Copyright : (c) Roman Leshchinskiy 2009 diff --git a/Data/Vector/Generic.hs b/Data/Vector/Generic.hs --- a/Data/Vector/Generic.hs +++ b/Data/Vector/Generic.hs @@ -1,5 +1,5 @@ {-# LANGUAGE Rank2Types, MultiParamTypeClasses, FlexibleContexts, - TypeFamilies, ScopedTypeVariables #-} + TypeFamilies, ScopedTypeVariables, BangPatterns #-} -- | -- Module : Data.Vector.Generic -- Copyright : (c) Roman Leshchinskiy 2008-2010 @@ -43,6 +43,7 @@ -- ** Unfolding unfoldr, unfoldrN, + constructN, constructrN, -- ** Enumeration enumFromN, enumFromStepN, enumFromTo, enumFromThenTo, @@ -152,6 +153,9 @@ -- ** Comparisons eq, cmp, + -- ** Show and Read + showsPrec, readPrec, + -- ** @Data@ and @Typeable@ gfoldl, dataCast, mkType ) where @@ -165,7 +169,7 @@ import Data.Vector.Generic.New ( New ) import qualified Data.Vector.Fusion.Stream as Stream -import Data.Vector.Fusion.Stream ( Stream, MStream, inplace, liftStream ) +import Data.Vector.Fusion.Stream ( Stream, MStream, Step(..), inplace, liftStream ) import qualified Data.Vector.Fusion.Stream.Monadic as MStream import Data.Vector.Fusion.Stream.Size import Data.Vector.Fusion.Util @@ -186,8 +190,10 @@ all, any, and, or, sum, product, maximum, minimum, scanl, scanl1, scanr, scanr1, enumFromTo, enumFromThenTo, - mapM, mapM_, sequence, sequence_ ) + mapM, mapM_, sequence, sequence_, + showsPrec ) +import qualified Text.Read as Read import Data.Typeable ( Typeable1, gcast1 ) #include "vector.h" @@ -231,12 +237,14 @@ -- Indexing -- -------- +infixl 9 ! -- | O(1) Indexing (!) :: Vector v a => v a -> Int -> a {-# INLINE_STREAM (!) #-} -v ! i = BOUNDS_CHECK(checkIndex) "(!)" i (length v) - $ unId (basicUnsafeIndexM v i) +(!) v i = BOUNDS_CHECK(checkIndex) "(!)" i (length v) + $ unId (basicUnsafeIndexM v i) +infixl 9 !? -- | O(1) Safe indexing (!?) :: Vector v a => v a -> Int -> Maybe a {-# INLINE_STREAM (!?) #-} @@ -274,6 +282,9 @@ "(!)/unstream [Vector]" forall i s. new (New.unstream s) ! i = s Stream.!! i +"(!?)/unstream [Vector]" forall i s. + new (New.unstream s) !? i = s Stream.!? i + "head/unstream [Vector]" forall s. head (new (New.unstream s)) = Stream.head s @@ -542,6 +553,64 @@ {-# INLINE unfoldrN #-} unfoldrN n f = unstream . Stream.unfoldrN n f +-- | /O(n)/ Construct a vector with @n@ elements by repeatedly applying the +-- generator function to the already constructed part of the vector. +-- +-- > constructN 3 f = let a = f <> ; b = f ; c = f in f +-- +constructN :: forall v a. Vector v a => Int -> (v a -> a) -> v a +{-# INLINE constructN #-} +-- NOTE: We *CANNOT* wrap this in New and then fuse because the elements +-- might contain references to the immutable vector! +constructN !n f = runST ( + do + v <- M.new n + v' <- unsafeFreeze v + fill v' 0 + ) + where + fill :: forall s. v a -> Int -> ST s (v a) + fill !v i | i < n = let x = f (unsafeTake i v) + in + elemseq v x $ + do + v' <- unsafeThaw v + M.unsafeWrite v' i x + v'' <- unsafeFreeze v' + fill v'' (i+1) + + fill v i = return v + +-- | /O(n)/ Construct a vector with @n@ elements from right to left by +-- repeatedly applying the generator function to the already constructed part +-- of the vector. +-- +-- > constructrN 3 f = let a = f <> ; b = f ; c = f in f +-- +constructrN :: forall v a. Vector v a => Int -> (v a -> a) -> v a +{-# INLINE constructrN #-} +-- NOTE: We *CANNOT* wrap this in New and then fuse because the elements +-- might contain references to the immutable vector! +constructrN !n f = runST ( + do + v <- n `seq` M.new n + v' <- unsafeFreeze v + fill v' 0 + ) + where + fill :: forall s. v a -> Int -> ST s (v a) + fill !v i | i < n = let x = f (unsafeSlice (n-i) i v) + in + elemseq v x $ + do + v' <- unsafeThaw v + M.unsafeWrite v' (n-i-1) x + v'' <- unsafeFreeze v' + fill v'' (i+1) + + fill v i = return v + + -- Enumeration -- ----------- @@ -607,7 +676,6 @@ -- | /O(n)/ Concatenate all vectors in the list concat :: Vector v a => [v a] -> v a {-# INLINE concat #-} --- concat vs = create (thawMany vs) concat vs = unstream (Stream.flatten mk step (Exact n) (Stream.fromList vs)) where n = List.foldl' (\k v -> k + length v) 0 vs @@ -917,9 +985,29 @@ concatMap :: (Vector v a, Vector v b) => (a -> v b) -> v a -> v b {-# INLINE concatMap #-} -- NOTE: We can't fuse concatMap anyway so don't pretend we do. +-- This seems to be slightly slower +-- concatMap f = concat . Stream.toList . Stream.map f . stream + +-- Slowest -- concatMap f = unstream . Stream.concatMap (stream . f) . stream -concatMap f = concat . Stream.toList . Stream.map f . stream +-- Seems to be fastest +concatMap f = unstream + . Stream.flatten mk step Unknown + . stream + where + {-# INLINE_INNER step #-} + step (v,i,k) + | i < k = case unsafeIndexM v i of + Box x -> Stream.Yield x (v,i+1,k) + | otherwise = Stream.Done + + {-# INLINE mk #-} + mk x = let v = f x + k = length v + in + k `seq` (v,0,k) + -- Monadic mapping -- --------------- @@ -1681,11 +1769,15 @@ {-# INLINE unsafeFreeze #-} unsafeFreeze = basicUnsafeFreeze +-- | /O(n)/ Yield an immutable copy of the mutable vector. +freeze :: (PrimMonad m, Vector v a) => Mutable v (PrimState m) a -> m (v a) +{-# INLINE freeze #-} +freeze mv = unsafeFreeze =<< M.clone mv -- | /O(1)/ Unsafely convert an immutable vector to a mutable one without -- copying. The immutable vector may not be used after this operation. unsafeThaw :: (PrimMonad m, Vector v a) => v a -> m (Mutable v (PrimState m) a) -{-# INLINE unsafeThaw #-} +{-# INLINE_STREAM unsafeThaw #-} unsafeThaw = basicUnsafeThaw -- | /O(n)/ Yield a mutable copy of the immutable vector. @@ -1696,11 +1788,16 @@ unsafeCopy mv v return mv --- | /O(n)/ Yield an immutable copy of the mutable vector. -freeze :: (PrimMonad m, Vector v a) => Mutable v (PrimState m) a -> m (v a) -{-# INLINE freeze #-} -freeze mv = unsafeFreeze =<< M.clone mv +{-# RULES +"unsafeThaw/new [Vector]" forall p. + unsafeThaw (new p) = New.runPrim p + +"thaw/new [Vector]" forall p. + thaw (new p) = New.runPrim p + + #-} + {- -- | /O(n)/ Yield a mutable vector containing copies of each vector in the -- list. @@ -1810,6 +1907,12 @@ "New.unstreamR/streamR/new [Vector]" forall p. New.unstreamR (streamR (new p)) = p +"New.unstream/streamR/new [Vector]" forall p. + New.unstream (streamR (new p)) = New.modify M.reverse p + +"New.unstreamR/stream/new [Vector]" forall p. + New.unstreamR (stream (new p)) = New.modify M.reverse p + "inplace right [Vector]" forall (f :: forall m. Monad m => MStream m a -> MStream m a) m. New.unstreamR (inplace f (streamR (new m))) = New.transformR f m @@ -1883,6 +1986,22 @@ cmp :: (Vector v a, Ord a) => v a -> v a -> Ordering {-# INLINE cmp #-} cmp xs ys = compare (stream xs) (stream ys) + +-- Show +-- ---- + +-- | Generic definition of 'Prelude.showsPrec' +showsPrec :: (Vector v a, Show a) => Int -> v a -> ShowS +{-# INLINE showsPrec #-} +showsPrec p v = showParen (p > 10) $ showString "fromList " . shows (toList v) + +-- | Generic definition of 'Text.Read.readPrec' +readPrec :: (Vector v a, Read a) => Read.ReadPrec (v a) +{-# INLINE readPrec #-} +readPrec = Read.parens $ Read.prec 10 $ do + Read.Ident "fromList" <- Read.lexP + xs <- Read.readPrec + return (fromList xs) -- Data and Typeable -- ----------------- 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 @@ -48,15 +48,13 @@ set, copy, move, unsafeCopy, unsafeMove, -- * Internal operations + mstream, mstreamR, unstream, unstreamR, munstream, munstreamR, transform, transformR, fill, fillR, unsafeAccum, accum, unsafeUpdate, update, reverse, - unstablePartition, unstablePartitionStream, partitionStream, - - -- * Deprecated operations - newWith, unsafeNewWith + unstablePartition, unstablePartitionStream, partitionStream ) where import qualified Data.Vector.Fusion.Stream as Stream @@ -133,14 +131,8 @@ basicUnsafeGrow :: PrimMonad m => v (PrimState m) a -> Int -> m (v (PrimState m) a) - -- | /DEPRECATED/ in favour of 'basicUnsafeReplicate' - basicUnsafeNewWith :: PrimMonad m => Int -> a -> m (v (PrimState m) a) - {-# INLINE basicUnsafeReplicate #-} - basicUnsafeReplicate = basicUnsafeNewWith - - {-# INLINE basicUnsafeNewWith #-} - basicUnsafeNewWith n x + basicUnsafeReplicate n x = do v <- basicUnsafeNew n basicSet v x @@ -150,14 +142,19 @@ basicClear _ = return () {-# INLINE basicSet #-} - basicSet !v x = do_set 0 + basicSet !v x + | n == 0 = return () + | otherwise = do + basicUnsafeWrite v 0 x + do_set 1 where !n = basicLength v - do_set i | i < n = do - basicUnsafeWrite v i x - do_set (i+1) - | otherwise = return () + do_set i | 2*i < n = do basicUnsafeCopy (basicUnsafeSlice i i v) + (basicUnsafeSlice 0 i v) + do_set (2*i) + | otherwise = basicUnsafeCopy (basicUnsafeSlice i (n-i) v) + (basicUnsafeSlice 0 (n-i) v) {-# INLINE basicUnsafeCopy #-} basicUnsafeCopy !dst !src = do_copy 0 @@ -186,8 +183,6 @@ where n = basicLength v -{-# DEPRECATED basicUnsafeNewWith "define and use basicUnsafeReplicate instead" #-} - -- ------------------ -- Internal functions -- ------------------ @@ -872,19 +867,4 @@ | otherwise = do v2' <- unsafeAppend1 v2 i2 x return (v1, i1, v2', i2+1) - --- Deprecated functions --- -------------------- - --- | /DEPRECATED/ Use 'replicate' instead -newWith :: (PrimMonad m, MVector v a) => Int -> a -> m (v (PrimState m) a) -{-# INLINE newWith #-} -newWith = replicate - --- | /DEPRECATED/ Use 'replicate' instead -unsafeNewWith :: (PrimMonad m, MVector v a) => Int -> a -> m (v (PrimState m) a) -{-# INLINE unsafeNewWith #-} -unsafeNewWith = replicate - -{-# DEPRECATED newWith, unsafeNewWith "Use replicate instead" #-} diff --git a/Data/Vector/Generic/Mutable/Safe.hs b/Data/Vector/Generic/Mutable/Safe.hs new file mode 100644 --- /dev/null +++ b/Data/Vector/Generic/Mutable/Safe.hs @@ -0,0 +1,61 @@ +#if __GLASGOW_HASKELL__ >= 701 && defined(VECTOR_BOUNDS_CHECKS) +{-# LANGUAGE Trustworthy #-} +#endif +-- | +-- Module : Data.Vector.Generic.Mutable.Safe +-- Copyright : (c) Roman Leshchinskiy 2008-2010 +-- License : BSD-style +-- +-- Maintainer : Roman Leshchinskiy +-- Stability : experimental +-- Portability : non-portable +-- +-- Safe interface to "Data.Vector.Generic.Mutable" +-- + +module Data.Vector.Generic.Mutable.Safe ( + -- * Class of mutable vector types + MVector, + + -- * Accessors + + -- ** Length information + length, null, + + -- ** Extracting subvectors + slice, init, tail, take, drop, splitAt, + + -- ** Overlapping + overlaps, + + -- * Construction + + -- ** Initialisation + new, replicate, replicateM, clone, + + -- ** Growing + grow, + + -- ** Restricting memory usage + clear, + + -- * Accessing individual elements + read, write, swap, + + -- * Modifying vectors + + -- ** Filling and copying + set, copy, move, + + -- * Internal operations + unstream, unstreamR, + munstream, munstreamR, + transform, transformR, + fill, fillR, + accum, update, reverse, + unstablePartition, unstablePartitionStream, partitionStream +) where + +import Data.Vector.Generic.Mutable +import Prelude () + diff --git a/Data/Vector/Generic/New.hs b/Data/Vector/Generic/New.hs --- a/Data/Vector/Generic/New.hs +++ b/Data/Vector/Generic/New.hs @@ -13,7 +13,7 @@ -- module Data.Vector.Generic.New ( - New(..), create, run, apply, modify, modifyWithStream, + New(..), create, run, runPrim, apply, modify, modifyWithStream, unstream, transform, unstreamR, transformR, slice, init, tail, take, drop, unsafeSlice, unsafeInit, unsafeTail @@ -27,6 +27,7 @@ import Data.Vector.Fusion.Stream ( Stream, MStream ) import qualified Data.Vector.Fusion.Stream as Stream +import Control.Monad.Primitive import Control.Monad.ST ( ST ) import Control.Monad ( liftM ) import Prelude hiding ( init, tail, take, drop, reverse, map, filter ) @@ -42,6 +43,10 @@ run :: New v a -> ST s (Mutable v s a) {-# INLINE run #-} run (New p) = p + +runPrim :: PrimMonad m => New v a -> m (Mutable v (PrimState m) a) +{-# INLINE runPrim #-} +runPrim (New p) = primToPrim p apply :: (forall s. Mutable v s a -> Mutable v s a) -> New v a -> New v a {-# INLINE apply #-} diff --git a/Data/Vector/Generic/New/Safe.hs b/Data/Vector/Generic/New/Safe.hs new file mode 100644 --- /dev/null +++ b/Data/Vector/Generic/New/Safe.hs @@ -0,0 +1,25 @@ +#if __GLASGOW_HASKELL__ >= 701 && defined(VECTOR_BOUNDS_CHECKS) +{-# LANGUAGE Trustworthy #-} +#endif + +-- | +-- Module : Data.Vector.Generic.New.Safe +-- Copyright : (c) Roman Leshchinskiy 2008-2010 +-- License : BSD-style +-- +-- Maintainer : Roman Leshchinskiy +-- Stability : experimental +-- Portability : non-portable +-- +-- Safe interface to "Data.Vector.Generic.New" +-- + +module Data.Vector.Generic.New.Safe ( + New(..), create, run, apply, modify, modifyWithStream, + unstream, transform, unstreamR, transformR, + slice, init, tail, take, drop +) where + +import Data.Vector.Generic.New +import Prelude () + diff --git a/Data/Vector/Generic/Safe.hs b/Data/Vector/Generic/Safe.hs new file mode 100644 --- /dev/null +++ b/Data/Vector/Generic/Safe.hs @@ -0,0 +1,157 @@ +#if __GLASGOW_HASKELL__ >= 701 && defined(VECTOR_BOUNDS_CHECKS) +{-# LANGUAGE Trustworthy #-} +#endif +-- | +-- Module : Data.Vector.Generic.Safe +-- Copyright : (c) Roman Leshchinskiy 2008-2010 +-- License : BSD-style +-- +-- Maintainer : Roman Leshchinskiy +-- Stability : experimental +-- Portability : non-portable +-- +-- Safe interface to "Data.Vector.Generic" +-- + +module Data.Vector.Generic.Safe ( + -- * Immutable vectors + Vector, Mutable, + + -- * Accessors + + -- ** Length information + length, null, + + -- ** Indexing + (!), (!?), head, last, + + -- ** Monadic indexing + indexM, headM, lastM, + + -- ** Extracting subvectors (slicing) + slice, init, tail, take, drop, splitAt, + + -- * Construction + + -- ** Initialisation + empty, singleton, replicate, generate, iterateN, + + -- ** Monadic initialisation + replicateM, generateM, create, + + -- ** Unfolding + unfoldr, unfoldrN, + + -- ** Enumeration + enumFromN, enumFromStepN, enumFromTo, enumFromThenTo, + + -- ** Concatenation + cons, snoc, (++), concat, + + -- ** Restricting memory usage + force, + + -- * Modifying vectors + + -- ** Bulk updates + (//), update, update_, + + -- ** Accumulations + accum, accumulate, accumulate_, + + -- ** Permutations + reverse, backpermute, + + -- ** Safe destructive updates + modify, + + -- * Elementwise operations + + -- ** Indexing + indexed, + + -- ** Mapping + map, imap, concatMap, + + -- ** Monadic mapping + mapM, mapM_, forM, forM_, + + -- ** Zipping + zipWith, zipWith3, zipWith4, zipWith5, zipWith6, + izipWith, izipWith3, izipWith4, izipWith5, izipWith6, + zip, zip3, zip4, zip5, zip6, + + -- ** Monadic zipping + zipWithM, zipWithM_, + + -- ** Unzipping + unzip, unzip3, unzip4, unzip5, unzip6, + + -- * Working with predicates + + -- ** Filtering + filter, ifilter, filterM, + takeWhile, dropWhile, + + -- ** Partitioning + partition, unstablePartition, span, break, + + -- ** Searching + elem, notElem, find, findIndex, findIndices, elemIndex, elemIndices, + + -- * Folding + foldl, foldl1, foldl', foldl1', foldr, foldr1, foldr', foldr1', + ifoldl, ifoldl', ifoldr, ifoldr', + + -- ** Specialised folds + all, any, and, or, + sum, product, + maximum, maximumBy, minimum, minimumBy, + minIndex, minIndexBy, maxIndex, maxIndexBy, + + -- ** Monadic folds + foldM, foldM', fold1M, fold1M', + foldM_, foldM'_, fold1M_, fold1M'_, + + -- ** Monadic sequencing + sequence, sequence_, + + -- * Prefix sums (scans) + prescanl, prescanl', + postscanl, postscanl', + scanl, scanl', scanl1, scanl1', + prescanr, prescanr', + postscanr, postscanr', + scanr, scanr', scanr1, scanr1', + + -- * Conversions + + -- ** Lists + toList, fromList, fromListN, + + -- ** Different vector types + convert, + + -- ** Mutable vectors + freeze, thaw, copy, + + -- * Fusion support + + -- ** Conversion to/from Streams + stream, unstream, streamR, unstreamR, + + -- ** Recycling support + new, clone, + + -- * Utilities + + -- ** Comparisons + eq, cmp, + + -- ** @Data@ and @Typeable@ + gfoldl, dataCast, mkType +) where + +import Data.Vector.Generic +import Prelude () + diff --git a/Data/Vector/Mutable.hs b/Data/Vector/Mutable.hs --- a/Data/Vector/Mutable.hs +++ b/Data/Vector/Mutable.hs @@ -46,10 +46,7 @@ -- * Modifying vectors -- ** Filling and copying - set, copy, move, unsafeCopy, unsafeMove, - - -- * Deprecated operations - newWith, unsafeNewWith + set, copy, move, unsafeCopy, unsafeMove ) where import Control.Monad (when) @@ -104,6 +101,10 @@ {-# INLINE basicUnsafeWrite #-} basicUnsafeWrite (MVector i n arr) j x = writeArray arr (i+j) x + + {-# INLINE basicUnsafeCopy #-} + basicUnsafeCopy (MVector i n dst) (MVector j _ src) + = copyMutableArray dst i src j n basicUnsafeMove dst@(MVector iDst n arrDst) src@(MVector iSrc _ arrSrc) = case n of @@ -382,19 +383,4 @@ -> m () {-# INLINE unsafeMove #-} unsafeMove = G.unsafeMove - --- Deprecated functions --- -------------------- - --- | /DEPRECATED/ Use 'replicate' instead -newWith :: PrimMonad m => Int -> a -> m (MVector (PrimState m) a) -{-# INLINE newWith #-} -newWith = G.replicate - --- | /DEPRECATED/ Use 'replicate' instead -unsafeNewWith :: PrimMonad m => Int -> a -> m (MVector (PrimState m) a) -{-# INLINE unsafeNewWith #-} -unsafeNewWith = G.replicate - -{-# DEPRECATED newWith, unsafeNewWith "Use replicate instead" #-} diff --git a/Data/Vector/Mutable/Safe.hs b/Data/Vector/Mutable/Safe.hs new file mode 100644 --- /dev/null +++ b/Data/Vector/Mutable/Safe.hs @@ -0,0 +1,54 @@ +#if __GLASGOW_HASKELL__ >= 701 && defined(VECTOR_BOUNDS_CHECKS) +{-# LANGUAGE Trustworthy #-} +#endif + +-- | +-- Module : Data.Vector.Mutable.Safe +-- Copyright : (c) Roman Leshchinskiy 2008-2010 +-- License : BSD-style +-- +-- Maintainer : Roman Leshchinskiy +-- Stability : experimental +-- Portability : non-portable +-- +-- Safe interface to "Data.Vector.Mutable" +-- + +module Data.Vector.Mutable.Safe ( + -- * Mutable boxed vectors + MVector, IOVector, STVector, + + -- * Accessors + + -- ** Length information + length, null, + + -- ** Extracting subvectors + slice, init, tail, take, drop, splitAt, + + -- ** Overlapping + overlaps, + + -- * Construction + + -- ** Initialisation + new, replicate, replicateM, clone, + + -- ** Growing + grow, + + -- ** Restricting memory usage + clear, + + -- * Accessing individual elements + read, write, swap, + + -- * Modifying vectors + + -- ** Filling and copying + set, copy, move +) where + +import Data.Vector.Mutable +import Prelude () + diff --git a/Data/Vector/Primitive.hs b/Data/Vector/Primitive.hs --- a/Data/Vector/Primitive.hs +++ b/Data/Vector/Primitive.hs @@ -46,6 +46,7 @@ -- ** Unfolding unfoldr, unfoldrN, + constructN, constructrN, -- ** Enumeration enumFromN, enumFromStepN, enumFromTo, enumFromThenTo, @@ -161,6 +162,7 @@ import Data.Typeable ( Typeable ) import Data.Data ( Data(..) ) +import Text.Read ( Read(..), readListPrecDefault ) import Data.Monoid ( Monoid(..) ) @@ -171,8 +173,12 @@ deriving ( Typeable ) instance (Show a, Prim a) => Show (Vector a) where - show = (Prelude.++ " :: Data.Vector.Primitive.Vector") . ("fromList " Prelude.++) . show . toList + showsPrec = G.showsPrec +instance (Read a, Prim a) => Read (Vector a) where + readPrec = G.readPrec + readListPrec = readListPrecDefault + instance (Data a, Prim a) => Data (Vector a) where gfoldl = G.gfoldl toConstr _ = error "toConstr" @@ -203,7 +209,7 @@ {-# INLINE basicUnsafeCopy #-} basicUnsafeCopy (MVector i n dst) (Vector j _ src) - = memcpyByteArray' dst (i * sz) src (j * sz) (n * sz) + = copyByteArray dst (i*sz) src (j*sz) (n*sz) where sz = sizeOf (undefined :: a) @@ -480,6 +486,25 @@ unfoldrN :: Prim a => Int -> (b -> Maybe (a, b)) -> b -> Vector a {-# INLINE unfoldrN #-} unfoldrN = G.unfoldrN + +-- | /O(n)/ Construct a vector with @n@ elements by repeatedly applying the +-- generator function to the already constructed part of the vector. +-- +-- > constructN 3 f = let a = f <> ; b = f ; c = f in f +-- +constructN :: Prim a => Int -> (Vector a -> a) -> Vector a +{-# INLINE constructN #-} +constructN = G.constructN + +-- | /O(n)/ Construct a vector with @n@ elements from right to left by +-- repeatedly applying the generator function to the already constructed part +-- of the vector. +-- +-- > constructrN 3 f = let a = f <> ; b = f ; c = f in f +-- +constructrN :: Prim a => Int -> (Vector a -> a) -> Vector a +{-# INLINE constructrN #-} +constructrN = G.constructrN -- Enumeration -- ----------- 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 @@ -46,10 +46,7 @@ -- * Modifying vectors -- ** Filling and copying - set, copy, move, unsafeCopy, unsafeMove, - - -- * Deprecated operations - newWith, unsafeNewWith + set, copy, move, unsafeCopy, unsafeMove ) where import qualified Data.Vector.Generic.Mutable as G @@ -98,13 +95,13 @@ {-# INLINE basicUnsafeCopy #-} basicUnsafeCopy (MVector i n dst) (MVector j _ src) - = memcpyByteArray dst (i * sz) src (j * sz) (n * sz) + = copyMutableByteArray dst (i*sz) src (j*sz) (n*sz) where sz = sizeOf (undefined :: a) {-# INLINE basicUnsafeMove #-} basicUnsafeMove (MVector i n dst) (MVector j _ src) - = memmoveByteArray dst (i * sz) src (j * sz) (n * sz) + = moveByteArray dst (i*sz) src (j*sz) (n * sz) where sz = sizeOf (undefined :: a) @@ -325,19 +322,4 @@ -> m () {-# INLINE unsafeMove #-} unsafeMove = G.unsafeMove - --- Deprecated functions --- -------------------- - --- | /DEPRECATED/ Use 'replicate' instead -newWith :: (PrimMonad m, Prim a) => Int -> a -> m (MVector (PrimState m) a) -{-# INLINE newWith #-} -newWith = G.replicate - --- | /DEPRECATED/ Use 'replicate' instead -unsafeNewWith :: (PrimMonad m, Prim a) => Int -> a -> m (MVector (PrimState m) a) -{-# INLINE unsafeNewWith #-} -unsafeNewWith = G.replicate - -{-# DEPRECATED newWith, unsafeNewWith "Use replicate instead" #-} diff --git a/Data/Vector/Primitive/Mutable/Safe.hs b/Data/Vector/Primitive/Mutable/Safe.hs new file mode 100644 --- /dev/null +++ b/Data/Vector/Primitive/Mutable/Safe.hs @@ -0,0 +1,53 @@ +#if __GLASGOW_HASKELL__ >= 701 && defined(VECTOR_BOUNDS_CHECKS) +{-# LANGUAGE Trustworthy #-} +#endif +-- | +-- Module : Data.Vector.Primitive.Mutable.Safe +-- Copyright : (c) Roman Leshchinskiy 2008-2010 +-- License : BSD-style +-- +-- Maintainer : Roman Leshchinskiy +-- Stability : experimental +-- Portability : non-portable +-- +-- Safe interface to "Data.Vector.Primitive.Mutable" +-- + +module Data.Vector.Primitive.Mutable.Safe ( + -- * Mutable vectors of primitive types + MVector, IOVector, STVector, Prim, + + -- * Accessors + + -- ** Length information + length, null, + + -- ** Extracting subvectors + slice, init, tail, take, drop, splitAt, + + -- ** Overlapping + overlaps, + + -- * Construction + + -- ** Initialisation + new, replicate, replicateM, clone, + + -- ** Growing + grow, + + -- ** Restricting memory usage + clear, + + -- * Accessing individual elements + read, write, swap, + + -- * Modifying vectors + + -- ** Filling and copying + set, copy, move +) where + +import Data.Vector.Primitive.Mutable +import Prelude () + diff --git a/Data/Vector/Primitive/Safe.hs b/Data/Vector/Primitive/Safe.hs new file mode 100644 --- /dev/null +++ b/Data/Vector/Primitive/Safe.hs @@ -0,0 +1,133 @@ +#if __GLASGOW_HASKELL__ >= 701 && defined(VECTOR_BOUNDS_CHECKS) +{-# LANGUAGE Trustworthy #-} +#endif + +-- | +-- Module : Data.Vector.Primitive.Safe +-- Copyright : (c) Roman Leshchinskiy 2008-2010 +-- License : BSD-style +-- +-- Maintainer : Roman Leshchinskiy +-- Stability : experimental +-- Portability : non-portable +-- +-- Safe interface to "Data.Vector.Primitive" +-- + +module Data.Vector.Primitive.Safe ( + -- * Primitive vectors + Vector, MVector, Prim, + + -- * Accessors + + -- ** Length information + length, null, + + -- ** Indexing + (!), (!?), head, last, + + -- ** Monadic indexing + indexM, headM, lastM, + + -- ** Extracting subvectors (slicing) + slice, init, tail, take, drop, splitAt, + + -- * Construction + + -- ** Initialisation + empty, singleton, replicate, generate, iterateN, + + -- ** Monadic initialisation + replicateM, generateM, create, + + -- ** Unfolding + unfoldr, unfoldrN, + + -- ** Enumeration + enumFromN, enumFromStepN, enumFromTo, enumFromThenTo, + + -- ** Concatenation + cons, snoc, (++), concat, + + -- ** Restricting memory usage + force, + + -- * Modifying vectors + + -- ** Bulk updates + (//), update_, + + -- ** Accumulations + accum, accumulate_, + + -- ** Permutations + reverse, backpermute, + + -- ** Safe destructive updates + modify, + + -- * Elementwise operations + + -- ** Mapping + map, imap, concatMap, + + -- ** Monadic mapping + mapM, mapM_, forM, forM_, + + -- ** Zipping + zipWith, zipWith3, zipWith4, zipWith5, zipWith6, + izipWith, izipWith3, izipWith4, izipWith5, izipWith6, + + -- ** Monadic zipping + zipWithM, zipWithM_, + + -- * Working with predicates + + -- ** Filtering + filter, ifilter, filterM, + takeWhile, dropWhile, + + -- ** Partitioning + partition, unstablePartition, span, break, + + -- ** Searching + elem, notElem, find, findIndex, findIndices, elemIndex, elemIndices, + + -- * Folding + foldl, foldl1, foldl', foldl1', foldr, foldr1, foldr', foldr1', + ifoldl, ifoldl', ifoldr, ifoldr', + + -- ** Specialised folds + all, any, + sum, product, + maximum, maximumBy, minimum, minimumBy, + minIndex, minIndexBy, maxIndex, maxIndexBy, + + -- ** Monadic folds + foldM, foldM', fold1M, fold1M', + foldM_, foldM'_, fold1M_, fold1M'_, + + -- * Prefix sums (scans) + prescanl, prescanl', + postscanl, postscanl', + scanl, scanl', scanl1, scanl1', + prescanr, prescanr', + postscanr, postscanr', + scanr, scanr', scanr1, scanr1', + + -- * Conversions + + -- ** Lists + toList, fromList, fromListN, + + -- ** Other vector types + G.convert, + + -- ** Mutable vectors + freeze, thaw, copy, +) where + +import Data.Vector.Primitive +import qualified Data.Vector.Generic as G +import Prelude () + diff --git a/Data/Vector/Safe.hs b/Data/Vector/Safe.hs new file mode 100644 --- /dev/null +++ b/Data/Vector/Safe.hs @@ -0,0 +1,142 @@ +#if __GLASGOW_HASKELL__ >= 701 && defined(VECTOR_BOUNDS_CHECKS) +{-# LANGUAGE Trustworthy #-} +#endif +-- | +-- Module : Data.Vector.Safe +-- Copyright : (c) Roman Leshchinskiy 2008-2010 +-- License : BSD-style +-- +-- Maintainer : Roman Leshchinskiy +-- Stability : experimental +-- Portability : non-portable +-- +-- Safe interface to "Data.Vector" +-- + +module Data.Vector.Safe ( + -- * Boxed vectors + Vector, MVector, + + -- * Accessors + + -- ** Length information + length, null, + + -- ** Indexing + (!), (!?), head, last, + + -- ** Monadic indexing + indexM, headM, lastM, + + -- ** Extracting subvectors (slicing) + slice, init, tail, take, drop, splitAt, + + -- * Construction + + -- ** Initialisation + empty, singleton, replicate, generate, iterateN, + + -- ** Monadic initialisation + replicateM, generateM, create, + + -- ** Unfolding + unfoldr, unfoldrN, + + -- ** Enumeration + enumFromN, enumFromStepN, enumFromTo, enumFromThenTo, + + -- ** Concatenation + cons, snoc, (++), concat, + + -- ** Restricting memory usage + force, + + -- * Modifying vectors + + -- ** Bulk updates + (//), update, update_, + + -- ** Accumulations + accum, accumulate, accumulate_, + + -- ** Permutations + reverse, backpermute, + + -- ** Safe destructive updates + modify, + + -- * Elementwise operations + + -- ** Indexing + indexed, + + -- ** Mapping + map, imap, concatMap, + + -- ** Monadic mapping + mapM, mapM_, forM, forM_, + + -- ** Zipping + zipWith, zipWith3, zipWith4, zipWith5, zipWith6, + izipWith, izipWith3, izipWith4, izipWith5, izipWith6, + zip, zip3, zip4, zip5, zip6, + + -- ** Monadic zipping + zipWithM, zipWithM_, + + -- ** Unzipping + unzip, unzip3, unzip4, unzip5, unzip6, + + -- * Working with predicates + + -- ** Filtering + filter, ifilter, filterM, + takeWhile, dropWhile, + + -- ** Partitioning + partition, unstablePartition, span, break, + + -- ** Searching + elem, notElem, find, findIndex, findIndices, elemIndex, elemIndices, + + -- * Folding + foldl, foldl1, foldl', foldl1', foldr, foldr1, foldr', foldr1', + ifoldl, ifoldl', ifoldr, ifoldr', + + -- ** Specialised folds + all, any, and, or, + sum, product, + maximum, maximumBy, minimum, minimumBy, + minIndex, minIndexBy, maxIndex, maxIndexBy, + + -- ** Monadic folds + foldM, foldM', fold1M, fold1M', + foldM_, foldM'_, fold1M_, fold1M'_, + + -- ** Monadic sequencing + sequence, sequence_, + + -- * Prefix sums (scans) + prescanl, prescanl', + postscanl, postscanl', + scanl, scanl', scanl1, scanl1', + prescanr, prescanr', + postscanr, postscanr', + scanr, scanr', scanr1, scanr1', + + -- * Conversions + + -- ** Lists + toList, fromList, fromListN, + + -- ** Other vector types + G.convert, + + -- ** Mutable vectors + freeze, thaw, copy +) where + +import Data.Vector +import qualified Data.Vector.Generic as G +import Prelude () + diff --git a/Data/Vector/Storable.hs b/Data/Vector/Storable.hs --- a/Data/Vector/Storable.hs +++ b/Data/Vector/Storable.hs @@ -43,6 +43,7 @@ -- ** Unfolding unfoldr, unfoldrN, + constructN, constructrN, -- ** Enumeration enumFromN, enumFromStepN, enumFromTo, enumFromThenTo, @@ -164,23 +165,24 @@ import Data.Typeable ( Typeable ) import Data.Data ( Data(..) ) +import Text.Read ( Read(..), readListPrecDefault ) import Data.Monoid ( Monoid(..) ) #include "vector.h" -- | 'Storable'-based vectors -data Vector a = Vector {-# UNPACK #-} !(Ptr a) - {-# UNPACK #-} !Int +data Vector a = Vector {-# UNPACK #-} !Int {-# UNPACK #-} !(ForeignPtr a) deriving ( Typeable ) instance (Show a, Storable a) => Show (Vector a) where - show = (Prelude.++ " :: Data.Vector.Storable.Vector") - . ("fromList " Prelude.++) - . show - . toList + showsPrec = G.showsPrec +instance (Read a, Storable a) => Read (Vector a) where + readPrec = G.readPrec + readListPrec = readListPrecDefault + instance (Data a, Storable a) => Data (Vector a) where gfoldl = G.gfoldl toConstr _ = error "toConstr" @@ -192,28 +194,28 @@ instance Storable a => G.Vector Vector a where {-# INLINE basicUnsafeFreeze #-} - basicUnsafeFreeze (MVector p n fp) = return $ Vector p n fp + basicUnsafeFreeze (MVector n fp) = return $ Vector n fp {-# INLINE basicUnsafeThaw #-} - basicUnsafeThaw (Vector p n fp) = return $ MVector p n fp + basicUnsafeThaw (Vector n fp) = return $ MVector n fp {-# INLINE basicLength #-} - basicLength (Vector _ n _) = n + basicLength (Vector n _) = n {-# INLINE basicUnsafeSlice #-} - basicUnsafeSlice i n (Vector p _ fp) = Vector (p `advancePtr` i) n fp + basicUnsafeSlice i n (Vector _ fp) = Vector n (updPtr (`advancePtr` i) fp) {-# INLINE basicUnsafeIndexM #-} - basicUnsafeIndexM (Vector p _ fp) i = return - . unsafeInlineIO - $ withForeignPtr fp $ \_ -> - peekElemOff p i + basicUnsafeIndexM (Vector _ fp) i = return + . unsafeInlineIO + $ withForeignPtr fp $ \p -> + peekElemOff p i {-# INLINE basicUnsafeCopy #-} - basicUnsafeCopy (MVector p n fp) (Vector q _ fq) + basicUnsafeCopy (MVector n fp) (Vector _ fq) = unsafePrimToPrim - $ withForeignPtr fp $ \_ -> - withForeignPtr fq $ \_ -> + $ withForeignPtr fp $ \p -> + withForeignPtr fq $ \q -> copyArray p q n {-# INLINE elemseq #-} @@ -490,6 +492,25 @@ {-# INLINE unfoldrN #-} unfoldrN = G.unfoldrN +-- | /O(n)/ Construct a vector with @n@ elements by repeatedly applying the +-- generator function to the already constructed part of the vector. +-- +-- > constructN 3 f = let a = f <> ; b = f ; c = f in f +-- +constructN :: Storable a => Int -> (Vector a -> a) -> Vector a +{-# INLINE constructN #-} +constructN = G.constructN + +-- | /O(n)/ Construct a vector with @n@ elements from right to left by +-- repeatedly applying the generator function to the already constructed part +-- of the vector. +-- +-- > constructrN 3 f = let a = f <> ; b = f ; c = f in f +-- +constructrN :: Storable a => Int -> (Vector a -> a) -> Vector a +{-# INLINE constructrN #-} +constructrN = G.constructrN + -- Enumeration -- ----------- @@ -1289,9 +1310,8 @@ -- unsafeCast :: forall a b. (Storable a, Storable b) => Vector a -> Vector b {-# INLINE unsafeCast #-} -unsafeCast (Vector p n fp) - = Vector (castPtr p) - ((n * sizeOf (undefined :: a)) `div` sizeOf (undefined :: b)) +unsafeCast (Vector n fp) + = Vector ((n * sizeOf (undefined :: a)) `div` sizeOf (undefined :: b)) (castForeignPtr fp) @@ -1346,18 +1366,18 @@ -> Int -- ^ length -> Vector a {-# INLINE unsafeFromForeignPtr #-} -unsafeFromForeignPtr fp i n = Vector (offsetToPtr fp i) n fp +unsafeFromForeignPtr fp i n = Vector n (updPtr (`advancePtr` i) fp) -- | /O(1)/ Yield the underlying 'ForeignPtr' together with the offset to the -- data and its length. The data may not be modified through the 'ForeignPtr'. unsafeToForeignPtr :: Storable a => Vector a -> (ForeignPtr a, Int, Int) {-# INLINE unsafeToForeignPtr #-} -unsafeToForeignPtr (Vector p n fp) = (fp, ptrToOffset fp p, n) +unsafeToForeignPtr (Vector n fp) = (fp, 0, n) -- | Pass a pointer to the vector's data to the IO action. The data may not be -- modified through the 'Ptr. unsafeWith :: Storable a => Vector a -> (Ptr a -> IO b) -> IO b {-# INLINE unsafeWith #-} -unsafeWith (Vector p n fp) m = withForeignPtr fp $ \_ -> m p +unsafeWith (Vector n fp) = withForeignPtr fp diff --git a/Data/Vector/Storable/Internal.hs b/Data/Vector/Storable/Internal.hs --- a/Data/Vector/Storable/Internal.hs +++ b/Data/Vector/Storable/Internal.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE MagicHash, UnboxedTuples, ScopedTypeVariables #-} - -- | -- Module : Data.Vector.Storable.Internal -- Copyright : (c) Roman Leshchinskiy 2009-2010 @@ -13,7 +11,7 @@ -- module Data.Vector.Storable.Internal ( - ptrToOffset, offsetToPtr + getPtr, setPtr, updPtr ) where import Control.Monad.Primitive ( unsafeInlineIO ) @@ -22,18 +20,18 @@ import Foreign.Ptr import Foreign.Marshal.Array ( advancePtr ) import GHC.Base ( quotInt ) +import GHC.ForeignPtr ( ForeignPtr(..) ) +import GHC.Ptr ( Ptr(..) ) -distance :: forall a. Storable a => Ptr a -> Ptr a -> Int -{-# INLINE distance #-} -distance p q = (p `minusPtr` q) `quotInt` sizeOf (undefined :: a) +getPtr :: ForeignPtr a -> Ptr a +{-# INLINE getPtr #-} +getPtr (ForeignPtr addr _) = Ptr addr -ptrToOffset :: Storable a => ForeignPtr a -> Ptr a -> Int -{-# INLINE ptrToOffset #-} -ptrToOffset fp q = unsafeInlineIO - $ withForeignPtr fp $ \p -> return (distance q p) +setPtr :: ForeignPtr a -> Ptr a -> ForeignPtr a +{-# INLINE setPtr #-} +setPtr (ForeignPtr _ c) (Ptr addr) = ForeignPtr addr c -offsetToPtr :: Storable a => ForeignPtr a -> Int -> Ptr a -{-# INLINE offsetToPtr #-} -offsetToPtr fp i = unsafeInlineIO - $ withForeignPtr fp $ \p -> return (advancePtr p i) +updPtr :: (Ptr a -> Ptr a) -> ForeignPtr a -> ForeignPtr a +{-# INLINE updPtr #-} +updPtr f (ForeignPtr p c) = case f (Ptr p) of { Ptr q -> ForeignPtr q c } 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 @@ -52,10 +52,7 @@ unsafeCast, -- * Raw pointers - unsafeFromForeignPtr, unsafeToForeignPtr, unsafeWith, - - -- * Deprecated operations - newWith, unsafeNewWith + unsafeFromForeignPtr, unsafeToForeignPtr, unsafeWith ) where import qualified Data.Vector.Generic.Mutable as G @@ -82,8 +79,7 @@ #include "vector.h" -- | Mutable 'Storable'-based vectors -data MVector s a = MVector {-# UNPACK #-} !(Ptr a) - {-# UNPACK #-} !Int +data MVector s a = MVector {-# UNPACK #-} !Int {-# UNPACK #-} !(ForeignPtr a) deriving ( Typeable ) @@ -92,47 +88,49 @@ instance Storable a => G.MVector MVector a where {-# INLINE basicLength #-} - basicLength (MVector _ n _) = n + basicLength (MVector n _) = n {-# INLINE basicUnsafeSlice #-} - basicUnsafeSlice j m (MVector p n fp) = MVector (p `advancePtr` j) m fp + basicUnsafeSlice j m (MVector n fp) = MVector m (updPtr (`advancePtr` j) fp) -- FIXME: this relies on non-portable pointer comparisons {-# INLINE basicOverlaps #-} - basicOverlaps (MVector p m _) (MVector q n _) + basicOverlaps (MVector m fp) (MVector n fq) = between p q (q `advancePtr` n) || between q p (p `advancePtr` m) where between x y z = x >= y && x < z + p = getPtr fp + q = getPtr fq {-# INLINE basicUnsafeNew #-} basicUnsafeNew n = unsafePrimToPrim $ do fp <- mallocVector n - withForeignPtr fp $ \p -> return $ MVector p n fp + return $ MVector n fp {-# INLINE basicUnsafeRead #-} - basicUnsafeRead (MVector p _ fp) i + basicUnsafeRead (MVector _ fp) i = unsafePrimToPrim - $ withForeignPtr fp $ \_ -> peekElemOff p i + $ withForeignPtr fp (`peekElemOff` i) {-# INLINE basicUnsafeWrite #-} - basicUnsafeWrite (MVector p n fp) i x + basicUnsafeWrite (MVector _ fp) i x = unsafePrimToPrim - $ withForeignPtr fp $ \_ -> pokeElemOff p i x + $ withForeignPtr fp $ \p -> pokeElemOff p i x {-# INLINE basicUnsafeCopy #-} - basicUnsafeCopy (MVector p n fp) (MVector q _ fq) + basicUnsafeCopy (MVector n fp) (MVector _ fq) = unsafePrimToPrim - $ withForeignPtr fp $ \_ -> - withForeignPtr fq $ \_ -> + $ withForeignPtr fp $ \p -> + withForeignPtr fq $ \q -> copyArray p q n {-# INLINE basicUnsafeMove #-} - basicUnsafeMove (MVector p n fp) (MVector q _ fq) + basicUnsafeMove (MVector n fp) (MVector _ fq) = unsafePrimToPrim - $ withForeignPtr fp $ \_ -> - withForeignPtr fq $ \_ -> + $ withForeignPtr fp $ \p -> + withForeignPtr fq $ \q -> moveArray p q n {-# INLINE mallocVector #-} @@ -380,9 +378,8 @@ unsafeCast :: forall a b s. (Storable a, Storable b) => MVector s a -> MVector s b {-# INLINE unsafeCast #-} -unsafeCast (MVector p n fp) - = MVector (castPtr p) - ((n * sizeOf (undefined :: a)) `div` sizeOf (undefined :: b)) +unsafeCast (MVector n fp) + = MVector ((n * sizeOf (undefined :: a)) `div` sizeOf (undefined :: b)) (castForeignPtr fp) -- Raw pointers @@ -397,34 +394,19 @@ -> Int -- ^ length -> MVector s a {-# INLINE unsafeFromForeignPtr #-} -unsafeFromForeignPtr fp i n = MVector (offsetToPtr fp i) n fp +unsafeFromForeignPtr fp i n = MVector n (updPtr (`advancePtr` i) fp) -- | Yield the underlying 'ForeignPtr' together with the offset to the data -- and its length. Modifying the data through the 'ForeignPtr' is -- unsafe if the vector could have frozen before the modification. unsafeToForeignPtr :: Storable a => MVector s a -> (ForeignPtr a, Int, Int) {-# INLINE unsafeToForeignPtr #-} -unsafeToForeignPtr (MVector p n fp) = (fp, ptrToOffset fp p, n) +unsafeToForeignPtr (MVector n fp) = (fp, 0, n) -- | Pass a pointer to the vector's data to the IO action. Modifying data -- through the pointer is unsafe if the vector could have been frozen before -- the modification. unsafeWith :: Storable a => IOVector a -> (Ptr a -> IO b) -> IO b {-# INLINE unsafeWith #-} -unsafeWith (MVector p n fp) m = withForeignPtr fp $ \_ -> m p - --- Deprecated functions --- -------------------- - --- | /DEPRECATED/ Use 'replicate' instead -newWith :: (PrimMonad m, Storable a) => Int -> a -> m (MVector (PrimState m) a) -{-# INLINE newWith #-} -newWith = G.replicate - --- | /DEPRECATED/ Use 'replicate' instead -unsafeNewWith :: (PrimMonad m, Storable a) => Int -> a -> m (MVector (PrimState m) a) -{-# INLINE unsafeNewWith #-} -unsafeNewWith = G.replicate - -{-# DEPRECATED newWith, unsafeNewWith "Use replicate instead" #-} +unsafeWith (MVector n fp) = withForeignPtr fp diff --git a/Data/Vector/Unboxed.hs b/Data/Vector/Unboxed.hs --- a/Data/Vector/Unboxed.hs +++ b/Data/Vector/Unboxed.hs @@ -66,6 +66,7 @@ -- ** Unfolding unfoldr, unfoldrN, + constructN, constructrN, -- ** Enumeration enumFromN, enumFromStepN, enumFromTo, enumFromThenTo, @@ -183,6 +184,8 @@ mapM, mapM_ ) import qualified Prelude +import Text.Read ( Read(..), readListPrecDefault ) + import Data.Monoid ( Monoid(..) ) #include "vector.h" @@ -223,8 +226,12 @@ mconcat = concat instance (Show a, Unbox a) => Show (Vector a) where - show = (Prelude.++ " :: Data.Vector.Unboxed.Vector") . ("fromList " Prelude.++) . show . toList + showsPrec = G.showsPrec +instance (Read a, Unbox a) => Read (Vector a) where + readPrec = G.readPrec + readListPrec = readListPrecDefault + -- Length information -- ------------------ @@ -459,6 +466,25 @@ unfoldrN :: Unbox a => Int -> (b -> Maybe (a, b)) -> b -> Vector a {-# INLINE unfoldrN #-} unfoldrN = G.unfoldrN + +-- | /O(n)/ Construct a vector with @n@ elements by repeatedly applying the +-- generator function to the already constructed part of the vector. +-- +-- > constructN 3 f = let a = f <> ; b = f ; c = f in f +-- +constructN :: Unbox a => Int -> (Vector a -> a) -> Vector a +{-# INLINE constructN #-} +constructN = G.constructN + +-- | /O(n)/ Construct a vector with @n@ elements from right to left by +-- repeatedly applying the generator function to the already constructed part +-- of the vector. +-- +-- > constructrN 3 f = let a = f <> ; b = f ; c = f in f +-- +constructrN :: Unbox a => Int -> (Vector a -> a) -> Vector a +{-# INLINE constructrN #-} +constructrN = G.constructrN -- Enumeration -- ----------- 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 @@ -29,7 +29,13 @@ import Data.Int ( Int8, Int16, Int32, Int64 ) import Data.Complex -import Data.Typeable ( Typeable1(..), Typeable2(..), mkTyConApp, mkTyCon ) +import Data.Typeable ( Typeable1(..), Typeable2(..), mkTyConApp, +#if MIN_VERSION_base(4,4,0) + mkTyCon3 +#else + mkTyCon +#endif + ) import Data.Data ( Data(..) ) #include "vector.h" @@ -48,20 +54,23 @@ -- Data and Typeable -- ----------------- -vectorTy :: String -vectorTy = "Data.Vector.Unboxed.Vector" +#if MIN_VERSION_base(4,4,0) +vectorTyCon = mkTyCon3 "vector" +#else +vectorTyCon m s = mkTyCon $ m ++ "." ++ s +#endif instance Typeable1 Vector where - typeOf1 _ = mkTyConApp (mkTyCon vectorTy) [] + typeOf1 _ = mkTyConApp (vectorTyCon "Data.Vector.Unboxed" "Vector") [] instance Typeable2 MVector where - typeOf2 _ = mkTyConApp (mkTyCon "Data.Vector.Unboxed.Mutable.MVector") [] + typeOf2 _ = mkTyConApp (vectorTyCon "Data.Vector.Unboxed.Mutable" "MVector") [] instance (Data a, Unbox a) => Data (Vector a) where gfoldl = G.gfoldl toConstr _ = error "toConstr" gunfold _ _ = error "gunfold" - dataTypeOf _ = G.mkType vectorTy + dataTypeOf _ = G.mkType "Data.Vector.Unboxed.Vector" dataCast1 = G.dataCast -- ---- 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,11 +48,7 @@ -- * Modifying vectors -- ** Filling and copying - set, copy, move, unsafeCopy, unsafeMove, - - -- * Deprecated operations - newWith, unsafeNewWith - + set, copy, move, unsafeCopy, unsafeMove ) where import Data.Vector.Unboxed.Base @@ -283,21 +279,6 @@ -> m () {-# INLINE unsafeMove #-} unsafeMove = G.unsafeMove - --- Deprecated functions --- -------------------- - --- | /DEPRECATED/ Use 'replicate' instead -newWith :: (PrimMonad m, Unbox a) => Int -> a -> m (MVector (PrimState m) a) -{-# INLINE newWith #-} -newWith = G.replicate - --- | /DEPRECATED/ Use 'replicate' instead -unsafeNewWith :: (PrimMonad m, Unbox a) => Int -> a -> m (MVector (PrimState m) a) -{-# INLINE unsafeNewWith #-} -unsafeNewWith = G.replicate - -{-# DEPRECATED newWith, unsafeNewWith "Use replicate instead" #-} #define DEFINE_MUTABLE #include "unbox-tuple-instances" diff --git a/Data/Vector/Unboxed/Mutable/Safe.hs b/Data/Vector/Unboxed/Mutable/Safe.hs new file mode 100644 --- /dev/null +++ b/Data/Vector/Unboxed/Mutable/Safe.hs @@ -0,0 +1,57 @@ +#if __GLASGOW_HASKELL__ >= 701 && defined(VECTOR_BOUNDS_CHECKS) +{-# LANGUAGE Trustworthy #-} +#endif +-- | +-- Module : Data.Vector.Unboxed.Mutable.Safe +-- Copyright : (c) Roman Leshchinskiy 2009-2010 +-- License : BSD-style +-- +-- Maintainer : Roman Leshchinskiy +-- Stability : experimental +-- Portability : non-portable +-- +-- Safe interface to "Data.Vector.Unboxed.Mutable" +-- + +module Data.Vector.Unboxed.Mutable.Safe ( + -- * Mutable vectors of primitive types + MVector, IOVector, STVector, Unbox, + + -- * Accessors + + -- ** Length information + length, null, + + -- ** Extracting subvectors + slice, init, tail, take, drop, splitAt, + + -- ** Overlapping + overlaps, + + -- * Construction + + -- ** Initialisation + new, replicate, replicateM, clone, + + -- ** Growing + grow, + + -- ** Restricting memory usage + clear, + + -- * Zipping and unzipping + zip, zip3, zip4, zip5, zip6, + unzip, unzip3, unzip4, unzip5, unzip6, + + -- * Accessing individual elements + read, write, swap, + + -- * Modifying vectors + + -- ** Filling and copying + set, copy, move +) where + +import Data.Vector.Unboxed.Mutable +import Prelude () + diff --git a/Data/Vector/Unboxed/Safe.hs b/Data/Vector/Unboxed/Safe.hs new file mode 100644 --- /dev/null +++ b/Data/Vector/Unboxed/Safe.hs @@ -0,0 +1,140 @@ +#if __GLASGOW_HASKELL__ >= 701 && defined(VECTOR_BOUNDS_CHECKS) +{-# LANGUAGE Trustworthy #-} +#endif + +-- | +-- Module : Data.Vector.Unboxed.Safe +-- Copyright : (c) Roman Leshchinskiy 2009-2010 +-- License : BSD-style +-- +-- Maintainer : Roman Leshchinskiy +-- Stability : experimental +-- Portability : non-portable +-- +-- Safe interface to "Data.Vector.Unboxed" +-- + +module Data.Vector.Unboxed.Safe ( + -- * Unboxed vectors + Vector, MVector, Unbox, + + -- * Accessors + + -- ** Length information + length, null, + + -- ** Indexing + (!), (!?), head, last, + + -- ** Monadic indexing + indexM, headM, lastM, + + -- ** Extracting subvectors (slicing) + slice, init, tail, take, drop, splitAt, + + -- * Construction + + -- ** Initialisation + empty, singleton, replicate, generate, iterateN, + + -- ** Monadic initialisation + replicateM, generateM, create, + + -- ** Unfolding + unfoldr, unfoldrN, + + -- ** Enumeration + enumFromN, enumFromStepN, enumFromTo, enumFromThenTo, + + -- ** Concatenation + cons, snoc, (++), concat, + + -- ** Restricting memory usage + force, + + -- * Modifying vectors + + -- ** Bulk updates + (//), update, update_, + + -- ** Accumulations + accum, accumulate, accumulate_, + + -- ** Permutations + reverse, backpermute, + + -- ** Safe destructive updates + modify, + + -- * Elementwise operations + + -- ** Indexing + indexed, + + -- ** Mapping + map, imap, concatMap, + + -- ** Monadic mapping + mapM, mapM_, forM, forM_, + + -- ** Zipping + zipWith, zipWith3, zipWith4, zipWith5, zipWith6, + izipWith, izipWith3, izipWith4, izipWith5, izipWith6, + zip, zip3, zip4, zip5, zip6, + + -- ** Monadic zipping + zipWithM, zipWithM_, + + -- ** Unzipping + unzip, unzip3, unzip4, unzip5, unzip6, + + -- * Working with predicates + + -- ** Filtering + filter, ifilter, filterM, + takeWhile, dropWhile, + + -- ** Partitioning + partition, unstablePartition, span, break, + + -- ** Searching + elem, notElem, find, findIndex, findIndices, elemIndex, elemIndices, + + -- * Folding + foldl, foldl1, foldl', foldl1', foldr, foldr1, foldr', foldr1', + ifoldl, ifoldl', ifoldr, ifoldr', + + -- ** Specialised folds + all, any, and, or, + sum, product, + maximum, maximumBy, minimum, minimumBy, + minIndex, minIndexBy, maxIndex, maxIndexBy, + + -- ** Monadic folds + foldM, foldM', fold1M, fold1M', + foldM_, foldM'_, fold1M_, fold1M'_, + + -- * Prefix sums (scans) + prescanl, prescanl', + postscanl, postscanl', + scanl, scanl', scanl1, scanl1', + prescanr, prescanr', + postscanr, postscanr', + scanr, scanr', scanr1, scanr1', + + -- * Conversions + + -- ** Lists + toList, fromList, fromListN, + + -- ** Other vector types + G.convert, + + -- ** Mutable vectors + freeze, thaw, copy +) where + +import Data.Vector.Unboxed +import qualified Data.Vector.Generic as G +import Prelude () + diff --git a/benchmarks/vector-benchmarks.cabal b/benchmarks/vector-benchmarks.cabal --- a/benchmarks/vector-benchmarks.cabal +++ b/benchmarks/vector-benchmarks.cabal @@ -1,5 +1,5 @@ Name: vector-benchmarks -Version: 0.7.1 +Version: 0.8 License: BSD3 License-File: LICENSE Author: Roman Leshchinskiy @@ -13,8 +13,8 @@ Build-Depends: base >= 2 && < 5, array, criterion >= 0.5 && < 0.6, - mwc-random >= 0.5 && < 0.9, - vector == 0.7.1 + mwc-random >= 0.5 && < 0.11, + vector == 0.8 if impl(ghc<6.13) Ghc-Options: -finline-if-enough-args -fno-method-sharing diff --git a/tests/Tests/Vector.hs b/tests/Tests/Vector.hs --- a/tests/Tests/Vector.hs +++ b/tests/Tests/Vector.hs @@ -17,6 +17,8 @@ import Text.Show.Functions () import Data.List +import Data.Monoid +import qualified Control.Applicative as Applicative import System.Random (Random) #define COMMON_CONTEXT(a, v) \ @@ -78,44 +80,115 @@ testPolymorphicFunctions _ = $(testProperties [ 'prop_eq, + -- Length information 'prop_length, 'prop_null, - 'prop_empty, 'prop_singleton, 'prop_replicate, - 'prop_cons, 'prop_snoc, 'prop_append, 'prop_force, 'prop_generate, + -- Indexing (FIXME) + 'prop_index, 'prop_safeIndex, 'prop_head, 'prop_last, + 'prop_unsafeIndex, 'prop_unsafeHead, 'prop_unsafeLast, - 'prop_head, 'prop_last, 'prop_index, - 'prop_unsafeHead, 'prop_unsafeLast, 'prop_unsafeIndex, + -- Monadic indexing (FIXME) + {- 'prop_indexM, 'prop_headM, 'prop_lastM, + 'prop_unsafeIndexM, 'prop_unsafeHeadM, 'prop_unsafeLastM, -} + -- Subvectors (FIXME) 'prop_slice, 'prop_init, 'prop_tail, 'prop_take, 'prop_drop, + 'prop_splitAt, + {- 'prop_unsafeSlice, 'prop_unsafeInit, 'prop_unsafeTail, + 'prop_unsafeTake, 'prop_unsafeDrop, -} - 'prop_accum, 'prop_upd, 'prop_backpermute, 'prop_reverse, + -- Initialisation (FIXME) + 'prop_empty, 'prop_singleton, 'prop_replicate, + 'prop_generate, 'prop_iterateN, - 'prop_map, 'prop_zipWith, 'prop_zipWith3, - 'prop_imap, 'prop_izipWith, 'prop_izipWith3, + -- Monadic initialisation (FIXME) + {- 'prop_replicateM, 'prop_generateM, 'prop_create, -} - 'prop_filter, 'prop_ifilter, 'prop_takeWhile, 'prop_dropWhile, - 'prop_partition, 'prop_span, 'prop_break, + -- Unfolding (FIXME) + {- 'prop_unfoldr, prop_unfoldrN, -} + 'prop_constructN, 'prop_constructrN, + -- Enumeration? (FIXME?) + + -- Concatenation (FIXME) + 'prop_cons, 'prop_snoc, 'prop_append, + 'prop_concat, + + -- Restricting memory usage + 'prop_force, + + + -- Bulk updates (FIXME) + 'prop_upd, + {- 'prop_update, 'prop_update_, + 'prop_unsafeUpd, 'prop_unsafeUpdate, 'prop_unsafeUpdate_, -} + + -- Accumulations (FIXME) + 'prop_accum, + {- 'prop_accumulate, 'prop_accumulate_, + 'prop_unsafeAccum, 'prop_unsafeAccumulate, 'prop_unsafeAccumulate_, -} + + -- Permutations + 'prop_reverse, 'prop_backpermute, + {- 'prop_unsafeBackpermute, -} + + -- Elementwise indexing + {- 'prop_indexed, -} + + -- Mapping + 'prop_map, 'prop_imap, 'prop_concatMap, + + -- Monadic mapping + {- 'prop_mapM, 'prop_mapM_, 'prop_forM, 'prop_forM_, -} + + -- Zipping + 'prop_zipWith, 'prop_zipWith3, {- ... -} + 'prop_izipWith, 'prop_izipWith3, {- ... -} + {- 'prop_zip, ... -} + + -- Monadic zipping + {- 'prop_zipWithM, 'prop_zipWithM_, -} + + -- Unzipping + {- 'prop_unzip, ... -} + + -- Filtering + 'prop_filter, 'prop_ifilter, {- prop_filterM, -} + 'prop_takeWhile, 'prop_dropWhile, + + -- Paritioning + 'prop_partition, {- 'prop_unstablePartition, -} + 'prop_span, 'prop_break, + + -- Searching 'prop_elem, 'prop_notElem, 'prop_find, 'prop_findIndex, 'prop_findIndices, 'prop_elemIndex, 'prop_elemIndices, + -- Folding 'prop_foldl, 'prop_foldl1, 'prop_foldl', 'prop_foldl1', 'prop_foldr, 'prop_foldr1, 'prop_foldr', 'prop_foldr1', 'prop_ifoldl, 'prop_ifoldl', 'prop_ifoldr, 'prop_ifoldr', + -- Specialised folds 'prop_all, 'prop_any, + {- 'prop_maximumBy, 'prop_minimumBy, + 'prop_maxIndexBy, 'prop_minIndexBy, -} + -- Monadic folds + {- ... -} + + -- Monadic sequencing + {- ... -} + + -- Scans 'prop_prescanl, 'prop_prescanl', 'prop_postscanl, 'prop_postscanl', 'prop_scanl, 'prop_scanl', 'prop_scanl1, 'prop_scanl1', 'prop_prescanr, 'prop_prescanr', 'prop_postscanr, 'prop_postscanr', - 'prop_scanr, 'prop_scanr', 'prop_scanr1, 'prop_scanr1', - - 'prop_concatMap {- , - 'prop_unfoldr -} + 'prop_scanr, 'prop_scanr', 'prop_scanr1, 'prop_scanr1' ]) where -- Prelude @@ -131,9 +204,12 @@ prop_cons :: P (a -> v a -> v a) = V.cons `eq` (:) prop_snoc :: P (v a -> a -> v a) = V.snoc `eq` snoc prop_append :: P (v a -> v a -> v a) = (V.++) `eq` (++) + prop_concat :: P ([v a] -> v a) = V.concat `eq` concat prop_force :: P (v a -> v a) = V.force `eq` id prop_generate :: P (Int -> (Int -> a) -> v a) = (\n _ -> n < 1000) ===> V.generate `eq` generate + prop_iterateN :: P (Int -> (a -> a) -> a -> v a) + = (\n _ _ -> n < 1000) ===> V.iterateN `eq` (\n f -> take n . iterate f) 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 @@ -143,6 +219,11 @@ unP prop xs i where prop :: P (v a -> Int -> a) = (V.!) `eq` (!!) + prop_safeIndex :: P (v a -> Int -> Maybe a) = (V.!?) `eq` fn + where + fn xs i = case drop i xs of + x:_ | i >= 0 -> Just x + _ -> Nothing prop_unsafeHead :: P (v a -> a) = not . V.null ===> V.unsafeHead `eq` head prop_unsafeLast :: P (v a -> a) = not . V.null ===> V.unsafeLast `eq` last prop_unsafeIndex = \xs -> @@ -163,6 +244,7 @@ prop_init :: P (v a -> v a) = not . V.null ===> V.init `eq` init prop_take :: P (Int -> v a -> v a) = V.take `eq` take prop_drop :: P (Int -> v a -> v a) = V.drop `eq` drop + prop_splitAt :: P (Int -> v a -> (v a, v a)) = V.splitAt `eq` splitAt prop_accum = \f xs -> forAll (index_value_pairs (V.length xs)) $ \ps -> @@ -305,7 +387,20 @@ = (\n f a -> V.unfoldr (limitUnfolds f) (a, n)) `eq` (\n f a -> unfoldr (limitUnfolds f) (a, n)) + prop_constructN = \f -> forAll (choose (0,20)) $ \n -> unP prop n f + where + prop :: P (Int -> (v a -> a) -> v a) = V.constructN `eq` constructN [] + constructN xs 0 _ = xs + constructN xs n f = constructN (xs ++ [f xs]) (n-1) f + + prop_constructrN = \f -> forAll (choose (0,20)) $ \n -> unP prop n f + where + prop :: P (Int -> (v a -> a) -> v a) = V.constructrN `eq` constructrN [] + + 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]) where @@ -356,7 +451,45 @@ | otherwise = (i-d*2, i+d*100) where d = abs (j-i) - + +testMonoidFunctions :: forall a v. (COMMON_CONTEXT(a, v), Monoid (v a)) => v a -> [Test] +testMonoidFunctions _ = $(testProperties + [ 'prop_mempty, 'prop_mappend, 'prop_mconcat ]) + where + prop_mempty :: P (v a) = mempty `eq` mempty + 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 _ = $(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 _ = $(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 _ = $(testProperties + [ 'prop_applicative_pure, 'prop_applicative_appl ]) + where + prop_applicative_pure :: P (a -> v a) + = Applicative.pure `eq` Applicative.pure + 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 _ = $(testProperties + [ 'prop_alternative_empty, 'prop_alternative_or ]) + where + prop_alternative_empty :: P (v a) = Applicative.empty `eq` Applicative.empty + prop_alternative_or :: P (v a -> v a -> v a) + = (Applicative.<|>) `eq` (Applicative.<|>) + testBoolFunctions :: forall v. (COMMON_CONTEXT(Bool, v)) => v Bool -> [Test] testBoolFunctions _ = $(testProperties ['prop_and, 'prop_or]) where @@ -387,7 +520,12 @@ testPolymorphicFunctions, testOrdFunctions, testTuplyFunctions, - testNestedVectorFunctions + testNestedVectorFunctions, + testMonoidFunctions, + testFunctorFunctions, + testMonadFunctions, + testApplicativeFunctions, + testAlternativeFunctions ] testBoolBoxedVector dummy = concatMap ($ dummy) @@ -408,7 +546,8 @@ testGeneralPrimitiveVector dummy = concatMap ($ dummy) [ testSanity, testPolymorphicFunctions, - testOrdFunctions + testOrdFunctions, + testMonoidFunctions ] testBoolPrimitiveVector dummy = concatMap ($ dummy) @@ -429,7 +568,8 @@ testGeneralStorableVector dummy = concatMap ($ dummy) [ testSanity, testPolymorphicFunctions, - testOrdFunctions + testOrdFunctions, + testMonoidFunctions ] testNumericStorableVector dummy = concatMap ($ dummy) @@ -444,7 +584,8 @@ testGeneralUnboxedVector dummy = concatMap ($ dummy) [ testSanity, testPolymorphicFunctions, - testOrdFunctions + testOrdFunctions, + testMonoidFunctions ] testUnitUnboxedVector dummy = concatMap ($ dummy) diff --git a/tests/vector-tests.cabal b/tests/vector-tests.cabal --- a/tests/vector-tests.cabal +++ b/tests/vector-tests.cabal @@ -1,5 +1,5 @@ Name: vector-tests -Version: 0.6.0.1 +Version: 0.8 License: BSD3 License-File: LICENSE Author: Max Bolingbroke, Roman Leshchinskiy @@ -14,9 +14,14 @@ Cabal-Version: >= 1.2 Build-Type: Simple -Executable "vector-tests" + +Executable "vector-tests-O0" Main-Is: Main.hs + Build-Depends: base >= 4 && < 5, template-haskell, vector == 0.8, + random, + QuickCheck >= 2, test-framework, test-framework-quickcheck2 + Extensions: CPP, ScopedTypeVariables, PatternGuards, @@ -27,12 +32,26 @@ TypeFamilies, TemplateHaskell - Build-Depends: base >= 4 && < 5, template-haskell, vector, + Ghc-Options: -O0 + Ghc-Options: -Wall -fno-warn-orphans -fno-warn-missing-signatures + +Executable "vector-tests-O2" + Main-Is: Main.hs + + Build-Depends: base >= 4 && < 5, template-haskell, vector == 0.8, random, QuickCheck >= 2, test-framework, test-framework-quickcheck2 - -- Don't let fusion occur or GHC will make our tests less informative in some cases :-) - Ghc-Options: -O0 - - -- It's good practice to show all warnings, but since this is just test code let's ignore type sigs + Extensions: CPP, + ScopedTypeVariables, + PatternGuards, + MultiParamTypeClasses, + FlexibleContexts, + Rank2Types, + TypeSynonymInstances, + TypeFamilies, + TemplateHaskell + + Ghc-Options: -O2 Ghc-Options: -Wall -fno-warn-orphans -fno-warn-missing-signatures + diff --git a/vector.cabal b/vector.cabal --- a/vector.cabal +++ b/vector.cabal @@ -1,5 +1,5 @@ Name: vector -Version: 0.7.1 +Version: 0.8 License: BSD3 License-File: LICENSE Author: Roman Leshchinskiy @@ -12,23 +12,26 @@ Description: . An efficient implementation of Int-indexed arrays (both mutable - and immutable), with a powerful loop fusion optimization framework . + and immutable), with a powerful loop optimisation framework . . It is structured as follows: . - [@Data.Vector@] Boxed vectors of arbitrary types. + ["Data.Vector"] Boxed vectors of arbitrary types. . - [@Data.Vector.Unboxed@] Unboxed vectors with an adaptive + ["Data.Vector.Unboxed"] Unboxed vectors with an adaptive representation based on data type families. . - [@Data.Vector.Storable@] Unboxed vectors of 'Storable' types. + ["Data.Vector.Storable"] Unboxed vectors of 'Storable' types. . - [@Data.Vector.Primitive@] Unboxed vectors of primitive types as - defined by the @primitive@ package. @Data.Vector.Unboxed@ is more + ["Data.Vector.Primitive"] Unboxed vectors of primitive types as + defined by the @primitive@ package. "Data.Vector.Unboxed" is more flexible at no performance cost. . - [@Data.Vector.Generic@] Generic interface to the vector types. + ["Data.Vector.Generic"] Generic interface to the vector types. . + Each module has a @Safe@ version with is marked as @Trustworthy@ + (see ). + . There is also a (draft) tutorial on common uses of vector. . * @@ -38,45 +41,25 @@ . * . - Changes in version 0.7.1 - . - * New functions: @iterateN@, @splitAt@ - . - * New monadic operations: @generateM@, @sequence@, @foldM_@ and - variants - . - * New functions for copying potentially overlapping arrays: @move@, - @unsafeMove@ - . - * Specialisations of various monadic operations for primitive monads - . - * Unsafe casts for Storable vectors - . - * Efficiency improvements - . - Changes in version 0.7.0.1 - . - * Dependency on package ghc removed - . - Changes in version 0.7 + Changes in version 0.8 . - * New functions for freezing, copying and thawing vectors: @freeze@, - @thaw@, @unsafeThaw@ and @clone@ + * New functions: @constructN@, @constructrN@ . - * @newWith@ and @newUnsafeWith@ on mutable vectors replaced by - @replicate@ + * Support for GHC 7.2 array copying primitives . - * New function: @concat@ + * New fixity for @(!)@ . - * New function for safe indexing: @(!?)@ + * Safe Haskell support (contributed by David Terei) . - * @Monoid@ instances for all vector types + * 'Functor', 'Monad', 'Applicative', 'Alternative', 'Foldable' and + 'Traversable' instances for boxed vectors + (/WARNING: they tend to be slow and are only provided for completeness/) . - * Significant recycling and fusion improvements + * 'Show' instances for immutable vectors follow containers conventions . - * Bug fixes + * 'Read' instances for all immutable vector types . - * Support for GHC 7.0 + * Performance improvements . Cabal-Version: >= 1.2.3 @@ -133,15 +116,22 @@ Data.Vector.Fusion.Util Data.Vector.Fusion.Stream.Size Data.Vector.Fusion.Stream.Monadic + Data.Vector.Fusion.Stream.Monadic.Safe Data.Vector.Fusion.Stream + Data.Vector.Fusion.Stream.Safe Data.Vector.Generic.Mutable + Data.Vector.Generic.Mutable.Safe Data.Vector.Generic.Base Data.Vector.Generic.New + Data.Vector.Generic.New.Safe Data.Vector.Generic + Data.Vector.Generic.Safe Data.Vector.Primitive.Mutable + Data.Vector.Primitive.Mutable.Safe Data.Vector.Primitive + Data.Vector.Primitive.Safe Data.Vector.Storable.Internal Data.Vector.Storable.Mutable @@ -149,10 +139,14 @@ Data.Vector.Unboxed.Base Data.Vector.Unboxed.Mutable + Data.Vector.Unboxed.Mutable.Safe Data.Vector.Unboxed + Data.Vector.Unboxed.Safe Data.Vector.Mutable + Data.Vector.Mutable.Safe Data.Vector + Data.Vector.Safe Include-Dirs: include, internal @@ -160,7 +154,7 @@ Install-Includes: vector.h - Build-Depends: base >= 4 && < 5, primitive >= 0.3.1 && < 0.4 + Build-Depends: base >= 4 && < 5, primitive >= 0.4 && < 0.5 if impl(ghc<6.13) Ghc-Options: -finline-if-enough-args -fno-method-sharing