{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MagicHash #-}
{-# OPTIONS_HADDOCK hide #-}
module Data.Vector.Internal.Check (
HasCallStack,
Checks(..), doChecks,
internalError,
check, checkIndex, checkLength, checkSlice,
inRange
) where
import GHC.Exts (Int(..), Int#)
import Prelude hiding( error, (&&), (||), not )
import qualified Prelude as P
import GHC.Stack (HasCallStack)
infixr 2 ||
infixr 3 &&
not :: Bool -> Bool
{-# INLINE not #-}
not :: Bool -> Bool
not Bool
True = Bool
False
not Bool
False = Bool
True
(&&) :: Bool -> Bool -> Bool
{-# INLINE (&&) #-}
Bool
False && :: Bool -> Bool -> Bool
&& Bool
_ = Bool
False
Bool
True && Bool
x = Bool
x
(||) :: Bool -> Bool -> Bool
{-# INLINE (||) #-}
Bool
True || :: Bool -> Bool -> Bool
|| Bool
_ = Bool
True
Bool
False || Bool
x = Bool
x
data Checks = Bounds | Unsafe | Internal deriving( Checks -> Checks -> Bool
(Checks -> Checks -> Bool)
-> (Checks -> Checks -> Bool) -> Eq Checks
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Checks -> Checks -> Bool
$c/= :: Checks -> Checks -> Bool
== :: Checks -> Checks -> Bool
$c== :: Checks -> Checks -> Bool
Eq )
doBoundsChecks :: Bool
#ifdef VECTOR_BOUNDS_CHECKS
doBoundsChecks :: Bool
doBoundsChecks = Bool
True
#else
doBoundsChecks = False
#endif
doUnsafeChecks :: Bool
#ifdef VECTOR_UNSAFE_CHECKS
doUnsafeChecks = True
#else
doUnsafeChecks :: Bool
doUnsafeChecks = Bool
False
#endif
doInternalChecks :: Bool
#ifdef VECTOR_INTERNAL_CHECKS
doInternalChecks = True
#else
doInternalChecks :: Bool
doInternalChecks = Bool
False
#endif
doChecks :: Checks -> Bool
{-# INLINE doChecks #-}
doChecks :: Checks -> Bool
doChecks Checks
Bounds = Bool
doBoundsChecks
doChecks Checks
Unsafe = Bool
doUnsafeChecks
doChecks Checks
Internal = Bool
doInternalChecks
internalError :: HasCallStack => String -> a
{-# NOINLINE internalError #-}
internalError :: String -> a
internalError String
msg
= String -> a
forall a. HasCallStack => String -> a
P.error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
[String
"*** Internal error in package vector ***"
,String
"*** Please submit a bug report at http://github.com/haskell/vector"
,String
msg]
checkError :: HasCallStack => Checks -> String -> a
{-# NOINLINE checkError #-}
checkError :: Checks -> String -> a
checkError Checks
kind String
msg
= case Checks
kind of
Checks
Internal -> String -> a
forall a. HasCallStack => String -> a
internalError String
msg
Checks
_ -> String -> a
forall a. HasCallStack => String -> a
P.error String
msg
check :: HasCallStack => Checks -> String -> Bool -> a -> a
{-# INLINE check #-}
check :: Checks -> String -> Bool -> a -> a
check Checks
kind String
msg Bool
cond a
x
| Bool -> Bool
not (Checks -> Bool
doChecks Checks
kind) Bool -> Bool -> Bool
|| Bool
cond = a
x
| Bool
otherwise = Checks -> String -> a
forall a. HasCallStack => Checks -> String -> a
checkError Checks
kind String
msg
checkIndex_msg :: Int -> Int -> String
{-# INLINE checkIndex_msg #-}
checkIndex_msg :: Int -> Int -> String
checkIndex_msg (I# Int#
i#) (I# Int#
n#) = Int# -> Int# -> String
checkIndex_msg# Int#
i# Int#
n#
checkIndex_msg# :: Int# -> Int# -> String
{-# NOINLINE checkIndex_msg# #-}
checkIndex_msg# :: Int# -> Int# -> String
checkIndex_msg# Int#
i# Int#
n# = String
"index out of bounds " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Int, Int) -> String
forall a. Show a => a -> String
show (Int# -> Int
I# Int#
i#, Int# -> Int
I# Int#
n#)
checkIndex :: HasCallStack => Checks -> Int -> Int -> a -> a
{-# INLINE checkIndex #-}
checkIndex :: Checks -> Int -> Int -> a -> a
checkIndex Checks
kind Int
i Int
n a
x
= Checks -> String -> Bool -> a -> a
forall a. HasCallStack => Checks -> String -> Bool -> a -> a
check Checks
kind (Int -> Int -> String
checkIndex_msg Int
i Int
n) (Int -> Int -> Bool
inRange Int
i Int
n) a
x
checkLength_msg :: Int -> String
{-# INLINE checkLength_msg #-}
checkLength_msg :: Int -> String
checkLength_msg (I# Int#
n#) = Int# -> String
checkLength_msg# Int#
n#
checkLength_msg# :: Int# -> String
{-# NOINLINE checkLength_msg# #-}
checkLength_msg# :: Int# -> String
checkLength_msg# Int#
n# = String
"negative length " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Int# -> Int
I# Int#
n#)
checkLength :: HasCallStack => Checks -> Int -> a -> a
{-# INLINE checkLength #-}
checkLength :: Checks -> Int -> a -> a
checkLength Checks
kind Int
n = Checks -> String -> Bool -> a -> a
forall a. HasCallStack => Checks -> String -> Bool -> a -> a
check Checks
kind (Int -> String
checkLength_msg Int
n) (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0)
checkSlice_msg :: Int -> Int -> Int -> String
{-# INLINE checkSlice_msg #-}
checkSlice_msg :: Int -> Int -> Int -> String
checkSlice_msg (I# Int#
i#) (I# Int#
m#) (I# Int#
n#) = Int# -> Int# -> Int# -> String
checkSlice_msg# Int#
i# Int#
m# Int#
n#
checkSlice_msg# :: Int# -> Int# -> Int# -> String
{-# NOINLINE checkSlice_msg# #-}
checkSlice_msg# :: Int# -> Int# -> Int# -> String
checkSlice_msg# Int#
i# Int#
m# Int#
n# = String
"invalid slice " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Int, Int, Int) -> String
forall a. Show a => a -> String
show (Int# -> Int
I# Int#
i#, Int# -> Int
I# Int#
m#, Int# -> Int
I# Int#
n#)
checkSlice :: HasCallStack => Checks -> Int -> Int -> Int -> a -> a
{-# INLINE checkSlice #-}
checkSlice :: Checks -> Int -> Int -> Int -> a -> a
checkSlice Checks
kind Int
i Int
m Int
n a
x
= Checks -> String -> Bool -> a -> a
forall a. HasCallStack => Checks -> String -> Bool -> a -> a
check Checks
kind (Int -> Int -> Int -> String
checkSlice_msg Int
i Int
m Int
n) (Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i) a
x
inRange :: Int -> Int -> Bool
{-# INLINE inRange #-}
inRange :: Int -> Int -> Bool
inRange Int
i Int
n = (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i :: Word) Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
< (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n :: Word)