{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
module HaskellWorks.Data.Json.Simd.Index.Standard
( makeStandardJsonIbBps
, makeStandardJsonIbBpsUnsafe
, enabledMakeStandardJsonIbBps
) where
import Control.Monad
import Data.Word
import HaskellWorks.Data.Json.Simd.Internal.Index.Standard
import qualified Data.ByteString as BS
import qualified Data.ByteString.Internal as BSI
import qualified Data.ByteString.Lazy as LBS
import qualified Foreign.ForeignPtr as F
import qualified Foreign.ForeignPtr.Unsafe as F
import qualified Foreign.Marshal.Unsafe as F
import qualified Foreign.Ptr as F
import qualified Foreign.Storable as F
import qualified HaskellWorks.Data.Json.Simd.Capabilities as C
import qualified HaskellWorks.Data.Json.Simd.Internal.Foreign as F
import qualified System.IO.Unsafe as IO
makeStandardJsonIbBps :: LBS.ByteString -> Either String [(BS.ByteString, BS.ByteString)]
makeStandardJsonIbBps :: ByteString -> Either String [(ByteString, ByteString)]
makeStandardJsonIbBps ByteString
lbs = if Bool
enabledMakeStandardJsonIbBps
then forall a b. b -> Either a b
Right (ByteString -> [(ByteString, ByteString)]
makeStandardJsonIbBpsUnsafe ByteString
lbs)
else forall a b. a -> Either a b
Left String
"makeStandardJsonIbBps function is disabled"
makeStandardJsonIbBpsUnsafe :: LBS.ByteString -> [(BS.ByteString, BS.ByteString)]
makeStandardJsonIbBpsUnsafe :: ByteString -> [(ByteString, ByteString)]
makeStandardJsonIbBpsUnsafe ByteString
lbs = forall a. IO a -> a
F.unsafeLocalState forall a b. (a -> b) -> a -> b
$ do
WorkBuffers
wb <- Int -> IO WorkBuffers
allocWorkBuffers (Int
32 forall a. Num a => a -> a -> a
* Int
1024 forall a. Num a => a -> a -> a
* Int
1204)
WorkState
ws <- Word32 -> IO WorkState
newWorkState Word32
0
ForeignPtr UInt32
fptrState :: F.ForeignPtr F.UInt32 <- forall a. Storable a => IO (ForeignPtr a)
F.mallocForeignPtr
ForeignPtr UInt64
fptrRemBits :: F.ForeignPtr F.UInt64 <- forall a. Storable a => IO (ForeignPtr a)
F.mallocForeignPtr
ForeignPtr UInt64
fptrRemBitsLen :: F.ForeignPtr F.Size <- forall a. Storable a => IO (ForeignPtr a)
F.mallocForeignPtr
let ptrState :: Ptr UInt32
ptrState = forall a. ForeignPtr a -> Ptr a
F.unsafeForeignPtrToPtr ForeignPtr UInt32
fptrState
let ptrRemBits :: Ptr UInt64
ptrRemBits = forall a. ForeignPtr a -> Ptr a
F.unsafeForeignPtrToPtr ForeignPtr UInt64
fptrRemBits
let ptrRemBitsLen :: Ptr UInt64
ptrRemBitsLen = forall a. ForeignPtr a -> Ptr a
F.unsafeForeignPtrToPtr ForeignPtr UInt64
fptrRemBitsLen
forall a. Storable a => Ptr a -> a -> IO ()
F.poke Ptr UInt32
ptrState UInt32
0
forall a. Storable a => Ptr a -> a -> IO ()
F.poke Ptr UInt64
ptrRemBits UInt64
0
forall a. Storable a => Ptr a -> a -> IO ()
F.poke Ptr UInt64
ptrRemBitsLen UInt64
0
forall a. IO a -> IO a
IO.unsafeInterleaveIO forall a b. (a -> b) -> a -> b
$ WorkBuffers
-> WorkState
-> ForeignPtr UInt32
-> ForeignPtr UInt64
-> ForeignPtr UInt64
-> [ByteString]
-> IO [(ByteString, ByteString)]
go WorkBuffers
wb WorkState
ws ForeignPtr UInt32
fptrState ForeignPtr UInt64
fptrRemBits ForeignPtr UInt64
fptrRemBitsLen (ByteString -> [ByteString]
LBS.toChunks ByteString
lbs)
where go :: ()
=> WorkBuffers
-> WorkState
-> F.ForeignPtr F.UInt32
-> F.ForeignPtr F.UInt64
-> F.ForeignPtr F.Size
-> [BS.ByteString]
-> IO [(BS.ByteString, BS.ByteString)]
go :: WorkBuffers
-> WorkState
-> ForeignPtr UInt32
-> ForeignPtr UInt64
-> ForeignPtr UInt64
-> [ByteString]
-> IO [(ByteString, ByteString)]
go WorkBuffers
_ WorkState
_ ForeignPtr UInt32
_ ForeignPtr UInt64
fptrRemBits ForeignPtr UInt64
fptrRemBitsLen [] = do
ForeignPtr Word8
resBpFptr <- forall a. Int -> IO (ForeignPtr a)
F.mallocForeignPtrBytes Int
8
let resBpPtr :: Ptr UInt64
resBpPtr = forall a b. Ptr a -> Ptr b
F.castPtr (forall a. ForeignPtr a -> Ptr a
F.unsafeForeignPtrToPtr ForeignPtr Word8
resBpFptr )
let ptrRemBits :: Ptr UInt64
ptrRemBits = forall a. ForeignPtr a -> Ptr a
F.unsafeForeignPtrToPtr ForeignPtr UInt64
fptrRemBits
let ptrRemBitsLen :: Ptr UInt64
ptrRemBitsLen = forall a. ForeignPtr a -> Ptr a
F.unsafeForeignPtrToPtr ForeignPtr UInt64
fptrRemBitsLen
UInt64
remBits <- forall a. Storable a => Ptr a -> IO a
F.peek Ptr UInt64
ptrRemBits
UInt64
remBitsLen <- forall a. Storable a => Ptr a -> IO a
F.peek Ptr UInt64
ptrRemBitsLen
UInt64
bpByteLen <- UInt64 -> UInt64 -> Ptr UInt64 -> IO UInt64
F.smWriteBpChunkFinal
UInt64
remBits
UInt64
remBitsLen
Ptr UInt64
resBpPtr
forall (m :: * -> *) a. Monad m => a -> m a
return [ ( ByteString
BS.empty
, ForeignPtr Word8 -> Int -> Int -> ByteString
BSI.fromForeignPtr ForeignPtr Word8
resBpFptr Int
0 (forall a b. (Integral a, Num b) => a -> b
fromIntegral UInt64
bpByteLen forall a. Num a => a -> a -> a
* Int
8)
)
]
go WorkBuffers
wb WorkState
ws ForeignPtr UInt32
fptrState ForeignPtr UInt64
fptrRemBits ForeignPtr UInt64
fptrRemBitsLen (ByteString
bs:[ByteString]
bss) = do
let (!ForeignPtr Word8
bsFptr, !Int
bsOff, !Int
bsLen) = ByteString -> (ForeignPtr Word8, Int, Int)
BSI.toForeignPtr ByteString
bs
let !idxByteLen :: Int
idxByteLen = (Int
bsLen forall a. Num a => a -> a -> a
+ Int
7) forall a. Integral a => a -> a -> a
`div` Int
8
ForeignPtr Word8
resIbFptr <- forall a. Int -> IO (ForeignPtr a)
F.mallocForeignPtrBytes Int
idxByteLen
ForeignPtr Word8
resBpFptr <- forall a. Int -> IO (ForeignPtr a)
F.mallocForeignPtrBytes Int
idxByteLen
let resIbPtr :: Ptr UInt8
resIbPtr = forall a b. Ptr a -> Ptr b
F.castPtr (forall a. ForeignPtr a -> Ptr a
F.unsafeForeignPtrToPtr ForeignPtr Word8
resIbFptr )
let resBpPtr :: Ptr UInt64
resBpPtr = forall a b. Ptr a -> Ptr b
F.castPtr (forall a. ForeignPtr a -> Ptr a
F.unsafeForeignPtrToPtr ForeignPtr Word8
resBpFptr )
let bsPtr :: Ptr Any
bsPtr = forall a b. Ptr a -> Ptr b
F.castPtr (forall a. ForeignPtr a -> Ptr a
F.unsafeForeignPtrToPtr ForeignPtr Word8
bsFptr)
let ptrState :: Ptr UInt32
ptrState = forall a. ForeignPtr a -> Ptr a
F.unsafeForeignPtrToPtr ForeignPtr UInt32
fptrState
let ptrRemBits :: Ptr UInt64
ptrRemBits = forall a. ForeignPtr a -> Ptr a
F.unsafeForeignPtrToPtr ForeignPtr UInt64
fptrRemBits
let ptrRemBitsLen :: Ptr UInt64
ptrRemBitsLen = forall a. ForeignPtr a -> Ptr a
F.unsafeForeignPtrToPtr ForeignPtr UInt64
fptrRemBitsLen
Word8
s :: Word8 <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Ptr a -> IO a
F.peek Ptr UInt32
ptrState
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ Ptr UInt8 -> UInt64 -> Ptr UInt32 -> Ptr UInt32 -> IO ()
F.smProcessChunk
(forall a b. Ptr a -> Int -> Ptr b
F.plusPtr Ptr Any
bsPtr Int
bsOff)
(forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
bsLen)
Ptr UInt32
ptrState
(WorkBuffers -> Ptr UInt32
workBuffersP WorkBuffers
wb)
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ UInt8
-> Ptr UInt32
-> UInt64
-> Ptr UInt8
-> Ptr UInt8
-> Ptr UInt8
-> IO ()
F.smMakeIbOpClChunks
(forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
s)
(WorkBuffers -> Ptr UInt32
workBuffersP WorkBuffers
wb)
(forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
bsLen)
Ptr UInt8
resIbPtr
(WorkBuffers -> Ptr UInt8
workBuffersO WorkBuffers
wb)
(WorkBuffers -> Ptr UInt8
workBuffersC WorkBuffers
wb)
UInt64
bpByteLen <- Ptr UInt8
-> Ptr UInt8
-> UInt64
-> Ptr UInt64
-> Ptr UInt64
-> Ptr UInt64
-> IO UInt64
F.smWriteBpChunk
(WorkBuffers -> Ptr UInt8
workBuffersO WorkBuffers
wb)
(WorkBuffers -> Ptr UInt8
workBuffersC WorkBuffers
wb)
(forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
idxByteLen)
Ptr UInt64
ptrRemBits
Ptr UInt64
ptrRemBitsLen
Ptr UInt64
resBpPtr
let !r :: (ByteString, ByteString)
r =
( ForeignPtr Word8 -> Int -> Int -> ByteString
BSI.fromForeignPtr ForeignPtr Word8
resIbFptr Int
0 Int
idxByteLen
, ForeignPtr Word8 -> Int -> Int -> ByteString
BSI.fromForeignPtr ForeignPtr Word8
resBpFptr Int
0 (forall a b. (Integral a, Num b) => a -> b
fromIntegral UInt64
bpByteLen forall a. Num a => a -> a -> a
* Int
8)
)
[(ByteString, ByteString)]
rs <- forall a. IO a -> IO a
IO.unsafeInterleaveIO forall a b. (a -> b) -> a -> b
$ WorkBuffers
-> WorkState
-> ForeignPtr UInt32
-> ForeignPtr UInt64
-> ForeignPtr UInt64
-> [ByteString]
-> IO [(ByteString, ByteString)]
go WorkBuffers
wb WorkState
ws ForeignPtr UInt32
fptrState ForeignPtr UInt64
fptrRemBits ForeignPtr UInt64
fptrRemBitsLen [ByteString]
bss
forall (m :: * -> *) a. Monad m => a -> m a
return ((ByteString, ByteString)
rforall a. a -> [a] -> [a]
:[(ByteString, ByteString)]
rs)
enabledMakeStandardJsonIbBps :: Bool
enabledMakeStandardJsonIbBps :: Bool
enabledMakeStandardJsonIbBps = Bool
C.avx_2 Bool -> Bool -> Bool
&& Bool
C.sse_4_2 Bool -> Bool -> Bool
&& Bool
C.bmi_2