{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MagicHash #-}
{-# OPTIONS_HADDOCK hide #-}

-- |
-- Module      : Data.Strict.Vector.Autogen.Internal.Check
-- Copyright   : (c) Roman Leshchinskiy 2009
--                   Alexey Kuleshevich 2020-2022
--                   Aleksey Khudyakov 2020-2022
--                   Andrew Lelechenko 2020-2022
-- License     : BSD-style
--
-- Maintainer  : Haskell Libraries Team <libraries@haskell.org>
-- Stability   : experimental
-- Portability : non-portable
--
-- Bounds checking infrastructure
--
module Data.Strict.Vector.Autogen.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)

-- 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
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 = True
#else
doBoundsChecks :: Bool
doBoundsChecks = Bool
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 :: forall a. HasCallStack => String -> a
internalError String
msg
  = forall a. HasCallStack => String -> a
P.error 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 :: forall a. HasCallStack => Checks -> String -> a
checkError Checks
kind String
msg
  = case Checks
kind of
      Checks
Internal -> forall a. HasCallStack => String -> a
internalError String
msg
      Checks
_ -> forall a. HasCallStack => String -> a
P.error String
msg

check :: HasCallStack => Checks -> String -> Bool -> a -> a
{-# INLINE check #-}
check :: forall a. HasCallStack => 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 = 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 " forall a. [a] -> [a] -> [a]
++ 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 :: forall a. HasCallStack => Checks -> Int -> Int -> a -> a
checkIndex Checks
kind Int
i Int
n a
x
  = 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 " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Int# -> Int
I# Int#
n#)

checkLength :: HasCallStack => Checks -> Int -> a -> a
{-# INLINE checkLength #-}
checkLength :: forall a. HasCallStack => Checks -> Int -> a -> a
checkLength Checks
kind Int
n = forall a. HasCallStack => Checks -> String -> Bool -> a -> a
check Checks
kind (Int -> String
checkLength_msg Int
n) (Int
n 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 " forall a. [a] -> [a] -> [a]
++ 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 :: forall a. HasCallStack => Checks -> Int -> Int -> Int -> a -> a
checkSlice Checks
kind Int
i Int
m Int
n a
x
  = 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 forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
m forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
m forall a. Ord a => a -> a -> Bool
<= Int
n forall a. Num a => a -> a -> a
- Int
i) a
x

-- Lengths are never negative, so we can check @0 <= i < length v@
-- using one unsigned comparison.
inRange :: Int -> Int -> Bool
{-# INLINE inRange #-}
inRange :: Int -> Int -> Bool
inRange Int
i Int
n = (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i :: Word) forall a. Ord a => a -> a -> Bool
< (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n :: Word)