{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnliftedFFITypes #-}
{-# LANGUAGE CPP #-}

module Data.Text.Internal.ArrayUtils (memchr) where

#if defined(PURE_HASKELL)
import qualified Data.Text.Array as A
import Data.List (elemIndex)
#else
import Foreign.C.Types
import System.Posix.Types (CSsize(..))
#endif
import GHC.Exts (ByteArray#)
import Data.Word (Word8)

memchr :: ByteArray# -> Int -> Int -> Word8 -> Int
#if defined(PURE_HASKELL)
memchr arr# off len w =
    let tempBa = A.ByteArray arr#
    in case elemIndex w (A.toList tempBa off len) of
        Nothing -> -1
        Just i -> i
#else
memchr :: ByteArray# -> Int -> Int -> Word8 -> Int
memchr ByteArray#
arr# Int
off Int
len Word8
w = CSsize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CSsize -> Int) -> CSsize -> Int
forall a b. (a -> b) -> a -> b
$ ByteArray# -> CSize -> CSize -> Word8 -> CSsize
c_memchr ByteArray#
arr# (Int -> CSize
intToCSize Int
off) (Int -> CSize
intToCSize Int
len) Word8
w

intToCSize :: Int -> CSize
intToCSize :: Int -> CSize
intToCSize = Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral


foreign import ccall unsafe "_hs_text_memchr" c_memchr
    :: ByteArray# -> CSize -> CSize -> Word8 -> CSsize
#endif