packages feed

vector 0.3.1 → 0.4

raw patch · 31 files changed

+3204/−2187 lines, 31 filesdep +primitivedep −arraydep −ghc-primdep ~basedep ~ghc

Dependencies added: primitive

Dependencies removed: array, ghc-prim

Dependency ranges changed: base, ghc

Files

Data/Vector.hs view
@@ -1,8 +1,8 @@-{-# LANGUAGE MagicHash, UnboxedTuples, FlexibleInstances, MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}  -- | -- Module      : Data.Vector--- Copyright   : (c) Roman Leshchinskiy 2008+-- Copyright   : (c) Roman Leshchinskiy 2008-2009 -- License     : BSD-style -- -- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au>@@ -13,7 +13,7 @@ --  module Data.Vector (-  Vector,+  Vector, MVector,    -- * Length information   length, null,@@ -53,6 +53,8 @@    -- * Scans   prescanl, prescanl',+  postscanl, postscanl',+  scanl, scanl', scanl1, scanl1',    -- * Enumeration   enumFromTo, enumFromThenTo,@@ -61,16 +63,12 @@   toList, fromList ) where -import           Data.Vector.IVector ( IVector(..) )-import qualified Data.Vector.IVector    as IV-import qualified Data.Vector.Mutable.ST as Mut+import qualified Data.Vector.Generic as G+import           Data.Vector.Mutable  ( MVector(..) )+import           Data.Primitive.Array  import Control.Monad.ST ( runST ) -import GHC.ST   ( ST(..) )-import GHC.Prim ( Array#, unsafeFreezeArray#, indexArray#, (+#) )-import GHC.Base ( Int(..) )- import Prelude hiding ( length, null,                         replicate, (++),                         head, last,@@ -81,52 +79,52 @@                         elem, notElem,                         foldl, foldl1, foldr, foldr1,                         and, or, sum, product, minimum, maximum,+                        scanl, scanl1,                         enumFromTo, enumFromThenTo )  import qualified Prelude  data Vector a = Vector {-# UNPACK #-} !Int                        {-# UNPACK #-} !Int-                                      (Array# a)+                       {-# UNPACK #-} !(Array a)  instance Show a => Show (Vector a) where     show = (Prelude.++ " :: Data.Vector.Vector") . ("fromList " Prelude.++) . show . toList -instance IVector Vector a where+instance G.Vector Vector a where   {-# INLINE vnew #-}   vnew init = runST (do-                       Mut.Vector i n marr# <- init-                       ST (\s# -> case unsafeFreezeArray# marr# s# of-                               (# s2#, arr# #) -> (# s2#, Vector i n arr# #)))+                       MVector i n marr <- init+                       arr <- unsafeFreezeArray marr+                       return (Vector i n arr))    {-# INLINE vlength #-}   vlength (Vector _ n _) = n    {-# INLINE unsafeSlice #-}-  unsafeSlice (Vector i _ arr#) j n = Vector (i+j) n arr#+  unsafeSlice (Vector i _ arr) j n = Vector (i+j) n arr    {-# INLINE unsafeIndexM #-}-  unsafeIndexM (Vector (I# i#) _ arr#) (I# j#)-    = case indexArray# arr# (i# +# j#) of (# x #) -> return x+  unsafeIndexM (Vector i _ arr) j = indexArrayM arr (i+j)  instance Eq a => Eq (Vector a) where   {-# INLINE (==) #-}-  (==) = IV.eq+  (==) = G.eq  instance Ord a => Ord (Vector a) where   {-# INLINE compare #-}-  compare = IV.cmp+  compare = G.cmp  -- Length -- ------  length :: Vector a -> Int {-# INLINE length #-}-length = IV.length+length = G.length  null :: Vector a -> Bool {-# INLINE null #-}-null = IV.null+null = G.null  -- Construction -- ------------@@ -134,38 +132,38 @@ -- | Empty vector empty :: Vector a {-# INLINE empty #-}-empty = IV.empty+empty = G.empty  -- | Vector with exaclty one element singleton :: a -> Vector a {-# INLINE singleton #-}-singleton = IV.singleton+singleton = G.singleton  -- | Vector of the given length with the given value in each position replicate :: Int -> a -> Vector a {-# INLINE replicate #-}-replicate = IV.replicate+replicate = G.replicate  -- | Prepend an element cons :: a -> Vector a -> Vector a {-# INLINE cons #-}-cons = IV.cons+cons = G.cons  -- | Append an element snoc :: Vector a -> a -> Vector a {-# INLINE snoc #-}-snoc = IV.snoc+snoc = G.snoc  infixr 5 ++ -- | Concatenate two vectors (++) :: Vector a -> Vector a -> Vector a {-# INLINE (++) #-}-(++) = (IV.++)+(++) = (G.++)  -- | Create a copy of a vector. Useful when dealing with slices. copy :: Vector a -> Vector a {-# INLINE copy #-}-copy = IV.copy+copy = G.copy  -- Accessing individual elements -- -----------------------------@@ -173,31 +171,31 @@ -- | Indexing (!) :: Vector a -> Int -> a {-# INLINE (!) #-}-(!) = (IV.!)+(!) = (G.!)  -- | First element head :: Vector a -> a {-# INLINE head #-}-head = IV.head+head = G.head  -- | Last element last :: Vector a -> a {-# INLINE last #-}-last = IV.last+last = G.last  -- | 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 = IV.indexM+indexM = G.indexM  headM :: Monad m => Vector a -> m a {-# INLINE headM #-}-headM = IV.headM+headM = G.headM  lastM :: Monad m => Vector a -> m a {-# INLINE lastM #-}-lastM = IV.lastM+lastM = G.lastM  -- Subarrays -- ---------@@ -208,50 +206,50 @@                   -> Int   -- ^ length                   -> Vector a {-# INLINE slice #-}-slice = IV.slice+slice = G.slice  -- | Yield all but the last element without copying. init :: Vector a -> Vector a {-# INLINE init #-}-init = IV.init+init = G.init  -- | All but the first element (without copying). tail :: Vector a -> Vector a {-# INLINE tail #-}-tail = IV.tail+tail = G.tail  -- | Yield the first @n@ elements without copying. take :: Int -> Vector a -> Vector a {-# INLINE take #-}-take = IV.take+take = G.take  -- | Yield all but the first @n@ elements without copying. drop :: Int -> Vector a -> Vector a {-# INLINE drop #-}-drop = IV.drop+drop = G.drop  -- Permutations -- ------------  accum :: (a -> b -> a) -> Vector a -> [(Int,b)] -> Vector a {-# INLINE accum #-}-accum = IV.accum+accum = G.accum  (//) :: Vector a -> [(Int, a)] -> Vector a {-# INLINE (//) #-}-(//) = (IV.//)+(//) = (G.//)  update :: Vector a -> Vector (Int, a) -> Vector a {-# INLINE update #-}-update = IV.update+update = G.update  backpermute :: Vector a -> Vector Int -> Vector a {-# INLINE backpermute #-}-backpermute = IV.backpermute+backpermute = G.backpermute  reverse :: Vector a -> Vector a {-# INLINE reverse #-}-reverse = IV.reverse+reverse = G.reverse  -- Mapping -- -------@@ -259,11 +257,11 @@ -- | Map a function over a vector map :: (a -> b) -> Vector a -> Vector b {-# INLINE map #-}-map = IV.map+map = G.map  concatMap :: (a -> Vector b) -> Vector a -> Vector b {-# INLINE concatMap #-}-concatMap = IV.concatMap+concatMap = G.concatMap  -- Zipping/unzipping -- -----------------@@ -271,28 +269,28 @@ -- | Zip two vectors with the given function. zipWith :: (a -> b -> c) -> Vector a -> Vector b -> Vector c {-# INLINE zipWith #-}-zipWith = IV.zipWith+zipWith = G.zipWith  -- | Zip three vectors with the given function. zipWith3 :: (a -> b -> c -> d) -> Vector a -> Vector b -> Vector c -> Vector d {-# INLINE zipWith3 #-}-zipWith3 = IV.zipWith3+zipWith3 = G.zipWith3  zip :: Vector a -> Vector b -> Vector (a, b) {-# INLINE zip #-}-zip = IV.zip+zip = G.zip  zip3 :: Vector a -> Vector b -> Vector c -> Vector (a, b, c) {-# INLINE zip3 #-}-zip3 = IV.zip3+zip3 = G.zip3  unzip :: Vector (a, b) -> (Vector a, Vector b) {-# INLINE unzip #-}-unzip = IV.unzip+unzip = G.unzip  unzip3 :: Vector (a, b, c) -> (Vector a, Vector b, Vector c) {-# INLINE unzip3 #-}-unzip3 = IV.unzip3+unzip3 = G.unzip3  -- Filtering -- ---------@@ -300,17 +298,17 @@ -- | Drop elements which do not satisfy the predicate filter :: (a -> Bool) -> Vector a -> Vector a {-# INLINE filter #-}-filter = IV.filter+filter = G.filter  -- | Yield the longest prefix of elements satisfying the predicate. takeWhile :: (a -> Bool) -> Vector a -> Vector a {-# INLINE takeWhile #-}-takeWhile = IV.takeWhile+takeWhile = G.takeWhile  -- | Drop the longest prefix of elements that satisfy the predicate. dropWhile :: (a -> Bool) -> Vector a -> Vector a {-# INLINE dropWhile #-}-dropWhile = IV.dropWhile+dropWhile = G.dropWhile  -- Searching -- ---------@@ -319,25 +317,25 @@ -- | Check whether the vector contains an element elem :: Eq a => a -> Vector a -> Bool {-# INLINE elem #-}-elem = IV.elem+elem = G.elem  infix 4 `notElem` -- | Inverse of `elem` notElem :: Eq a => a -> Vector a -> Bool {-# INLINE notElem #-}-notElem = IV.notElem+notElem = G.notElem  -- | Yield 'Just' the first element matching the predicate or 'Nothing' if no -- such element exists. find :: (a -> Bool) -> Vector a -> Maybe a {-# INLINE find #-}-find = IV.find+find = G.find  -- | Yield 'Just' the index of the first element matching the predicate or -- 'Nothing' if no such element exists. findIndex :: (a -> Bool) -> Vector a -> Maybe Int {-# INLINE findIndex #-}-findIndex = IV.findIndex+findIndex = G.findIndex  -- Folding -- -------@@ -345,66 +343,66 @@ -- | Left fold foldl :: (a -> b -> a) -> a -> Vector b -> a {-# INLINE foldl #-}-foldl = IV.foldl+foldl = G.foldl  -- | Lefgt fold on non-empty vectors foldl1 :: (a -> a -> a) -> Vector a -> a {-# INLINE foldl1 #-}-foldl1 = IV.foldl1+foldl1 = G.foldl1  -- | Left fold with strict accumulator foldl' :: (a -> b -> a) -> a -> Vector b -> a {-# INLINE foldl' #-}-foldl' = IV.foldl'+foldl' = G.foldl'  -- | Left fold on non-empty vectors with strict accumulator foldl1' :: (a -> a -> a) -> Vector a -> a {-# INLINE foldl1' #-}-foldl1' = IV.foldl1'+foldl1' = G.foldl1'  -- | Right fold foldr :: (a -> b -> b) -> b -> Vector a -> b {-# INLINE foldr #-}-foldr = IV.foldr+foldr = G.foldr  -- | Right fold on non-empty vectors foldr1 :: (a -> a -> a) -> Vector a -> a {-# INLINE foldr1 #-}-foldr1 = IV.foldr1+foldr1 = G.foldr1  -- Specialised folds -- -----------------  and :: Vector Bool -> Bool {-# INLINE and #-}-and = IV.and+and = G.and  or :: Vector Bool -> Bool {-# INLINE or #-}-or = IV.or+or = G.or  sum :: Num a => Vector a -> a {-# INLINE sum #-}-sum = IV.sum+sum = G.sum  product :: Num a => Vector a -> a {-# INLINE product #-}-product = IV.product+product = G.product  maximum :: Ord a => Vector a -> a {-# INLINE maximum #-}-maximum = IV.maximum+maximum = G.maximum  minimum :: Ord a => Vector a -> a {-# INLINE minimum #-}-minimum = IV.minimum+minimum = G.minimum  -- Unfolding -- ---------  unfoldr :: (b -> Maybe (a, b)) -> b -> Vector a {-# INLINE unfoldr #-}-unfoldr = IV.unfoldr+unfoldr = G.unfoldr  -- Scans -- -----@@ -412,23 +410,53 @@ -- | Prefix scan prescanl :: (a -> b -> a) -> a -> Vector b -> Vector a {-# INLINE prescanl #-}-prescanl = IV.prescanl+prescanl = G.prescanl  -- | Prefix scan with strict accumulator prescanl' :: (a -> b -> a) -> a -> Vector b -> Vector a {-# INLINE prescanl' #-}-prescanl' = IV.prescanl'+prescanl' = G.prescanl' +-- | Suffix scan+postscanl :: (a -> b -> a) -> a -> Vector b -> Vector a+{-# INLINE postscanl #-}+postscanl = G.postscanl++-- | Suffix scan with strict accumulator+postscanl' :: (a -> b -> a) -> a -> Vector b -> Vector a+{-# INLINE postscanl' #-}+postscanl' = G.postscanl'++-- | Haskell-style scan+scanl :: (a -> b -> a) -> a -> Vector b -> Vector a+{-# INLINE scanl #-}+scanl = G.scanl++-- | Haskell-style scan with strict accumulator+scanl' :: (a -> b -> a) -> a -> Vector b -> Vector a+{-# INLINE scanl' #-}+scanl' = G.scanl'++-- | Scan over a non-empty 'Vector'+scanl1 :: (a -> a -> a) -> Vector a -> Vector a+{-# INLINE scanl1 #-}+scanl1 = G.scanl1++-- | Scan over a non-empty 'Vector' with a strict accumulator+scanl1' :: (a -> a -> a) -> Vector a -> Vector a+{-# INLINE scanl1' #-}+scanl1' = G.scanl1'+ -- Enumeration -- -----------  enumFromTo :: Enum a => a -> a -> Vector a {-# INLINE enumFromTo #-}-enumFromTo = IV.enumFromTo+enumFromTo = G.enumFromTo  enumFromThenTo :: Enum a => a -> a -> a -> Vector a {-# INLINE enumFromThenTo #-}-enumFromThenTo = IV.enumFromThenTo+enumFromThenTo = G.enumFromThenTo  -- Conversion to/from lists -- ------------------------@@ -436,10 +464,10 @@ -- | Convert a vector to a list toList :: Vector a -> [a] {-# INLINE toList #-}-toList = IV.toList+toList = G.toList  -- | Convert a list to a vector fromList :: [a] -> Vector a {-# INLINE fromList #-}-fromList = IV.fromList+fromList = G.fromList
Data/Vector/Fusion/Stream.hs view
@@ -1,8 +1,8 @@-{-# LANGUAGE ExistentialQuantification, FlexibleInstances #-}+{-# LANGUAGE ExistentialQuantification, FlexibleInstances, Rank2Types #-}  -- | -- Module      : Data.Vector.Fusion.Stream--- Copyright   : (c) Roman Leshchinskiy 2008+-- Copyright   : (c) Roman Leshchinskiy 2008-2009 -- License     : BSD-style -- -- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au>@@ -18,6 +18,9 @@   -- * Types   Step(..), Stream, MStream, +  -- * In-place markers+  inplace, inplace',+   -- * Size hints   size, sized, @@ -56,12 +59,15 @@    -- * Scans   prescanl, prescanl',+  postscanl, postscanl',+  scanl, scanl',+  scanl1, scanl1',    -- * Conversions   toList, fromList, liftStream,    -- * Monadic combinators-  mapM_, foldM+  mapM_, foldM, fold1M, foldM', fold1M' ) where  import Data.Vector.Fusion.Stream.Size@@ -79,6 +85,7 @@                         elem, notElem,                         foldl, foldl1, foldr, foldr1,                         and, or,+                        scanl, scanl1,                         mapM_ )  -- | The type of pure streams @@ -87,6 +94,42 @@ -- | Alternative name for monadic streams type MStream = M.Stream +inplace :: (forall m. Monad m => M.Stream m a -> M.Stream m a)+        -> Stream a -> Stream a+{-# INLINE_STREAM inplace #-}+inplace f s = f s++{-# RULES++"inplace/inplace [Vector]"+  forall (f :: forall m. Monad m => MStream m a -> MStream m a)+         (g :: forall m. Monad m => MStream m a -> MStream m a)+         s.+  inplace f (inplace g s) = inplace (f . g) s++  #-}++inplace' :: (forall m. Monad m => M.Stream m a -> M.Stream m b)+         -> Stream a -> Stream b+{-# INLINE_STREAM inplace' #-}+inplace' f s = f s++-- FIXME: We'd like to have this+{- RULES++"inplace' [Vector]" inplace' = inplace+-}+-- but it's only available in 6.13+-- (see http://hackage.haskell.org/trac/ghc/ticket/3670)++{-# RULES++"inplace' [Vector]"+  forall (f :: forall m. Monad m => MStream m a -> MStream m a).+  inplace' f = inplace f++  #-}+ -- | Convert a pure stream to a monadic stream liftStream :: Monad m => Stream a -> M.Stream m a {-# INLINE_STREAM liftStream #-}@@ -130,7 +173,7 @@  -- | Replicate a value to a given length replicate :: Int -> a -> Stream a-{-# INLINE_STREAM replicate #-}+{-# INLINE replicate #-} replicate = M.replicate  -- | Prepend an element@@ -332,6 +375,37 @@ {-# INLINE prescanl' #-} prescanl' = M.prescanl' +-- | Suffix scan+postscanl :: (a -> b -> a) -> a -> Stream b -> Stream a+{-# INLINE postscanl #-}+postscanl = M.postscanl++-- | Suffix scan with strict accumulator+postscanl' :: (a -> b -> a) -> a -> Stream b -> Stream a+{-# INLINE postscanl' #-}+postscanl' = M.postscanl'++-- | Haskell-style scan+scanl :: (a -> b -> a) -> a -> Stream b -> Stream a+{-# INLINE scanl #-}+scanl = M.scanl++-- | Haskell-style scan with strict accumulator+scanl' :: (a -> b -> a) -> a -> Stream b -> Stream a+{-# INLINE scanl' #-}+scanl' = M.scanl'++-- | Scan over a non-empty 'Stream'+scanl1 :: (a -> a -> a) -> Stream a -> Stream a+{-# INLINE scanl1 #-}+scanl1 = M.scanl1++-- | Scan over a non-empty 'Stream' with a strict accumulator+scanl1' :: (a -> a -> a) -> Stream a -> Stream a+{-# INLINE scanl1' #-}+scanl1' = M.scanl1'++ -- Comparisons -- ----------- @@ -381,13 +455,29 @@  -- | Apply a monadic action to each element of the stream mapM_ :: Monad m => (a -> m ()) -> Stream a -> m ()-{-# INLINE_STREAM mapM_ #-}+{-# INLINE mapM_ #-} mapM_ f = M.mapM_ f . liftStream  -- | Monadic fold foldM :: Monad m => (a -> b -> m a) -> a -> Stream b -> m a-{-# INLINE_STREAM foldM #-}+{-# INLINE foldM #-} foldM m z = M.foldM m z . liftStream++-- | Monadic fold over non-empty stream+fold1M :: Monad m => (a -> a -> m a) -> Stream a -> m a+{-# INLINE fold1M #-}+fold1M m = M.fold1M m . liftStream++-- | Monadic fold with strict accumulator+foldM' :: Monad m => (a -> b -> m a) -> a -> Stream b -> m a+{-# INLINE foldM' #-}+foldM' m z = M.foldM' m z . liftStream++-- | Monad fold over non-empty stream with strict accumulator+fold1M' :: Monad m => (a -> a -> m a) -> Stream a -> m a+{-# INLINE fold1M' #-}+fold1M' m = M.fold1M' m . liftStream+  -- Conversions -- -----------
Data/Vector/Fusion/Stream/Monadic.hs view
@@ -2,7 +2,7 @@  -- | -- Module      : Data.Vector.Fusion.Stream.Monadic--- Copyright   : (c) Roman Leshchinskiy 2008+-- Copyright   : (c) Roman Leshchinskiy 2008-2009 -- License     : BSD-style -- -- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au>@@ -45,8 +45,8 @@   elem, notElem, find, findM, findIndex, findIndexM,    -- * Folding-  foldl, foldlM, foldM, foldl1, foldl1M,-  foldl', foldlM', foldl1', foldl1M',+  foldl, foldlM, foldl1, foldl1M, foldM, fold1M,+  foldl', foldlM', foldl1', foldl1M', foldM', fold1M',   foldr, foldrM, foldr1, foldr1M,    -- * Specialised folds@@ -57,6 +57,9 @@    -- * Scans   prescanl, prescanlM, prescanl', prescanlM',+  postscanl, postscanlM, postscanl', postscanlM',+  scanl, scanlM, scanl', scanlM',+  scanl1, scanl1M, scanl1', scanl1M',    -- * Conversions   toList, fromList@@ -74,7 +77,8 @@                         filter, takeWhile, dropWhile,                         elem, notElem,                         foldl, foldl1, foldr, foldr1,-                        and, or )+                        and, or,+                        scanl, scanl1 ) import qualified Prelude  -- | Result of taking a single step in a stream@@ -122,7 +126,7 @@ {-# INLINE_STREAM singleton #-} singleton x = Stream (return . step) True (Exact 1)   where-    {-# INLINE step #-}+    {-# INLINE_INNER step #-}     step True  = Yield x False     step False = Done @@ -131,7 +135,7 @@ {-# INLINE_STREAM replicate #-} replicate n x = Stream (return . step) n (Exact (max n 0))   where-    {-# INLINE step #-}+    {-# INLINE_INNER step #-}     step i | i > 0     = Yield x (i-1)            | otherwise = Done @@ -151,6 +155,7 @@ {-# INLINE_STREAM (++) #-} Stream stepa sa na ++ Stream stepb sb nb = Stream step (Left sa) (na + nb)   where+    {-# INLINE_INNER step #-}     step (Left  sa) = do                         r <- stepa sa                         case r of@@ -228,7 +233,7 @@ {-# INLINE_STREAM init #-} init (Stream step s sz) = Stream step' (Nothing, s) (sz - 1)   where-    {-# INLINE step' #-}+    {-# INLINE_INNER step' #-}     step' (Nothing, s) = liftM (\r ->                            case r of                              Yield x s' -> Skip (Just x,  s')@@ -248,7 +253,7 @@ {-# INLINE_STREAM tail #-} tail (Stream step s sz) = Stream step' (Left s) (sz - 1)   where-    {-# INLINE step' #-}+    {-# INLINE_INNER step' #-}     step' (Left  s) = liftM (\r ->                         case r of                           Yield x s' -> Skip (Right s')@@ -268,7 +273,7 @@ {-# INLINE_STREAM take #-} take n (Stream step s sz) = Stream step' (s, 0) (smaller (Exact n) sz)   where-    {-# INLINE step' #-}+    {-# INLINE_INNER step' #-}     step' (s, i) | i < n = liftM (\r ->                              case r of                                Yield x s' -> Yield x (s', i+1)@@ -282,7 +287,7 @@ {-# INLINE_STREAM drop #-} drop n (Stream step s sz) = Stream step' (s, Just n) (sz - Exact n)   where-    {-# INLINE step' #-}+    {-# INLINE_INNER step' #-}     step' (s, Just i) | i > 0 = liftM (\r ->                                 case r of                                    Yield x s' -> Skip (s', Just (i-1))@@ -316,7 +321,7 @@ {-# INLINE_STREAM mapM #-} mapM f (Stream step s n) = Stream step' s n   where-    {-# INLINE step' #-}+    {-# INLINE_INNER step' #-}     step' s = do                 r <- step s                 case r of@@ -356,7 +361,7 @@ zipWithM f (Stream stepa sa na) (Stream stepb sb nb)   = Stream step (sa, sb, Nothing) (smaller na nb)   where-    {-# INLINE step #-}+    {-# INLINE_INNER step #-}     step (sa, sb, Nothing) = liftM (\r ->                                case r of                                  Yield x sa' -> Skip (sa', sb, Just x)@@ -385,7 +390,7 @@ zipWith3M f (Stream stepa sa na) (Stream stepb sb nb) (Stream stepc sc nc)   = Stream step (sa, sb, sc, Nothing) (smaller na (smaller nb nc))   where-    {-# INLINE step #-}+    {-# INLINE_INNER step #-}     step (sa, sb, sc, Nothing) = do         r <- stepa sa         return $ case r of@@ -420,7 +425,7 @@ {-# INLINE_STREAM filterM #-} filterM f (Stream step s n) = Stream step' s (toMax n)   where-    {-# INLINE step' #-}+    {-# INLINE_INNER step' #-}     step' s = do                 r <- step s                 case r of@@ -441,7 +446,7 @@ {-# INLINE_STREAM takeWhileM #-} takeWhileM f (Stream step s n) = Stream step' s (toMax n)   where-    {-# INLINE step' #-}+    {-# INLINE_INNER step' #-}     step' s = do                 r <- step s                 case r of@@ -466,7 +471,7 @@     -- NOTE: we jump through hoops here to have only one Yield; local data     -- declarations would be nice! -    {-# INLINE step' #-}+    {-# INLINE_INNER step' #-}     step' (DropWhile_Drop s)       = do           r <- step s@@ -597,6 +602,11 @@                        Skip    s' -> foldl1M_go s'                        Done       -> errorEmptyStream "foldl1M" +-- | Same as 'foldl1M'+fold1M :: Monad m => (a -> a -> m a) -> Stream m a -> m a+{-# INLINE fold1M #-}+fold1M = foldl1M+ -- | Left fold with a strict accumulator foldl' :: Monad m => (a -> b -> a) -> a -> Stream m b -> m a {-# INLINE foldl' #-}@@ -615,6 +625,11 @@                          Skip    s' -> foldlM'_go z s'                          Done       -> return z +-- | Same as 'foldlM''+foldM' :: Monad m => (a -> b -> m a) -> a -> Stream m b -> m a+{-# INLINE foldM' #-}+foldM' = foldlM'+ -- | Left fold over a non-empty 'Stream' with a strict accumulator foldl1' :: Monad m => (a -> a -> a) -> Stream m a -> m a {-# INLINE foldl1' #-}@@ -633,6 +648,11 @@                         Skip    s' -> foldl1M'_go s'                         Done       -> errorEmptyStream "foldl1M'" +-- | Same as 'foldl1M''+fold1M' :: Monad m => (a -> a -> m a) -> Stream m a -> m a+{-# INLINE fold1M' #-}+fold1M' = foldl1M'+ -- | Right fold foldr :: Monad m => (a -> b -> b) -> b -> Stream m a -> m b {-# INLINE foldr #-}@@ -737,7 +757,7 @@ {-# INLINE_STREAM unfoldrM #-} unfoldrM f s = Stream step s Unknown   where-    {-# INLINE step #-}+    {-# INLINE_INNER step #-}     step s = liftM (\r ->                case r of                  Just (x, s') -> Yield x s'@@ -757,7 +777,7 @@ {-# INLINE_STREAM prescanlM #-} prescanlM f z (Stream step s sz) = Stream step' (s,z) sz   where-    {-# INLINE step' #-}+    {-# INLINE_INNER step' #-}     step' (s,x) = do                     r <- step s                     case r of@@ -777,7 +797,7 @@ {-# INLINE_STREAM prescanlM' #-} prescanlM' f z (Stream step s sz) = Stream step' (s,z) sz   where-    {-# INLINE step' #-}+    {-# INLINE_INNER step' #-}     step' (s,x) = x `seq`                   do                     r <- step s@@ -787,6 +807,123 @@                                       return $ Yield x (s', z)                       Skip    s' -> return $ Skip (s', x)                       Done       -> return Done++-- | Suffix scan+postscanl :: Monad m => (a -> b -> a) -> a -> Stream m b -> Stream m a+{-# INLINE postscanl #-}+postscanl f = postscanlM (\a b -> return (f a b))++-- | Suffix scan with a monadic operator+postscanlM :: Monad m => (a -> b -> m a) -> a -> Stream m b -> Stream m a+{-# INLINE_STREAM postscanlM #-}+postscanlM f z (Stream step s sz) = Stream step' (s,z) sz+  where+    {-# INLINE_INNER step' #-}+    step' (s,x) = do+                    r <- step s+                    case r of+                      Yield y s' -> do+                                      z <- f x y+                                      return $ Yield z (s',z)+                      Skip    s' -> return $ Skip (s',x)+                      Done       -> return Done++-- | Suffix scan with strict accumulator+postscanl' :: Monad m => (a -> b -> a) -> a -> Stream m b -> Stream m a+{-# INLINE postscanl' #-}+postscanl' f = postscanlM' (\a b -> return (f a b))++-- | Suffix scan with strict acccumulator and a monadic operator+postscanlM' :: Monad m => (a -> b -> m a) -> a -> Stream m b -> Stream m a+{-# INLINE_STREAM postscanlM' #-}+postscanlM' f z (Stream step s sz) = z `seq` Stream step' (s,z) sz+  where+    {-# INLINE_INNER step' #-}+    step' (s,x) = x `seq`+                  do+                    r <- step s+                    case r of+                      Yield y s' -> do+                                      z <- f x y+                                      z `seq` return (Yield z (s',z))+                      Skip    s' -> return $ Skip (s',x)+                      Done       -> return Done++-- | Haskell-style scan+scanl :: Monad m => (a -> b -> a) -> a -> Stream m b -> Stream m a+{-# INLINE scanl #-}+scanl f = scanlM (\a b -> return (f a b))++-- | Haskell-style scan with a monadic operator+scanlM :: Monad m => (a -> b -> m a) -> a -> Stream m b -> Stream m a+{-# INLINE scanlM #-}+scanlM f z s = z `cons` postscanlM f z s++-- | Haskell-style scan with strict accumulator+scanl' :: Monad m => (a -> b -> a) -> a -> Stream m b -> Stream m a+{-# INLINE scanl' #-}+scanl' f = scanlM' (\a b -> return (f a b))++-- | Haskell-style scan with strict accumulator and a monadic operator+scanlM' :: Monad m => (a -> b -> m a) -> a -> Stream m b -> Stream m a+{-# INLINE scanlM' #-}+scanlM' f z s = z `seq` (z `cons` postscanlM f z s)++-- | Scan over a non-empty 'Stream'+scanl1 :: Monad m => (a -> a -> a) -> Stream m a -> Stream m a+{-# INLINE scanl1 #-}+scanl1 f = scanl1M (\x y -> return (f x y))++-- | Scan over a non-empty 'Stream' with a monadic operator+scanl1M :: Monad m => (a -> a -> m a) -> Stream m a -> Stream m a+{-# INLINE_STREAM scanl1M #-}+scanl1M f (Stream step s sz) = Stream step' (s, Nothing) sz+  where+    {-# INLINE_INNER step' #-}+    step' (s, Nothing) = do+                           r <- step s+                           case r of+                             Yield x s' -> return $ Yield x (s', Just x)+                             Skip    s' -> return $ Skip (s', Nothing)+                             Done       -> errorEmptyStream "scanl1M"++    step' (s, Just x) = do+                          r <- step s+                          case r of+                            Yield y s' -> do+                                            z <- f x y+                                            return $ Yield z (s', Just z)+                            Skip    s' -> return $ Skip (s', Just x)+                            Done       -> return Done++-- | Scan over a non-empty 'Stream' with a strict accumulator+scanl1' :: Monad m => (a -> a -> a) -> Stream m a -> Stream m a+{-# INLINE scanl1' #-}+scanl1' f = scanl1M' (\x y -> return (f x y))++-- | Scan over a non-empty 'Stream' with a strict accumulator and a monadic+-- operator+scanl1M' :: Monad m => (a -> a -> m a) -> Stream m a -> Stream m a+{-# INLINE_STREAM scanl1M' #-}+scanl1M' f (Stream step s sz) = Stream step' (s, Nothing) sz+  where+    {-# INLINE_INNER step' #-}+    step' (s, Nothing) = do+                           r <- step s+                           case r of+                             Yield x s' -> x `seq` return (Yield x (s', Just x))+                             Skip    s' -> return $ Skip (s', Nothing)+                             Done       -> errorEmptyStream "scanl1M"++    step' (s, Just x) = x `seq`+                        do+                          r <- step s+                          case r of+                            Yield y s' -> do+                                            z <- f x y+                                            z `seq` return (Yield z (s', Just z))+                            Skip    s' -> return $ Skip (s', Just x)+                            Done       -> return Done  -- Conversions -- -----------
Data/Vector/Fusion/Stream/Size.hs view
@@ -1,6 +1,6 @@ -- | -- Module      : Data.Vector.Fusion.Stream.Size--- Copyright   : (c) Roman Leshchinskiy 2008+-- Copyright   : (c) Roman Leshchinskiy 2008-2009 -- License     : BSD-style -- -- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au>
+ Data/Vector/Generic.hs view
@@ -0,0 +1,647 @@+{-# LANGUAGE Rank2Types, MultiParamTypeClasses, FlexibleContexts,+             ScopedTypeVariables #-}+-- |+-- Module      : Data.Vector.Generic+-- Copyright   : (c) Roman Leshchinskiy 2008-2009+-- License     : BSD-style+--+-- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au>+-- Stability   : experimental+-- Portability : non-portable+-- +-- Generic interface to pure vectors+--++#include "phases.h"++module Data.Vector.Generic (+  -- * Immutable vectors+  Vector(..),++  -- * Length information+  length, null,++  -- * Construction+  empty, singleton, cons, snoc, replicate, (++), copy,++  -- * Accessing individual elements+  (!), head, last, indexM, headM, lastM,++  -- * Subvectors+  slice, init, tail, take, drop,++  -- * Permutations+  accum, (//), update, backpermute, reverse,++  -- * Mapping+  map, concatMap,++  -- * Zipping and unzipping+  zipWith, zipWith3, zip, zip3, unzip, unzip3,++  -- * Comparisons+  eq, cmp,++  -- * Filtering+  filter, takeWhile, dropWhile,++  -- * Searching+  elem, notElem, find, findIndex,++  -- * Folding+  foldl, foldl1, foldl', foldl1', foldr, foldr1,+ +  -- * Specialised folds+  and, or, sum, product, maximum, minimum,++  -- * Unfolding+  unfoldr,++  -- * Scans+  prescanl, prescanl',+  postscanl, postscanl',+  scanl, scanl', scanl1, scanl1',++  -- * Enumeration+  enumFromTo, enumFromThenTo,++  -- * Conversion to/from lists+  toList, fromList,++  -- * Conversion to/from Streams+  stream, unstream,++  -- * MVector-based initialisation+  new+) where++import           Data.Vector.Generic.Mutable ( MVector )++import qualified Data.Vector.Generic.New as New+import           Data.Vector.Generic.New ( New )++import qualified Data.Vector.Fusion.Stream as Stream+import           Data.Vector.Fusion.Stream ( Stream, MStream, inplace, inplace' )+import qualified Data.Vector.Fusion.Stream.Monadic as MStream+import           Data.Vector.Fusion.Stream.Size+import           Data.Vector.Fusion.Util++import Control.Exception ( assert )++import Prelude hiding ( length, null,+                        replicate, (++),+                        head, last,+                        init, tail, take, drop, reverse,+                        map, concatMap,+                        zipWith, zipWith3, zip, zip3, unzip, unzip3,+                        filter, takeWhile, dropWhile,+                        elem, notElem,+                        foldl, foldl1, foldr, foldr1,+                        and, or, sum, product, maximum, minimum,+                        scanl, scanl1,+                        enumFromTo, enumFromThenTo )++-- | Class of immutable vectors.+--+class Vector v a where+  -- | Construct a pure vector from a monadic initialiser (not fusible!)+  vnew         :: (forall mv m. MVector mv m a => m (mv a)) -> v a++  -- | Length of the vector (not fusible!)+  vlength      :: v a -> Int++  -- | Yield a part of the vector without copying it. No range checks!+  unsafeSlice  :: v a -> Int -> Int -> 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 'unsafeIndexM', we can do+  --+  -- > copy mv v ... = ... case unsafeIndexM 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.+  --+  unsafeIndexM  :: Monad m => v a -> Int -> m a++-- Fusion+-- ------++-- | Construct a pure vector from a monadic initialiser +new :: Vector v a => New a -> v a+{-# INLINE new #-}+new m = new' undefined 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 = vnew (New.run m)++-- | Convert a vector to a 'Stream'+stream :: Vector v a => v a -> Stream a+{-# INLINE_STREAM stream #-}+stream v = v `seq` (Stream.unfoldr get 0 `Stream.sized` Exact n)+  where+    n = length v++    {-# INLINE get #-}+    get i | i < n     = case unsafeIndexM v i of Box x -> Just (x, i+1)+          | otherwise = Nothing++-- | Create a vector from a 'Stream'+unstream :: Vector v a => Stream a -> v a+{-# INLINE unstream #-}+unstream s = new (New.unstream s)++{-# 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++ #-}++{-# RULES++"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++"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))++ #-}++-- Length+-- ------++length :: Vector v a => v a -> Int+{-# INLINE_STREAM length #-}+length v = vlength v++{-# RULES++"length/unstream [Vector]" forall v s.+  length (new' v (New.unstream s)) = Stream.length s++  #-}++null :: Vector v a => v a -> Bool+{-# INLINE_STREAM null #-}+null v = vlength v == 0++{-# RULES++"null/unstream [Vector]" forall v s.+  null (new' v (New.unstream s)) = Stream.null s++  #-}++-- Construction+-- ------------++-- | Empty vector+empty :: Vector v a => v a+{-# INLINE empty #-}+empty = unstream Stream.empty++-- | Vector with exaclty one element+singleton :: Vector v a => a -> v a+{-# INLINE singleton #-}+singleton x = unstream (Stream.singleton x)++-- | Vector of the given length with the given value in each position+replicate :: Vector v a => Int -> a -> v a+{-# INLINE replicate #-}+replicate n = unstream . Stream.replicate n++-- | Prepend an element+cons :: Vector v a => a -> v a -> v a+{-# INLINE cons #-}+cons x = unstream . Stream.cons x . stream++-- | Append an element+snoc :: Vector v a => v a -> a -> v a+{-# INLINE snoc #-}+snoc v = unstream . Stream.snoc (stream v)++infixr 5 +++-- | Concatenate two vectors+(++) :: Vector v a => v a -> v a -> v a+{-# INLINE (++) #-}+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)++ #-}++-- Accessing individual elements+-- -----------------------------++-- | Indexing+(!) :: Vector v a => v a -> Int -> a+{-# INLINE_STREAM (!) #-}+v ! i = assert (i >= 0 && i < length v)+      $ unId (unsafeIndexM v i)++-- | First element+head :: Vector v a => v a -> a+{-# INLINE_STREAM head #-}+head v = v ! 0++-- | Last element+last :: Vector v a => v a -> a+{-# INLINE_STREAM last #-}+last v = v ! (length v - 1)++{-# RULES++"(!)/unstream [Vector]" forall v i s.+  new' v (New.unstream s) ! i = s Stream.!! i++"head/unstream [Vector]" forall v s.+  head (new' v (New.unstream s)) = Stream.head s++"last/unstream [Vector]" forall v s.+  last (new' v (New.unstream s)) = Stream.last s++ #-}++-- | Monadic indexing which can be strict in the vector while remaining lazy in+-- the element.+indexM :: (Vector v a, Monad m) => v a -> Int -> m a+{-# INLINE_STREAM indexM #-}+indexM v i = assert (i >= 0 && i < length v)+           $ unsafeIndexM v i++headM :: (Vector v a, Monad m) => v a -> m a+{-# INLINE_STREAM headM #-}+headM v = indexM v 0++lastM :: (Vector v a, Monad m) => v a -> m a+{-# INLINE_STREAM lastM #-}+lastM v = indexM v (length v - 1)++-- FIXME: the rhs of these rules are lazy in the stream which is WRONG+{- RULES++"indexM/unstream [Vector]" forall v i s.+  indexM (new' v (New.unstream s)) i = return (s Stream.!! i)++"headM/unstream [Vector]" forall v s.+  headM (new' v (New.unstream s)) = return (Stream.head s)++"lastM/unstream [Vector]" forall v s.+  lastM (new' v (New.unstream s)) = return (Stream.last s)++ -}++-- Subarrays+-- ---------++-- FIXME: slicing doesn't work with the inplace stuff at the moment++-- | Yield a part of the vector without copying it. Safer version of+-- 'unsafeSlice'.+slice :: Vector v a => v a -> Int   -- ^ starting index+                            -> Int   -- ^ length+                            -> v a+{-# INLINE_STREAM slice #-}+slice v i n = assert (i >= 0 && n >= 0  && i+n <= length v)+            $ unsafeSlice v i n++-- | Yield all but the last element without copying.+init :: Vector v a => v a -> v a+{-# INLINE_STREAM init #-}+init v = slice v 0 (length v - 1)++-- | All but the first element (without copying).+tail :: Vector v a => v a -> v a+{-# INLINE_STREAM tail #-}+tail v = slice v 1 (length v - 1)++-- | Yield the first @n@ elements without copying.+take :: Vector v a => Int -> v a -> v a+{-# INLINE_STREAM take #-}+take n v = slice v 0 (min n' (length v))+  where n' = max n 0++-- | Yield all but the first @n@ elements without copying.+drop :: Vector v a => Int -> v a -> v a+{-# INLINE_STREAM drop #-}+drop n v = slice v (min n' len) (max 0 (len - n'))+  where n' = max n 0+        len = length v++{-# RULES++"slice/new [Vector]" forall v p i n.+  slice (new' v p) i n = new' v (New.slice p i n)++"init/new [Vector]" forall v p.+  init (new' v p) = new' v (New.init p)++"tail/new [Vector]" forall v p.+  tail (new' v p) = new' v (New.tail p)++"take/new [Vector]" forall n v p.+  take n (new' v p) = new' v (New.take n p)++"drop/new [Vector]" forall n v p.+  drop n (new' v p) = new' v (New.drop n p)++  #-}++-- Permutations+-- ------------++accum :: Vector v a => (a -> b -> a) -> v a -> [(Int,b)] -> v a+{-# INLINE accum #-}+accum f v us = new (New.accum f (New.unstream (stream v))+                                (Stream.fromList us))++(//) :: Vector v a => v a -> [(Int, a)] -> v a+{-# INLINE (//) #-}+v // us = new (New.update (New.unstream (stream v))+                          (Stream.fromList us))++update :: (Vector v a, Vector v (Int, a)) => v a -> v (Int, a) -> v a+{-# INLINE update #-}+update v w = new (New.update (New.unstream (stream v)) (stream w))++-- This somewhat non-intuitive definition ensures that the resulting vector+-- does not retain references to the original one even if it is lazy in its+-- elements. This would not be the case if we simply used+--+-- backpermute v is = map (v!) is+backpermute :: (Vector v a, Vector v Int) => v a -> v Int -> v a+{-# INLINE backpermute #-}+backpermute v is = seq v+                 $ unstream+                 $ MStream.trans (Id . unBox)+                 $ MStream.mapM (indexM v)+                 $ MStream.trans (Box . unId)+                 $ stream is++reverse :: (Vector v a) => v a -> v a+{-# INLINE reverse #-}+reverse = new . New.reverse . New.unstream . stream++-- Mapping+-- -------++-- | Map a function over a vector+map :: (Vector v a, Vector v b) => (a -> b) -> v a -> v b+{-# INLINE map #-}+map f = unstream . inplace' (MStream.map f) . stream++concatMap :: (Vector v a, Vector v b) => (a -> v b) -> v a -> v b+{-# INLINE concatMap #-}+concatMap f = unstream . Stream.concatMap (stream . f) . stream++-- Zipping/unzipping+-- -----------------++-- | Zip two vectors with the given function.+zipWith :: (Vector v a, Vector v b, Vector v c) => (a -> b -> c) -> v a -> v b -> v c+{-# INLINE zipWith #-}+zipWith f xs ys = unstream (Stream.zipWith f (stream xs) (stream ys))++-- | Zip three vectors with the given function.+zipWith3 :: (Vector v a, Vector v b, Vector v c, Vector v d) => (a -> b -> c -> d) -> v a -> v b -> v c -> v d+{-# INLINE zipWith3 #-}+zipWith3 f xs ys zs = unstream (Stream.zipWith3 f (stream xs) (stream ys) (stream zs))++zip :: (Vector v a, Vector v b, Vector v (a,b)) => v a -> v b -> v (a, b)+{-# INLINE zip #-}+zip = zipWith (,)++zip3 :: (Vector v a, Vector v b, Vector v c, Vector v (a, b, c)) => v a -> v b -> v c -> v (a, b, c)+{-# INLINE zip3 #-}+zip3 = zipWith3 (,,)++unzip :: (Vector v a, Vector v b, Vector v (a,b)) => v (a, b) -> (v a, v b)+{-# INLINE unzip #-}+unzip xs = (map fst xs, map snd xs)++unzip3 :: (Vector v a, Vector v b, Vector v c, Vector v (a, b, c)) => v (a, b, c) -> (v a, v b, v c)+{-# INLINE unzip3 #-}+unzip3 xs = (map (\(a, b, c) -> a) xs, map (\(a, b, c) -> b) xs, map (\(a, b, c) -> c) xs)++-- Comparisons+-- -----------++eq :: (Vector v a, Eq a) => v a -> v a -> Bool+{-# INLINE eq #-}+xs `eq` ys = stream xs == stream ys++cmp :: (Vector v a, Ord a) => v a -> v a -> Ordering+{-# INLINE cmp #-}+cmp xs ys = compare (stream xs) (stream ys)++-- Filtering+-- ---------++-- | Drop elements which do not satisfy the predicate+filter :: Vector v a => (a -> Bool) -> v a -> v a+{-# INLINE filter #-}+filter f = unstream . inplace (MStream.filter f) . stream++-- | Yield the longest prefix of elements satisfying the predicate.+takeWhile :: Vector v a => (a -> Bool) -> v a -> v a+{-# INLINE takeWhile #-}+takeWhile f = unstream . Stream.takeWhile f . stream++-- | Drop the longest prefix of elements that satisfy the predicate.+dropWhile :: Vector v a => (a -> Bool) -> v a -> v a+{-# INLINE dropWhile #-}+dropWhile f = unstream . Stream.dropWhile f . stream++-- Searching+-- ---------++infix 4 `elem`+-- | Check whether the vector contains an element+elem :: (Vector v a, Eq a) => a -> v a -> Bool+{-# INLINE elem #-}+elem x = Stream.elem x . stream++infix 4 `notElem`+-- | Inverse of `elem`+notElem :: (Vector v a, Eq a) => a -> v a -> Bool+{-# INLINE notElem #-}+notElem x = Stream.notElem x . stream++-- | Yield 'Just' the first element matching the predicate or 'Nothing' if no+-- such element exists.+find :: Vector v a => (a -> Bool) -> v a -> Maybe a+{-# INLINE find #-}+find f = Stream.find f . stream++-- | Yield 'Just' the index of the first element matching the predicate or+-- 'Nothing' if no such element exists.+findIndex :: Vector v a => (a -> Bool) -> v a -> Maybe Int+{-# INLINE findIndex #-}+findIndex f = Stream.findIndex f . stream++-- Folding+-- -------++-- | Left fold+foldl :: Vector v b => (a -> b -> a) -> a -> v b -> a+{-# INLINE foldl #-}+foldl f z = Stream.foldl f z . stream++-- | Lefgt fold on non-empty vectors+foldl1 :: Vector v a => (a -> a -> a) -> v a -> a+{-# INLINE foldl1 #-}+foldl1 f = Stream.foldl1 f . stream++-- | Left fold with strict accumulator+foldl' :: Vector v b => (a -> b -> a) -> a -> v b -> a+{-# INLINE foldl' #-}+foldl' f z = Stream.foldl' f z . stream++-- | Left fold on non-empty vectors with strict accumulator+foldl1' :: Vector v a => (a -> a -> a) -> v a -> a+{-# INLINE foldl1' #-}+foldl1' f = Stream.foldl1' f . stream++-- | Right fold+foldr :: Vector v a => (a -> b -> b) -> b -> v a -> b+{-# INLINE foldr #-}+foldr f z = Stream.foldr f z . stream++-- | Right fold on non-empty vectors+foldr1 :: Vector v a => (a -> a -> a) -> v a -> a+{-# INLINE foldr1 #-}+foldr1 f = Stream.foldr1 f . stream++-- Specialised folds+-- -----------------++and :: Vector v Bool => v Bool -> Bool+{-# INLINE and #-}+and = Stream.and . stream++or :: Vector v Bool => v Bool -> Bool+{-# INLINE or #-}+or = Stream.or . stream++sum :: (Vector v a, Num a) => v a -> a+{-# INLINE sum #-}+sum = Stream.foldl' (+) 0 . stream++product :: (Vector v a, Num a) => v a -> a+{-# INLINE product #-}+product = Stream.foldl' (*) 1 . stream++maximum :: (Vector v a, Ord a) => v a -> a+{-# INLINE maximum #-}+maximum = Stream.foldl1' max . stream++minimum :: (Vector v a, Ord a) => v a -> a+{-# INLINE minimum #-}+minimum = Stream.foldl1' min . stream++-- Unfolding+-- ---------++unfoldr :: Vector v a => (b -> Maybe (a, b)) -> b -> v a+{-# INLINE unfoldr #-}+unfoldr f = unstream . Stream.unfoldr f++-- Scans+-- -----++-- | Prefix scan+prescanl :: (Vector v a, Vector v b) => (a -> b -> a) -> a -> v b -> v a+{-# INLINE prescanl #-}+prescanl f z = unstream . inplace' (MStream.prescanl f z) . stream++-- | Prefix scan with strict accumulator+prescanl' :: (Vector v a, Vector v b) => (a -> b -> a) -> a -> v b -> v a+{-# INLINE prescanl' #-}+prescanl' f z = unstream . inplace' (MStream.prescanl' f z) . stream++-- | Suffix scan+postscanl :: (Vector v a, Vector v b) => (a -> b -> a) -> a -> v b -> v a+{-# INLINE postscanl #-}+postscanl f z = unstream . inplace' (MStream.postscanl f z) . stream++-- | Suffix scan with strict accumulator+postscanl' :: (Vector v a, Vector v b) => (a -> b -> a) -> a -> v b -> v a+{-# INLINE postscanl' #-}+postscanl' f z = unstream . inplace' (MStream.postscanl' f z) . stream++-- | Haskell-style scan+scanl :: (Vector v a, Vector v b) => (a -> b -> a) -> a -> v b -> v a+{-# INLINE scanl #-}+scanl f z = unstream . Stream.scanl f z . stream++-- | Haskell-style scan with strict accumulator+scanl' :: (Vector v a, Vector v b) => (a -> b -> a) -> a -> v b -> v a+{-# INLINE scanl' #-}+scanl' f z = unstream . Stream.scanl' f z . stream++-- | Scan over a non-empty vector+scanl1 :: Vector v a => (a -> a -> a) -> v a -> v a+{-# INLINE scanl1 #-}+scanl1 f = unstream . inplace (MStream.scanl1 f) . stream++-- | Scan over a non-empty vector with a strict accumulator+scanl1' :: Vector v a => (a -> a -> a) -> v a -> v a+{-# INLINE scanl1' #-}+scanl1' f = unstream . inplace (MStream.scanl1' f) . stream++-- Enumeration+-- -----------++-- FIXME: The Enum class is irreparably broken, there just doesn't seem to be a+-- way to implement this generically. Either specialise this or define a new+-- Enum-like class with a proper interface.++enumFromTo :: (Vector v a, Enum a) => a -> a -> v a+{-# INLINE enumFromTo #-}+enumFromTo from to = fromList [from .. to]++enumFromThenTo :: (Vector v a, Enum a) => a -> a -> a -> v a+{-# INLINE enumFromThenTo #-}+enumFromThenTo from next to = fromList [from, next .. to]++-- | Convert a vector to a list+toList :: Vector v a => v a -> [a]+{-# INLINE toList #-}+toList = Stream.toList . stream++-- | Convert a list to a vector+fromList :: Vector v a => [a] -> v a+{-# INLINE fromList #-}+fromList = unstream . Stream.fromList+
+ Data/Vector/Generic/Mutable.hs view
@@ -0,0 +1,256 @@+{-# LANGUAGE MultiParamTypeClasses, BangPatterns #-}+-- |+-- Module      : Data.Vector.Generic.Mutable+-- Copyright   : (c) Roman Leshchinskiy 2008-2009+-- License     : BSD-style+--+-- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au>+-- Stability   : experimental+-- Portability : non-portable+-- +-- Generic interface to mutable vectors+--++#include "phases.h"++module Data.Vector.Generic.Mutable (+  MVectorPure(..), MVector(..),++  slice, new, newWith, read, write, copy, grow,+  unstream, transform,+  accum, update, reverse+) where++import qualified Data.Vector.Fusion.Stream      as Stream+import           Data.Vector.Fusion.Stream      ( Stream, MStream )+import qualified Data.Vector.Fusion.Stream.Monadic as MStream+import           Data.Vector.Fusion.Stream.Size++import Control.Exception ( assert )++import GHC.Float (+    double2Int, int2Double+  )++import Prelude hiding ( length, reverse, map, read )++gROWTH_FACTOR :: Double+gROWTH_FACTOR = 1.5++-- | Basic pure functions on mutable vectors+class MVectorPure v a where+  -- | Length of the mutable vector+  length           :: v a -> Int++  -- | Yield a part of the mutable vector without copying it. No range checks!+  unsafeSlice      :: v a -> Int  -- ^ starting index+                          -> Int  -- ^ length of the slice+                          -> v a++  -- Check whether two vectors overlap.+  overlaps         :: v a -> v a -> Bool++-- | Class of mutable vectors. The type @m@ is the monad in which the mutable+-- vector can be transformed and @a@ is the type of elements.+--+class (Monad m, MVectorPure v a) => MVector v m a where+  -- | Create a mutable vector of the given length. Length is not checked!+  unsafeNew        :: Int -> m (v a)++  -- | Create a mutable vector of the given length and fill it with an+  -- initial value. Length is not checked!+  unsafeNewWith    :: Int -> a -> m (v a)++  -- | Yield the element at the given position. Index is not checked!+  unsafeRead       :: v a -> Int -> m a++  -- | Replace the element at the given position. Index is not checked!+  unsafeWrite      :: v a -> Int -> a -> m ()++  -- | Clear all references to external objects+  clear            :: v a -> m ()++  -- | Write the value at each position.+  set              :: v a -> a -> m ()++  -- | Copy a vector. The two vectors may not overlap. This is not checked!+  unsafeCopy       :: v a   -- ^ target+                   -> v a   -- ^ source+                   -> m ()++  -- | Grow a vector by the given number of elements. The length is not+  -- checked!+  unsafeGrow       :: v a -> Int -> m (v a)++  {-# INLINE unsafeNewWith #-}+  unsafeNewWith n x = do+                        v <- unsafeNew n+                        set v x+                        return v++  {-# INLINE set #-}+  set v x = do_set 0+    where+      n = length v++      do_set i | i < n = do+                            unsafeWrite v i x+                            do_set (i+1)+                | otherwise = return ()++  {-# INLINE unsafeCopy #-}+  unsafeCopy dst src = do_copy 0+    where+      n = length src++      do_copy i | i < n = do+                            x <- unsafeRead src i+                            unsafeWrite dst i x+                            do_copy (i+1)+                | otherwise = return ()++  {-# INLINE unsafeGrow #-}+  unsafeGrow v by = do+                      v' <- unsafeNew (n+by)+                      unsafeCopy (unsafeSlice v' 0 n) v+                      return v'+    where+      n = length v++-- | Test whether the index is valid for the vector+inBounds :: MVectorPure v a => v a -> Int -> Bool+{-# INLINE inBounds #-}+inBounds v i = i >= 0 && i < length v++-- | Yield a part of the mutable vector without copying it. Safer version of+-- 'unsafeSlice'.+slice :: MVectorPure v a => v a -> Int -> Int -> v a+{-# INLINE slice #-}+slice v i n = assert (i >=0 && n >= 0 && i+n <= length v)+            $ unsafeSlice v i n++-- | Create a mutable vector of the given length. Safer version of+-- 'unsafeNew'.+new :: MVector v m a => Int -> m (v a)+{-# INLINE new #-}+new n = assert (n >= 0) $ unsafeNew n++-- | Create a mutable vector of the given length and fill it with an+-- initial value. Safer version of 'unsafeNewWith'.+newWith :: MVector v m a => Int -> a -> m (v a)+{-# INLINE newWith #-}+newWith n x = assert (n >= 0) $ unsafeNewWith n x++-- | Yield the element at the given position. Safer version of 'unsafeRead'.+read :: MVector v m a => v a -> Int -> m a+{-# INLINE read #-}+read v i = assert (inBounds v i) $ unsafeRead v i++-- | Replace the element at the given position. Safer version of+-- 'unsafeWrite'.+write :: MVector v m a => v a -> Int -> a -> m ()+{-# INLINE write #-}+write v i x = assert (inBounds v i) $ unsafeWrite v i x++-- | Copy a vector. The two vectors may not overlap. Safer version of+-- 'unsafeCopy'.+copy :: MVector v m a => v a -> v a -> m ()+{-# INLINE copy #-}+copy dst src = assert (not (dst `overlaps` src) && length dst == length src)+             $ unsafeCopy dst src++-- | Grow a vector by the given number of elements. Safer version of+-- 'unsafeGrow'.+grow :: MVector v m a => v a -> Int -> m (v a)+{-# INLINE grow #-}+grow v by = assert (by >= 0)+          $ unsafeGrow v by++mstream :: MVector v m a => v a -> MStream m a+{-# INLINE mstream #-}+mstream v = v `seq` (MStream.unfoldrM get 0 `MStream.sized` Exact n)+  where+    n = length v++    {-# INLINE_INNER get #-}+    get i | i < n     = do x <- unsafeRead v i+                           return $ Just (x, i+1)+          | otherwise = return $ Nothing++munstream :: MVector v m a => v a -> MStream m a -> m (v a)+{-# INLINE munstream #-}+munstream v s = v `seq` do+                          n' <- MStream.foldM put 0 s+                          return $ slice v 0 n'+  where+    {-# INLINE_INNER put #-}+    put i x = do { write v i x; return (i+1) }++transform :: MVector v m a => (MStream m a -> MStream m a) -> v a -> m (v a)+{-# INLINE_STREAM transform #-}+transform f v = munstream v (f (mstream 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.+unstream :: MVector v m a => Stream a -> m (v a)+{-# INLINE_STREAM unstream #-}+unstream s = case upperBound (Stream.size s) of+               Just n  -> unstreamMax     s n+               Nothing -> unstreamUnknown s++unstreamMax :: MVector v m a => Stream a -> Int -> m (v a)+{-# INLINE unstreamMax #-}+unstreamMax s n+  = do+      v  <- new n+      let put i x = do { write v i x; return (i+1) }+      n' <- Stream.foldM' put 0 s+      return $ slice v 0 n'++unstreamUnknown :: MVector v m a => Stream a -> m (v a)+{-# INLINE unstreamUnknown #-}+unstreamUnknown s+  = do+      v <- new 0+      (v', n) <- Stream.foldM put (v, 0) s+      return $ slice v' 0 n+  where+    {-# INLINE_INNER put #-}+    put (v, i) x = do+                     v' <- enlarge v i+                     unsafeWrite v' i x+                     return (v', i+1)++    {-# INLINE_INNER enlarge #-}+    enlarge v i | i < length v = return v+                | otherwise    = unsafeGrow v+                                 . max 1+                                 . double2Int+                                 $ int2Double (length v) * gROWTH_FACTOR++accum :: MVector v m a => (a -> b -> a) -> v a -> Stream (Int, b) -> m ()+{-# INLINE accum #-}+accum f !v s = Stream.mapM_ upd s+  where+    {-# INLINE_INNER upd #-}+    upd (i,b) = do+                  a <- read v i+                  write v i (f a b)++update :: MVector v m a => v a -> Stream (Int, a) -> m ()+{-# INLINE update #-}+update = accum (const id)++reverse :: MVector v m a => v a -> m ()+{-# INLINE reverse #-}+reverse !v = reverse_loop 0 (length v - 1)+  where+    reverse_loop i j | i < j = do+                                 x <- unsafeRead v i+                                 y <- unsafeRead v j+                                 unsafeWrite v i y+                                 unsafeWrite v j x+                                 reverse_loop (i + 1) (j - 1)+    reverse_loop _ _ = return ()+
+ Data/Vector/Generic/New.hs view
@@ -0,0 +1,118 @@+{-# LANGUAGE Rank2Types #-}++-- |+-- Module      : Data.Vector.Generic.New+-- Copyright   : (c) Roman Leshchinskiy 2008-2009+-- License     : BSD-style+--+-- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au>+-- Stability   : experimental+-- Portability : non-portable+-- +-- Purely functional interface to initialisation of mutable vectors+--++#include "phases.h"++module Data.Vector.Generic.New (+  New(..), run, unstream, transform, accum, update, reverse,+  slice, init, tail, take, drop+) where++import qualified Data.Vector.Generic.Mutable as MVector+import           Data.Vector.Generic.Mutable ( MVector, MVectorPure )++import           Data.Vector.Fusion.Stream ( Stream, MStream )+import qualified Data.Vector.Fusion.Stream as Stream++import Control.Monad  ( liftM )+import Prelude hiding ( init, tail, take, drop, reverse, map, filter )++newtype New a = New (forall m mv. MVector mv m a => m (mv a))++run :: MVector mv m a => New a -> m (mv a)+{-# INLINE run #-}+run (New p) = p++apply :: (forall mv a. MVectorPure mv a => mv a -> mv a) -> New a -> New a+{-# INLINE apply #-}+apply f (New p) = New (liftM f p)++modify :: New a -> (forall m mv. MVector mv m a => mv a -> m ()) -> New a+{-# INLINE modify #-}+modify (New p) q = New (do { v <- p; q v; return v })++unstream :: Stream a -> New a+{-# INLINE_STREAM unstream #-}+unstream s = New (MVector.unstream s)++transform :: (forall m. Monad m => MStream m a -> MStream m a) -> New a -> New a+{-# INLINE_STREAM transform #-}+transform f (New p) = New (MVector.transform f =<< p)++{-# RULES++"transform/transform [New]"+  forall (f :: forall m. Monad m => MStream m a -> MStream m a)+         (g :: forall m. Monad m => MStream m a -> MStream m a)+         p .+  transform f (transform g p) = transform (f . g) p++"transform/unstream [New]"+  forall (f :: forall m. Monad m => MStream m a -> MStream m a)+         s.+  transform f (unstream s) = unstream (f s)++ #-}++slice :: New a -> Int -> Int -> New a+{-# INLINE_STREAM slice #-}+slice m i n = apply (\v -> MVector.slice v i n) m++init :: New a -> New a+{-# INLINE_STREAM init #-}+init m = apply (\v -> MVector.slice v 0 (MVector.length v - 1)) m++tail :: New a -> New a+{-# INLINE_STREAM tail #-}+tail m = apply (\v -> MVector.slice v 1 (MVector.length v - 1)) m++take :: Int -> New a -> New a+{-# INLINE_STREAM take #-}+take n m = apply (\v -> MVector.slice v 0 (min n (MVector.length v))) m++drop :: Int -> New a -> New a+{-# INLINE_STREAM drop #-}+drop n m = apply (\v -> MVector.slice v n (max 0 (MVector.length v - n))) m++{-# RULES++"slice/unstream [New]" forall s i n.+  slice (unstream s) i n = unstream (Stream.extract s i n)++"init/unstream [New]" forall s.+  init (unstream s) = unstream (Stream.init s)++"tail/unstream [New]" forall s.+  tail (unstream s) = unstream (Stream.tail s)++"take/unstream [New]" forall n s.+  take n (unstream s) = unstream (Stream.take n s)++"drop/unstream [New]" forall n s.+  drop n (unstream s) = unstream (Stream.drop n s)++  #-}++accum :: (a -> b -> a) -> New a -> Stream (Int, b) -> New a+{-# INLINE_STREAM accum #-}+accum f m s = modify m (\v -> MVector.accum f v s)++update :: New a -> Stream (Int, a) -> New a+{-# INLINE_STREAM update #-}+update m s = modify m (\v -> MVector.update v s)++reverse :: New a -> New a+{-# INLINE_STREAM reverse #-}+reverse m = modify m (MVector.reverse)+
− Data/Vector/IVector.hs 
@@ -1,667 +0,0 @@-{-# LANGUAGE Rank2Types, MultiParamTypeClasses, FlexibleContexts,-             ScopedTypeVariables #-}--- |--- Module      : Data.Vector.IVector--- Copyright   : (c) Roman Leshchinskiy 2008--- License     : BSD-style------ Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au>--- Stability   : experimental--- Portability : non-portable--- --- Generic interface to pure vectors-----#include "phases.h"--module Data.Vector.IVector (-  -- * Immutable vectors-  IVector,--  -- * Length information-  length, null,--  -- * Construction-  empty, singleton, cons, snoc, replicate, (++), copy,--  -- * Accessing individual elements-  (!), head, last, indexM, headM, lastM,--  -- * Subvectors-  slice, init, tail, take, drop,--  -- * Permutations-  accum, (//), update, backpermute, reverse,--  -- * Mapping-  map, concatMap,--  -- * Zipping and unzipping-  zipWith, zipWith3, zip, zip3, unzip, unzip3,--  -- * Comparisons-  eq, cmp,--  -- * Filtering-  filter, takeWhile, dropWhile,--  -- * Searching-  elem, notElem, find, findIndex,--  -- * Folding-  foldl, foldl1, foldl', foldl1', foldr, foldr1,- -  -- * Specialised folds-  and, or, sum, product, maximum, minimum,--  -- * Unfolding-  unfoldr,--  -- * Scans-  prescanl, prescanl',--  -- * Enumeration-  enumFromTo, enumFromThenTo,--  -- * Conversion to/from lists-  toList, fromList,--  -- * Conversion to/from Streams-  stream, unstream,--  -- * MVector-based initialisation-  new,--  -- * Unsafe functions-  unsafeSlice, unsafeIndexM,--  -- * Utility functions-  vlength, vnew-) where--import qualified Data.Vector.MVector as MVector-import           Data.Vector.MVector ( MVector )--import qualified Data.Vector.MVector.New as New-import           Data.Vector.MVector.New ( New )--import qualified Data.Vector.Fusion.Stream as Stream-import           Data.Vector.Fusion.Stream ( Stream, MStream )-import qualified Data.Vector.Fusion.Stream.Monadic as MStream-import           Data.Vector.Fusion.Stream.Size-import           Data.Vector.Fusion.Util--import Control.Exception ( assert )--import Prelude hiding ( length, null,-                        replicate, (++),-                        head, last,-                        init, tail, take, drop, reverse,-                        map, concatMap,-                        zipWith, zipWith3, zip, zip3, unzip, unzip3,-                        filter, takeWhile, dropWhile,-                        elem, notElem,-                        foldl, foldl1, foldr, foldr1,-                        and, or, sum, product, maximum, minimum,-                        enumFromTo, enumFromThenTo )---- | Class of immutable vectors.----class IVector v a where-  -- | Construct a pure vector from a monadic initialiser (not fusible!)-  vnew         :: (forall mv m. MVector mv m a => m (mv a)) -> v a--  -- | Length of the vector (not fusible!)-  vlength      :: v a -> Int--  -- | Yield a part of the vector without copying it. No range checks!-  unsafeSlice  :: v a -> Int -> Int -> 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 'unsafeIndexM', we can do-  ---  -- > copy mv v ... = ... case unsafeIndexM 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.-  ---  unsafeIndexM  :: Monad m => v a -> Int -> m a---- Fusion--- ---------- | Construct a pure vector from a monadic initialiser -new :: IVector v a => New a -> v a-{-# INLINE new #-}-new m = new' undefined 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' :: IVector v a => v a -> New a -> v a-{-# INLINE_STREAM new' #-}-new' _ m = vnew (New.run m)---- | Convert a vector to a 'Stream'-stream :: IVector v a => v a -> Stream a-{-# INLINE_STREAM stream #-}-stream v = v `seq` (Stream.unfoldr get 0 `Stream.sized` Exact n)-  where-    n = length v--    {-# INLINE get #-}-    get i | i < n     = case unsafeIndexM v i of Box x -> Just (x, i+1)-          | otherwise = Nothing---- | Create a vector from a 'Stream'-unstream :: IVector v a => Stream a -> v a-{-# INLINE unstream #-}-unstream s = new (New.unstream s)--{-# RULES--"stream/unstream [IVector]" forall v s.-  stream (new' v (New.unstream s)) = s--"New.unstream/stream/new [IVector]" forall v p.-  New.unstream (stream (new' v p)) = p-- #-}--inplace :: (forall m. Monad m => MStream m a -> MStream m a)-        -> Stream a -> Stream a-{-# INLINE_STREAM inplace #-}-inplace f s = f s--{-# RULES--"inplace [IVector]"-  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--"uninplace [IVector]"-  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))--"inplace/inplace [IVector]"-  forall (f :: forall m. Monad m => MStream m a -> MStream m a)-         (g :: forall m. Monad m => MStream m a -> MStream m a)-         s.-  inplace f (inplace g s) = inplace (f . g) s-- #-}---- Length--- --------length :: IVector v a => v a -> Int-{-# INLINE_STREAM length #-}-length v = vlength v--{-# RULES--"length/unstream [IVector]" forall v s.-  length (new' v (New.unstream s)) = Stream.length s--  #-}--null :: IVector v a => v a -> Bool-{-# INLINE_STREAM null #-}-null v = vlength v == 0--{-# RULES--"null/unstream [IVector]" forall v s.-  null (new' v (New.unstream s)) = Stream.null s--  #-}---- Construction--- ---------------- | Empty vector-empty :: IVector v a => v a-{-# INLINE empty #-}-empty = unstream Stream.empty---- | Vector with exaclty one element-singleton :: IVector v a => a -> v a-{-# INLINE singleton #-}-singleton x = unstream (Stream.singleton x)---- | Vector of the given length with the given value in each position-replicate :: IVector v a => Int -> a -> v a-{-# INLINE replicate #-}-replicate n = unstream . Stream.replicate n---- | Prepend an element-cons :: IVector v a => a -> v a -> v a-{-# INLINE cons #-}-cons x = unstream . Stream.cons x . stream---- | Append an element-snoc :: IVector v a => v a -> a -> v a-{-# INLINE snoc #-}-snoc v = unstream . Stream.snoc (stream v)--infixr 5 ++--- | Concatenate two vectors-(++) :: IVector v a => v a -> v a -> v a-{-# INLINE (++) #-}-v ++ w = unstream (stream v Stream.++ stream w)---- | Create a copy of a vector. Useful when dealing with slices.-copy :: IVector v a => v a -> v a-{-# INLINE_STREAM copy #-}-copy = unstream . stream--{-# RULES--"copy/unstream [IVector]" forall v s.-  copy (new' v (New.unstream s)) = new' v (New.unstream s)-- #-}---- Accessing individual elements--- --------------------------------- | Indexing-(!) :: IVector v a => v a -> Int -> a-{-# INLINE_STREAM (!) #-}-v ! i = assert (i >= 0 && i < length v)-      $ unId (unsafeIndexM v i)---- | First element-head :: IVector v a => v a -> a-{-# INLINE_STREAM head #-}-head v = v ! 0---- | Last element-last :: IVector v a => v a -> a-{-# INLINE_STREAM last #-}-last v = v ! (length v - 1)--{-# RULES--"(!)/unstream [IVector]" forall v i s.-  new' v (New.unstream s) ! i = s Stream.!! i--"head/unstream [IVector]" forall v s.-  head (new' v (New.unstream s)) = Stream.head s--"last/unstream [IVector]" forall v s.-  last (new' v (New.unstream s)) = Stream.last s-- #-}---- | Monadic indexing which can be strict in the vector while remaining lazy in--- the element.-indexM :: (IVector v a, Monad m) => v a -> Int -> m a-{-# INLINE_STREAM indexM #-}-indexM v i = assert (i >= 0 && i < length v)-           $ unsafeIndexM v i--headM :: (IVector v a, Monad m) => v a -> m a-{-# INLINE_STREAM headM #-}-headM v = indexM v 0--lastM :: (IVector v a, Monad m) => v a -> m a-{-# INLINE_STREAM lastM #-}-lastM v = indexM v (length v - 1)--{-# RULES--"indexM/unstream [IVector]" forall v i s.-  indexM (new' v (New.unstream s)) i = return (s Stream.!! i)--"headM/unstream [IVector]" forall v s.-  headM (new' v (New.unstream s)) = return (Stream.head s)--"lastM/unstream [IVector]" forall v s.-  lastM (new' v (New.unstream s)) = return (Stream.last s)-- #-}---- Subarrays--- ------------- FIXME: slicing doesn't work with the inplace stuff at the moment---- | Yield a part of the vector without copying it. Safer version of--- 'unsafeSlice'.-slice :: IVector v a => v a -> Int   -- ^ starting index-                            -> Int   -- ^ length-                            -> v a-{-# INLINE_STREAM slice #-}-slice v i n = assert (i >= 0 && n >= 0  && i+n <= length v)-            $ unsafeSlice v i n---- | Yield all but the last element without copying.-init :: IVector v a => v a -> v a-{-# INLINE_STREAM init #-}-init v = slice v 0 (length v - 1)---- | All but the first element (without copying).-tail :: IVector v a => v a -> v a-{-# INLINE_STREAM tail #-}-tail v = slice v 1 (length v - 1)---- | Yield the first @n@ elements without copying.-take :: IVector v a => Int -> v a -> v a-{-# INLINE_STREAM take #-}-take n v = slice v 0 (min n' (length v))-  where n' = max n 0---- | Yield all but the first @n@ elements without copying.-drop :: IVector v a => Int -> v a -> v a-{-# INLINE_STREAM drop #-}-drop n v = slice v (min n' len) (max 0 (len - n'))-  where n' = max n 0-        len = length v--{-# RULES--"slice/new [IVector]" forall v p i n.-  slice (new' v p) i n = new' v (New.slice p i n)--"init/new [IVector]" forall v p.-  init (new' v p) = new' v (New.init p)--"tail/new [IVector]" forall v p.-  tail (new' v p) = new' v (New.tail p)--"take/new [IVector]" forall n v p.-  take n (new' v p) = new' v (New.take n p)--"drop/new [IVector]" forall n v p.-  drop n (new' v p) = new' v (New.drop n p)--  #-}---- Permutations--- --------------accum :: IVector v a => (a -> b -> a) -> v a -> [(Int,b)] -> v a-{-# INLINE accum #-}-accum f v us = new (New.accum f (New.unstream (stream v))-                                (Stream.fromList us))--(//) :: IVector v a => v a -> [(Int, a)] -> v a-{-# INLINE (//) #-}-v // us = new (New.update (New.unstream (stream v))-                          (Stream.fromList us))--update :: (IVector v a, IVector v (Int, a)) => v a -> v (Int, a) -> v a-{-# INLINE update #-}-update v w = new (New.update (New.unstream (stream v)) (stream w))---- This somewhat non-intuitive definition ensures that the resulting vector--- does not retain references to the original one even if it is lazy in its--- elements. This would not be the case if we simply used------ backpermute v is = map (v!) is-backpermute :: (IVector v a, IVector v Int) => v a -> v Int -> v a-{-# INLINE backpermute #-}-backpermute v is = unstream-                 . MStream.trans (Id . unBox)-                 . MStream.mapM (indexM v)-                 . MStream.trans (Box . unId)-                 $ stream is--reverse :: (IVector v a) => v a -> v a-{-# INLINE reverse #-}-reverse = new . New.reverse . New.unstream . stream---- Mapping--- ----------- | Map a function over a vector-map :: (IVector v a, IVector v b) => (a -> b) -> v a -> v b-{-# INLINE map #-}-map f = unstream . Stream.map f . stream--inplace_map :: IVector v a => (a -> a) -> v a -> v a-{-# INLINE inplace_map #-}-inplace_map f = unstream . inplace (MStream.map f) . stream--{-# RULES--"map->inplace_map [IVector]" map = inplace_map-- #-}--concatMap :: (IVector v a, IVector v b) => (a -> v b) -> v a -> v b-{-# INLINE concatMap #-}-concatMap f = unstream . Stream.concatMap (stream . f) . stream---- Zipping/unzipping--- --------------------- | Zip two vectors with the given function.-zipWith :: (IVector v a, IVector v b, IVector v c) => (a -> b -> c) -> v a -> v b -> v c-{-# INLINE zipWith #-}-zipWith f xs ys = unstream (Stream.zipWith f (stream xs) (stream ys))---- | Zip three vectors with the given function.-zipWith3 :: (IVector v a, IVector v b, IVector v c, IVector v d) => (a -> b -> c -> d) -> v a -> v b -> v c -> v d-{-# INLINE zipWith3 #-}-zipWith3 f xs ys zs = unstream (Stream.zipWith3 f (stream xs) (stream ys) (stream zs))--zip :: (IVector v a, IVector v b, IVector v (a,b)) => v a -> v b -> v (a, b)-{-# INLINE zip #-}-zip = zipWith (,)--zip3 :: (IVector v a, IVector v b, IVector v c, IVector v (a, b, c)) => v a -> v b -> v c -> v (a, b, c)-{-# INLINE zip3 #-}-zip3 = zipWith3 (,,)--unzip :: (IVector v a, IVector v b, IVector v (a,b)) => v (a, b) -> (v a, v b)-{-# INLINE unzip #-}-unzip xs = (map fst xs, map snd xs)--unzip3 :: (IVector v a, IVector v b, IVector v c, IVector v (a, b, c)) => v (a, b, c) -> (v a, v b, v c)-{-# INLINE unzip3 #-}-unzip3 xs = (map (\(a, b, c) -> a) xs, map (\(a, b, c) -> b) xs, map (\(a, b, c) -> c) xs)---- Comparisons--- -------------eq :: (IVector v a, Eq a) => v a -> v a -> Bool-{-# INLINE eq #-}-xs `eq` ys = stream xs == stream ys--cmp :: (IVector v a, Ord a) => v a -> v a -> Ordering-{-# INLINE cmp #-}-cmp xs ys = compare (stream xs) (stream ys)---- Filtering--- ------------- | Drop elements which do not satisfy the predicate-filter :: IVector v a => (a -> Bool) -> v a -> v a-{-# INLINE filter #-}-filter f = unstream . inplace (MStream.filter f) . stream---- | Yield the longest prefix of elements satisfying the predicate.-takeWhile :: IVector v a => (a -> Bool) -> v a -> v a-{-# INLINE takeWhile #-}-takeWhile f = unstream . Stream.takeWhile f . stream---- | Drop the longest prefix of elements that satisfy the predicate.-dropWhile :: IVector v a => (a -> Bool) -> v a -> v a-{-# INLINE dropWhile #-}-dropWhile f = unstream . Stream.dropWhile f . stream---- Searching--- -----------infix 4 `elem`--- | Check whether the vector contains an element-elem :: (IVector v a, Eq a) => a -> v a -> Bool-{-# INLINE elem #-}-elem x = Stream.elem x . stream--infix 4 `notElem`--- | Inverse of `elem`-notElem :: (IVector v a, Eq a) => a -> v a -> Bool-{-# INLINE notElem #-}-notElem x = Stream.notElem x . stream---- | Yield 'Just' the first element matching the predicate or 'Nothing' if no--- such element exists.-find :: IVector v a => (a -> Bool) -> v a -> Maybe a-{-# INLINE find #-}-find f = Stream.find f . stream---- | Yield 'Just' the index of the first element matching the predicate or--- 'Nothing' if no such element exists.-findIndex :: IVector v a => (a -> Bool) -> v a -> Maybe Int-{-# INLINE findIndex #-}-findIndex f = Stream.findIndex f . stream---- Folding--- ----------- | Left fold-foldl :: IVector v b => (a -> b -> a) -> a -> v b -> a-{-# INLINE foldl #-}-foldl f z = Stream.foldl f z . stream---- | Lefgt fold on non-empty vectors-foldl1 :: IVector v a => (a -> a -> a) -> v a -> a-{-# INLINE foldl1 #-}-foldl1 f = Stream.foldl1 f . stream---- | Left fold with strict accumulator-foldl' :: IVector v b => (a -> b -> a) -> a -> v b -> a-{-# INLINE foldl' #-}-foldl' f z = Stream.foldl' f z . stream---- | Left fold on non-empty vectors with strict accumulator-foldl1' :: IVector v a => (a -> a -> a) -> v a -> a-{-# INLINE foldl1' #-}-foldl1' f = Stream.foldl1' f . stream---- | Right fold-foldr :: IVector v a => (a -> b -> b) -> b -> v a -> b-{-# INLINE foldr #-}-foldr f z = Stream.foldr f z . stream---- | Right fold on non-empty vectors-foldr1 :: IVector v a => (a -> a -> a) -> v a -> a-{-# INLINE foldr1 #-}-foldr1 f = Stream.foldr1 f . stream---- Specialised folds--- -------------------and :: IVector v Bool => v Bool -> Bool-{-# INLINE and #-}-and = Stream.and . stream--or :: IVector v Bool => v Bool -> Bool-{-# INLINE or #-}-or = Stream.or . stream--sum :: (IVector v a, Num a) => v a -> a-{-# INLINE sum #-}-sum = Stream.foldl' (+) 0 . stream--product :: (IVector v a, Num a) => v a -> a-{-# INLINE product #-}-product = Stream.foldl' (*) 1 . stream--maximum :: (IVector v a, Ord a) => v a -> a-{-# INLINE maximum #-}-maximum = Stream.foldl1' max . stream--minimum :: (IVector v a, Ord a) => v a -> a-{-# INLINE minimum #-}-minimum = Stream.foldl1' min . stream---- Unfolding--- -----------unfoldr :: IVector v a => (b -> Maybe (a, b)) -> b -> v a-{-# INLINE unfoldr #-}-unfoldr f = unstream . Stream.unfoldr f---- Scans--- --------- | Prefix scan-prescanl :: (IVector v a, IVector v b) => (a -> b -> a) -> a -> v b -> v a-{-# INLINE prescanl #-}-prescanl f z = unstream . Stream.prescanl f z . stream--inplace_prescanl :: IVector v a => (a -> a -> a) -> a -> v a -> v a-{-# INLINE inplace_prescanl #-}-inplace_prescanl f z = unstream . inplace (MStream.prescanl f z) . stream--{-# RULES--"prescanl -> inplace_prescanl [IVector]" prescanl = inplace_prescanl-- #-}---- | Prefix scan with strict accumulator-prescanl' :: (IVector v a, IVector v b) => (a -> b -> a) -> a -> v b -> v a-{-# INLINE prescanl' #-}-prescanl' f z = unstream . Stream.prescanl' f z . stream--inplace_prescanl' :: IVector v a => (a -> a -> a) -> a -> v a -> v a-{-# INLINE inplace_prescanl' #-}-inplace_prescanl' f z = unstream . inplace (MStream.prescanl' f z) . stream--{-# RULES--"prescanl' -> inplace_prescanl' [IVector]" prescanl' = inplace_prescanl'-- #-}----- Enumeration--- -------------enumFromTo :: (IVector v a, Enum a) => a -> a -> v a-{-# INLINE enumFromTo #-}-enumFromTo from to = from `seq` to `seq` unfoldr enumFromTo_go (fromEnum from)-  where-    to_i = fromEnum to-    enumFromTo_go i | i <= to_i = Just (toEnum i, i + 1)-                    | otherwise = Nothing--enumFromThenTo :: (IVector v a, Enum a) => a -> a -> a -> v a-{-# INLINE enumFromThenTo #-}-enumFromThenTo from next to = from `seq` next `seq` to `seq` unfoldr enumFromThenTo_go from_i-  where-    from_i = fromEnum from-    to_i = fromEnum to-    step_i = fromEnum next - from_i-    enumFromThenTo_go i | i <= to_i = Just (toEnum i, i + step_i)-                        | otherwise = Nothing---- | Convert a vector to a list-toList :: IVector v a => v a -> [a]-{-# INLINE toList #-}-toList = Stream.toList . stream---- | Convert a list to a vector-fromList :: IVector v a => [a] -> v a-{-# INLINE fromList #-}-fromList = unstream . Stream.fromList-
− Data/Vector/MVector.hs 
@@ -1,256 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses #-}--- |--- Module      : Data.Vector.MVector--- Copyright   : (c) Roman Leshchinskiy 2008--- License     : BSD-style------ Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au>--- Stability   : experimental--- Portability : non-portable--- --- Generic interface to mutable vectors-----#include "phases.h"--module Data.Vector.MVector (-  MVectorPure(..), MVector(..),--  slice, new, newWith, read, write, copy, grow,-  unstream, transform,-  accum, update, reverse-) where--import qualified Data.Vector.Fusion.Stream      as Stream-import           Data.Vector.Fusion.Stream      ( Stream, MStream )-import qualified Data.Vector.Fusion.Stream.Monadic as MStream-import           Data.Vector.Fusion.Stream.Size--import Control.Monad.ST ( ST )-import Control.Exception ( assert )--import GHC.Float (-    double2Int, int2Double-  )--import Prelude hiding ( length, reverse, map, read )--gROWTH_FACTOR :: Double-gROWTH_FACTOR = 1.5---- | Basic pure functions on mutable vectors-class MVectorPure v a where-  -- | Length of the mutable vector-  length           :: v a -> Int--  -- | Yield a part of the mutable vector without copying it. No range checks!-  unsafeSlice      :: v a -> Int  -- ^ starting index-                          -> Int  -- ^ length of the slice-                          -> v a--  -- Check whether two vectors overlap.-  overlaps         :: v a -> v a -> Bool---- | Class of mutable vectors. The type @m@ is the monad in which the mutable--- vector can be transformed and @a@ is the type of elements.----class (Monad m, MVectorPure v a) => MVector v m a where-  -- | Create a mutable vector of the given length. Length is not checked!-  unsafeNew        :: Int -> m (v a)--  -- | Create a mutable vector of the given length and fill it with an-  -- initial value. Length is not checked!-  unsafeNewWith    :: Int -> a -> m (v a)--  -- | Yield the element at the given position. Index is not checked!-  unsafeRead       :: v a -> Int -> m a--  -- | Replace the element at the given position. Index is not checked!-  unsafeWrite      :: v a -> Int -> a -> m ()--  -- | Clear all references to external objects-  clear            :: v a -> m ()--  -- | Write the value at each position.-  set              :: v a -> a -> m ()--  -- | Copy a vector. The two vectors may not overlap. This is not checked!-  unsafeCopy       :: v a   -- ^ target-                   -> v a   -- ^ source-                   -> m ()--  -- | Grow a vector by the given number of elements. The length is not-  -- checked!-  unsafeGrow       :: v a -> Int -> m (v a)--  {-# INLINE unsafeNewWith #-}-  unsafeNewWith n x = do-                        v <- unsafeNew n-                        set v x-                        return v--  {-# INLINE set #-}-  set v x = do_set 0-    where-      n = length v--      do_set i | i < n = do-                            unsafeWrite v i x-                            do_set (i+1)-                | otherwise = return ()--  {-# INLINE unsafeCopy #-}-  unsafeCopy dst src = do_copy 0-    where-      n = length src--      do_copy i | i < n = do-                            x <- unsafeRead src i-                            unsafeWrite dst i x-                            do_copy (i+1)-                | otherwise = return ()--  {-# INLINE unsafeGrow #-}-  unsafeGrow v by = do-                      v' <- unsafeNew (n+by)-                      unsafeCopy (unsafeSlice v' 0 n) v-                      return v'-    where-      n = length v---- | Test whether the index is valid for the vector-inBounds :: MVectorPure v a => v a -> Int -> Bool-{-# INLINE inBounds #-}-inBounds v i = i >= 0 && i < length v---- | Yield a part of the mutable vector without copying it. Safer version of--- 'unsafeSlice'.-slice :: MVectorPure v a => v a -> Int -> Int -> v a-{-# INLINE slice #-}-slice v i n = assert (i >=0 && n >= 0 && i+n <= length v)-            $ unsafeSlice v i n---- | Create a mutable vector of the given length. Safer version of--- 'unsafeNew'.-new :: MVector v m a => Int -> m (v a)-{-# INLINE new #-}-new n = assert (n >= 0) $ unsafeNew n---- | Create a mutable vector of the given length and fill it with an--- initial value. Safer version of 'unsafeNewWith'.-newWith :: MVector v m a => Int -> a -> m (v a)-{-# INLINE newWith #-}-newWith n x = assert (n >= 0) $ unsafeNewWith n x---- | Yield the element at the given position. Safer version of 'unsafeRead'.-read :: MVector v m a => v a -> Int -> m a-{-# INLINE read #-}-read v i = assert (inBounds v i) $ unsafeRead v i---- | Replace the element at the given position. Safer version of--- 'unsafeWrite'.-write :: MVector v m a => v a -> Int -> a -> m ()-{-# INLINE write #-}-write v i x = assert (inBounds v i) $ unsafeWrite v i x---- | Copy a vector. The two vectors may not overlap. Safer version of--- 'unsafeCopy'.-copy :: MVector v m a => v a -> v a -> m ()-{-# INLINE copy #-}-copy dst src = assert (not (dst `overlaps` src) && length dst == length src)-             $ unsafeCopy dst src---- | Grow a vector by the given number of elements. Safer version of--- 'unsafeGrow'.-grow :: MVector v m a => v a -> Int -> m (v a)-{-# INLINE grow #-}-grow v by = assert (by >= 0)-          $ unsafeGrow v by--mstream :: MVector v m a => v a -> MStream m a-{-# INLINE mstream #-}-mstream v = v `seq` (MStream.unfoldrM get 0 `MStream.sized` Exact n)-  where-    n = length v--    {-# INLINE get #-}-    get i | i < n     = do x <- unsafeRead v i-                           return $ Just (x, i+1)-          | otherwise = return $ Nothing--munstream :: MVector v m a => v a -> MStream m a -> m (v a)-{-# INLINE munstream #-}-munstream v s = v `seq` do-                          n' <- MStream.foldM put 0 s-                          return $ slice v 0 n'-  where-    put i x = do { write v i x; return (i+1) }--transform :: MVector v m a => (MStream m a -> MStream m a) -> v a -> m (v a)-{-# INLINE_STREAM transform #-}-transform f v = munstream v (f (mstream 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.-unstream :: MVector v m a => Stream a -> m (v a)-{-# INLINE_STREAM unstream #-}-unstream s = case upperBound (Stream.size s) of-               Just n  -> unstreamMax     s n-               Nothing -> unstreamUnknown s--unstreamMax :: MVector v m a => Stream a -> Int -> m (v a)-{-# INLINE unstreamMax #-}-unstreamMax s n-  = do-      v  <- new n-      let put i x = do { write v i x; return (i+1) }-      n' <- Stream.foldM put 0 s-      return $ slice v 0 n'--unstreamUnknown :: MVector v m a => Stream a -> m (v a)-{-# INLINE unstreamUnknown #-}-unstreamUnknown s-  = do-      v <- new 0-      (v', n) <- Stream.foldM put (v, 0) s-      return $ slice v' 0 n-  where-    {-# INLINE put #-}-    put (v, i) x = do-                     v' <- enlarge v i-                     unsafeWrite v' i x-                     return (v', i+1)--    {-# INLINE enlarge #-}-    enlarge v i | i < length v = return v-                | otherwise    = unsafeGrow v-                                 . max 1-                                 . double2Int-                                 $ int2Double (length v) * gROWTH_FACTOR--accum :: MVector v m a => (a -> b -> a) -> v a -> Stream (Int, b) -> m ()-{-# INLINE accum #-}-accum f v s = Stream.mapM_ upd s-  where-    {-# INLINE upd #-}-    upd (i,b) = do-                  a <- read v i-                  write v i (f a b)--update :: MVector v m a => v a -> Stream (Int, a) -> m ()-{-# INLINE update #-}-update = accum (const id)--reverse :: MVector v m a => v a -> m ()-{-# INLINE reverse #-}-reverse v = reverse_loop 0 (length v - 1)-  where-    reverse_loop i j | i < j = do-                                 x <- unsafeRead v i-                                 y <- unsafeRead v j-                                 unsafeWrite v i y-                                 unsafeWrite v j x-                                 reverse_loop (i + 1) (j - 1)-    reverse_loop _ _ = return ()-
− Data/Vector/MVector/New.hs 
@@ -1,108 +0,0 @@-{-# LANGUAGE Rank2Types, ScopedTypeVariables #-}--#include "phases.h"--module Data.Vector.MVector.New (-  New(..), run, unstream, transform, accum, update, reverse,-  slice, init, tail, take, drop-) where--import qualified Data.Vector.MVector as MVector-import           Data.Vector.MVector ( MVector, MVectorPure )--import           Data.Vector.Fusion.Stream ( Stream, MStream )-import qualified Data.Vector.Fusion.Stream as Stream--import qualified Data.Vector.Fusion.Stream.Monadic as MStream--import Control.Monad  ( liftM )-import Prelude hiding ( init, tail, take, drop, reverse, map, filter )--newtype New a = New (forall m mv. MVector mv m a => m (mv a))--run :: MVector mv m a => New a -> m (mv a)-{-# INLINE run #-}-run (New p) = p--apply :: (forall mv a. MVectorPure mv a => mv a -> mv a) -> New a -> New a-{-# INLINE apply #-}-apply f (New p) = New (liftM f p)--modify :: New a -> (forall m mv. MVector mv m a => mv a -> m ()) -> New a-{-# INLINE modify #-}-modify (New p) q = New (do { v <- p; q v; return v })--unstream :: Stream a -> New a-{-# INLINE_STREAM unstream #-}-unstream s = New (MVector.unstream s)--transform :: (forall m. Monad m => MStream m a -> MStream m a) -> New a -> New a-{-# INLINE_STREAM transform #-}-transform f (New p) = New (MVector.transform f =<< p)--{-# RULES--"transform/transform [New]"-  forall (f :: forall m. Monad m => MStream m a -> MStream m a)-         (g :: forall m. Monad m => MStream m a -> MStream m a)-         p .-  transform f (transform g p) = transform (f . g) p--"transform/unstream [New]"-  forall (f :: forall m. Monad m => MStream m a -> MStream m a)-         s.-  transform f (unstream s) = unstream (f s)-- #-}--slice :: New a -> Int -> Int -> New a-{-# INLINE_STREAM slice #-}-slice m i n = apply (\v -> MVector.slice v i n) m--init :: New a -> New a-{-# INLINE_STREAM init #-}-init m = apply (\v -> MVector.slice v 0 (MVector.length v - 1)) m--tail :: New a -> New a-{-# INLINE_STREAM tail #-}-tail m = apply (\v -> MVector.slice v 1 (MVector.length v - 1)) m--take :: Int -> New a -> New a-{-# INLINE_STREAM take #-}-take n m = apply (\v -> MVector.slice v 0 (min n (MVector.length v))) m--drop :: Int -> New a -> New a-{-# INLINE_STREAM drop #-}-drop n m = apply (\v -> MVector.slice v n (max 0 (MVector.length v - n))) m--{-# RULES--"slice/unstream [New]" forall s i n.-  slice (unstream s) i n = unstream (Stream.extract s i n)--"init/unstream [New]" forall s.-  init (unstream s) = unstream (Stream.init s)--"tail/unstream [New]" forall s.-  tail (unstream s) = unstream (Stream.tail s)--"take/unstream [New]" forall n s.-  take n (unstream s) = unstream (Stream.take n s)--"drop/unstream [New]" forall n s.-  drop n (unstream s) = unstream (Stream.drop n s)--  #-}--accum :: (a -> b -> a) -> New a -> Stream (Int, b) -> New a-{-# INLINE_STREAM accum #-}-accum f m s = modify m (\v -> MVector.accum f v s)--update :: New a -> Stream (Int, a) -> New a-{-# INLINE_STREAM update #-}-update m s = modify m (\v -> MVector.update v s)--reverse :: New a -> New a-{-# INLINE_STREAM reverse #-}-reverse m = modify m (MVector.reverse)-
+ Data/Vector/Mutable.hs view
@@ -0,0 +1,65 @@+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}++-- |+-- Module      : Data.Vector.Mutable+-- Copyright   : (c) Roman Leshchinskiy 2008-2009+-- License     : BSD-style+--+-- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au>+-- Stability   : experimental+-- Portability : non-portable+-- +-- Mutable boxed vectors.+--++module Data.Vector.Mutable ( MVector(..), IOVector, STVector )+where++import qualified Data.Vector.Generic.Mutable as G+import           Data.Primitive.Array+import           Control.Monad.Primitive ( PrimMonad )+import           Control.Monad.ST ( ST )++-- | Mutable boxed vectors keyed on the monad they live in ('IO' or @'ST' s@).+data MVector m a = MVector {-# UNPACK #-} !Int+                           {-# UNPACK #-} !Int+                           {-# UNPACK #-} !(MutableArray m a)++type IOVector = MVector IO+type STVector s = MVector (ST s)++instance G.MVectorPure (MVector m) a where+  length (MVector _ n _) = n+  unsafeSlice (MVector i _ arr) j m = MVector (i+j) m arr++  {-# INLINE overlaps #-}+  overlaps (MVector i m arr1) (MVector j n arr2)+    = sameMutableArray arr1 arr2+      && (between i j (j+n) || between j i (i+m))+    where+      between x y z = x >= y && x < z+++instance PrimMonad m => G.MVector (MVector m) m a where+  {-# INLINE unsafeNew #-}+  unsafeNew n = do+                  arr <- newArray n uninitialised+                  return (MVector 0 n arr)++  {-# INLINE unsafeNewWith #-}+  unsafeNewWith n x = do+                        arr <- newArray n x+                        return (MVector 0 n arr)++  {-# INLINE unsafeRead #-}+  unsafeRead (MVector i _ arr) j = readArray arr (i+j)++  {-# INLINE unsafeWrite #-}+  unsafeWrite (MVector i _ arr) j x = writeArray arr (i+j) x++  {-# INLINE clear #-}+  clear v = G.set v uninitialised++uninitialised :: a+uninitialised = error "Data.Vector.Mutable: uninitialised element"+
− Data/Vector/Mutable/IO.hs 
@@ -1,58 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}---- |--- Module      : Data.Vector.Mutable.IO--- Copyright   : (c) Roman Leshchinskiy 2009--- License     : BSD-style------ Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au>--- Stability   : experimental--- Portability : non-portable--- --- Mutable boxed vectors in the IO monad.-----module Data.Vector.Mutable.IO ( Vector(..) )-where--import           Data.Vector.MVector ( MVector(..), MVectorPure(..) )-import qualified Data.Vector.Mutable.ST as STV--import GHC.Base   ( RealWorld )-import GHC.ST     ( ST(..) )-import GHC.IOBase ( IO(..) )--import Prelude hiding ( length )---- | IO-based mutable vectors-newtype Vector a = Vector (STV.Vector RealWorld a)--instance MVectorPure Vector a where-  {-# INLINE length #-}-  length (Vector v) = length v--  {-# INLINE unsafeSlice #-}-  unsafeSlice (Vector v) j m = Vector (unsafeSlice v j m)--  {-# INLINE overlaps #-}-  overlaps (Vector v1) (Vector v2) = overlaps v1 v2--instance MVector Vector IO a where-  {-# INLINE unsafeNew #-}-  unsafeNew n = Vector `fmap` stToIO (unsafeNew n)--  {-# INLINE unsafeNewWith #-}-  unsafeNewWith n x = Vector `fmap` stToIO (unsafeNewWith n x)--  {-# INLINE unsafeRead #-}-  unsafeRead (Vector v) i = stToIO (unsafeRead v i)--  {-# INLINE unsafeWrite #-}-  unsafeWrite (Vector v) i x = stToIO (unsafeWrite v i x)--  {-# INLINE clear #-}-  clear (Vector v) = stToIO (clear v)--stToIO :: ST RealWorld a -> IO a-stToIO (ST m) = IO m-
− Data/Vector/Mutable/ST.hs 
@@ -1,77 +0,0 @@-{-# LANGUAGE MagicHash, UnboxedTuples, MultiParamTypeClasses, FlexibleInstances #-}---- |--- Module      : Data.Vector.Mutable.ST--- Copyright   : (c) Roman Leshchinskiy 2008--- License     : BSD-style------ Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au>--- Stability   : experimental--- Portability : non-portable--- --- Mutable boxed vectors in the ST monad.-----module Data.Vector.Mutable.ST ( Vector(..) )-where--import qualified Data.Vector.MVector as MVector-import           Data.Vector.MVector ( MVector, MVectorPure )--import GHC.Prim ( MutableArray#,-                  newArray#, readArray#, writeArray#, sameMutableArray#, (+#) )--import GHC.ST   ( ST(..) )--import GHC.Base ( Int(..) )---- | Mutable boxed vectors. They live in the 'ST' monad.-data Vector s a = Vector {-# UNPACK #-} !Int-                         {-# UNPACK #-} !Int-                                        (MutableArray# s a)--instance MVectorPure (Vector s) a where-  length (Vector _ n _) = n-  unsafeSlice (Vector i _ arr#) j m = Vector (i+j) m arr#--  {-# INLINE overlaps #-}-  overlaps (Vector i m arr1#) (Vector j n arr2#)-    = sameMutableArray# arr1# arr2#-      && (between i j (j+n) || between j i (i+m))-    where-      between x y z = x >= y && x < z---instance MVector (Vector s) (ST s) a where-  {-# INLINE unsafeNew #-}-  unsafeNew = unsafeNew--  {-# INLINE unsafeNewWith #-}-  unsafeNewWith = unsafeNewWith--  {-# INLINE unsafeRead #-}-  unsafeRead (Vector (I# i#) _ arr#) (I# j#) = ST (readArray# arr# (i# +# j#))--  {-# INLINE unsafeWrite #-}-  unsafeWrite (Vector (I# i#) _ arr#) (I# j#) x = ST (\s# ->-      case writeArray# arr# (i# +# j#) x s# of s2# -> (# s2#, () #)-    )--  {-# INLINE clear #-}-  clear v = MVector.set v uninitialised---uninitialised :: a-uninitialised = error "Data.Vector.Mutable: uninitialised elemen t"--unsafeNew :: Int -> ST s (Vector s a)-{-# INLINE unsafeNew #-}-unsafeNew n = unsafeNewWith n uninitialised--unsafeNewWith :: Int -> a -> ST s (Vector s a)-{-# INLINE unsafeNewWith #-}-unsafeNewWith (I# n#) x = ST (\s# ->-    case newArray# n# x s# of-      (# s2#, arr# #) -> (# s2#, Vector 0 (I# n#) arr# #)-  )-
+ Data/Vector/Primitive.hs view
@@ -0,0 +1,435 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}++-- |+-- Module      : Data.Vector.Primitive+-- Copyright   : (c) Roman Leshchinskiy 2008-2009+-- License     : BSD-style+--+-- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au>+-- Stability   : experimental+-- Portability : non-portable+-- +-- Unboxed vectors of primitive types.+--++module Data.Vector.Primitive (+  Vector, MVector(..), Prim,++  -- * Length information+  length, null,++  -- * Construction+  empty, singleton, cons, snoc, replicate, (++), copy,++  -- * Accessing individual elements+  (!), head, last,++  -- * Subvectors+  slice, init, tail, take, drop,++  -- * Permutations+  accum, (//), backpermute, reverse,++  -- * Mapping+  map, concatMap,++  -- * Zipping and unzipping+  zipWith, zipWith3,++  -- * Filtering+  filter, takeWhile, dropWhile,++  -- * Searching+  elem, notElem, find, findIndex,++  -- * Folding+  foldl, foldl1, foldl', foldl1', foldr, foldr1,++  -- * Specialised folds+  sum, product, maximum, minimum,++  -- * Unfolding+  unfoldr,++  -- * Scans+  prescanl, prescanl',+  postscanl, postscanl',+  scanl, scanl', scanl1, scanl1',++  -- * Enumeration+  enumFromTo, enumFromThenTo,++  -- * Conversion to/from lists+  toList, fromList+) where++import qualified Data.Vector.Generic           as G+import           Data.Vector.Primitive.Mutable ( MVector(..) )+import           Data.Primitive.ByteArray+import           Data.Primitive ( Prim )++import Control.Monad.ST ( runST )++import Prelude hiding ( length, null,+                        replicate, (++),+                        head, last,+                        init, tail, take, drop, reverse,+                        map, concatMap,+                        zipWith, zipWith3, zip, zip3, unzip, unzip3,+                        filter, takeWhile, dropWhile,+                        elem, notElem,+                        foldl, foldl1, foldr, foldr1,+                        sum, product, minimum, maximum,+                        scanl, scanl1,+                        enumFromTo, enumFromThenTo )++import qualified Prelude++-- | Unboxed vectors of primitive types+data Vector a = Vector {-# UNPACK #-} !Int+                       {-# UNPACK #-} !Int+                       {-# UNPACK #-} !ByteArray++instance (Show a, Prim a) => Show (Vector a) where+    show = (Prelude.++ " :: Data.Vector.Primitive.Vector") . ("fromList " Prelude.++) . show . toList++instance Prim a => G.Vector Vector a where+  {-# INLINE vnew #-}+  vnew init = runST (do+                       MVector i n marr <- init+                       arr <- unsafeFreezeByteArray marr+                       return (Vector i n arr))++  {-# INLINE vlength #-}+  vlength (Vector _ n _) = n++  {-# INLINE unsafeSlice #-}+  unsafeSlice (Vector i _ arr) j n = Vector (i+j) n arr++  {-# INLINE unsafeIndexM #-}+  unsafeIndexM (Vector i _ arr) j = return (indexByteArray arr (i+j))++instance (Prim a, Eq a) => Eq (Vector a) where+  {-# INLINE (==) #-}+  (==) = G.eq++instance (Prim a, Ord a) => Ord (Vector a) where+  {-# INLINE compare #-}+  compare = G.cmp++-- Length+-- ------++length :: Prim a => Vector a -> Int+{-# INLINE length #-}+length = G.length++null :: Prim a => Vector a -> Bool+{-# INLINE null #-}+null = G.null++-- Construction+-- ------------++-- | Empty vector+empty :: Prim a => Vector a+{-# INLINE empty #-}+empty = G.empty++-- | Vector with exaclty one element+singleton :: Prim a => a -> Vector a+{-# INLINE singleton #-}+singleton = G.singleton++-- | Vector of the given length with the given value in each position+replicate :: Prim a => Int -> a -> Vector a+{-# INLINE replicate #-}+replicate = G.replicate++-- | Prepend an element+cons :: Prim a => a -> Vector a -> Vector a+{-# INLINE cons #-}+cons = G.cons++-- | Append an element+snoc :: Prim a => Vector a -> a -> Vector a+{-# INLINE snoc #-}+snoc = G.snoc++infixr 5 +++-- | Concatenate two vectors+(++) :: Prim a => Vector a -> Vector a -> Vector a+{-# INLINE (++) #-}+(++) = (G.++)++-- | Create a copy of a vector. Useful when dealing with slices.+copy :: Prim a => Vector a -> Vector a+{-# INLINE copy #-}+copy = G.copy++-- Accessing individual elements+-- -----------------------------++-- | Indexing+(!) :: Prim a => Vector a -> Int -> a+{-# INLINE (!) #-}+(!) = (G.!)++-- | First element+head :: Prim a => Vector a -> a+{-# INLINE head #-}+head = G.head++-- | Last element+last :: Prim a => Vector a -> a+{-# INLINE last #-}+last = G.last++-- Subarrays+-- ---------++-- | Yield a part of the vector without copying it. Safer version of+-- 'unsafeSlice'.+slice :: Prim a => Vector a -> Int   -- ^ starting index+                             -> Int   -- ^ length+                             -> Vector a+{-# INLINE slice #-}+slice = G.slice++-- | Yield all but the last element without copying.+init :: Prim a => Vector a -> Vector a+{-# INLINE init #-}+init = G.init++-- | All but the first element (without copying).+tail :: Prim a => Vector a -> Vector a+{-# INLINE tail #-}+tail = G.tail++-- | Yield the first @n@ elements without copying.+take :: Prim a => Int -> Vector a -> Vector a+{-# INLINE take #-}+take = G.take++-- | Yield all but the first @n@ elements without copying.+drop :: Prim a => Int -> Vector a -> Vector a+{-# INLINE drop #-}+drop = G.drop++-- Permutations+-- ------------++accum :: Prim a => (a -> b -> a) -> Vector a -> [(Int,b)] -> Vector a+{-# INLINE accum #-}+accum = G.accum++(//) :: Prim a => Vector a -> [(Int, a)] -> Vector a+{-# INLINE (//) #-}+(//) = (G.//)++backpermute :: Prim a => Vector a -> Vector Int -> Vector a+{-# INLINE backpermute #-}+backpermute = G.backpermute++reverse :: Prim a => Vector a -> Vector a+{-# INLINE reverse #-}+reverse = G.reverse++-- Mapping+-- -------++-- | Map a function over a vector+map :: (Prim a, Prim b) => (a -> b) -> Vector a -> Vector b+{-# INLINE map #-}+map = G.map++concatMap :: (Prim a, Prim b) => (a -> Vector b) -> Vector a -> Vector b+{-# INLINE concatMap #-}+concatMap = G.concatMap++-- Zipping/unzipping+-- -----------------++-- | Zip two vectors with the given function.+zipWith :: (Prim a, Prim b, Prim c)+        => (a -> b -> c) -> Vector a -> Vector b -> Vector c+{-# INLINE zipWith #-}+zipWith = G.zipWith++-- | Zip three vectors with the given function.+zipWith3 :: (Prim a, Prim b, Prim c, Prim d)+         => (a -> b -> c -> d) -> Vector a -> Vector b -> Vector c -> Vector d+{-# INLINE zipWith3 #-}+zipWith3 = G.zipWith3++-- Filtering+-- ---------++-- | Drop elements which do not satisfy the predicate+filter :: Prim a => (a -> Bool) -> Vector a -> Vector a+{-# INLINE filter #-}+filter = G.filter++-- | Yield the longest prefix of elements satisfying the predicate.+takeWhile :: Prim a => (a -> Bool) -> Vector a -> Vector a+{-# INLINE takeWhile #-}+takeWhile = G.takeWhile++-- | Drop the longest prefix of elements that satisfy the predicate.+dropWhile :: Prim a => (a -> Bool) -> Vector a -> Vector a+{-# INLINE dropWhile #-}+dropWhile = G.dropWhile++-- Searching+-- ---------++infix 4 `elem`+-- | Check whether the vector contains an element+elem :: (Prim a, Eq a) => a -> Vector a -> Bool+{-# INLINE elem #-}+elem = G.elem++infix 4 `notElem`+-- | Inverse of `elem`+notElem :: (Prim a, Eq a) => a -> Vector a -> Bool+{-# INLINE notElem #-}+notElem = G.notElem++-- | Yield 'Just' the first element matching the predicate or 'Nothing' if no+-- such element exists.+find :: Prim a => (a -> Bool) -> Vector a -> Maybe a+{-# INLINE find #-}+find = G.find++-- | Yield 'Just' the index of the first element matching the predicate or+-- 'Nothing' if no such element exists.+findIndex :: Prim a => (a -> Bool) -> Vector a -> Maybe Int+{-# INLINE findIndex #-}+findIndex = G.findIndex++-- Folding+-- -------++-- | Left fold+foldl :: Prim b => (a -> b -> a) -> a -> Vector b -> a+{-# INLINE foldl #-}+foldl = G.foldl++-- | Lefgt fold on non-empty vectors+foldl1 :: Prim a => (a -> a -> a) -> Vector a -> a+{-# INLINE foldl1 #-}+foldl1 = G.foldl1++-- | Left fold with strict accumulator+foldl' :: Prim b => (a -> b -> a) -> a -> Vector b -> a+{-# INLINE foldl' #-}+foldl' = G.foldl'++-- | Left fold on non-empty vectors with strict accumulator+foldl1' :: Prim a => (a -> a -> a) -> Vector a -> a+{-# INLINE foldl1' #-}+foldl1' = G.foldl1'++-- | Right fold+foldr :: Prim a => (a -> b -> b) -> b -> Vector a -> b+{-# INLINE foldr #-}+foldr = G.foldr++-- | Right fold on non-empty vectors+foldr1 :: Prim a => (a -> a -> a) -> Vector a -> a+{-# INLINE foldr1 #-}+foldr1 = G.foldr1++-- Specialised folds+-- -----------------++sum :: (Prim a, Num a) => Vector a -> a+{-# INLINE sum #-}+sum = G.sum++product :: (Prim a, Num a) => Vector a -> a+{-# INLINE product #-}+product = G.product++maximum :: (Prim a, Ord a) => Vector a -> a+{-# INLINE maximum #-}+maximum = G.maximum++minimum :: (Prim a, Ord a) => Vector a -> a+{-# INLINE minimum #-}+minimum = G.minimum++-- Unfolding+-- ---------++unfoldr :: Prim a => (b -> Maybe (a, b)) -> b -> Vector a+{-# INLINE unfoldr #-}+unfoldr = G.unfoldr++-- Scans+-- -----++-- | Prefix scan+prescanl :: (Prim a, Prim b) => (a -> b -> a) -> a -> Vector b -> Vector a+{-# INLINE prescanl #-}+prescanl = G.prescanl++-- | Prefix scan with strict accumulator+prescanl' :: (Prim a, Prim b) => (a -> b -> a) -> a -> Vector b -> Vector a+{-# INLINE prescanl' #-}+prescanl' = G.prescanl'++-- | Suffix scan+postscanl :: (Prim a, Prim b) => (a -> b -> a) -> a -> Vector b -> Vector a+{-# INLINE postscanl #-}+postscanl = G.postscanl++-- | Suffix scan with strict accumulator+postscanl' :: (Prim a, Prim b) => (a -> b -> a) -> a -> Vector b -> Vector a+{-# INLINE postscanl' #-}+postscanl' = G.postscanl'++-- | Haskell-style scan+scanl :: (Prim a, Prim b) => (a -> b -> a) -> a -> Vector b -> Vector a+{-# INLINE scanl #-}+scanl = G.scanl++-- | Haskell-style scan with strict accumulator+scanl' :: (Prim a, Prim b) => (a -> b -> a) -> a -> Vector b -> Vector a+{-# INLINE scanl' #-}+scanl' = G.scanl'++-- | Scan over a non-empty 'Vector'+scanl1 :: Prim a => (a -> a -> a) -> Vector a -> Vector a+{-# INLINE scanl1 #-}+scanl1 = G.scanl1++-- | Scan over a non-empty 'Vector' with a strict accumulator+scanl1' :: Prim a => (a -> a -> a) -> Vector a -> Vector a+{-# INLINE scanl1' #-}+scanl1' = G.scanl1'++-- Enumeration+-- -----------++enumFromTo :: (Prim a, Enum a) => a -> a -> Vector a+{-# INLINE enumFromTo #-}+enumFromTo = G.enumFromTo++enumFromThenTo :: (Prim a, Enum a) => a -> a -> a -> Vector a+{-# INLINE enumFromThenTo #-}+enumFromThenTo = G.enumFromThenTo++-- Conversion to/from lists+-- ------------------------++-- | Convert a vector to a list+toList :: Prim a => Vector a -> [a]+{-# INLINE toList #-}+toList = G.toList++-- | Convert a list to a vector+fromList :: Prim a => [a] -> Vector a+{-# INLINE fromList #-}+fromList = G.fromList+
+ Data/Vector/Primitive/Mutable.hs view
@@ -0,0 +1,58 @@+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, ScopedTypeVariables #-}++-- |+-- Module      : Data.Vector.Primitive.Mutable+-- Copyright   : (c) Roman Leshchinskiy 2008-2009+-- License     : BSD-style+--+-- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au>+-- Stability   : experimental+-- Portability : non-portable+-- +-- Mutable primitive vectors.+--++module Data.Vector.Primitive.Mutable ( MVector(..), IOVector, STVector )+where++import qualified Data.Vector.Generic.Mutable as G+import           Data.Primitive.ByteArray+import           Data.Primitive ( Prim, sizeOf )+import           Control.Monad.Primitive+import           Control.Monad.ST ( ST )++-- | Mutable unboxed vectors. They live in the 'ST' monad.+data MVector m a = MVector {-# UNPACK #-} !Int+                         {-# UNPACK #-} !Int+                         {-# UNPACK #-} !(MutableByteArray m)++type IOVector = MVector IO+type STVector s = MVector (ST s)++instance Prim a => G.MVectorPure (MVector m) a where+  length (MVector _ n _) = n+  unsafeSlice (MVector i _ arr) j m = MVector (i+j) m arr++  {-# INLINE overlaps #-}+  overlaps (MVector i m arr1) (MVector j n arr2)+    = sameMutableByteArray arr1 arr2+      && (between i j (j+n) || between j i (i+m))+    where+      between x y z = x >= y && x < z+++instance (Prim a, PrimMonad m) => G.MVector (MVector m) m a where+  {-# INLINE unsafeNew #-}+  unsafeNew n = do+                  arr <- newByteArray (n * sizeOf (undefined :: a))+                  return (MVector 0 n arr)++  {-# INLINE unsafeRead #-}+  unsafeRead (MVector i _ arr) j = readByteArray arr (i+j)++  {-# INLINE unsafeWrite #-}+  unsafeWrite (MVector i _ arr) j x = writeByteArray arr (i+j) x++  {-# INLINE clear #-}+  clear _ = return ()+
+ Data/Vector/Storable.hs view
@@ -0,0 +1,449 @@+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}++-- |+-- Module      : Data.Vector.Storable+-- Copyright   : (c) Roman Leshchinskiy 2009+-- License     : BSD-style+--+-- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au>+-- Stability   : experimental+-- Portability : non-portable+-- +-- 'Storable'-based vectors.+--++module Data.Vector.Storable (+  Vector, MVector(..), Storable,++  -- * Length information+  length, null,++  -- * Construction+  empty, singleton, cons, snoc, replicate, (++), copy,++  -- * Accessing individual elements+  (!), head, last,++  -- * Subvectors+  slice, init, tail, take, drop,++  -- * Permutations+  accum, (//), backpermute, reverse,++  -- * Mapping+  map, concatMap,++  -- * Zipping and unzipping+  zipWith, zipWith3,++  -- * Filtering+  filter, takeWhile, dropWhile,++  -- * Searching+  elem, notElem, find, findIndex,++  -- * Folding+  foldl, foldl1, foldl', foldl1', foldr, foldr1,++  -- * Specialised folds+  and, or, sum, product, maximum, minimum,++  -- * Unfolding+  unfoldr,++  -- * Scans+  prescanl, prescanl',+  postscanl, postscanl',+  scanl, scanl', scanl1, scanl1',++  -- * Enumeration+  enumFromTo, enumFromThenTo,++  -- * Conversion to/from lists+  toList, fromList+) where++import qualified Data.Vector.Generic          as G+import           Data.Vector.Storable.Mutable ( MVector(..) )+import Data.Vector.Storable.Internal++import Foreign.Storable+import Foreign.ForeignPtr++import System.IO.Unsafe ( unsafePerformIO )++import Prelude hiding ( length, null,+                        replicate, (++),+                        head, last,+                        init, tail, take, drop, reverse,+                        map, concatMap,+                        zipWith, zipWith3, zip, zip3, unzip, unzip3,+                        filter, takeWhile, dropWhile,+                        elem, notElem,+                        foldl, foldl1, foldr, foldr1,+                        and, or, sum, product, minimum, maximum,+                        scanl, scanl1,+                        enumFromTo, enumFromThenTo )++import qualified Prelude++-- | 'Storable'-based vectors+data Vector a = Vector {-# UNPACK #-} !Int+                       {-# UNPACK #-} !Int+                       {-# UNPACK #-} !(ForeignPtr a)++instance (Show a, Storable a) => Show (Vector a) where+  show = (Prelude.++ " :: Data.Vector.Storable.Vector")+       . ("fromList " Prelude.++)+       . show+       . toList++instance Storable a => G.Vector Vector a where+  {-# INLINE vnew #-}+  vnew init = unsafePerformIO (do+                                 MVector i n p <- init+                                 return (Vector i n p))++  {-# INLINE vlength #-}+  vlength (Vector _ n _) = n++  {-# INLINE unsafeSlice #-}+  unsafeSlice (Vector i _ p) j n = Vector (i+j) n p++  {-# INLINE unsafeIndexM #-}+  unsafeIndexM (Vector i _ p) j = return+                                . inlinePerformIO+                                $ withForeignPtr p (`peekElemOff` (i+j))++instance (Storable a, Eq a) => Eq (Vector a) where+  {-# INLINE (==) #-}+  (==) = G.eq++instance (Storable a, Ord a) => Ord (Vector a) where+  {-# INLINE compare #-}+  compare = G.cmp++-- Length+-- ------++length :: Storable a => Vector a -> Int+{-# INLINE length #-}+length = G.length++null :: Storable a => Vector a -> Bool+{-# INLINE null #-}+null = G.null++-- Construction+-- ------------++-- | Empty vector+empty :: Storable a => Vector a+{-# INLINE empty #-}+empty = G.empty++-- | Vector with exaclty one element+singleton :: Storable a => a -> Vector a+{-# INLINE singleton #-}+singleton = G.singleton++-- | Vector of the given length with the given value in each position+replicate :: Storable a => Int -> a -> Vector a+{-# INLINE replicate #-}+replicate = G.replicate++-- | Prepend an element+cons :: Storable a => a -> Vector a -> Vector a+{-# INLINE cons #-}+cons = G.cons++-- | Append an element+snoc :: Storable a => Vector a -> a -> Vector a+{-# INLINE snoc #-}+snoc = G.snoc++infixr 5 +++-- | Concatenate two vectors+(++) :: Storable a => Vector a -> Vector a -> Vector a+{-# INLINE (++) #-}+(++) = (G.++)++-- | Create a copy of a vector. Useful when dealing with slices.+copy :: Storable a => Vector a -> Vector a+{-# INLINE copy #-}+copy = G.copy++-- Accessing individual elements+-- -----------------------------++-- | Indexing+(!) :: Storable a => Vector a -> Int -> a+{-# INLINE (!) #-}+(!) = (G.!)++-- | First element+head :: Storable a => Vector a -> a+{-# INLINE head #-}+head = G.head++-- | Last element+last :: Storable a => Vector a -> a+{-# INLINE last #-}+last = G.last++-- Subarrays+-- ---------++-- | Yield a part of the vector without copying it. Safer version of+-- 'unsafeSlice'.+slice :: Storable a => Vector a -> Int   -- ^ starting index+                             -> Int   -- ^ length+                             -> Vector a+{-# INLINE slice #-}+slice = G.slice++-- | Yield all but the last element without copying.+init :: Storable a => Vector a -> Vector a+{-# INLINE init #-}+init = G.init++-- | All but the first element (without copying).+tail :: Storable a => Vector a -> Vector a+{-# INLINE tail #-}+tail = G.tail++-- | Yield the first @n@ elements without copying.+take :: Storable a => Int -> Vector a -> Vector a+{-# INLINE take #-}+take = G.take++-- | Yield all but the first @n@ elements without copying.+drop :: Storable a => Int -> Vector a -> Vector a+{-# INLINE drop #-}+drop = G.drop++-- Permutations+-- ------------++accum :: Storable a => (a -> b -> a) -> Vector a -> [(Int,b)] -> Vector a+{-# INLINE accum #-}+accum = G.accum++(//) :: Storable a => Vector a -> [(Int, a)] -> Vector a+{-# INLINE (//) #-}+(//) = (G.//)++backpermute :: Storable a => Vector a -> Vector Int -> Vector a+{-# INLINE backpermute #-}+backpermute = G.backpermute++reverse :: Storable a => Vector a -> Vector a+{-# INLINE reverse #-}+reverse = G.reverse++-- Mapping+-- -------++-- | Map a function over a vector+map :: (Storable a, Storable b) => (a -> b) -> Vector a -> Vector b+{-# INLINE map #-}+map = G.map++concatMap :: (Storable a, Storable b) => (a -> Vector b) -> Vector a -> Vector b+{-# INLINE concatMap #-}+concatMap = G.concatMap++-- Zipping/unzipping+-- -----------------++-- | Zip two vectors with the given function.+zipWith :: (Storable a, Storable b, Storable c)+        => (a -> b -> c) -> Vector a -> Vector b -> Vector c+{-# INLINE zipWith #-}+zipWith = G.zipWith++-- | Zip three vectors with the given function.+zipWith3 :: (Storable a, Storable b, Storable c, Storable d)+         => (a -> b -> c -> d) -> Vector a -> Vector b -> Vector c -> Vector d+{-# INLINE zipWith3 #-}+zipWith3 = G.zipWith3++-- Filtering+-- ---------++-- | Drop elements which do not satisfy the predicate+filter :: Storable a => (a -> Bool) -> Vector a -> Vector a+{-# INLINE filter #-}+filter = G.filter++-- | Yield the longest prefix of elements satisfying the predicate.+takeWhile :: Storable a => (a -> Bool) -> Vector a -> Vector a+{-# INLINE takeWhile #-}+takeWhile = G.takeWhile++-- | Drop the longest prefix of elements that satisfy the predicate.+dropWhile :: Storable a => (a -> Bool) -> Vector a -> Vector a+{-# INLINE dropWhile #-}+dropWhile = G.dropWhile++-- Searching+-- ---------++infix 4 `elem`+-- | Check whether the vector contains an element+elem :: (Storable a, Eq a) => a -> Vector a -> Bool+{-# INLINE elem #-}+elem = G.elem++infix 4 `notElem`+-- | Inverse of `elem`+notElem :: (Storable a, Eq a) => a -> Vector a -> Bool+{-# INLINE notElem #-}+notElem = G.notElem++-- | Yield 'Just' the first element matching the predicate or 'Nothing' if no+-- such element exists.+find :: Storable a => (a -> Bool) -> Vector a -> Maybe a+{-# INLINE find #-}+find = G.find++-- | Yield 'Just' the index of the first element matching the predicate or+-- 'Nothing' if no such element exists.+findIndex :: Storable a => (a -> Bool) -> Vector a -> Maybe Int+{-# INLINE findIndex #-}+findIndex = G.findIndex++-- Folding+-- -------++-- | Left fold+foldl :: Storable b => (a -> b -> a) -> a -> Vector b -> a+{-# INLINE foldl #-}+foldl = G.foldl++-- | Lefgt fold on non-empty vectors+foldl1 :: Storable a => (a -> a -> a) -> Vector a -> a+{-# INLINE foldl1 #-}+foldl1 = G.foldl1++-- | Left fold with strict accumulator+foldl' :: Storable b => (a -> b -> a) -> a -> Vector b -> a+{-# INLINE foldl' #-}+foldl' = G.foldl'++-- | Left fold on non-empty vectors with strict accumulator+foldl1' :: Storable a => (a -> a -> a) -> Vector a -> a+{-# INLINE foldl1' #-}+foldl1' = G.foldl1'++-- | Right fold+foldr :: Storable a => (a -> b -> b) -> b -> Vector a -> b+{-# INLINE foldr #-}+foldr = G.foldr++-- | Right fold on non-empty vectors+foldr1 :: Storable a => (a -> a -> a) -> Vector a -> a+{-# INLINE foldr1 #-}+foldr1 = G.foldr1++-- Specialised folds+-- -----------------++and :: Vector Bool -> Bool+{-# INLINE and #-}+and = G.and++or :: Vector Bool -> Bool+{-# INLINE or #-}+or = G.or++sum :: (Storable a, Num a) => Vector a -> a+{-# INLINE sum #-}+sum = G.sum++product :: (Storable a, Num a) => Vector a -> a+{-# INLINE product #-}+product = G.product++maximum :: (Storable a, Ord a) => Vector a -> a+{-# INLINE maximum #-}+maximum = G.maximum++minimum :: (Storable a, Ord a) => Vector a -> a+{-# INLINE minimum #-}+minimum = G.minimum++-- Unfolding+-- ---------++unfoldr :: Storable a => (b -> Maybe (a, b)) -> b -> Vector a+{-# INLINE unfoldr #-}+unfoldr = G.unfoldr++-- Scans+-- -----++-- | Prefix scan+prescanl :: (Storable a, Storable b) => (a -> b -> a) -> a -> Vector b -> Vector a+{-# INLINE prescanl #-}+prescanl = G.prescanl++-- | Prefix scan with strict accumulator+prescanl' :: (Storable a, Storable b) => (a -> b -> a) -> a -> Vector b -> Vector a+{-# INLINE prescanl' #-}+prescanl' = G.prescanl'++-- | Suffix scan+postscanl :: (Storable a, Storable b) => (a -> b -> a) -> a -> Vector b -> Vector a+{-# INLINE postscanl #-}+postscanl = G.postscanl++-- | Suffix scan with strict accumulator+postscanl' :: (Storable a, Storable b) => (a -> b -> a) -> a -> Vector b -> Vector a+{-# INLINE postscanl' #-}+postscanl' = G.postscanl'++-- | Haskell-style scan+scanl :: (Storable a, Storable b) => (a -> b -> a) -> a -> Vector b -> Vector a+{-# INLINE scanl #-}+scanl = G.scanl++-- | Haskell-style scan with strict accumulator+scanl' :: (Storable a, Storable b) => (a -> b -> a) -> a -> Vector b -> Vector a+{-# INLINE scanl' #-}+scanl' = G.scanl'++-- | Scan over a non-empty 'Vector'+scanl1 :: Storable a => (a -> a -> a) -> Vector a -> Vector a+{-# INLINE scanl1 #-}+scanl1 = G.scanl1++-- | Scan over a non-empty 'Vector' with a strict accumulator+scanl1' :: Storable a => (a -> a -> a) -> Vector a -> Vector a+{-# INLINE scanl1' #-}+scanl1' = G.scanl1'++-- Enumeration+-- -----------++enumFromTo :: (Storable a, Enum a) => a -> a -> Vector a+{-# INLINE enumFromTo #-}+enumFromTo = G.enumFromTo++enumFromThenTo :: (Storable a, Enum a) => a -> a -> a -> Vector a+{-# INLINE enumFromThenTo #-}+enumFromThenTo = G.enumFromThenTo++-- Conversion to/from lists+-- ------------------------++-- | Convert a vector to a list+toList :: Storable a => Vector a -> [a]+{-# INLINE toList #-}+toList = G.toList++-- | Convert a list to a vector+fromList :: Storable a => [a] -> Vector a+{-# INLINE fromList #-}+fromList = G.fromList+
+ Data/Vector/Storable/Internal.hs view
@@ -0,0 +1,25 @@+{-# LANGUAGE MagicHash, UnboxedTuples #-}++-- |+-- Module      : Data.Vector.Storable.Internal+-- Copyright   : (c) Roman Leshchinskiy 2009+-- License     : BSD-style+--+-- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au>+-- Stability   : experimental+-- Portability : non-portable+-- +-- Ugly internal utility functions for implementing 'Storable'-based vectors.+--++module Data.Vector.Storable.Internal+where++import GHC.Base         ( realWorld# )+import GHC.IOBase       ( IO(..) )++-- Stolen from the ByteString library+inlinePerformIO :: IO a -> a+{-# INLINE inlinePerformIO #-}+inlinePerformIO (IO m) = case m realWorld# of (# _, r #) -> r+
+ Data/Vector/Storable/Mutable.hs view
@@ -0,0 +1,54 @@+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}++-- |+-- Module      : Data.Vector.Storable.Mutable+-- Copyright   : (c) Roman Leshchinskiy 2009+-- License     : BSD-style+--+-- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au>+-- Stability   : experimental+-- Portability : non-portable+-- +-- Mutable vectors based on Storable.+--++module Data.Vector.Storable.Mutable( MVector(..) )+where++import qualified Data.Vector.Generic.Mutable as G++import Foreign.Storable+import Foreign.ForeignPtr++-- | Mutable 'Storable'-based vectors in the 'IO' monad.+data MVector a = MVector {-# UNPACK #-} !Int+                       {-# UNPACK #-} !Int+                       {-# UNPACK #-} !(ForeignPtr a)++instance G.MVectorPure MVector a where+  {-# INLINE length #-}+  length (MVector _ n _) = n++  {-# INLINE unsafeSlice #-}+  unsafeSlice (MVector i _ p) j m = MVector (i+j) m p++  -- FIXME: implement this properly+  {-# INLINE overlaps #-}+  overlaps (MVector i m p) (MVector j n q)+    = True++instance Storable a => G.MVector MVector IO a where+  {-# INLINE unsafeNew #-}+  unsafeNew n = MVector 0 n `fmap` mallocForeignPtrArray n++  {-# INLINE unsafeRead #-}+  unsafeRead (MVector i n p) j = withForeignPtr p $ \ptr ->+                                peekElemOff ptr (i+j)+     +  {-# INLINE unsafeWrite #-}+  unsafeWrite (MVector i n p) j x = withForeignPtr p $ \ptr ->+                                   pokeElemOff ptr (i+j) x ++  {-# INLINE clear #-}+  clear _ = return ()+
− Data/Vector/Unboxed.hs 
@@ -1,416 +0,0 @@-{-# LANGUAGE MagicHash, UnboxedTuples, FlexibleInstances, MultiParamTypeClasses #-}---- |--- Module      : Data.Vector.Unboxed--- Copyright   : (c) Roman Leshchinskiy 2008--- License     : BSD-style------ Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au>--- Stability   : experimental--- Portability : non-portable--- --- Unboxed vectors based on 'Unbox'.-----module Data.Vector.Unboxed (-  Vector,--  -- * Length information-  length, null,--  -- * Construction-  empty, singleton, cons, snoc, replicate, (++), copy,--  -- * Accessing individual elements-  (!), head, last,--  -- * Subvectors-  slice, init, tail, take, drop,--  -- * Permutations-  accum, (//), backpermute, reverse,--  -- * Mapping-  map, concatMap,--  -- * Zipping and unzipping-  zipWith, zipWith3,--  -- * Filtering-  filter, takeWhile, dropWhile,--  -- * Searching-  elem, notElem, find, findIndex,--  -- * Folding-  foldl, foldl1, foldl', foldl1', foldr, foldr1,--  -- * Specialised folds-  {-and, or,-} sum, product, maximum, minimum,--  -- * Unfolding-  unfoldr,--  -- * Scans-  prescanl, prescanl',--  -- * Enumeration-  enumFromTo, enumFromThenTo,--  -- * Conversion to/from lists-  toList, fromList-) where--import           Data.Vector.IVector ( IVector(..) )-import qualified Data.Vector.IVector            as IV-import qualified Data.Vector.Unboxed.Mutable.ST as Mut-import           Data.Vector.Unboxed.Unbox--import Control.Monad.ST ( runST )--import GHC.ST   ( ST(..) )-import GHC.Prim ( ByteArray#, unsafeFreezeByteArray#, (+#) )-import GHC.Base ( Int(..) )--import Prelude hiding ( length, null,-                        replicate, (++),-                        head, last,-                        init, tail, take, drop, reverse,-                        map, concatMap,-                        zipWith, zipWith3, zip, zip3, unzip, unzip3,-                        filter, takeWhile, dropWhile,-                        elem, notElem,-                        foldl, foldl1, foldr, foldr1,-                        and, or, sum, product, minimum, maximum,-                        enumFromTo, enumFromThenTo )--import qualified Prelude---- | Unboxed vectors-data Vector a = Vector {-# UNPACK #-} !Int-                       {-# UNPACK #-} !Int-                                      ByteArray#--instance (Show a, Unbox a) => Show (Vector a) where-    show = (Prelude.++ " :: Data.Vector.Unboxed.Vector") . ("fromList " Prelude.++) . show . toList--instance Unbox a => IVector Vector a where-  {-# INLINE vnew #-}-  vnew init = runST (do-                       Mut.Vector i n marr# <- init-                       ST (\s# -> case unsafeFreezeByteArray# marr# s# of-                            (# s2#, arr# #) -> (# s2#, Vector i n arr# #)))--  {-# INLINE vlength #-}-  vlength (Vector _ n _) = n--  {-# INLINE unsafeSlice #-}-  unsafeSlice (Vector i _ arr#) j n = Vector (i+j) n arr#--  {-# INLINE unsafeIndexM #-}-  unsafeIndexM (Vector (I# i#) _ arr#) (I# j#) = return (at# arr# (i# +# j#))--instance (Unbox a, Eq a) => Eq (Vector a) where-  {-# INLINE (==) #-}-  (==) = IV.eq--instance (Unbox a, Ord a) => Ord (Vector a) where-  {-# INLINE compare #-}-  compare = IV.cmp---- Length--- --------length :: Unbox a => Vector a -> Int-{-# INLINE length #-}-length = IV.length--null :: Unbox a => Vector a -> Bool-{-# INLINE null #-}-null = IV.null---- Construction--- ---------------- | Empty vector-empty :: Unbox a => Vector a-{-# INLINE empty #-}-empty = IV.empty---- | Vector with exaclty one element-singleton :: Unbox a => a -> Vector a-{-# INLINE singleton #-}-singleton = IV.singleton---- | Vector of the given length with the given value in each position-replicate :: Unbox a => Int -> a -> Vector a-{-# INLINE replicate #-}-replicate = IV.replicate---- | Prepend an element-cons :: Unbox a => a -> Vector a -> Vector a-{-# INLINE cons #-}-cons = IV.cons---- | Append an element-snoc :: Unbox a => Vector a -> a -> Vector a-{-# INLINE snoc #-}-snoc = IV.snoc--infixr 5 ++--- | Concatenate two vectors-(++) :: Unbox a => Vector a -> Vector a -> Vector a-{-# INLINE (++) #-}-(++) = (IV.++)---- | Create a copy of a vector. Useful when dealing with slices.-copy :: Unbox a => Vector a -> Vector a-{-# INLINE copy #-}-copy = IV.copy---- Accessing individual elements--- --------------------------------- | Indexing-(!) :: Unbox a => Vector a -> Int -> a-{-# INLINE (!) #-}-(!) = (IV.!)---- | First element-head :: Unbox a => Vector a -> a-{-# INLINE head #-}-head = IV.head---- | Last element-last :: Unbox a => Vector a -> a-{-# INLINE last #-}-last = IV.last---- Subarrays--- ------------- | Yield a part of the vector without copying it. Safer version of--- 'unsafeSlice'.-slice :: Unbox a => Vector a -> Int   -- ^ starting index-                             -> Int   -- ^ length-                             -> Vector a-{-# INLINE slice #-}-slice = IV.slice---- | Yield all but the last element without copying.-init :: Unbox a => Vector a -> Vector a-{-# INLINE init #-}-init = IV.init---- | All but the first element (without copying).-tail :: Unbox a => Vector a -> Vector a-{-# INLINE tail #-}-tail = IV.tail---- | Yield the first @n@ elements without copying.-take :: Unbox a => Int -> Vector a -> Vector a-{-# INLINE take #-}-take = IV.take---- | Yield all but the first @n@ elements without copying.-drop :: Unbox a => Int -> Vector a -> Vector a-{-# INLINE drop #-}-drop = IV.drop---- Permutations--- --------------accum :: Unbox a => (a -> b -> a) -> Vector a -> [(Int,b)] -> Vector a-{-# INLINE accum #-}-accum = IV.accum--(//) :: Unbox a => Vector a -> [(Int, a)] -> Vector a-{-# INLINE (//) #-}-(//) = (IV.//)--backpermute :: Unbox a => Vector a -> Vector Int -> Vector a-{-# INLINE backpermute #-}-backpermute = IV.backpermute--reverse :: Unbox a => Vector a -> Vector a-{-# INLINE reverse #-}-reverse = IV.reverse---- Mapping--- ----------- | Map a function over a vector-map :: (Unbox a, Unbox b) => (a -> b) -> Vector a -> Vector b-{-# INLINE map #-}-map = IV.map--concatMap :: (Unbox a, Unbox b) => (a -> Vector b) -> Vector a -> Vector b-{-# INLINE concatMap #-}-concatMap = IV.concatMap---- Zipping/unzipping--- --------------------- | Zip two vectors with the given function.-zipWith :: (Unbox a, Unbox b, Unbox c)-        => (a -> b -> c) -> Vector a -> Vector b -> Vector c-{-# INLINE zipWith #-}-zipWith = IV.zipWith---- | Zip three vectors with the given function.-zipWith3 :: (Unbox a, Unbox b, Unbox c, Unbox d)-         => (a -> b -> c -> d) -> Vector a -> Vector b -> Vector c -> Vector d-{-# INLINE zipWith3 #-}-zipWith3 = IV.zipWith3---- Filtering--- ------------- | Drop elements which do not satisfy the predicate-filter :: Unbox a => (a -> Bool) -> Vector a -> Vector a-{-# INLINE filter #-}-filter = IV.filter---- | Yield the longest prefix of elements satisfying the predicate.-takeWhile :: Unbox a => (a -> Bool) -> Vector a -> Vector a-{-# INLINE takeWhile #-}-takeWhile = IV.takeWhile---- | Drop the longest prefix of elements that satisfy the predicate.-dropWhile :: Unbox a => (a -> Bool) -> Vector a -> Vector a-{-# INLINE dropWhile #-}-dropWhile = IV.dropWhile---- Searching--- -----------infix 4 `elem`--- | Check whether the vector contains an element-elem :: (Unbox a, Eq a) => a -> Vector a -> Bool-{-# INLINE elem #-}-elem = IV.elem--infix 4 `notElem`--- | Inverse of `elem`-notElem :: (Unbox a, Eq a) => a -> Vector a -> Bool-{-# INLINE notElem #-}-notElem = IV.notElem---- | Yield 'Just' the first element matching the predicate or 'Nothing' if no--- such element exists.-find :: Unbox a => (a -> Bool) -> Vector a -> Maybe a-{-# INLINE find #-}-find = IV.find---- | Yield 'Just' the index of the first element matching the predicate or--- 'Nothing' if no such element exists.-findIndex :: Unbox a => (a -> Bool) -> Vector a -> Maybe Int-{-# INLINE findIndex #-}-findIndex = IV.findIndex---- Folding--- ----------- | Left fold-foldl :: Unbox b => (a -> b -> a) -> a -> Vector b -> a-{-# INLINE foldl #-}-foldl = IV.foldl---- | Lefgt fold on non-empty vectors-foldl1 :: Unbox a => (a -> a -> a) -> Vector a -> a-{-# INLINE foldl1 #-}-foldl1 = IV.foldl1---- | Left fold with strict accumulator-foldl' :: Unbox b => (a -> b -> a) -> a -> Vector b -> a-{-# INLINE foldl' #-}-foldl' = IV.foldl'---- | Left fold on non-empty vectors with strict accumulator-foldl1' :: Unbox a => (a -> a -> a) -> Vector a -> a-{-# INLINE foldl1' #-}-foldl1' = IV.foldl1'---- | Right fold-foldr :: Unbox a => (a -> b -> b) -> b -> Vector a -> b-{-# INLINE foldr #-}-foldr = IV.foldr---- | Right fold on non-empty vectors-foldr1 :: Unbox a => (a -> a -> a) -> Vector a -> a-{-# INLINE foldr1 #-}-foldr1 = IV.foldr1---- Specialised folds--- -------------------{--and :: Vector Bool -> Bool-{-# INLINE and #-}-and = IV.and--or :: Vector Bool -> Bool-{-# INLINE or #-}-or = IV.or--}--sum :: (Unbox a, Num a) => Vector a -> a-{-# INLINE sum #-}-sum = IV.sum--product :: (Unbox a, Num a) => Vector a -> a-{-# INLINE product #-}-product = IV.product--maximum :: (Unbox a, Ord a) => Vector a -> a-{-# INLINE maximum #-}-maximum = IV.maximum--minimum :: (Unbox a, Ord a) => Vector a -> a-{-# INLINE minimum #-}-minimum = IV.minimum---- Unfolding--- -----------unfoldr :: Unbox a => (b -> Maybe (a, b)) -> b -> Vector a-{-# INLINE unfoldr #-}-unfoldr = IV.unfoldr---- Scans--- --------- | Prefix scan-prescanl :: (Unbox a, Unbox b) => (a -> b -> a) -> a -> Vector b -> Vector a-{-# INLINE prescanl #-}-prescanl = IV.prescanl---- | Prefix scan with strict accumulator-prescanl' :: (Unbox a, Unbox b) => (a -> b -> a) -> a -> Vector b -> Vector a-{-# INLINE prescanl' #-}-prescanl' = IV.prescanl'---- Enumeration--- -------------enumFromTo :: (Unbox a, Enum a) => a -> a -> Vector a-{-# INLINE enumFromTo #-}-enumFromTo = IV.enumFromTo--enumFromThenTo :: (Unbox a, Enum a) => a -> a -> a -> Vector a-{-# INLINE enumFromThenTo #-}-enumFromThenTo = IV.enumFromThenTo---- Conversion to/from lists--- ---------------------------- | Convert a vector to a list-toList :: Unbox a => Vector a -> [a]-{-# INLINE toList #-}-toList = IV.toList---- | Convert a list to a vector-fromList :: Unbox a => [a] -> Vector a-{-# INLINE fromList #-}-fromList = IV.fromList-
− Data/Vector/Unboxed/Mutable/IO.hs 
@@ -1,59 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}---- |--- Module      : Data.Vector.Mutable.Unboxed.IO--- Copyright   : (c) Roman Leshchinskiy 2009--- License     : BSD-style------ Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au>--- Stability   : experimental--- Portability : non-portable--- --- Mutable unboxed vectors in the IO monad.-----module Data.Vector.Unboxed.Mutable.IO ( Vector(..) )-where--import           Data.Vector.MVector ( MVector(..), MVectorPure(..) )-import qualified Data.Vector.Unboxed.Mutable.ST as STV-import           Data.Vector.Unboxed.Unbox ( Unbox )--import GHC.Base   ( RealWorld )-import GHC.ST     ( ST(..) )-import GHC.IOBase ( IO(..) )--import Prelude hiding ( length )---- | IO-based mutable vectors-newtype Vector a = Vector (STV.Vector RealWorld a)--instance Unbox a => MVectorPure Vector a where-  {-# INLINE length #-}-  length (Vector v) = length v--  {-# INLINE unsafeSlice #-}-  unsafeSlice (Vector v) j m = Vector (unsafeSlice v j m)--  {-# INLINE overlaps #-}-  overlaps (Vector v1) (Vector v2) = overlaps v1 v2--instance Unbox a => MVector Vector IO a where-  {-# INLINE unsafeNew #-}-  unsafeNew n = Vector `fmap` stToIO (unsafeNew n)--  {-# INLINE unsafeNewWith #-}-  unsafeNewWith n x = Vector `fmap` stToIO (unsafeNewWith n x)--  {-# INLINE unsafeRead #-}-  unsafeRead (Vector v) i = stToIO (unsafeRead v i)--  {-# INLINE unsafeWrite #-}-  unsafeWrite (Vector v) i x = stToIO (unsafeWrite v i x)--  {-# INLINE clear #-}-  clear (Vector v) = stToIO (clear v)--stToIO :: ST RealWorld a -> IO a-stToIO (ST m) = IO m-
− Data/Vector/Unboxed/Mutable/ST.hs 
@@ -1,63 +0,0 @@-{-# LANGUAGE MagicHash, UnboxedTuples, MultiParamTypeClasses, FlexibleInstances, ScopedTypeVariables #-}---- |--- Module      : Data.Vector.Unboxed.Mutable.ST--- Copyright   : (c) Roman Leshchinskiy 2008--- License     : BSD-style------ Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au>--- Stability   : experimental--- Portability : non-portable--- --- Mutable unboxed vectors based on 'Unbox' in the ST monad.-----module Data.Vector.Unboxed.Mutable.ST ( Vector(..) )-where--import qualified Data.Vector.MVector as MVector-import           Data.Vector.MVector ( MVector, MVectorPure )-import           Data.Vector.Unboxed.Unbox--import GHC.Prim ( MutableByteArray#,-                  newByteArray#, sameMutableByteArray#, (+#) )--import GHC.ST   ( ST(..) )--import GHC.Base ( Int(..) )---- | Mutable unboxed vectors. They live in the 'ST' monad.-data Vector s a = Vector {-# UNPACK #-} !Int-                         {-# UNPACK #-} !Int-                                        (MutableByteArray# s)--instance Unbox a => MVectorPure (Vector s) a where-  length (Vector _ n _) = n-  unsafeSlice (Vector i _ arr#) j m = Vector (i+j) m arr#--  {-# INLINE overlaps #-}-  overlaps (Vector i m arr1#) (Vector j n arr2#)-    = sameMutableByteArray# arr1# arr2#-      && (between i j (j+n) || between j i (i+m))-    where-      between x y z = x >= y && x < z---instance Unbox a => MVector (Vector s) (ST s) a where-  {-# INLINE unsafeNew #-}-  unsafeNew (I# n#) = ST (\s# ->-      case newByteArray# (size# (undefined :: a) n#) s# of-        (# s2#, arr# #) -> (# s2#, Vector 0 (I# n#) arr# #)-    )--  {-# INLINE unsafeRead #-}-  unsafeRead (Vector (I# i#) _ arr#) (I# j#) = ST (read# arr# (i# +# j#))--  {-# INLINE unsafeWrite #-}-  unsafeWrite (Vector (I# i#) _ arr#) (I# j#) x = ST (\s# ->-      case write# arr# (i# +# j#) x s# of s2# -> (# s2#, () #)-    )--  {-# INLINE clear #-}-  clear _ = return ()-
− Data/Vector/Unboxed/Unbox.hs 
@@ -1,85 +0,0 @@-{-# LANGUAGE MagicHash, UnboxedTuples #-}---- |--- Module      : Data.Vector.Unboxed.Unbox--- Copyright   : (c) Roman Leshchinskiy 2008--- License     : BSD-style------ Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au>--- Stability   : experimental--- Portability : non-portable--- --- Primitives for manipulating unboxed arrays-----module Data.Vector.Unboxed.Unbox (-  Unbox(..)-) where--import GHC.Base (-    Int(..)-  )-import GHC.Float (-    Float(..), Double(..)-  )-import GHC.Word (-    Word(..)-  )--import GHC.Prim (-    ByteArray#, MutableByteArray#, State#,--    Int#, indexIntArray#,    readIntArray#,    writeIntArray#,-          indexWordArray#,   readWordArray#,   writeWordArray#,-          indexFloatArray#,  readFloatArray#,  writeFloatArray#,-          indexDoubleArray#, readDoubleArray#, writeDoubleArray#-  )-import Data.Array.Base (-    wORD_SCALE, fLOAT_SCALE, dOUBLE_SCALE-  )---- | Class of types which can be stored in unboxed arrays-class Unbox a where-  -- | Yield the size in bytes of a 'ByteArray#' which can store @n@ elements-  size#  :: a     -- ^ Dummy type parameter, never evaluated-         -> Int#  -- ^ Number of elements-         -> Int#--  -- | Indexing-  at#    :: ByteArray# -> Int# -> a--  -- | Yield the element at the given position-  read#  :: MutableByteArray# s -> Int# -> State# s -> (# State# s, a #)--  -- | Store the given element at the given position-  write# :: MutableByteArray# s -> Int# -> a -> State# s -> State# s--instance Unbox Word where-  size# _                   = wORD_SCALE-  at#    arr# i#            = W# (indexWordArray# arr# i#)-  read#  arr# i# s#         = case readWordArray# arr# i# s# of-                                (# s1#, n# #) -> (# s1#, W# n# #)-  write# arr# i# (W# n#) s# = writeWordArray# arr# i# n# s#---instance Unbox Int where-  size#  _                  = wORD_SCALE-  at#    arr# i#            = I# (indexIntArray# arr# i#)-  read#  arr# i# s#         = case readIntArray# arr# i# s# of-                                (# s1#, n# #) -> (# s1#, I# n# #)-  write# arr# i# (I# n#) s# = writeIntArray# arr# i# n# s#--instance Unbox Float where-  size#  _                  = fLOAT_SCALE-  at#    arr# i#            = F# (indexFloatArray# arr# i#)-  read#  arr# i# s#         = case readFloatArray# arr# i# s# of-                                (# s1#, x# #) -> (# s1#, F# x# #)-  write# arr# i# (F# x#) s# = writeFloatArray# arr# i# x# s#--instance Unbox Double where-  size#  _                  = dOUBLE_SCALE-  at#    arr# i#            = D# (indexDoubleArray# arr# i#)-  read#  arr# i# s#         = case readDoubleArray# arr# i# s# of-                                (# s1#, x# #) -> (# s1#, D# x# #)-  write# arr# i# (D# x#) s# = writeDoubleArray# arr# i# x# s#-
include/phases.h view
@@ -1,2 +1,6 @@-#define INLINE_STREAM INLINE [1]+#define PHASE_STREAM [1]+#define PHASE_INNER  [0]++#define INLINE_STREAM INLINE PHASE_STREAM+#define INLINE_INNER  INLINE PHASE_INNER
tests/Boilerplater.hs view
@@ -1,6 +1,6 @@ module Boilerplater where -import Test.Framework.Providers.QuickCheck+import Test.Framework.Providers.QuickCheck2  import Language.Haskell.TH
tests/Main.hs view
@@ -1,7 +1,10 @@ module Main (main) where -import Properties (tests)+import qualified Tests.Vector+import qualified Tests.Stream  import Test.Framework (defaultMain) -main = defaultMain tests+main = defaultMain $ Tests.Stream.tests+                  ++ Tests.Vector.tests+
− tests/Properties.hs 
@@ -1,235 +0,0 @@-module Properties (tests) where--import Boilerplater-import Utilities--import qualified Data.Vector.IVector as V-import qualified Data.Vector-import qualified Data.Vector.Unboxed-import qualified Data.Vector.Fusion.Stream as S--import Test.QuickCheck--import Test.Framework-import Test.Framework.Providers.QuickCheck--import Text.Show.Functions ()-import Data.List           (foldl', foldl1', unfoldr, find, findIndex)--#define COMMON_CONTEXT(a, v) \- VANILLA_CONTEXT(a, v), VECTOR_CONTEXT(a, v)--#define VANILLA_CONTEXT(a, v) \-  Eq a,     Show a,     Arbitrary a,     Model a a--#define VECTOR_CONTEXT(a, v) \-  Eq (v a), Show (v a), Arbitrary (v a), Model (v a) [a], V.IVector v a----- TODO: implement Vector equivalents of list functions for some of the commented out properties---- TODO: test and implement some of these other Prelude functions:---  mapM *---  mapM_ *---  sequence---  sequence_---  sum *---  product *---  scanl *---  scanl1 *---  scanr *---  scanr1 *---  lookup *---  lines---  words---  unlines---  unwords--- NB: this is an exhaustive list of all Prelude list functions that make sense for vectors.--- Ones with *s are the most plausible candidates.---- TODO: add tests for the other extra functions--- IVector exports still needing tests:---  copy,---  slice,---  (//), update, bpermute,---  prescanl, prescanl',---  new,---  unsafeSlice, unsafeIndex,---  vlength, vnew---- TODO: test non-IVector stuff?--testSanity :: forall a v. (COMMON_CONTEXT(a, v)) => v a -> [Test]-testSanity _ = [-        testProperty "fromList.toList == id" prop_fromList_toList,-        testProperty "toList.fromList == id" prop_toList_fromList,-        testProperty "unstream.stream == id" prop_unstream_stream,-        testProperty "stream.unstream == id" prop_stream_unstream-    ]-  where-    prop_fromList_toList (v :: v a)        = (V.fromList . V.toList)                        v == v-    prop_toList_fromList (l :: [a])        = ((V.toList :: v a -> [a]) . V.fromList)        l == l-    prop_unstream_stream (v :: v a)        = (V.unstream . V.stream)                        v == v-    prop_stream_unstream (s :: S.Stream a) = ((V.stream :: v a -> S.Stream a) . V.unstream) s == s--testPolymorphicFunctions :: forall a v. (COMMON_CONTEXT(a, v)) => v a -> [Test]-testPolymorphicFunctions _ = $(testProperties [-        'prop_eq, 'prop_length, 'prop_null, 'prop_reverse,-        'prop_append, 'prop_concatMap,-        'prop_empty, 'prop_cons,-        'prop_head, 'prop_tail, 'prop_init, 'prop_last,-        'prop_drop, 'prop_dropWhile, 'prop_take, 'prop_takeWhile,-        'prop_filter, 'prop_map, 'prop_replicate,-        'prop_zipWith, 'prop_zipWith3,-        'prop_elem, 'prop_notElem,-        'prop_foldr, 'prop_foldl, 'prop_foldr1, 'prop_foldl1,-        'prop_foldl', 'prop_foldl1',-        'prop_find, 'prop_findIndex,-        'prop_unfoldr,-        'prop_singleton, 'prop_snoc-    ])-  where-    -- Prelude-    prop_eq           = ((==) :: v a -> v a -> Bool)                  `eq2` (==)-    prop_length       = (V.length :: v a -> Int)                      `eq1` length-    prop_null         = (V.null :: v a -> Bool)                       `eq1` null-    prop_reverse      = (V.reverse :: v a -> v a)                     `eq1` reverse-    prop_append       = ((V.++) :: v a -> v a -> v a)                 `eq2` (++)-    prop_concatMap    = (V.concatMap :: (a -> v a) -> v a -> v a)     `eq2` concatMap-    prop_empty        = (V.empty :: v a)                              `eq0` []-    prop_cons         = (V.cons :: a -> v a -> v a)                   `eq2` (:)-    --prop_index        = compare (V.!) to (!!)-    prop_head         = (V.head :: v a -> a)                          `eqNotNull1` head-    prop_tail         = (V.tail :: v a -> v a)                        `eqNotNull1` tail-    prop_init         = (V.init :: v a -> v a)                        `eqNotNull1` init-    prop_last         = (V.last :: v a -> a)                          `eqNotNull1` last-    prop_drop         = (V.drop :: Int -> v a -> v a)                 `eq2` drop-    prop_dropWhile    = (V.dropWhile :: (a -> Bool) -> v a -> v a)    `eq2` dropWhile-    prop_take         = (V.take :: Int -> v a -> v a)                 `eq2` take-    prop_takeWhile    = (V.takeWhile :: (a -> Bool) -> v a -> v a)    `eq2` takeWhile-    prop_filter       = (V.filter :: (a -> Bool) -> v a -> v a)       `eq2` filter-    prop_map          = (V.map :: (a -> a) -> v a -> v a)             `eq2` map-    prop_replicate    = (V.replicate :: Int -> a -> v a)              `eq2` replicate-    prop_zipWith      = (V.zipWith :: (a -> a -> a) -> v a -> v a -> v a) `eq3` zipWith-    prop_zipWith3     = (V.zipWith3 :: (a -> a -> a -> a) -> v a -> v a -> v a -> v a) `eq4` zipWith3-    --prop_span         = (V.span :: (a -> Bool) -> v a -> (v a, v a))  `eq2` span-    --prop_break        = (V.break :: (a -> Bool) -> v a -> (v a, v a)) `eq2` break-    --prop_splitAt      = (V.splitAt :: Int -> v a -> (v a, v a))       `eq2` splitAt-    prop_elem         = (V.elem :: a -> v a -> Bool)                  `eq2` elem-    prop_notElem      = (V.notElem :: a -> v a -> Bool)               `eq2` notElem-    prop_foldr        = (V.foldr :: (a -> a -> a) -> a -> v a -> a)   `eq3` foldr-    prop_foldl        = (V.foldl :: (a -> a -> a) -> a -> v a -> a)   `eq3` foldl-    prop_foldr1       = (V.foldr1 :: (a -> a -> a) -> v a -> a)       `eqNotNull2` foldr1-    prop_foldl1       = (V.foldl1 :: (a -> a -> a) -> v a -> a)       `eqNotNull2` foldl1-    --prop_all          = (V.all :: (a -> Bool) -> v a -> Bool)         `eq2` all-    --prop_any          = (V.any :: (a -> Bool) -> v a -> Bool)         `eq2` any--    -- Data.List-    prop_foldl'       = (V.foldl' :: (a -> a -> a) -> a -> v a -> a)     `eq3` foldl'-    prop_foldl1'      = (V.foldl1' :: (a -> a -> a) -> v a -> a)         `eqNotNull2` foldl1'-    prop_find         = (V.find :: (a -> Bool) -> v a -> Maybe a)        `eq2` find-    prop_findIndex    = (V.findIndex :: (a -> Bool) -> v a -> Maybe Int) `eq2` findIndex-    --prop_findIndices  = V.findIndices `eq2` (findIndices :: (a -> Bool) -> v a -> v Int)-    --prop_isPrefixOf   = V.isPrefixOf  `eq2` (isPrefixOf  :: v a -> v a -> Bool)-    --prop_elemIndex    = V.elemIndex   `eq2` (elemIndex   :: a -> v a -> Maybe Int)-    --prop_elemIndices  = V.elemIndices `eq2` (elemIndices :: a -> v a -> v Int)-    ---    --prop_mapAccumL  = eq3-    --    (V.mapAccumL :: (X -> W -> (X,W)) -> X -> B   -> (X, B))-    --    (  mapAccumL :: (X -> W -> (X,W)) -> X -> [W] -> (X, [W]))-    -- -    --prop_mapAccumR  = eq3-    --    (V.mapAccumR :: (X -> W -> (X,W)) -> X -> B   -> (X, B))-    --    (  mapAccumR :: (X -> W -> (X,W)) -> X -> [W] -> (X, [W]))--    -- Because the vectors are strict, we need to be totally sure that the unfold eventually terminates. This-    -- is achieved by injecting our own bit of state into the unfold - the maximum number of unfolds allowed.-    limitUnfolds f (theirs, ours) | ours >= 0-                                  , Just (out, theirs') <- f theirs = Just (out, (theirs', ours - 1))-                                  | otherwise                       = Nothing-    prop_unfoldr      = ((\n f a -> V.unfoldr (limitUnfolds f) (a, n)) :: Int -> ((Int, Int) -> Maybe (a, (Int, Int))) -> (Int, Int) -> v a)-                        `eq3` (\n f a -> unfoldr (limitUnfolds f) (a, n))--    -- Extras-    singleton x = [x]-    prop_singleton = (V.singleton :: a -> v a) `eq1` singleton-    -    snoc xs x = xs ++ [x]-    prop_snoc = (V.snoc :: v a -> a -> v a) `eq2` snoc--testTuplyFunctions:: forall a v. (COMMON_CONTEXT(a, v), VECTOR_CONTEXT((a, a), v), VECTOR_CONTEXT((a, a, a), v)) => v a -> [Test]-testTuplyFunctions _ = $(testProperties ['prop_zip, 'prop_zip3, 'prop_unzip, 'prop_unzip3])-  where-    prop_zip          = (V.zip :: v a -> v a -> v (a, a))             `eq2` zip-    prop_zip3         = (V.zip3 :: v a -> v a -> v a -> v (a, a, a))  `eq3` zip3-    prop_unzip        = (V.unzip :: v (a, a) -> (v a, v a))           `eq1` unzip-    prop_unzip3       = (V.unzip3 :: v (a, a, a) -> (v a, v a, v a))  `eq1` unzip3--testOrdFunctions :: forall a v. (COMMON_CONTEXT(a, v), Ord a, Ord (v a)) => v a -> [Test]-testOrdFunctions _ = $(testProperties ['prop_compare, 'prop_maximum, 'prop_minimum])-  where-    prop_compare      = (compare :: v a -> v a -> Ordering) `eq2` compare-    prop_maximum      = (V.maximum :: v a -> a)             `eqNotNull1` maximum-    prop_minimum      = (V.minimum :: v a -> a)             `eqNotNull1` minimum--testEnumFunctions :: forall a v. (COMMON_CONTEXT(a, v), Enum a) => v a -> [Test]-testEnumFunctions _ = $(testProperties ['prop_enumFromTo, 'prop_enumFromThenTo])-  where-    prop_enumFromTo     =                                        (V.enumFromTo :: a -> a -> v a)          `eq2` enumFromTo-    prop_enumFromThenTo = \i j n -> fromEnum i < fromEnum j ==> ((V.enumFromThenTo :: a -> a -> a -> v a) `eq3` enumFromThenTo) i j n--testBoolFunctions :: forall v. (COMMON_CONTEXT(Bool, v)) => v Bool -> [Test]-testBoolFunctions _ = $(testProperties ['prop_and, 'prop_or])-  where-    prop_and          = (V.and :: v Bool -> Bool) `eq1` and-    prop_or           = (V.or :: v Bool -> Bool)  `eq1` or--testNumFunctions :: forall a v. (COMMON_CONTEXT(a, v), Num a) => v a -> [Test]-testNumFunctions _ = $(testProperties ['prop_sum, 'prop_product])-  where-    prop_sum          = (V.sum :: v a -> a)     `eq1` sum-    prop_product      = (V.product :: v a -> a) `eq1` product--testNestedVectorFunctions :: forall a v. (COMMON_CONTEXT(a, v)) => v a -> [Test]-testNestedVectorFunctions _ = $(testProperties [])-  where-    -- Prelude-    --prop_concat       = (V.concat :: [v a] -> v a)                    `eq1` concat-    -    -- Data.List-    --prop_transpose    = V.transpose   `eq1` (transpose   :: [v a] -> [v a])-    --prop_group        = V.group       `eq1` (group       :: v a -> [v a])-    --prop_inits        = V.inits       `eq1` (inits       :: v a -> [v a])-    --prop_tails        = V.tails       `eq1` (tails       :: v a -> [v a])---testGeneralBoxedVector dummy = concatMap ($ dummy) [-        testSanity,-        testPolymorphicFunctions,-        testOrdFunctions,-        testEnumFunctions,-        testTuplyFunctions,-        testNestedVectorFunctions-    ]--testBoolBoxedVector dummy = testGeneralBoxedVector dummy ++ testBoolFunctions dummy-testNumericBoxedVector dummy = testGeneralBoxedVector dummy ++ testNumFunctions dummy--testGeneralUnboxedVector dummy = concatMap ($ dummy) [-        testSanity,-        testPolymorphicFunctions,-        testOrdFunctions,-        testEnumFunctions-    ]--testBoolUnboxedVector dummy = testGeneralUnboxedVector dummy ++ testBoolFunctions dummy-testNumericUnboxedVector dummy = testGeneralUnboxedVector dummy ++ testNumFunctions dummy--tests = [-        testGroup "Data.Vector.Vector (Bool)"           (testBoolBoxedVector      (undefined :: Data.Vector.Vector Bool)),-        testGroup "Data.Vector.Vector (Int)"            (testNumericBoxedVector   (undefined :: Data.Vector.Vector Int)),-        testGroup "Data.Vector.Unboxed.Vector (Bool)"   (testBoolUnboxedVector    (undefined :: Data.Vector.Unboxed.Vector Bool)),-        testGroup "Data.Vector.Unboxed.Vector (Int)"    (testNumericUnboxedVector (undefined :: Data.Vector.Unboxed.Vector Int)),-        testGroup "Data.Vector.Unboxed.Vector (Float)"  (testNumericUnboxedVector (undefined :: Data.Vector.Unboxed.Vector Float)),-        testGroup "Data.Vector.Unboxed.Vector (Double)" (testNumericUnboxedVector (undefined :: Data.Vector.Unboxed.Vector Double))-    ]
+ tests/Tests/Stream.hs view
@@ -0,0 +1,163 @@+module Tests.Stream ( tests ) where++import Boilerplater+import Utilities++import qualified Data.Vector.Fusion.Stream as S++import Test.QuickCheck++import Test.Framework+import Test.Framework.Providers.QuickCheck2++import Text.Show.Functions ()+import Data.List           (foldl', foldl1', unfoldr, find, findIndex)+import System.Random       (Random)++#define COMMON_CONTEXT(a) \+ VANILLA_CONTEXT(a)++#define VANILLA_CONTEXT(a) \+  Eq a,     Show a,     Arbitrary a,     CoArbitrary a,     TestData a,     Model a ~ a,        EqTest a ~ Property++testSanity :: forall a. (COMMON_CONTEXT(a)) => S.Stream a -> [Test]+testSanity _ = [+        testProperty "fromList.toList == id" prop_fromList_toList,+        testProperty "toList.fromList == id" prop_toList_fromList+    ]+  where+    prop_fromList_toList :: P (S.Stream a -> S.Stream a)+        = (S.fromList . S.toList) `eq` id+    prop_toList_fromList :: P ([a] -> [a])+        = (S.toList . (S.fromList :: [a] -> S.Stream a)) `eq` id++testPolymorphicFunctions :: forall a. (COMMON_CONTEXT(a)) => S.Stream a -> [Test]+testPolymorphicFunctions _ = $(testProperties [+        'prop_eq,++        'prop_length, 'prop_null,++        'prop_empty, 'prop_singleton, 'prop_replicate,+        'prop_cons, 'prop_snoc, 'prop_append,++        'prop_head, 'prop_last, 'prop_index,++        'prop_extract, 'prop_init, 'prop_tail, 'prop_take, 'prop_drop,++        'prop_map, 'prop_zipWith, 'prop_zipWith3,+        'prop_filter, 'prop_takeWhile, 'prop_dropWhile,++        'prop_elem, 'prop_notElem,+        'prop_find, 'prop_findIndex,++        'prop_foldl, 'prop_foldl1, 'prop_foldl', 'prop_foldl1',+        'prop_foldr, 'prop_foldr1,++        'prop_prescanl, 'prop_prescanl',+        'prop_postscanl, 'prop_postscanl',+        'prop_scanl, 'prop_scanl', 'prop_scanl1, 'prop_scanl1',++        'prop_concatMap,+        'prop_unfoldr+    ])+  where+    -- Prelude+    prop_eq :: P (S.Stream a -> S.Stream a -> Bool) = (==) `eq` (==)++    prop_length :: P (S.Stream a -> Int)     = S.length `eq` length+    prop_null   :: P (S.Stream a -> Bool)    = S.null `eq` null+    prop_empty  :: P (S.Stream a)            = S.empty `eq` []+    prop_singleton :: P (a -> S.Stream a)    = S.singleton `eq` singleton+    prop_replicate :: P (Int -> a -> S.Stream a)+              = (\n _ -> n < 1000) ===> S.replicate `eq` replicate+    prop_cons      :: P (a -> S.Stream a -> S.Stream a) = S.cons `eq` (:)+    prop_snoc      :: P (S.Stream a -> a -> S.Stream a) = S.snoc `eq` snoc+    prop_append    :: P (S.Stream a -> S.Stream a -> S.Stream a) = (S.++) `eq` (++)++    prop_head      :: P (S.Stream a -> a) = not . S.null ===> S.head `eq` head+    prop_last      :: P (S.Stream a -> a) = not . S.null ===> S.last `eq` last+    prop_index        = \xs ->+                        not (S.null xs) ==>+                        forAll (choose (0, S.length xs-1)) $ \i ->+                        unP prop xs i+      where+        prop :: P (S.Stream a -> Int -> a) = (S.!!) `eq` (!!)++    prop_extract      = \xs ->+                        forAll (choose (0, S.length xs))     $ \i ->+                        forAll (choose (0, S.length xs - i)) $ \n ->+                        unP prop xs i n+      where+        prop :: P (S.Stream a -> Int -> Int -> S.Stream a) = S.extract `eq` slice++    prop_tail :: P (S.Stream a -> S.Stream a) = not . S.null ===> S.tail `eq` tail+    prop_init :: P (S.Stream a -> S.Stream a) = not . S.null ===> S.init `eq` init+    prop_take :: P (Int -> S.Stream a -> S.Stream a) = S.take `eq` take+    prop_drop :: P (Int -> S.Stream a -> S.Stream a) = S.drop `eq` drop++    prop_map :: P ((a -> a) -> S.Stream a -> S.Stream a) = S.map `eq` map+    prop_zipWith :: P ((a -> a -> a) -> S.Stream a -> S.Stream a -> S.Stream a) = S.zipWith `eq` zipWith+    prop_zipWith3 :: P ((a -> a -> a -> a) -> S.Stream a -> S.Stream a -> S.Stream a -> S.Stream a)+             = S.zipWith3 `eq` zipWith3++    prop_filter :: P ((a -> Bool) -> S.Stream a -> S.Stream a) = S.filter `eq` filter+    prop_takeWhile :: P ((a -> Bool) -> S.Stream a -> S.Stream a) = S.takeWhile `eq` takeWhile+    prop_dropWhile :: P ((a -> Bool) -> S.Stream a -> S.Stream a) = S.dropWhile `eq` dropWhile++    prop_elem    :: P (a -> S.Stream a -> Bool) = S.elem `eq` elem+    prop_notElem :: P (a -> S.Stream a -> Bool) = S.notElem `eq` notElem+    prop_find    :: P ((a -> Bool) -> S.Stream a -> Maybe a) = S.find `eq` find+    prop_findIndex :: P ((a -> Bool) -> S.Stream a -> Maybe Int)+      = S.findIndex `eq` findIndex++    prop_foldl :: P ((a -> a -> a) -> a -> S.Stream a -> a) = S.foldl `eq` foldl+    prop_foldl1 :: P ((a -> a -> a) -> S.Stream a -> a)     = notNullS2 ===>+                        S.foldl1 `eq` foldl1+    prop_foldl' :: P ((a -> a -> a) -> a -> S.Stream a -> a) = S.foldl' `eq` foldl'+    prop_foldl1' :: P ((a -> a -> a) -> S.Stream a -> a)     = notNullS2 ===>+                        S.foldl1' `eq` foldl1'+    prop_foldr :: P ((a -> a -> a) -> a -> S.Stream a -> a) = S.foldr `eq` foldr+    prop_foldr1 :: P ((a -> a -> a) -> S.Stream a -> a)     = notNullS2 ===>+                        S.foldr1 `eq` foldr1++    prop_prescanl :: P ((a -> a -> a) -> a -> S.Stream a -> S.Stream a)+                = S.prescanl `eq` prescanl+    prop_prescanl' :: P ((a -> a -> a) -> a -> S.Stream a -> S.Stream a)+                = S.prescanl' `eq` prescanl+    prop_postscanl :: P ((a -> a -> a) -> a -> S.Stream a -> S.Stream a)+                = S.postscanl `eq` postscanl+    prop_postscanl' :: P ((a -> a -> a) -> a -> S.Stream a -> S.Stream a)+                = S.postscanl' `eq` postscanl+    prop_scanl :: P ((a -> a -> a) -> a -> S.Stream a -> S.Stream a)+                = S.scanl `eq` scanl+    prop_scanl' :: P ((a -> a -> a) -> a -> S.Stream a -> S.Stream a)+               = S.scanl' `eq` scanl+    prop_scanl1 :: P ((a -> a -> a) -> S.Stream a -> S.Stream a) = notNullS2 ===>+                 S.scanl1 `eq` scanl1+    prop_scanl1' :: P ((a -> a -> a) -> S.Stream a -> S.Stream a) = notNullS2 ===>+                 S.scanl1' `eq` scanl1+ +    prop_concatMap    = forAll arbitrary $ \xs ->+                        forAll (sized (\n -> resize (n `div` S.length xs) arbitrary)) $ \f -> unP prop f xs+      where+        prop :: P ((a -> S.Stream a) -> S.Stream a -> S.Stream a) = S.concatMap `eq` concatMap++    limitUnfolds f (theirs, ours) | ours >= 0+                                  , Just (out, theirs') <- f theirs = Just (out, (theirs', ours - 1))+                                  | otherwise                       = Nothing+    prop_unfoldr :: P (Int -> (Int -> Maybe (a,Int)) -> Int -> S.Stream a)+         = (\n f a -> S.unfoldr (limitUnfolds f) (a, n))+           `eq` (\n f a -> unfoldr (limitUnfolds f) (a, n))++testBoolFunctions :: [Test]+testBoolFunctions = $(testProperties ['prop_and, 'prop_or])+  where+    prop_and :: P (S.Stream Bool -> Bool) = S.and `eq` and+    prop_or  :: P (S.Stream Bool -> Bool) = S.or `eq` or++testStreamFunctions = testSanity (undefined :: S.Stream Int)+                      ++ testPolymorphicFunctions (undefined :: S.Stream Int)+                      ++ testBoolFunctions++tests = [ testGroup "Data.Vector.Fusion.Stream" testStreamFunctions ]+
+ tests/Tests/Vector.hs view
@@ -0,0 +1,342 @@+module Tests.Vector (tests) where++import Boilerplater+import Utilities++import qualified Data.Vector.Generic as V+import qualified Data.Vector+import qualified Data.Vector.Primitive+import qualified Data.Vector.Storable+import qualified Data.Vector.Fusion.Stream as S++import Test.QuickCheck++import Test.Framework+import Test.Framework.Providers.QuickCheck2++import Text.Show.Functions ()+import Data.List           (foldl', foldl1', unfoldr, find, findIndex)+import System.Random       (Random)++#define COMMON_CONTEXT(a, v) \+ VANILLA_CONTEXT(a, v), VECTOR_CONTEXT(a, v)++#define VANILLA_CONTEXT(a, v) \+  Eq a,     Show a,     Arbitrary a,     CoArbitrary a,     TestData a,     Model a ~ a,        EqTest a ~ Property++#define VECTOR_CONTEXT(a, v) \+  Eq (v a), Show (v a), Arbitrary (v a), CoArbitrary (v a), TestData (v a), Model (v a) ~ [a],  EqTest (v a) ~ Property, V.Vector v a++-- TODO: implement Vector equivalents of list functions for some of the commented out properties++-- TODO: test and implement some of these other Prelude functions:+--  mapM *+--  mapM_ *+--  sequence+--  sequence_+--  sum *+--  product *+--  scanl *+--  scanl1 *+--  scanr *+--  scanr1 *+--  lookup *+--  lines+--  words+--  unlines+--  unwords+-- NB: this is an exhaustive list of all Prelude list functions that make sense for vectors.+-- Ones with *s are the most plausible candidates.++-- TODO: add tests for the other extra functions+-- IVector exports still needing tests:+--  copy,+--  slice,+--  (//), update, bpermute,+--  prescanl, prescanl',+--  new,+--  unsafeSlice, unsafeIndex,+--  vlength, vnew++-- TODO: test non-IVector stuff?++testSanity :: forall a v. (COMMON_CONTEXT(a, v)) => v a -> [Test]+testSanity _ = [+        testProperty "fromList.toList == id" prop_fromList_toList,+        testProperty "toList.fromList == id" prop_toList_fromList,+        testProperty "unstream.stream == id" prop_unstream_stream,+        testProperty "stream.unstream == id" prop_stream_unstream+    ]+  where+    prop_fromList_toList (v :: v a)        = (V.fromList . V.toList)                        v == v+    prop_toList_fromList (l :: [a])        = ((V.toList :: v a -> [a]) . V.fromList)        l == l+    prop_unstream_stream (v :: v a)        = (V.unstream . V.stream)                        v == v+    prop_stream_unstream (s :: S.Stream a) = ((V.stream :: v a -> S.Stream a) . V.unstream) s == s++testPolymorphicFunctions :: forall a v. (COMMON_CONTEXT(a, v), VECTOR_CONTEXT(Int, v)) => v a -> [Test]+testPolymorphicFunctions _ = $(testProperties [+        'prop_eq,++        'prop_length, 'prop_null,++        'prop_empty, 'prop_singleton, 'prop_replicate,+        'prop_cons, 'prop_snoc, 'prop_append, 'prop_copy,++        'prop_head, 'prop_last, 'prop_index,++        'prop_slice, 'prop_init, 'prop_tail, 'prop_take, 'prop_drop,++        'prop_accum, 'prop_write, 'prop_backpermute, 'prop_reverse,++        'prop_map, 'prop_zipWith, 'prop_zipWith3,+        'prop_filter, 'prop_takeWhile, 'prop_dropWhile,++        'prop_elem, 'prop_notElem,+        'prop_find, 'prop_findIndex,++        'prop_foldl, 'prop_foldl1, 'prop_foldl', 'prop_foldl1',+        'prop_foldr, 'prop_foldr1,++        'prop_prescanl, 'prop_prescanl',+        'prop_postscanl, 'prop_postscanl',+        'prop_scanl, 'prop_scanl', 'prop_scanl1, 'prop_scanl1',++        'prop_concatMap,+        'prop_unfoldr+    ])+  where+    -- Prelude+    prop_eq :: P (v a -> v a -> Bool) = (==) `eq` (==)++    prop_length :: P (v a -> Int)     = V.length `eq` length+    prop_null   :: P (v a -> Bool)    = V.null `eq` null++    prop_empty  :: P (v a)            = V.empty `eq` []+    prop_singleton :: P (a -> v a)    = V.singleton `eq` singleton+    prop_replicate :: P (Int -> a -> v a)+              = (\n _ -> n < 1000) ===> V.replicate `eq` replicate+    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_head      :: P (v a -> a) = not . V.null ===> V.head `eq` head+    prop_last      :: P (v a -> a) = not . V.null ===> V.last `eq` last+    prop_index        = \xs ->+                        not (V.null xs) ==>+                        forAll (choose (0, V.length xs-1)) $ \i ->+                        unP prop xs i+      where+        prop :: P (v a -> Int -> a) = (V.!) `eq` (!!)++    prop_slice        = \xs ->+                        forAll (choose (0, V.length xs))     $ \i ->+                        forAll (choose (0, V.length xs - i)) $ \n ->+                        unP prop xs i n+      where+        prop :: P (v a -> Int -> Int -> v a) = V.slice `eq` slice++    prop_tail :: P (v a -> v a) = not . V.null ===> V.tail `eq` tail+    prop_init :: P (v a -> v a) = not . V.null ===> V.init `eq` init+    prop_take :: P (Int -> v a -> v a) = V.take `eq` take+    prop_drop :: P (Int -> v a -> v a) = V.drop `eq` drop++    prop_accum = \f xs ->+                 forAll (index_value_pairs (V.length xs)) $ \ps ->+                 unP prop f xs ps+      where+        prop :: P ((a -> a -> a) -> v a -> [(Int,a)] -> v a)+          = V.accum `eq` accum++    prop_write        = \xs ->+                        forAll (index_value_pairs (V.length xs)) $ \ps ->+                        unP prop xs ps+      where+        prop :: P (v a -> [(Int,a)] -> v a) = (V.//) `eq` (//)++    prop_backpermute  = \xs ->+                        forAll (indices (V.length xs)) $ \is ->+                        unP prop xs (V.fromList is)+      where+        prop :: P (v a -> v Int -> v a) = V.backpermute `eq` backpermute++    prop_reverse :: P (v a -> v a) = V.reverse `eq` reverse++    prop_map :: P ((a -> a) -> v a -> v a) = V.map `eq` map+    prop_zipWith :: P ((a -> a -> a) -> v a -> v a -> v a) = V.zipWith `eq` zipWith+    prop_zipWith3 :: P ((a -> a -> a -> a) -> v a -> v a -> v a -> v a)+             = V.zipWith3 `eq` zipWith3++    prop_filter :: P ((a -> Bool) -> v a -> v a) = V.filter `eq` filter+    prop_takeWhile :: P ((a -> Bool) -> v a -> v a) = V.takeWhile `eq` takeWhile+    prop_dropWhile :: P ((a -> Bool) -> v a -> v a) = V.dropWhile `eq` dropWhile++    prop_elem    :: P (a -> v a -> Bool) = V.elem `eq` elem+    prop_notElem :: P (a -> v a -> Bool) = V.notElem `eq` notElem+    prop_find    :: P ((a -> Bool) -> v a -> Maybe a) = V.find `eq` find+    prop_findIndex :: P ((a -> Bool) -> v a -> Maybe Int)+      = V.findIndex `eq` findIndex++    prop_foldl :: P ((a -> a -> a) -> a -> v a -> a) = V.foldl `eq` foldl+    prop_foldl1 :: P ((a -> a -> a) -> v a -> a)     = notNull2 ===>+                        V.foldl1 `eq` foldl1+    prop_foldl' :: P ((a -> a -> a) -> a -> v a -> a) = V.foldl' `eq` foldl'+    prop_foldl1' :: P ((a -> a -> a) -> v a -> a)     = notNull2 ===>+                        V.foldl1' `eq` foldl1'+    prop_foldr :: P ((a -> a -> a) -> a -> v a -> a) = V.foldr `eq` foldr+    prop_foldr1 :: P ((a -> a -> a) -> v a -> a)     = notNull2 ===>+                        V.foldr1 `eq` foldr1++    prop_prescanl :: P ((a -> a -> a) -> a -> v a -> v a)+                = V.prescanl `eq` prescanl+    prop_prescanl' :: P ((a -> a -> a) -> a -> v a -> v a)+                = V.prescanl' `eq` prescanl+    prop_postscanl :: P ((a -> a -> a) -> a -> v a -> v a)+                = V.postscanl `eq` postscanl+    prop_postscanl' :: P ((a -> a -> a) -> a -> v a -> v a)+                = V.postscanl' `eq` postscanl+    prop_scanl :: P ((a -> a -> a) -> a -> v a -> v a)+                = V.scanl `eq` scanl+    prop_scanl' :: P ((a -> a -> a) -> a -> v a -> v a)+               = V.scanl' `eq` scanl+    prop_scanl1 :: P ((a -> a -> a) -> v a -> v a) = notNull2 ===>+                 V.scanl1 `eq` scanl1+    prop_scanl1' :: P ((a -> a -> a) -> v a -> v a) = notNull2 ===>+                 V.scanl1' `eq` scanl1+ +    prop_concatMap    = forAll arbitrary $ \xs ->+                        forAll (sized (\n -> resize (n `div` V.length xs) arbitrary)) $ \f -> unP prop f xs+      where+        prop :: P ((a -> v a) -> v a -> v a) = V.concatMap `eq` concatMap++    --prop_span         = (V.span :: (a -> Bool) -> v a -> (v a, v a))  `eq2` span+    --prop_break        = (V.break :: (a -> Bool) -> v a -> (v a, v a)) `eq2` break+    --prop_splitAt      = (V.splitAt :: Int -> v a -> (v a, v a))       `eq2` splitAt+    --prop_all          = (V.all :: (a -> Bool) -> v a -> Bool)         `eq2` all+    --prop_any          = (V.any :: (a -> Bool) -> v a -> Bool)         `eq2` any++    -- Data.List+    --prop_findIndices  = V.findIndices `eq2` (findIndices :: (a -> Bool) -> v a -> v Int)+    --prop_isPrefixOf   = V.isPrefixOf  `eq2` (isPrefixOf  :: v a -> v a -> Bool)+    --prop_elemIndex    = V.elemIndex   `eq2` (elemIndex   :: a -> v a -> Maybe Int)+    --prop_elemIndices  = V.elemIndices `eq2` (elemIndices :: a -> v a -> v Int)+    --+    --prop_mapAccumL  = eq3+    --    (V.mapAccumL :: (X -> W -> (X,W)) -> X -> B   -> (X, B))+    --    (  mapAccumL :: (X -> W -> (X,W)) -> X -> [W] -> (X, [W]))+    -- +    --prop_mapAccumR  = eq3+    --    (V.mapAccumR :: (X -> W -> (X,W)) -> X -> B   -> (X, B))+    --    (  mapAccumR :: (X -> W -> (X,W)) -> X -> [W] -> (X, [W]))++    -- Because the vectors are strict, we need to be totally sure that the unfold eventually terminates. This+    -- is achieved by injecting our own bit of state into the unfold - the maximum number of unfolds allowed.+    limitUnfolds f (theirs, ours) | ours >= 0+                                  , Just (out, theirs') <- f theirs = Just (out, (theirs', ours - 1))+                                  | otherwise                       = Nothing+    prop_unfoldr :: P (Int -> (Int -> Maybe (a,Int)) -> Int -> v a)+         = (\n f a -> V.unfoldr (limitUnfolds f) (a, n))+           `eq` (\n f a -> unfoldr (limitUnfolds f) (a, n))+++testTuplyFunctions:: forall a v. (COMMON_CONTEXT(a, v), VECTOR_CONTEXT((a, a), v), VECTOR_CONTEXT((a, a, a), v)) => v a -> [Test]+testTuplyFunctions _ = $(testProperties ['prop_zip, 'prop_zip3, 'prop_unzip, 'prop_unzip3])+  where+    prop_zip    :: P (v a -> v a -> v (a, a))           = V.zip `eq` zip+    prop_zip3   :: P (v a -> v a -> v a -> v (a, a, a)) = V.zip3 `eq` zip3+    prop_unzip  :: P (v (a, a) -> (v a, v a))           = V.unzip `eq` unzip+    prop_unzip3 :: P (v (a, a, a) -> (v a, v a, v a))   = V.unzip3 `eq` unzip3++testOrdFunctions :: forall a v. (COMMON_CONTEXT(a, v), Ord a, Ord (v a)) => v a -> [Test]+testOrdFunctions _ = $(testProperties ['prop_compare, 'prop_maximum, 'prop_minimum])+  where+    prop_compare :: P (v a -> v a -> Ordering) = compare `eq` compare+    prop_maximum :: P (v a -> a) = not . V.null ===> V.maximum `eq` maximum+    prop_minimum :: P (v a -> a) = not . V.null ===> V.minimum `eq` minimum++testEnumFunctions :: forall a v. (COMMON_CONTEXT(a, v), Enum a, Ord a, Num a, Random a) => v a -> [Test]+testEnumFunctions _ = $(testProperties ['prop_enumFromTo, 'prop_enumFromThenTo])+  where+    prop_enumFromTo = \m ->+                      forAll (choose (-2,100)) $ \n ->+                      unP prop m (m+n)+      where+        prop  :: P (a -> a -> v a) = V.enumFromTo `eq` enumFromTo++    prop_enumFromThenTo = \i j ->+                          j /= i ==>+                          forAll (choose (ks i j)) $ \k ->+                          unP prop i j k+      where+        prop :: P (a -> a -> a -> v a) = V.enumFromThenTo `eq` enumFromThenTo++        ks i j | j < i     = (i-d*100, i+d*2)+               | otherwise = (i-d*2, i+d*100)+          where+            d = abs (j-i)+                          +testBoolFunctions :: forall v. (COMMON_CONTEXT(Bool, v)) => v Bool -> [Test]+testBoolFunctions _ = $(testProperties ['prop_and, 'prop_or])+  where+    prop_and :: P (v Bool -> Bool) = V.and `eq` and+    prop_or  :: P (v Bool -> Bool) = V.or `eq` or++testNumFunctions :: forall a v. (COMMON_CONTEXT(a, v), Num a) => v a -> [Test]+testNumFunctions _ = $(testProperties ['prop_sum, 'prop_product])+  where+    prop_sum     :: P (v a -> a) = V.sum `eq` sum+    prop_product :: P (v a -> a) = V.product `eq` product++testNestedVectorFunctions :: forall a v. (COMMON_CONTEXT(a, v)) => v a -> [Test]+testNestedVectorFunctions _ = $(testProperties [])+  where+    -- Prelude+    --prop_concat       = (V.concat :: [v a] -> v a)                    `eq1` concat+    +    -- Data.List+    --prop_transpose    = V.transpose   `eq1` (transpose   :: [v a] -> [v a])+    --prop_group        = V.group       `eq1` (group       :: v a -> [v a])+    --prop_inits        = V.inits       `eq1` (inits       :: v a -> [v a])+    --prop_tails        = V.tails       `eq1` (tails       :: v a -> [v a])+++testGeneralBoxedVector dummy = concatMap ($ dummy) [+        testSanity,+        testPolymorphicFunctions,+        testOrdFunctions,+        testTuplyFunctions,+        testNestedVectorFunctions+    ]++testBoolBoxedVector dummy = testGeneralBoxedVector dummy ++ testBoolFunctions dummy+testNumericBoxedVector dummy = testGeneralBoxedVector dummy ++ testNumFunctions dummy ++ testEnumFunctions dummy++testGeneralPrimitiveVector dummy = concatMap ($ dummy) [+        testSanity,+        testPolymorphicFunctions,+        testOrdFunctions+    ]++testGeneralStorableVector dummy = concatMap ($ dummy) [+        testSanity,+        testPolymorphicFunctions,+        testOrdFunctions+    ]++testBoolPrimitiveVector dummy = testGeneralPrimitiveVector dummy ++ testBoolFunctions dummy+testNumericPrimitiveVector dummy = testGeneralPrimitiveVector dummy ++ testNumFunctions dummy ++ testEnumFunctions dummy+testNumericStorableVector dummy = testGeneralStorableVector dummy ++ testNumFunctions dummy ++ testEnumFunctions dummy++tests = [+        testGroup "Data.Vector.Vector (Bool)"           (testBoolBoxedVector      (undefined :: Data.Vector.Vector Bool)),+        testGroup "Data.Vector.Vector (Int)"            (testNumericBoxedVector   (undefined :: Data.Vector.Vector Int)),++        testGroup "Data.Vector.Primitive.Vector (Int)"    (testNumericPrimitiveVector (undefined :: Data.Vector.Primitive.Vector Int)),+        testGroup "Data.Vector.Primitive.Vector (Float)"  (testNumericPrimitiveVector (undefined :: Data.Vector.Primitive.Vector Float)),+        testGroup "Data.Vector.Primitive.Vector (Double)" (testNumericPrimitiveVector (undefined :: Data.Vector.Primitive.Vector Double)),++        testGroup "Data.Vector.Storable.Vector (Int)"    (testNumericStorableVector (undefined :: Data.Vector.Storable.Vector Int)),+        testGroup "Data.Vector.Storable.Vector (Float)"  (testNumericStorableVector (undefined :: Data.Vector.Storable.Vector Float)),+        testGroup "Data.Vector.Storable.Vector (Double)" (testNumericStorableVector (undefined :: Data.Vector.Storable.Vector Double))+    ]+
tests/Utilities.hs view
@@ -1,61 +1,216 @@+{-# LANGUAGE FlexibleInstances, GADTs #-} module Utilities where  import Test.QuickCheck  import qualified Data.Vector as DV-import qualified Data.Vector.IVector as DVI-import qualified Data.Vector.Unboxed as DVU-import qualified Data.Vector.Unboxed.Unbox as DVUU+import qualified Data.Vector.Generic as DVG+import qualified Data.Vector.Primitive as DVP+import qualified Data.Vector.Storable as DVS import qualified Data.Vector.Fusion.Stream as S +import Data.List ( sortBy ) + instance Show a => Show (S.Stream a) where     show s = "Data.Vector.Fusion.Stream.fromList " ++ show (S.toList s)   instance Arbitrary a => Arbitrary (DV.Vector a) where     arbitrary = fmap DV.fromList arbitrary++instance CoArbitrary a => CoArbitrary (DV.Vector a) where     coarbitrary = coarbitrary . DV.toList -instance (Arbitrary a, DVUU.Unbox a) => Arbitrary (DVU.Vector a) where-    arbitrary = fmap DVU.fromList arbitrary-    coarbitrary = coarbitrary . DVU.toList+instance (Arbitrary a, DVP.Prim a) => Arbitrary (DVP.Vector a) where+    arbitrary = fmap DVP.fromList arbitrary +instance (CoArbitrary a, DVP.Prim a) => CoArbitrary (DVP.Vector a) where+    coarbitrary = coarbitrary . DVP.toList++instance (Arbitrary a, DVS.Storable a) => Arbitrary (DVS.Vector a) where+    arbitrary = fmap DVS.fromList arbitrary++instance (CoArbitrary a, DVS.Storable a) => CoArbitrary (DVS.Vector a) where+    coarbitrary = coarbitrary . DVS.toList+ instance Arbitrary a => Arbitrary (S.Stream a) where     arbitrary = fmap S.fromList arbitrary++instance CoArbitrary a => CoArbitrary (S.Stream a) where     coarbitrary = coarbitrary . S.toList +class (Testable (EqTest a), Conclusion (EqTest a)) => TestData a where+  type Model a+  model :: a -> Model a+  unmodel :: Model a -> a -class Model a b | a -> b where-  -- | Convert a concrete value into an abstract model-  model :: a -> b+  type EqTest a+  equal :: a -> a -> EqTest a --- The meat of the models-instance                 Model (DV.Vector a)  [a] where model = DV.toList-instance DVUU.Unbox a => Model (DVU.Vector a) [a] where model = DVU.toList+instance Eq a => TestData (S.Stream a) where+  type Model (S.Stream a) = [a]+  model = S.toList+  unmodel = S.fromList --- Identity models-instance Model Bool     Bool     where model = id-instance Model Int      Int      where model = id-instance Model Float    Float    where model = id-instance Model Double   Double   where model = id-instance Model Ordering Ordering where model = id+  type EqTest (S.Stream a) = Property+  equal x y = property (x == y) +instance Eq a => TestData (DV.Vector a) where+  type Model (DV.Vector a) = [a]+  model = DV.toList+  unmodel = DV.fromList++  type EqTest (DV.Vector a) = Property+  equal x y = property (x == y)++instance (Eq a, DVP.Prim a) => TestData (DVP.Vector a) where+  type Model (DVP.Vector a) = [a]+  model = DVP.toList+  unmodel = DVP.fromList++  type EqTest (DVP.Vector a) = Property+  equal x y = property (x == y)++instance (Eq a, DVS.Storable a) => TestData (DVS.Vector a) where+  type Model (DVS.Vector a) = [a]+  model = DVS.toList+  unmodel = DVS.fromList++  type EqTest (DVS.Vector a) = Property+  equal x y = property (x == y)++#define id_TestData(ty) \+instance TestData ty where { \+  type Model ty = ty;        \+  model = id;                \+  unmodel = id;              \+                             \+  type EqTest ty = Property; \+  equal x y = property (x == y) }++id_TestData(Bool)+id_TestData(Int)+id_TestData(Float)+id_TestData(Double)+id_TestData(Ordering)+ -- Functorish models -- All of these need UndecidableInstances although they are actually well founded. Oh well.-instance Model a b                            => Model (Maybe a) (Maybe b)    where model           = fmap model-instance (Model a a', Model b b')             => Model (a, b) (a', b')        where model (a, b)    = (model a, model b)-instance (Model a a', Model b b', Model c c') => Model (a, b, c) (a', b', c') where model (a, b, c) = (model a, model b, model c)-instance (Model c a, Model b d)               => Model (a -> b) (c -> d)      where model f         = model . f . model+instance (Eq a, TestData a) => TestData (Maybe a) where+  type Model (Maybe a) = Maybe (Model a)+  model = fmap model+  unmodel = fmap unmodel +  type EqTest (Maybe a) = Property+  equal x y = property (x == y) -eq0 f g =             model f           == g-eq1 f g = \a       -> model (f a)       == g (model a)-eq2 f g = \a b     -> model (f a b)     == g (model a) (model b)-eq3 f g = \a b c   -> model (f a b c)   == g (model a) (model b) (model c)-eq4 f g = \a b c d -> model (f a b c d) == g (model a) (model b) (model c) (model d)+instance (Eq a, TestData a) => TestData [a] where+  type Model [a] = [Model a]+  model = fmap model+  unmodel = fmap unmodel -eqNotNull1 f g = \a       -> (not (DVI.null a)) ==> eq1 f g a-eqNotNull2 f g = \a b     -> (not (DVI.null b)) ==> eq2 f g a b-eqNotNull3 f g = \a b c   -> (not (DVI.null c)) ==> eq3 f g a b c-eqNotNull4 f g = \a b c d -> (not (DVI.null d)) ==> eq4 f g a b c d+  type EqTest [a] = Property+  equal x y = property (x == y)++instance (Eq a, Eq b, TestData a, TestData b) => TestData (a,b) where+  type Model (a,b) = (Model a, Model b)+  model (a,b) = (model a, model b)+  unmodel (a,b) = (unmodel a, unmodel b)++  type EqTest (a,b) = Property+  equal x y = property (x == y)++instance (Eq a, Eq b, Eq c, TestData a, TestData b, TestData c) => TestData (a,b,c) where+  type Model (a,b,c) = (Model a, Model b, Model c)+  model (a,b,c) = (model a, model b, model c)+  unmodel (a,b,c) = (unmodel a, unmodel b, unmodel c)++  type EqTest (a,b,c) = Property+  equal x y = property (x == y)++instance (Arbitrary a, Show a, TestData a, TestData b) => TestData (a -> b) where+  type Model (a -> b) = Model a -> Model b+  model f = model . f . unmodel+  unmodel f = unmodel . f . model++  type EqTest (a -> b) = a -> EqTest b+  equal f g x = equal (f x) (g x)++newtype P a = P { unP :: EqTest a }++instance TestData a => Testable (P a) where+  property (P a) = property a++infix 4 `eq`+eq :: TestData a => a -> Model a -> P a+eq x y = P (equal x (unmodel y))++class Conclusion p where+  type Predicate p++  predicate :: Predicate p -> p -> p++instance Conclusion Property where+  type Predicate Property = Bool++  predicate = (==>)++instance Conclusion p => Conclusion (a -> p) where+  type Predicate (a -> p) = a -> Predicate p++  predicate f p = \x -> predicate (f x) (p x)++infixr 0 ===>+(===>) :: TestData a => Predicate (EqTest a) -> P a -> P a+p ===> P a = P (predicate p a)++notNull2 _ xs = not $ DVG.null xs+notNullS2 _ s = not $ S.null s++-- Generators+index_value_pairs :: Arbitrary a => Int -> Gen [(Int,a)]+index_value_pairs 0 = return [] +index_value_pairs m = sized $ \n ->+  do+    len <- choose (0,n)+    is <- sequence [choose (0,m-1) | i <- [1..len]]+    xs <- vector len+    return $ zip is xs++indices :: Int -> Gen [Int]+indices 0 = return []+indices m = sized $ \n ->+  do+    len <- choose (0,n)+    sequence [choose (0,m-1) | i <- [1..len]]+++-- Additional list functions+singleton x = [x]+snoc xs x = xs ++ [x]+slice xs i n = take n (drop i xs)+backpermute xs is = map (xs!!) is+prescanl f z = init . scanl f z+postscanl f z = tail . scanl f z++accum :: (a -> b -> a) -> [a] -> [(Int,b)] -> [a]+accum f xs ps = go xs ps' 0+  where+    ps' = sortBy (\p q -> compare (fst p) (fst q)) ps++    go (x:xs) ((i,y) : ps) j+      | i == j     = go (f x y : xs) ps j+    go (x:xs) ps j = x : go xs ps (j+1)+    go [] _ _      = []  ++(//) :: [a] -> [(Int, a)] -> [a]+xs // ps = go xs ps' 0+  where+    ps' = sortBy (\p q -> compare (fst p) (fst q)) ps++    go (x:xs) ((i,y) : ps) j+      | i == j     = go (y:xs) ps j+    go (x:xs) ps j = x : go xs ps (j+1)+    go [] _ _      = []+
tests/vector-tests.cabal view
@@ -23,13 +23,12 @@               MultiParamTypeClasses,               FlexibleContexts,               Rank2Types,-              FunctionalDependencies,               TypeSynonymInstances,-              UndecidableInstances,+              TypeFamilies,               TemplateHaskell -  Build-Depends: base, template-haskell, vector,-                 QuickCheck, test-framework, test-framework-quickcheck+  Build-Depends: base, template-haskell, vector, random,+                 QuickCheck >= 2, test-framework, test-framework-quickcheck2    -- Don't let fusion occur or GHC will make our tests less informative in some cases :-)   Ghc-Options: -O0
vector.cabal view
@@ -1,18 +1,29 @@ Name:           vector-Version:        0.3.1+Version:        0.4 License:        BSD3 License-File:   LICENSE-Author:         Roman Leshchinskiy+Author:         Roman Leshchinskiy <rl@cse.unsw.edu.au> Maintainer:     Roman Leshchinskiy <rl@cse.unsw.edu.au>-Copyright:      (c) Roman Leshchinskiy 2008+Copyright:      (c) Roman Leshchinskiy 2008-2009 Homepage:       http://darcs.haskell.org/vector-Category:       Data Structures+Category:       Data, Data Structures Synopsis:       Efficient Arrays Description:         .-        An efficient but highly experimental implementation of Int-indexed-        arrays with a powerful loop fusion framework.+        An efficient implementation of Int-indexed arrays with a powerful loop+        fusion framework.         .+        It is structured as follows:+        .+        [@Data.Vector@] boxed vectors of arbitrary types+        .+        [@Data.Vector.Primitive@] unboxed vectors of primitive types as+                defined by the @primitive@ package+        .+        [@Data.Vector.Storable@] unboxed vectors of 'Storable' types+        .+        [@Data.Vector.Generic@] generic interface to the vector types+        .  Cabal-Version:  >= 1.2 Build-Type:     Simple@@ -23,8 +34,9 @@       tests/Setup.hs       tests/Main.hs       tests/Boilerplater.hs-      tests/Properties.hs       tests/Utilities.hs+      tests/Tests/Stream.hs+      tests/Tests/Vector.hs  Flag EnableAssertions   Description: Enable assertions that check parameters to functions are reasonable.@@ -40,17 +52,18 @@         Data.Vector.Fusion.Stream.Monadic         Data.Vector.Fusion.Stream -        Data.Vector.MVector-        Data.Vector.MVector.New-        Data.Vector.IVector+        Data.Vector.Generic.Mutable+        Data.Vector.Generic.New+        Data.Vector.Generic -        Data.Vector.Unboxed.Unbox-        Data.Vector.Unboxed.Mutable.ST-        Data.Vector.Unboxed.Mutable.IO-        Data.Vector.Unboxed+        Data.Vector.Primitive.Mutable+        Data.Vector.Primitive -        Data.Vector.Mutable.ST-        Data.Vector.Mutable.IO+        Data.Vector.Storable.Internal+        Data.Vector.Storable.Mutable+        Data.Vector.Storable++        Data.Vector.Mutable         Data.Vector   Include-Dirs:         include@@ -58,14 +71,14 @@   Install-Includes:         phases.h -  Build-Depends: base >= 2 && < 4, array, ghc-prim,-                 ghc >= 6.9+  Build-Depends: base >= 2 && < 5, ghc >= 6.9, primitive  -- -finline-if-enough-args is ESSENTIAL. If we don't have this the partial application -- of e.g. Stream.Monadic.++ to the monad dictionary at the use site in Stream.++ causes -- it to be fruitlessly inlined. This in turn leads to a huge RHS for Stream.++, so it -- doesn't get inlined at the final call site and fusion fails to occur.-  Ghc-Options: -finline-if-enough-args+  if impl(ghc<6.13)+    Ghc-Options: -finline-if-enough-args    -- It's probably a good idea to compile the library with -O2 as well. However, it's probably -- not as essential as you think because most of the optimisation occurs when the library