storablevector 0.2.5 → 0.2.6
raw patch · 7 files changed
+533/−58 lines, 7 filesdep ~QuickCheckdep ~transformers
Dependency ranges changed: QuickCheck, transformers
Files
- Data/StorableVector.hs +93/−11
- Data/StorableVector/Lazy.hs +8/−0
- Data/StorableVector/Lazy/Pattern.hs +32/−6
- Data/StorableVector/ST/Strict.hs +59/−0
- speedtest/SpeedTestChorus.hs +330/−31
- storablevector.cabal +5/−4
- tests/QuickCheckUtils.hs +6/−6
Data/StorableVector.hs view
@@ -7,7 +7,7 @@ -- (c) Don Stewart 2005-2006 -- (c) Bjorn Bringert 2006 -- (c) Spencer Janssen 2006--- (c) Henning Thielemann 2008-2009+-- (c) Henning Thielemann 2008-2010 -- -- -- License : BSD-style@@ -184,7 +184,8 @@ ,scanl,scanl1,scanr,scanr1 ,readFile,writeFile,appendFile,replicate ,getContents,getLine,putStr,putStrLn- ,zip,zipWith,zipWith3,unzip,notElem)+ ,zip,zipWith,zipWith3,unzip,notElem+ ,pred,succ) import Data.StorableVector.Base @@ -210,7 +211,7 @@ hGetBuf, hPutBuf, Handle, IOMode(..), ) -import System.IO.Unsafe (unsafePerformIO, )+import System.IO.Unsafe (unsafePerformIO, {- unsafeInterleaveIO, -} ) -- import GHC.IOBase -- -----------------------------------------------------------------------------@@ -484,6 +485,12 @@ -- | 'foldr', applied to a binary operator, a starting value -- (typically the right-identity of the operator), and a 'Vector', -- reduces the 'Vector' using the binary operator, from right to left.+-- However, it is not the same as 'foldl' applied to the reversed vector.+-- Actually 'foldr' starts processing with the first element,+-- and thus can be used for efficiently building a singly linked list+-- by @foldr (:) [] vec@.+-- Unfortunately 'foldr' is quite slow for low-level loops,+-- since GHC (up to 6.12.1) cannot detect the loop. foldr :: (Storable a) => (a -> b -> b) -> b -> Vector a -> b foldr = foldrByLoop {-# INLINE foldr #-}@@ -492,6 +499,9 @@ *Data.StorableVector> List.length $ foldrBySwitch (:) [] $ replicate 1000000 'a' 1000000 (11.29 secs, 1183476300 bytes)+*Data.StorableVector> List.length $ foldrByIO (:) [] $ replicate 1000000 'a'+1000000+(7.86 secs, 1033901140 bytes) *Data.StorableVector> List.length $ foldrByIndex (:) [] $ replicate 1000000 'a' 1000000 (7.86 secs, 914340420 bytes)@@ -506,6 +516,9 @@ and increment that instead, because we need to keep the reference to ForeignPtr, otherwise memory might be freed.+We can also not perform loop entirely in strict IO,+since this eat up the stack quickly+and 'foldr' might be used to build a list lazily. -} foldrByLoop :: (Storable a) => (a -> b -> b) -> b -> Vector a -> b foldrByLoop f z (SV fp s l) =@@ -518,6 +531,17 @@ {-# INLINE foldrByLoop #-} {-+foldrByIO :: (Storable a) => (a -> b -> b) -> b -> Vector a -> b+foldrByIO f z v@(SV fp _ _) =+ unsafeWithStartPtr v $+ let go = Strict.arguments2 $ \p l ->+ unsafeInterleaveIO $+ if l>0+ then liftM2 f (peek p) (go (incPtr p) (pred l))+ else touchForeignPtr fp >> return z+ in go+{-# INLINE foldrByIO #-}+ foldrByIndex :: (Storable a) => (a -> b -> b) -> b -> Vector a -> b foldrByIndex k z xs = let recourse n =@@ -755,11 +779,58 @@ -- | /O(n)/ 'replicate' @n x@ is a 'Vector' of length @n@ with @x@ -- the value of every element. --+{- nice implementation replicate :: (Storable a) => Int -> a -> Vector a replicate n c = fst $ unfoldrN n (const $ Just (c, ())) ()+-}++-- fast implementation+replicate :: (Storable a) => Int -> a -> Vector a+replicate n c =+ if n <= 0+ then empty+ else unsafeCreate n $+ let go = Strict.arguments2 $ \i p ->+ if i == 0+ then return ()+ else poke p c >> go (pred i) (incPtr p)+ in go n {-# INLINE replicate #-}+{-+For 'replicate 10000000 (42::Int)' generates: +Main_zdwa_info:+ movl (%ebp),%eax+ testl %eax,%eax+ jne .LcfIQ+ movl $ghczmprim_GHCziUnit_Z0T_closure+1,%esi+ addl $8,%ebp+ jmp *(%ebp)+.LcfIQ:+ movl 4(%ebp),%ecx+ movl $42,(%ecx)+ decl %eax+ addl $4,4(%ebp)+ movl %eax,(%ebp)+ jmp Main_zdwa_info++that is, the inner loop consists of 9 instructions,+where I would write something like:+ # counter in %ecx+ testl %ecx+ jz skip_loop+ movl $42,%ebx+start_loop:+ movl %ebx,(%edx)+ addl $4,%edx+ loop start_loop+skip_loop:++and need only 3 instructions in the loop.+-}++ -- | /O(n)/ 'iterateN' @n f x@ is a 'Vector' of length @n@ -- where the elements of @x@ are generated by repeated application of @f@. --@@ -797,23 +868,23 @@ -- > fst (unfoldrN n f s) == take n (unfoldr f s) -- unfoldrN :: (Storable b) => Int -> (a -> Maybe (b, a)) -> a -> (Vector b, Maybe a)-unfoldrN i f x0 =- if i <= 0+unfoldrN n f x0 =+ if n <= 0 then (empty, Just x0)- else unsafePerformIO $ createAndTrim' i $ \p -> go p 0 x0+ else unsafePerformIO $ createAndTrim' n $ \p -> go p n 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, Just x)+ go = Strict.arguments2 $ \p i -> \x ->+ if i == 0+ then return (0, n-i, Just x) else case f x of- Nothing -> return (0, n, Nothing)+ Nothing -> return (0, n-i, Nothing) Just (w,x') -> do poke p w- go (incPtr p) (n+1) x'+ go (incPtr p) (i-1) x' {-# INLINE unfoldrN #-} {-@@ -1372,6 +1443,17 @@ -- --------------------------------------------------------------------- -- Internal utilities+++-- These definitions of succ and pred do not check for overflow+-- and are faster than their counterparts from Enum class.+succ :: Int -> Int+succ n = n+1+{-# INLINE succ #-}++pred :: Int -> Int+pred n = n-1+{-# INLINE pred #-} unsafeWithStartPtr :: Storable a => Vector a -> (Ptr a -> Int -> IO b) -> b unsafeWithStartPtr v f =
Data/StorableVector/Lazy.hs view
@@ -36,7 +36,9 @@ import qualified System.IO.Error as Exc import System.IO.Unsafe (unsafeInterleaveIO) +import Test.QuickCheck (Arbitrary(..)) + import Prelude hiding (length, (++), concat, iterate, foldl, map, repeat, replicate, null, zip, zipWith, zipWith3, drop, take, splitAt, takeWhile, dropWhile, reverse)@@ -73,10 +75,16 @@ (showString "VectorLazy.fromChunks " . showsPrec 10 (chunks xs)) +instance (Storable a, Arbitrary a) => Arbitrary (Vector a) where+ arbitrary = liftM2 pack arbitrary arbitrary + -- for a list of chunk sizes see "Data.StorableVector.LazySize". newtype ChunkSize = ChunkSize Int deriving (Eq, Ord, Show)++instance Arbitrary ChunkSize where+ arbitrary = fmap (ChunkSize . max 1) arbitrary instance Num ChunkSize where (ChunkSize x) + (ChunkSize y) =
Data/StorableVector/Lazy/Pattern.hs view
@@ -63,6 +63,8 @@ take, drop, splitAt,+ takeVectorPattern,+ splitAtVectorPattern, dropMarginRem, dropMargin, dropWhile,@@ -103,7 +105,7 @@ import qualified Data.List as List import qualified Data.List.HT as ListHT-import Data.Tuple.HT (mapPair, mapFst, forcePair, )+import Data.Tuple.HT (mapPair, mapFst, forcePair, swap, ) import Control.Monad (liftM2, liftM3, liftM4, guard, ) @@ -237,10 +239,21 @@ -- * sub-vectors +{- |+Generates laziness breaks+wherever either the lazy length number or the vector has a chunk boundary.+-} {-# INLINE take #-} take :: (Storable a) => LazySize -> Vector a -> Vector a-take _ (SV []) = empty-take n (SV (x:xs)) =+take n = fst . splitAt n++{- |+Preserves the chunk pattern of the lazy vector.+-}+{-# INLINE takeVectorPattern #-}+takeVectorPattern :: (Storable a) => LazySize -> Vector a -> Vector a+takeVectorPattern _ (SV []) = empty+takeVectorPattern n (SV (x:xs)) = if List.null (LS.toChunks n) then empty else@@ -257,8 +270,20 @@ List.foldl (flip (LSV.drop . intFromChunkSize)) xs (LS.toChunks size) {-# INLINE splitAt #-}-splitAt :: (Storable a) => LazySize -> Vector a -> (Vector a, Vector a)-splitAt n0 =+splitAt ::+ (Storable a) => LazySize -> Vector a -> (Vector a, Vector a)+splitAt size xs =+ mapFst LSV.concat $ swap $+ List.mapAccumL+ (\xs0 n ->+ swap $ LSV.splitAt (intFromChunkSize n) xs0)+ xs (LS.toChunks size)++{-# INLINE splitAtVectorPattern #-}+splitAtVectorPattern ::+ (Storable a) => LazySize -> Vector a -> (Vector a, Vector a)+splitAtVectorPattern n0 =+ forcePair . if List.null (LS.toChunks n0) then (,) empty else@@ -269,7 +294,8 @@ (x:xs) -> let remain = decrementLimit x n in if LS.isNull remain- then mapPair ((:[]), (:xs)) $ V.splitAt (intFromLazySize n) x+ then mapPair ((:[]), (:xs)) $+ V.splitAt (intFromLazySize n) x else mapFst (x:) $ recourse remain xs in mapPair (SV, SV) . recourse n0 . LSV.chunks
Data/StorableVector/ST/Strict.hs view
@@ -16,6 +16,9 @@ read, write, modify,+ maybeRead,+ maybeWrite,+ maybeModify, unsafeRead, unsafeWrite, unsafeModify,@@ -43,6 +46,10 @@ import Foreign.Marshal.Array (advancePtr, copyArray, ) -- import System.IO.Unsafe (unsafePerformIO) +import qualified Data.Traversable as Traversable+import Data.Maybe.HT (toMaybe, )+import Data.Maybe (isJust, )+ -- import Prelude (Int, ($), (+), return, const, ) import Prelude hiding (read, length, ) @@ -103,6 +110,58 @@ then act else error ("StorableVector.ST." ++ name ++ ": index out of range") ++{- |+Returns @Just e@, when the element @e@ could be read+and 'Nothing' if the index was out of range.+This way you can avoid duplicate index checks+that may be needed when using 'read'.++> Control.Monad.ST.runST (do arr <- new_ 10; Monad.zipWithM_ (write arr) [9,8..0] ['a'..]; read arr 3)++In future 'maybeRead' will replace 'read'.+-}+{-# INLINE maybeRead #-}+maybeRead :: (Storable e) =>+ Vector s e -> Int -> ST s (Maybe e)+maybeRead v n =+ maybeAccess v n $ unsafeRead v n++{- |+Returns 'True' if the element could be written+and 'False' if the index was out of range.++> runSTVector (do arr <- new_ 10; foldr (\c go i -> maybeWrite arr i c >>= \cont -> if cont then go (succ i) else return arr) (error "unreachable") ['a'..] 0)++In future 'maybeWrite' will replace 'write'.+-}+{-# INLINE maybeWrite #-}+maybeWrite :: (Storable e) =>+ Vector s e -> Int -> e -> ST s Bool+maybeWrite v n x =+ fmap isJust $ maybeAccess v n $ unsafeWrite v n x++{- |+Similar to 'maybeWrite'.++In future 'maybeModify' will replace 'modify'.+-}+{-# INLINE maybeModify #-}+maybeModify :: (Storable e) =>+ Vector s e -> Int -> (e -> e) -> ST s Bool+maybeModify v n f =+ fmap isJust $ maybeAccess v n $ unsafeModify v n f++{-# INLINE maybeAccess #-}+maybeAccess :: (Storable e) =>+ Vector s e -> Int -> ST s a -> ST s (Maybe a)+maybeAccess (SV _v l) n act =+ Traversable.sequence $ toMaybe (0<=n && n<l) act+{-+ if 0<=n && n<l+ then fmap Just act+ else return Nothing+-} {-# INLINE unsafeRead #-} unsafeRead :: (Storable e) =>
speedtest/SpeedTestChorus.hs view
@@ -1,6 +1,8 @@-{-# OPTIONS_GHC -funbox-strict-fields -ddump-simpl -O #-}+{-# OPTIONS_GHC -funbox-strict-fields -ddump-simpl -ddump-asm -O #-} {-# LANGUAGE ExistentialQuantification #-} {- -dverbose-core2core -ddump-simpl-stats -}+-- I use the dump options only in the main module and not in Cabal+-- in order to get only code for the main module and not all modules {- This module demonstrates the following: mainMonolithic1Generator performs the same computation as mainMonolithic1Compose@@ -18,7 +20,7 @@ > ghc -package storablevector-0.2.5 -O speedtest/SpeedTestChorus.hs -Exporting only main causes warnings about unused functions,+Exporting only 'main' causes warnings about unused functions, but it also reduces the core output to a third. -} module Main (main) where@@ -28,7 +30,7 @@ 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 Data.StorableVector.Private as SVP import qualified Control.Monad.ST.Strict as StrictST import Control.Monad.ST.Lazy (ST, runST, strictToLazyST, )@@ -45,6 +47,7 @@ {-+GHC-6.10.4: 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.@@ -124,6 +127,30 @@ SVL.unfoldr SVL.defaultChunkSize (generator0Freq freq) phase +{-+Here we let storablevector functions check+whether we reached the end of the vector.+However, 'SVSTS.maybeWrite' also checks+whether the index is non-negative,+which is unnecessary in our case.+-}+{-# INLINE runLoopSTStrictSafe #-}+runLoopSTStrictSafe ::+ (Storable a) =>+ Int -> (s -> Maybe (a, s)) -> s -> SV.Vector a+runLoopSTStrictSafe n f s =+ SVSTS.runSTVector+ (do v <- SVSTS.new_ n+ let go i s0 =+ case f s0 of+ Nothing -> return v+ Just (a,s1) ->+ SVSTS.maybeWrite v i a >>= \cont ->+ if cont+ then go (succ i) s1+ else return v+ go 0 s)+ {-# INLINE runLoopSTStrict #-} runLoopSTStrict :: (Storable a) =>@@ -132,14 +159,10 @@ 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+ case guard (i<n) >> f s0 of+ Nothing -> return v+ Just (a,s1) ->+ SVSTS.unsafeWrite v i a >> go (succ i) s1 go 0 s) {-# INLINE runLoopSTLazy #-}@@ -150,22 +173,19 @@ 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+ case guard (i<n) >> f s0 of+ Nothing -> return v+ Just (a,s1) ->+ strictToLazyST (SVSTS.unsafeWrite v i a >> return (succ i))+ >>= go 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+ -}+-- SVSTL.unsafeWrite v i a >>= \() -> go s1 (succ i)+-- SVSTL.unsafeWrite v i a >> go s1 (succ i) go s 0) @@ -179,7 +199,7 @@ case f s0 of Nothing -> return i Just (a,s1) ->- SVSTS.unsafeWrite v i a >> go (succ i) s1+ SVSTS.unsafeModify v i (a+) >> go (succ i) s1 else return i in go 0 s @@ -191,11 +211,42 @@ case guard (i < SVSTS.length v) >> f s0 of Nothing -> return i Just (a,s1) ->- SVSTS.unsafeWrite v i a >> go (succ i) s1+ SVSTS.unsafeModify v i (a+) >> go (succ i) s1 in go 0 s +{-+It seems that mixSTVectorFoldr is essentially slower than mixSTVectorIndex.+The former one should be faster,+since 'foldr' uses direct pointer into the source vector.+-}+{-# INLINE mixSTVectorIndex #-}+mixSTVectorIndex :: (Storable a, Num a) =>+ SVSTS.Vector s a -> SV.Vector a -> StrictST.ST s Int+mixSTVectorIndex dst src =+ let end = min (SVSTS.length dst) (SV.length src)+ go i =+ if i >= end+ then return i+ else+ SVSTS.unsafeModify dst i (SV.index src i +) >>+ go (succ i)+ in go 0 +{-# INLINE mixSTVectorFoldr #-}+mixSTVectorFoldr :: (Storable a, Num a) =>+ SVSTS.Vector s a -> SV.Vector a -> StrictST.ST s Int+mixSTVectorFoldr dst src =+ SV.foldr+ (\x go i ->+ if i >= SVSTS.length dst+ then return i+ else+ SVSTS.unsafeModify dst i (x +) >>+ go (succ i))+ return src 0 ++ {-# INLINE runBuilder #-} runBuilder :: (Storable a) =>@@ -320,14 +371,53 @@ size :: Int size = 10000000 ++mainSumFoldl :: IO ()+mainSumFoldl =+ print $ SV.foldl (\s x -> s+x+13) 23 (SV.replicate size (42::Int))+{-+stack overflow+-}++mainSumFoldl' :: IO ()+mainSumFoldl' =+ print $ SV.foldl' (\s x -> s+x+13) 23 (SV.replicate size (42::Int))+{-+GHC-6.12.1:++real 0m0.171s+user 0m0.112s+sys 0m0.056s+-}++mainSumFoldr :: IO ()+mainSumFoldr =+ print $ SV.foldr (\x go s -> go $! s+x+13) id (SV.replicate size (42::Int)) $! 23+{-+GHC-6.12.1:++real 0m0.503s+user 0m0.464s+sys 0m0.036s+-}+ mainMonolithic0 :: IO () mainMonolithic0 = SV.writeFile "speed.f32" (fst $ SV.unfoldrN size generator0 0) {-+GHC-6.10.4:+ real 0m0.423s user 0m0.256s sys 0m0.152s+++GHC-6.12.1:++real 0m0.392s+user 0m0.252s+sys 0m0.140s -} mainMonolithic0Generator :: IO ()@@ -335,15 +425,31 @@ SV.writeFile "speed.f32" (runGeneratorMonolithic size (generator0Gen (0.01::Float) 0))+{-+GHC-6.12.1: +real 0m0.413s+user 0m0.240s+sys 0m0.172s+-}+ mainMonolithic0STStrict :: IO () mainMonolithic0STStrict = SV.writeFile "speed.f32" (runLoopSTStrict size (generator0Freq (0.01::Float)) 0) {-+GHC-6.10.4:+ real 0m0.430s user 0m0.288s sys 0m0.132s+++GHC-6.12.1:++real 0m0.447s+user 0m0.276s+sys 0m0.168s -} mainMonolithic0STLazy :: IO ()@@ -351,9 +457,17 @@ SV.writeFile "speed.f32" (runLoopSTLazy size (generator0Freq (0.01::Float)) 0) {-+GHC-6.10.4:+ real 0m0.886s user 0m0.752s sys 0m0.128s++GHC-6.12.1:++real 0m0.763s+user 0m0.620s+sys 0m0.144s -} mainMonolithic0STMix :: IO ()@@ -364,16 +478,32 @@ l <- mixSTGuard v (generator0Freq (0.01::Float)) 0 fmap (SV.take l) (SVSTS.unsafeFreeze v)) {-+GHC-6.10.4:+ real 0m0.505s user 0m0.344s sys 0m0.156s+++GHC-6.12.1:++real 0m0.475s+user 0m0.344s+sys 0m0.128s -} mainMonolithic1 :: IO () mainMonolithic1 = SV.writeFile "speed.f32" (fst $ SV.unfoldrN size generator1 (fst initPhase2))+{-+GHC-6.12.1: +real 0m0.973s+user 0m0.824s+sys 0m0.140s+-}+ mainMonolithic1Composed :: IO () mainMonolithic1Composed = SV.writeFile "speed.f32"@@ -385,9 +515,18 @@ (let (p0,p1,p2) = fst initPhase2 in ((p0,p1),p2))) {-+GHC-6.10.4:+ real 0m0.974s user 0m0.812s sys 0m0.160s+++GHC-6.12.1:++real 0m0.940s+user 0m0.800s+sys 0m0.132s -} mainMonolithic1Generator :: IO ()@@ -400,9 +539,18 @@ generator0Gen f1 p1 `mixGen` generator0Gen f2 p2)) {-+GHC-6.10.4:+ real 0m2.244s user 0m2.084s sys 0m0.152s+++GHC-6.12.1:++real 0m2.256s+user 0m2.084s+sys 0m0.172s -} mainMonolithic1GeneratorFold :: IO ()@@ -415,9 +563,18 @@ map (uncurry generator0Gen) $ [(f0,p0), (f1,p1), (f2,p2)])) {-+GHC-6.10.4:+ real 0m3.006s user 0m2.816s sys 0m0.180s+++GHC-6.12.1:++real 0m3.050s+user 0m2.884s+sys 0m0.160s -} mainMonolithic1STMix :: IO ()@@ -432,9 +589,18 @@ l2 <- mixSTGuard v (generator0Freq f2) p2 fmap (SV.take (l0 `min` l1 `min` l2)) (SVSTS.unsafeFreeze v)) {-+GHC-6.10.4:+ real 0m1.895s user 0m1.684s sys 0m0.180s+++GHC-6.12.1:++real 0m1.932s+user 0m1.764s+sys 0m0.168s -} mainMonolithic1STMixZip :: IO ()@@ -448,16 +614,95 @@ [f0,f1,f2] [p0,p1,p2] fmap (SV.take (minimum ls)) (SVSTS.unsafeFreeze v)) {-+GHC-6.10.4:+ real 0m1.391s user 0m1.232s sys 0m0.160s+++GHC-6.12.1:++real 0m1.560s+user 0m1.404s+sys 0m0.136s -} ++mainMonolithic1STMixVector :: IO ()+mainMonolithic1STMixVector =+ SV.writeFile "speed.f32" $+ StrictST.runST+ (do v <- SVSTS.new size 0+ let (f0,f1,f2) = dl+ (p0,p1,p2) = fst initPhase2+ osci f p = fst $ SV.unfoldrN size (generator0Freq f) p+ l0 <- mixSTVectorIndex v (osci f0 p0)+ l1 <- mixSTVectorIndex v (osci f1 p1)+ l2 <- mixSTVectorIndex v (osci f2 p2)+ fmap (SV.take (l0 `min` l1 `min` l2)) (SVSTS.unsafeFreeze v))+{-+GHC-6.12.1:++real 0m1.751s+user 0m1.544s+sys 0m0.208s+-}++mainMonolithic1STMixVectorZipFoldr :: IO ()+mainMonolithic1STMixVectorZipFoldr =+ SV.writeFile "speed.f32" $+ StrictST.runST+ (do v <- SVSTS.new size 0+ let (f0,f1,f2) = dl+ (p0,p1,p2) = fst initPhase2+ vs = zipWith+ (\f p -> fst $ SV.unfoldrN size (generator0Freq f) p)+ [f0,f1,f2] [p0,p1,p2]+ ls <- mapM (mixSTVectorFoldr v) vs+ fmap (SV.take (minimum ls)) (SVSTS.unsafeFreeze v))+{-+GHC-6.12.1:++real 0m3.046s+user 0m2.828s+sys 0m0.216s+-}++mainMonolithic1STMixVectorZipIndex :: IO ()+mainMonolithic1STMixVectorZipIndex =+ SV.writeFile "speed.f32" $+ StrictST.runST+ (do v <- SVSTS.new size 0+ let (f0,f1,f2) = dl+ (p0,p1,p2) = fst initPhase2+ vs = zipWith+ (\f p -> fst $ SV.unfoldrN size (generator0Freq f) p)+ [f0,f1,f2] [p0,p1,p2]+ ls <- mapM (mixSTVectorIndex v) vs+ fmap (SV.take (minimum ls)) (SVSTS.unsafeFreeze v))+{-+GHC-6.12.1:++real 0m1.782s+user 0m1.532s+sys 0m0.220s+-}++ mainMonolithic2 :: IO () mainMonolithic2 = SV.writeFile "speed.f32" (fst $ SV.unfoldrN size generator2 initPhase2)+{-+GHC-6.12.1: +real 0m1.852s+user 0m1.588s+sys 0m0.252s+-}++{- mainMonolithicStrict2 :: IO () mainMonolithicStrict2 = SV.writeFile "speed.f32"@@ -471,6 +716,7 @@ (\(pl,pr) -> Just (Stereo.cons (sawChorus pl) (sawChorus pr))) initPhase2)+-} mainChunky0 :: IO ()@@ -479,9 +725,18 @@ (SVL.take size $ SVL.unfoldr SVL.defaultChunkSize generator0 0) {-+GHC-6.10.4:+ real 0m0.428s user 0m0.292s sys 0m0.132s+++GHC-6.12.1:++real 0m0.424s+user 0m0.252s+sys 0m0.168s -} mainChunky0Builder :: IO ()@@ -490,9 +745,18 @@ (SVL.take size $ runBuilder SVL.defaultChunkSize generator0 0) {-+GHC-6.10.4:+ real 0m1.107s user 0m0.968s sys 0m0.140s+++GHC-6.12.1:++real 0m1.079s+user 0m0.936s+sys 0m0.136s -} mainChunky1 :: IO ()@@ -501,9 +765,18 @@ (SVL.take size $ SVL.unfoldr SVL.defaultChunkSize generator1 (fst initPhase2)) {-+GHC-6.10.4:+ real 0m0.938s user 0m0.812s sys 0m0.116s+++GHC-6.12.1:++real 0m0.945s+user 0m0.788s+sys 0m0.152s -} mainChunky1MixFlat :: IO ()@@ -516,9 +789,18 @@ tone0 f1 p1 `mixVec` tone0 f2 p2) {-+GHC-6.10.4:+ real 0m3.932s user 0m2.112s sys 0m0.156s+++GHC-6.12.1:++real 0m2.264s+user 0m2.144s+sys 0m0.116s -} mainChunky1MixFold :: IO ()@@ -531,9 +813,18 @@ map (uncurry tone0) $ [(f0,p0), (f1,p1), (f2,p2)]) {-+GHC-6.10.4:+ real 0m1.611s user 0m1.476s sys 0m0.108s+++GHC-6.12.1:++real 0m1.555s+user 0m1.416s+sys 0m0.136s -} mainChunky2 :: IO ()@@ -542,12 +833,20 @@ (SVL.take size $ SVL.unfoldr SVL.defaultChunkSize generator2 initPhase2) {-+GHC-6.10.4:+ real 0m2.220s user 0m1.400s sys 0m0.192s+++GHC-6.12.1:++real 0m1.877s+user 0m1.652s+sys 0m0.216s -} main :: IO () main =- mainMonolithic1STMixZip--- mainMonolithic1GeneratorFold+ mainSumFoldl'
storablevector.cabal view
@@ -1,5 +1,5 @@ Name: storablevector-Version: 0.2.5+Version: 0.2.6 Category: Data Synopsis: Fast, packed, strict storable arrays with a list interface like ByteString Description:@@ -51,13 +51,14 @@ Source-Repository this type: darcs location: http://code.haskell.org/storablevector/- tag: 0.2.5+ tag: 0.2.6 Library Build-Depends: non-negative >= 0.0.4 && <0.1, utility-ht >= 0.0.5 && <0.1,- transformers >=0.0 && <0.2+ transformers >=0.2 && <0.3,+ QuickCheck >= 1 && < 3 If impl(jhc) Hs-Source-Dirs: foreign-ptr/jhc@@ -114,7 +115,7 @@ If flag(buildTests) Build-Depends: bytestring >= 0.9 && < 0.10,- QuickCheck >= 1 && < 2+ QuickCheck >= 1 && < 3 If flag(splitBase) Build-Depends: random >= 1.0 && < 1.1 If flag(functorInstance)
tests/QuickCheckUtils.hs view
@@ -85,12 +85,12 @@ ------------------------------------------------------------------------ instance Arbitrary Char where- arbitrary = choose ('a', 'i')- coarbitrary c = variant (ord c `rem` 4)+ arbitrary = choose ('a', 'i')+ coarbitrary c = variant (ord c `rem` 4) instance Arbitrary Word8 where- arbitrary = choose (97, 105)- coarbitrary c = variant (fromIntegral ((fromIntegral c) `rem` 4))+ arbitrary = choose (97, 105)+ coarbitrary c = variant (fromIntegral ((fromIntegral c) `rem` 4)) instance Arbitrary Int64 where arbitrary = sized $ \n -> choose (-fromIntegral n,fromIntegral n)@@ -120,8 +120,8 @@ (x,g) -> (fromIntegral x, g) instance Arbitrary V where- arbitrary = V.pack `fmap` arbitrary- coarbitrary s = coarbitrary (V.unpack s)+ arbitrary = V.pack `fmap` arbitrary+ coarbitrary s = coarbitrary (V.unpack s) instance Arbitrary P.ByteString where arbitrary = P.pack `fmap` arbitrary