vector 0.9 → 0.9.1
raw patch · 8 files changed
+178/−66 lines, 8 filesdep +ghc-prim
Dependencies added: ghc-prim
Files
- Data/Vector/Fusion/Stream/Monadic.hs +16/−11
- Data/Vector/Internal/Check.hs +70/−29
- Data/Vector/Storable.hs +36/−2
- Data/Vector/Storable/Mutable.hs +38/−2
- benchmarks/vector-benchmarks.cabal +2/−2
- include/vector.h +3/−15
- tests/vector-tests.cabal +3/−3
- vector.cabal +10/−2
Data/Vector/Fusion/Stream/Monadic.hs view
@@ -104,7 +104,12 @@ {-# ANN type SPEC ForceSpecConstr #-} #endif +emptyStream :: String+{-# NOINLINE emptyStream #-}+emptyStream = "empty stream" +#define EMPTY_STREAM (\s -> ERROR s emptyStream)+ -- | Result of taking a single step in a stream data Step s a = Yield a s -- ^ a new element and a new seed | Skip s -- ^ just a new seed@@ -230,7 +235,7 @@ case r of Yield x _ -> return x Skip s' -> head_loop SPEC s'- Done -> BOUNDS_ERROR(emptyStream) "head"+ Done -> EMPTY_STREAM "head" @@ -245,7 +250,7 @@ case r of Yield x s' -> last_loop1 SPEC x s' Skip s' -> last_loop0 SPEC s'- Done -> BOUNDS_ERROR(emptyStream) "last"+ Done -> EMPTY_STREAM "last" last_loop1 !sPEC x s = do@@ -259,7 +264,7 @@ -- | Element at the given position (!!) :: Monad m => Stream m a -> Int -> m a {-# INLINE (!!) #-}-Stream step s _ !! i | i < 0 = BOUNDS_ERROR(error) "!!" "negative index"+Stream step s _ !! i | i < 0 = ERROR "!!" "negative index" | otherwise = index_loop SPEC s i where index_loop !sPEC s i@@ -270,7 +275,7 @@ Yield x s' | i == 0 -> return x | otherwise -> index_loop SPEC s' (i-1) Skip s' -> index_loop SPEC s' i- Done -> BOUNDS_ERROR(emptyStream) "!!"+ Done -> EMPTY_STREAM "!!" infixl 9 !? -- | Element at the given position or 'Nothing' if out of bounds@@ -309,7 +314,7 @@ case r of Yield x s' -> Skip (Just x, s') Skip s' -> Skip (Nothing, s')- Done -> BOUNDS_ERROR(emptyStream) "init"+ Done -> EMPTY_STREAM "init" ) (step s) step' (Just x, s) = liftM (\r -> @@ -329,7 +334,7 @@ case r of Yield x s' -> Skip (Right s') Skip s' -> Skip (Left s')- Done -> BOUNDS_ERROR(emptyStream) "tail"+ Done -> EMPTY_STREAM "tail" ) (step s) step' (Right s) = liftM (\r ->@@ -797,7 +802,7 @@ case r of Yield x s' -> foldlM f x (Stream step s' (sz - 1)) Skip s' -> foldl1M_loop SPEC s'- Done -> BOUNDS_ERROR(emptyStream) "foldl1M"+ Done -> EMPTY_STREAM "foldl1M" -- | Same as 'foldl1M' fold1M :: Monad m => (a -> a -> m a) -> Stream m a -> m a@@ -845,7 +850,7 @@ case r of Yield x s' -> foldlM' f x (Stream step s' (sz - 1)) Skip s' -> foldl1M'_loop SPEC s'- Done -> BOUNDS_ERROR(emptyStream) "foldl1M'"+ Done -> EMPTY_STREAM "foldl1M'" -- | Same as 'foldl1M'' fold1M' :: Monad m => (a -> a -> m a) -> Stream m a -> m a@@ -886,7 +891,7 @@ case r of Yield x s' -> foldr1M_loop1 SPEC x s' Skip s' -> foldr1M_loop0 SPEC s'- Done -> BOUNDS_ERROR(emptyStream) "foldr1M"+ Done -> EMPTY_STREAM "foldr1M" foldr1M_loop1 !sPEC x s = do@@ -1147,7 +1152,7 @@ case r of Yield x s' -> return $ Yield x (s', Just x) Skip s' -> return $ Skip (s', Nothing)- Done -> BOUNDS_ERROR(emptyStream) "scanl1M"+ Done -> EMPTY_STREAM "scanl1M" step' (s, Just x) = do r <- step s@@ -1175,7 +1180,7 @@ case r of Yield x s' -> x `seq` return (Yield x (s', Just x)) Skip s' -> return $ Skip (s', Nothing)- Done -> BOUNDS_ERROR(emptyStream) "scanl1M"+ Done -> EMPTY_STREAM "scanl1M" step' (s, Just x) = x `seq` do
Data/Vector/Internal/Check.hs view
@@ -10,16 +10,42 @@ -- Bounds checking infrastructure -- +{-# LANGUAGE MagicHash #-}+ module Data.Vector.Internal.Check ( Checks(..), doChecks, - error, emptyStream,- check, assert, checkIndex, checkLength, checkSlice+ error, internalError,+ check, checkIndex, checkLength, checkSlice ) where -import Prelude hiding( error )+import GHC.Base( Int(..) )+import GHC.Prim( Int# )+import Prelude hiding( error, (&&), (||), not ) import qualified Prelude as P +-- NOTE: This is a workaround for GHC's weird behaviour where it doesn't inline+-- these functions into unfoldings which makes the intermediate code size+-- explode. See http://hackage.haskell.org/trac/ghc/ticket/5539.+infixr 2 ||+infixr 3 &&++not :: Bool -> Bool+{-# INLINE not #-}+not True = False+not False = True++(&&) :: Bool -> Bool -> Bool+{-# INLINE (&&) #-}+False && x = False+True && x = x++(||) :: Bool -> Bool -> Bool+{-# INLINE (||) #-}+True || x = True+False || x = x++ data Checks = Bounds | Unsafe | Internal deriving( Eq ) doBoundsChecks :: Bool@@ -50,37 +76,44 @@ doChecks Unsafe = doUnsafeChecks doChecks Internal = doInternalChecks -error :: String -> Int -> Checks -> String -> String -> a-error file line kind loc msg- = P.error $ unlines $- (if kind == Internal- then (["*** Internal error in package vector ***"- ,"*** Please submit a bug report at http://trac.haskell.org/vector"]++)- else id) $- [ file ++ ":" ++ show line ++ " (" ++ loc ++ "): " ++ msg ]+error_msg :: String -> Int -> String -> String -> String+error_msg file line loc msg = file ++ ":" ++ show line ++ " (" ++ loc ++ "): " ++ msg -emptyStream :: String -> Int -> Checks -> String -> a-{-# NOINLINE emptyStream #-}-emptyStream file line kind loc- = error file line kind loc "empty stream"+error :: String -> Int -> String -> String -> a+{-# NOINLINE error #-}+error file line loc msg+ = P.error $ error_msg file line loc msg +internalError :: String -> Int -> String -> String -> a+{-# NOINLINE internalError #-}+internalError file line loc msg+ = P.error $ unlines+ ["*** Internal error in package vector ***"+ ,"*** Please submit a bug report at http://trac.haskell.org/vector"+ ,error_msg file line loc msg]+++checkError :: String -> Int -> Checks -> String -> String -> a+{-# NOINLINE checkError #-}+checkError file line kind loc msg+ = case kind of+ Internal -> internalError file line loc msg+ _ -> error file line loc msg+ check :: String -> Int -> Checks -> String -> String -> Bool -> a -> a {-# INLINE check #-} check file line kind loc msg cond x | not (doChecks kind) || cond = x- | otherwise = error file line kind loc msg--assert_msg :: String-assert_msg = "assertion failure"--assert :: String -> Int -> Checks -> String -> Bool -> a -> a-{-# INLINE assert #-}-assert file line kind loc = check file line kind loc assert_msg+ | otherwise = checkError file line kind loc msg checkIndex_msg :: Int -> Int -> String-{-# NOINLINE checkIndex_msg #-}-checkIndex_msg i n = "index out of bounds " ++ show (i,n)+{-# INLINE checkIndex_msg #-}+checkIndex_msg (I# i#) (I# n#) = checkIndex_msg# i# n# +checkIndex_msg# :: Int# -> Int# -> String+{-# NOINLINE checkIndex_msg# #-}+checkIndex_msg# i# n# = "index out of bounds " ++ show (I# i#, I# n#)+ checkIndex :: String -> Int -> Checks -> String -> Int -> Int -> a -> a {-# INLINE checkIndex #-} checkIndex file line kind loc i n x@@ -88,9 +121,13 @@ checkLength_msg :: Int -> String-{-# NOINLINE checkLength_msg #-}-checkLength_msg n = "negative length " ++ show n+{-# INLINE checkLength_msg #-}+checkLength_msg (I# n#) = checkLength_msg# n# +checkLength_msg# :: Int# -> String+{-# NOINLINE checkLength_msg# #-}+checkLength_msg# n# = "negative length " ++ show (I# n#)+ checkLength :: String -> Int -> Checks -> String -> Int -> a -> a {-# INLINE checkLength #-} checkLength file line kind loc n x@@ -98,8 +135,12 @@ checkSlice_msg :: Int -> Int -> Int -> String-{-# NOINLINE checkSlice_msg #-}-checkSlice_msg i m n = "invalid slice " ++ show (i,m,n)+{-# INLINE checkSlice_msg #-}+checkSlice_msg (I# i#) (I# m#) (I# n#) = checkSlice_msg# i# m# n#++checkSlice_msg# :: Int# -> Int# -> Int# -> String+{-# NOINLINE checkSlice_msg# #-}+checkSlice_msg# i# m# n# = "invalid slice " ++ show (I# i#, I# m#, I# n#) checkSlice :: String -> Int -> Checks -> String -> Int -> Int -> Int -> a -> a {-# INLINE checkSlice #-}
Data/Vector/Storable.hs view
@@ -131,7 +131,9 @@ freeze, thaw, copy, unsafeFreeze, unsafeThaw, unsafeCopy, -- * Raw pointers- unsafeFromForeignPtr, unsafeToForeignPtr, unsafeWith+ unsafeFromForeignPtr, unsafeFromForeignPtr0,+ unsafeToForeignPtr, unsafeToForeignPtr0,+ unsafeWith ) where import qualified Data.Vector.Generic as G@@ -1359,20 +1361,52 @@ -- -------------------------- -- | /O(1)/ Create a vector from a 'ForeignPtr' with an offset and a length.+-- -- The data may not be modified through the 'ForeignPtr' afterwards.+--+-- If your offset is 0 it is more efficient to use 'unsafeFromForeignPtr0'. unsafeFromForeignPtr :: Storable a => ForeignPtr a -- ^ pointer -> Int -- ^ offset -> Int -- ^ length -> Vector a {-# INLINE unsafeFromForeignPtr #-}-unsafeFromForeignPtr fp i n = Vector n (updPtr (`advancePtr` i) fp)+unsafeFromForeignPtr fp i n = unsafeFromForeignPtr0 fp' n+ where+ fp' = updPtr (`advancePtr` i) fp +{-# RULES+"unsafeFromForeignPtr fp 0 n -> unsafeFromForeignPtr0 fp n " forall fp n.+ unsafeFromForeignPtr fp 0 n = unsafeFromForeignPtr0 fp n+ #-}++-- | /O(1)/ Create a vector from a 'ForeignPtr' and a length.+--+-- It is assumed the pointer points directly to the data (no offset).+-- Use `unsafeFromForeignPtr` if you need to specify an offset.+--+-- The data may not be modified through the 'ForeignPtr' afterwards.+unsafeFromForeignPtr0 :: Storable a+ => ForeignPtr a -- ^ pointer+ -> Int -- ^ length+ -> Vector a+{-# INLINE unsafeFromForeignPtr0 #-}+unsafeFromForeignPtr0 fp n = Vector n fp+ -- | /O(1)/ Yield the underlying 'ForeignPtr' together with the offset to the -- data and its length. The data may not be modified through the 'ForeignPtr'. unsafeToForeignPtr :: Storable a => Vector a -> (ForeignPtr a, Int, Int) {-# INLINE unsafeToForeignPtr #-} unsafeToForeignPtr (Vector n fp) = (fp, 0, n)++-- | /O(1)/ Yield the underlying 'ForeignPtr' together with its length.+--+-- You can assume the pointer points directly to the data (no offset).+--+-- The data may not be modified through the 'ForeignPtr'.+unsafeToForeignPtr0 :: Storable a => Vector a -> (ForeignPtr a, Int)+{-# INLINE unsafeToForeignPtr0 #-}+unsafeToForeignPtr0 (Vector n fp) = (fp, n) -- | Pass a pointer to the vector's data to the IO action. The data may not be -- modified through the 'Ptr.
Data/Vector/Storable/Mutable.hs view
@@ -52,7 +52,9 @@ unsafeCast, -- * Raw pointers- unsafeFromForeignPtr, unsafeToForeignPtr, unsafeWith+ unsafeFromForeignPtr, unsafeFromForeignPtr0,+ unsafeToForeignPtr, unsafeToForeignPtr0,+ unsafeWith ) where import qualified Data.Vector.Generic.Mutable as G@@ -386,22 +388,56 @@ -- ------------ -- | Create a mutable vector from a 'ForeignPtr' with an offset and a length.+-- -- Modifying data through the 'ForeignPtr' afterwards is unsafe if the vector -- could have been frozen before the modification.+--+-- If your offset is 0 it is more efficient to use 'unsafeFromForeignPtr0'. unsafeFromForeignPtr :: Storable a => ForeignPtr a -- ^ pointer -> Int -- ^ offset -> Int -- ^ length -> MVector s a {-# INLINE unsafeFromForeignPtr #-}-unsafeFromForeignPtr fp i n = MVector n (updPtr (`advancePtr` i) fp)+unsafeFromForeignPtr fp i n = unsafeFromForeignPtr0 fp' n+ where+ fp' = updPtr (`advancePtr` i) fp +{-# RULES+"unsafeFromForeignPtr fp 0 n -> unsafeFromForeignPtr0 fp n " forall fp n.+ unsafeFromForeignPtr fp 0 n = unsafeFromForeignPtr0 fp n+ #-}++-- | /O(1)/ Create a mutable vector from a 'ForeignPtr' and a length.+--+-- It is assumed the pointer points directly to the data (no offset).+-- Use `unsafeFromForeignPtr` if you need to specify an offset.+--+-- Modifying data through the 'ForeignPtr' afterwards is unsafe if the vector+-- could have been frozen before the modification.+unsafeFromForeignPtr0 :: Storable a+ => ForeignPtr a -- ^ pointer+ -> Int -- ^ length+ -> MVector s a+{-# INLINE unsafeFromForeignPtr0 #-}+unsafeFromForeignPtr0 fp n = MVector n fp+ -- | Yield the underlying 'ForeignPtr' together with the offset to the data -- and its length. Modifying the data through the 'ForeignPtr' is -- unsafe if the vector could have frozen before the modification. unsafeToForeignPtr :: Storable a => MVector s a -> (ForeignPtr a, Int, Int) {-# INLINE unsafeToForeignPtr #-} unsafeToForeignPtr (MVector n fp) = (fp, 0, n)++-- | /O(1)/ Yield the underlying 'ForeignPtr' together with its length.+--+-- You can assume the pointer points directly to the data (no offset).+--+-- Modifying the data through the 'ForeignPtr' is unsafe if the vector could+-- have frozen before the modification.+unsafeToForeignPtr0 :: Storable a => MVector s a -> (ForeignPtr a, Int)+{-# INLINE unsafeToForeignPtr0 #-}+unsafeToForeignPtr0 (MVector n fp) = (fp, n) -- | Pass a pointer to the vector's data to the IO action. Modifying data -- through the pointer is unsafe if the vector could have been frozen before
benchmarks/vector-benchmarks.cabal view
@@ -1,5 +1,5 @@ Name: vector-benchmarks-Version: 0.8+Version: 0.9.1 License: BSD3 License-File: LICENSE Author: Roman Leshchinskiy <rl@cse.unsw.edu.au>@@ -14,7 +14,7 @@ Build-Depends: base >= 2 && < 5, array, criterion >= 0.5 && < 0.6, mwc-random >= 0.5 && < 0.11,- vector == 0.8+ vector == 0.9.1 if impl(ghc<6.13) Ghc-Options: -finline-if-enough-args -fno-method-sharing
include/vector.h view
@@ -8,24 +8,12 @@ import qualified Data.Vector.Internal.Check as Ck #endif -#define ERROR(f) (Ck.f __FILE__ __LINE__)-#define ASSERT (Ck.assert __FILE__ __LINE__)-#define ENSURE (Ck.f __FILE__ __LINE__)-#define CHECK(f) (Ck.f __FILE__ __LINE__)+#define ERROR (Ck.error __FILE__ __LINE__)+#define INTERNAL_ERROR (Ck.internalError __FILE__ __LINE__) -#define BOUNDS_ERROR(f) (ERROR(f) Ck.Bounds)-#define BOUNDS_ASSERT (ASSERT Ck.Bounds)-#define BOUNDS_ENSURE (ENSURE Ck.Bounds)+#define CHECK(f) (Ck.f __FILE__ __LINE__) #define BOUNDS_CHECK(f) (CHECK(f) Ck.Bounds)--#define UNSAFE_ERROR(f) (ERROR(f) Ck.Unsafe)-#define UNSAFE_ASSERT (ASSERT Ck.Unsafe)-#define UNSAFE_ENSURE (ENSURE Ck.Unsafe) #define UNSAFE_CHECK(f) (CHECK(f) Ck.Unsafe)--#define INTERNAL_ERROR(f) (ERROR(f) Ck.Internal)-#define INTERNAL_ASSERT (ASSERT Ck.Internal)-#define INTERNAL_ENSURE (ENSURE Ck.Internal) #define INTERNAL_CHECK(f) (CHECK(f) Ck.Internal)
tests/vector-tests.cabal view
@@ -1,5 +1,5 @@ Name: vector-tests-Version: 0.8+Version: 0.9.1 License: BSD3 License-File: LICENSE Author: Max Bolingbroke, Roman Leshchinskiy@@ -18,7 +18,7 @@ Executable "vector-tests-O0" Main-Is: Main.hs - Build-Depends: base >= 4 && < 5, template-haskell, vector == 0.8,+ Build-Depends: base >= 4 && < 5, template-haskell, vector == 0.9.1, random, QuickCheck >= 2, test-framework, test-framework-quickcheck2 @@ -38,7 +38,7 @@ Executable "vector-tests-O2" Main-Is: Main.hs - Build-Depends: base >= 4 && < 5, template-haskell, vector == 0.8,+ Build-Depends: base >= 4 && < 5, template-haskell, vector == 0.9.1, random, QuickCheck >= 2, test-framework, test-framework-quickcheck2
vector.cabal view
@@ -1,5 +1,5 @@ Name: vector-Version: 0.9+Version: 0.9.1 License: BSD3 License-File: LICENSE Author: Roman Leshchinskiy <rl@cse.unsw.edu.au>@@ -41,6 +41,14 @@ . * <http://trac.haskell.org/vector> .+ Changes in version 0.9.1+ .+ * New functions: @unsafeFromForeignPtr0@ and @unsafeToForeignPtr0@+ .+ * Small performance improvements+ .+ * Fixes for GHC 7.4+ . Changes in version 0.9 . * 'MonadPlus' instance for boxed vectors@@ -162,7 +170,7 @@ Install-Includes: vector.h - Build-Depends: base >= 4 && < 5, primitive >= 0.4.0.1 && < 0.5+ Build-Depends: base >= 4 && < 5, primitive >= 0.4.0.1 && < 0.5, ghc-prim if impl(ghc<6.13) Ghc-Options: -finline-if-enough-args -fno-method-sharing