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

    -- |
    -- Module      : Data.Vector.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.Vector.Internal.Check (
      HasCallStack,
      Checks(..), doChecks,

      internalError,
      check, checkIndex, checkLength, checkSlice,
      inRange
    ) where

    import GHC.Exts (Int(..), Int#)
    import Prelude
      ( Eq, Bool(..), Word, String
      , otherwise, fromIntegral, show, unlines
      , (-), (<), (<=), (>=), ($), (++) )
    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
    (Checks -> Checks -> Bool)
    -> (Checks -> Checks -> Bool) -> Eq Checks
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Checks -> Checks -> Bool
    == :: Checks -> Checks -> Bool
    $c/= :: Checks -> Checks -> Bool
    /= :: 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 :: forall a. HasCallStack => 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 :: forall a. HasCallStack => 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 :: 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 = 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 :: forall a. HasCallStack => 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 :: forall a. HasCallStack => 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 :: forall a. HasCallStack => 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

    -- 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 = (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)