summaryrefslogtreecommitdiff
path: root/packages/base/src/Internal/Vector.hs
diff options
context:
space:
mode:
authoridontgetoutmuch <dominic@steinitz.org>2018-04-01 05:43:38 -0700
committerGitHub <noreply@github.com>2018-04-01 05:43:38 -0700
commitc8c6a3e414bb08e3f818f58c121ddc99396b4f1e (patch)
treedaf3add31de83efcc74b41755c2d05c811242ce6 /packages/base/src/Internal/Vector.hs
parentd83b17190029c11e3ab8b504e5cdc917f5863120 (diff)
parent1a68793247b8845cefad4d157e4f4d25b1731b42 (diff)
Merge pull request #262 from idontgetoutmuch/master
Implement CI
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