packages feed

vector 0.5 → 0.6

raw patch · 38 files changed

+2114/−477 lines, 38 filesdep ~basedep ~primitive

Dependency ranges changed: base, primitive

Files

Data/Vector.hs view
@@ -1,33 +1,68 @@-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeFamilies #-}+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeFamilies, Rank2Types #-}  -- | -- Module      : Data.Vector--- Copyright   : (c) Roman Leshchinskiy 2008-2009+-- Copyright   : (c) Roman Leshchinskiy 2008-2010 -- License     : BSD-style -- -- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au> -- Stability   : experimental -- Portability : non-portable -- --- Boxed vectors+-- A library for boxed vectors (that is, polymorphic arrays capable of+-- holding any Haskell value). The vectors come in two flavors: --+--  * mutable+--+--  * immutable+--+-- and support a rich interface of both list-like operations, and bulk+-- array operations.+--+-- For unboxed arrays, use the 'Data.Vector.Unboxed' interface.+--  module Data.Vector (++  -- * The pure and mutable array types   Vector, MVector, -  -- * Length information-  length, null,+  -- * Constructing vectors+  empty,+  singleton,+  cons,+  snoc,+  (++),+  replicate,+  generate,+  force, -  -- * Construction-  empty, singleton, cons, snoc, replicate, generate, (++), copy,+  -- * Operations based on length information+  length,+  null,    -- * Accessing individual elements-  (!), head, last, indexM, headM, lastM,+  (!),+  head,+  last,++  -- ** Accessors in a monad+  indexM,+  headM,+  lastM,++  -- ** Accessor functions with no bounds checking   unsafeIndex, unsafeHead, unsafeLast,   unsafeIndexM, unsafeHeadM, unsafeLastM,    -- * Subvectors-  slice, init, tail, take, drop,+  init,+  tail,+  take,+  drop,+  slice,++  -- * Subvector construction without bounds checks   unsafeSlice, unsafeInit, unsafeTail, unsafeTake, unsafeDrop,    -- * Permutations@@ -65,7 +100,7 @@   minIndex, minIndexBy, maxIndex, maxIndexBy,    -- * Unfolding-  unfoldr,+  unfoldr, unfoldrN,    -- * Scans   prescanl, prescanl',@@ -79,14 +114,24 @@   enumFromN, enumFromStepN, enumFromTo, enumFromThenTo,    -- * Conversion to/from lists-  toList, fromList+  toList, fromList, fromListN,++  -- * Monadic operations+  replicateM, mapM, mapM_, forM, forM_, zipWithM, zipWithM_, filterM,+  foldM, foldM', fold1M, fold1M',++  -- * Destructive operations+  create, modify, copy, unsafeCopy ) where  import qualified Data.Vector.Generic as G import           Data.Vector.Mutable  ( MVector(..) ) import           Data.Primitive.Array+import qualified Data.Vector.Fusion.Stream as Stream  import Control.Monad ( liftM )+import Control.Monad.ST ( ST )+import Control.Monad.Primitive  import Prelude hiding ( length, null,                         replicate, (++),@@ -99,17 +144,30 @@                         foldl, foldl1, foldr, foldr1,                         all, any, and, or, sum, product, minimum, maximum,                         scanl, scanl1, scanr, scanr1,-                        enumFromTo, enumFromThenTo )+                        enumFromTo, enumFromThenTo,+                        mapM, mapM_ )  import qualified Prelude +import Data.Typeable ( Typeable )+import Data.Data     ( Data(..) )++-- | Boxed vectors, supporting efficient slicing. data Vector a = Vector {-# UNPACK #-} !Int                        {-# UNPACK #-} !Int                        {-# UNPACK #-} !(Array a)+        deriving ( Typeable )  instance Show a => Show (Vector a) where     show = (Prelude.++ " :: Data.Vector.Vector") . ("fromList " Prelude.++) . show . toList +instance Data a => Data (Vector a) where+  gfoldl       = G.gfoldl+  toConstr _   = error "toConstr"+  gunfold _ _  = error "gunfold"+  dataTypeOf _ = G.mkType "Data.Vector.Vector"+  dataCast1    = G.dataCast+ type instance G.Mutable Vector = MVector  instance G.Vector Vector a where@@ -126,21 +184,40 @@   {-# INLINE basicUnsafeIndexM #-}   basicUnsafeIndexM (Vector i _ arr) j = indexArrayM arr (i+j) +-- See http://trac.haskell.org/vector/ticket/12 instance Eq a => Eq (Vector a) where   {-# INLINE (==) #-}-  (==) = G.eq+  xs == ys = Stream.eq (G.stream xs) (G.stream ys) +  {-# INLINE (/=) #-}+  xs /= ys = not (Stream.eq (G.stream xs) (G.stream ys))++-- See http://trac.haskell.org/vector/ticket/12 instance Ord a => Ord (Vector a) where   {-# INLINE compare #-}-  compare = G.cmp+  compare xs ys = Stream.cmp (G.stream xs) (G.stream ys) +  {-# INLINE (<) #-}+  xs < ys = Stream.cmp (G.stream xs) (G.stream ys) == LT++  {-# INLINE (<=) #-}+  xs <= ys = Stream.cmp (G.stream xs) (G.stream ys) /= GT++  {-# INLINE (>) #-}+  xs > ys = Stream.cmp (G.stream xs) (G.stream ys) == GT++  {-# INLINE (>=) #-}+  xs >= ys = Stream.cmp (G.stream xs) (G.stream ys) /= LT+ -- Length -- ------ +-- |/O(1)/. Yield the length of a vector as an 'Int' length :: Vector a -> Int {-# INLINE length #-} length = G.length +-- |/O(1)/. 'null' tests whether the given array is empty. null :: Vector a -> Bool {-# INLINE null #-} null = G.null@@ -148,93 +225,106 @@ -- Construction -- ------------ --- | Empty vector+-- |/O(1)/. 'empty' builds a vector of size zero. empty :: Vector a {-# INLINE empty #-} empty = G.empty --- | Vector with exaclty one element+-- |/O(1)/, Vector with exactly one element singleton :: a -> Vector a {-# INLINE singleton #-} singleton = G.singleton --- | Vector of the given length with the given value in each position+-- |/O(n)/. @'replicate' n e@ yields a vector of length @n@ storing @e@ at each position replicate :: Int -> a -> Vector a {-# INLINE replicate #-} replicate = G.replicate --- | Generate a vector of the given length by applying the function to each--- index+-- |/O(n)/, Generate a vector of the given length by applying a (pure)+-- generator function to each index generate :: Int -> (Int -> a) -> Vector a {-# INLINE generate #-} generate = G.generate --- | Prepend an element+-- |/O(n)/, Prepend an element to an array. cons :: a -> Vector a -> Vector a {-# INLINE cons #-} cons = G.cons --- | Append an element+-- |/O(n)/, Append an element to an array. snoc :: Vector a -> a -> Vector a {-# INLINE snoc #-} snoc = G.snoc  infixr 5 ++--- | Concatenate two vectors++-- |/O(n)/, Concatenate two vectors (++) :: Vector a -> Vector a -> Vector a {-# INLINE (++) #-} (++) = (G.++) --- | Create a copy of a vector. Useful when dealing with slices.-copy :: Vector a -> Vector a-{-# INLINE copy #-}-copy = G.copy+-- |/O(n)/, Create a copy of a vector.+-- @force@ is useful when dealing with slices, as the garbage collector+-- may be able to free the original vector if no further references are held.+--+force :: Vector a -> Vector a+{-# INLINE force #-}+force = G.force  -- Accessing individual elements -- ----------------------------- --- | Indexing+-- |/O(1)/. Read the element in the vector at the given index. (!) :: Vector a -> Int -> a {-# INLINE (!) #-} (!) = (G.!) --- | First element+-- |/O(1)/. 'head' returns the first element of the vector head :: Vector a -> a {-# INLINE head #-} head = G.head --- | Last element+-- |/O(n)/. 'last' yields the last element of an array. last :: Vector a -> a {-# INLINE last #-} last = G.last --- | Unsafe indexing without bounds checking+-- |/O(1)/, Unsafe indexing without bounds checking+--+-- By not performing bounds checks, this function may be faster when+-- this function is used in an inner loop)+-- unsafeIndex :: Vector a -> Int -> a {-# INLINE unsafeIndex #-} unsafeIndex = G.unsafeIndex --- | Yield the first element of a vector without checking if the vector is--- empty+-- |/O(1)/, Yield the first element of a vector without checking if the vector is empty+--+-- By not performing bounds checks, this function may be faster when+-- this function is used in an inner loop) unsafeHead :: Vector a -> a {-# INLINE unsafeHead #-} unsafeHead = G.unsafeHead --- | Yield the last element of a vector without checking if the vector is--- empty+-- | Yield the last element of a vector without checking if the vector is empty+--+-- By not performing bounds checks, this function may be faster when+-- this function is used in an inner loop) unsafeLast :: Vector a -> a {-# INLINE unsafeLast #-} unsafeLast = G.unsafeLast --- | Monadic indexing which can be strict in the vector while remaining lazy in--- the element+-- | Monadic indexing which can be strict in the vector while remaining lazy in the element indexM :: Monad m => Vector a -> Int -> m a {-# INLINE indexM #-} indexM = G.indexM +-- | Monadic head which can be strict in the vector while remaining lazy in the element headM :: Monad m => Vector a -> m a {-# INLINE headM #-} headM = G.headM +-- | Monadic last which can be strict in the vector while remaining lazy in the element lastM :: Monad m => Vector a -> m a {-# INLINE lastM #-} lastM = G.lastM@@ -244,10 +334,12 @@ {-# INLINE unsafeIndexM #-} unsafeIndexM = G.unsafeIndexM +-- | Unsafe monadic head (access the first element) without bounds checks unsafeHeadM :: Monad m => Vector a -> m a {-# INLINE unsafeHeadM #-} unsafeHeadM = G.unsafeHeadM +-- | Unsafe monadic last (access the last element) without bounds checks unsafeLastM :: Monad m => Vector a -> m a {-# INLINE unsafeLastM #-} unsafeLastM = G.unsafeLastM@@ -255,8 +347,8 @@ -- Subarrays -- --------- --- | Yield a part of the vector without copying it. Safer version of--- 'basicUnsafeSlice'.+-- | /O(1)/, Yield a part of the vector without copying it.+-- slice :: Int   -- ^ starting index       -> Int   -- ^ length       -> Vector a@@ -264,27 +356,27 @@ {-# INLINE slice #-} slice = G.slice --- | Yield all but the last element without copying.+-- |/O(1)/, Yield all but the last element without copying. init :: Vector a -> Vector a {-# INLINE init #-} init = G.init --- | All but the first element (without copying).+-- |/O(1), Yield all but the first element (without copying). tail :: Vector a -> Vector a {-# INLINE tail #-} tail = G.tail --- | Yield the first @n@ elements without copying.+-- |/O(1)/, Yield the first @n@ elements without copying. take :: Int -> Vector a -> Vector a {-# INLINE take #-} take = G.take --- | Yield all but the first @n@ elements without copying.+-- |/O(1)/, Yield all but the first @n@ elements without copying. drop :: Int -> Vector a -> Vector a {-# INLINE drop #-} drop = G.drop --- | Unsafely yield a part of the vector without copying it and without+-- |/O(1)/, Unsafely yield a part of the vector without copying it and without -- performing bounds checks. unsafeSlice :: Int   -- ^ starting index             -> Int   -- ^ length@@ -293,18 +385,22 @@ {-# INLINE unsafeSlice #-} unsafeSlice = G.unsafeSlice +-- |/O(1)/, Zero-copying 'init' without bounds checks. unsafeInit :: Vector a -> Vector a {-# INLINE unsafeInit #-} unsafeInit = G.unsafeInit +-- |/O(1)/, Zero-copying 'tail' without bounds checks. unsafeTail :: Vector a -> Vector a {-# INLINE unsafeTail #-} unsafeTail = G.unsafeTail +-- |/O(1)/, Zero-copying 'take' without bounds checks. unsafeTake :: Int -> Vector a -> Vector a {-# INLINE unsafeTake #-} unsafeTake = G.unsafeTake +-- |/O(1)/, Zero-copying 'drop' without bounds checks. unsafeDrop :: Int -> Vector a -> Vector a {-# INLINE unsafeDrop #-} unsafeDrop = G.unsafeDrop@@ -312,63 +408,80 @@ -- Permutations -- ------------ +-- TODO there is no documentation for the accum* family of functions++-- | TODO unsafeAccum. unsafeAccum :: (a -> b -> a) -> Vector a -> [(Int,b)] -> Vector a {-# INLINE unsafeAccum #-} unsafeAccum = G.unsafeAccum +-- | TODO unsafeAccumulate unsafeAccumulate :: (a -> b -> a) -> Vector a -> Vector (Int,b) -> Vector a {-# INLINE unsafeAccumulate #-} unsafeAccumulate = G.unsafeAccumulate +-- | TODO unsafeAccumulate_ unsafeAccumulate_   :: (a -> b -> a) -> Vector a -> Vector Int -> Vector b -> Vector a {-# INLINE unsafeAccumulate_ #-} unsafeAccumulate_ = G.unsafeAccumulate_ +-- | TODO accum accum :: (a -> b -> a) -> Vector a -> [(Int,b)] -> Vector a {-# INLINE accum #-} accum = G.accum +-- | TODO accumulate accumulate :: (a -> b -> a) -> Vector a -> Vector (Int,b) -> Vector a {-# INLINE accumulate #-} accumulate = G.accumulate +-- | TODO accumulate_ accumulate_ :: (a -> b -> a) -> Vector a -> Vector Int -> Vector b -> Vector a {-# INLINE accumulate_ #-} accumulate_ = G.accumulate_ +-- | TODO unsafeUpd unsafeUpd :: Vector a -> [(Int, a)] -> Vector a {-# INLINE unsafeUpd #-} unsafeUpd = G.unsafeUpd +-- | TODO unsafeUpdate unsafeUpdate :: Vector a -> Vector (Int, a) -> Vector a {-# INLINE unsafeUpdate #-} unsafeUpdate = G.unsafeUpdate +-- | TODO unsafeUpdate_ unsafeUpdate_ :: Vector a -> Vector Int -> Vector a -> Vector a {-# INLINE unsafeUpdate_ #-} unsafeUpdate_ = G.unsafeUpdate_ +-- | TODO (//) (//) :: Vector a -> [(Int, a)] -> Vector a {-# INLINE (//) #-} (//) = (G.//) +-- | TODO update update :: Vector a -> Vector (Int, a) -> Vector a {-# INLINE update #-} update = G.update +-- | TODO update_ update_ :: Vector a -> Vector Int -> Vector a -> Vector a {-# INLINE update_ #-} update_ = G.update_ +-- | backpermute, courtesy Blelloch. The back-permute is a gather\/get operation. backpermute :: Vector a -> Vector Int -> Vector a {-# INLINE backpermute #-} backpermute = G.backpermute +-- | TODO unsafeBackpermute unsafeBackpermute :: Vector a -> Vector Int -> Vector a {-# INLINE unsafeBackpermute #-} unsafeBackpermute = G.unsafeBackpermute +-- | /O(n)/, reverse the elements of the given vector. reverse :: Vector a -> Vector a {-# INLINE reverse #-} reverse = G.reverse@@ -376,16 +489,17 @@ -- Mapping -- ------- --- | Map a function over a vector+-- | /O(n)/, Map a function over a vector map :: (a -> b) -> Vector a -> Vector b {-# INLINE map #-} map = G.map --- | Apply a function to every index/value pair+-- | /O(n)/, Apply a function to every index/value pair yielding a new vector imap :: (Int -> a -> b) -> Vector a -> Vector b {-# INLINE imap #-} imap = G.imap +-- | /O(n)/, generate a vector from each element of the input vector, then join the results. concatMap :: (a -> Vector b) -> Vector a -> Vector b {-# INLINE concatMap #-} concatMap = G.concatMap@@ -393,65 +507,73 @@ -- Zipping/unzipping -- ----------------- --- | Zip two vectors with the given function.+-- |/O(n)/, Zip two vectors with the given function. zipWith :: (a -> b -> c) -> Vector a -> Vector b -> Vector c {-# INLINE zipWith #-} zipWith = G.zipWith --- | Zip three vectors with the given function.+-- |/O(n)/, Zip three vectors with the given function. zipWith3 :: (a -> b -> c -> d) -> Vector a -> Vector b -> Vector c -> Vector d {-# INLINE zipWith3 #-} zipWith3 = G.zipWith3 +-- |/O(n)/, Zip four vectors with the given function. zipWith4 :: (a -> b -> c -> d -> e)           -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e {-# INLINE zipWith4 #-} zipWith4 = G.zipWith4 +-- |/O(n)/, Zip five vectors with the given function. zipWith5 :: (a -> b -> c -> d -> e -> f)           -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e           -> Vector f {-# INLINE zipWith5 #-} zipWith5 = G.zipWith5 +-- |/O(n)/, Zip six vectors with the given function. zipWith6 :: (a -> b -> c -> d -> e -> f -> g)           -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e           -> Vector f -> Vector g {-# INLINE zipWith6 #-} zipWith6 = G.zipWith6 --- | Zip two vectors and their indices with the given function.+-- |/O(n)/, Zip two vectors and their indices with the given function. izipWith :: (Int -> a -> b -> c) -> Vector a -> Vector b -> Vector c {-# INLINE izipWith #-} izipWith = G.izipWith --- | Zip three vectors and their indices with the given function.+-- |/O(n)/, Zip three vectors and their indices with the given function. izipWith3 :: (Int -> a -> b -> c -> d)           -> Vector a -> Vector b -> Vector c -> Vector d {-# INLINE izipWith3 #-} izipWith3 = G.izipWith3 +-- |/O(n)/, Zip four vectors and their indices with the given function. izipWith4 :: (Int -> a -> b -> c -> d -> e)           -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e {-# INLINE izipWith4 #-} izipWith4 = G.izipWith4 +-- |/O(n)/, Zip five vectors and their indices with the given function. izipWith5 :: (Int -> a -> b -> c -> d -> e -> f)           -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e           -> Vector f {-# INLINE izipWith5 #-} izipWith5 = G.izipWith5 +-- |/O(n)/, Zip six vectors and their indices with the given function. izipWith6 :: (Int -> a -> b -> c -> d -> e -> f -> g)           -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e           -> Vector f -> Vector g {-# INLINE izipWith6 #-} izipWith6 = G.izipWith6 +-- | Elementwise pairing of array elements.  zip :: Vector a -> Vector b -> Vector (a, b) {-# INLINE zip #-} zip = G.zip +-- | zip together three vectors into a vector of triples zip3 :: Vector a -> Vector b -> Vector c -> Vector (a, b, c) {-# INLINE zip3 #-} zip3 = G.zip3@@ -471,6 +593,7 @@ {-# INLINE zip6 #-} zip6 = G.zip6 +-- | Elementwise unpairing of array elements. unzip :: Vector (a, b) -> (Vector a, Vector b) {-# INLINE unzip #-} unzip = G.unzip@@ -496,23 +619,23 @@ -- Filtering -- --------- --- | Drop elements which do not satisfy the predicate+-- |/O(n)/, Remove elements from the vector which do not satisfy the predicate filter :: (a -> Bool) -> Vector a -> Vector a {-# INLINE filter #-} filter = G.filter --- | Drop elements that do not satisfy the predicate (applied to values and+-- |/O(n)/, Drop elements that do not satisfy the predicate (applied to values and -- their indices) ifilter :: (Int -> a -> Bool) -> Vector a -> Vector a {-# INLINE ifilter #-} ifilter = G.ifilter --- | Yield the longest prefix of elements satisfying the predicate.+-- |/O(n)/, Yield the longest prefix of elements satisfying the predicate. takeWhile :: (a -> Bool) -> Vector a -> Vector a {-# INLINE takeWhile #-} takeWhile = G.takeWhile --- | Drop the longest prefix of elements that satisfy the predicate.+-- |/O(n)/, Drop the longest prefix of elements that satisfy the predicate. dropWhile :: (a -> Bool) -> Vector a -> Vector a {-# INLINE dropWhile #-} dropWhile = G.dropWhile@@ -525,14 +648,14 @@ {-# INLINE partition #-} partition = G.partition --- | Split the vector in two parts, the first one containing those elements+-- |/O(n)/, Split the vector in two parts, the first one containing those elements -- that satisfy the predicate and the second one those that don't. The order -- of the elements is not preserved. unstablePartition :: (a -> Bool) -> Vector a -> (Vector a, Vector a) {-# INLINE unstablePartition #-} unstablePartition = G.unstablePartition --- | Split the vector into the longest prefix of elements that satisfy the+-- |/O(n)/, Split the vector into the longest prefix of elements that satisfy the -- predicate and the rest. span :: (a -> Bool) -> Vector a -> (Vector a, Vector a) {-# INLINE span #-}@@ -595,7 +718,7 @@ {-# INLINE foldl #-} foldl = G.foldl --- | Lefgt fold on non-empty vectors+-- | Left fold on non-empty vectors foldl1 :: (a -> a -> a) -> Vector a -> a {-# INLINE foldl1 #-} foldl1 = G.foldl1@@ -655,58 +778,74 @@ -- Specialised folds -- ----------------- +-- |/O(n)/. @'all' p u@ determines whether all elements in array @u@ satisfy +-- predicate @p@. all :: (a -> Bool) -> Vector a -> Bool {-# INLINE all #-} all = G.all +-- |/O(n)/. @'any' p u@ determines whether any element in array @u@ satisfies+-- predicate @p@. any :: (a -> Bool) -> Vector a -> Bool {-# INLINE any #-} any = G.any +-- |/O(n)/. 'and' yields the conjunction of a boolean array. and :: Vector Bool -> Bool {-# INLINE and #-} and = G.and +-- |/O(n)/. 'or' yields the disjunction of a boolean array. or :: Vector Bool -> Bool {-# INLINE or #-} or = G.or +-- |/O(n)/. 'sum' computes the sum (with @(+)@) of an array of elements. sum :: Num a => Vector a -> a {-# INLINE sum #-} sum = G.sum +-- |/O(n)/. 'sum' computes the product (with @(*)@) of an array of elements. product :: Num a => Vector a -> a {-# INLINE product #-} product = G.product +-- |/O(n)/. 'maximum' finds the maximum element in an array of orderable elements. maximum :: Ord a => Vector a -> a {-# INLINE maximum #-} maximum = G.maximum +-- |/O(n)/. 'maximumBy' finds the maximum element in an array under the given ordering. maximumBy :: (a -> a -> Ordering) -> Vector a -> a {-# INLINE maximumBy #-} maximumBy = G.maximumBy +-- |/O(n)/. 'minimum' finds the minimum element in an array of orderable elements. minimum :: Ord a => Vector a -> a {-# INLINE minimum #-} minimum = G.minimum +-- |/O(n)/. 'minimumBy' finds the minimum element in an array under the given ordering. minimumBy :: (a -> a -> Ordering) -> Vector a -> a {-# INLINE minimumBy #-} minimumBy = G.minimumBy +-- | TODO maxIndex maxIndex :: Ord a => Vector a -> Int {-# INLINE maxIndex #-} maxIndex = G.maxIndex +-- | TODO maxIndexBy maxIndexBy :: (a -> a -> Ordering) -> Vector a -> Int {-# INLINE maxIndexBy #-} maxIndexBy = G.maxIndexBy +-- | TODO minIndex minIndex :: Ord a => Vector a -> Int {-# INLINE minIndex #-} minIndex = G.minIndex +-- | TODO minIndexBy minIndexBy :: (a -> a -> Ordering) -> Vector a -> Int {-# INLINE minIndexBy #-} minIndexBy = G.minIndexBy@@ -714,10 +853,27 @@ -- Unfolding -- --------- +-- | The 'unfoldr' function is a \`dual\' to 'foldr': while 'foldr'+-- reduces a vector to a summary value, 'unfoldr' builds a list from+-- a seed value.  The function takes the element and returns 'Nothing'+-- if it is done generating the vector or returns 'Just' @(a,b)@, in which+-- case, @a@ is a prepended to the vector and @b@ is used as the next+-- element in a recursive call.+--+-- A simple use of unfoldr:+--+-- > unfoldr (\b -> if b == 0 then Nothing else Just (b, b-1)) 10+-- >  [10,9,8,7,6,5,4,3,2,1]+-- unfoldr :: (b -> Maybe (a, b)) -> b -> Vector a {-# INLINE unfoldr #-} unfoldr = G.unfoldr +-- | Unfold at most @n@ elements+unfoldrN :: Int -> (b -> Maybe (a, b)) -> b -> Vector a+{-# INLINE unfoldrN #-}+unfoldrN = G.unfoldrN+ -- Scans -- ----- @@ -741,7 +897,7 @@ {-# INLINE postscanl' #-} postscanl' = G.postscanl' --- | Haskell-style scan+-- | Haskell-style scan function. scanl :: (a -> b -> a) -> a -> Vector b -> Vector a {-# INLINE scanl #-} scanl = G.scanl@@ -761,7 +917,6 @@ {-# INLINE scanl1' #-} scanl1' = G.scanl1' - -- | Prefix right-to-left scan prescanr :: (a -> b -> b) -> b -> Vector a -> Vector b {-# INLINE prescanr #-}@@ -846,4 +1001,107 @@ fromList :: [a] -> Vector a {-# INLINE fromList #-} fromList = G.fromList++-- | Convert the first @n@ elements of a list to a vector+--+-- > fromListN n xs = fromList (take n xs)+fromListN :: Int -> [a] -> Vector a+{-# INLINE fromListN #-}+fromListN = G.fromListN++-- Monadic operations+-- ------------------++-- | Perform the monadic action the given number of times and store the+-- results in a vector.+replicateM :: Monad m => Int -> m a -> m (Vector a)+{-# INLINE replicateM #-}+replicateM = G.replicateM++-- | Apply the monadic action to all elements of the vector, yielding a vector+-- of results+mapM :: Monad m => (a -> m b) -> Vector a -> m (Vector b)+{-# INLINE mapM #-}+mapM = G.mapM++-- | Apply the monadic action to all elements of a vector and ignore the+-- results+mapM_ :: Monad m => (a -> m b) -> Vector a -> m ()+{-# INLINE mapM_ #-}+mapM_ = G.mapM_++-- | Apply the monadic action to all elements of the vector, yielding a vector+-- of results+forM :: Monad m => Vector a -> (a -> m b) -> m (Vector b)+{-# INLINE forM #-}+forM = G.forM++-- | Apply the monadic action to all elements of a vector and ignore the+-- results+forM_ :: Monad m => Vector a -> (a -> m b) -> m ()+{-# INLINE forM_ #-}+forM_ = G.forM_++-- | Zip the two vectors with the monadic action and yield a vector of results+zipWithM :: Monad m+         => (a -> b -> m c) -> Vector a -> Vector b -> m (Vector c)+{-# INLINE zipWithM #-}+zipWithM = G.zipWithM++-- | Zip the two vectors with the monadic action and ignore the results+zipWithM_ :: Monad m+          => (a -> b -> m c) -> Vector a -> Vector b -> m ()+{-# INLINE zipWithM_ #-}+zipWithM_ = G.zipWithM_++-- | Drop elements that do not satisfy the monadic predicate+filterM :: Monad m => (a -> m Bool) -> Vector a -> m (Vector a)+{-# INLINE filterM #-}+filterM = G.filterM++-- | Monadic fold+foldM :: Monad m => (a -> b -> m a) -> a -> Vector b -> m a+{-# INLINE foldM #-}+foldM = G.foldM++-- | Monadic fold over non-empty vectors+fold1M :: Monad m => (a -> a -> m a) -> Vector a -> m a+{-# INLINE fold1M #-}+fold1M = G.fold1M++-- | Monadic fold with strict accumulator+foldM' :: Monad m => (a -> b -> m a) -> a -> Vector b -> m a+{-# INLINE foldM' #-}+foldM' = G.foldM'++-- | Monad fold over non-empty vectors with strict accumulator+fold1M' :: Monad m => (a -> a -> m a) -> Vector a -> m a+{-# INLINE fold1M' #-}+fold1M' = G.fold1M'++-- Destructive operations+-- ----------------------++-- | Destructively initialise a vector.+create :: (forall s. ST s (MVector s a)) -> Vector a+{-# INLINE create #-}+create = G.create++-- | Apply a destructive operation to a vector. The operation is applied to a+-- copy of the vector unless it can be safely performed in place.+modify :: (forall s. MVector s a -> ST s ()) -> Vector a -> Vector a+{-# INLINE modify #-}+modify = G.modify++-- | Copy an immutable vector into a mutable one. The two vectors must have+-- the same length. This is not checked.+unsafeCopy :: PrimMonad m => MVector (PrimState m) a -> Vector a -> m ()+{-# INLINE unsafeCopy #-}+unsafeCopy = G.unsafeCopy+           +-- | Copy an immutable vector into a mutable one. The two vectors must have the+-- same length.+copy :: PrimMonad m => MVector (PrimState m) a -> Vector a -> m ()+{-# INLINE copy #-}+copy = G.copy
Data/Vector/Fusion/Stream.hs view
@@ -1,8 +1,8 @@-{-# LANGUAGE ExistentialQuantification, FlexibleInstances, Rank2Types #-}+{-# LANGUAGE FlexibleInstances, Rank2Types #-}  -- | -- Module      : Data.Vector.Fusion.Stream--- Copyright   : (c) Roman Leshchinskiy 2008-2009+-- Copyright   : (c) Roman Leshchinskiy 2008-2010 -- License     : BSD-style -- -- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au>@@ -55,7 +55,7 @@   and, or,    -- * Unfolding-  unfoldr,+  unfoldr, unfoldrN,    -- * Scans   prescanl, prescanl',@@ -67,10 +67,12 @@   enumFromStepN, enumFromTo, enumFromThenTo,    -- * Conversions-  toList, fromList, liftStream,+  toList, fromList, fromListN, unsafeFromList, liftStream,    -- * Monadic combinators-  mapM_, foldM, fold1M, foldM', fold1M'+  mapM, mapM_, zipWithM, zipWithM_, filterM, foldM, fold1M, foldM', fold1M',++  eq, cmp ) where  import Data.Vector.Fusion.Stream.Size@@ -90,8 +92,10 @@                         and, or,                         scanl, scanl1,                         enumFromTo, enumFromThenTo,-                        mapM_ )+                        mapM, mapM_ ) +import GHC.Base ( build )+ #include "vector.h"  -- | The type of pure streams @@ -409,6 +413,11 @@ {-# INLINE unfoldr #-} unfoldr = M.unfoldr +-- | Unfold at most @n@ elements+unfoldrN :: Int -> (s -> Maybe (a, s)) -> s -> Stream a+{-# INLINE unfoldrN #-}+unfoldrN = M.unfoldrN+ -- Scans -- ----- @@ -500,11 +509,30 @@ -- Monadic combinators -- ------------------- +-- | Apply a monadic action to each element of the stream, producing a monadic+-- stream of results+mapM :: Monad m => (a -> m b) -> Stream a -> M.Stream m b+{-# INLINE mapM #-}+mapM f = M.mapM f . liftStream+ -- | Apply a monadic action to each element of the stream-mapM_ :: Monad m => (a -> m ()) -> Stream a -> m ()+mapM_ :: Monad m => (a -> m b) -> Stream a -> m () {-# INLINE mapM_ #-} mapM_ f = M.mapM_ f . liftStream +zipWithM :: Monad m => (a -> b -> m c) -> Stream a -> Stream b -> M.Stream m c+{-# INLINE zipWithM #-}+zipWithM f as bs = M.zipWithM f (liftStream as) (liftStream bs)++zipWithM_ :: Monad m => (a -> b -> m c) -> Stream a -> Stream b -> m ()+{-# INLINE zipWithM_ #-}+zipWithM_ f as bs = M.zipWithM_ f (liftStream as) (liftStream bs)++-- | Yield a monadic stream of elements that satisfy the monadic predicate+filterM :: Monad m => (a -> m Bool) -> Stream a -> M.Stream m a+{-# INLINE filterM #-}+filterM f = M.filterM f . liftStream+ -- | Monadic fold foldM :: Monad m => (a -> b -> m a) -> a -> Stream b -> m a {-# INLINE foldM #-}@@ -556,10 +584,33 @@ -- | Convert a 'Stream' to a list toList :: Stream a -> [a] {-# INLINE toList #-}-toList s = unId (M.toList s)+-- toList s = unId (M.toList s)+toList s = build (\c n -> toListFB c n s) +-- This supports foldr/build list fusion that GHC implements+toListFB :: (a -> b -> b) -> b -> Stream a -> b+{-# INLINE [0] toListFB #-}+toListFB c n (M.Stream step s _) = go s+  where+    go s = case unId (step s) of+             Yield x s' -> x `c` go s'+             Skip    s' -> go s'+             Done       -> n+ -- | Create a 'Stream' from a list fromList :: [a] -> Stream a {-# INLINE fromList #-} fromList = M.fromList++-- | Create a 'Stream' from the first @n@ elements of a list+--+-- > fromListN n xs = fromList (take n xs)+fromListN :: Int -> [a] -> Stream a+{-# INLINE fromListN #-}+fromListN = M.fromListN++unsafeFromList :: Size -> [a] -> Stream a+{-# INLINE unsafeFromList #-}+unsafeFromList = M.unsafeFromList+
Data/Vector/Fusion/Stream/Monadic.hs view
@@ -2,14 +2,14 @@  -- | -- Module      : Data.Vector.Fusion.Stream.Monadic--- Copyright   : (c) Roman Leshchinskiy 2008-2009+-- Copyright   : (c) Roman Leshchinskiy 2008-2010 -- License     : BSD-style -- -- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au> -- Stability   : experimental -- Portability : non-portable ----- Monadic streams+-- Monadic stream combinators. --  module Data.Vector.Fusion.Stream.Monadic (@@ -22,7 +22,7 @@   length, null,    -- * Construction-  empty, singleton, cons, snoc, replicate, generate, generateM, (++),+  empty, singleton, cons, snoc, replicate, replicateM, generate, generateM, (++),    -- * Accessing elements   head, last, (!!),@@ -34,7 +34,7 @@   map, mapM, mapM_, trans, unbox, concatMap,      -- * Zipping-  indexed, indexedR,+  indexed, indexedR, zipWithM_,   zipWithM, zipWith3M, zipWith4M, zipWith5M, zipWith6M,   zipWith, zipWith3, zipWith4, zipWith5, zipWith6,   zip, zip3, zip4, zip5, zip6,@@ -55,6 +55,7 @@    -- * Unfolding   unfoldr, unfoldrM,+  unfoldrN, unfoldrNM,    -- * Scans   prescanl, prescanlM, prescanl', prescanlM',@@ -66,7 +67,7 @@   enumFromStepN, enumFromTo, enumFromThenTo,    -- * Conversions-  toList, fromList+  toList, fromList, fromListN, unsafeFromList ) where  import Data.Vector.Fusion.Stream.Size@@ -87,7 +88,6 @@                         and, or,                         scanl, scanl1,                         enumFromTo, enumFromThenTo )-import qualified Prelude  import Data.Int  ( Int8, Int16, Int32, Int64 ) import Data.Word ( Word8, Word16, Word32, Word, Word64 )@@ -155,14 +155,20 @@  -- | Replicate a value to a given length replicate :: Monad m => Int -> a -> Stream m a-{-# INLINE_STREAM replicate #-}+{-# INLINE replicate #-}+replicate n x = replicateM n (return x)++-- | Yield a 'Stream' of values obtained by performing the monadic action the+-- given number of times+replicateM :: Monad m => Int -> m a -> Stream m a+{-# INLINE_STREAM replicateM #-} -- NOTE: We delay inlining max here because GHC will create a join point for -- the call to newArray# otherwise which is not really nice.-replicate n x = Stream (return . step) n (Exact (delay_inline max n 0))+replicateM n p = Stream step n (Exact (delay_inline max n 0))   where     {-# INLINE_INNER step #-}-    step i | i <= 0    = Done-           | otherwise = Yield x (i-1)+    step i | i <= 0    = return Done+           | otherwise = do { x <- p; return $ Yield x (i-1) }  generate :: Monad m => Int -> (Int -> a) -> Stream m a {-# INLINE generate #-}@@ -377,19 +383,23 @@                   Skip    s' -> return (Skip    s')                   Done       -> return Done --- | Execute a monadic action for each element of the 'Stream'-mapM_ :: Monad m => (a -> m b) -> Stream m a -> m ()-{-# INLINE_STREAM mapM_ #-}-mapM_ m (Stream step s _) = mapM_loop SPEC s+consume :: Monad m => Stream m a -> m ()+{-# INLINE_STREAM consume #-}+consume (Stream step s _) = consume_loop SPEC s   where-    mapM_loop SPEC s+    consume_loop SPEC s       = do           r <- step s           case r of-            Yield x s' -> do { m x; mapM_loop SPEC s' }-            Skip    s' -> mapM_loop SPEC s'+            Yield _ s' -> consume_loop SPEC s'+            Skip    s' -> consume_loop SPEC s'             Done       -> return () +-- | Execute a monadic action for each element of the 'Stream'+mapM_ :: Monad m => (a -> m b) -> Stream m a -> m ()+{-# INLINE_STREAM mapM_ #-}+mapM_ m = consume . mapM m+ -- | Transform a 'Stream' to use a different monad trans :: (Monad m, Monad m') => (forall a. m a -> m' a)                              -> Stream m a -> Stream m' a@@ -474,6 +484,10 @@    #-} +zipWithM_ :: Monad m => (a -> b -> m c) -> Stream m a -> Stream m b -> m ()+{-# INLINE zipWithM_ #-}+zipWithM_ f sa sb = consume (zipWithM f sa sb)+ zipWith3M :: Monad m => (a -> b -> c -> m d) -> Stream m a -> Stream m b -> Stream m c -> Stream m d {-# INLINE_STREAM zipWith3M #-} zipWith3M f (Stream stepa sa na) (Stream stepb sb nb) (Stream stepc sc nc)@@ -937,6 +951,24 @@                  Nothing      -> Done              ) (f s) +-- | Unfold at most @n@ elements+unfoldrN :: Monad m => Int -> (s -> Maybe (a, s)) -> s -> Stream m a+{-# INLINE_STREAM unfoldrN #-}+unfoldrN n f = unfoldrNM n (return . f)++-- | Unfold at most @n@ elements with a monadic functions+unfoldrNM :: Monad m => Int -> (s -> m (Maybe (a, s))) -> s -> Stream m a+{-# INLINE_STREAM unfoldrNM #-}+unfoldrNM n f s = Stream step (s,n) (Max (delay_inline max n 0))+  where+    {-# INLINE_INNER step #-}+    step (s,n) | n <= 0    = return Done+               | otherwise = liftM (\r ->+                               case r of+                                 Just (x,s') -> Yield x (s',n-1)+                                 Nothing     -> Done+                             ) (f s)+ -- Scans -- ----- @@ -1123,9 +1155,6 @@ {-# INLINE_STREAM enumFromTo #-} enumFromTo x y = fromList [x .. y] --- FIXME: Specialise enumFromTo for Float and Double. Also, try to do--- something about pairs?- -- NOTE: We use (x+1) instead of (succ x) below because the latter checks for -- overflow which can't happen here. @@ -1268,7 +1297,7 @@                         $ fromIntegral n       where         n = y-x+1-                        +     {-# INLINE_INNER step #-}     step x | x <= y    = return $ Yield x (x+1)            | otherwise = return $ Done@@ -1304,6 +1333,41 @@    #-} +------------------------------------------------------------------------++-- Specialise enumFromTo for Float and Double.+-- Also, try to do something about pairs?++enumFromTo_double :: (Monad m, Ord a, RealFrac a) => a -> a -> Stream m a+{-# INLINE_STREAM enumFromTo_double #-}+enumFromTo_double n m = Stream step n (Max (len n m))+  where+    lim = m + 1/2 -- important to float out++    {-# INLINE [0] len #-}+    len x y | x > y     = 0+            | otherwise = BOUNDS_CHECK(check) "enumFromTo" "vector too large"+                          (n > 0)+                        $ fromIntegral n+      where+        n = truncate (y-x)+2++    {-# INLINE_INNER step #-}+    step x | x <= lim  = return $ Yield x (x+1)+           | otherwise = return $ Done++{-# RULES++"enumFromTo<Double> [Stream]"+  enumFromTo = enumFromTo_double :: Monad m => Double -> Double -> Stream m Double++"enumFromTo<Float> [Stream]"+  enumFromTo = enumFromTo_double :: Monad m => Float -> Float -> Stream m Float++  #-}++------------------------------------------------------------------------+ -- | Enumerate values with a given step. -- -- /WARNING:/ This operation is very inefficient. If at all possible, use@@ -1324,8 +1388,23 @@  -- | Convert a list to a 'Stream' fromList :: Monad m => [a] -> Stream m a-{-# INLINE_STREAM fromList #-}-fromList xs = Stream step xs Unknown+{-# INLINE fromList #-}+fromList xs = unsafeFromList Unknown xs++-- | Convert the first @n@ elements of a list to a 'Stream'+fromListN :: Monad m => Int -> [a] -> Stream m a+{-# INLINE_STREAM fromListN #-}+fromListN n xs = Stream step (xs,n) (Max (delay_inline max n 0))+  where+    {-# INLINE_INNER step #-}+    step (xs,n) | n <= 0 = return Done+    step (x:xs,n)        = return (Yield x (xs,n-1))+    step ([],n)          = return Done++-- | Convert a list to a 'Stream' with the given 'Size' hint. +unsafeFromList :: Monad m => Size -> [a] -> Stream m a+{-# INLINE_STREAM unsafeFromList #-}+unsafeFromList sz xs = Stream step xs sz   where     step (x:xs) = return (Yield x xs)     step []     = return Done
Data/Vector/Fusion/Stream/Size.hs view
@@ -1,13 +1,13 @@ -- | -- Module      : Data.Vector.Fusion.Stream.Size--- Copyright   : (c) Roman Leshchinskiy 2008-2009+-- Copyright   : (c) Roman Leshchinskiy 2008-2010 -- License     : BSD-style -- -- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au> -- Stability   : experimental -- Portability : portable -- --- Size hints+-- Size hints for streams. --  module Data.Vector.Fusion.Stream.Size (
Data/Vector/Generic.hs view
@@ -2,7 +2,7 @@              TypeFamilies, ScopedTypeVariables #-} -- | -- Module      : Data.Vector.Generic--- Copyright   : (c) Roman Leshchinskiy 2008-2009+-- Copyright   : (c) Roman Leshchinskiy 2008-2010 -- License     : BSD-style -- -- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au>@@ -20,7 +20,7 @@   length, null,    -- * Construction-  empty, singleton, cons, snoc, replicate, generate, (++), copy,+  empty, singleton, cons, snoc, replicate, generate, (++), force,    -- * Accessing individual elements   (!), head, last, indexM, headM, lastM,@@ -69,7 +69,7 @@   minIndex, minIndexBy, maxIndex, maxIndexBy,    -- * Unfolding-  unfoldr,+  unfoldr, unfoldrN,    -- * Scans   prescanl, prescanl',@@ -83,15 +83,27 @@   enumFromN, enumFromStepN, enumFromTo, enumFromThenTo,    -- * Conversion to/from lists-  toList, fromList,+  toList, fromList, fromListN, +  -- * Monadic operations+  replicateM, mapM, mapM_, forM, forM_, zipWithM, zipWithM_, filterM,+  foldM, foldM', fold1M, fold1M',++  -- * Destructive operations+  create, modify, copy, unsafeCopy,+   -- * Conversion to/from Streams   stream, unstream, streamR, unstreamR, -  -- * MVector-based initialisation-  new+  -- * Recycling support+  new, clone,++  -- * Utilities for defining Data instances+  gfoldl, dataCast, mkType ) where +import           Data.Vector.Generic.Base+ import           Data.Vector.Generic.Mutable ( MVector ) import qualified Data.Vector.Generic.Mutable as M @@ -104,8 +116,9 @@ import           Data.Vector.Fusion.Stream.Size import           Data.Vector.Fusion.Util -import Control.Monad.ST ( runST )+import Control.Monad.ST ( ST, runST ) import Control.Monad.Primitive+import qualified Control.Monad as Monad import Prelude hiding ( length, null,                         replicate, (++),                         head, last,@@ -117,71 +130,29 @@                         foldl, foldl1, foldr, foldr1,                         all, any, and, or, sum, product, maximum, minimum,                         scanl, scanl1, scanr, scanr1,-                        enumFromTo, enumFromThenTo )--#include "vector.h"--type family Mutable (v :: * -> *) :: * -> * -> *---- | Class of immutable vectors.----class MVector (Mutable v) a => Vector v a where-  -- | Unsafely convert a mutable vector to its immutable version-  -- without copying. The mutable vector may not be used after-  -- this operation.-  unsafeFreeze :: PrimMonad m => Mutable v (PrimState m) a -> m (v a)--  -- | Length of the vector (not fusible!)-  basicLength      :: v a -> Int--  -- | Yield a part of the vector without copying it. No range checks!-  basicUnsafeSlice  :: Int -> Int -> v a -> v a--  -- | Yield the element at the given position in a monad. The monad allows us-  -- to be strict in the vector if we want. Suppose we had-  ---  -- > unsafeIndex :: v a -> Int -> a-  ---  -- instead. Now, if we wanted to copy a vector, we'd do something like-  ---  -- > copy mv v ... = ... unsafeWrite mv i (unsafeIndex v i) ...-  ---  -- For lazy vectors, the indexing would not be evaluated which means that we-  -- would retain a reference to the original vector in each element we write.-  -- This is not what we want!-  ---  -- With 'basicUnsafeIndexM', we can do-  ---  -- > copy mv v ... = ... case basicUnsafeIndexM v i of-  -- >                       Box x -> unsafeWrite mv i x ...-  ---  -- which does not have this problem because indexing (but not the returned-  -- element!) is evaluated immediately.-  ---  basicUnsafeIndexM  :: Monad m => v a -> Int -> m a+                        enumFromTo, enumFromThenTo,+                        mapM, mapM_ ) -  elemseq :: v a -> a -> b -> b+import Data.Typeable ( Typeable1, gcast1 )+import Data.Data ( Data, DataType, mkNorepType ) -  {-# INLINE elemseq #-}-  elemseq _ = \_ x -> x+#include "vector.h"  -- Fusion -- ------  -- | Construct a pure vector from a monadic initialiser -new :: Vector v a => New a -> v a-{-# INLINE new #-}-new m = new' undefined m+new :: Vector v a => New v a -> v a+{-# INLINE_STREAM new #-}+new m = m `seq` runST (unsafeFreeze =<< New.run m) --- | Same as 'new' but with a dummy argument necessary for correctly typing--- the rule @uninplace@.------ See http://hackage.haskell.org/trac/ghc/ticket/2600-new' :: Vector v a => v a -> New a -> v a-{-# INLINE_STREAM new' #-}-new' _ m = m `seq` runST (do-                            mv <- New.run m-                            unsafeFreeze mv)+clone :: Vector v a => v a -> New v a+{-# INLINE_STREAM clone #-}+clone v = v `seq` New.create (+  do+    mv <- M.new (length v)+    unsafeCopy mv v+    return mv)  -- | Convert a vector to a 'Stream' stream :: Vector v a => v a -> Stream a@@ -203,23 +174,22 @@  {-# RULES -"stream/unstream [Vector]" forall v s.-  stream (new' v (New.unstream s)) = s--"New.unstream/stream/new [Vector]" forall v p.-  New.unstream (stream (new' v p)) = p+"stream/unstream [Vector]" forall s.+  stream (new (New.unstream s)) = s - #-}+"New.unstream/stream [Vector]" forall v.+  New.unstream (stream v) = clone v -{-# RULES+"clone/new [Vector]" forall p.+  clone (new p) = p  "inplace [Vector]"-  forall (f :: forall m. Monad m => MStream m a -> MStream m a) v m.-  New.unstream (inplace f (stream (new' v m))) = New.transform f m+  forall (f :: forall m. Monad m => MStream m a -> MStream m a) m.+  New.unstream (inplace f (stream (new m))) = New.transform f m  "uninplace [Vector]"-  forall (f :: forall m. Monad m => MStream m a -> MStream m a) v m.-  stream (new' v (New.transform f m)) = inplace f (stream (new' v m))+  forall (f :: forall m. Monad m => MStream m a -> MStream m a) m.+  stream (new (New.transform f m)) = inplace f (stream (new m))   #-} @@ -230,8 +200,6 @@   where     n = length v -    -- NOTE: the False case comes first in Core so making it the recursive one-    -- makes the code easier to read     {-# INLINE get #-}     get 0 = Nothing     get i = let i' = i-1@@ -245,23 +213,19 @@  {-# RULES -"streamR/unstreamR [Vector]" forall v s.-  streamR (new' v (New.unstreamR s)) = s--"New.unstreamR/streamR/new [Vector]" forall v p.-  New.unstreamR (streamR (new' v p)) = p-- #-}+"streamR/unstreamR [Vector]" forall s.+  streamR (new (New.unstreamR s)) = s -{-# RULES+"New.unstreamR/streamR/new [Vector]" forall p.+  New.unstreamR (streamR (new p)) = p -"inplace [Vector]"-  forall (f :: forall m. Monad m => MStream m a -> MStream m a) v m.-  New.unstreamR (inplace f (streamR (new' v m))) = New.transformR f m+"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 -"uninplace [Vector]"-  forall (f :: forall m. Monad m => MStream m a -> MStream m a) v m.-  streamR (new' v (New.transformR f m)) = inplace f (streamR (new' v m))+"uninplace right [Vector]"+  forall (f :: forall m. Monad m => MStream m a -> MStream m a) m.+  streamR (new (New.transformR f m)) = inplace f (streamR (new m))   #-} @@ -274,15 +238,22 @@  {-# RULES -"length/unstream [Vector]" forall v s.-  length (new' v (New.unstream s)) = Stream.length s+"length/unstream [Vector]" forall s.+  length (new (New.unstream s)) = Stream.length s    #-}  null :: Vector v a => v a -> Bool-{-# INLINE null #-}-null v = length v == 0+{-# INLINE_STREAM null #-}+null v = basicLength v == 0 +{-# RULES++"null/unstream [Vector]" forall s.+  null (new (New.unstream s)) = Stream.null s++  #-}+ -- Construction -- ------------ @@ -332,16 +303,9 @@ v ++ w = unstream (stream v Stream.++ stream w)  -- | Create a copy of a vector. Useful when dealing with slices.-copy :: Vector v a => v a -> v a-{-# INLINE_STREAM copy #-}-copy = unstream . stream--{-# RULES--"copy/unstream [Vector]" forall v s.-  copy (new' v (New.unstream s)) = new' v (New.unstream s)-- #-}+force :: Vector v a => v a -> v a+{-# INLINE_STREAM force #-}+force v = new (clone v)  -- Accessing individual elements -- -----------------------------@@ -382,23 +346,23 @@  {-# RULES -"(!)/unstream [Vector]" forall v i s.-  new' v (New.unstream s) ! i = s Stream.!! i+"(!)/unstream [Vector]" forall i s.+  new (New.unstream s) ! i = s Stream.!! i -"head/unstream [Vector]" forall v s.-  head (new' v (New.unstream s)) = Stream.head s+"head/unstream [Vector]" forall s.+  head (new (New.unstream s)) = Stream.head s -"last/unstream [Vector]" forall v s.-  last (new' v (New.unstream s)) = Stream.last s+"last/unstream [Vector]" forall s.+  last (new (New.unstream s)) = Stream.last s -"unsafeIndex/unstream [Vector]" forall v i s.-  unsafeIndex (new' v (New.unstream s)) i = s Stream.!! i+"unsafeIndex/unstream [Vector]" forall i s.+  unsafeIndex (new (New.unstream s)) i = s Stream.!! i -"unsafeHead/unstream [Vector]" forall v s.-  unsafeHead (new' v (New.unstream s)) = Stream.head s+"unsafeHead/unstream [Vector]" forall s.+  unsafeHead (new (New.unstream s)) = Stream.head s -"unsafeLast/unstream [Vector]" forall v s.-  unsafeLast (new' v (New.unstream s)) = Stream.last s+"unsafeLast/unstream [Vector]" forall s.+  unsafeLast (new (New.unstream s)) = Stream.last s   #-} @@ -448,8 +412,6 @@ -- Subarrays -- --------- --- FIXME: slicing doesn't work with the inplace stuff at the moment- -- | Yield a part of the vector without copying it. slice :: Vector v a => Int   -- ^ starting index                     -> Int   -- ^ length@@ -511,29 +473,29 @@  {-# RULES -"slice/new [Vector]" forall i n v p.-  slice i n (new' v p) = new' v (New.slice i n p)+"slice/new [Vector]" forall i n p.+  slice i n (new p) = new (New.slice i n p) -"init/new [Vector]" forall v p.-  init (new' v p) = new' v (New.init p)+"init/new [Vector]" forall p.+  init (new p) = new (New.init p) -"tail/new [Vector]" forall v p.-  tail (new' v p) = new' v (New.tail p)+"tail/new [Vector]" forall p.+  tail (new p) = new (New.tail p) -"take/new [Vector]" forall n v p.-  take n (new' v p) = new' v (New.take n p)+"take/new [Vector]" forall n p.+  take n (new p) = new (New.take n p) -"drop/new [Vector]" forall n v p.-  drop n (new' v p) = new' v (New.drop n p)+"drop/new [Vector]" forall n p.+  drop n (new p) = new (New.drop n p) -"unsafeSlice/new [Vector]" forall i n v p.-  unsafeSlice i n (new' v p) = new' v (New.unsafeSlice i n p)+"unsafeSlice/new [Vector]" forall i n p.+  unsafeSlice i n (new p) = new (New.unsafeSlice i n p) -"unsafeInit/new [Vector]" forall v p.-  unsafeInit (new' v p) = new' v (New.unsafeInit p)+"unsafeInit/new [Vector]" forall p.+  unsafeInit (new p) = new (New.unsafeInit p) -"unsafeTail/new [Vector]" forall v p.-  unsafeTail (new' v p) = new' v (New.unsafeTail p)+"unsafeTail/new [Vector]" forall p.+  unsafeTail (new p) = new (New.unsafeTail p)    #-} @@ -543,7 +505,7 @@ unsafeAccum_stream   :: Vector v a => (a -> b -> a) -> v a -> Stream (Int,b) -> v a {-# INLINE unsafeAccum_stream #-}-unsafeAccum_stream f v s = new (New.accum f (New.unstream (stream v)) s)+unsafeAccum_stream f = modifyWithStream (M.unsafeAccum f)  unsafeAccum :: Vector v a => (a -> b -> a) -> v a -> [(Int,b)] -> v a {-# INLINE unsafeAccum #-}@@ -562,7 +524,7 @@  accum_stream :: Vector v a => (a -> b -> a) -> v a -> Stream (Int,b) -> v a {-# INLINE accum_stream #-}-accum_stream f v s = new (New.accum f (New.unstream (stream v)) s)+accum_stream f = modifyWithStream (M.accum f)  accum :: Vector v a => (a -> b -> a) -> v a -> [(Int,b)] -> v a {-# INLINE accum #-}@@ -582,7 +544,7 @@  unsafeUpdate_stream :: Vector v a => v a -> Stream (Int,a) -> v a {-# INLINE unsafeUpdate_stream #-}-unsafeUpdate_stream v s = new (New.unsafeUpdate (New.unstream (stream v)) s)+unsafeUpdate_stream = modifyWithStream M.unsafeUpdate  unsafeUpd :: Vector v a => v a -> [(Int, a)] -> v a {-# INLINE unsafeUpd #-}@@ -599,7 +561,7 @@  update_stream :: Vector v a => v a -> Stream (Int,a) -> v a {-# INLINE update_stream #-}-update_stream v s = new (New.update (New.unstream (stream v)) s)+update_stream = modifyWithStream M.update  (//) :: Vector v a => v a -> [(Int, a)] -> v a {-# INLINE (//) #-}@@ -634,9 +596,10 @@                        $ Stream.map (unsafeIndexM v)                        $ stream is +-- FIXME: make this fuse better, add support for recycling reverse :: (Vector v a) => v a -> v a {-# INLINE reverse #-}-reverse = new . New.reverse . New.unstream . stream+reverse = unstream . streamR  -- Mapping -- -------@@ -901,7 +864,7 @@     v2 <- unsafeFreeze mv2     return (v1,v2)) -unstablePartition_new :: Vector v a => (a -> Bool) -> New a -> (v a, v a)+unstablePartition_new :: Vector v a => (a -> Bool) -> New v a -> (v a, v a) {-# INLINE_STREAM unstablePartition_new #-} unstablePartition_new f (New.New p) = runST (   do@@ -912,8 +875,8 @@  {-# RULES -"unstablePartition" forall f v p.-  unstablePartition_stream f (stream (new' v p))+"unstablePartition" forall f p.+  unstablePartition_stream f (stream (new p))     = unstablePartition_new f p    #-}@@ -1129,10 +1092,16 @@ -- Unfolding -- --------- +-- | Unfold unfoldr :: Vector v a => (b -> Maybe (a, b)) -> b -> v a {-# INLINE unfoldr #-} unfoldr f = unstream . Stream.unfoldr f +-- | Unfoldr at most @n@ elements.+unfoldrN  :: Vector v a => Int -> (b -> Maybe (a, b)) -> b -> v a+{-# INLINE unfoldrN #-}+unfoldrN n f = unstream . Stream.unfoldrN n f+ -- Scans -- ----- @@ -1252,6 +1221,9 @@ {-# INLINE enumFromThenTo #-} enumFromThenTo x y z = unstream (Stream.enumFromThenTo x y z) +-- Conversion to/from lists+-- ------------------------+ -- | Convert a vector to a list toList :: Vector v a => v a -> [a] {-# INLINE toList #-}@@ -1261,4 +1233,151 @@ fromList :: Vector v a => [a] -> v a {-# INLINE fromList #-} fromList = unstream . Stream.fromList++-- | Convert the first @n@ elements of a list to a vector+--+-- > fromListN n xs = fromList (take n xs)+fromListN :: Vector v a => Int -> [a] -> v a+{-# INLINE fromListN #-}+fromListN n = unstream . Stream.fromListN n++unstreamM :: (Vector v a, Monad m) => MStream m a -> m (v a)+{-# INLINE_STREAM unstreamM #-}+unstreamM s = do+                xs <- MStream.toList s+                return $ unstream $ Stream.unsafeFromList (MStream.size s) xs++-- Monadic operations+-- ------------------++-- FIXME: specialise various combinators for ST and IO?++-- | Perform the monadic action the given number of times and store the+-- results in a vector.+replicateM :: (Monad m, Vector v a) => Int -> m a -> m (v a)+{-# INLINE replicateM #-}+replicateM n m = fromListN n `Monad.liftM` Monad.replicateM n m++-- | Apply the monadic action to all elements of the vector, yielding a vector+-- of results+mapM :: (Monad m, Vector v a, Vector v b) => (a -> m b) -> v a -> m (v b)+{-# INLINE mapM #-}+mapM f = unstreamM . Stream.mapM f . stream++-- | Apply the monadic action to all elements of a vector and ignore the+-- results+mapM_ :: (Monad m, Vector v a) => (a -> m b) -> v a -> m ()+{-# INLINE mapM_ #-}+mapM_ f = Stream.mapM_ f . stream++-- | Apply the monadic action to all elements of the vector, yielding a vector+-- of results+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++-- | Apply the monadic action to all elements of a vector and ignore the+-- results+forM_ :: (Monad m, Vector v a) => v a -> (a -> m b) -> m ()+{-# INLINE forM_ #-}+forM_ as f = mapM_ f as++-- | Zip the two vectors with the monadic action and yield a vector of results+zipWithM :: (Monad m, Vector v a, Vector v b, Vector v c)+         => (a -> b -> m c) -> v a -> v b -> m (v c)+{-# INLINE zipWithM #-}+zipWithM f as bs = unstreamM $ Stream.zipWithM f (stream as) (stream bs)++-- | Zip the two vectors with the monadic action and ignore the results+zipWithM_ :: (Monad m, Vector v a, Vector v b)+          => (a -> b -> m c) -> v a -> v b -> m ()+{-# INLINE zipWithM_ #-}+zipWithM_ f as bs = Stream.zipWithM_ f (stream as) (stream bs)++-- | Drop elements that do not satisfy the monadic predicate+filterM :: (Monad m, Vector v a) => (a -> m Bool) -> v a -> m (v a)+{-# INLINE filterM #-}+filterM f = unstreamM . Stream.filterM f . stream++-- | Monadic fold+foldM :: (Monad m, Vector v b) => (a -> b -> m a) -> a -> v b -> m a+{-# INLINE foldM #-}+foldM m z = Stream.foldM m z . stream++-- | Monadic fold over non-empty vectors+fold1M :: (Monad m, Vector v a) => (a -> a -> m a) -> v a -> m a+{-# INLINE fold1M #-}+fold1M m = Stream.fold1M m . stream++-- | Monadic fold with strict accumulator+foldM' :: (Monad m, Vector v b) => (a -> b -> m a) -> a -> v b -> m a+{-# INLINE foldM' #-}+foldM' m z = Stream.foldM' m z . stream++-- | Monad fold over non-empty vectors with strict accumulator+fold1M' :: (Monad m, Vector v a) => (a -> a -> m a) -> v a -> m a+{-# INLINE fold1M' #-}+fold1M' m = Stream.fold1M' m . stream++-- Destructive operations+-- ----------------------++-- | Destructively initialise a vector.+create :: Vector v a => (forall s. ST s (Mutable v s a)) -> v a+{-# INLINE create #-}+create p = new (New.create p)++-- | Apply a destructive operation to a vector. The operation modifies a+-- copy of the vector unless it can be safely performed in place.+modify :: Vector v a => (forall s. Mutable v s a -> ST s ()) -> v a -> v a+{-# INLINE modify #-}+modify p = new . New.modify p . clone++-- We have to make sure that this is strict in the stream but we can't seq on+-- it while fusion is happening. Hence this ugliness.+modifyWithStream :: Vector v a+                 => (forall s. Mutable v s a -> Stream b -> ST s ())+                 -> v a -> Stream b -> v a+{-# INLINE modifyWithStream #-}+modifyWithStream p v s = new (New.modifyWithStream p (clone v) s)++-- | Copy an immutable vector into a mutable one. The two vectors must have+-- the same length. This is not checked.+unsafeCopy+  :: (PrimMonad m, Vector v a) => Mutable v (PrimState m) a -> v a -> m ()+{-# INLINE unsafeCopy #-}+unsafeCopy dst src = UNSAFE_CHECK(check) "unsafeCopy" "length mismatch"+                                         (M.length dst == length src)+                   $ (dst `seq` src `seq` basicUnsafeCopy dst src)+           +-- | Copy an immutable vector into a mutable one. The two vectors must have the+-- same length.+copy+  :: (PrimMonad m, Vector v a) => Mutable v (PrimState m) a -> v a -> m ()+{-# INLINE copy #-}+copy dst src = BOUNDS_CHECK(check) "copy" "length mismatch"+                                          (M.length dst == length src)+             $ unsafeCopy dst src++-- Utilities for defining Data instances+-- -------------------------------------++-- | Generic definion of 'Data.Data.gfoldl' that views a 'Vector' as a+-- list.+gfoldl :: (Vector v a, Data a)+       => (forall d b. Data d => c (d -> b) -> d -> c b)+       -> (forall g. g -> c g)+       -> v a+       -> c (v a)+{-# INLINE gfoldl #-}+gfoldl f z v = z fromList `f` toList v++mkType :: String -> DataType+{-# INLINE mkType #-}+mkType = mkNorepType++dataCast :: (Vector v a, Data a, Typeable1 v, Typeable1 t)+         => (forall d. Data  d => c (t d)) -> Maybe  (c (v a))+{-# INLINE dataCast #-}+dataCast f = gcast1 f
+ Data/Vector/Generic/Base.hs view
@@ -0,0 +1,86 @@+{-# LANGUAGE Rank2Types, MultiParamTypeClasses, FlexibleContexts,+             TypeFamilies, ScopedTypeVariables #-}++-- |+-- Module      : Data.Vector.Generic.Base+-- Copyright   : (c) Roman Leshchinskiy 2008-2010+-- License     : BSD-style+--+-- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au>+-- Stability   : experimental+-- Portability : non-portable+-- +-- Class of pure vectors+--++module Data.Vector.Generic.Base (+  Vector(..), Mutable+) where++import           Data.Vector.Generic.Mutable ( MVector )+import qualified Data.Vector.Generic.Mutable as M++import Control.Monad.Primitive++-- | @Mutable v s a@ is the mutable version of the pure vector type @v a@ with+-- the state token @s@+--+type family Mutable (v :: * -> *) :: * -> * -> *++-- | Class of immutable vectors.+--+class MVector (Mutable v) a => Vector v a where+  -- | Unsafely convert a mutable vector to its immutable version+  -- without copying. The mutable vector may not be used after+  -- this operation.+  unsafeFreeze :: PrimMonad m => Mutable v (PrimState m) a -> m (v a)++  -- | Length of the vector (not fusible!)+  basicLength      :: v a -> Int++  -- | Yield a part of the vector without copying it. No range checks!+  basicUnsafeSlice  :: Int -> Int -> v a -> v a++  -- | Yield the element at the given position in a monad. The monad allows us+  -- to be strict in the vector if we want. Suppose we had+  --+  -- > unsafeIndex :: v a -> Int -> a+  --+  -- instead. Now, if we wanted to copy a vector, we'd do something like+  --+  -- > copy mv v ... = ... unsafeWrite mv i (unsafeIndex v i) ...+  --+  -- For lazy vectors, the indexing would not be evaluated which means that we+  -- would retain a reference to the original vector in each element we write.+  -- This is not what we want!+  --+  -- With 'basicUnsafeIndexM', we can do+  --+  -- > copy mv v ... = ... case basicUnsafeIndexM v i of+  -- >                       Box x -> unsafeWrite mv i x ...+  --+  -- which does not have this problem because indexing (but not the returned+  -- element!) is evaluated immediately.+  --+  basicUnsafeIndexM  :: Monad m => v a -> Int -> m a++  -- | Copy an immutable vector into a mutable one.+  basicUnsafeCopy :: PrimMonad m => Mutable v (PrimState m) a -> v a -> m ()++  {-# INLINE basicUnsafeCopy #-}+  basicUnsafeCopy dst src = do_copy 0+    where+      n = basicLength src++      do_copy i | i < n = do+                            x <- basicUnsafeIndexM src i+                            M.basicUnsafeWrite dst i x+                            do_copy (i+1)+                | otherwise = return ()++  elemseq :: v a -> a -> b -> b++  {-# INLINE elemseq #-}+  elemseq _ = \_ x -> x++
Data/Vector/Generic/Mutable.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE MultiParamTypeClasses, BangPatterns, ScopedTypeVariables #-} -- | -- Module      : Data.Vector.Generic.Mutable--- Copyright   : (c) Roman Leshchinskiy 2008-2009+-- Copyright   : (c) Roman Leshchinskiy 2008-2010 -- License     : BSD-style -- -- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au>@@ -26,7 +26,10 @@   unsafeCopy, unsafeGrow,    -- * Internal operations-  unstream, transform, unstreamR, transformR,+  unstream, unstreamR,+  munstream, munstreamR,+  transform, transformR,+  fill, fillR,   unsafeAccum, accum, unsafeUpdate, update, reverse,   unstablePartition, unstablePartitionStream, partitionStream ) where@@ -38,10 +41,6 @@  import Control.Monad.Primitive ( PrimMonad, PrimState ) -import GHC.Float (-    double2Int, int2Double-  )- import Prelude hiding ( length, reverse, map, read,                         take, drop, init, tail ) @@ -194,27 +193,27 @@                            return $ Just (x, i+1)           | otherwise = return $ Nothing -munstream :: (PrimMonad m, MVector v a)+fill :: (PrimMonad m, MVector v a)            => v (PrimState m) a -> MStream m a -> m (v (PrimState m) a)-{-# INLINE munstream #-}-munstream v s = v `seq` do-                          n' <- MStream.foldM put 0 s-                          return $ unsafeSlice 0 n' v+{-# INLINE fill #-}+fill v s = v `seq` do+                     n' <- MStream.foldM put 0 s+                     return $ unsafeSlice 0 n' v   where     {-# INLINE_INNER put #-}     put i x = do-                INTERNAL_CHECK(checkIndex) "munstream" i (length v)+                INTERNAL_CHECK(checkIndex) "fill" i (length v)                   $ unsafeWrite v i x                 return (i+1)  transform :: (PrimMonad m, MVector v a)   => (MStream m a -> MStream m a) -> v (PrimState m) a -> m (v (PrimState m) a) {-# INLINE_STREAM transform #-}-transform f v = munstream v (f (mstream v))+transform f v = fill v (f (mstream v)) -mrstream :: (PrimMonad m, MVector v a) => v (PrimState m) a -> MStream m a-{-# INLINE mrstream #-}-mrstream v = v `seq` (MStream.unfoldrM get n `MStream.sized` Exact n)+mstreamR :: (PrimMonad m, MVector v a) => v (PrimState m) a -> MStream m a+{-# INLINE mstreamR #-}+mstreamR v = v `seq` (MStream.unfoldrM get n `MStream.sized` Exact n)   where     n = length v @@ -225,12 +224,12 @@       where         j = i-1 -munstreamR :: (PrimMonad m, MVector v a)+fillR :: (PrimMonad m, MVector v a)            => v (PrimState m) a -> MStream m a -> m (v (PrimState m) a)-{-# INLINE munstreamR #-}-munstreamR v s = v `seq` do-                           i <- MStream.foldM put n s-                           return $ unsafeSlice i (n-i) v+{-# INLINE fillR #-}+fillR v s = v `seq` do+                      i <- MStream.foldM put n s+                      return $ unsafeSlice i (n-i) v   where     n = length v @@ -244,17 +243,25 @@ transformR :: (PrimMonad m, MVector v a)   => (MStream m a -> MStream m a) -> v (PrimState m) a -> m (v (PrimState m) a) {-# INLINE_STREAM transformR #-}-transformR f v = munstreamR v (f (mrstream v))+transformR f v = fillR v (f (mstreamR v))  -- | Create a new mutable vector and fill it with elements from the 'Stream'.--- The vector will grow logarithmically if the 'Size' hint of the 'Stream' is--- inexact.+-- The vector will grow exponentially if the maximum size of the 'Stream' is+-- unknown. unstream :: (PrimMonad m, MVector v a) => Stream a -> m (v (PrimState m) a)+-- NOTE: replace INLINE_STREAM by INLINE? (also in unstreamR) {-# INLINE_STREAM unstream #-}-unstream s = case upperBound (Stream.size s) of-               Just n  -> unstreamMax     s n-               Nothing -> unstreamUnknown s+unstream s = munstream (Stream.liftStream s) +-- | Create a new mutable vector and fill it with elements from the monadic+-- stream. The vector will grow exponentially if the maximum size of the stream+-- is unknown.+munstream :: (PrimMonad m, MVector v a) => MStream m a -> m (v (PrimState m) a)+{-# INLINE_STREAM munstream #-}+munstream s = case upperBound (MStream.size s) of+               Just n  -> munstreamMax     s n+               Nothing -> munstreamUnknown s+ -- FIXME: I can't think of how to prevent GHC from floating out -- unstreamUnknown. That is bad because SpecConstr then generates two -- specialisations: one for when it is called from unstream (it doesn't know@@ -263,30 +270,31 @@ -- -- fromList = Data.Vector.Unboxed.unstream . Stream.fromList --+-- I'm not sure this still applies (19/04/2010) -unstreamMax-  :: (PrimMonad m, MVector v a) => Stream a -> Int -> m (v (PrimState m) a)-{-# INLINE unstreamMax #-}-unstreamMax s n+munstreamMax+  :: (PrimMonad m, MVector v a) => MStream m a -> Int -> m (v (PrimState m) a)+{-# INLINE munstreamMax #-}+munstreamMax s n   = do-      v <- INTERNAL_CHECK(checkLength) "unstreamMax" n+      v <- INTERNAL_CHECK(checkLength) "munstreamMax" n            $ unsafeNew n       let put i x = do-                       INTERNAL_CHECK(checkIndex) "unstreamMax" i n+                       INTERNAL_CHECK(checkIndex) "munstreamMax" i n                          $ unsafeWrite v i x                        return (i+1)-      n' <- Stream.foldM' put 0 s-      return $ INTERNAL_CHECK(checkSlice) "unstreamMax" 0 n' n+      n' <- MStream.foldM' put 0 s+      return $ INTERNAL_CHECK(checkSlice) "munstreamMax" 0 n' n              $ unsafeSlice 0 n' v -unstreamUnknown-  :: (PrimMonad m, MVector v a) => Stream a -> m (v (PrimState m) a)-{-# INLINE unstreamUnknown #-}-unstreamUnknown s+munstreamUnknown+  :: (PrimMonad m, MVector v a) => MStream m a -> m (v (PrimState m) a)+{-# INLINE munstreamUnknown #-}+munstreamUnknown s   = do       v <- unsafeNew 0-      (v', n) <- Stream.foldM put (v, 0) s-      return $ INTERNAL_CHECK(checkSlice) "unstreamUnknown" 0 n (length v')+      (v', n) <- MStream.foldM put (v, 0) s+      return $ INTERNAL_CHECK(checkSlice) "munstreamUnknown" 0 n (length v')              $ unsafeSlice 0 n v'   where     {-# INLINE_INNER put #-}@@ -294,38 +302,46 @@                     v' <- unsafeAppend1 v i x                     return (v',i+1) --- | Create a new mutable vector and fill it with elements from the 'Stream'.--- The vector will grow logarithmically if the 'Size' hint of the 'Stream' is--- inexact.+-- | Create a new mutable vector and fill it with elements from the 'Stream'+-- from right to left. The vector will grow exponentially if the maximum size+-- of the 'Stream' is unknown. unstreamR :: (PrimMonad m, MVector v a) => Stream a -> m (v (PrimState m) a)+-- NOTE: replace INLINE_STREAM by INLINE? (also in unstream) {-# INLINE_STREAM unstreamR #-}-unstreamR s = case upperBound (Stream.size s) of-               Just n  -> unstreamRMax     s n-               Nothing -> unstreamRUnknown s+unstreamR s = munstreamR (Stream.liftStream s) -unstreamRMax-  :: (PrimMonad m, MVector v a) => Stream a -> Int -> m (v (PrimState m) a)-{-# INLINE unstreamRMax #-}-unstreamRMax s n+-- | Create a new mutable vector and fill it with elements from the monadic+-- stream from right to left. The vector will grow exponentially if the maximum+-- size of the stream is unknown.+munstreamR :: (PrimMonad m, MVector v a) => MStream m a -> m (v (PrimState m) a)+{-# INLINE_STREAM munstreamR #-}+munstreamR s = case upperBound (MStream.size s) of+               Just n  -> munstreamRMax     s n+               Nothing -> munstreamRUnknown s++munstreamRMax+  :: (PrimMonad m, MVector v a) => MStream m a -> Int -> m (v (PrimState m) a)+{-# INLINE munstreamRMax #-}+munstreamRMax s n   = do-      v <- INTERNAL_CHECK(checkLength) "unstreamRMax" n+      v <- INTERNAL_CHECK(checkLength) "munstreamRMax" n            $ unsafeNew n       let put i x = do                       let i' = i-1-                      INTERNAL_CHECK(checkIndex) "unstreamRMax" i' n+                      INTERNAL_CHECK(checkIndex) "munstreamRMax" i' n                         $ unsafeWrite v i' x                       return i'-      i <- Stream.foldM' put n s-      return $ INTERNAL_CHECK(checkSlice) "unstreamRMax" i (n-i) n+      i <- MStream.foldM' put n s+      return $ INTERNAL_CHECK(checkSlice) "munstreamRMax" i (n-i) n              $ unsafeSlice i (n-i) v -unstreamRUnknown-  :: (PrimMonad m, MVector v a) => Stream a -> m (v (PrimState m) a)-{-# INLINE unstreamRUnknown #-}-unstreamRUnknown s+munstreamRUnknown+  :: (PrimMonad m, MVector v a) => MStream m a -> m (v (PrimState m) a)+{-# INLINE munstreamRUnknown #-}+munstreamRUnknown s   = do       v <- unsafeNew 0-      (v', i) <- Stream.foldM put (v, 0) s+      (v', i) <- MStream.foldM put (v, 0) s       let n = length v'       return $ INTERNAL_CHECK(checkSlice) "unstreamRUnknown" i (n-i) n              $ unsafeSlice i (n-i) v'@@ -528,7 +544,7 @@                                          (length dst == length src)                    $ UNSAFE_CHECK(check) "unsafeCopy" "overlapping vectors"                                          (not (dst `overlaps` src))-                   $ basicUnsafeCopy dst src+                   $ (dst `seq` src `seq` basicUnsafeCopy dst src)  -- Subvectors -- ----------
Data/Vector/Generic/New.hs view
@@ -2,7 +2,7 @@  -- | -- Module      : Data.Vector.Generic.New--- Copyright   : (c) Roman Leshchinskiy 2008-2009+-- Copyright   : (c) Roman Leshchinskiy 2008-2010 -- License     : BSD-style -- -- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au>@@ -13,16 +13,17 @@ --  module Data.Vector.Generic.New (-  New(..), run, unstream, transform, unstreamR, transformR,-  accum, update, reverse,+  New(..), create, run, apply, modify, modifyWithStream,+  unstream, transform, unstreamR, transformR,   slice, init, tail, take, drop,-  unsafeSlice, unsafeInit, unsafeTail,-  unsafeAccum, unsafeUpdate+  unsafeSlice, unsafeInit, unsafeTail ) where  import qualified Data.Vector.Generic.Mutable as MVector import           Data.Vector.Generic.Mutable ( MVector ) +import           Data.Vector.Generic.Base ( Vector, Mutable )+ import           Data.Vector.Fusion.Stream ( Stream, MStream ) import qualified Data.Vector.Fusion.Stream as Stream @@ -32,25 +33,35 @@  #include "vector.h" -data New a = New (forall mv s. MVector mv a => ST s (mv s a))+data New v a = New (forall s. ST s (Mutable v s a)) -run :: MVector mv a => New a -> ST s (mv s a)+create :: (forall s. ST s (Mutable v s a)) -> New v a+{-# INLINE create #-}+create = New++run :: New v a -> ST s (Mutable v s a) {-# INLINE run #-} run (New p) = p -apply :: (forall mv s a. MVector mv a => mv s a -> mv s a) -> New a -> New a+apply :: (forall s. Mutable v s a -> Mutable v s a) -> New v a -> New v a {-# INLINE apply #-} apply f (New p) = New (liftM f p) -modify :: New a -> (forall mv s. MVector mv a => mv s a -> ST s ()) -> New a+modify :: (forall s. Mutable v s a -> ST s ()) -> New v a -> New v a {-# INLINE modify #-}-modify (New p) q = New (do { v <- p; q v; return v })+modify f (New p) = New (do { v <- p; f v; return v }) -unstream :: Stream a -> New a+modifyWithStream :: (forall s. Mutable v s a -> Stream b -> ST s ())+                 -> New v a -> Stream b -> New v a+{-# INLINE_STREAM modifyWithStream #-}+modifyWithStream f (New p) s = s `seq` New (do { v <- p; f v s; return v })++unstream :: Vector v a => Stream a -> New v a {-# INLINE_STREAM unstream #-} unstream s = s `seq` New (MVector.unstream s) -transform :: (forall m. Monad m => MStream m a -> MStream m a) -> New a -> New a+transform :: Vector v a =>+        (forall m. Monad m => MStream m a -> MStream m a) -> New v a -> New v a {-# INLINE_STREAM transform #-} transform f (New p) = New (MVector.transform f =<< p) @@ -70,11 +81,12 @@  #-}  -unstreamR :: Stream a -> New a+unstreamR :: Vector v a => Stream a -> New v a {-# INLINE_STREAM unstreamR #-} unstreamR s = s `seq` New (MVector.unstreamR s) -transformR :: (forall m. Monad m => MStream m a -> MStream m a) -> New a -> New a+transformR :: Vector v a =>+        (forall m. Monad m => MStream m a -> MStream m a) -> New v a -> New v a {-# INLINE_STREAM transformR #-} transformR f (New p) = New (MVector.transformR f =<< p) @@ -93,35 +105,35 @@   #-} -slice :: Int -> Int -> New a -> New a+slice :: Vector v a => Int -> Int -> New v a -> New v a {-# INLINE_STREAM slice #-} slice i n m = apply (MVector.slice i n) m -init :: New a -> New a+init :: Vector v a => New v a -> New v a {-# INLINE_STREAM init #-} init m = apply MVector.init m -tail :: New a -> New a+tail :: Vector v a => New v a -> New v a {-# INLINE_STREAM tail #-} tail m = apply MVector.tail m -take :: Int -> New a -> New a+take :: Vector v a => Int -> New v a -> New v a {-# INLINE_STREAM take #-} take n m = apply (MVector.take n) m -drop :: Int -> New a -> New a+drop :: Vector v a => Int -> New v a -> New v a {-# INLINE_STREAM drop #-} drop n m = apply (MVector.drop n) m -unsafeSlice :: Int -> Int -> New a -> New a+unsafeSlice :: Vector v a => Int -> Int -> New v a -> New v a {-# INLINE_STREAM unsafeSlice #-} unsafeSlice i n m = apply (MVector.unsafeSlice i n) m -unsafeInit :: New a -> New a+unsafeInit :: Vector v a => New v a -> New v a {-# INLINE_STREAM unsafeInit #-} unsafeInit m = apply MVector.unsafeInit m -unsafeTail :: New a -> New a+unsafeTail :: Vector v a => New v a -> New v a {-# INLINE_STREAM unsafeTail #-} unsafeTail m = apply MVector.unsafeTail m @@ -152,24 +164,4 @@   unsafeTail (unstream s) = unstream (Stream.tail s)    #-}--unsafeAccum :: (a -> b -> a) -> New a -> Stream (Int, b) -> New a-{-# INLINE_STREAM unsafeAccum #-}-unsafeAccum f m s = s `seq` modify m (\v -> MVector.unsafeAccum f v s)--accum :: (a -> b -> a) -> New a -> Stream (Int, b) -> New a-{-# INLINE_STREAM accum #-}-accum f m s = s `seq` modify m (\v -> MVector.accum f v s)--unsafeUpdate :: New a -> Stream (Int, a) -> New a-{-# INLINE_STREAM unsafeUpdate #-}-unsafeUpdate m s = s `seq` modify m (\v -> MVector.unsafeUpdate v s)--update :: New a -> Stream (Int, a) -> New a-{-# INLINE_STREAM update #-}-update m s = s `seq` modify m (\v -> MVector.update v s)--reverse :: New a -> New a-{-# INLINE_STREAM reverse #-}-reverse m = modify m (MVector.reverse)
Data/Vector/Internal/Check.hs view
@@ -54,8 +54,8 @@ error file line kind loc msg   = P.error $ unlines $       (if kind == Internal-         then (["*** Internal error in package vector"-               ,"*** Please submit a bug report"]++)+         then (["*** Internal error in package vector ***"+               ,"*** Please submit a bug report at http://trac.haskell.org/vector"]++)          else id) $       [ file ++ ":" ++ show line ++ " (" ++ loc ++ "): " ++ msg ]
Data/Vector/Mutable.hs view
@@ -1,8 +1,8 @@-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, TypeFamilies #-}+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}  -- | -- Module      : Data.Vector.Mutable--- Copyright   : (c) Roman Leshchinskiy 2008-2009+-- Copyright   : (c) Roman Leshchinskiy 2008-2010 -- License     : BSD-style -- -- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au>@@ -28,16 +28,18 @@ import qualified Data.Vector.Generic.Mutable as G import           Data.Primitive.Array import           Control.Monad.Primitive-import           Control.Monad.ST ( ST )  import Prelude hiding ( length, read ) +import Data.Typeable ( Typeable )+ #include "vector.h"  -- | Mutable boxed vectors keyed on the monad they live in ('IO' or @'ST' s@). data MVector s a = MVector {-# UNPACK #-} !Int                            {-# UNPACK #-} !Int                            {-# UNPACK #-} !(MutableArray s a)+        deriving ( Typeable )  type IOVector = MVector RealWorld type STVector s = MVector s
Data/Vector/Primitive.hs view
@@ -1,8 +1,8 @@-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeFamilies #-}+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeFamilies, ScopedTypeVariables, Rank2Types #-}  -- | -- Module      : Data.Vector.Primitive--- Copyright   : (c) Roman Leshchinskiy 2008-2009+-- Copyright   : (c) Roman Leshchinskiy 2008-2010 -- License     : BSD-style -- -- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au>@@ -19,7 +19,7 @@   length, null,    -- * Construction-  empty, singleton, cons, snoc, replicate, generate, (++), copy,+  empty, singleton, cons, snoc, replicate, generate, (++), force,    -- * Accessing individual elements   (!), head, last, indexM, headM, lastM,@@ -61,7 +61,7 @@   minIndex, minIndexBy, maxIndex, maxIndexBy,    -- * Unfolding-  unfoldr,+  unfoldr, unfoldrN,    -- * Scans   prescanl, prescanl',@@ -75,15 +75,25 @@   enumFromN, enumFromStepN, enumFromTo, enumFromThenTo,    -- * Conversion to/from lists-  toList, fromList+  toList, fromList, fromListN,++  -- * Monadic operations+  replicateM, mapM, mapM_, forM, forM_, zipWithM, zipWithM_, filterM,+  foldM, foldM', fold1M, fold1M',++  -- * Destructive operations+  create, modify, copy, unsafeCopy ) where  import qualified Data.Vector.Generic           as G import           Data.Vector.Primitive.Mutable ( MVector(..) )+import qualified Data.Vector.Fusion.Stream as Stream import           Data.Primitive.ByteArray-import           Data.Primitive ( Prim )+import           Data.Primitive ( Prim, sizeOf )  import Control.Monad ( liftM )+import Control.Monad.ST ( ST )+import Control.Monad.Primitive  import Prelude hiding ( length, null,                         replicate, (++),@@ -96,18 +106,31 @@                         foldl, foldl1, foldr, foldr1,                         all, any, sum, product, minimum, maximum,                         scanl, scanl1, scanr, scanr1,-                        enumFromTo, enumFromThenTo )+                        enumFromTo, enumFromThenTo,+                        mapM, mapM_ )  import qualified Prelude +import Data.Typeable ( Typeable )+import Data.Data     ( Data(..) )+ -- | Unboxed vectors of primitive types data Vector a = Vector {-# UNPACK #-} !Int                        {-# UNPACK #-} !Int                        {-# UNPACK #-} !ByteArray+  deriving ( Typeable )  instance (Show a, Prim a) => Show (Vector a) where     show = (Prelude.++ " :: Data.Vector.Primitive.Vector") . ("fromList " Prelude.++) . show . toList +instance (Data a, Prim a) => Data (Vector a) where+  gfoldl       = G.gfoldl+  toConstr _   = error "toConstr"+  gunfold _ _  = error "gunfold"+  dataTypeOf _ = G.mkType "Data.Vector.Primitive.Vector"+  dataCast1    = G.dataCast++ type instance G.Mutable Vector = MVector  instance Prim a => G.Vector Vector a where@@ -124,17 +147,40 @@   {-# INLINE basicUnsafeIndexM #-}   basicUnsafeIndexM (Vector i _ arr) j = return (indexByteArray arr (i+j)) +  {-# INLINE basicUnsafeCopy #-}+  basicUnsafeCopy (MVector i n dst) (Vector j _ src)+    = memcpyByteArray' dst (i * sz) src (j * sz) (n * sz)+    where+      sz = sizeOf (undefined :: a)+   {-# INLINE elemseq #-}   elemseq _ = seq +-- See http://trac.haskell.org/vector/ticket/12 instance (Prim a, Eq a) => Eq (Vector a) where   {-# INLINE (==) #-}-  (==) = G.eq+  xs == ys = Stream.eq (G.stream xs) (G.stream ys) +  {-# INLINE (/=) #-}+  xs /= ys = not (Stream.eq (G.stream xs) (G.stream ys))++-- See http://trac.haskell.org/vector/ticket/12 instance (Prim a, Ord a) => Ord (Vector a) where   {-# INLINE compare #-}-  compare = G.cmp+  compare xs ys = Stream.cmp (G.stream xs) (G.stream ys) +  {-# INLINE (<) #-}+  xs < ys = Stream.cmp (G.stream xs) (G.stream ys) == LT++  {-# INLINE (<=) #-}+  xs <= ys = Stream.cmp (G.stream xs) (G.stream ys) /= GT++  {-# INLINE (>) #-}+  xs > ys = Stream.cmp (G.stream xs) (G.stream ys) == GT++  {-# INLINE (>=) #-}+  xs >= ys = Stream.cmp (G.stream xs) (G.stream ys) /= LT+ -- Length -- ------ @@ -187,9 +233,9 @@ (++) = (G.++)  -- | Create a copy of a vector. Useful when dealing with slices.-copy :: Prim a => Vector a -> Vector a-{-# INLINE copy #-}-copy = G.copy+force :: Prim a => Vector a -> Vector a+{-# INLINE force #-}+force = G.force  -- Accessing individual elements -- -----------------------------@@ -657,10 +703,27 @@ -- Unfolding -- --------- +-- | The 'unfoldr' function is a \`dual\' to 'foldr': while 'foldr'+-- reduces a vector to a summary value, 'unfoldr' builds a list from+-- a seed value.  The function takes the element and returns 'Nothing'+-- if it is done generating the vector or returns 'Just' @(a,b)@, in which+-- case, @a@ is a prepended to the vector and @b@ is used as the next+-- element in a recursive call.+--+-- A simple use of unfoldr:+--+-- > unfoldr (\b -> if b == 0 then Nothing else Just (b, b-1)) 10+-- >  [10,9,8,7,6,5,4,3,2,1]+-- unfoldr :: Prim a => (b -> Maybe (a, b)) -> b -> Vector a {-# INLINE unfoldr #-} unfoldr = G.unfoldr +-- | Unfold at most @n@ elements+unfoldrN :: Prim a => Int -> (b -> Maybe (a, b)) -> b -> Vector a+{-# INLINE unfoldrN #-}+unfoldrN = G.unfoldrN+ -- Scans -- ----- @@ -789,4 +852,108 @@ fromList :: Prim a => [a] -> Vector a {-# INLINE fromList #-} fromList = G.fromList++-- | Convert the first @n@ elements of a list to a vector+--+-- > fromListN n xs = fromList (take n xs)+fromListN :: Prim a => Int -> [a] -> Vector a+{-# INLINE fromListN #-}+fromListN = G.fromListN++-- Monadic operations+-- ------------------++-- | Perform the monadic action the given number of times and store the+-- results in a vector.+replicateM :: (Monad m, Prim a) => Int -> m a -> m (Vector a)+{-# INLINE replicateM #-}+replicateM = G.replicateM++-- | Apply the monadic action to all elements of the vector, yielding a vector+-- of results+mapM :: (Monad m, Prim a, Prim b) => (a -> m b) -> Vector a -> m (Vector b)+{-# INLINE mapM #-}+mapM = G.mapM++-- | Apply the monadic action to all elements of a vector and ignore the+-- results+mapM_ :: (Monad m, Prim a) => (a -> m b) -> Vector a -> m ()+{-# INLINE mapM_ #-}+mapM_ = G.mapM_++-- | Apply the monadic action to all elements of the vector, yielding a vector+-- of results+forM :: (Monad m, Prim a, Prim b) => Vector a -> (a -> m b) -> m (Vector b)+{-# INLINE forM #-}+forM = G.forM++-- | Apply the monadic action to all elements of a vector and ignore the+-- results+forM_ :: (Monad m, Prim a) => Vector a -> (a -> m b) -> m ()+{-# INLINE forM_ #-}+forM_ = G.forM_++-- | Zip the two vectors with the monadic action and yield a vector of results+zipWithM :: (Monad m, Prim a, Prim b, Prim c)+         => (a -> b -> m c) -> Vector a -> Vector b -> m (Vector c)+{-# INLINE zipWithM #-}+zipWithM = G.zipWithM++-- | Zip the two vectors with the monadic action and ignore the results+zipWithM_ :: (Monad m, Prim a, Prim b)+          => (a -> b -> m c) -> Vector a -> Vector b -> m ()+{-# INLINE zipWithM_ #-}+zipWithM_ = G.zipWithM_++-- | Drop elements that do not satisfy the monadic predicate+filterM :: (Monad m, Prim a) => (a -> m Bool) -> Vector a -> m (Vector a)+{-# INLINE filterM #-}+filterM = G.filterM++-- | Monadic fold+foldM :: (Monad m, Prim b) => (a -> b -> m a) -> a -> Vector b -> m a+{-# INLINE foldM #-}+foldM = G.foldM++-- | Monadic fold over non-empty vectors+fold1M :: (Monad m, Prim a) => (a -> a -> m a) -> Vector a -> m a+{-# INLINE fold1M #-}+fold1M = G.fold1M++-- | Monadic fold with strict accumulator+foldM' :: (Monad m, Prim b) => (a -> b -> m a) -> a -> Vector b -> m a+{-# INLINE foldM' #-}+foldM' = G.foldM'++-- | Monad fold over non-empty vectors with strict accumulator+fold1M' :: (Monad m, Prim a) => (a -> a -> m a) -> Vector a -> m a+{-# INLINE fold1M' #-}+fold1M' = G.fold1M'++-- Destructive operations+-- ----------------------++-- | Destructively initialise a vector.+create :: Prim a => (forall s. ST s (MVector s a)) -> Vector a+{-# INLINE create #-}+create = G.create++-- | Apply a destructive operation to a vector. The operation is applied to a+-- copy of the vector unless it can be safely performed in place.+modify :: Prim a => (forall s. MVector s a -> ST s ()) -> Vector a -> Vector a+{-# INLINE modify #-}+modify = G.modify++-- | Copy an immutable vector into a mutable one. The two vectors must have+-- the same length. This is not checked.+unsafeCopy+  :: (Prim a, PrimMonad m) => MVector (PrimState m) a -> Vector a -> m ()+{-# INLINE unsafeCopy #-}+unsafeCopy = G.unsafeCopy+           +-- | Copy an immutable vector into a mutable one. The two vectors must have the+-- same length.+copy :: (Prim a, PrimMonad m) => MVector (PrimState m) a -> Vector a -> m ()+{-# INLINE copy #-}+copy = G.copy
Data/Vector/Primitive/Mutable.hs view
@@ -1,9 +1,8 @@-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, ScopedTypeVariables,-             FlexibleContexts #-}+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, ScopedTypeVariables #-}  -- | -- Module      : Data.Vector.Primitive.Mutable--- Copyright   : (c) Roman Leshchinskiy 2008-2009+-- Copyright   : (c) Roman Leshchinskiy 2008-2010 -- License     : BSD-style -- -- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au>@@ -30,17 +29,19 @@ import           Data.Primitive.ByteArray import           Data.Primitive ( Prim, sizeOf ) import           Control.Monad.Primitive-import           Control.Monad.ST ( ST ) import           Control.Monad ( liftM )  import Prelude hiding( length, read ) +import Data.Typeable ( Typeable )+ #include "vector.h"  -- | Mutable vectors of primitive types. data MVector s a = MVector {-# UNPACK #-} !Int                            {-# UNPACK #-} !Int                            {-# UNPACK #-} !(MutableByteArray s)+        deriving ( Typeable )  type IOVector = MVector RealWorld type STVector s = MVector s@@ -66,6 +67,12 @@    {-# INLINE basicUnsafeWrite #-}   basicUnsafeWrite (MVector i n arr) j x = writeByteArray arr (i+j) x++  {-# INLINE basicUnsafeCopy #-}+  basicUnsafeCopy (MVector i n dst) (MVector j _ src)+    = memcpyByteArray dst (i * sz) src (j * sz) (n * sz)+    where+      sz = sizeOf (undefined :: a)  -- | Yield a part of the mutable vector without copying it. No bounds checks -- are performed.
Data/Vector/Storable.hs view
@@ -1,8 +1,8 @@-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, TypeFamilies #-}+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, TypeFamilies, Rank2Types #-}  -- | -- Module      : Data.Vector.Storable--- Copyright   : (c) Roman Leshchinskiy 2009-10+-- Copyright   : (c) Roman Leshchinskiy 2009-2010 -- License     : BSD-style -- -- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au>@@ -19,7 +19,7 @@   length, null,    -- * Construction-  empty, singleton, cons, snoc, replicate, generate, (++), copy,+  empty, singleton, cons, snoc, replicate, generate, (++), force,    -- * Accessing individual elements   (!), head, last, indexM, headM, lastM,@@ -61,7 +61,7 @@   minIndex, minIndexBy, maxIndex, maxIndexBy,    -- * Unfolding-  unfoldr,+  unfoldr, unfoldrN,    -- * Scans   prescanl, prescanl',@@ -75,8 +75,15 @@   enumFromN, enumFromStepN, enumFromTo, enumFromThenTo,    -- * Conversion to/from lists-  toList, fromList,+  toList, fromList, fromListN, +  -- * Monadic operations+  replicateM, mapM, mapM_, forM, forM_, zipWithM, zipWithM_, filterM,+  foldM, foldM', fold1M, fold1M',++  -- * Destructive operations+  create, modify, copy, unsafeCopy,+   -- * Accessing the underlying memory   unsafeFromForeignPtr, unsafeToForeignPtr, unsafeWith ) where@@ -84,13 +91,15 @@ import qualified Data.Vector.Generic          as G import           Data.Vector.Storable.Mutable ( MVector(..) ) import Data.Vector.Storable.Internal+import qualified Data.Vector.Fusion.Stream as Stream  import Foreign.Storable import Foreign.ForeignPtr import Foreign.Ptr-import Foreign.Marshal.Array ( advancePtr )+import Foreign.Marshal.Array ( advancePtr, copyArray ) -import Control.Monad.ST ( ST, runST )+import Control.Monad.ST ( ST )+import Control.Monad.Primitive  import Prelude hiding ( length, null,                         replicate, (++),@@ -103,16 +112,21 @@                         foldl, foldl1, foldr, foldr1,                         all, any, and, or, sum, product, minimum, maximum,                         scanl, scanl1, scanr, scanr1,-                        enumFromTo, enumFromThenTo )+                        enumFromTo, enumFromThenTo,+                        mapM, mapM_ )  import qualified Prelude +import Data.Typeable ( Typeable )+import Data.Data     ( Data(..) )+ #include "vector.h"  -- | 'Storable'-based vectors-data Vector a = Vector {-# UNPACK #-} !Int+data Vector a = Vector {-# UNPACK #-} !(Ptr a)                        {-# UNPACK #-} !Int                        {-# UNPACK #-} !(ForeignPtr a)+        deriving ( Typeable )  instance (Show a, Storable a) => Show (Vector a) where   show = (Prelude.++ " :: Data.Vector.Storable.Vector")@@ -120,30 +134,66 @@        . show        . toList +instance (Data a, Storable a) => Data (Vector a) where+  gfoldl       = G.gfoldl+  toConstr _   = error "toConstr"+  gunfold _ _  = error "gunfold"+  dataTypeOf _ = G.mkType "Data.Vector.Storable.Vector"+  dataCast1    = G.dataCast+ type instance G.Mutable Vector = MVector  instance Storable a => G.Vector Vector a where   {-# INLINE unsafeFreeze #-}-  unsafeFreeze (MVector i n p) = return $ Vector i n p+  unsafeFreeze (MVector p n fp) = return $ Vector p n fp    {-# INLINE basicLength #-}   basicLength (Vector _ n _) = n    {-# INLINE basicUnsafeSlice #-}-  basicUnsafeSlice j n (Vector i _ p) = Vector (i+j) n p+  basicUnsafeSlice i n (Vector p _ fp) = Vector (p `advancePtr` i) n fp    {-# INLINE basicUnsafeIndexM #-}-  basicUnsafeIndexM (Vector i _ p) j = return-                                     . inlinePerformIO-                                     $ withForeignPtr p (`peekElemOff` (i+j))+  basicUnsafeIndexM (Vector p _ fp) i = return+                                      . unsafeInlineIO+                                      $ withForeignPtr fp $ \_ ->+                                        peekElemOff p i +  {-# INLINE basicUnsafeCopy #-}+  basicUnsafeCopy (MVector p n fp) (Vector q _ fq)+    = unsafePrimToPrim+    $ withForeignPtr fp $ \_ ->+      withForeignPtr fq $ \_ ->+      copyArray p q n+   {-# INLINE elemseq #-}   elemseq _ = seq +-- See http://trac.haskell.org/vector/ticket/12 instance (Storable a, Eq a) => Eq (Vector a) where   {-# INLINE (==) #-}-  (==) = G.eq+  xs == ys = Stream.eq (G.stream xs) (G.stream ys) +  {-# INLINE (/=) #-}+  xs /= ys = not (Stream.eq (G.stream xs) (G.stream ys))++-- See http://trac.haskell.org/vector/ticket/12+instance (Storable a, Ord a) => Ord (Vector a) where+  {-# INLINE compare #-}+  compare xs ys = Stream.cmp (G.stream xs) (G.stream ys)++  {-# INLINE (<) #-}+  xs < ys = Stream.cmp (G.stream xs) (G.stream ys) == LT++  {-# INLINE (<=) #-}+  xs <= ys = Stream.cmp (G.stream xs) (G.stream ys) /= GT++  {-# INLINE (>) #-}+  xs > ys = Stream.cmp (G.stream xs) (G.stream ys) == GT++  {-# INLINE (>=) #-}+  xs >= ys = Stream.cmp (G.stream xs) (G.stream ys) /= LT+ {- eq_memcmp :: forall a. Storable a => Vector a -> Vector a -> Bool {-# INLINE_STREAM eq_memcmp #-}@@ -165,9 +215,6 @@  #-} -} -instance (Storable a, Ord a) => Ord (Vector a) where-  {-# INLINE compare #-}-  compare = G.cmp  -- Length -- ------@@ -221,9 +268,9 @@ (++) = (G.++)  -- | Create a copy of a vector. Useful when dealing with slices.-copy :: Storable a => Vector a -> Vector a-{-# INLINE copy #-}-copy = G.copy+force :: Storable a => Vector a -> Vector a+{-# INLINE force #-}+force = G.force  -- Accessing individual elements -- -----------------------------@@ -704,10 +751,27 @@ -- Unfolding -- --------- +-- | The 'unfoldr' function is a \`dual\' to 'foldr': while 'foldr'+-- reduces a vector to a summary value, 'unfoldr' builds a list from+-- a seed value.  The function takes the element and returns 'Nothing'+-- if it is done generating the vector or returns 'Just' @(a,b)@, in which+-- case, @a@ is a prepended to the vector and @b@ is used as the next+-- element in a recursive call.+--+-- A simple use of unfoldr:+--+-- > unfoldr (\b -> if b == 0 then Nothing else Just (b, b-1)) 10+-- >  [10,9,8,7,6,5,4,3,2,1]+-- unfoldr :: Storable a => (b -> Maybe (a, b)) -> b -> Vector a {-# INLINE unfoldr #-} unfoldr = G.unfoldr +-- | Unfold at most @n@ elements+unfoldrN :: Storable a => Int -> (b -> Maybe (a, b)) -> b -> Vector a+{-# INLINE unfoldrN #-}+unfoldrN = G.unfoldrN+ -- Scans -- ----- @@ -841,28 +905,134 @@ {-# INLINE fromList #-} fromList = G.fromList +-- | Convert the first @n@ elements of a list to a vector+--+-- > fromListN n xs = fromList (take n xs)+fromListN :: Storable a => Int -> [a] -> Vector a+{-# INLINE fromListN #-}+fromListN = G.fromListN++-- Monadic operations+-- ------------------++-- | Perform the monadic action the given number of times and store the+-- results in a vector.+replicateM :: (Monad m, Storable a) => Int -> m a -> m (Vector a)+{-# INLINE replicateM #-}+replicateM = G.replicateM++-- | Apply the monadic action to all elements of the vector, yielding a vector+-- of results+mapM :: (Monad m, Storable a, Storable b) => (a -> m b) -> Vector a -> m (Vector b)+{-# INLINE mapM #-}+mapM = G.mapM++-- | Apply the monadic action to all elements of a vector and ignore the+-- results+mapM_ :: (Monad m, Storable a) => (a -> m b) -> Vector a -> m ()+{-# INLINE mapM_ #-}+mapM_ = G.mapM_++-- | Apply the monadic action to all elements of the vector, yielding a vector+-- of results+forM :: (Monad m, Storable a, Storable b) => Vector a -> (a -> m b) -> m (Vector b)+{-# INLINE forM #-}+forM = G.forM++-- | Apply the monadic action to all elements of a vector and ignore the+-- results+forM_ :: (Monad m, Storable a) => Vector a -> (a -> m b) -> m ()+{-# INLINE forM_ #-}+forM_ = G.forM_++-- | Zip the two vectors with the monadic action and yield a vector of results+zipWithM :: (Monad m, Storable a, Storable b, Storable c)+         => (a -> b -> m c) -> Vector a -> Vector b -> m (Vector c)+{-# INLINE zipWithM #-}+zipWithM = G.zipWithM++-- | Zip the two vectors with the monadic action and ignore the results+zipWithM_ :: (Monad m, Storable a, Storable b)+          => (a -> b -> m c) -> Vector a -> Vector b -> m ()+{-# INLINE zipWithM_ #-}+zipWithM_ = G.zipWithM_++-- | Drop elements that do not satisfy the monadic predicate+filterM :: (Monad m, Storable a) => (a -> m Bool) -> Vector a -> m (Vector a)+{-# INLINE filterM #-}+filterM = G.filterM++-- | Monadic fold+foldM :: (Monad m, Storable b) => (a -> b -> m a) -> a -> Vector b -> m a+{-# INLINE foldM #-}+foldM = G.foldM++-- | Monadic fold over non-empty vectors+fold1M :: (Monad m, Storable a) => (a -> a -> m a) -> Vector a -> m a+{-# INLINE fold1M #-}+fold1M = G.fold1M++-- | Monadic fold with strict accumulator+foldM' :: (Monad m, Storable b) => (a -> b -> m a) -> a -> Vector b -> m a+{-# INLINE foldM' #-}+foldM' = G.foldM'++-- | Monad fold over non-empty vectors with strict accumulator+fold1M' :: (Monad m, Storable a) => (a -> a -> m a) -> Vector a -> m a+{-# INLINE fold1M' #-}+fold1M' = G.fold1M'++-- Destructive operations+-- ----------------------++-- | Destructively initialise a vector.+create :: Storable a => (forall s. ST s (MVector s a)) -> Vector a+{-# INLINE create #-}+create = G.create++-- | Apply a destructive operation to a vector. The operation is applied to a+-- copy of the vector unless it can be safely performed in place.+modify+  :: Storable a => (forall s. MVector s a -> ST s ()) -> Vector a -> Vector a+{-# INLINE modify #-}+modify = G.modify++-- | Copy an immutable vector into a mutable one. The two vectors must have+-- the same length. This is not checked.+unsafeCopy+  :: (Storable a, PrimMonad m) => MVector (PrimState m) a -> Vector a -> m ()+{-# INLINE unsafeCopy #-}+unsafeCopy = G.unsafeCopy+           +-- | Copy an immutable vector into a mutable one. The two vectors must have the+-- same length.+copy :: (Storable a, PrimMonad m) => MVector (PrimState m) a -> Vector a -> m ()+{-# INLINE copy #-}+copy = G.copy+ -- Accessing the underlying memory -- -------------------------------  -- | Create a vector from a 'ForeignPtr' with an offset and a length. The data -- may not be modified through the 'ForeignPtr' afterwards.-unsafeFromForeignPtr :: ForeignPtr a    -- ^ pointer+unsafeFromForeignPtr :: Storable a+                     => ForeignPtr a    -- ^ pointer                      -> Int             -- ^ offset                      -> Int             -- ^ length                      -> Vector a {-# INLINE unsafeFromForeignPtr #-}-unsafeFromForeignPtr p i n = Vector i n p+unsafeFromForeignPtr fp i n = Vector (offsetToPtr fp i) n fp  -- | Yield the underlying 'ForeignPtr' together with the offset to the data -- and its length. The data may not be modified through the 'ForeignPtr'.-unsafeToForeignPtr :: Vector a -> (ForeignPtr a, Int, Int)+unsafeToForeignPtr :: Storable a => Vector a -> (ForeignPtr a, Int, Int) {-# INLINE unsafeToForeignPtr #-}-unsafeToForeignPtr (Vector i n p) = (p,i,n)+unsafeToForeignPtr (Vector p n fp) = (fp, ptrToOffset fp p, 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 i n fp) m-  = withForeignPtr fp $ \p -> m (p `advancePtr` i)+unsafeWith (Vector p n fp) m = withForeignPtr fp $ \_ -> m p+
Data/Vector/Storable/Internal.hs view
@@ -1,8 +1,8 @@-{-# LANGUAGE MagicHash, UnboxedTuples #-}+{-# LANGUAGE MagicHash, UnboxedTuples, ScopedTypeVariables #-}  -- | -- Module      : Data.Vector.Storable.Internal--- Copyright   : (c) Roman Leshchinskiy 2009+-- Copyright   : (c) Roman Leshchinskiy 2009-2010 -- License     : BSD-style -- -- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au>@@ -12,14 +12,28 @@ -- Ugly internal utility functions for implementing 'Storable'-based vectors. -- -module Data.Vector.Storable.Internal-where+module Data.Vector.Storable.Internal (+  ptrToOffset, offsetToPtr+) where -import GHC.Base         ( realWorld# )-import GHC.IOBase       ( IO(..) )+import Control.Monad.Primitive ( unsafeInlineIO )+import Foreign.Storable+import Foreign.ForeignPtr+import Foreign.Ptr+import Foreign.Marshal.Array ( advancePtr )+import GHC.Base         ( quotInt ) --- Stolen from the ByteString library-inlinePerformIO :: IO a -> a-{-# INLINE inlinePerformIO #-}-inlinePerformIO (IO m) = case m realWorld# of (# _, r #) -> r+distance :: forall a. Storable a => Ptr a -> Ptr a -> Int+{-# INLINE distance #-}+distance p q = (p `minusPtr` q) `quotInt` sizeOf (undefined :: a)++ptrToOffset :: Storable a => ForeignPtr a -> Ptr a -> Int+{-# INLINE ptrToOffset #-}+ptrToOffset fp q = unsafeInlineIO+                 $ withForeignPtr fp $ \p -> return (distance p q)++offsetToPtr :: Storable a => ForeignPtr a -> Int -> Ptr a+{-# INLINE offsetToPtr #-}+offsetToPtr fp i = unsafeInlineIO+                 $ withForeignPtr fp $ \p -> return (advancePtr p i)
Data/Vector/Storable/Mutable.hs view
@@ -29,22 +29,27 @@ ) where  import qualified Data.Vector.Generic.Mutable as G+import Data.Vector.Storable.Internal  import Foreign.Storable import Foreign.ForeignPtr import Foreign.Ptr-import Foreign.Marshal.Array ( advancePtr )+import Foreign.Marshal.Array ( advancePtr, copyArray )+import Foreign.C.Types ( CInt )  import Control.Monad.Primitive  import Prelude hiding( length, read ) +import Data.Typeable ( Typeable )+ #include "vector.h"  -- | Mutable 'Storable'-based vectors-data MVector s a = MVector {-# UNPACK #-} !Int+data MVector s a = MVector {-# UNPACK #-} !(Ptr a)                            {-# UNPACK #-} !Int                            {-# UNPACK #-} !(ForeignPtr a)+        deriving ( Typeable )  type IOVector = MVector RealWorld type STVector s = MVector s@@ -54,51 +59,63 @@   basicLength (MVector _ n _) = n    {-# INLINE basicUnsafeSlice #-}-  basicUnsafeSlice j m (MVector i n p) = MVector (i+j) m p+  basicUnsafeSlice j m (MVector p n fp) = MVector (p `advancePtr` j) m fp -  -- FIXME: implement this properly+  -- FIXME: this relies on non-portable pointer comparisons   {-# INLINE basicOverlaps #-}-  basicOverlaps (MVector i m p) (MVector j n q) = True+  basicOverlaps (MVector p m _) (MVector q n _)+    = between p q (q `advancePtr` n) || between q p (p `advancePtr` m)+    where+      between x y z = x >= y && x < z    {-# INLINE basicUnsafeNew #-}   basicUnsafeNew n     = unsafePrimToPrim-    $ MVector 0 n `fmap` mallocForeignPtrArray n+    $ do+        fp <- mallocForeignPtrArray n+        withForeignPtr fp $ \p -> return $ MVector p n fp    {-# INLINE basicUnsafeRead #-}-  basicUnsafeRead (MVector i n p) j+  basicUnsafeRead (MVector p _ fp) i     = unsafePrimToPrim-    $ withForeignPtr p $ \ptr -> peekElemOff ptr (i+j)+    $ withForeignPtr fp $ \_ -> peekElemOff p i    {-# INLINE basicUnsafeWrite #-}-  basicUnsafeWrite (MVector i n p) j x+  basicUnsafeWrite (MVector p n fp) i x     = unsafePrimToPrim-    $ withForeignPtr p $ \ptr -> pokeElemOff ptr (i+j) x+    $ withForeignPtr fp $ \_ -> pokeElemOff p i x +  {-# INLINE basicUnsafeCopy #-}+  basicUnsafeCopy (MVector p n fp) (MVector q _ fq)+    = unsafePrimToPrim+    $ withForeignPtr fp $ \_ ->+      withForeignPtr fq $ \_ ->+      copyArray p q n+ -- | Create a mutable vector from a 'ForeignPtr' with an offset and a length. -- Modifying data through the 'ForeignPtr' afterwards is unsafe if the vector -- could have been frozen before the modification.-unsafeFromForeignPtr :: ForeignPtr a    -- ^ pointer+unsafeFromForeignPtr :: Storable a+                     => ForeignPtr a    -- ^ pointer                      -> Int             -- ^ offset                      -> Int             -- ^ length                      -> MVector s a {-# INLINE unsafeFromForeignPtr #-}-unsafeFromForeignPtr p i n = MVector i n p+unsafeFromForeignPtr fp i n = MVector (offsetToPtr fp i) n 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 :: MVector s a -> (ForeignPtr a, Int, Int)+unsafeToForeignPtr :: Storable a => MVector s a -> (ForeignPtr a, Int, Int) {-# INLINE unsafeToForeignPtr #-}-unsafeToForeignPtr (MVector i n p) = (p,i,n)+unsafeToForeignPtr (MVector p n fp) = (fp, ptrToOffset fp p, 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 i n fp) m-  = withForeignPtr fp $ \p -> m (p `advancePtr` i)+unsafeWith (MVector p n fp) m = withForeignPtr fp $ \_ -> m p  -- | Yield a part of the mutable vector without copying it. No bounds checks -- are performed.
Data/Vector/Unboxed.hs view
@@ -1,6 +1,8 @@+{-# LANGUAGE Rank2Types #-}+ -- | -- Module      : Data.Vector.Unboxed--- Copyright   : (c) Roman Leshchinskiy 2009+-- Copyright   : (c) Roman Leshchinskiy 2009-2010 -- License     : BSD-style -- -- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au>@@ -17,7 +19,7 @@   length, null,    -- * Construction-  empty, singleton, cons, snoc, replicate, generate, (++), copy,+  empty, singleton, cons, snoc, replicate, generate, (++), force,    -- * Accessing individual elements   (!), head, last, indexM, headM, lastM,@@ -63,7 +65,7 @@   minIndex, minIndexBy, maxIndex, maxIndexBy,    -- * Unfolding-  unfoldr,+  unfoldr, unfoldrN,    -- * Scans   prescanl, prescanl',@@ -77,13 +79,23 @@   enumFromN, enumFromStepN, enumFromTo, enumFromThenTo,    -- * Conversion to/from lists-  toList, fromList+  toList, fromList, fromListN,++  -- * Monadic operations+  replicateM, mapM, mapM_, forM, forM_, zipWithM, zipWithM_, filterM,+  foldM, foldM', fold1M, fold1M',++  -- * Destructive operations+  create, modify, copy, unsafeCopy ) where  import Data.Vector.Unboxed.Base import qualified Data.Vector.Generic as G import qualified Data.Vector.Fusion.Stream as Stream +import Control.Monad.ST ( ST )+import Control.Monad.Primitive+ import Prelude hiding ( length, null,                         replicate, (++),                         head, last,@@ -95,19 +107,37 @@                         foldl, foldl1, foldr, foldr1,                         all, any, and, or, sum, product, minimum, maximum,                         scanl, scanl1, scanr, scanr1,-                        enumFromTo, enumFromThenTo )+                        enumFromTo, enumFromThenTo,+                        mapM, mapM_ ) import qualified Prelude  #include "vector.h" +-- See http://trac.haskell.org/vector/ticket/12 instance (Unbox a, Eq a) => Eq (Vector a) where   {-# INLINE (==) #-}-  (==) = G.eq+  xs == ys = Stream.eq (G.stream xs) (G.stream ys) +  {-# INLINE (/=) #-}+  xs /= ys = not (Stream.eq (G.stream xs) (G.stream ys))++-- See http://trac.haskell.org/vector/ticket/12 instance (Unbox a, Ord a) => Ord (Vector a) where   {-# INLINE compare #-}-  compare = G.cmp+  compare xs ys = Stream.cmp (G.stream xs) (G.stream ys) +  {-# INLINE (<) #-}+  xs < ys = Stream.cmp (G.stream xs) (G.stream ys) == LT++  {-# INLINE (<=) #-}+  xs <= ys = Stream.cmp (G.stream xs) (G.stream ys) /= GT++  {-# INLINE (>) #-}+  xs > ys = Stream.cmp (G.stream xs) (G.stream ys) == GT++  {-# INLINE (>=) #-}+  xs >= ys = Stream.cmp (G.stream xs) (G.stream ys) /= LT+ instance (Show a, Unbox a) => Show (Vector a) where     show = (Prelude.++ " :: Data.Vector.Unboxed.Vector") . ("fromList " Prelude.++) . show . toList @@ -163,9 +193,9 @@ (++) = (G.++)  -- | Create a copy of a vector. Useful when dealing with slices.-copy :: Unbox a => Vector a -> Vector a-{-# INLINE copy #-}-copy = G.copy+force :: Unbox a => Vector a -> Vector a+{-# INLINE force #-}+force = G.force  -- Accessing individual elements -- -----------------------------@@ -659,10 +689,27 @@ -- Unfolding -- --------- +-- | The 'unfoldr' function is a \`dual\' to 'foldr': while 'foldr'+-- reduces a vector to a summary value, 'unfoldr' builds a list from+-- a seed value.  The function takes the element and returns 'Nothing'+-- if it is done generating the vector or returns 'Just' @(a,b)@, in which+-- case, @a@ is a prepended to the vector and @b@ is used as the next+-- element in a recursive call.+--+-- A simple use of unfoldr:+--+-- > unfoldr (\b -> if b == 0 then Nothing else Just (b, b-1)) 10+-- >  [10,9,8,7,6,5,4,3,2,1]+-- unfoldr :: Unbox a => (b -> Maybe (a, b)) -> b -> Vector a {-# INLINE unfoldr #-} unfoldr = G.unfoldr +-- | Unfold at most @n@ elements+unfoldrN :: Unbox a => Int -> (b -> Maybe (a, b)) -> b -> Vector a+{-# INLINE unfoldrN #-}+unfoldrN = G.unfoldrN+ -- Scans -- ----- @@ -791,6 +838,111 @@ fromList :: Unbox a => [a] -> Vector a {-# INLINE fromList #-} fromList = G.fromList++-- | Convert the first @n@ elements of a list to a vector+--+-- > fromListN n xs = fromList (take n xs)+fromListN :: Unbox a => Int -> [a] -> Vector a+{-# INLINE fromListN #-}+fromListN = G.fromListN++-- Monadic operations+-- ------------------++-- | Perform the monadic action the given number of times and store the+-- results in a vector.+replicateM :: (Monad m, Unbox a) => Int -> m a -> m (Vector a)+{-# INLINE replicateM #-}+replicateM = G.replicateM++-- | Apply the monadic action to all elements of the vector, yielding a vector+-- of results+mapM :: (Monad m, Unbox a, Unbox b) => (a -> m b) -> Vector a -> m (Vector b)+{-# INLINE mapM #-}+mapM = G.mapM++-- | Apply the monadic action to all elements of a vector and ignore the+-- results+mapM_ :: (Monad m, Unbox a) => (a -> m b) -> Vector a -> m ()+{-# INLINE mapM_ #-}+mapM_ = G.mapM_++-- | Apply the monadic action to all elements of the vector, yielding a vector+-- of results+forM :: (Monad m, Unbox a, Unbox b) => Vector a -> (a -> m b) -> m (Vector b)+{-# INLINE forM #-}+forM = G.forM++-- | Apply the monadic action to all elements of a vector and ignore the+-- results+forM_ :: (Monad m, Unbox a) => Vector a -> (a -> m b) -> m ()+{-# INLINE forM_ #-}+forM_ = G.forM_++-- | Zip the two vectors with the monadic action and yield a vector of results+zipWithM :: (Monad m, Unbox a, Unbox b, Unbox c)+         => (a -> b -> m c) -> Vector a -> Vector b -> m (Vector c)+{-# INLINE zipWithM #-}+zipWithM = G.zipWithM++-- | Zip the two vectors with the monadic action and ignore the results+zipWithM_ :: (Monad m, Unbox a, Unbox b)+          => (a -> b -> m c) -> Vector a -> Vector b -> m ()+{-# INLINE zipWithM_ #-}+zipWithM_ = G.zipWithM_++-- | Drop elements that do not satisfy the monadic predicate+filterM :: (Monad m, Unbox a) => (a -> m Bool) -> Vector a -> m (Vector a)+{-# INLINE filterM #-}+filterM = G.filterM++-- | Monadic fold+foldM :: (Monad m, Unbox b) => (a -> b -> m a) -> a -> Vector b -> m a+{-# INLINE foldM #-}+foldM = G.foldM++-- | Monadic fold over non-empty vectors+fold1M :: (Monad m, Unbox a) => (a -> a -> m a) -> Vector a -> m a+{-# INLINE fold1M #-}+fold1M = G.fold1M++-- | Monadic fold with strict accumulator+foldM' :: (Monad m, Unbox b) => (a -> b -> m a) -> a -> Vector b -> m a+{-# INLINE foldM' #-}+foldM' = G.foldM'++-- | Monad fold over non-empty vectors with strict accumulator+fold1M' :: (Monad m, Unbox a) => (a -> a -> m a) -> Vector a -> m a+{-# INLINE fold1M' #-}+fold1M' = G.fold1M'++-- Destructive operations+-- ----------------------++-- | Destructively initialise a vector.+create :: Unbox a => (forall s. ST s (MVector s a)) -> Vector a+{-# INLINE create #-}+create = G.create++-- | Apply a destructive operation to a vector. The operation is applied to a+-- copy of the vector unless it can be safely performed in place.+modify :: Unbox a => (forall s. MVector s a -> ST s ()) -> Vector a -> Vector a+{-# INLINE modify #-}+modify = G.modify++-- | Copy an immutable vector into a mutable one. The two vectors must have+-- the same length. This is not checked.+unsafeCopy+  :: (Unbox a, PrimMonad m) => MVector (PrimState m) a -> Vector a -> m ()+{-# INLINE unsafeCopy #-}+unsafeCopy = G.unsafeCopy+           +-- | Copy an immutable vector into a mutable one. The two vectors must have the+-- same length.+copy :: (Unbox a, PrimMonad m) => MVector (PrimState m) a -> Vector a -> m ()+{-# INLINE copy #-}+copy = G.copy+  #define DEFINE_IMMUTABLE #include "unbox-tuple-instances"
Data/Vector/Unboxed/Base.hs view
@@ -1,8 +1,7 @@-{-# LANGUAGE MultiParamTypeClasses, TypeFamilies, FlexibleContexts,-             ScopedTypeVariables #-}+{-# LANGUAGE MultiParamTypeClasses, TypeFamilies, FlexibleContexts #-} -- | -- Module      : Data.Vector.Unboxed.Base--- Copyright   : (c) Roman Leshchinskiy 2009+-- Copyright   : (c) Roman Leshchinskiy 2009-2010 -- License     : BSD-style -- -- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au>@@ -22,13 +21,15 @@ import qualified Data.Vector.Primitive as P  import Control.Monad.Primitive-import Control.Monad.ST ( runST ) import Control.Monad ( liftM )  import Data.Word ( Word, Word8, Word16, Word32, Word64 ) import Data.Int  ( Int8, Int16, Int32, Int64 ) import Data.Complex +import Data.Typeable ( Typeable1(..), Typeable2(..), mkTyConApp, mkTyCon )+import Data.Data     ( Data(..) )+ #include "vector.h"  data family MVector s a@@ -41,7 +42,26 @@  class (G.Vector Vector a, M.MVector MVector a) => Unbox a +-- -----------------+-- Data and Typeable+-- ----------------- +vectorTy :: String+vectorTy = "Data.Vector.Unboxed.Vector"++instance Typeable1 Vector where+  typeOf1 _ = mkTyConApp (mkTyCon vectorTy) []++instance Typeable2 MVector where+  typeOf2 _ = mkTyConApp (mkTyCon "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+  dataCast1    = G.dataCast+ -- ---- -- Unit -- ----@@ -96,6 +116,9 @@   {-# INLINE basicUnsafeIndexM #-}   basicUnsafeIndexM (V_Unit _) i = return () +  {-# INLINE basicUnsafeCopy #-}+  basicUnsafeCopy (MV_Unit _) (V_Unit _) = return ()+   {-# INLINE elemseq #-}   elemseq _ = seq @@ -140,6 +163,7 @@ ; basicLength (con v) = G.basicLength v                                 \ ; basicUnsafeSlice i n (con v) = con $ G.basicUnsafeSlice i n v         \ ; basicUnsafeIndexM (con v) i = G.basicUnsafeIndexM v i                 \+; basicUnsafeCopy (mcon mv) (con v) = G.basicUnsafeCopy mv v            \ ; elemseq _ = seq }  newtype instance MVector s Int = MV_Int (P.MVector s Int)@@ -276,6 +300,7 @@   basicLength (V_Bool v) = G.basicLength v   basicUnsafeSlice i n (V_Bool v) = V_Bool $ G.basicUnsafeSlice i n v   basicUnsafeIndexM (V_Bool v) i = toBool `liftM` G.basicUnsafeIndexM v i+  basicUnsafeCopy (MV_Bool mv) (V_Bool v) = G.basicUnsafeCopy mv v   elemseq _ = seq  -- -------@@ -322,6 +347,8 @@   basicUnsafeSlice i n (V_Complex v) = V_Complex $ G.basicUnsafeSlice i n v   basicUnsafeIndexM (V_Complex v) i                 = uncurry (:+) `liftM` G.basicUnsafeIndexM v i+  basicUnsafeCopy (MV_Complex mv) (V_Complex v)+                = G.basicUnsafeCopy mv v   elemseq _ (x :+ y) z = G.elemseq (undefined :: Vector a) x                        $ G.elemseq (undefined :: Vector a) y z
Data/Vector/Unboxed/Mutable.hs view
@@ -1,6 +1,6 @@ -- | -- Module      : Data.Vector.Unboxed.Mutable--- Copyright   : (c) Roman Leshchinskiy 2009+-- Copyright   : (c) Roman Leshchinskiy 2009-2010 -- License     : BSD-style -- -- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au>
+ benchmarks/Algo/AwShCC.hs view
@@ -0,0 +1,38 @@+{-# OPTIONS -fno-spec-constr-count #-}+module Algo.AwShCC (awshcc) where++import Data.Vector.Unboxed as V++awshcc :: (Int, Vector Int, Vector Int) -> Vector Int+{-# NOINLINE awshcc #-}+awshcc (n, es1, es2) = concomp ds es1' es2'+    where+      ds = V.enumFromTo 0 (n-1) V.++ V.enumFromTo 0 (n-1)+      es1' = es1 V.++ es2+      es2' = es2 V.++ es1++      starCheck ds = V.backpermute st' gs+        where+          gs  = V.backpermute ds ds+          st  = V.zipWith (==) ds gs+          st' = V.update st . V.filter (not . snd)+                            $ V.zip gs st++      concomp ds es1 es2+        | V.and (starCheck ds'') = ds''+        | otherwise              = concomp (V.backpermute ds'' ds'') es1 es2+        where+          ds'  = V.update ds+               . V.map (\(di, dj, gi) -> (di, dj))+               . V.filter (\(di, dj, gi) -> gi == di && di > dj)+               $ V.zip3 (V.backpermute ds es1)+                        (V.backpermute ds es2)+                        (V.backpermute ds (V.backpermute ds es1))++          ds'' = V.update ds'+               . V.map (\(di, dj, st) -> (di, dj))+               . V.filter (\(di, dj, st) -> st && di /= dj)+               $ V.zip3 (V.backpermute ds' es1)+                        (V.backpermute ds' es2)+                        (V.backpermute (starCheck ds') es1)+
+ benchmarks/Algo/HybCC.hs view
@@ -0,0 +1,42 @@+module Algo.HybCC (hybcc) where++import Data.Vector.Unboxed as V++hybcc :: (Int, Vector Int, Vector Int) -> Vector Int+{-# NOINLINE hybcc #-}+hybcc (n, e1, e2) = concomp (V.zip e1 e2) n+    where+      concomp es n+        | V.null es = V.enumFromTo 0 (n-1)+        | otherwise = V.backpermute ins ins+        where+          p = shortcut_all+            $ V.update (V.enumFromTo 0 (n-1)) es++          (es',i) = compress p es+          r = concomp es' (V.length i)+          ins = V.update_ p i+              $ V.backpermute i r++      enumerate bs = V.prescanl' (+) 0 $ V.map (\b -> if b then 1 else 0) bs++      pack_index bs = V.map fst+                    . V.filter snd+                    $ V.zip (V.enumFromTo 0 (V.length bs - 1)) bs++      shortcut_all p | p == pp   = pp+                     | otherwise = shortcut_all pp+        where+          pp = V.backpermute p p++      compress p es = (new_es, pack_index roots)+        where+          (e1,e2) = V.unzip es+          es' = V.map (\(x,y) -> if x > y then (y,x) else (x,y))+              . V.filter (\(x,y) -> x /= y)+              $ V.zip (V.backpermute p e1) (V.backpermute p e2)++          roots = V.zipWith (==) p (V.enumFromTo 0 (V.length p - 1))+          labels = enumerate roots+          (e1',e2') = V.unzip es'+          new_es = V.zip (V.backpermute labels e1') (V.backpermute labels e2')
+ benchmarks/Algo/Leaffix.hs view
@@ -0,0 +1,16 @@+module Algo.Leaffix where++import Data.Vector.Unboxed as V++leaffix :: (Vector Int, Vector Int) -> Vector Int+{-# NOINLINE leaffix #-}+leaffix (ls,rs)+    = leaffix (V.replicate (V.length ls) 1) ls rs+    where+      leaffix xs ls rs+        = let zs   = V.replicate (V.length ls * 2) 0+              vs   = V.update_ zs ls xs+              sums = V.prescanl' (+) 0 vs+          in+          V.zipWith (-) (V.backpermute sums ls) (V.backpermute sums rs)+
+ benchmarks/Algo/ListRank.hs view
@@ -0,0 +1,21 @@+module Algo.ListRank+where++import Data.Vector.Unboxed as V++listRank :: Int -> Vector Int+{-# NOINLINE listRank #-}+listRank n = pointer_jump xs val+  where+    xs = 0 `V.cons` V.enumFromTo 0 (n-2)++    val = V.zipWith (\i j -> if i == j then 0 else 1)+                    xs (V.enumFromTo 0 (n-1))++    pointer_jump pt val+      | npt == pt = val+      | otherwise = pointer_jump npt nval+      where+        npt  = V.backpermute pt pt+        nval = V.zipWith (+) val (V.backpermute val pt)+
+ benchmarks/Algo/Quickhull.hs view
@@ -0,0 +1,32 @@+module Algo.Quickhull (quickhull) where++import Data.Vector.Unboxed as V++quickhull :: (Vector Double, Vector Double) -> (Vector Double, Vector Double)+{-# NOINLINE quickhull #-}+quickhull (xs, ys) = xs' `seq` ys' `seq` (xs',ys')+    where+      (xs',ys') = V.unzip+                $ hsplit points pmin pmax V.++ hsplit points pmax pmin++      imin = V.minIndex xs+      imax = V.maxIndex xs++      points = V.zip xs ys+      pmin   = points V.! imin+      pmax   = points V.! imax+++      hsplit points p1 p2+        | V.length packed < 2 = p1 `V.cons` packed+        | otherwise = hsplit packed p1 pm V.++ hsplit packed pm p2+        where+          cs     = V.map (\p -> cross p p1 p2) points+          packed = V.map fst+                 $ V.filter (\t -> snd t > 0)+                 $ V.zip points cs++          pm     = points V.! V.maxIndex cs++      cross (x,y) (x1,y1) (x2,y2) = (x1-x)*(y2-y) - (y1-y)*(x2-x)+
+ benchmarks/Algo/Rootfix.hs view
@@ -0,0 +1,15 @@+module Algo.Rootfix where++import Data.Vector.Unboxed as V++rootfix :: (V.Vector Int, V.Vector Int) -> V.Vector Int+{-# NOINLINE rootfix #-}+rootfix (ls, rs) = rootfix (V.replicate (V.length ls) 1) ls rs+    where+      rootfix xs ls rs+        = let zs   = V.replicate (V.length ls * 2) 0+              vs   = V.update_ (V.update_ zs ls xs) rs (V.map negate xs)+              sums = V.prescanl' (+) 0 vs+          in+          V.backpermute sums ls+
+ benchmarks/Algo/Spectral.hs view
@@ -0,0 +1,21 @@+module Algo.Spectral ( spectral ) where++import Data.Vector.Unboxed as V++import Data.Bits++spectral :: Vector Double -> Vector Double+{-# NOINLINE spectral #-}+spectral us = us `seq` V.map row (V.enumFromTo 0 (n-1))+    where+      n = V.length us++      row i = i `seq` V.sum (V.imap (\j u -> eval_A i j * u) us)++      eval_A i j = 1 / fromIntegral r+        where+          r = u + (i+1)+          u = t `shiftR` 1+          t = n * (n+1)+          n = i+j+
+ benchmarks/Algo/Tridiag.hs view
@@ -0,0 +1,20 @@+module Algo.Tridiag ( tridiag ) where++import Data.Vector.Unboxed as V++tridiag :: (Vector Double, Vector Double, Vector Double, Vector Double)+            -> Vector Double+{-# NOINLINE tridiag #-}+tridiag (as,bs,cs,ds) = xs+    where+      (cs',ds') = V.unzip+                $ V.prescanl' modify (0,0)+                $ V.zip (V.zip as bs) (V.zip cs ds)++      modify (c',d') ((a,b),(c,d)) = +                   let id = 1 / (b - c'*a)+                   in+                   id `seq` (c*id, (d-d'*a)*id)++      xs = V.prescanr' (\(c,d) x' -> d - c*x') 0 (V.zip cs' ds')+
+ benchmarks/LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2008-2009, Roman Leshchinskiy+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++- Redistributions of source code must retain the above copyright notice,+this list of conditions and the following disclaimer.+ +- Redistributions in binary form must reproduce the above copyright notice,+this list of conditions and the following disclaimer in the documentation+and/or other materials provided with the distribution.+ +- Neither name of the University nor the names of its contributors may be+used to endorse or promote products derived from this software without+specific prior written permission. ++THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF+GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND+FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE+UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH+DAMAGE.+
+ benchmarks/Main.hs view
@@ -0,0 +1,46 @@+module Main where++import Criterion.Main++import Algo.ListRank  (listRank)+import Algo.Rootfix   (rootfix)+import Algo.Leaffix   (leaffix)+import Algo.AwShCC    (awshcc)+import Algo.HybCC     (hybcc)+import Algo.Quickhull (quickhull)+import Algo.Spectral  ( spectral )+import Algo.Tridiag   ( tridiag )++import TestData.ParenTree ( parenTree )+import TestData.Graph     ( randomGraph )+import TestData.Random    ( randomVector )++import Data.Vector.Unboxed ( Vector )++size :: Int+size = 100000++main = lparens `seq` rparens `seq`+       nodes `seq` edges1 `seq` edges2 `seq`+       do+         as <- randomVector size :: IO (Vector Double)+         bs <- randomVector size :: IO (Vector Double)+         cs <- randomVector size :: IO (Vector Double)+         ds <- randomVector size :: IO (Vector Double)+         sp <- randomVector (floor $ sqrt $ fromIntegral size)+                                 :: IO (Vector Double)+         as `seq` bs `seq` cs `seq` ds `seq` sp `seq`+           defaultMain [ bench "listRank"  $ whnf listRank size+                       , bench "rootfix"   $ whnf rootfix (lparens, rparens)+                       , bench "leaffix"   $ whnf leaffix (lparens, rparens)+                       , bench "awshcc"    $ whnf awshcc (nodes, edges1, edges2)+                       , bench "hybcc"     $ whnf hybcc  (nodes, edges1, edges2)+                       , bench "quickhull" $ whnf quickhull (as,bs)+                       , bench "spectral"  $ whnf spectral sp+                       , bench "tridiag"   $ whnf tridiag (as,bs,cs,ds)+                       ]+  where+    (lparens, rparens) = parenTree size+    (nodes, edges1, edges2) = randomGraph size+    +
+ benchmarks/Setup.hs view
@@ -0,0 +1,3 @@+import Distribution.Simple+main = defaultMain+
+ benchmarks/TestData/Graph.hs view
@@ -0,0 +1,45 @@+module TestData.Graph ( randomGraph )+where++import System.Random.MWC+import qualified Data.Array.ST as STA+import qualified Data.Vector.Unboxed as V++import Control.Monad.ST ( ST, runST )++randomGraph :: Int -> (Int, V.Vector Int, V.Vector Int)+randomGraph e+  = runST (+    do+      g <- create+      arr <- STA.newArray (0,n-1) [] :: ST s (STA.STArray s Int [Int])+      addRandomEdges n g arr e+      xs <- STA.getAssocs arr+      let (as,bs) = unzip [(i,j) | (i,js) <- xs, j <- js ]+      return (n, V.fromListN (length as) as, V.fromListN (length bs) bs)+    )+  where+    n = e `div` 10++addRandomEdges :: Int -> Gen s -> STA.STArray s Int [Int] -> Int -> ST s ()+addRandomEdges n g arr = fill+  where+    fill 0 = return ()+    fill e+      = do+          m <- random_index+          n <- random_index+          let lo = min m n+              hi = max m n+          ns <- STA.readArray arr lo+          if lo == hi || hi `elem` ns+            then fill e+            else do+                   STA.writeArray arr lo (hi:ns)+                   fill (e-1)++    random_index = do+                     x <- uniform g+                     let i = floor ((x::Double) * toEnum n)+                     if i == n then return 0 else return i+
+ benchmarks/TestData/ParenTree.hs view
@@ -0,0 +1,20 @@+module TestData.ParenTree where++import qualified Data.Vector.Unboxed as V++parenTree :: Int -> (V.Vector Int, V.Vector Int)+parenTree n = case go ([],[]) 0 (if even n then n else n+1) of+               (ls,rs) -> (V.fromListN (length ls) (reverse ls),+                           V.fromListN (length rs) (reverse rs))+  where+    go (ls,rs) i j = case j-i of+                       0 -> (ls,rs)+                       2 -> (ls',rs')+                       d -> let k = ((d-2) `div` 4) * 2+                            in+                            go (go (ls',rs') (i+1) (i+1+k)) (i+1+k) (j-1)+      where+        ls' = i:ls+        rs' = j-1:rs++
+ benchmarks/TestData/Random.hs view
@@ -0,0 +1,16 @@+module TestData.Random ( randomVector ) where++import qualified Data.Vector.Unboxed as V++import System.Random.MWC+import Control.Monad.ST ( runST )++randomVector :: (Variate a, V.Unbox a) => Int -> IO (V.Vector a)+randomVector n = withSystemRandom $ \g ->+  do+    xs <- sequence $ replicate n $ uniform g+    io (return $ V.fromListN n xs)+  where+    io :: IO a -> IO a+    io = id+
+ benchmarks/vector-benchmarks.cabal view
@@ -0,0 +1,37 @@+Name:           vector-benchmarks+Version:        0.6+License:        BSD3+License-File:   LICENSE+Author:         Roman Leshchinskiy <rl@cse.unsw.edu.au>+Maintainer:     Roman Leshchinskiy <rl@cse.unsw.edu.au>+Copyright:      (c) Roman Leshchinskiy 2010+Cabal-Version:  >= 1.2+Build-Type:     Simple++Executable algorithms+  Main-Is: Main.hs++  Build-Depends: base >= 2 && < 5, array,+                 criterion >= 0.5 && < 0.6,+                 mwc-random >= 0.5 && < 0.6,+                 vector >= 0.6 && < 0.7++  if impl(ghc<6.13)+    Ghc-Options: -finline-if-enough-args -fno-method-sharing+  +  Ghc-Options: -O2++  Other-Modules:+        Algo.ListRank+        Algo.Rootfix+        Algo.Leaffix+        Algo.AwShCC+        Algo.HybCC+        Algo.Quickhull+        Algo.Spectral+        Algo.Tridiag++        TestData.ParenTree+        TestData.Graph+        TestData.Random+
internal/GenUnboxTuple.hs view
@@ -157,9 +157,9 @@       = (pat "MV" <+> tuple vars,          mk_do [qM rec <+> vs <+> v | vs <- varss | v <- vars] empty) -    gen_unsafeCopy rec-      = (patn "MV" 1 <+> patn "MV" 2,-         mk_do [qM rec <+> vs <> char '1' <+> vs <> char '2' | vs <- varss]+    gen_unsafeCopy c q rec+      = (patn "MV" 1 <+> patn c 2,+         mk_do [q rec <+> vs <> char '1' <+> vs <> char '2' | vs <- varss]                empty)      gen_unsafeGrow rec@@ -183,11 +183,11 @@                $ text "return" <+> tuple vars)      gen_elemseq rec-      = (char '_' <+> tuple vars <+> var 'x',-         vcat [qG rec <+> parens (text "undefined :: Vector" <+> v)-                      <+> v <+> char '$' | v <- vars]-         <+> var 'x')-+      = (char '_' <+> tuple vars,+         vcat $ r : [char '.' <+> r | r <- rs])+      where+        r : rs = [qG rec <+> parens (text "undefined :: Vector" <+> v)+                         <+> v | v <- vars]      mk_do cmds ret = hang (text "do")                           2@@ -209,11 +209,12 @@                       ,("basicUnsafeWrite",       gen_unsafeWrite)                       ,("basicClear",             gen_clear)                       ,("basicSet",               gen_set)-                      ,("basicUnsafeCopy",        gen_unsafeCopy)+                      ,("basicUnsafeCopy",        gen_unsafeCopy "MV" qM)                       ,("basicUnsafeGrow",        gen_unsafeGrow)]      methods_Vector  = [("unsafeFreeze",           gen_unsafeFreeze)                       ,("basicLength",            gen_length "V")                       ,("basicUnsafeSlice",       gen_unsafeSlice "G" "V")                       ,("basicUnsafeIndexM",      gen_basicUnsafeIndexM)+                      ,("basicUnsafeCopy",        gen_unsafeCopy "V" qG)                       ,("elemseq",                gen_elemseq)]
internal/unbox-tuple-instances view
@@ -80,10 +80,15 @@           a <- G.basicUnsafeIndexM as i_           b <- G.basicUnsafeIndexM bs i_           return (a, b)+  {-# INLINE basicUnsafeCopy  #-}+  basicUnsafeCopy (MV_2 n_1 as1 bs1) (V_2 n_2 as2 bs2)+      = do+          G.basicUnsafeCopy as1 as2+          G.basicUnsafeCopy bs1 bs2   {-# INLINE elemseq  #-}-  elemseq _ (a, b) x_-      = G.elemseq (undefined :: Vector a) a $-        G.elemseq (undefined :: Vector b) b $ x_+  elemseq _ (a, b)+      = G.elemseq (undefined :: Vector a) a+        . G.elemseq (undefined :: Vector b) b #endif #ifdef DEFINE_MUTABLE zip :: (Unbox a, Unbox b) => MVector s a ->@@ -211,11 +216,17 @@           b <- G.basicUnsafeIndexM bs i_           c <- G.basicUnsafeIndexM cs i_           return (a, b, c)+  {-# INLINE basicUnsafeCopy  #-}+  basicUnsafeCopy (MV_3 n_1 as1 bs1 cs1) (V_3 n_2 as2 bs2 cs2)+      = do+          G.basicUnsafeCopy as1 as2+          G.basicUnsafeCopy bs1 bs2+          G.basicUnsafeCopy cs1 cs2   {-# INLINE elemseq  #-}-  elemseq _ (a, b, c) x_-      = G.elemseq (undefined :: Vector a) a $-        G.elemseq (undefined :: Vector b) b $-        G.elemseq (undefined :: Vector c) c $ x_+  elemseq _ (a, b, c)+      = G.elemseq (undefined :: Vector a) a+        . G.elemseq (undefined :: Vector b) b+        . G.elemseq (undefined :: Vector c) c #endif #ifdef DEFINE_MUTABLE zip3 :: (Unbox a, Unbox b, Unbox c) => MVector s a ->@@ -375,12 +386,22 @@           c <- G.basicUnsafeIndexM cs i_           d <- G.basicUnsafeIndexM ds i_           return (a, b, c, d)+  {-# INLINE basicUnsafeCopy  #-}+  basicUnsafeCopy (MV_4 n_1 as1 bs1 cs1 ds1) (V_4 n_2 as2+                                                      bs2+                                                      cs2+                                                      ds2)+      = do+          G.basicUnsafeCopy as1 as2+          G.basicUnsafeCopy bs1 bs2+          G.basicUnsafeCopy cs1 cs2+          G.basicUnsafeCopy ds1 ds2   {-# INLINE elemseq  #-}-  elemseq _ (a, b, c, d) x_-      = G.elemseq (undefined :: Vector a) a $-        G.elemseq (undefined :: Vector b) b $-        G.elemseq (undefined :: Vector c) c $-        G.elemseq (undefined :: Vector d) d $ x_+  elemseq _ (a, b, c, d)+      = G.elemseq (undefined :: Vector a) a+        . G.elemseq (undefined :: Vector b) b+        . G.elemseq (undefined :: Vector c) c+        . G.elemseq (undefined :: Vector d) d #endif #ifdef DEFINE_MUTABLE zip4 :: (Unbox a, Unbox b, Unbox c, Unbox d) => MVector s a ->@@ -579,13 +600,25 @@           d <- G.basicUnsafeIndexM ds i_           e <- G.basicUnsafeIndexM es i_           return (a, b, c, d, e)+  {-# INLINE basicUnsafeCopy  #-}+  basicUnsafeCopy (MV_5 n_1 as1 bs1 cs1 ds1 es1) (V_5 n_2 as2+                                                          bs2+                                                          cs2+                                                          ds2+                                                          es2)+      = do+          G.basicUnsafeCopy as1 as2+          G.basicUnsafeCopy bs1 bs2+          G.basicUnsafeCopy cs1 cs2+          G.basicUnsafeCopy ds1 ds2+          G.basicUnsafeCopy es1 es2   {-# INLINE elemseq  #-}-  elemseq _ (a, b, c, d, e) x_-      = G.elemseq (undefined :: Vector a) a $-        G.elemseq (undefined :: Vector b) b $-        G.elemseq (undefined :: Vector c) c $-        G.elemseq (undefined :: Vector d) d $-        G.elemseq (undefined :: Vector e) e $ x_+  elemseq _ (a, b, c, d, e)+      = G.elemseq (undefined :: Vector a) a+        . G.elemseq (undefined :: Vector b) b+        . G.elemseq (undefined :: Vector c) c+        . G.elemseq (undefined :: Vector d) d+        . G.elemseq (undefined :: Vector e) e #endif #ifdef DEFINE_MUTABLE zip5 :: (Unbox a,@@ -833,14 +866,28 @@           e <- G.basicUnsafeIndexM es i_           f <- G.basicUnsafeIndexM fs i_           return (a, b, c, d, e, f)+  {-# INLINE basicUnsafeCopy  #-}+  basicUnsafeCopy (MV_6 n_1 as1 bs1 cs1 ds1 es1 fs1) (V_6 n_2 as2+                                                              bs2+                                                              cs2+                                                              ds2+                                                              es2+                                                              fs2)+      = do+          G.basicUnsafeCopy as1 as2+          G.basicUnsafeCopy bs1 bs2+          G.basicUnsafeCopy cs1 cs2+          G.basicUnsafeCopy ds1 ds2+          G.basicUnsafeCopy es1 es2+          G.basicUnsafeCopy fs1 fs2   {-# INLINE elemseq  #-}-  elemseq _ (a, b, c, d, e, f) x_-      = G.elemseq (undefined :: Vector a) a $-        G.elemseq (undefined :: Vector b) b $-        G.elemseq (undefined :: Vector c) c $-        G.elemseq (undefined :: Vector d) d $-        G.elemseq (undefined :: Vector e) e $-        G.elemseq (undefined :: Vector f) f $ x_+  elemseq _ (a, b, c, d, e, f)+      = G.elemseq (undefined :: Vector a) a+        . G.elemseq (undefined :: Vector b) b+        . G.elemseq (undefined :: Vector c) c+        . G.elemseq (undefined :: Vector d) d+        . G.elemseq (undefined :: Vector e) e+        . G.elemseq (undefined :: Vector f) f #endif #ifdef DEFINE_MUTABLE zip6 :: (Unbox a,
tests/Tests/Vector.hs view
@@ -81,7 +81,7 @@         'prop_length, 'prop_null,          'prop_empty, 'prop_singleton, 'prop_replicate,-        'prop_cons, 'prop_snoc, 'prop_append, 'prop_copy, 'prop_generate,+        'prop_cons, 'prop_snoc, 'prop_append, 'prop_force, 'prop_generate,          'prop_head, 'prop_last, 'prop_index,         'prop_unsafeHead, 'prop_unsafeLast, 'prop_unsafeIndex,@@ -131,7 +131,7 @@     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_copy      :: P (v a -> v a)        = V.copy `eq` id+    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
tests/vector-tests.cabal view
@@ -1,5 +1,5 @@ Name:           vector-tests-Version:        0.5+Version:        0.6 License:        BSD3 License-File:   LICENSE Author:         Max Bolingbroke, Roman Leshchinskiy@@ -27,7 +27,8 @@               TypeFamilies,               TemplateHaskell -  Build-Depends: base >= 4 && < 5, template-haskell, vector, random,+  Build-Depends: base >= 4 && < 5, template-haskell, vector >= 0.6 && < 0.7,+                 random,                  QuickCheck >= 2, test-framework, test-framework-quickcheck2    -- Don't let fusion occur or GHC will make our tests less informative in some cases :-)
vector.cabal view
@@ -1,17 +1,18 @@ Name:           vector-Version:        0.5+Version:        0.6 License:        BSD3 License-File:   LICENSE Author:         Roman Leshchinskiy <rl@cse.unsw.edu.au> Maintainer:     Roman Leshchinskiy <rl@cse.unsw.edu.au> Copyright:      (c) Roman Leshchinskiy 2008-2010 Homepage:       http://code.haskell.org/vector+Bug-Reports:    http://trac.haskell.org/vector Category:       Data, Data Structures Synopsis:       Efficient Arrays Description:         .-        An efficient implementation of Int-indexed arrays with a powerful loop-        fusion framework.+        An efficient implementation of Int-indexed arrays (both mutable+        and immutable), with a powerful loop fusion optimization framework .         .         It is structured as follows:         .@@ -28,19 +29,31 @@         .         [@Data.Vector.Generic@] Generic interface to the vector types.         .-        Changes since version 0.4.2+        There is also a (draft) tutorial on common uses of vector.         .-        * Unboxed vectors of primitive types and tuples+        * <http://haskell.org/haskellwiki/Numeric_Haskell:_A_Vector_Tutorial>         .-        * Redesigned interface between mutable and immutable vectors (now-          with the popular @unsafeFreeze@ primitive)+        Please use the project trac to submit bug reports and feature+        requests.         .-        * Many new combinators+        * <http://trac.haskell.org/vector>         .-        * Significant performance improvements+        Changes since version 0.5         .+        * More efficient representation of @Storable@ vectors+        .+        * Block copy operations used when possible+        .+        * @Typeable@ and @Data@ instances+        .+        * Monadic combinators (@replicateM@, @mapM@ etc.)+        .+        * Better support for recycling (see @create@ and @modify@)+        .+        * Performance improvements+        . -Cabal-Version:  >= 1.2+Cabal-Version:  >= 1.2.3 Build-Type:     Simple  Extra-Source-Files:@@ -52,6 +65,21 @@       tests/Utilities.hs       tests/Tests/Stream.hs       tests/Tests/Vector.hs+      benchmarks/vector-benchmarks.cabal+      benchmarks/LICENSE+      benchmarks/Setup.hs+      benchmarks/Main.hs+      benchmarks/Algo/AwShCC.hs+      benchmarks/Algo/HybCC.hs+      benchmarks/Algo/Leaffix.hs+      benchmarks/Algo/ListRank.hs+      benchmarks/Algo/Quickhull.hs+      benchmarks/Algo/Rootfix.hs+      benchmarks/Algo/Spectral.hs+      benchmarks/Algo/Tridiag.hs+      benchmarks/TestData/Graph.hs+      benchmarks/TestData/ParenTree.hs+      benchmarks/TestData/Random.hs       internal/GenUnboxTuple.hs       internal/unbox-tuple-instances @@ -71,7 +99,7 @@   Library-  Extensions: CPP+  Extensions: CPP, DeriveDataTypeable   Exposed-Modules:         Data.Vector.Internal.Check @@ -81,6 +109,7 @@         Data.Vector.Fusion.Stream          Data.Vector.Generic.Mutable+        Data.Vector.Generic.Base         Data.Vector.Generic.New         Data.Vector.Generic @@ -104,10 +133,10 @@   Install-Includes:         vector.h -  Build-Depends: base >= 2 && < 5, ghc >= 6.9, primitive >= 0.2 && < 0.3+  Build-Depends: base >= 4 && < 5, ghc >= 6.9, primitive >= 0.3 && < 0.4    if impl(ghc<6.13)-    Ghc-Options: -finline-if-enough-args+    Ghc-Options: -finline-if-enough-args -fno-method-sharing      Ghc-Options: -O2