storablevector 0.2.8.2 → 0.2.8.3
raw patch · 12 files changed
+220/−53 lines, 12 filesdep +unsafe
Dependencies added: unsafe
Files
- Data/StorableVector.hs +10/−10
- Data/StorableVector/Base.hs +5/−5
- Data/StorableVector/Cursor.hs +8/−8
- Data/StorableVector/Lazy.hs +3/−3
- Data/StorableVector/Lazy/Builder.hs +7/−5
- Data/StorableVector/Pointer.hs +3/−3
- Data/StorableVector/Private.hs +4/−4
- Data/StorableVector/ST/Private.hs +4/−2
- Data/StorableVector/ST/Strict.hs +9/−9
- LICENSE +1/−1
- speedtest/SpeedTestChorus.hs +161/−0
- storablevector.cabal +5/−3
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-2011+-- (c) Henning Thielemann 2008-2013 -- -- -- License : BSD-style@@ -218,7 +218,7 @@ hGetBuf, hPutBuf, Handle, IOMode(..), ) -import System.IO.Unsafe (unsafePerformIO, {- unsafeInterleaveIO, -} )+import qualified System.Unsafe as Unsafe -- import GHC.IOBase -- -----------------------------------------------------------------------------@@ -234,7 +234,7 @@ -- | /O(n)/ Equality on the 'Vector' type. equal :: (Storable a, Eq a) => Vector a -> Vector a -> Bool equal a b =- unsafePerformIO $+ Unsafe.performIO $ withStartPtr a $ \paf la -> withStartPtr b $ \pbf lb -> if la /= lb@@ -487,7 +487,7 @@ -- | 'foldl\'' is like 'foldl', but strict in the accumulator. foldl' :: (Storable a) => (b -> a -> b) -> b -> Vector a -> b foldl' f b v =- unsafePerformIO $ withStartPtr v $ \ptr l ->+ Unsafe.performIO $ withStartPtr v $ \ptr l -> let q = ptr `advancePtr` l go = Strict.arguments2 $ \p z -> if p == q@@ -549,7 +549,7 @@ foldrByIO f z v@(SV fp _ _) = unsafeWithStartPtr v $ let go = Strict.arguments2 $ \p l ->- unsafeInterleaveIO $+ Unsafe.interleaveIO $ if l>0 then liftM2 f (peek p) (go (incPtr p) (pred l)) else touchForeignPtr fp >> return z@@ -892,7 +892,7 @@ unfoldrN n f x0 = if n <= 0 then (empty, Just x0)- else unsafePerformIO $ createAndTrim' n $ \p -> go p n x0+ else Unsafe.performIO $ createAndTrim' n $ \p -> go p n x0 {- go must not be strict in the accumulator since otherwise packN would be too strict.@@ -939,7 +939,7 @@ unfoldrResultN i g f x0 = if i <= 0 then (empty, g x0)- else unsafePerformIO $ createAndTrim' i $ \p -> go p 0 x0+ else Unsafe.performIO $ createAndTrim' i $ \p -> go p 0 x0 {- go must not be strict in the accumulator since otherwise packN would be too strict.@@ -958,7 +958,7 @@ unfoldlN :: (Storable b) => Int -> (a -> Maybe (b, a)) -> a -> (Vector b, Maybe a) unfoldlN i f x0 | i < 0 = (empty, Just x0)- | otherwise = unsafePerformIO $ createAndTrim' i $ \p -> go (p `advancePtr` i) i x0+ | otherwise = Unsafe.performIO $ createAndTrim' i $ \p -> go (p `advancePtr` i) i x0 where go = Strict.arguments2 $ \p n -> \x -> if n == 0 then return (n, i, Just x)@@ -1402,7 +1402,7 @@ -- @interleave [pack "adgj", pack "behk", pack "cfil"] = pack ['a'..'l']@ interleave :: (Storable a) => [Vector a] -> Vector a interleave vs =- unsafePerformIO $+ Unsafe.performIO $ MC.runContT (do pls <- mapM (\v -> MC.ContT (withStartPtr v . curry)) vs@@ -1531,7 +1531,7 @@ unsafeWithStartPtr :: Storable a => Vector a -> (Ptr a -> Int -> IO b) -> b unsafeWithStartPtr v f =- unsafePerformIO (withStartPtr v f)+ Unsafe.performIO (withStartPtr v f) {-# INLINE unsafeWithStartPtr #-} foreignPeek :: Storable a => ForeignPtr a -> Int -> a
Data/StorableVector/Base.hs view
@@ -62,7 +62,7 @@ import GHC.IO (IO(IO), ) #endif -import System.IO.Unsafe (unsafePerformIO, )+import qualified System.Unsafe as Unsafe -- CFILES stuff is Hugs only {-# CFILES cbits/fpstring.c #-}@@ -172,7 +172,7 @@ -- 'createAndTrim' the Vector is not reallocated if the final size -- is less than the estimated size. unsafeCreate :: (Storable a) => Int -> (Ptr a -> IO ()) -> Vector a-unsafeCreate l f = unsafePerformIO (create l f)+unsafeCreate l f = Unsafe.performIO (create l f) {-# INLINE unsafeCreate #-} -- | Wrapper of mallocForeignPtrArray.@@ -211,15 +211,15 @@ else do ps <- create l' $ \p' -> copyArray p' (p `advancePtr` off) l' return $! (ps, res) --- | Just like unsafePerformIO, but we inline it. Big performance gains as+-- | Just like Unsafe.performIO, but we inline it. Big performance gains as -- it exposes lots of things to further inlining. /Very unsafe/. In -- particular, you should do no memory allocation inside an--- 'inlinePerformIO' block. On Hugs this is just @unsafePerformIO@.+-- 'inlinePerformIO' block. On Hugs this is just @Unsafe.performIO@. -- {-# INLINE inlinePerformIO #-} inlinePerformIO :: IO a -> a #if defined(__GLASGOW_HASKELL__) inlinePerformIO (IO m) = case m realWorld# of (# _, r #) -> r #else-inlinePerformIO = unsafePerformIO+inlinePerformIO = Unsafe.performIO #endif
Data/StorableVector/Cursor.hs view
@@ -16,7 +16,7 @@ import Control.Monad (when) import Data.Maybe (isNothing) -import System.IO.Unsafe (unsafePerformIO, unsafeInterleaveIO, )+import qualified System.Unsafe as Unsafe import qualified Data.List.HT as ListHT import Data.Tuple.HT (mapSnd, )@@ -70,7 +70,7 @@ {-# INLINE create #-} create :: (Storable a) => Int -> Generator a -> Buffer a-create l g = unsafePerformIO (createIO l g)+create l g = Unsafe.performIO (createIO l g) -- | Wrapper of mallocForeignPtrArray. createIO :: (Storable a) => Int -> Generator a -> IO (Buffer a)@@ -86,7 +86,7 @@ unfoldrNTerm :: (Storable b) => Int -> (a -> Maybe (b, a)) -> a -> Vector b unfoldrNTerm l f x0 =- unsafePerformIO (unfoldrNTermIO l f x0)+ Unsafe.performIO (unfoldrNTermIO l f x0) unfoldrNTermIO :: (Storable b) => Int -> (a -> Maybe (b, a)) -> a -> IO (Vector b)@@ -98,14 +98,14 @@ unfoldrN :: (Storable b) => Int -> (a -> Maybe (b, a)) -> a -> (Vector b, Maybe a) unfoldrN l f x0 =- unsafePerformIO (unfoldrNIO l f x0)+ Unsafe.performIO (unfoldrNIO l f x0) unfoldrNIO :: (Storable b) => Int -> (a -> Maybe (b, a)) -> a -> IO (Vector b, Maybe a) unfoldrNIO l f x0 = do ref <- newIORef (Just x0) buf <- createIO l (Generator (StateT f) ref)- s <- unsafeInterleaveIO $+ s <- Unsafe.interleaveIO $ do evaluateToIO l buf readIORef ref return (Vector buf 0 l, s)@@ -144,7 +144,7 @@ getFinalState :: (Storable b) => Vector b -> Maybe a getFinalState y =- unsafePerformIO $+ Unsafe.performIO $ ... -} @@ -270,7 +270,7 @@ {-# INLINE viewL #-} viewL :: Storable a => Vector a -> Maybe (a, Vector a)-viewL v = unsafePerformIO (viewLIO v)+viewL v = Unsafe.performIO (viewLIO v) {-# INLINE viewLIO #-} viewLIO :: Storable a => Vector a -> IO (Maybe (a, Vector a))@@ -320,7 +320,7 @@ -- length drop :: (Storable a) => Int -> Vector a -> Vector a-drop n v = unsafePerformIO $ dropIO n v+drop n v = Unsafe.performIO $ dropIO n v dropIO :: (Storable a) => Int -> Vector a -> IO (Vector a) dropIO n v =
Data/StorableVector/Lazy.hs view
@@ -32,7 +32,7 @@ import Control.Exception (bracket, catch, ) import qualified System.IO.Error as Exc-import System.IO.Unsafe (unsafeInterleaveIO)+import qualified System.Unsafe as Unsafe import Test.QuickCheck (Arbitrary(..)) @@ -1301,7 +1301,7 @@ ChunkSize -> Handle -> IO (IOError, Vector a) hGetContentsAsync (ChunkSize size) h = let go =- unsafeInterleaveIO $+ Unsafe.interleaveIO $ flip catch (\err -> return (err,[])) $ do v <- V.hGet h size if V.null v@@ -1310,7 +1310,7 @@ "StorableVector.Lazy.hGetContentsAsync" (Just h) Nothing, []) else fmap (mapSnd (v:)) go {-- unsafeInterleaveIO $+ Unsafe.interleaveIO $ flip catch (\err -> return (err,[])) $ liftM2 (\ chunk ~(err,rest) -> (err,chunk:rest)) (V.hGet h size) go
Data/StorableVector/Lazy/Builder.hs view
@@ -22,19 +22,21 @@ import Data.StorableVector.Lazy (ChunkSize, ) import Control.Monad (liftM2, )-import Control.Monad.ST.Strict (ST, runST, unsafeInterleaveST, )+import Control.Monad.ST.Strict (ST, runST, ) import Data.Monoid (Monoid(mempty, mappend), ) import Foreign.Storable (Storable, ) +import qualified System.Unsafe as Unsafe + {- 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',+and only rare 'Unsafe.interleaveST', since this is more efficient than using lazy ST everywhere. Before that approach I tried to achieve this with a lazy State monad.@@ -87,7 +89,7 @@ liftM2 (:) -- we could call 'flush' here, but this requires an extra 'SV.take' (STV.unsafeFreeze v0)- (unsafeInterleaveST $+ (Unsafe.interleaveST $ cont =<< newChunk cs) ) @@ -103,7 +105,7 @@ liftM2 (:) -- we could call 'flush' here, but this requires an extra 'SV.take' (STV.unsafeFreeze v0)- (unsafeInterleaveST $+ (Unsafe.interleaveST $ do (v1,i1) <- newChunk cs STV.write v1 i1 a cont (v1, succ i1))@@ -135,7 +137,7 @@ Builder (\cs cont vi0 -> liftM2 (:) (fixVector vi0)- (unsafeInterleaveST $ cont =<< newChunk cs)+ (Unsafe.interleaveST $ cont =<< newChunk cs) {- lazyToStrictST $ liftM2 (:)
Data/StorableVector/Pointer.hs view
@@ -13,7 +13,7 @@ import Foreign.Marshal.Array (advancePtr, ) import Foreign.Storable (Storable, peek, ) import Foreign (Ptr, )--- import System.IO.Unsafe (unsafePerformIO, )+import qualified System.Unsafe as Unsafe {-@@ -35,7 +35,7 @@ {-# INLINE cons #-} cons :: Storable a => VB.Vector a -> Pointer a cons (VB.SV fp s l) =- Pointer fp (advancePtr (FPtr.unsafeForeignPtrToPtr fp) s) l+ Pointer fp (advancePtr (Unsafe.foreignPtrToPtr fp) s) l {-# INLINE viewL #-}@@ -49,4 +49,4 @@ 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+-- Unsafe.performIO at this place would make SpeedPointer test 0.5 s slower
Data/StorableVector/Private.hs view
@@ -11,7 +11,7 @@ import Foreign.Storable (Storable(..)) -import System.IO.Unsafe (unsafePerformIO, )+import qualified System.Unsafe as Unsafe import Control.DeepSeq (NFData, rnf, deepseq, ) @@ -49,7 +49,7 @@ unfoldrStrictN i f x0 = if i <= 0 then (empty, Just x0)- else unsafePerformIO $ createAndTrim' i $ \p -> go p 0 x0+ else Unsafe.performIO $ createAndTrim' i $ \p -> go p 0 x0 {- go must not be strict in the accumulator since otherwise packN would be too strict.@@ -71,7 +71,7 @@ unfoldrTransitionN n trans emit x = if n <= 0 then (empty, x)- else unsafePerformIO $ createAndTrim' n $ \p ->+ else Unsafe.performIO $ createAndTrim' n $ \p -> case emit x of Nothing -> return (0, n, x) Just y0 -> poke p y0 >>@@ -133,7 +133,7 @@ unfoldrStateN i f x0 = if i <= 0 then (empty, x0)- else unsafePerformIO $ createAndTrim' i $ \p -> go p 0 x0+ else Unsafe.performIO $ createAndTrim' i $ \p -> go p 0 x0 {- go must not be strict in the accumulator since otherwise packN would be too strict.
Data/StorableVector/ST/Private.hs view
@@ -13,12 +13,14 @@ import Data.StorableVector.Memory (mallocForeignPtrArray, ) -import Control.Monad.ST.Strict (ST, unsafeIOToST, ) -- stToIO,+import Control.Monad.ST.Strict (ST, ) import Foreign.Ptr (Ptr, ) import Foreign.ForeignPtr (ForeignPtr, withForeignPtr, ) import Foreign.Storable (Storable, ) +import qualified System.Unsafe as Unsafe+ -- import Prelude (Int, ($), (+), return, const, ) import Prelude hiding (read, length, ) @@ -37,7 +39,7 @@ {-# INLINE unsafeCreate #-} unsafeCreate :: (Storable a) => Int -> (Ptr a -> IO ()) -> ST s (Vector s a)-unsafeCreate l f = unsafeIOToST $ create l f+unsafeCreate l f = Unsafe.ioToST $ create l f {- This function must be in ST monad,
Data/StorableVector/ST/Strict.hs view
@@ -37,13 +37,13 @@ import qualified Data.StorableVector as VS import qualified Data.StorableVector.Lazy as VL -import Control.Monad.ST.Strict (ST, unsafeIOToST, runST, ) -- stToIO,+import Control.Monad.ST.Strict (ST, runST, ) import Foreign.Ptr (Ptr, )-import Foreign.ForeignPtr (withForeignPtr, unsafeForeignPtrToPtr, )+import Foreign.ForeignPtr (withForeignPtr, ) import Foreign.Storable (Storable(peek, poke)) import Foreign.Marshal.Array (advancePtr, copyArray, )--- import System.IO.Unsafe (unsafePerformIO)+import qualified System.Unsafe as Unsafe import qualified Data.Traversable as Traversable import Data.Maybe.HT (toMaybe, )@@ -184,14 +184,14 @@ 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))+ Unsafe.ioToST (withForeignPtr v $ \p -> act (advancePtr p n)) {-# INLINE freeze #-} freeze :: (Storable e) => Vector s e -> ST s (VS.Vector e) freeze (SV x l) =- unsafeIOToST $+ Unsafe.ioToST $ V.create l $ \p -> withForeignPtr x $ \f -> copyArray p f (fromIntegral l)@@ -212,7 +212,7 @@ thaw :: (Storable e) => VS.Vector e -> ST s (Vector s e) thaw v =- unsafeIOToST $+ Unsafe.ioToST $ V.withStartPtr v $ \f l -> create l $ \p -> copyArray p f (fromIntegral l)@@ -246,13 +246,13 @@ go l q p = if l>0 then- do unsafeIOToST . poke p =<< f =<< unsafeIOToST (peek q)+ do Unsafe.ioToST . poke p =<< f =<< Unsafe.ioToST (peek q) go (pred l) (advancePtr q 1) (advancePtr p 1) else return () in do ys@(SV py _) <- new_ n go n- (unsafeForeignPtrToPtr px `advancePtr` sx)- (unsafeForeignPtrToPtr py)+ (Unsafe.foreignPtrToPtr px `advancePtr` sx)+ (Unsafe.foreignPtrToPtr py) unsafeToVector ys {-
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) Henning Thielemann 2008+Copyright (c) Henning Thielemann 2008-2013 (c) Spencer Janssen 2007 (c) Don Stewart 2005-2006 (c) David Roundy 2003-2005.
speedtest/SpeedTestChorus.hs view
@@ -388,6 +388,12 @@ real 0m0.171s user 0m0.112s sys 0m0.056s++GHC-7.6.1 (64bit, Toshiba):++real 0m0.100s+user 0m0.080s+sys 0m0.016s -} mainSumFoldr :: IO ()@@ -399,6 +405,13 @@ real 0m0.503s user 0m0.464s sys 0m0.036s+++GHC-7.6.1 (64bit, Toshiba):++real 0m0.253s+user 0m0.204s+sys 0m0.044s -} mainMonolithic0 :: IO ()@@ -418,6 +431,13 @@ real 0m0.392s user 0m0.252s sys 0m0.140s+++GHC-7.6.1 (64bit, Toshiba):++real 0m0.157s+user 0m0.080s+sys 0m0.076s -} mainMonolithic0Generator :: IO ()@@ -431,6 +451,13 @@ real 0m0.413s user 0m0.240s sys 0m0.172s+++GHC-7.6.1 (64bit, Toshiba):++real 0m0.164s+user 0m0.076s+sys 0m0.080s -} mainMonolithic0STStrict :: IO ()@@ -450,6 +477,13 @@ real 0m0.447s user 0m0.276s sys 0m0.168s+++GHC-7.6.1 (64bit, Toshiba):++real 0m0.164s+user 0m0.064s+sys 0m0.096s -} mainMonolithic0STLazy :: IO ()@@ -468,6 +502,13 @@ real 0m0.763s user 0m0.620s sys 0m0.144s+++GHC-7.6.1 (64bit, Toshiba):++real 0m0.166s+user 0m0.068s+sys 0m0.096s -} mainMonolithic0STMix :: IO ()@@ -490,6 +531,13 @@ real 0m0.475s user 0m0.344s sys 0m0.128s+++GHC-7.6.1 (64bit, Toshiba):++real 0m0.196s+user 0m0.100s+sys 0m0.092s -} mainMonolithic1 :: IO ()@@ -502,6 +550,13 @@ real 0m0.973s user 0m0.824s sys 0m0.140s+++GHC-7.6.1 (64bit, Toshiba):++real 0m0.252s+user 0m0.160s+sys 0m0.088s -} mainMonolithic1Composed :: IO ()@@ -527,6 +582,13 @@ real 0m0.940s user 0m0.800s sys 0m0.132s+++GHC-7.6.1 (64bit, Toshiba):++real 0m0.258s+user 0m0.180s+sys 0m0.076s -} mainMonolithic1Generator :: IO ()@@ -551,6 +613,13 @@ real 0m2.256s user 0m2.084s sys 0m0.172s+++GHC-7.6.1 (64bit, Toshiba):++real 0m0.262s+user 0m0.172s+sys 0m0.088s -} mainMonolithic1GeneratorFold :: IO ()@@ -575,6 +644,13 @@ real 0m3.050s user 0m2.884s sys 0m0.160s+++GHC-7.6.1 (64bit, Toshiba):++real 0m1.057s+user 0m0.940s+sys 0m0.112s -} mainMonolithic1STMix :: IO ()@@ -601,6 +677,13 @@ real 0m1.932s user 0m1.764s sys 0m0.168s+++GHC-7.6.1 (64bit, Toshiba):++real 0m0.350s+user 0m0.256s+sys 0m0.092s -} mainMonolithic1STMixZip :: IO ()@@ -626,6 +709,14 @@ real 0m1.560s user 0m1.404s sys 0m0.136s+++GHC-7.6.1 (64bit, Toshiba):++real 0m0.493s+user 0m0.396s+sys 0m0.092s+ -} @@ -647,6 +738,13 @@ real 0m1.751s user 0m1.544s sys 0m0.208s+++GHC-7.6.1 (64bit, Toshiba):++real 0m0.615s+user 0m0.468s+sys 0m0.140s -} mainMonolithic1STMixVectorZipFoldr :: IO ()@@ -667,6 +765,13 @@ real 0m3.046s user 0m2.828s sys 0m0.216s+++GHC-7.6.1 (64bit, Toshiba):++real 0m1.449s+user 0m1.324s+sys 0m0.120s -} mainMonolithic1STMixVectorZipIndex :: IO ()@@ -687,6 +792,13 @@ real 0m1.782s user 0m1.532s sys 0m0.220s+++GHC-7.6.1 (64bit, Toshiba):++real 0m0.595s+user 0m0.484s+sys 0m0.108s -} @@ -700,6 +812,13 @@ real 0m1.852s user 0m1.588s sys 0m0.252s+++GHC-7.6.1 (64bit, Toshiba):++real 0m0.561s+user 0m0.404s+sys 0m0.152s -} {-@@ -737,6 +856,13 @@ real 0m0.424s user 0m0.252s sys 0m0.168s+++GHC-7.6.1 (64bit, Toshiba):++real 0m0.186s+user 0m0.076s+sys 0m0.108s -} mainChunky0Builder :: IO ()@@ -757,6 +883,13 @@ real 0m1.079s user 0m0.936s sys 0m0.136s+++GHC-7.6.1 (64bit, Toshiba):++real 0m0.139s+user 0m0.048s+sys 0m0.088s -} mainChunky1 :: IO ()@@ -777,6 +910,13 @@ real 0m0.945s user 0m0.788s sys 0m0.152s+++GHC-7.6.1 (64bit, Toshiba):++real 0m0.272s+user 0m0.172s+sys 0m0.096s -} mainChunky1MixFlat :: IO ()@@ -801,6 +941,13 @@ real 0m2.264s user 0m2.144s sys 0m0.116s+++GHC-7.6.1 (64bit, Toshiba):++real 0m0.708s+user 0m0.424s+sys 0m0.124s -} mainChunky1MixFold :: IO ()@@ -825,6 +972,13 @@ real 0m1.555s user 0m1.416s sys 0m0.136s+++GHC-7.6.1 (64bit, Toshiba):++real 0m0.730s+user 0m0.596s+sys 0m0.132s -} mainChunky2 :: IO ()@@ -845,6 +999,13 @@ real 0m1.877s user 0m1.652s sys 0m0.216s+++GHC-7.6.1 (64bit, Toshiba):++real 0m0.591s+user 0m0.420s+sys 0m0.168s -} main :: IO ()
storablevector.cabal view
@@ -1,5 +1,5 @@ Name: storablevector-Version: 0.2.8.2+Version: 0.2.8.3 Category: Data Synopsis: Fast, packed, strict storable arrays with a list interface like ByteString Description:@@ -25,7 +25,8 @@ Homepage: http://www.haskell.org/haskellwiki/Storable_Vector Stability: Experimental Build-Type: Simple-Tested-With: GHC==6.8.2, GHC==6.12.3, GHC==7.4.1, JHC==0.7.3+Tested-With: GHC==6.8.2, GHC==6.12.3, GHC==7.4.1, GHC==7.6.2+Tested-With: JHC==0.7.3 Cabal-Version: >=1.6 Extra-Source-Files: foreign-ptr/fast/Data/StorableVector/Memory.hs@@ -52,13 +53,14 @@ Source-Repository this type: darcs location: http://code.haskell.org/storablevector/- tag: 0.2.8.2+ tag: 0.2.8.3 Library Build-Depends: non-negative >=0.1 && <0.2, utility-ht >=0.0.5 && <0.1, transformers >=0.2 && <0.4,+ unsafe >=0.0 && <0.1, QuickCheck >=1 && <3 If impl(jhc)