storablevector 0.2.4 → 0.2.5
raw patch · 22 files changed
+1432/−218 lines, 22 filesdep +deepseqdep +sample-framedep +statethreaddep ~base
Dependencies added: deepseq, sample-frame, statethread
Dependency ranges changed: base
Files
- Data/StorableVector.hs +138/−25
- Data/StorableVector/Base.hs +13/−0
- Data/StorableVector/Lazy.hs +136/−29
- Data/StorableVector/Lazy/Builder.hs +110/−40
- Data/StorableVector/Lazy/Pattern.hs +5/−4
- Data/StorableVector/Lazy/PointerPrivate.hs +21/−10
- Data/StorableVector/Lazy/PointerPrivateIndex.hs +38/−0
- Data/StorableVector/Pointer.hs +52/−0
- Data/StorableVector/Private.hs +151/−0
- Data/StorableVector/ST/Lazy.hs +36/−13
- Data/StorableVector/ST/Private.hs +3/−1
- Data/StorableVector/ST/Strict.hs +65/−25
- foreign-ptr/fast/Data/StorableVector/Memory.hs +9/−0
- foreign-ptr/jhc/Data/StorableVector/Memory.hs +12/−0
- foreign-ptr/slow/Data/StorableVector/Memory.hs +9/−0
- slow-foreign-ptr/Data/StorableVector/Memory.hs +0/−9
- speedtest/Pointer.hs +5/−4
- speedtest/SpeedTestChorus.hs +553/−0
- speedtest/SpeedTestLazy.hs +0/−17
- storablevector.cabal +74/−38
- tests/QuickCheckUtils.hs +0/−3
- tests/tests.hs +2/−0
Data/StorableVector.hs view
@@ -66,7 +66,7 @@ switchL, switchR, - -- * Transformating 'Vector's+ -- * Transforming 'Vector's map, reverse, intersperse,@@ -83,6 +83,7 @@ -- ** Special folds concat, concatMap,+ monoidConcatMap, any, all, maximum,@@ -102,8 +103,10 @@ -- ** Unfolding 'Vector's replicate,+ iterateN, unfoldr, unfoldrN,+ unfoldrResultN, sample, -- * Substrings@@ -158,6 +161,8 @@ -- * Zipping and unzipping 'Vector's zip, zipWith,+ zipWith3,+ zipWith4, unzip, copy, @@ -179,7 +184,7 @@ ,scanl,scanl1,scanr,scanr1 ,readFile,writeFile,appendFile,replicate ,getContents,getLine,putStr,putStrLn- ,zip,zipWith,unzip,notElem)+ ,zip,zipWith,zipWith3,unzip,notElem) import Data.StorableVector.Base @@ -199,7 +204,7 @@ import Foreign.Storable (Storable(..)) import Data.Monoid (Monoid, mempty, mappend, mconcat, )-import Control.Monad (mplus, guard, when, )+import Control.Monad (mplus, guard, when, liftM2, liftM3, liftM4, ) import System.IO (openBinaryFile, hClose, hFileSize, hGetBuf, hPutBuf,@@ -587,6 +592,13 @@ concatMap f = concat . unpackWith f {-# INLINE concatMap #-} +-- | This is like @mconcat . map f@,+-- but in many cases the result of @f@ will not be storable.+monoidConcatMap :: (Storable a, Monoid m) => (a -> m) -> Vector a -> m+monoidConcatMap f =+ foldr (mappend . f) mempty+{-# INLINE monoidConcatMap #-}+ -- | /O(n)/ Applied to a predicate and a 'Vector', 'any' determines if -- any element of the 'Vector' satisfies the predicate. any :: (Storable a) => (a -> Bool) -> Vector a -> Bool@@ -744,10 +756,18 @@ -- the value of every element. -- replicate :: (Storable a) => Int -> a -> Vector a-replicate w c- | w <= 0 = empty- | otherwise = fst $ unfoldrN w (const $ return (c, ())) ()+replicate n c =+ fst $ unfoldrN n (const $ Just (c, ())) ()+{-# INLINE replicate #-} +-- | /O(n)/ 'iterateN' @n f x@ is a 'Vector' of length @n@+-- where the elements of @x@ are generated by repeated application of @f@.+--+iterateN :: (Storable a) => Int -> (a -> a) -> a -> Vector a+iterateN n f =+ fst . unfoldrN n (\a -> Just (a, f a))+{-# INLINE iterateN #-}+ -- | /O(n)/, where /n/ is the length of the result. The 'unfoldr' -- function is analogous to the List \'unfoldr\'. 'unfoldr' builds a -- 'Vector' from a seed value. The function takes the element and@@ -778,7 +798,7 @@ -- unfoldrN :: (Storable b) => Int -> (a -> Maybe (b, a)) -> a -> (Vector b, Maybe a) unfoldrN i f x0 =- if i < 0+ if i <= 0 then (empty, Just x0) else unsafePerformIO $ createAndTrim' i $ \p -> go p 0 x0 {-@@ -796,6 +816,53 @@ go (incPtr p) (n+1) x' {-# INLINE unfoldrN #-} +{-+Examples:++f i = Just (i::Char, succ i)++f i = toMaybe (i<='p') (i::Char, succ i)++-}+-- | /O(n)/ Like 'unfoldrN' this function builds a 'Vector'+-- from a seed value with limited size.+-- Additionally it returns a value, that depends on the state,+-- but is not necessarily the state itself.+-- If end of vector and end of the generator coincide,+-- then the result is as if only the end of vector is reached.+--+-- Example:+--+-- > unfoldrResultN 30 Char.ord (\c -> if c>'z' then Left 1000 else Right (c, succ c)) 'a'+--+-- The following equation relates 'unfoldrN' and 'unfoldrResultN':+--+-- > unfoldrN n f s ==+-- > unfoldrResultN n Just+-- > (maybe (Left Nothing) Right . f) s+--+-- It is not possible to express 'unfoldrResultN' in terms of 'unfoldrN'.+--+unfoldrResultN :: (Storable b) => Int -> (a -> c) -> (a -> Either c (b, a)) -> a -> (Vector b, c)+unfoldrResultN i g f x0 =+ if i <= 0+ then (empty, g x0)+ else unsafePerformIO $ createAndTrim' i $ \p -> go p 0 x0+ {-+ go must not be strict in the accumulator+ since otherwise packN would be too strict.+ -}+ where+ go = Strict.arguments2 $ \p n -> \a0 ->+ if n == i+ then return (0, n, g a0)+ else+ case f a0 of+ Left c -> return (0, n, c)+ Right (b,a1) -> do poke p b+ go (incPtr p) (n+1) a1+{-# INLINE unfoldrResultN #-}+ unfoldlN :: (Storable b) => Int -> (a -> Maybe (b, a)) -> a -> (Vector b, Maybe a) unfoldlN i f x0 | i < 0 = (empty, Just x0)@@ -1044,8 +1111,9 @@ -- satisfying the predicate. findIndex :: (Storable a) => (a -> Bool) -> Vector a -> Maybe Int findIndex p xs =- {- the implementation is in principle the same as for findIndices,- but we use the First monoid, instead of the List/append monoid -}+ {- The implementation is in principle the same as for findIndices,+ but we use the First monoid, instead of the List/append monoid.+ We could also implement findIndex in terms of monoidConcatMap. -} foldr (\x k n -> toMaybe (p x) n `mplus` k (succ n))@@ -1155,18 +1223,58 @@ -- corresponding sums. zipWith :: (Storable a, Storable b, Storable c) => (a -> b -> c) -> Vector a -> Vector b -> Vector c-zipWith f ps0 qs0 =- fst $ unfoldrN- (min (length ps0) (length qs0))- (\(ps,qs) ->- do (ph,pt) <- viewL ps- (qh,qt) <- viewL qs- return (f ph qh, (pt,qt)))- (ps0,qs0)+zipWith f as bs =+ unsafeWithStartPtr as $ \pa0 la ->+ withStartPtr bs $ \pb0 lb ->+ let len = min la lb+ in create len $ \p0 ->+ let go = Strict.arguments4 $ \n p pa pb ->+ when (n>0) $+ liftM2 f (peek pa) (peek pb) >>= poke p >>+ go (pred n) (incPtr p) (incPtr pa) (incPtr pb)+ in go len p0 pa0 pb0 + -- zipWith f ps qs = pack $ List.zipWith f (unpack ps) (unpack qs) {-# INLINE zipWith #-} +-- | Like 'zipWith' but for three input vectors+zipWith3 :: (Storable a, Storable b, Storable c, Storable d) =>+ (a -> b -> c -> d) -> Vector a -> Vector b -> Vector c -> Vector d+zipWith3 f as bs cs =+ unsafeWithStartPtr as $ \pa0 la ->+ withStartPtr bs $ \pb0 lb ->+ withStartPtr cs $ \pc0 lc ->+ let len = la `min` lb `min` lc+ in create len $ \p0 ->+ let go = Strict.arguments5 $ \n p pa pb pc ->+ when (n>0) $+ liftM3 f (peek pa) (peek pb) (peek pc) >>= poke p >>+ go (pred n) (incPtr p) (incPtr pa) (incPtr pb) (incPtr pc)+ in go len p0 pa0 pb0 pc0+{-# INLINE zipWith3 #-}++-- | Like 'zipWith' but for four input vectors+-- If you need even more input vectors,+-- you might write a function yourselve using unfoldrN and viewL.+zipWith4 :: (Storable a, Storable b, Storable c, Storable d, Storable e) =>+ (a -> b -> c -> d -> e) -> Vector a -> Vector b -> Vector c -> Vector d -> Vector e+zipWith4 f as bs cs ds =+ unsafeWithStartPtr as $ \pa0 la ->+ withStartPtr bs $ \pb0 lb ->+ withStartPtr cs $ \pc0 lc ->+ withStartPtr ds $ \pd0 ld ->+ let len = la `min` lb `min` lc `min` ld+ in create len $ \p0 ->+ let go =+ Strict.arguments2 $ \n p ->+ Strict.arguments4 $ \pa pb pc pd ->+ when (n>0) $+ liftM4 f (peek pa) (peek pb) (peek pc) (peek pd) >>= poke p >>+ go (pred n) (incPtr p) (incPtr pa) (incPtr pb) (incPtr pc) (incPtr pd)+ in go len p0 pa0 pb0 pc0 pd0+{-# INLINE zipWith4 #-}+ -- | /O(n)/ 'unzip' transforms a list of pairs of elements into a pair of -- 'Vector's. Note that this performs two 'pack' operations. unzip :: (Storable a, Storable b) => [(a, b)] -> (Vector a, Vector b)@@ -1222,13 +1330,22 @@ -- hGet :: (Storable a) => Handle -> Int -> IO (Vector a) hGet _ 0 = return empty-hGet h i =- createAndTrim i $ \p ->+hGet h l =+ createAndTrim l $ \p -> let elemType :: Ptr a -> a elemType _ = undefined- sizeOfElem = sizeOf (elemType p)+ roundUp m n = n + mod (-n) m+ sizeOfElem =+ roundUp+ (alignment (elemType p))+ (sizeOf (elemType p)) in fmap (flip div sizeOfElem) $- hGetBuf h p (i * sizeOfElem)+ hGetBuf h p (l * sizeOfElem)+{-+ createAndTrim l $ \p ->+ fmap (flip div (incPtr p `minusPtr` p)) $+ hGetBuf h p (advancePtr p l `minusPtr` p)+-} -- | Read an entire file strictly into a 'Vector'. This is far more -- efficient than reading the characters into a 'String' and then using@@ -1265,10 +1382,6 @@ foreignPeek fp k = inlinePerformIO $ withForeignPtr fp $ flip peekElemOff k {-# INLINE foreignPeek #-}--incPtr :: (Storable a) => Ptr a -> Ptr a-incPtr v = advancePtr v 1-{-# INLINE incPtr #-} withNonEmptyVector :: String -> (ForeignPtr a -> Int -> Int -> b) -> Vector a -> b
Data/StorableVector/Base.hs view
@@ -38,6 +38,7 @@ fromForeignPtr, -- :: ForeignPtr a -> Int -> Vector a toForeignPtr, -- :: Vector a -> (ForeignPtr a, Int, Int) withStartPtr, -- :: Vector a -> (Ptr a -> Int -> IO b) -> IO b+ incPtr, -- :: Ptr a -> Ptr a inlinePerformIO @@ -133,6 +134,14 @@ unsafeDrop n (SV x s l) = assert (0 <= n && n <= l) $ SV x (s+n) (l-n) {-# INLINE unsafeDrop #-} ++instance (Storable a, Show a) => Show (Vector a) where+ showsPrec p xs@(SV _ _ l) =+ showParen (p>=10)+ (showString "Vector.pack " .+ showsPrec 10 (map (unsafeIndex xs) [0..(l-1)]))++ -- --------------------------------------------------------------------- -- Low level constructors @@ -150,6 +159,10 @@ withStartPtr (SV x s l) f = withForeignPtr x $ \p -> f (p `advancePtr` s) l {-# INLINE withStartPtr #-}++incPtr :: (Storable a) => Ptr a -> Ptr a+incPtr v = advancePtr v 1+{-# INLINE incPtr #-} -- | A way of creating Vectors outside the IO monad. The @Int@ -- argument gives the final size of the Vector. Unlike
Data/StorableVector/Lazy.hs view
@@ -56,8 +56,6 @@ -{-# ONLINE chunks #-}- newtype Vector a = SV {chunks :: [V.Vector a]} @@ -69,7 +67,13 @@ instance (Storable a, Eq a) => Eq (Vector a) where (==) = equal +instance (Storable a, Show a) => Show (Vector a) where+ showsPrec p xs =+ showParen (p>=10)+ (showString "VectorLazy.fromChunks " .+ showsPrec 10 (chunks xs)) + -- for a list of chunk sizes see "Data.StorableVector.LazySize". newtype ChunkSize = ChunkSize Int deriving (Eq, Ord, Show)@@ -123,7 +127,7 @@ {-# INLINE packWith #-} packWith :: (Storable b) => ChunkSize -> (a -> b) -> [a] -> Vector b packWith size f =- unfoldr size (fmap (\(a,b) -> (f a, b)) . ListHT.viewL)+ unfoldr size (fmap (mapFst f) . ListHT.viewL) {-# INLINE unpackWith #-} unpackWith :: (Storable a) => (a -> b) -> Vector a -> [b]@@ -132,15 +136,37 @@ {-# INLINE unfoldr #-} unfoldr :: (Storable b) =>- ChunkSize- -> (a -> Maybe (b,a))- -> a- -> Vector b+ ChunkSize ->+ (a -> Maybe (b,a)) ->+ a ->+ Vector b unfoldr (ChunkSize size) f = SV . List.unfoldr (cancelNullVector . V.unfoldrN size f =<<) . Just +{- |+Example:++> *Data.StorableVector.Lazy> unfoldrResult (ChunkSize 5) (\c -> if c>'z' then Left (Char.ord c) else Right (c, succ c)) 'a'+> (VectorLazy.fromChunks [Vector.pack "abcde",Vector.pack "fghij",Vector.pack "klmno",Vector.pack "pqrst",Vector.pack "uvwxy",Vector.pack "z"],123)+-}+{-# INLINE unfoldrResult #-}+unfoldrResult :: (Storable b) =>+ ChunkSize ->+ (a -> Either c (b, a)) ->+ a ->+ (Vector b, c)+unfoldrResult (ChunkSize size) f =+ let recourse a0 =+ let (chunk, a1) =+ V.unfoldrResultN size Right (either (Left . Left) Right . f) a0+ in either+ ((,) (if V.null chunk then [] else [chunk]))+ (mapFst (chunk :) . recourse) a1+ in mapFst SV . recourse++ {-# INLINE sample #-} sample :: (Storable a) => ChunkSize -> (Int -> a) -> Vector a sample size f =@@ -281,6 +307,11 @@ foldr f x0 = List.foldr (flip (V.foldr f)) x0 . chunks +{-# INLINE monoidConcatMap #-}+monoidConcatMap :: (Storable a, Monoid m) => (a -> m) -> Vector a -> m+monoidConcatMap f =+ List.foldr (mappend . V.monoidConcatMap f) mempty . chunks+ {-# INLINE any #-} any :: (Storable a) => (a -> Bool) -> Vector a -> Bool any p = List.any (V.any p) . chunks@@ -314,8 +345,7 @@ {-# INLINE pointer #-} pointer :: Storable a => Vector a -> Ptr.Pointer a-pointer x =- Ptr.Pointer (chunks x) 0+pointer = Ptr.cons . chunks {-# INLINE viewL #-} viewL :: Storable a => Vector a -> Maybe (a, Vector a)@@ -327,7 +357,11 @@ {-# INLINE viewR #-} viewR :: Storable a => Vector a -> Maybe (Vector a, a) viewR (SV xs0) =+ do xsp <- ListHT.viewR xs0+ let (xs,x) = xsp+{- do ~(xs,x) <- ListHT.viewR xs0+-} let (ys,y) = fromMaybe (moduleError "viewR" "last chunk empty") (V.viewR x) return (append (SV xs) (fromChunk ys), y) @@ -418,8 +452,12 @@ {-# INLINE take #-} take :: (Storable a) => Int -> Vector a -> Vector a-take _ (SV []) = empty+{- this order of pattern matches is certainly the most lazy one+> take 4 (pack (chunkSize 2) $ "abcd" List.++ undefined)+VectorLazy.fromChunks [Vector.pack "ab",Vector.pack "cd"]+-} take 0 _ = empty+take _ (SV []) = empty take n (SV (x:xs)) = let m = V.length x in if m<=n@@ -438,8 +476,12 @@ {-# INLINE splitAt #-} splitAt :: (Storable a) => Int -> Vector a -> (Vector a, Vector a) splitAt n0 =- let recourse _ [] = ([], [])- recourse 0 xs = ([], xs)+ {- this order of pattern matches is certainly the most lazy one+ > splitAt 4 (pack (chunkSize 2) $ "abcd" List.++ undefined)+ (VectorLazy.fromChunks [Vector.pack "ab",Vector.pack "cd"],VectorLazy.fromChunks *** Exception: Prelude.undefined+ -}+ let recourse 0 xs = ([], xs)+ recourse _ [] = ([], []) recourse n (x:xs) = let m = V.length x in if m<=n@@ -527,22 +569,88 @@ SV . List.filter (not . V.null) . List.map (V.filter p) . chunks +{- |+Generates laziness breaks+wherever one of the input signals has a chunk boundary.+-} {-# INLINE zipWith #-} zipWith :: (Storable a, Storable b, Storable c) => (a -> b -> c) -> Vector a -> Vector b -> Vector c-zipWith f =+zipWith f as0 bs0 =+ let recourse at@(a:_) bt@(b:_) =+ let z = V.zipWith f a b+ n = V.length z+ in z : recourse+ (chunks $ drop n $ fromChunks at)+ (chunks $ drop n $ fromChunks bt)+ recourse _ _ = []+ in fromChunks $ recourse (chunks as0) (chunks bs0)++{-# INLINE zipWith3 #-}+zipWith3 :: (Storable a, Storable b, Storable c, Storable d) =>+ (a -> b -> c -> d)+ -> Vector a+ -> Vector b+ -> Vector c+ -> Vector d+zipWith3 f as0 bs0 cs0 =+ let recourse at@(a:_) bt@(b:_) ct@(c:_) =+ let z = V.zipWith3 f a b c+ n = V.length z+ in z : recourse+ (chunks $ drop n $ fromChunks at)+ (chunks $ drop n $ fromChunks bt)+ (chunks $ drop n $ fromChunks ct)+ recourse _ _ _ = []+ in fromChunks $ recourse (chunks as0) (chunks bs0) (chunks cs0)++{-# INLINE zipWith4 #-}+zipWith4 :: (Storable a, Storable b, Storable c, Storable d, Storable e) =>+ (a -> b -> c -> d -> e)+ -> Vector a+ -> Vector b+ -> Vector c+ -> Vector d+ -> Vector e+zipWith4 f as0 bs0 cs0 ds0 =+ let recourse at@(a:_) bt@(b:_) ct@(c:_) dt@(d:_) =+ let z = V.zipWith4 f a b c d+ n = V.length z+ in z : recourse+ (chunks $ drop n $ fromChunks at)+ (chunks $ drop n $ fromChunks bt)+ (chunks $ drop n $ fromChunks ct)+ (chunks $ drop n $ fromChunks dt)+ recourse _ _ _ _ = []+ in fromChunks $+ recourse (chunks as0) (chunks bs0) (chunks cs0) (chunks ds0)+++{- |+Preserves chunk pattern of the last argument.+-}+{-# INLINE zipWithLastPattern #-}+zipWithLastPattern :: (Storable a, Storable b, Storable c) =>+ (a -> b -> c)+ -> Vector a+ -> Vector b+ -> Vector c+zipWithLastPattern f = crochetL (\y -> liftM (mapFst (flip f y)) . Ptr.viewL) . pointer -{-# INLINE zipWith3 #-}-zipWith3 ::+{- |+Preserves chunk pattern of the last argument.+-}+{-# INLINE zipWithLastPattern3 #-}+zipWithLastPattern3 :: (Storable a, Storable b, Storable c, Storable d) => (a -> b -> c -> d) -> (Vector a -> Vector b -> Vector c -> Vector d)-zipWith3 f s0 s1 =+zipWithLastPattern3 f s0 s1 = crochetL (\z (xt,yt) -> liftM2 (\(x,xs) (y,ys) -> (f x y z, (xs,ys)))@@ -550,12 +658,15 @@ (Ptr.viewL yt)) (pointer s0, pointer s1) -{-# INLINE zipWith4 #-}-zipWith4 ::+{- |+Preserves chunk pattern of the last argument.+-}+{-# INLINE zipWithLastPattern4 #-}+zipWithLastPattern4 :: (Storable a, Storable b, Storable c, Storable d, Storable e) => (a -> b -> c -> d -> e) -> (Vector a -> Vector b -> Vector c -> Vector d -> Vector e)-zipWith4 f s0 s1 s2 =+zipWithLastPattern4 f s0 s1 s2 = crochetL (\w (xt,yt,zt) -> liftM3 (\(x,xs) (y,ys) (z,zs) -> (f x y z w, (xs,ys,zs)))@@ -615,7 +726,7 @@ {- | Ensure a minimal length of the list by appending pad values. -}-{-# ONLINE pad #-}+{- disabled INLINE pad -} pad :: (Storable a) => ChunkSize -> a -> Int -> Vector a -> Vector a pad size y n0 = let recourse n xt =@@ -1127,7 +1238,7 @@ then hClose h >> return (Exc.mkIOError Exc.eofErrorType "StorableVector.Lazy.hGetContentsAsync" (Just h) Nothing, [])- else liftM (\ ~(err,rest) -> (err, v:rest)) go+ else fmap (mapSnd (v:)) go {- unsafeInterleaveIO $ flip catch (\err -> return (err,[])) $@@ -1136,19 +1247,15 @@ -} in fmap (mapSnd SV) go -{- hGetContentsSync :: Storable a =>- ChunkSize -> Handle -> IO (IOError, Vector a)+ ChunkSize -> Handle -> IO (Vector a) hGetContentsSync (ChunkSize size) h = let go =- flip catch (\err -> return (err,[])) $ do v <- V.hGet h size if V.null v- then return (Exc.mkIOError Exc.eofErrorType- "StorableVector.Lazy.hGetContentsAsync" (Just h) Nothing, [])- else liftM (\ ~(err,rest) -> (err, v:rest)) go- in fmap (mapSnd SV) go--}+ then return []+ else fmap (v:) go+ in fmap SV go hPut :: Storable a => Handle -> Vector a -> IO () hPut h = mapM_ (V.hPut h) . chunks
Data/StorableVector/Lazy/Builder.hs view
@@ -2,6 +2,11 @@ {- | Build a lazy storable vector by incrementally adding an element. This is analogous to Data.Binary.Builder for Data.ByteString.Lazy.++Attention:+This implementation is still almost 3 times slower+than constructing a lazy storable vector using unfoldr+in our Chorus speed test. -} module Data.StorableVector.Lazy.Builder ( Builder,@@ -12,76 +17,141 @@ import qualified Data.StorableVector as SV import qualified Data.StorableVector.Lazy as SVL-import qualified Data.StorableVector.ST.Lazy as STV-import qualified Data.StorableVector.ST.Private as STVP-import qualified Control.Monad.Trans.RWS as RWS+import qualified Data.StorableVector.ST.Strict as STV+import qualified Data.StorableVector.ST.Lazy as STVL -import Foreign.Storable (Storable, ) import Data.StorableVector.Lazy (ChunkSize(ChunkSize), )-import Control.Monad.ST.Lazy (ST, runST, strictToLazyST, )-import Control.Monad.Trans.RWS (RWST, runRWST, )-import Control.Monad.Trans (lift, )-import Data.Monoid (Monoid(mempty, mappend), Endo(Endo), appEndo, )+import Control.Monad (liftM2, )+import Control.Monad.ST.Strict (ST, runST, unsafeInterleaveST, )+import Data.Monoid (Monoid(mempty, mappend), ) +import Foreign.Storable (Storable, ) ++{-+Given an initial buffer and a function that generates the rest of the vector,+a 'Builder' generates the whole vector.+The idea is inspired by Data.Binary.Builder.++We use the strict ST monad by default+and only rare 'unsafeInterleaveST',+since this is more efficient than using lazy ST everywhere.++Before that approach I tried to achieve this with a lazy State monad.+I found this more comprehensible but it was very slow+and had a space leak, when the last chunk shall be handled correctly.+-} newtype Builder a = Builder {run :: forall s.- RWST ChunkSize (Endo [SV.Vector a]) (STV.Vector s a, Int) (ST s) ()}+ ChunkSize ->+ (Buffer s a -> ST s [SV.Vector a]) ->+ (Buffer s a -> ST s [SV.Vector a])+ } +type Buffer s a = (STV.Vector s a, Int) + -- instance Monoid (Builder a) where {--Storable constraint not need in the current implementation,+Storable constraint not needed in the current implementation, but who knows what will be in future ... -} instance Storable a => Monoid (Builder a) where- mempty = Builder (return ())- mappend x y = Builder (run x >> run y)+ {-# INLINE mempty #-}+ {-# INLINE mappend #-}+ mempty = Builder (\_ -> id)+ mappend x y = Builder (\cs -> run x cs . run y cs) -{--SVL.unpack $ toLazyStorableVector (ChunkSize 7) $ Data.Monoid.mconcat $ map put ['a'..'z']+{- |+> toLazyStorableVector (ChunkSize 7) $ Data.Monoid.mconcat $ map put ['a'..'z'] -}+{-# INLINE toLazyStorableVector #-} toLazyStorableVector :: Storable a => ChunkSize -> Builder a -> SVL.Vector a-toLazyStorableVector cs@(SVL.ChunkSize size) bld =- runST (do- v0 <- STV.new_ size- (_,vi1,chunks) <- runRWST (run bld) cs (v0,0)- lastChunk <- fixVector vi1- return $ SVL.fromChunks $ appEndo chunks [lastChunk])+toLazyStorableVector cs bld =+ SVL.fromChunks $+ runST (run bld cs (fmap (:[]) . fixVector) =<< newChunk cs) ++{-# INLINE put #-} put :: Storable a => a -> Builder a put a =- Builder (- do (SVL.ChunkSize size) <- RWS.ask- (v0,i0) <- RWS.get- (v1,i1) <-- if i0<size- then return (v0,i0)- else+ Builder (\cs cont (v0,i0) ->+ do STV.unsafeWrite v0 i0 a+ let i1 = succ i0+ if i1 < STV.length v0+ then+ cont (v0, i1)+ else+ liftM2 (:) -- we could call 'flush' here, but this requires an extra 'SV.take'- do RWS.tell . Endo . (:) =<<- (lift $ strictToLazyST $ STVP.unsafeToVector v0)- lift $ fmap (flip (,) 0) $ STV.new_ size- lift $ STV.write v1 i1 a- RWS.put (v1, succ i1)+ (STV.unsafeFreeze v0)+ (unsafeInterleaveST $+ cont =<< newChunk cs) ) +{-+put :: Storable a => a -> Builder a+put a =+ Builder (\cs cont (v0,i0) ->+ if i0 < STV.length v0+ then+ do STV.write v0 i0 a+ cont (v0, succ i0)+ else+ liftM2 (:)+ -- we could call 'flush' here, but this requires an extra 'SV.take'+ (STV.unsafeFreeze v0)+ (unsafeInterleaveST $+ do (v1,i1) <- newChunk cs+ STV.write v1 i1 a+ cont (v1, succ i1))+ )+-}++{-+ lazyToStrictST $+ liftM2 (:)+ -- we could call 'flush' here, but this requires an extra 'SV.take'+ (STVL.unsafeFreeze v0)+ (strictToLazyST $+ do (v1,i1) <- newChunk cs+ STV.write v1 i1 a+ cont (v1, succ i1))+-}++{-+Prelude Control.Monad.ST.Lazy> Control.Monad.ST.runST (lazyToStrictST $ Monad.liftM2 (,) (strictToLazyST $ return 'a') (strictToLazyST (undefined::Monad m => m Char)))+*** Exception: Prelude.undefined+-}+ {- | Set a laziness break. -}+{-# INLINE flush #-} flush :: Storable a => Builder a flush =- Builder (- do RWS.tell . Endo . (:) =<< lift . fixVector =<< RWS.get- (SVL.ChunkSize size) <- RWS.ask- v1 <- lift $ STV.new_ size- RWS.put (v1, 0)+ Builder (\cs cont vi0 ->+ liftM2 (:)+ (fixVector vi0)+ (unsafeInterleaveST $ cont =<< newChunk cs)+{-+ lazyToStrictST $+ liftM2 (:)+ (strictToLazyST $ fixVector vi0)+ (strictToLazyST $ cont =<< newChunk cs)+-} ) +{-# INLINE newChunk #-}+newChunk :: (Storable a) =>+ ChunkSize -> ST s (Buffer s a)+newChunk (SVL.ChunkSize size) =+ fmap (flip (,) 0) $ STV.new_ size++{-# INLINE fixVector #-} fixVector :: (Storable a) =>- (STVP.Vector s a, Int) -> ST s (SV.Vector a)+ Buffer s a -> ST s (SV.Vector a) fixVector ~(v1,i1) =- fmap (SV.take i1) $- strictToLazyST $ STVP.unsafeToVector v1+ fmap (SV.take i1) $ STV.unsafeFreeze v1
Data/StorableVector/Lazy/Pattern.hs view
@@ -102,7 +102,6 @@ import qualified Data.List as List -import Data.Maybe (Maybe(Just, Nothing), ) import qualified Data.List.HT as ListHT import Data.Tuple.HT (mapPair, mapFst, forcePair, ) @@ -110,12 +109,14 @@ import Foreign.Storable (Storable) -{- import Prelude hiding (length, (++), iterate, foldl, map, repeat, replicate, null,- zip, zipWith, zipWith3, drop, take, splitAt, takeWhile, dropWhile, reverse)--}+ zip, zipWith, zipWith3, drop, take, splitAt, takeWhile, dropWhile, reverse,+ any, all, concat, cycle, filter, maximum, minimum, scanl, span, )+{-+import Data.Maybe (Maybe(Just, Nothing), ) import Prelude (Int, (.), ($), fst, snd, (<=), flip, curry, return, fmap, not, uncurry, )+-} type LazySize = LS.T ChunkSize
Data/StorableVector/Lazy/PointerPrivate.hs view
@@ -1,5 +1,6 @@ module Data.StorableVector.Lazy.PointerPrivate where +import qualified Data.StorableVector.Pointer as VP import qualified Data.StorableVector as V import qualified Data.StorableVector.Base as VB @@ -7,9 +8,21 @@ data Pointer a =- Pointer {chunks :: ![VB.Vector a], index :: !Int}+ Pointer {+ chunks :: [VB.Vector a],+ ptr :: {-# UNPACK #-} !(VP.Pointer a)+ } +empty :: Storable a => Pointer a+empty =+ Pointer [] (VP.cons V.empty)++{-# INLINE cons #-}+cons :: Storable a => [VB.Vector a] -> Pointer a+cons [] = empty+cons (c:cs) = Pointer cs (VP.cons c)+ {-# INLINE viewL #-} viewL :: Storable a => Pointer a -> Maybe (a, Pointer a) viewL = switchL Nothing (curry Just)@@ -19,13 +32,11 @@ b -> (a -> Pointer a -> b) -> Pointer a -> b switchL n j = let recourse p =- let s = chunks p- in case s of- [] -> n- (c:cs) ->- let i = index p- d = i - V.length c- in if d < 0- then j (VB.unsafeIndex c i) (Pointer s (i+1))- else recourse (Pointer cs d)+ let ct = chunks p+ in VP.switchL+ (case ct of+ [] -> n+ (c:cs) -> recourse (Pointer cs (VP.cons c)))+ (\a cp -> j a (Pointer ct cp))+ (ptr p) in recourse
+ Data/StorableVector/Lazy/PointerPrivateIndex.hs view
@@ -0,0 +1,38 @@+{-+Alternative to PointerPrivate implemented at a higher level.+-}+module Data.StorableVector.Lazy.PointerPrivateIndex where++import qualified Data.StorableVector as V+import qualified Data.StorableVector.Base as VB++import Foreign.Storable (Storable)+++data Pointer a =+ Pointer {chunks :: ![VB.Vector a], index :: !Int}+++{-# INLINE cons #-}+cons :: Storable a => [VB.Vector a] -> Pointer a+cons = flip Pointer 0++{-# INLINE viewL #-}+viewL :: Storable a => Pointer a -> Maybe (a, Pointer a)+viewL = switchL Nothing (curry Just)++{-# INLINE switchL #-}+switchL :: Storable a =>+ b -> (a -> Pointer a -> b) -> Pointer a -> b+switchL n j =+ let recourse p =+ let s = chunks p+ in case s of+ [] -> n+ (c:cs) ->+ let i = index p+ d = i - V.length c+ in if d < 0+ then j (VB.unsafeIndex c i) (Pointer s (i+1))+ else recourse (Pointer cs d)+ in recourse
+ Data/StorableVector/Pointer.hs view
@@ -0,0 +1,52 @@+{- |+In principle you can traverse through a storable vector+using repeated calls to @viewL@ or using @index@.+However this needs a bit of pointer arrangement and allocation.+This data structure should make loops optimally fast.+-}+module Data.StorableVector.Pointer where++-- import qualified Data.StorableVector as V+import qualified Data.StorableVector.Base as VB++import qualified Foreign.ForeignPtr as FPtr+import Foreign.Marshal.Array (advancePtr, )+import Foreign.Storable (Storable, peek, )+import Foreign (Ptr, ForeignPtr, )+-- import System.IO.Unsafe (unsafePerformIO, )+++{-+The reference to the ForeignPtr asserts,+that the array is maintained and thus is not garbage collected.+The Ptr we use for traversing would not achieve this.+-}+{- |+We might have name the data type iterator.+-}+data Pointer a =+ Pointer {+ fptr :: {-# UNPACK #-} !(FPtr.ForeignPtr a),+ ptr :: {-# UNPACK #-} !(Ptr a),+ left :: {-# UNPACK #-} !Int+ }+++{-# INLINE cons #-}+cons :: Storable a => VB.Vector a -> Pointer a+cons (VB.SV fp s l) =+ Pointer fp (advancePtr (FPtr.unsafeForeignPtrToPtr fp) s) l+++{-# INLINE viewL #-}+viewL :: Storable a => Pointer a -> Maybe (a, Pointer a)+viewL = switchL Nothing (curry Just)++{-# INLINE switchL #-}+switchL :: Storable a =>+ b -> (a -> Pointer a -> b) -> Pointer a -> b+switchL n j (Pointer fp p l) =+ if l<=0+ then n+ else j (VB.inlinePerformIO (peek p)) (Pointer fp (advancePtr p 1) (l-1))+-- unsafePerformIO at this place would make SpeedPointer test 0.5 s slower
+ Data/StorableVector/Private.hs view
@@ -0,0 +1,151 @@+{- |+Functions that may be useful, but I'm uncertain.+-}+module Data.StorableVector.Private where+++import Data.StorableVector (empty, unfoldrN, viewL, length, )+import Data.StorableVector.Base++import qualified Data.Strictness.HT as Strict++import Foreign.Storable (Storable(..))++import System.IO.Unsafe (unsafePerformIO, )++import Control.DeepSeq (NFData, rnf, deepseq, )++import Prelude hiding (length, )++++{- |+This implementation is based on viewL+and thus not as fast as possible.+-}+zipWithViewL :: (Storable a, Storable b, Storable c) =>+ (a -> b -> c) -> Vector a -> Vector b -> Vector c+zipWithViewL f ps0 qs0 =+ fst $ unfoldrN+ (min (length ps0) (length qs0))+ (\(ps,qs) ->+ do (ph,pt) <- viewL ps+ (qh,qt) <- viewL qs+ return (f ph qh, (pt,qt)))+ (ps0,qs0)+++zipWithIndex :: (Storable a, Storable b, Storable c) =>+ (a -> b -> c) -> Vector a -> Vector b -> Vector c+zipWithIndex f ps qs =+ fst $ unfoldrN+ (min (length ps) (length qs))+ (\i -> Just (f (unsafeIndex ps i) (unsafeIndex qs i), succ i))+ 0+++unfoldrStrictN :: (Storable b, NFData a) => Int -> (a -> Maybe (b, a)) -> a -> (Vector b, Maybe a)+-- unfoldrStrictN :: (Storable b) => Int -> (a -> Maybe (b, a)) -> a -> (Vector b, Maybe a)+unfoldrStrictN i f x0 =+ if i <= 0+ then (empty, Just x0)+ else unsafePerformIO $ createAndTrim' i $ \p -> go p 0 x0+ {-+ go must not be strict in the accumulator+ since otherwise packN would be too strict.+ -}+ where+ go = Strict.arguments3 $ \p n -> \x ->+ if n == i+ then return (0, n, Just x)+ else+ case f x of+ Nothing -> return (0, n, Nothing)+ Just (w,x') -> do poke p w+-- go (incPtr p) (n+1) $! x'+ go (incPtr p) (n+1) (x' `deepseq` x')+-- seq (rnf x') (((go $! incPtr p) $! n+1) $! x')+{-# INLINE unfoldrStrictN #-}++unfoldrTransitionN :: (Storable b) => Int -> (a -> a) -> (a -> Maybe b) -> a -> (Vector b, a)+unfoldrTransitionN n trans emit x =+ if n <= 0+ then (empty, x)+ else unsafePerformIO $ createAndTrim' n $ \p ->+ case emit x of+ Nothing -> return (0, n, x)+ Just y0 -> poke p y0 >>+ {-+ go must not be strict in the accumulator+ since otherwise packN would be too strict.+ -}+ let go = Strict.arguments2 $ \p0 i0 -> \x0 ->+ {-+ We run 'emit' in order to evaluate the new state.+ We need to return this new state+ also in case the array is full.+ The drawback is, that the whole vector becomes undefined+ if only the state after the last element is undefined.+ This is the same situation as in an unfoldr with strict state.+ -}+ let i1 = i0-1+ x1 = trans x0+ in case emit x1 of+ Nothing -> return (0, n-i1, x1)+ Just y1 ->+ if i1 == 0+ then return (0, n, x1)+ else+ let p1 = incPtr p0+ in do poke p1 y1+ go p1 i1 x1+{-+ let i1 = i0-1+ in if i1 == 0+ then return (0, n, x0)+ else+ let x1 = trans x0+ p1 = incPtr p0+ in case emit x1 of+ Nothing -> return (0, n-i1, x1)+ Just y1 -> do poke p1 y1+ go p1 i1 x1+-}+ in go p n x+{-# INLINE unfoldrTransitionN #-}++-- | /O(n)/ Like 'unfoldrN' this function builds a 'Vector' from a seed+-- value. However, it does always return a state value.+-- The vector construction can be aborted either by reaching+-- the given maximum size or by returning 'Nothing' as element.+--+-- The following equation relates 'unfoldrN' and 'unfoldrStateN':+--+-- > unfoldrN n f s ==+-- > unfoldrStateN n+-- > (maybe (error "state will be always Just")+-- > ((\a -> (fmap fst a, fmap snd a)) . f))+-- > (Just s)+--+-- It is not possible to express 'unfoldrNState' in terms of 'unfoldrN'.+--+unfoldrStateN :: (Storable b) => Int -> (a -> (Maybe b, a)) -> a -> (Vector b, a)+unfoldrStateN i f x0 =+ if i <= 0+ then (empty, x0)+ else unsafePerformIO $ createAndTrim' i $ \p -> go p 0 x0+ {-+ go must not be strict in the accumulator+ since otherwise packN would be too strict.+ -}+ where+ go = Strict.arguments2 $ \p n -> \x ->+ if n == i+ then return (0, n, x)+ else+ let (my,x') = f x+ in case my of+ Nothing -> return (0, n, x)+ Just w -> do poke p w+ go (incPtr p) (n+1) x'+{-# INLINE unfoldrStateN #-}
Data/StorableVector/ST/Lazy.hs view
@@ -16,7 +16,11 @@ read, write, modify,+ unsafeRead,+ unsafeWrite,+ unsafeModify, freeze,+ unsafeFreeze, thaw, VST.length, runSTVector,@@ -43,25 +47,14 @@ -{-# INLINE new #-}-{-# INLINE new_ #-}-{-# INLINE read #-}-{-# INLINE write #-}-{-# INLINE modify #-}-{-# INLINE freeze #-}-{-# INLINE thaw #-}-{-# ONLINE length #-}-{-# INLINE runSTVector #-}-{-# INLINE mapST #-}-{-# INLINE mapSTLazy #-}-- -- * access to mutable storable vector +{-# INLINE new #-} new :: (Storable e) => Int -> e -> ST s (Vector s e) new n x = ST.strictToLazyST (VST.new n x) +{-# INLINE new_ #-} new_ :: (Storable e) => Int -> ST s (Vector s e) new_ n = ST.strictToLazyST (VST.new_ n)@@ -69,6 +62,7 @@ {- | > Control.Monad.ST.runST (do arr <- new_ 10; Monad.zipWithM_ (write arr) [9,8..0] ['a'..]; read arr 3) -}+{-# INLINE read #-} read :: (Storable e) => Vector s e -> Int -> ST s e read xs n = ST.strictToLazyST (VST.read xs n)@@ -76,24 +70,51 @@ {- | > VS.unpack $ runSTVector (do arr <- new_ 10; Monad.zipWithM_ (write arr) [9,8..0] ['a'..]; return arr) -}+{-# INLINE write #-} write :: (Storable e) => Vector s e -> Int -> e -> ST s () write xs n x = ST.strictToLazyST (VST.write xs n x) +{-# INLINE modify #-} modify :: (Storable e) => Vector s e -> Int -> (e -> e) -> ST s () modify xs n f = ST.strictToLazyST (VST.modify xs n f) ++{-# INLINE unsafeRead #-}+unsafeRead :: (Storable e) =>+ Vector s e -> Int -> ST s e+unsafeRead xs n = ST.strictToLazyST (VST.unsafeRead xs n)++{-# INLINE unsafeWrite #-}+unsafeWrite :: (Storable e) =>+ Vector s e -> Int -> e -> ST s ()+unsafeWrite xs n x = ST.strictToLazyST (VST.unsafeWrite xs n x)++{-# INLINE unsafeModify #-}+unsafeModify :: (Storable e) =>+ Vector s e -> Int -> (e -> e) -> ST s ()+unsafeModify xs n f = ST.strictToLazyST (VST.unsafeModify xs n f)+++{-# INLINE freeze #-} freeze :: (Storable e) => Vector s e -> ST s (VS.Vector e) freeze xs = ST.strictToLazyST (VST.freeze xs) +{-# INLINE unsafeFreeze #-}+unsafeFreeze :: (Storable e) =>+ Vector s e -> ST s (VS.Vector e)+unsafeFreeze xs = ST.strictToLazyST (VST.unsafeFreeze xs)++{-# INLINE thaw #-} thaw :: (Storable e) => VS.Vector e -> ST s (Vector s e) thaw xs = ST.strictToLazyST (VST.thaw xs) +{-# INLINE runSTVector #-} runSTVector :: (Storable e) => (forall s. ST s (Vector s e)) -> VS.Vector e runSTVector m = VST.runSTVector (ST.lazyToStrictST m)@@ -106,6 +127,7 @@ > :module + Data.STRef > VS.unpack $ Control.Monad.ST.runST (do ref <- newSTRef 'a'; mapST (\ _n -> do c <- readSTRef ref; modifySTRef ref succ; return c) (VS.pack [1,2,3,4::Data.Int.Int16])) -}+{-# INLINE mapST #-} mapST :: (Storable a, Storable b) => (a -> ST s b) -> VS.Vector a -> ST s (VS.Vector b) mapST f xs =@@ -123,6 +145,7 @@ > *Data.StorableVector.ST.Strict Data.STRef.Lazy> VL.unpack $ Control.Monad.ST.Lazy.runST (do ref <- newSTRef 'a'; mapSTLazy (\ _n -> do c <- readSTRef ref; modifySTRef ref succ; return c) (VL.pack VL.defaultChunkSize [0::Data.Int.Int16 ..])) > "Interrupted. -}+{-# INLINE mapSTLazy #-} mapSTLazy :: (Storable a, Storable b) => (a -> ST s b) -> VL.Vector a -> ST s (VL.Vector b) mapSTLazy f (VL.SV xs) =
Data/StorableVector/ST/Private.hs view
@@ -12,11 +12,13 @@ import qualified Data.StorableVector.Base as V import qualified Data.StorableVector as VS +import Data.StorableVector.Memory (mallocForeignPtrArray, )+ import qualified Control.Monad.ST.Strict as ST import Control.Monad.ST.Strict (ST, unsafeIOToST, ) -- stToIO, import Foreign.Ptr (Ptr, )-import Foreign.ForeignPtr (ForeignPtr, withForeignPtr, mallocForeignPtrArray, )+import Foreign.ForeignPtr (ForeignPtr, withForeignPtr, ) import Foreign.Storable (Storable, ) -- import Prelude (Int, ($), (+), return, const, )
Data/StorableVector/ST/Strict.hs view
@@ -16,7 +16,11 @@ read, write, modify,+ unsafeRead,+ unsafeWrite,+ unsafeModify, freeze,+ unsafeFreeze, thaw, length, runSTVector,@@ -25,7 +29,7 @@ ) where import Data.StorableVector.ST.Private- (Vector(SV), unsafeCreate, unsafeToVector, )+ (Vector(SV), create, unsafeCreate, unsafeToVector, ) import qualified Data.StorableVector.Base as V import qualified Data.StorableVector as VS import qualified Data.StorableVector.Lazy as VL@@ -43,21 +47,9 @@ import Prelude hiding (read, length, ) -{-# INLINE new #-}-{-# INLINE new_ #-}-{-# INLINE read #-}-{-# INLINE write #-}-{-# INLINE modify #-}-{-# INLINE freeze #-}-{-# INLINE thaw #-}-{-# INLINE length #-}-{-# INLINE runSTVector #-}-{-# INLINE mapST #-}-{-# INLINE mapSTLazy #-}-- -- * access to mutable storable vector +{-# INLINE new #-} new :: (Storable e) => Int -> e -> ST s (Vector s e) new n x =@@ -65,10 +57,11 @@ let {-# INLINE go #-} go m p = if m>0- then poke p x >> go (pred m) (p `advancePtr` 1)+ then poke p x >> go (pred m) (V.incPtr p) else return () in go n +{-# INLINE new_ #-} new_ :: (Storable e) => Int -> ST s (Vector s e) new_ n =@@ -78,35 +71,65 @@ {- | > Control.Monad.ST.runST (do arr <- new_ 10; Monad.zipWithM_ (write arr) [9,8..0] ['a'..]; read arr 3) -}+{-# INLINE read #-} read :: (Storable e) => Vector s e -> Int -> ST s e read v n =- access "read" v n $ peek+ access "read" v n $ unsafeRead v n {- | > VS.unpack $ runSTVector (do arr <- new_ 10; Monad.zipWithM_ (write arr) [9,8..0] ['a'..]; return arr) -}+{-# INLINE write #-} write :: (Storable e) => Vector s e -> Int -> e -> ST s () write v n x =- access "write" v n $ \p -> poke p x+ access "write" v n $ unsafeWrite v n x {- | > VS.unpack $ runSTVector (do arr <- new 10 'a'; Monad.mapM_ (\n -> modify arr (mod n 8) succ) [0..10]; return arr) -}+{-# INLINE modify #-} modify :: (Storable e) => Vector s e -> Int -> (e -> e) -> ST s () modify v n f =- access "modify" v n $ \p -> poke p . f =<< peek p+ access "modify" v n $ unsafeModify v n f {-# INLINE access #-} access :: (Storable e) =>- String -> Vector s e -> Int -> (Ptr e -> IO a) -> ST s a-access name (SV v l) n act =+ String -> Vector s e -> Int -> ST s a -> ST s a+access name (SV _v l) n act = if 0<=n && n<l- then unsafeIOToST (withForeignPtr v $ \p -> act (advancePtr p n))+ then act else error ("StorableVector.ST." ++ name ++ ": index out of range") ++{-# INLINE unsafeRead #-}+unsafeRead :: (Storable e) =>+ Vector s e -> Int -> ST s e+unsafeRead v n =+ unsafeAccess v n $ peek++{-# INLINE unsafeWrite #-}+unsafeWrite :: (Storable e) =>+ Vector s e -> Int -> e -> ST s ()+unsafeWrite v n x =+ unsafeAccess v n $ \p -> poke p x++{-# INLINE unsafeModify #-}+unsafeModify :: (Storable e) =>+ Vector s e -> Int -> (e -> e) -> ST s ()+unsafeModify v n f =+ unsafeAccess v n $ \p -> poke p . f =<< peek p++{-# INLINE unsafeAccess #-}+unsafeAccess :: (Storable e) =>+ Vector s e -> Int -> (Ptr e -> IO a) -> ST s a+unsafeAccess (SV v _l) n act =+ unsafeIOToST (withForeignPtr v $ \p -> act (advancePtr p n))+++{-# INLINE freeze #-} freeze :: (Storable e) => Vector s e -> ST s (VS.Vector e) freeze (SV x l) =@@ -115,20 +138,35 @@ withForeignPtr x $ \f -> copyArray p f (fromIntegral l) +{- |+This is like 'freeze' but it does not copy the vector.+You must make sure that you never write again to the array.+It is best to use 'unsafeFreeze' only at the end of a block,+that is run by 'runST'.+-}+{-# INLINE unsafeFreeze #-}+unsafeFreeze :: (Storable e) =>+ Vector s e -> ST s (VS.Vector e)+unsafeFreeze = unsafeToVector ++{-# INLINE thaw #-} thaw :: (Storable e) => VS.Vector e -> ST s (Vector s e)-thaw (V.SV x s l) =- unsafeCreate l $ \p ->- withForeignPtr x $ \f ->- copyArray p (f `advancePtr` s) (fromIntegral l)+thaw v =+ unsafeIOToST $+ V.withStartPtr v $ \f l ->+ create l $ \p ->+ copyArray p f (fromIntegral l) +{-# INLINE length #-} length :: Vector s e -> Int length (SV _v l) = l +{-# INLINE runSTVector #-} runSTVector :: (Storable e) => (forall s. ST s (Vector s e)) -> VS.Vector e runSTVector m =@@ -142,6 +180,7 @@ > :module + Data.STRef > VS.unpack $ Control.Monad.ST.runST (do ref <- newSTRef 'a'; mapST (\ _n -> do c <- readSTRef ref; modifySTRef ref succ; return c) (VS.pack [1,2,3,4::Data.Int.Int16])) -}+{-# INLINE mapST #-} mapST :: (Storable a, Storable b) => (a -> ST s b) -> VS.Vector a -> ST s (VS.Vector b) mapST f (V.SV px sx n) =@@ -183,6 +222,7 @@ > *Data.StorableVector.ST.Strict Data.STRef> VL.unpack $ Control.Monad.ST.runST (do ref <- newSTRef 'a'; mapSTLazy (\ _n -> do c <- readSTRef ref; modifySTRef ref succ; return c) (VL.pack VL.defaultChunkSize [0::Data.Int.Int16 ..])) > "Interrupted. -}+{-# INLINE mapSTLazy #-} mapSTLazy :: (Storable a, Storable b) => (a -> ST s b) -> VL.Vector a -> ST s (VL.Vector b) mapSTLazy f (VL.SV xs) =
+ foreign-ptr/fast/Data/StorableVector/Memory.hs view
@@ -0,0 +1,9 @@+module Data.StorableVector.Memory where++import Foreign.Storable (Storable)+import Foreign.ForeignPtr (ForeignPtr)+import GHC.ForeignPtr (mallocPlainForeignPtrBytes)++{-# INLINE mallocForeignPtrArray #-}+mallocForeignPtrArray :: Storable a => Int -> IO (ForeignPtr a)+mallocForeignPtrArray = mallocPlainForeignPtrArray
+ foreign-ptr/jhc/Data/StorableVector/Memory.hs view
@@ -0,0 +1,12 @@+module Data.StorableVector.Memory where++import Foreign.Storable (Storable, sizeOf, )+import qualified Foreign.ForeignPtr as F+++{-# INLINE mallocForeignPtrArray #-}+mallocForeignPtrArray :: Storable a => Int -> IO (F.ForeignPtr a)+mallocForeignPtrArray =+ let withSize :: Storable a => a -> (Int -> IO (F.ForeignPtr a)) -> (Int -> IO (F.ForeignPtr a))+ withSize dummy f n = f (n*sizeOf dummy)+ in withSize undefined F.mallocForeignPtrBytes
+ foreign-ptr/slow/Data/StorableVector/Memory.hs view
@@ -0,0 +1,9 @@+module Data.StorableVector.Memory where++import Foreign.Storable (Storable)+import qualified Foreign.ForeignPtr as F+++{-# INLINE mallocForeignPtrArray #-}+mallocForeignPtrArray :: Storable a => Int -> IO (F.ForeignPtr a)+mallocForeignPtrArray = F.mallocForeignPtrArray
− slow-foreign-ptr/Data/StorableVector/Memory.hs
@@ -1,9 +0,0 @@-module Data.StorableVector.Memory where--import Foreign.Storable (Storable)-import qualified Foreign.ForeignPtr as F---{-# INLINE mallocForeignPtrArray #-}-mallocForeignPtrArray :: Storable a => Int -> IO (F.ForeignPtr a)-mallocForeignPtrArray = F.mallocForeignPtrArray
speedtest/Pointer.hs view
@@ -1,4 +1,4 @@-{-# OPTIONS_GHC -O -ddump-simpl-stats #-}+{-# OPTIONS_GHC -funbox-strict-fields -ddump-simpl-stats -O2 #-} {- -dverbose-core2core -} module Main (main) where @@ -70,10 +70,11 @@ print $ SV.foldl' (+) 0 $ SV.take 10000000 $- (case 1 of+ (case (1::Int) of 0 -> zipWith (+) 1 -> zipWithPointer (+) 2 -> zipWithSize SV.defaultChunkSize (+)- 3 -> zipWithPointerSize SV.defaultChunkSize (+))+ 3 -> zipWithPointerSize SV.defaultChunkSize (+)+ _ -> error "invalid choice") (SV.iterate SV.defaultChunkSize (subtract 1) 0)- (SV.iterate SV.defaultChunkSize (1+) (0::Int16))+ (SV.iterate SV.defaultChunkSize (1+) (1::Int16))
+ speedtest/SpeedTestChorus.hs view
@@ -0,0 +1,553 @@+{-# OPTIONS_GHC -funbox-strict-fields -ddump-simpl -O #-}+{-# LANGUAGE ExistentialQuantification #-}+{- -dverbose-core2core -ddump-simpl-stats -}+{-+This module demonstrates the following:+mainMonolithic1Generator performs the same computation as mainMonolithic1Compose+but the former is more than two times slower than latter.+This is serious since in more complex signal processing programs+this factor seems to multiply.+I assume that the problem is that 'mixGen' is not inlined.+Instead GHC seems to have decided to specialise mixGen.+In contrast to mainMonolithic1Compose,+mainMonolithic1Generator uses a data type with existential quantification.+But this alone is not the problem,+since mainMonolithic0 and mainMonolithic0Generator run with the same speed.++The program can be compiled using+> ghc -package storablevector-0.2.5 -O speedtest/SpeedTestChorus.hs+++Exporting only main causes warnings about unused functions,+but it also reduces the core output to a third.+-}+module Main (main) where++import qualified Data.StorableVector.Lazy.Builder as Builder+import qualified Data.StorableVector.ST.Strict as SVSTS+import qualified Data.StorableVector.ST.Lazy as SVSTL+import qualified Data.StorableVector as SV+import qualified Data.StorableVector.Lazy as SVL+import qualified Data.StorableVector.Private as SVP++import qualified Control.Monad.ST.Strict as StrictST+import Control.Monad.ST.Lazy (ST, runST, strictToLazyST, )++import Foreign.Storable (Storable, )+import GHC.Float (float2Int, int2Float, double2Int, int2Double, )++import qualified Sound.Frame.Stereo as Stereo++-- import qualified Data.Strictness.HT as Strict++import Control.Monad (guard, zipWithM, )+import Data.Monoid (mempty, mappend, )+++{-+I started with Storable instance for pairs from storable-tuple,+that was implemented using the storable-record framework at this time.+I got run-time around 5 seconds.+When I used inlining then the computation time increased to 8s!+Then I switch to sample-frame:Sound.Frame.Stereo+computation time dropped to 1.4 seconds.+At this time I already switched back+from the storable-record based implementation to a custom one+of the Storable Stereo instance.+With this implementation inlining doesn't change the run-time.+But then I noted that the generated file+contained only one saw wave tone.+This problem disappeared by not using -O2 option, but only -O.+Monolithic and chunky require about 2.6 seconds,+whereas monolithicStrict needs 3.8 seconds.+After inlining monolithicStrict needs 1.8 seconds.+-}++type Phase = (Float, Float, Float)++{-# INLINE saw #-}+saw :: Num a => a -> a+saw t = 1-2*t++{-# INLINE sawChorus #-}+sawChorus :: Phase -> Float+sawChorus (pl0,pl1,pl2) =+ 0.3 * (saw pl0 + saw pl1 + saw pl2)++{-+Much faster than @snd . properFraction@ but fails for large numbers.+-}+class (Num a, Ord a) => Fraction a where+ fraction :: a -> a++instance Fraction Float where+ {-# INLINE fraction #-}+ fraction x = x - int2Float (float2Int x)++instance Fraction Double where+ {-# INLINE fraction #-}+ fraction x = x - int2Double (double2Int x)++{-+fraction = Strict.arguments1 $ \x ->+ let y = x - int2Float (float2Int x)+ in y+-}+{-+ in if y<0+ then y+1+ else y+-}+{-+ if x==0+ then 0+ else x - int2Float (float2Int x)+-}+-- rnf x `seq` x - int2Float (float2Int x)+++{-# INLINE generator0Freq #-}+generator0Freq ::+ Fraction a => a -> a -> Maybe (a, a)+generator0Freq freq =+ \p -> Just (saw p, fraction (p+freq))++{-# INLINE generator0 #-}+generator0 ::+ Float -> Maybe (Float, Float)+generator0 = generator0Freq 0.01+++{-# INLINE tone0 #-}+tone0 :: Float -> Float -> SVL.Vector Float+tone0 freq phase =+ SVL.unfoldr SVL.defaultChunkSize (generator0Freq freq) phase+++{-# INLINE runLoopSTStrict #-}+runLoopSTStrict ::+ (Storable a) =>+ Int -> (s -> Maybe (a, s)) -> s -> SV.Vector a+runLoopSTStrict n f s =+ SVSTS.runSTVector+ (do v <- SVSTS.new_ n+ let go i s0 =+ if i<n+ then+ case f s0 of+ Nothing -> return v+ Just (a,s1) ->+-- SVSTS.write v i a >> go (succ i) s1+ SVSTS.unsafeWrite v i a >> go (succ i) s1+ else return v+ go 0 s)++{-# INLINE runLoopSTLazy #-}+runLoopSTLazy ::+ (Storable a) =>+ Int -> (s -> Maybe (a, s)) -> s -> SV.Vector a+runLoopSTLazy n f s =+ SVSTL.runSTVector+ (do v <- SVSTL.new_ n+ let go s0 i =+ if i<n+ then+ case f s0 of+ Nothing -> return v+ Just (a,s1) ->+ {-+ Strict pattern matching on () is necessary+ in order to avoid a memory leak.+ Working in ST.Lazy is still+ three times slower than ST.Strict+ -}+ strictToLazyST (SVSTS.unsafeWrite v i a >> return (succ i))+ >>= go s1+-- SVSTL.unsafeWrite v i a >>= \() -> go s1 (succ i)+-- SVSTL.unsafeWrite v i a >> go s1 (succ i)+ else return v+ go s 0)+++{-# INLINE mixST #-}+mixST :: (Storable a, Num a) =>+ SVSTS.Vector s a -> (st -> Maybe (a, st)) -> st -> StrictST.ST s Int+mixST v f s =+ let go i s0 =+ if i < SVSTS.length v+ then+ case f s0 of+ Nothing -> return i+ Just (a,s1) ->+ SVSTS.unsafeWrite v i a >> go (succ i) s1+ else return i+ in go 0 s++{-# INLINE mixSTGuard #-}+mixSTGuard :: (Storable a, Num a) =>+ SVSTS.Vector s a -> (st -> Maybe (a, st)) -> st -> StrictST.ST s Int+mixSTGuard v f s =+ let go i s0 =+ case guard (i < SVSTS.length v) >> f s0 of+ Nothing -> return i+ Just (a,s1) ->+ SVSTS.unsafeWrite v i a >> go (succ i) s1+ in go 0 s++++{-# INLINE runBuilder #-}+runBuilder ::+ (Storable a) =>+ SVL.ChunkSize -> (s -> Maybe (a, s)) -> s -> SVL.Vector a+runBuilder chunkSize f s =+ Builder.toLazyStorableVector chunkSize+ (let go s0 =+ case f s0 of+ Nothing -> mempty+ Just (a,s1) ->+ mappend (Builder.put a) (go s1)+ in go s)+++infixl 6 `mix`, `mixGen`, `mixVec`++{- |+Build a generator from two other generators+by handling their state in parallel and mix their results.+-}+{-# INLINE mix #-}+mix ::+ (Num y) =>+ (s -> Maybe (y, s)) ->+ (t -> Maybe (y, t)) ->+ ((s,t) -> Maybe (y, (s,t)))+mix f g (s0,t0) =+ do (a,s1) <- f s0+ (b,t1) <- g t0+ return ((a+b), (s1,t1))+++{- |+This is like a list without storage.+It is like stream-fusion:Data.Stream+but without Skip constructor.+-}+data Generator a =+ forall s.+ Generator (s -> Maybe (a, s)) s++{-# INLINE runGeneratorMonolithic #-}+runGeneratorMonolithic :: Storable a => Int -> Generator a -> SV.Vector a+runGeneratorMonolithic size (Generator f s) =+ fst $ SV.unfoldrN size f s++{- SPECIALISE INLINE generator0Gen :: Float -> Float -> Generator Float -}+{-# INLINE generator0Gen #-}+generator0Gen ::+ Fraction a => a -> a -> Generator a+generator0Gen freq phase =+ Generator (\p -> Just (saw p, fraction (p+freq))) phase++{- SPECIALISE INLINE mixGen :: Generator Float -> Generator Float -> Generator Float -}+{-# INLINE mixGen #-}+mixGen ::+ (Num y) =>+ Generator y ->+ Generator y ->+ Generator y+mixGen (Generator f s) (Generator g t) =+ Generator (\(s0,t0) ->+ do (a,s1) <- f s0+ (b,t1) <- g t0+ return ((a+b), (s1,t1))) (s,t)++++{-# INLINE incPhase #-}+incPhase :: Phase -> Phase -> Phase+incPhase (d0,d1,d2) (p0,p1,p2) =+ (fraction (p0+d0), fraction (p1+d1), fraction (p2+d2))++{-# INLINE generator1 #-}+generator1 ::+ Phase -> Maybe (Float, Phase)+generator1 =+ \p -> Just (sawChorus p, incPhase dl p)+++{-# SPECIALISE mixVec :: SVL.Vector Float -> SVL.Vector Float -> SVL.Vector Float #-}+{- disabled INLINE mixVec -}+mixVec ::+ (Num y, Storable y) =>+ SVL.Vector y ->+ SVL.Vector y ->+ SVL.Vector y+mixVec xs0 ys0 =+ let recourse xt@(x:_) yt@(y:_) =+ let z = SV.zipWith (+) x y+ n = SV.length z+ in z : recourse+ (SVL.chunks $ SVL.drop n $ SVL.fromChunks xt)+ (SVL.chunks $ SVL.drop n $ SVL.fromChunks yt)+ recourse xs [] = xs+ recourse [] ys = ys+ in SVL.fromChunks $+ recourse (SVL.chunks xs0) (SVL.chunks ys0)+++{-# INLINE generator2 #-}+generator2 ::+ (Phase, Phase) -> Maybe (Stereo.T Float, (Phase, Phase))+generator2 =+ \(pl, pr) ->+ Just (Stereo.cons (sawChorus pl) (sawChorus pr),+ (incPhase dl pl, incPhase dr pr))++{-# INLINE dl #-}+{-# INLINE dr #-}+dl, dr :: Phase+(dl,dr) =+ ((0.01008, 0.01003, 0.00990),+ (0.00992, 0.00997, 0.01010))++{-# INLINE initPhase2 #-}+initPhase2 :: (Phase, Phase)+initPhase2 =+ ((0,0.7,0.1), (0.3,0.4,0.6))+++size :: Int+size = 10000000++mainMonolithic0 :: IO ()+mainMonolithic0 =+ SV.writeFile "speed.f32"+ (fst $ SV.unfoldrN size generator0 0)+{-+real 0m0.423s+user 0m0.256s+sys 0m0.152s+-}++mainMonolithic0Generator :: IO ()+mainMonolithic0Generator =+ SV.writeFile "speed.f32"+ (runGeneratorMonolithic size+ (generator0Gen (0.01::Float) 0))++mainMonolithic0STStrict :: IO ()+mainMonolithic0STStrict =+ SV.writeFile "speed.f32"+ (runLoopSTStrict size (generator0Freq (0.01::Float)) 0)+{-+real 0m0.430s+user 0m0.288s+sys 0m0.132s+-}++mainMonolithic0STLazy :: IO ()+mainMonolithic0STLazy =+ SV.writeFile "speed.f32"+ (runLoopSTLazy size (generator0Freq (0.01::Float)) 0)+{-+real 0m0.886s+user 0m0.752s+sys 0m0.128s+-}++mainMonolithic0STMix :: IO ()+mainMonolithic0STMix =+ SV.writeFile "speed.f32" $+ StrictST.runST+ (do v <- SVSTS.new size 0+ l <- mixSTGuard v (generator0Freq (0.01::Float)) 0+ fmap (SV.take l) (SVSTS.unsafeFreeze v))+{-+real 0m0.505s+user 0m0.344s+sys 0m0.156s+-}++mainMonolithic1 :: IO ()+mainMonolithic1 =+ SV.writeFile "speed.f32"+ (fst $ SV.unfoldrN size generator1 (fst initPhase2))++mainMonolithic1Composed :: IO ()+mainMonolithic1Composed =+ SV.writeFile "speed.f32"+ (fst $ SV.unfoldrN size+ (let (f0,f1,f2) = dl+ in generator0Freq f0 `mix`+ generator0Freq f1 `mix`+ generator0Freq f2)+ (let (p0,p1,p2) = fst initPhase2+ in ((p0,p1),p2)))+{-+real 0m0.974s+user 0m0.812s+sys 0m0.160s+-}++mainMonolithic1Generator :: IO ()+mainMonolithic1Generator =+ SV.writeFile "speed.f32"+ (runGeneratorMonolithic size+ (let (f0,f1,f2) = dl+ (p0,p1,p2) = fst initPhase2+ in generator0Gen f0 p0 `mixGen`+ generator0Gen f1 p1 `mixGen`+ generator0Gen f2 p2))+{-+real 0m2.244s+user 0m2.084s+sys 0m0.152s+-}++mainMonolithic1GeneratorFold :: IO ()+mainMonolithic1GeneratorFold =+ SV.writeFile "speed.f32"+ (runGeneratorMonolithic size+ (let (f0,f1,f2) = dl+ (p0,p1,p2) = fst initPhase2+ in foldl1 mixGen $+ map (uncurry generator0Gen) $+ [(f0,p0), (f1,p1), (f2,p2)]))+{-+real 0m3.006s+user 0m2.816s+sys 0m0.180s+-}++mainMonolithic1STMix :: IO ()+mainMonolithic1STMix =+ SV.writeFile "speed.f32" $+ StrictST.runST+ (do v <- SVSTS.new size 0+ let (f0,f1,f2) = dl+ (p0,p1,p2) = fst initPhase2+ l0 <- mixSTGuard v (generator0Freq f0) p0+ l1 <- mixSTGuard v (generator0Freq f1) p1+ l2 <- mixSTGuard v (generator0Freq f2) p2+ fmap (SV.take (l0 `min` l1 `min` l2)) (SVSTS.unsafeFreeze v))+{-+real 0m1.895s+user 0m1.684s+sys 0m0.180s+-}++mainMonolithic1STMixZip :: IO ()+mainMonolithic1STMixZip =+ SV.writeFile "speed.f32" $+ StrictST.runST+ (do v <- SVSTS.new size 0+ let (f0,f1,f2) = dl+ (p0,p1,p2) = fst initPhase2+ ls <- zipWithM (mixSTGuard v . generator0Freq)+ [f0,f1,f2] [p0,p1,p2]+ fmap (SV.take (minimum ls)) (SVSTS.unsafeFreeze v))+{-+real 0m1.391s+user 0m1.232s+sys 0m0.160s+-}++mainMonolithic2 :: IO ()+mainMonolithic2 =+ SV.writeFile "speed.f32"+ (fst $ SV.unfoldrN size generator2 initPhase2)++mainMonolithicStrict2 :: IO ()+mainMonolithicStrict2 =+ SV.writeFile "speed.f32"+ (fst $ SVP.unfoldrStrictN size generator2 initPhase2)++mainMonolithicTransition2 :: IO ()+mainMonolithicTransition2 =+ SV.writeFile "speed.f32"+ (fst $ SVP.unfoldrTransitionN size+ (\(pl,pr) -> (incPhase dl pl, incPhase dr pr))+ (\(pl,pr) ->+ Just (Stereo.cons (sawChorus pl) (sawChorus pr)))+ initPhase2)+++mainChunky0 :: IO ()+mainChunky0 =+ SVL.writeFile "speed.f32"+ (SVL.take size $+ SVL.unfoldr SVL.defaultChunkSize generator0 0)+{-+real 0m0.428s+user 0m0.292s+sys 0m0.132s+-}++mainChunky0Builder :: IO ()+mainChunky0Builder =+ SVL.writeFile "speed.f32"+ (SVL.take size $+ runBuilder SVL.defaultChunkSize generator0 0)+{-+real 0m1.107s+user 0m0.968s+sys 0m0.140s+-}++mainChunky1 :: IO ()+mainChunky1 =+ SVL.writeFile "speed.f32"+ (SVL.take size $+ SVL.unfoldr SVL.defaultChunkSize generator1 (fst initPhase2))+{-+real 0m0.938s+user 0m0.812s+sys 0m0.116s+-}++mainChunky1MixFlat :: IO ()+mainChunky1MixFlat =+ SVL.writeFile "speed.f32"+ (let (f0,f1,f2) = dl+ (p0,p1,p2) = fst initPhase2+ in SVL.take size $+ tone0 f0 p0 `mixVec`+ tone0 f1 p1 `mixVec`+ tone0 f2 p2)+{-+real 0m3.932s+user 0m2.112s+sys 0m0.156s+-}++mainChunky1MixFold :: IO ()+mainChunky1MixFold =+ SVL.writeFile "speed.f32"+ (let (f0,f1,f2) = dl+ (p0,p1,p2) = fst initPhase2+ in SVL.take size $+ foldl1 mixVec $+ map (uncurry tone0) $+ [(f0,p0), (f1,p1), (f2,p2)])+{-+real 0m1.611s+user 0m1.476s+sys 0m0.108s+-}++mainChunky2 :: IO ()+mainChunky2 =+ SVL.writeFile "speed.f32"+ (SVL.take size $+ SVL.unfoldr SVL.defaultChunkSize generator2 initPhase2)+{-+real 0m2.220s+user 0m1.400s+sys 0m0.192s+-}++main :: IO ()+main =+ mainMonolithic1STMixZip+-- mainMonolithic1GeneratorFold
− speedtest/SpeedTestLazy.hs
@@ -1,17 +0,0 @@-{-# OPTIONS_GHC -O -ddump-simpl-stats #-}-{- -dverbose-core2core -}-module Main (main) where--import qualified Data.StorableVector.Lazy as SV--import Data.Int (Int16)----main :: IO ()-main =- SV.writeFile "speed-lazy.sw"- (SV.take 10000000 $- SV.unfoldr (SV.ChunkSize 10000)- (\x -> let y = mod (succ x) 10000- in Just (x,y)) (0::Int16))
storablevector.cabal view
@@ -1,5 +1,5 @@ Name: storablevector-Version: 0.2.4+Version: 0.2.5 Category: Data Synopsis: Fast, packed, strict storable arrays with a list interface like ByteString Description:@@ -16,7 +16,7 @@ We do not provide advanced fusion optimization, since especially for lazy vectors this would either be incorrect or not applicable.- For fusion see @storablevector-streamfusion@ package.+ For fusion see <http://hackage.haskell.org/cgi-bin/hackage-scripts/package/storablevector-streamfusion>. License: BSD3 License-file: LICENSE Author: Spencer Janssen <sjanssen@cse.unl.edu>, Henning Thielemann <storablevector@henning-thielemann.de>@@ -24,8 +24,12 @@ Homepage: http://www.haskell.org/haskellwiki/Storable_Vector Stability: Experimental Build-Type: Simple-Tested-With: GHC==6.8.2+Tested-With: GHC==6.8.2, JHC==0.7.3 Cabal-Version: >=1.6+Extra-Source-Files:+ foreign-ptr/fast/Data/StorableVector/Memory.hs+ foreign-ptr/slow/Data/StorableVector/Memory.hs+ foreign-ptr/jhc/Data/StorableVector/Memory.hs Flag splitBase description: Choose the new smaller, split-up base package.@@ -33,6 +37,9 @@ Flag separateSYB description: Data.Generics available in separate package. +Flag functorInstance+ description: Use a custom Functor instance for pairs and functions+ Flag buildTests description: Build test executables default: False@@ -44,31 +51,40 @@ Source-Repository this type: darcs location: http://code.haskell.org/storablevector/- tag: 0.2.4+ tag: 0.2.5 Library Build-Depends: non-negative >= 0.0.4 && <0.1, utility-ht >= 0.0.5 && <0.1, transformers >=0.0 && <0.2- If flag(splitBase)- If flag(separateSYB)- Build-Depends:- base >=4 && <5,- syb >=0.1 && <0.2- Else- Build-Depends:- base >=3 && <4++ If impl(jhc)+ Hs-Source-Dirs: foreign-ptr/jhc+ Build-Depends:+ statethread >=0.1 && <0.2,+ base >=1 && <2 Else- Build-Depends: base >=1 && <2+ Hs-Source-Dirs: foreign-ptr/slow+ If flag(splitBase)+ If flag(separateSYB)+ Build-Depends:+ base >=4 && <5,+ syb >=0.1 && <0.2+ Else+ Build-Depends:+ base >=3 && <4+ Else+ Build-Depends: base >=1 && <2 Extensions: CPP, ForeignFunctionInterface GHC-Options: -Wall -funbox-strict-fields- Hs-Source-Dirs: ., slow-foreign-ptr+ Hs-Source-Dirs: . Exposed-Modules: Data.StorableVector Data.StorableVector.Base+ Data.StorableVector.Pointer Data.StorableVector.Lazy Data.StorableVector.Lazy.Builder Data.StorableVector.Lazy.Pattern@@ -76,51 +92,71 @@ Data.StorableVector.ST.Strict Data.StorableVector.ST.Lazy + If !impl(jhc)+ Other-Modules:+ -- Cursor has no mature interface so far+ Data.StorableVector.Cursor+ Other-Modules:- -- Cursor has no mature interface so far- Data.StorableVector.Cursor Data.StorableVector.Memory Data.StorableVector.ST.Private Data.StorableVector.Lazy.PointerPrivate+ Data.StorableVector.Lazy.PointerPrivateIndex Executable test GHC-Options: -Wall -funbox-strict-fields- Hs-Source-Dirs: ., slow-foreign-ptr, tests+ Hs-Source-Dirs: ., foreign-ptr/slow, tests Main-Is: tests.hs Other-Modules: QuickCheckUtils, Instances- Build-Depends: bytestring >= 0.9 && < 0.10, QuickCheck >= 1 && < 2 Extensions: CPP, ForeignFunctionInterface- If flag(splitBase)- Hs-Source-Dirs: tests-2- Build-Depends: base >= 3 && <5, random >= 1.0 && < 1.1+ If flag(buildTests)+ Build-Depends:+ bytestring >= 0.9 && < 0.10,+ QuickCheck >= 1 && < 2+ If flag(splitBase)+ Build-Depends: random >= 1.0 && < 1.1+ If flag(functorInstance)+ Hs-Source-Dirs: tests-2+ Build-Depends: base >= 3 && <4+ Else+ Hs-Source-Dirs: tests-1+ Build-Depends: base >= 4 && <5+ Else+ Hs-Source-Dirs: tests-1+ Build-Depends: base >= 1.0 && < 2 Else- Hs-Source-Dirs: tests-1- Build-Depends: base >= 1.0 && < 2- if !flag(buildTests)- buildable: False+ Buildable: False Executable speedtest- GHC-Options: -Wall -funbox-strict-fields- Main-Is: SpeedTestLazy.hs+ GHC-Options: -Wall+ -- -fvia-C -optc-ffast-math -optc-O3 -optc-ftree-vectorize+ Main-Is: SpeedTestChorus.hs+ Other-Modules:+ Data.StorableVector.Private Extensions: CPP, ForeignFunctionInterface- Hs-Source-Dirs: ., slow-foreign-ptr, speedtest- If flag(splitBase)- Build-Depends: base >= 3 && <5+ Hs-Source-Dirs: ., foreign-ptr/slow, speedtest+ If flag(buildTests)+ Build-Depends:+ sample-frame >=0.0.1 && <0.1,+ deepseq >=1.1 && <1.2+ If flag(splitBase)+ Build-Depends: base >= 3 && <5+ Else+ Build-Depends: base >= 1.0 && < 2 Else- Build-Depends: base >= 1.0 && < 2- If !flag(buildTests) Buildable: False Executable speedpointer- GHC-Options: -Wall -funbox-strict-fields+ GHC-Options: -Wall Main-Is: Pointer.hs Extensions: CPP, ForeignFunctionInterface- Hs-Source-Dirs: ., slow-foreign-ptr, speedtest- If flag(splitBase)- Build-Depends: base >= 3 && <5+ Hs-Source-Dirs: ., foreign-ptr/slow, speedtest+ If flag(buildTests)+ If flag(splitBase)+ Build-Depends: base >= 3 && <5+ Else+ Build-Depends: base >= 1.0 && < 2 Else- Build-Depends: base >= 1.0 && < 2- If !flag(buildTests) Buildable: False
tests/QuickCheckUtils.hs view
@@ -223,6 +223,3 @@ class IsNull t where isNull :: t -> Bool instance IsNull P.ByteString where isNull = P.null instance IsNull V where isNull = V.null--instance Show V where- show = show . V.unpack
tests/tests.hs view
@@ -34,6 +34,7 @@ prop_isPrefixOfVP = (V.isPrefixOf :: V -> V -> Bool) `eq2` P.isPrefixOf prop_mapVP = (V.map :: (W -> W) -> V -> V) `eq2` P.map prop_replicateVP = (V.replicate :: X -> W -> V) `eq2` P.replicate+prop_iterateVP = (V.iterateN :: X -> (W -> W) -> W -> V) `eq3` (\n f -> P.pack . take n . iterate f) prop_snocVP = (V.snoc :: V -> W -> V) `eq2` P.snoc prop_spanVP = (V.span :: (W -> Bool) -> V -> (V, V)) `eq2` P.span prop_splitVP = (V.split :: W -> V -> [V]) `eq2` P.split@@ -127,6 +128,7 @@ ,("scanr", mytest prop_scanrVP) ,("transpose", mytest prop_transposeVP) ,("replicate", mytest prop_replicateVP)+ ,("iterateN", mytest prop_iterateVP) ,("take", mytest prop_takeVP) ,("drop", mytest prop_dropVP) ,("splitAt", mytest prop_splitAtVP)