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 67d0416..dedb822 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
@@ -283,11 +286,13 @@ foldVectorWithIndex f x v = unsafePerformIO $
283 go (dim v -1) x 286 go (dim v -1) x
284{-# INLINE foldVectorWithIndex #-} 287{-# INLINE foldVectorWithIndex #-}
285 288
289foldLoop :: (Int -> t -> t) -> t -> Int -> t
286foldLoop f s0 d = go (d - 1) s0 290foldLoop f s0 d = go (d - 1) s0
287 where 291 where
288 go 0 s = f (0::Int) s 292 go 0 s = f (0::Int) s
289 go !j !s = go (j - 1) (f j s) 293 go !j !s = go (j - 1) (f j s)
290 294
295foldVectorG :: Storable t1 => (Int -> (Int -> t1) -> t -> t) -> t -> Vector t1 -> t
291foldVectorG f s0 v = foldLoop g s0 (dim v) 296foldVectorG f s0 v = foldLoop g s0 (dim v)
292 where g !k !s = f k (safeRead v . flip peekElemOff) s 297 where g !k !s = f k (safeRead v . flip peekElemOff) s
293 {-# INLINE g #-} -- Thanks to Ryan Ingram (http://permalink.gmane.org/gmane.comp.lang.haskell.cafe/46479) 298 {-# INLINE g #-} -- Thanks to Ryan Ingram (http://permalink.gmane.org/gmane.comp.lang.haskell.cafe/46479)
@@ -390,8 +395,10 @@ chunks d = let c = d `div` chunk
390 m = d `mod` chunk 395 m = d `mod` chunk
391 in if m /= 0 then reverse (m:(replicate c chunk)) else (replicate c chunk) 396 in if m /= 0 then reverse (m:(replicate c chunk)) else (replicate c chunk)
392 397
398putVector :: (Storable t, Binary t) => Vector t -> Data.Binary.Put.PutM ()
393putVector v = mapM_ put $! toList v 399putVector v = mapM_ put $! toList v
394 400
401getVector :: (Storable a, Binary a) => Int -> Get (Vector a)
395getVector d = do 402getVector d = do
396 xs <- replicateM d get 403 xs <- replicateM d get
397 return $! fromList xs 404 return $! fromList xs