{-# LANGUAGE CPP #-}
{-# LANGUAGE MagicHash #-}
module Data.Vector.Internal.Check (
Checks(..), doChecks,
error, internalError,
check, checkIndex, checkLength, checkSlice
) where
import GHC.Base( Int(..) )
import GHC.Prim( Int# )
import Prelude hiding( error, (&&), (||), not )
import qualified Prelude as P
infixr 2 ||
infixr 3 &&
not :: Bool -> Bool
{-# INLINE not #-}
not :: Bool -> Bool
not True = Bool
False
not False = Bool
True
(&&) :: Bool -> Bool -> Bool
{-# INLINE (&&) #-}
False && :: Bool -> Bool -> Bool
&& _ = Bool
False
True && x :: Bool
x = Bool
x
(||) :: Bool -> Bool -> Bool
{-# INLINE (||) #-}
True || :: Bool -> Bool -> Bool
|| _ = Bool
True
False || x :: 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 Bounds = Bool
doBoundsChecks
doChecks Unsafe = Bool
doUnsafeChecks
doChecks Internal = Bool
doInternalChecks
error_msg :: String -> Int -> String -> String -> String
error_msg :: String -> Int -> String -> String -> String
error_msg file :: String
file line :: Int
line loc :: String
loc msg :: String
msg = String
file String -> String -> String
forall a. [a] -> [a] -> [a]
++ ":" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
line String -> String -> String
forall a. [a] -> [a] -> [a]
++ " (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
loc String -> String -> String
forall a. [a] -> [a] -> [a]
++ "): " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
msg
error :: String -> Int -> String -> String -> a
{-# NOINLINE error #-}
error :: String -> Int -> String -> String -> a
error file :: String
file line :: Int
line loc :: String
loc msg :: String
msg
= String -> a
forall a. HasCallStack => String -> a
P.error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String -> Int -> String -> String -> String
error_msg String
file Int
line String
loc String
msg
internalError :: String -> Int -> String -> String -> a
{-# NOINLINE internalError #-}
internalError :: String -> Int -> String -> String -> a
internalError file :: String
file line :: Int
line loc :: String
loc msg :: 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
["*** Internal error in package vector ***"
,"*** Please submit a bug report at http://trac.haskell.org/vector"
,String -> Int -> String -> String -> String
error_msg String
file Int
line String
loc String
msg]
checkError :: String -> Int -> Checks -> String -> String -> a
{-# NOINLINE checkError #-}
checkError :: String -> Int -> Checks -> String -> String -> a
checkError file :: String
file line :: Int
line kind :: Checks
kind loc :: String
loc msg :: String
msg
= case Checks
kind of
Internal -> String -> Int -> String -> String -> a
forall a. String -> Int -> String -> String -> a
internalError String
file Int
line String
loc String
msg
_ -> String -> Int -> String -> String -> a
forall a. String -> Int -> String -> String -> a
error String
file Int
line String
loc String
msg
check :: String -> Int -> Checks -> String -> String -> Bool -> a -> a
{-# INLINE check #-}
check :: String -> Int -> Checks -> String -> String -> Bool -> a -> a
check file :: String
file line :: Int
line kind :: Checks
kind loc :: String
loc msg :: String
msg cond :: Bool
cond x :: a
x
| Bool -> Bool
not (Checks -> Bool
doChecks Checks
kind) Bool -> Bool -> Bool
|| Bool
cond = a
x
| Bool
otherwise = String -> Int -> Checks -> String -> String -> a
forall a. String -> Int -> Checks -> String -> String -> a
checkError String
file Int
line Checks
kind String
loc String
msg
checkIndex_msg :: Int -> Int -> String
{-# INLINE checkIndex_msg #-}
checkIndex_msg :: Int -> Int -> String
checkIndex_msg (I# i# :: Int#
i#) (I# n# :: 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# i# :: Int#
i# n# :: Int#
n# = "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 :: String -> Int -> Checks -> String -> Int -> Int -> a -> a
{-# INLINE checkIndex #-}
checkIndex :: String -> Int -> Checks -> String -> Int -> Int -> a -> a
checkIndex file :: String
file line :: Int
line kind :: Checks
kind loc :: String
loc i :: Int
i n :: Int
n x :: a
x
= String -> Int -> Checks -> String -> String -> Bool -> a -> a
forall a.
String -> Int -> Checks -> String -> String -> Bool -> a -> a
check String
file Int
line Checks
kind String
loc (Int -> Int -> String
checkIndex_msg Int
i Int
n) (Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 0 Bool -> Bool -> Bool
&& Int
iInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
n) a
x
checkLength_msg :: Int -> String
{-# INLINE checkLength_msg #-}
checkLength_msg :: Int -> String
checkLength_msg (I# n# :: Int#
n#) = Int# -> String
checkLength_msg# Int#
n#
checkLength_msg# :: Int# -> String
{-# NOINLINE checkLength_msg# #-}
checkLength_msg# :: Int# -> String
checkLength_msg# n# :: Int#
n# = "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 :: String -> Int -> Checks -> String -> Int -> a -> a
{-# INLINE checkLength #-}
checkLength :: String -> Int -> Checks -> String -> Int -> a -> a
checkLength file :: String
file line :: Int
line kind :: Checks
kind loc :: String
loc n :: Int
n x :: a
x
= String -> Int -> Checks -> String -> String -> Bool -> a -> a
forall a.
String -> Int -> Checks -> String -> String -> Bool -> a -> a
check String
file Int
line Checks
kind String
loc (Int -> String
checkLength_msg Int
n) (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 0) a
x
checkSlice_msg :: Int -> Int -> Int -> String
{-# INLINE checkSlice_msg #-}
checkSlice_msg :: Int -> Int -> Int -> String
checkSlice_msg (I# i# :: Int#
i#) (I# m# :: Int#
m#) (I# n# :: 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# i# :: Int#
i# m# :: Int#
m# n# :: Int#
n# = "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 :: String -> Int -> Checks -> String -> Int -> Int -> Int -> a -> a
{-# INLINE checkSlice #-}
checkSlice :: String -> Int -> Checks -> String -> Int -> Int -> Int -> a -> a
checkSlice file :: String
file line :: Int
line kind :: Checks
kind loc :: String
loc i :: Int
i m :: Int
m n :: Int
n x :: a
x
= String -> Int -> Checks -> String -> String -> Bool -> a -> a
forall a.
String -> Int -> Checks -> String -> String -> Bool -> a -> a
check String
file Int
line Checks
kind String
loc (Int -> Int -> Int -> String
checkSlice_msg Int
i Int
m Int
n)
(Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 0 Bool -> Bool -> Bool
&& Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 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