{-# language BangPatterns #-}
{-# language BlockArguments #-}
{-# language MagicHash #-}
{-# language NamedFieldPuns #-}
{-# language ScopedTypeVariables #-}
{-# language TypeApplications #-}
{-# language UnliftedFFITypes #-}
{-# language UnboxedTuples #-}
module Data.Bytes.Byte
( count
, split
, splitU
, splitNonEmpty
, splitInit
, splitInitU
) where
import Prelude hiding (length)
import Control.Monad.ST (runST)
import Control.Monad.ST.Run (runPrimArrayST)
import Data.Bytes.Types (Bytes(..))
import Data.List.NonEmpty (NonEmpty((:|)))
import Data.Primitive (PrimArray(..),MutablePrimArray(..),ByteArray(..))
import Data.Primitive.Unlifted.Array (UnliftedArray)
import Data.Word (Word8)
import GHC.Exts (ByteArray#,MutableByteArray#)
import GHC.IO (unsafeIOToST)
import qualified Data.Primitive as PM
import qualified Data.Primitive.Unlifted.Array as PM
import qualified GHC.Exts as Exts
count :: Word8 -> Bytes -> Int
count !b (Bytes{array=ByteArray arr,offset,length}) =
count_ba arr offset length b
splitU :: Word8 -> Bytes -> UnliftedArray ByteArray
splitU !w !bs =
let !lens = splitLengthsAlt w bs
!lensSz = PM.sizeofPrimArray lens
in splitCommonU lens lensSz bs
splitInitU :: Word8 -> Bytes -> UnliftedArray ByteArray
splitInitU !w !bs =
let !lens = splitLengthsAlt w bs
!lensSz = PM.sizeofPrimArray lens
in splitCommonU lens (lensSz - 1) bs
splitCommonU ::
PrimArray Int
-> Int
-> Bytes
-> UnliftedArray ByteArray
splitCommonU !lens !lensSz Bytes{array,offset=arrIx0} = runST do
dst <- PM.unsafeNewUnliftedArray lensSz
let go !lenIx !arrIx = if lenIx < lensSz
then do
let !len = PM.indexPrimArray lens lenIx
buf <- PM.newByteArray len
PM.copyByteArray buf 0 array arrIx len
buf' <- PM.unsafeFreezeByteArray buf
PM.writeUnliftedArray dst lenIx buf'
go (lenIx + 1) (arrIx + len + 1)
else pure ()
go 0 arrIx0
PM.unsafeFreezeUnliftedArray dst
split :: Word8 -> Bytes -> [Bytes]
{-# inline split #-}
split !w !bs@Bytes{array,offset=arrIx0} = Exts.build
(\g x0 ->
let go !lenIx !arrIx = if lenIx < lensSz
then let !len = PM.indexPrimArray lens lenIx in
g (Bytes array arrIx len) (go (lenIx + 1) (arrIx + len + 1))
else x0
in go 0 arrIx0
)
where
!lens = splitLengthsAlt w bs
!lensSz = PM.sizeofPrimArray lens
splitNonEmpty :: Word8 -> Bytes -> NonEmpty Bytes
{-# inline splitNonEmpty #-}
splitNonEmpty !w !bs@Bytes{array,offset=arrIx0} =
Bytes array arrIx0 len0 :| Exts.build
(\g x0 ->
let go !lenIx !arrIx = if lenIx < lensSz
then let !len = PM.indexPrimArray lens lenIx in
g (Bytes array arrIx len) (go (lenIx + 1) (arrIx + len + 1))
else x0
in go 1 (1 + (arrIx0 + len0))
)
where
!lens = splitLengthsAlt w bs
!lensSz = PM.sizeofPrimArray lens
!len0 = PM.indexPrimArray lens 0 :: Int
splitInit :: Word8 -> Bytes -> [Bytes]
{-# inline splitInit #-}
splitInit !w !bs@Bytes{array,offset=arrIx0} = Exts.build
(\g x0 ->
let go !lenIx !arrIx = if lenIx < lensSz
then let !len = PM.indexPrimArray lens lenIx in
g (Bytes array arrIx len) (go (lenIx + 1) (arrIx + len + 1))
else x0
in go 0 arrIx0
)
where
!lens = splitLengthsAlt w bs
!lensSz = PM.sizeofPrimArray lens - 1
splitLengthsAlt :: Word8 -> Bytes -> PrimArray Int
splitLengthsAlt b Bytes{array=ByteArray arr#,offset=off,length=len} = runPrimArrayST do
let !n = count_ba arr# off len b
dst@(MutablePrimArray dst# ) :: MutablePrimArray s Int <- PM.newPrimArray (n + 1)
total <- unsafeIOToST (memchr_ba_many arr# off len dst# n b)
PM.writePrimArray dst n (len - total)
PM.unsafeFreezePrimArray dst
foreign import ccall unsafe "bs_custom.h memchr_ba_many" memchr_ba_many
:: ByteArray# -> Int -> Int -> MutableByteArray# s -> Int -> Word8 -> IO Int
foreign import ccall unsafe "bs_custom.h count_ba" count_ba
:: ByteArray# -> Int -> Int -> Word8 -> Int