summaryrefslogtreecommitdiff
path: root/packages/base/src/Internal/Vector.hs
diff options
context:
space:
mode:
Diffstat (limited to 'packages/base/src/Internal/Vector.hs')
-rw-r--r--packages/base/src/Internal/Vector.hs7
1 files changed, 7 insertions, 0 deletions
diff --git a/packages/base/src/Internal/Vector.hs b/packages/base/src/Internal/Vector.hs
index e1e4aa8..6271bb6 100644
--- a/packages/base/src/Internal/Vector.hs
+++ b/packages/base/src/Internal/Vector.hs
@@ -1,6 +1,7 @@
1{-# LANGUAGE MagicHash, UnboxedTuples, BangPatterns, FlexibleContexts #-} 1{-# LANGUAGE MagicHash, UnboxedTuples, BangPatterns, FlexibleContexts #-}
2{-# LANGUAGE TypeSynonymInstances #-} 2{-# LANGUAGE TypeSynonymInstances #-}
3 3
4{-# OPTIONS_GHC -fno-warn-orphans #-}
4 5
5-- | 6-- |
6-- Module : Internal.Vector 7-- Module : Internal.Vector
@@ -40,6 +41,7 @@ import qualified Data.Vector.Storable as Vector
40import Data.Vector.Storable(Vector, fromList, unsafeToForeignPtr, unsafeFromForeignPtr, unsafeWith) 41import Data.Vector.Storable(Vector, fromList, unsafeToForeignPtr, unsafeFromForeignPtr, unsafeWith)
41 42
42import Data.Binary 43import Data.Binary
44import Data.Binary.Put
43import Control.Monad(replicateM) 45import Control.Monad(replicateM)
44import qualified Data.ByteString.Internal as BS 46import qualified Data.ByteString.Internal as BS
45import Data.Vector.Storable.Internal(updPtr) 47import Data.Vector.Storable.Internal(updPtr)
@@ -92,6 +94,7 @@ createVector n = do
92 94
93-} 95-}
94 96
97safeRead :: Storable a => Vector a -> (Ptr a -> IO c) -> c
95safeRead v = inlinePerformIO . unsafeWith v 98safeRead v = inlinePerformIO . unsafeWith v
96{-# INLINE safeRead #-} 99{-# INLINE safeRead #-}
97 100
@@ -287,11 +290,13 @@ foldVectorWithIndex f x v = unsafePerformIO $
287 go (dim v -1) x 290 go (dim v -1) x
288{-# INLINE foldVectorWithIndex #-} 291{-# INLINE foldVectorWithIndex #-}
289 292
293foldLoop :: (Int -> t -> t) -> t -> Int -> t
290foldLoop f s0 d = go (d - 1) s0 294foldLoop f s0 d = go (d - 1) s0
291 where 295 where
292 go 0 s = f (0::Int) s 296 go 0 s = f (0::Int) s
293 go !j !s = go (j - 1) (f j s) 297 go !j !s = go (j - 1) (f j s)
294 298
299foldVectorG :: Storable t1 => (Int -> (Int -> t1) -> t -> t) -> t -> Vector t1 -> t
295foldVectorG f s0 v = foldLoop g s0 (dim v) 300foldVectorG f s0 v = foldLoop g s0 (dim v)
296 where g !k !s = f k (safeRead v . flip peekElemOff) s 301 where g !k !s = f k (safeRead v . flip peekElemOff) s
297 {-# INLINE g #-} -- Thanks to Ryan Ingram (http://permalink.gmane.org/gmane.comp.lang.haskell.cafe/46479) 302 {-# INLINE g #-} -- Thanks to Ryan Ingram (http://permalink.gmane.org/gmane.comp.lang.haskell.cafe/46479)
@@ -394,8 +399,10 @@ chunks d = let c = d `div` chunk
394 m = d `mod` chunk 399 m = d `mod` chunk
395 in if m /= 0 then reverse (m:(replicate c chunk)) else (replicate c chunk) 400 in if m /= 0 then reverse (m:(replicate c chunk)) else (replicate c chunk)
396 401
402putVector :: (Storable t, Binary t) => Vector t -> Data.Binary.Put.PutM ()
397putVector v = mapM_ put $! toList v 403putVector v = mapM_ put $! toList v
398 404
405getVector :: (Storable a, Binary a) => Int -> Get (Vector a)
399getVector d = do 406getVector d = do
400 xs <- replicateM d get 407 xs <- replicateM d get
401 return $! fromList xs 408 return $! fromList xs