Repository : ssh://darcs.haskell.org//srv/darcs/packages/vector On branch : master
http://hackage.haskell.org/trac/ghc/changeset/1b34731776d5d6e0f5569156cd04981df120a0c2 >--------------------------------------------------------------- commit 1b34731776d5d6e0f5569156cd04981df120a0c2 Author: Roman Leshchinskiy <[email protected]> Date: Sun Nov 27 15:42:30 2011 +0000 Manually worker/wrapper error functions (fixes #66) >--------------------------------------------------------------- Data/Vector/Internal/Check.hs | 28 ++++++++++++++++++++++------ vector.cabal | 2 +- 2 files changed, 23 insertions(+), 7 deletions(-) diff --git a/Data/Vector/Internal/Check.hs b/Data/Vector/Internal/Check.hs index a5e2753..948e46b 100644 --- a/Data/Vector/Internal/Check.hs +++ b/Data/Vector/Internal/Check.hs @@ -10,6 +10,8 @@ -- Bounds checking infrastructure -- +{-# LANGUAGE MagicHash #-} + module Data.Vector.Internal.Check ( Checks(..), doChecks, @@ -17,6 +19,8 @@ module Data.Vector.Internal.Check ( check, assert, checkIndex, checkLength, checkSlice ) where +import GHC.Base( Int(..) ) +import GHC.Prim( Int# ) import Prelude hiding( error ) import qualified Prelude as P @@ -78,8 +82,12 @@ assert :: String -> Int -> Checks -> String -> Bool -> a -> a assert file line kind loc = check file line kind loc assert_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 #-} @@ -88,8 +96,12 @@ checkIndex file line kind loc i n x 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 #-} @@ -98,8 +110,12 @@ checkLength file line kind loc n x 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 #-} diff --git a/vector.cabal b/vector.cabal index 6f8818e..a6fe4f5 100644 --- a/vector.cabal +++ b/vector.cabal @@ -162,7 +162,7 @@ Library 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 _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
