storablevector 0.2.10 → 0.2.11
raw patch · 8 files changed
+200/−42 lines, 8 filesdep ~deepseqdep ~randomdep ~syb
Dependency ranges changed: deepseq, random, syb, transformers
Files
- src/Data/StorableVector.hs +33/−19
- src/Data/StorableVector/Base.hs +6/−0
- src/Data/StorableVector/Cursor.hs +26/−8
- src/Data/StorableVector/Lazy.hs +122/−5
- src/Data/StorableVector/Lazy/Builder.hs +1/−1
- src/Data/StorableVector/Pointer.hs +6/−1
- storablevector.cabal +6/−5
- tests/Test/Utility.hs +0/−3
src/Data/StorableVector.hs view
@@ -173,6 +173,8 @@ interleave, -- * IO+ poke,+ peek, hGet, hPut, readFile,@@ -190,10 +192,12 @@ openBinaryFile, hClose, hFileSize, hGetBuf, hPutBuf, ) +import qualified Foreign.Storable as St import Foreign.ForeignPtr (ForeignPtr, withForeignPtr, ) import Foreign.Marshal.Array (advancePtr, copyArray, withArray, ) import Foreign.Ptr (Ptr, minusPtr, )-import Foreign.Storable (Storable(..))+import Foreign.Storable (Storable(sizeOf, alignment,+ pokeElemOff, peekElemOff), ) import qualified Test.QuickCheck as QC @@ -255,8 +259,8 @@ if l==0 then return True else- do x <- peek p- y <- peek q+ do x <- St.peek p+ y <- St.peek q if x==y then go (incPtr p) (incPtr q) (l-1) else return False@@ -273,7 +277,7 @@ -- | /O(1)/ Construct a 'Vector' containing a single element singleton :: (Storable a) => a -> Vector a-singleton c = unsafeCreate 1 $ \p -> poke p c+singleton c = unsafeCreate 1 $ \p -> St.poke p c {-# INLINE singleton #-} -- | /O(n)/ Convert a '[a]' into a 'Vector a'.@@ -284,7 +288,7 @@ go = Strict.arguments2 $ \p -> ListHT.switchL (return ())- (\x xs -> poke p x >> go (incPtr p) xs)+ (\x xs -> St.poke p x >> go (incPtr p) xs) -- | /O(n)/ Convert first @n@ elements of a '[a]' into a 'Vector a'. --@@ -306,7 +310,7 @@ go = Strict.arguments2 $ \p -> ListHT.switchL (return ())- (\x xs -> poke p (k x) >> go (incPtr p) xs)+ (\x xs -> St.poke p (k x) >> go (incPtr p) xs) -- less space than pokeElemOff {-# INLINE packWith #-} @@ -331,7 +335,7 @@ go p (l - 1) [] where STRICT3(go)- go p 0 acc = peek p >>= \e -> return (k e : acc)+ go p 0 acc = St.peek p >>= \e -> return (k e : acc) go p n acc = peekElemOff p n >>= \e -> go p (n-1) (k e : acc) {-# INLINE unpackWith #-} @@ -375,7 +379,7 @@ cons c v = unsafeWithStartPtr v $ \f l -> create (l + 1) $ \p -> do- poke p c+ St.poke p c copyArray (incPtr p) f (fromIntegral l) {-# INLINE cons #-} @@ -443,7 +447,7 @@ let go = Strict.arguments3 $ \ n p1 p2 -> when (n>0) $- do poke p2 . f =<< peek p1+ do St.poke p2 . f =<< St.peek p1 go (n-1) (incPtr p1) (incPtr p2) in go len a p {-# INLINE map #-}@@ -498,7 +502,7 @@ go = Strict.arguments2 $ \p z -> if p == q then return z- else go (incPtr p) . f z =<< peek p+ else go (incPtr p) . f z =<< St.peek p in go ptr b {-# INLINE foldl' #-} @@ -557,7 +561,7 @@ let go = Strict.arguments2 $ \p l -> Unsafe.interleaveIO $ if l>0- then liftM2 f (peek p) (go (incPtr p) (pred l))+ then liftM2 f (St.peek p) (go (incPtr p) (pred l)) else touchForeignPtr fp >> return z in go {-# INLINE foldrByIO #-}@@ -635,7 +639,7 @@ concatMap f = concat . unpackWith f {-# INLINE concatMap #-} --- | This is like @mconcat . map f@,+-- | This is like @foldMap@ or @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 =@@ -820,7 +824,7 @@ let go = Strict.arguments2 $ \i p -> if i == 0 then return ()- else poke p c >> go (pred i) (incPtr p)+ else St.poke p c >> go (pred i) (incPtr p) in go n {-# INLINE replicate #-} {-@@ -909,7 +913,7 @@ else case f x of Nothing -> return (0, n-i, Nothing)- Just (w,x') -> do poke p w+ Just (w,x') -> do St.poke p w go (incPtr p) (i-1) x' {-# INLINE unfoldrN #-} @@ -956,7 +960,7 @@ else case f a0 of Left c -> return (0, n, c)- Right (b,a1) -> do poke p b+ Right (b,a1) -> do St.poke p b go (incPtr p) (n+1) a1 {-# INLINE unfoldrResultN #-} @@ -972,7 +976,7 @@ Nothing -> return (n, i, Nothing) Just (w,x') -> let p' = p `advancePtr` (-1)- in do poke p' w+ in do St.poke p' w go p' (n-1) x' {-# INLINE unfoldlN #-} @@ -1340,7 +1344,7 @@ in create len $ \p0 -> let go = Strict.arguments4 $ \n p pa pb -> when (n>0) $- liftM2 f (peek pa) (peek pb) >>= poke p >>+ liftM2 f (St.peek pa) (St.peek pb) >>= St.poke p >> go (pred n) (incPtr p) (incPtr pa) (incPtr pb) in go len p0 pa0 pb0 @@ -1359,7 +1363,7 @@ 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 >>+ liftM3 f (St.peek pa) (St.peek pb) (St.peek pc) >>= St.poke p >> go (pred n) (incPtr p) (incPtr pa) (incPtr pb) (incPtr pc) in go len p0 pa0 pb0 pc0 {-# INLINE zipWith3 #-}@@ -1380,7 +1384,7 @@ 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 >>+ liftM4 f (St.peek pa) (St.peek pb) (St.peek pc) (St.peek pd) >>= St.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 #-}@@ -1477,6 +1481,16 @@ -- --------------------------------------------------------------------- -- IO++-- | Write a 'Vector' to a contiguous piece of memory.+poke :: (Storable a) => Ptr a -> Vector a -> IO ()+poke dst v =+ withStartPtr v $ \src len -> copyArray dst src len++-- | Read a 'Vector' from a contiguous piece of memory.+peek :: (Storable a) => Int -> Ptr a -> IO (Vector a)+peek len src =+ create len $ \dst -> copyArray dst src len -- | Outputs a 'Vector' to the specified 'Handle'. hPut :: (Storable a) => Handle -> Vector a -> IO ()
src/Data/StorableVector/Base.hs view
@@ -54,6 +54,7 @@ import Data.StorableVector.Memory (mallocForeignPtrArray, ) +import Control.DeepSeq (NFData, rnf) import Control.Exception (assert) #if defined(__GLASGOW_HASKELL__)@@ -80,6 +81,11 @@ #if defined(__GLASGOW_HASKELL__) deriving (Data, Typeable) #endif+++instance (Storable a) => NFData (Vector a) where+ rnf (SV _ _ _) = ()+ -- --------------------------------------------------------------------- --
src/Data/StorableVector/Cursor.hs view
@@ -2,7 +2,25 @@ {- | Simulate a list with strict elements by a more efficient array structure. -}-module Data.StorableVector.Cursor where+module Data.StorableVector.Cursor (+ Vector,+ create,+ unfoldrNTerm,+ unfoldrN,+ pack,+ cons,+ zipWith,+ zipNWith,+ whileM,+ switchL,+ viewL,+ foldr,+ unpack,+ null,+ drop,+ take,+ filter,+ ) where import Control.Exception (assert, ) import Control.Monad.Trans.State (StateT(StateT), runStateT, )@@ -21,7 +39,7 @@ import qualified Data.List.HT as ListHT import Data.Tuple.HT (mapSnd, ) -import Prelude hiding (length, foldr, zipWith, take, drop, )+import Prelude hiding (length, foldr, zipWith, take, drop, filter, null, ) {-@@ -50,8 +68,8 @@ data Buffer a = Buffer { memory :: {-# UNPACK #-} !(ForeignPtr a),- size :: {-# UNPACK #-} !Int, -- size of allocated memory, I think I only need it for debugging- gen :: !(Generator a), -- we need this indirection for the existential type in Generator+ _size :: {-# UNPACK #-} !Int, -- size of allocated memory, I think I only need it for debugging+ _gen :: !(Generator a), -- we need this indirection for the existential type in Generator cursor :: {-# UNPACK #-} !(IORef Int) } @@ -254,15 +272,15 @@ {- If it returns False the list can be empty anyway. -}-obviousNullIO :: Vector a -> IO Bool-obviousNullIO (Vector (Buffer _ _ (Generator _ s) _) _ ml) =+_obviousNullIO :: Vector a -> IO Bool+_obviousNullIO (Vector (Buffer _ _ (Generator _ s) _) _ ml) = assert (ml >= 0) $ do b <- readIORef s return (ml == 0 || isNothing b) {--obviousNullIO :: Vector a -> IO Bool-obviousNullIO (Vector (Buffer _ sz (Generator _ s) _) st _) =+_obviousNullIO :: Vector a -> IO Bool+_obviousNullIO (Vector (Buffer _ sz (Generator _ s) _) st _) = do b <- readIORef s return (st >= sz || isNothing b) -}
src/Data/StorableVector/Lazy.hs view
@@ -6,7 +6,94 @@ in order to turn them into machine loops instead of calling a function in an inner loop. -}-module Data.StorableVector.Lazy where+module Data.StorableVector.Lazy (+ -- constructors should not be exported+ Vector(SV, chunks),+ ChunkSize(ChunkSize),+ chunkSize,+ defaultChunkSize,+ empty,+ singleton,+ fromChunks,+ pack,+ unpack,+ packWith,+ unpackWith,+ unfoldr,+ unfoldrResult,+ sample,+ sampleN,+ iterate,+ repeat,+ cycle,+ replicate,+ null,+ length,+ equal,+ index,+ cons,+ append,+ extendL,+ concat,+ sliceVertical,+ snoc,+ map,+ reverse,+ foldl,+ foldl',+ foldr,+ monoidConcatMap,+ any,+ all,+ maximum,+ minimum,+ pointer,+ viewL,+ viewR,+ switchL,+ switchR,+ scanl,+ mapAccumL,+ mapAccumR,+ crochetL,+ take,+ takeEnd,+ drop,+ splitAt,+ dropMarginRem,+ dropMargin,+ dropWhile,+ takeWhile,+ span,+ filter,+ zipWith,+ zipWith3,+ zipWith4,+ zipWithLastPattern,+ zipWithLastPattern3,+ zipWithLastPattern4,+ zipWithSize,+ zipWithSize3,+ zipWithSize4,+ sieve,+ deinterleave,+ interleaveFirstPattern,+ pad,+ fromChunk,+ hGetContentsAsync,+ hGetContentsSync,+ hPut,+ readFileAsync,+ writeFile,+ appendFile,+ interact,+ -- should not be exported or should be exported from plain StorableVector+ crochetLChunk,+ -- should not be exported+ padAlt,+ cancelNullVector,+ moduleError,+ ) where import qualified Data.List as List import qualified Data.StorableVector as V@@ -27,8 +114,11 @@ import Control.Monad (liftM, liftM2, liftM3, liftM4, {- guard, -} ) +import qualified System.IO as IO import System.IO (openBinaryFile, IOMode(WriteMode, ReadMode, AppendMode), hClose, Handle)++import Control.DeepSeq (NFData, rnf) import Control.Exception (bracket, catch, ) import qualified System.IO.Error as Exc@@ -81,7 +171,10 @@ instance (Storable a, Arbitrary a) => Arbitrary (Vector a) where arbitrary = liftM2 pack arbitrary arbitrary +instance (Storable a) => NFData (Vector a) where+ rnf = rnf . List.map rnf . chunks + -- for a list of chunk sizes see "Data.StorableVector.LazySize". newtype ChunkSize = ChunkSize Int deriving (Eq, Ord, Show)@@ -95,8 +188,7 @@ Maybe we do not need the Num instance anymore. -} instance Num ChunkSize where- (ChunkSize x) + (ChunkSize y) =- ChunkSize (x+y)+ (ChunkSize x) + (ChunkSize y) = ChunkSize (x+y) (-) = moduleError "ChunkSize.-" "intentionally unimplemented" (*) = moduleError "ChunkSize.*" "intentionally unimplemented" abs = moduleError "ChunkSize.abs" "intentionally unimplemented"@@ -146,8 +238,7 @@ {-# INLINE packWith #-} packWith :: (Storable b) => ChunkSize -> (a -> b) -> [a] -> Vector b-packWith size f =- unfoldr size (fmap (mapFst f) . ListHT.viewL)+packWith size f = unfoldr size (fmap (mapFst f) . ListHT.viewL) {-# INLINE unpackWith #-} unpackWith :: (Storable a) => (a -> b) -> Vector a -> [b]@@ -300,7 +391,11 @@ sliceVertical n = List.unfoldr (\x -> toMaybe (not (null x)) (splitAt n x)) +{-# NOINLINE [0] snoc #-}+snoc :: Storable a => Vector a -> a -> Vector a+snoc xs x = append xs $ singleton x + -- * Transformations {-# INLINE map #-}@@ -331,6 +426,9 @@ foldr f x0 = List.foldr (flip (V.foldr f)) x0 . chunks +{- |+@foldMap@+-} {-# INLINE monoidConcatMap #-} monoidConcatMap :: (Storable a, Monoid m) => (a -> m) -> Vector a -> m monoidConcatMap f =@@ -1313,6 +1411,11 @@ but when working with realtime streams that may mean that the chunks are very small. -}+{-+ToDo:+It might be better to let the user close the file manually+after he finished processing the file.+-} hGetContentsAsync :: Storable a => ChunkSize -> Handle -> IO (IOError, Vector a) hGetContentsAsync (ChunkSize size) h =@@ -1367,6 +1470,20 @@ appendFile :: Storable a => FilePath -> Vector a -> IO () appendFile path = bracket (openBinaryFile path AppendMode) hClose . flip hPut++interact :: Storable a => ChunkSize -> (Vector a -> Vector a) -> IO ()+interact (ChunkSize size) f =+ let -- almost duplicate of hGetContentsSync+ hGetContents h =+ let go =+ Unsafe.interleaveIO $+ do v <- V.hGet h size+ if V.null v+ then return []+ else fmap (v:) go+ in go+ in mapM_ (V.hPut IO.stdout) . chunks . f . SV =<< hGetContents IO.stdin+ {-# NOINLINE moduleError #-}
src/Data/StorableVector/Lazy/Builder.hs view
@@ -66,7 +66,7 @@ {- |-> toLazyStorableVector (ChunkSize 7) $ Data.Monoid.mconcat $ map put ['a'..'z']+> toLazyStorableVector (ChunkSize 7) $ foldMap put ['a'..'z'] -} {-# INLINE toLazyStorableVector #-} toLazyStorableVector :: Storable a =>
src/Data/StorableVector/Pointer.hs view
@@ -4,7 +4,12 @@ However this needs a bit of pointer arrangement and allocation. This data structure should make loops optimally fast. -}-module Data.StorableVector.Pointer where+module Data.StorableVector.Pointer (+ Pointer(..),+ cons,+ viewL,+ switchL,+ ) where -- import qualified Data.StorableVector as V import qualified Data.StorableVector.Base as VB
storablevector.cabal view
@@ -1,5 +1,5 @@ Name: storablevector-Version: 0.2.10+Version: 0.2.11 Category: Data Synopsis: Fast, packed, strict storable arrays with a list interface like ByteString Description:@@ -48,14 +48,15 @@ Source-Repository this type: darcs location: http://code.haskell.org/storablevector/- tag: 0.2.10+ tag: 0.2.11 Library Build-Depends: non-negative >=0.1 && <0.2, utility-ht >=0.0.5 && <0.1,- transformers >=0.2 && <0.5,+ transformers >=0.2 && <0.6,+ deepseq >=1.3 && <1.5, unsafe >=0.0 && <0.1, QuickCheck >=1 && <3 @@ -70,7 +71,7 @@ If flag(separateSYB) Build-Depends: base >=4 && <5,- syb >=0.1 && <0.5+ syb >=0.1 && <0.7 Else Build-Depends: base >=3 && <4@@ -118,7 +119,7 @@ QuickCheck >=1 && <3 If flag(splitBase) Build-Depends:- random >=1.0 && <1.1,+ random >=1.0 && <1.2, base >=3 && <5 Else Hs-Source-Dirs: tests-1
tests/Test/Utility.hs view
@@ -11,7 +11,6 @@ import qualified Data.ByteString as P import qualified Data.StorableVector as V -import qualified Data.ByteString.Char8 as PC {- |@@ -23,14 +22,12 @@ model :: a -> b instance Model P [W] where model = P.unpack-instance Model P [Char] where model = PC.unpack instance Model V [W] where model = V.unpack instance Model V P where model = P.pack . V.unpack instance Model Bool Bool where model = id instance Model Int Int where model = id instance Model Int64 Int64 where model = id-instance Model Int64 Int where model = fromIntegral instance Model Word8 Word8 where model = id instance Model Ordering Ordering where model = id instance Model Char Char where model = id