diff options
Diffstat (limited to 'packages/base/src/Internal/Vector.hs')
-rw-r--r-- | packages/base/src/Internal/Vector.hs | 7 |
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 | |||
40 | import Data.Vector.Storable(Vector, fromList, unsafeToForeignPtr, unsafeFromForeignPtr, unsafeWith) | 41 | import Data.Vector.Storable(Vector, fromList, unsafeToForeignPtr, unsafeFromForeignPtr, unsafeWith) |
41 | 42 | ||
42 | import Data.Binary | 43 | import Data.Binary |
44 | import Data.Binary.Put | ||
43 | import Control.Monad(replicateM) | 45 | import Control.Monad(replicateM) |
44 | import qualified Data.ByteString.Internal as BS | 46 | import qualified Data.ByteString.Internal as BS |
45 | import Data.Vector.Storable.Internal(updPtr) | 47 | import Data.Vector.Storable.Internal(updPtr) |
@@ -92,6 +94,7 @@ createVector n = do | |||
92 | 94 | ||
93 | -} | 95 | -} |
94 | 96 | ||
97 | safeRead :: Storable a => Vector a -> (Ptr a -> IO c) -> c | ||
95 | safeRead v = inlinePerformIO . unsafeWith v | 98 | safeRead 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 | ||
293 | foldLoop :: (Int -> t -> t) -> t -> Int -> t | ||
290 | foldLoop f s0 d = go (d - 1) s0 | 294 | foldLoop 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 | ||
299 | foldVectorG :: Storable t1 => (Int -> (Int -> t1) -> t -> t) -> t -> Vector t1 -> t | ||
295 | foldVectorG f s0 v = foldLoop g s0 (dim v) | 300 | foldVectorG 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 | ||
402 | putVector :: (Storable t, Binary t) => Vector t -> Data.Binary.Put.PutM () | ||
397 | putVector v = mapM_ put $! toList v | 403 | putVector v = mapM_ put $! toList v |
398 | 404 | ||
405 | getVector :: (Storable a, Binary a) => Int -> Get (Vector a) | ||
399 | getVector d = do | 406 | getVector d = do |
400 | xs <- replicateM d get | 407 | xs <- replicateM d get |
401 | return $! fromList xs | 408 | return $! fromList xs |