packages feed

storablevector 0.2 → 0.2.1

raw patch · 8 files changed

+656/−30 lines, 8 files

Files

Data/StorableVector.hs view
@@ -34,6 +34,7 @@ -- UArray by Simon Marlow. Rewritten to support slices and use -- ForeignPtr by David Roundy. Polished and extended by Don Stewart. -- Generalized to any Storable value by Spencer Janssen.+-- Chunky lazy stream and mutable access in ST monad by Henning Thieleman.  module Data.StorableVector (
Data/StorableVector/Lazy.hs view
@@ -58,14 +58,19 @@ newtype Vector a = SV {chunks :: [V.Vector a]}  --- could also be a list of chunk sizes+-- for a list of chunk sizes see "Data.StorableVector.LazySize". newtype ChunkSize = ChunkSize Int  chunkSize :: Int -> ChunkSize-chunkSize = ChunkSize+chunkSize x =+   ChunkSize $+      if x>0+        then x+        else error ("no positive chunk size: " List.++ show x)  defaultChunkSize :: ChunkSize-defaultChunkSize = chunkSize 1024+defaultChunkSize =+   ChunkSize 1024   @@ -79,6 +84,9 @@ singleton :: (Storable a) => a -> Vector a singleton x = SV [V.singleton x] +fromChunks :: (Storable a) => [V.Vector a] -> Vector a+fromChunks = SV+ pack :: (Storable a) => ChunkSize -> [a] -> Vector a pack size = unfoldr size viewListL @@ -365,6 +373,15 @@  {-# INLINE dropMarginRem #-} -- I have used this in an inner loop thus I prefer inlining+{- |+@dropMarginRem n m xs@+drops at most the first @m@ elements of @xs@+and ensures that @xs@ still contains @n@ elements.+Additionally returns the number of elements that could not be dropped+due to the margin constraint.+That is @dropMarginRem n m xs == (k,ys)@ implies @length xs - m == length ys - k@.+Requires @length xs >= n@.+-} dropMarginRem :: (Storable a) => Int -> Int -> Vector a -> (Int, Vector a) dropMarginRem n m xs =    List.foldl'
+ Data/StorableVector/LazySize.hs view
@@ -0,0 +1,135 @@+{- |+A chunky lazy size type that resembles the NonNegative.Chunky type.+-}+module Data.StorableVector.LazySize where++import Data.StorableVector.Lazy+   (ChunkSize(ChunkSize), chunkSize, defaultChunkSize, )+import Control.Monad (liftM, liftM2, )+import Data.List (genericReplicate, )++import Test.QuickCheck (Arbitrary(..))+++newtype T = Cons {decons :: [ChunkSize]}++intFromChunkSize :: ChunkSize -> Int+intFromChunkSize (ChunkSize x) = x++++fromInt :: Int -> T+fromInt x = Cons [chunkSize x]++fromInts :: [Int] -> T+fromInts = Cons . map chunkSize++toInt :: T -> Int+toInt = sum . map intFromChunkSize . decons++++instance Show T where+   showsPrec p x =+      showParen (p>10)+         (showString "LazySize.Cons " .+          showsPrec 10 (map intFromChunkSize $ decons x))++lift2 :: ([ChunkSize] -> [ChunkSize] -> [ChunkSize]) -> (T -> T -> T)+lift2 f (Cons x) (Cons y) = Cons $ f x y++{- |+Remove zero chunks.+-}+normalize :: T -> T+normalize = Cons . filter (\(ChunkSize x) -> x>0) . decons++isNullList :: [ChunkSize] -> Bool+isNullList = null . filter (\(ChunkSize x) -> x>0)++isNull :: T -> Bool+isNull = isNullList . decons+  -- null . decons . normalize++isPositive :: T -> Bool+isPositive = not . isNull+++check :: String -> Bool -> a -> a+check funcName b x =+   if b+     then x+     else error ("Numeric.NonNegative.Chunky."++funcName++": negative number")+++{- |+In @glue x y == (z,r,b)@+@z@ represents @min x y@,+@r@ represents @max x y - min x y@,+and @x<y  ==>  b@ or @x>y  ==>  not b@, for @x==y@ the value of b is arbitrary.+-}+glue :: [ChunkSize] -> [ChunkSize] -> ([ChunkSize], [ChunkSize], Bool)+glue [] ys = ([], ys, True)+glue xs [] = ([], xs, False)+glue (x@(ChunkSize x0) : xs) (y@(ChunkSize y0) : ys) =+   let (z,(zs,rs,b)) =+           case compare x0 y0 of+              LT -> (x, glue xs (ChunkSize (y0-x0) : ys))+              GT -> (y, glue (ChunkSize (x0-y0) : xs) ys)+              EQ -> (x, glue xs ys)+   in  (z:zs,rs,b)+++equalList :: [ChunkSize] -> [ChunkSize] -> Bool+equalList x y =+   let (_,r,_) = glue x y+   in  isNullList r++compareList :: [ChunkSize] -> [ChunkSize] -> Ordering+compareList x y =+   let (_,r,b) = glue x y+   in  if isNullList r+         then EQ+         else if b then LT else GT++minList :: [ChunkSize] -> [ChunkSize] -> [ChunkSize]+minList x y =+   let (z,_,_) = glue x y in z++maxList :: [ChunkSize] -> [ChunkSize] -> [ChunkSize]+maxList x y =+   let (z,r,_) = glue x y in z++r+++instance Eq T where+   (Cons x) == (Cons y) = equalList x y++instance Ord T where+   compare (Cons x) (Cons y) = compareList x y+   min = lift2 minList+   max = lift2 maxList++instance Num T where+   (+)    = lift2 (++)+   (Cons x) - (Cons y) =+      let (_,d,b) = glue x y+          d' = Cons d+      in check "-" (not b || isNull d') d'+   negate x = check "negate" (isNull x) x+   fromInteger x =+      let (q,r) = divMod x (fromIntegral $ intFromChunkSize defaultChunkSize)+      in  Cons $ genericReplicate q defaultChunkSize ++ [ChunkSize (fromInteger r)]+   (*)    = lift2 (liftM2 (\(ChunkSize x) (ChunkSize y) -> ChunkSize (x*y)))+   abs    = id+   signum = fromInt . (\b -> if b then 1 else 0) . isPositive++instance Arbitrary T where+   arbitrary = liftM (normalize . Cons . map (ChunkSize . abs)) arbitrary+   coarbitrary = undefined++decrementLimit :: ChunkSize -> T -> T+decrementLimit (ChunkSize x) =+   let sub _ [] = []+       sub z (ChunkSize y : ys) =+          if z<y then ChunkSize (y-z) : ys else sub (z-y) ys+   in  Cons . sub x . decons
+ Data/StorableVector/LazyVarying.hs view
@@ -0,0 +1,403 @@+{- |+Functions for 'StorableVector' that allow control of the size of individual chunks.++This is import for an application like the following:+You want to mix audio signals that are relatively shifted.+The structure of chunks of three streams may be illustrated as:++> [____] [____] [____] [____] ...+>   [____] [____] [____] [____] ...+>     [____] [____] [____] [____] ...++When we mix the streams (@zipWith3 (\x y z -> x+y+z)@)+with respect to the chunk structure of the first signal,+computing the first chunk requires full evaluation of all leading chunks of the stream.+However the last value of the third leading chunk+is much later in time than the last value of the first leading chunk.+We like to reduce these dependencies using a different chunk structure,+say++> [____] [____] [____] [____] ...+>   [__] [____] [____] [____] ...+>     [] [____] [____] [____] ...++-}+module Data.StorableVector.LazyVarying (+   Vector,+   ChunkSize,+   chunkSize,+   defaultChunkSize,++   empty,+   singleton,+   pack,+   unpack,+   packWith,+   unpackWith,+   unfoldrN,+   iterateN,+   cycle,+   replicate,+   null,+   length,+   cons,+   append,+   concat,+   map,+   reverse,+   foldl,+   foldl',+   any,+   all,+   maximum,+   minimum,+   viewL,+   viewR,+   switchL,+   switchR,+   scanl,+   mapAccumL,+   mapAccumR,+   crochetL,+   take,+   drop,+   splitAt,+   dropMarginRem,+   dropMargin,+   dropWhile,+   takeWhile,+   span,+   filter,+   zipWith,+   zipWith3,+   zipWith4,+   zipWithSize,+   zipWithSize3,+   zipWithSize4,+{-+   pad,+   cancelNullVector,+   fromChunk,+   hGetContentsAsync,+   hPut,+   readFileAsync,+   writeFile,+   appendFile,+-}+   ) where++import qualified Data.StorableVector.LazySize as LS+import qualified Data.StorableVector.Lazy as LSV+import qualified Data.StorableVector as V++import Data.StorableVector.Lazy (Vector(SV), ChunkSize(ChunkSize))++import Data.StorableVector.Lazy (+   chunkSize, defaultChunkSize,+   empty, singleton, unpack, unpackWith, cycle,+   null, cons, append, concat, map, reverse,+   foldl, foldl', any, all, maximum, minimum,+   viewL, viewR, switchL, switchR,+   scanl, mapAccumL, mapAccumR, crochetL,+   dropMarginRem, dropMargin,+   dropWhile, takeWhile, span, filter, +   zipWith, zipWith3, zipWith4, +   )++import qualified Data.List as List++import Data.Maybe (Maybe(Just, Nothing), )+import Data.StorableVector.Utility (viewListL, mapPair, mapFst, )++import Control.Monad (liftM2, liftM3, liftM4, guard, )++import Foreign.Storable (Storable)++{-+import Prelude hiding+   (length, (++), iterate, foldl, map, repeat, replicate, null,+    zip, zipWith, zipWith3, drop, take, splitAt, takeWhile, dropWhile, reverse)+-}+import Prelude ((.), ($), fst, flip, curry, return, fmap, not, )+++type LazySize = LS.T++-- * Introducing and eliminating 'Vector's++pack :: (Storable a) => LazySize -> [a] -> Vector a+pack size =+   fst . unfoldrN size viewListL+++{-# INLINE packWith #-}+packWith :: (Storable b) => LazySize -> (a -> b) -> [a] -> Vector b+packWith size f =+   fst . unfoldrN size (fmap (\(a,b) -> (f a, b)) . viewListL)+++{-+{-# INLINE unfoldrNAlt #-}+unfoldrNAlt :: (Storable b) =>+      LazySize+   -> (a -> Maybe (b,a))+   -> a+   -> (Vector b, Maybe a)+unfoldrNAlt (LS.Cons size) f x =+   let go sz y =+          case sz of+             [] -> ([], y)+             (ChunkSize s : ss) ->+                maybe+                   ([], Nothing)+                   ((\(c,a1) -> mapFst (c:) $ go ss a1) .+                    V.unfoldrN s (fmap (mapSnd f)))+                   (f y)+   in  mapFst SV $ go size (Just x)+-}++{-# INLINE unfoldrN #-}+unfoldrN :: (Storable b) =>+      LazySize+   -> (a -> Maybe (b,a))+   -> a+   -> (Vector b, Maybe a)+unfoldrN (LS.Cons size) f x =+   let go sz y =+          case sz of+             [] -> ([], y)+             (ChunkSize s : ss) ->+                let m =+                       do a0 <- y+                          let p = V.unfoldrN s f a0+                          guard (not (V.null (fst p)))+                          return p+                in  case m of+                       Nothing -> ([], Nothing)+                       Just (c,a1) -> mapFst (c:) $ go ss a1+   in  mapFst SV $ go size (Just x)+++{-# INLINE iterateN #-}+iterateN :: Storable a => LazySize -> (a -> a) -> a -> Vector a+iterateN size f =+   fst . unfoldrN size (\x -> Just (x, f x))++replicate :: Storable a => LazySize -> a -> Vector a+replicate size x =+   SV $ List.map (\(ChunkSize m) -> V.replicate m x) (LS.decons size)++++-- * Basic interface++length :: Vector a -> LazySize+length = LS.Cons . List.map chunkLength . LSV.chunks++chunkLength :: V.Vector a -> ChunkSize+chunkLength = ChunkSize . V.length+++-- * sub-vectors++{-# INLINE take #-}+take :: (Storable a) => LazySize -> Vector a -> Vector a+take _ (SV []) = empty+take (LS.Cons []) _ = empty+take n (SV (x:xs)) =+   let remain = LS.decrementLimit (chunkLength x) n+   in  SV $+       if LS.isNull remain+         then [V.take (LS.toInt n) x]+         else+           let (SV ys) = take remain $ SV xs+           in  x:ys++{-# INLINE drop #-}+drop :: (Storable a) => LazySize -> Vector a -> Vector a+drop (LS.Cons size) xs =+   List.foldl (flip (LSV.drop . LS.intFromChunkSize)) xs size++{-# INLINE splitAt #-}+splitAt :: (Storable a) => LazySize -> Vector a -> (Vector a, Vector a)+splitAt (LS.Cons []) = (,) empty+splitAt n0 =+   let recurse _ [] = ([], [])+       recurse n (x:xs) =+          let remain = LS.decrementLimit (chunkLength x) n+          in  if LS.isNull remain+                then mapPair ((:[]), (:xs)) $ V.splitAt (LS.toInt n) x+                else mapFst (x:) $ recurse remain xs+   in  mapPair (SV, SV) . recurse n0 . LSV.chunks+++{-# INLINE [0] zipWithSize #-}+zipWithSize :: (Storable a, Storable b, Storable c) =>+      LazySize+   -> (a -> b -> c)+   -> Vector a+   -> Vector b+   -> Vector c+zipWithSize size f =+   curry (fst . unfoldrN size (\(xt,yt) ->+      liftM2+         (\(x,xs) (y,ys) -> (f x y, (xs,ys)))+         (viewL xt)+         (viewL yt)))++{-# INLINE zipWithSize3 #-}+zipWithSize3 ::+   (Storable a, Storable b, Storable c, Storable d) =>+   LazySize -> (a -> b -> c -> d) ->+   (Vector a -> Vector b -> Vector c -> Vector d)+zipWithSize3 size f s0 s1 s2 =+   fst $ unfoldrN size (\(xt,yt,zt) ->+      liftM3+         (\(x,xs) (y,ys) (z,zs) ->+             (f x y z, (xs,ys,zs)))+         (viewL xt)+         (viewL yt)+         (viewL zt))+      (s0,s1,s2)++{-# INLINE zipWithSize4 #-}+zipWithSize4 ::+   (Storable a, Storable b, Storable c, Storable d, Storable e) =>+   LazySize -> (a -> b -> c -> d -> e) ->+   (Vector a -> Vector b -> Vector c -> Vector d -> Vector e)+zipWithSize4 size f s0 s1 s2 s3 =+   fst $ unfoldrN size (\(xt,yt,zt,wt) ->+      liftM4+         (\(x,xs) (y,ys) (z,zs) (w,ws) ->+             (f x y z w, (xs,ys,zs,ws)))+         (viewL xt)+         (viewL yt)+         (viewL zt)+         (viewL wt))+      (s0,s1,s2,s3)++{-+{- |+Ensure a minimal length of the list by appending pad values.+-}+{-# ONLINE pad #-}+pad :: (Storable a) => ChunkSize -> a -> Int -> Vector a -> Vector a+pad size y n0 =+   let recurse n xt =+          if n<=0+            then xt+            else+              case xt of+                 [] -> chunks $ replicate size n y+                 x:xs -> x : recurse (n - V.length x) xs+   in  SV . recurse n0 . chunks++padAlt :: (Storable a) => ChunkSize -> a -> Int -> Vector a -> Vector a+padAlt size x n xs =+   append xs+      (let m = length xs+       in  if n>m+             then replicate size (n-m) x+             else empty)++++++-- * Helper functions for StorableVector+++{-# INLINE cancelNullVector #-}+cancelNullVector :: (V.Vector a, b) -> Maybe (V.Vector a, b)+cancelNullVector y =+   toMaybe (not (V.null (fst y))) y++-- if the chunk has length zero, an empty sequence is generated+{-# INLINE fromChunk #-}+fromChunk :: (Storable a) => V.Vector a -> Vector a+fromChunk x =+   if V.null x+     then empty+     else SV [x]++++{- * IO -}++{- |+Read the rest of a file lazily and+provide the reason of termination as IOError.+If IOError is EOF (check with @System.Error.isEOFError err@),+then the file was read successfully.+Only access the final IOError after you have consumed the file contents,+since finding out the terminating reason forces to read the entire file.+Make also sure you read the file completely,+because it is only closed when the file end is reached+(or an exception is encountered).++TODO:+In ByteString.Lazy the chunk size is reduced+if data is not immediately available.+Maybe we should adapt that behaviour+but when working with realtime streams+that may mean that the chunks are very small.+-}+hGetContentsAsync :: Storable a =>+   ChunkSize -> Handle -> IO (IOError, Vector a)+hGetContentsAsync (ChunkSize size) h =+   let go =+          unsafeInterleaveIO $+          flip catch (\err -> return (err,[])) $+          do v <- V.hGet h size+             if V.null v+               then hClose h >>+                    return (Exc.mkIOError Exc.eofErrorType+                      "StorableVector.Lazy.hGetContentsAsync" (Just h) Nothing, [])+               else liftM (\ ~(err,rest) -> (err, v:rest)) go+{-+          unsafeInterleaveIO $+          flip catch (\err -> return (err,[])) $+          liftM2 (\ chunk ~(err,rest) -> (err,chunk:rest))+             (V.hGet h size) go+-}+   in  fmap (mapSnd SV) go++{-+hGetContentsSync :: Storable a =>+   ChunkSize -> Handle -> IO (IOError, 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+-}++hPut :: Storable a => Handle -> Vector a -> IO ()+hPut h = mapM_ (V.hPut h) . chunks++{-+*Data.StorableVector.Lazy> print . mapSnd (length :: Vector Data.Int.Int16 -> Int) =<< readFileAsync (ChunkSize 1000) "dist/build/libHSstorablevector-0.1.3.a"+(dist/build/libHSstorablevector-0.1.3.a: hGetBuf: illegal operation (handle is closed),0)+-}+{- |+The file can only closed after all values are consumed.+That is you must always assert that you consume all elements of the stream,+and that no values are missed due to lazy evaluation.+This requirement makes this function useless in many applications.+-}+readFileAsync :: Storable a => ChunkSize -> FilePath -> IO (IOError, Vector a)+readFileAsync size path =+   openBinaryFile path ReadMode >>= hGetContentsAsync size++writeFile :: Storable a => FilePath -> Vector a -> IO ()+writeFile path =+   bracket (openBinaryFile path WriteMode) hClose . flip hPut++appendFile :: Storable a => FilePath -> Vector a -> IO ()+appendFile path =+   bracket (openBinaryFile path AppendMode) hClose . flip hPut+-}
Data/StorableVector/ST/Lazy.hs view
@@ -15,8 +15,10 @@         new_,         read,         write,+        modify,         freeze,         thaw,+        VST.length,         runSTVector,         mapST,         mapSTLazy,@@ -37,7 +39,7 @@ import Foreign.Storable         (Storable)  -- import Prelude (Int, ($), (+), return, const, )-import Prelude hiding (read, )+import Prelude hiding (read, length, )   @@ -45,8 +47,10 @@ {-# INLINE new_ #-} {-# INLINE read #-} {-# INLINE write #-}+{-# INLINE modify #-} {-# INLINE freeze #-} {-# INLINE thaw #-}+{-# ONLINE length #-} {-# INLINE runSTVector #-} {-# INLINE mapST #-} {-# INLINE mapSTLazy #-}@@ -76,6 +80,10 @@    Vector s e -> Int -> e -> ST s () write xs n x = ST.strictToLazyST (VST.write xs n x) +modify :: (Storable e) =>+   Vector s e -> Int -> (e -> e) -> ST s ()+modify xs n f = ST.strictToLazyST (VST.modify xs n f)+ freeze :: (Storable e) =>    Vector s e -> ST s (VS.Vector e) freeze xs = ST.strictToLazyST (VST.freeze xs)@@ -83,6 +91,7 @@ thaw :: (Storable e) =>    VS.Vector e -> ST s (Vector s e) thaw xs = ST.strictToLazyST (VST.thaw xs)+   runSTVector :: (Storable e) =>
Data/StorableVector/ST/Strict.hs view
@@ -15,8 +15,10 @@         new_,         read,         write,+        modify,         freeze,         thaw,+        length,         runSTVector,         mapST,         mapSTLazy,@@ -29,77 +31,129 @@ import qualified Control.Monad.ST.Strict as ST import Control.Monad.ST.Strict (ST, unsafeIOToST, runST, )  -- stToIO, -import Foreign.ForeignPtr       (withForeignPtr, unsafeForeignPtrToPtr, )-import Foreign.Storable         (Storable(peek, poke, pokeElemOff))-import Foreign.Marshal.Array    (advancePtr, )+import Foreign.Ptr              (Ptr, )+import Foreign.ForeignPtr       (ForeignPtr, withForeignPtr, mallocForeignPtrArray, unsafeForeignPtrToPtr, )+import Foreign.Storable         (Storable(peek, poke))+import Foreign.Marshal.Array    (advancePtr, copyArray, ) -- import System.IO.Unsafe         (unsafePerformIO)  -- import Prelude (Int, ($), (+), return, const, )-import Prelude hiding (read, )+import Prelude hiding (read, length, )  -newtype Vector s e = SV {vector :: V.Vector e}+data Vector s a =+   SV {-# UNPACK #-} !(ForeignPtr a)+      {-# UNPACK #-} !Int                -- length   {-# INLINE new #-} {-# INLINE new_ #-} {-# INLINE read #-} {-# INLINE write #-}+{-# INLINE modify #-} {-# INLINE freeze #-} {-# INLINE thaw #-}+{-# INLINE length #-} {-# INLINE runSTVector #-} {-# INLINE mapST #-} {-# INLINE mapSTLazy #-}  +-- * helper functions++-- | Wrapper of mallocForeignPtrArray.+create :: (Storable a) => Int -> (Ptr a -> IO ()) -> IO (Vector s a)+create l f = do+    fp <- mallocForeignPtrArray l+    withForeignPtr fp f+    return $! SV fp l++{-# INLINE unsafeCreate #-}+unsafeCreate :: (Storable a) => Int -> (Ptr a -> IO ()) -> ST s (Vector s a)+unsafeCreate l f = unsafeIOToST $ create l f++{-# INLINE unsafeToVector #-}+unsafeToVector :: Vector s a -> V.Vector a+unsafeToVector (SV x l) = V.SV x 0 l++ -- * access to mutable storable vector  new :: (Storable e) =>    Int -> e -> ST s (Vector s e)-new n x = return (SV (VS.replicate n x))+new n x =+   unsafeCreate n $+   let {-# INLINE go #-}+       go m p =+         if m>0+           then poke p x >> go (pred m) (p `advancePtr` 1)+           else return ()+   in  go n  new_ :: (Storable e) =>    Int -> ST s (Vector s e)-new_  =  fmap SV . newVec_+new_ n =+   unsafeCreate n (const (return ())) -{-# INLINE newVec_ #-}-newVec_ :: (Storable e) =>-   Int -> ST s (VS.Vector e)-newVec_ n =-   -- return (V.unsafeCreate n (const (return ())))-   unsafeIOToST $ V.create n (const (return ()))  {- | > Control.Monad.ST.runST (do arr <- new_ 10; Monad.zipWithM_ (write arr) [9,8..0] ['a'..]; read arr 3) -} read :: (Storable e) =>    Vector s e -> Int -> ST s e-read (SV xs) n = return (VS.index xs n)+read v n =+   access "read" v n $ peek  {- | > VS.unpack $ runSTVector (do arr <- new_ 10; Monad.zipWithM_ (write arr) [9,8..0] ['a'..]; return arr) -} write :: (Storable e) =>    Vector s e -> Int -> e -> ST s ()-write (SV (V.SV v s l)) n x =+write v n x =+   access "write" v n $ \p -> poke p x++{- |+> VS.unpack $ runSTVector (do arr <- new 10 'a'; Monad.mapM_ (\n -> modify arr (mod n 8) succ) [0..10]; return arr)+-}+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++{-# INLINE access #-}+access :: (Storable e) =>+   String -> Vector s e -> Int -> (Ptr e -> IO a) -> ST s a+access name (SV v l) n act =    if 0<=n && n<l-     then unsafeIOToST (withForeignPtr v $ \p -> pokeElemOff p (s+n) x)-     else error "StorableVector.ST.Strict.write: index out of range"+     then unsafeIOToST (withForeignPtr v $ \p -> act (advancePtr p n))+     else error ("StorableVector.ST." ++ name ++ ": index out of range")  freeze :: (Storable e) =>    Vector s e -> ST s (VS.Vector e)-freeze (SV xs) = return (VS.copy xs)+freeze (SV x l) =+   unsafeIOToST $+   V.create l $ \p ->+   withForeignPtr x $ \f ->+   copyArray p f (fromIntegral l) + thaw :: (Storable e) =>    VS.Vector e -> ST s (Vector s e)-thaw xs = return (SV (VS.copy xs))+thaw (V.SV x s l) =+   unsafeCreate l $ \p ->+   withForeignPtr x $ \f ->+   copyArray p (f `advancePtr` s) (fromIntegral l)  +length ::+   Vector s e -> Int+length (SV _v l) = l++ runSTVector :: (Storable e) =>    (forall s. ST s (Vector s e)) -> VS.Vector e runSTVector m =-   runST (fmap vector m)---   vector (unsafePerformIO (stToIO m))+   runST (fmap unsafeToVector m)   @@ -119,11 +173,11 @@                do unsafeIOToST . poke p =<< f =<< unsafeIOToST (peek q)                   go (pred l) (advancePtr q 1) (advancePtr p 1)             else return ()-   in  do ys@(V.SV py sy _) <- newVec_ n+   in  do ys@(SV py _) <- new_ n           go n-              (advancePtr (unsafeForeignPtrToPtr px) sx)-              (advancePtr (unsafeForeignPtrToPtr py) sy)-          return ys+              (unsafeForeignPtrToPtr px `advancePtr` sx)+              (unsafeForeignPtrToPtr py)+          return $! unsafeToVector ys  {- mapST f xs@(V.SV v s l) =
Data/StorableVector/Utility.hs view
@@ -40,3 +40,7 @@ toMaybe :: Bool -> a -> Maybe a toMaybe False _ = Nothing toMaybe True  x = Just x++{-# INLINE swap #-}+swap :: (a,b) -> (b,a)+swap (a,b) = (b,a)
storablevector.cabal view
@@ -1,5 +1,5 @@ Name:                storablevector-Version:             0.2+Version:             0.2.1 Category:            Data Synopsis:            Fast, packed, strict storable arrays with a list interface like ByteString Description:@@ -49,6 +49,9 @@     Data.StorableVector.ST.Lazy    Other-Modules:+    -- LazySize and LazyVarying have no mature interface so far+    Data.StorableVector.LazySize+    Data.StorableVector.LazyVarying     -- Cursor has no mature interface so far     Data.StorableVector.Cursor     Data.StorableVector.Memory