{-# LANGUAGE CPP #-}

-- |
-- Module      : Data.Vector.Internal.Check
-- Copyright   : (c) Roman Leshchinskiy 2009
-- License     : BSD-style
--
-- Maintainer  : Roman Leshchinskiy <rl@cse.unsw.edu.au>
-- Stability   : experimental
-- Portability : non-portable
--
-- Bounds checking infrastructure
--

{-# 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

-- 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 :: 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

error_msg :: String -> Int -> String -> String -> String
error_msg :: String -> Int -> String -> String -> String
error_msg String
file Int
line String
loc String
msg = String
file String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":" 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 -> String
forall a. [a] -> [a] -> [a]
++ String
loc String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"): " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
msg

error :: String -> Int -> String -> String -> a
{-# NOINLINE error #-}
error :: forall a. String -> Int -> String -> String -> a
error String
file Int
line String
loc 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 :: forall a. String -> Int -> String -> String -> a
internalError String
file Int
line String
loc 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://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 :: forall a. String -> Int -> Checks -> String -> String -> a
checkError String
file Int
line Checks
kind String
loc String
msg
  = case Checks
kind of
      Checks
Internal -> String -> Int -> String -> String -> a
forall a. String -> Int -> String -> String -> a
internalError String
file Int
line String
loc String
msg
      Checks
_ -> 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 :: forall a.
String -> Int -> Checks -> String -> String -> Bool -> a -> a
check String
file Int
line Checks
kind String
loc String
msg Bool
cond 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# 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 :: String -> Int -> Checks -> String -> Int -> Int -> a -> a
{-# INLINE checkIndex #-}
checkIndex :: forall a. String -> Int -> Checks -> String -> Int -> Int -> a -> a
checkIndex String
file Int
line Checks
kind String
loc Int
i Int
n 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
>= Int
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# 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 :: String -> Int -> Checks -> String -> Int -> a -> a
{-# INLINE checkLength #-}
checkLength :: forall a. String -> Int -> Checks -> String -> Int -> a -> a
checkLength String
file Int
line Checks
kind String
loc Int
n 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
>= Int
0) a
x


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 :: String -> Int -> Checks -> String -> Int -> Int -> Int -> a -> a
{-# INLINE checkSlice #-}
checkSlice :: forall a.
String -> Int -> Checks -> String -> Int -> Int -> Int -> a -> a
checkSlice String
file Int
line Checks
kind String
loc Int
i Int
m Int
n 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
>= 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