{-# 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

{- HLINT ignore "Reduce duplication"  -}
{- HLINT ignore "Redundant do"        -}

makeStandardJsonIbBps :: LBS.ByteString -> Either String [(BS.ByteString, BS.ByteString)]
makeStandardJsonIbBps :: ByteString -> Either String [(ByteString, ByteString)]
makeStandardJsonIbBps ByteString
lbs = if Bool
enabledMakeStandardJsonIbBps
  then [(ByteString, ByteString)]
-> Either String [(ByteString, ByteString)]
forall a b. b -> Either a b
Right (ByteString -> [(ByteString, ByteString)]
makeStandardJsonIbBpsUnsafe ByteString
lbs)
  else String -> Either String [(ByteString, ByteString)]
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 = IO [(ByteString, ByteString)] -> [(ByteString, ByteString)]
forall a. IO a -> a
F.unsafeLocalState (IO [(ByteString, ByteString)] -> [(ByteString, ByteString)])
-> IO [(ByteString, ByteString)] -> [(ByteString, ByteString)]
forall a b. (a -> b) -> a -> b
$ do
  WorkBuffers
wb <- Int -> IO WorkBuffers
allocWorkBuffers (Int
32 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1024 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1204)
  WorkState
ws <- Word32 -> IO WorkState
newWorkState Word32
0
  ForeignPtr UInt32
fptrState       :: F.ForeignPtr F.UInt32  <- IO (ForeignPtr UInt32)
forall a. Storable a => IO (ForeignPtr a)
F.mallocForeignPtr
  ForeignPtr UInt64
fptrRemBits     :: F.ForeignPtr F.UInt64  <- IO (ForeignPtr UInt64)
forall a. Storable a => IO (ForeignPtr a)
F.mallocForeignPtr
  ForeignPtr UInt64
fptrRemBitsLen  :: F.ForeignPtr F.Size    <- IO (ForeignPtr UInt64)
forall a. Storable a => IO (ForeignPtr a)
F.mallocForeignPtr
  let ptrState :: Ptr UInt32
ptrState      = ForeignPtr UInt32 -> Ptr UInt32
forall a. ForeignPtr a -> Ptr a
F.unsafeForeignPtrToPtr ForeignPtr UInt32
fptrState
  let ptrRemBits :: Ptr UInt64
ptrRemBits    = ForeignPtr UInt64 -> Ptr UInt64
forall a. ForeignPtr a -> Ptr a
F.unsafeForeignPtrToPtr ForeignPtr UInt64
fptrRemBits
  let ptrRemBitsLen :: Ptr UInt64
ptrRemBitsLen = ForeignPtr UInt64 -> Ptr UInt64
forall a. ForeignPtr a -> Ptr a
F.unsafeForeignPtrToPtr ForeignPtr UInt64
fptrRemBitsLen
  Ptr UInt32 -> UInt32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
F.poke Ptr UInt32
ptrState       UInt32
0
  Ptr UInt64 -> UInt64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
F.poke Ptr UInt64
ptrRemBits     UInt64
0
  Ptr UInt64 -> UInt64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
F.poke Ptr UInt64
ptrRemBitsLen  UInt64
0
  IO [(ByteString, ByteString)] -> IO [(ByteString, ByteString)]
forall a. IO a -> IO a
IO.unsafeInterleaveIO (IO [(ByteString, ByteString)] -> IO [(ByteString, ByteString)])
-> IO [(ByteString, ByteString)] -> IO [(ByteString, ByteString)]
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  <- Int -> IO (ForeignPtr Word8)
forall a. Int -> IO (ForeignPtr a)
F.mallocForeignPtrBytes Int
8
          let resBpPtr :: Ptr UInt64
resBpPtr      = Ptr Word8 -> Ptr UInt64
forall a b. Ptr a -> Ptr b
F.castPtr (ForeignPtr Word8 -> Ptr Word8
forall a. ForeignPtr a -> Ptr a
F.unsafeForeignPtrToPtr ForeignPtr Word8
resBpFptr  )
          let ptrRemBits :: Ptr UInt64
ptrRemBits    = ForeignPtr UInt64 -> Ptr UInt64
forall a. ForeignPtr a -> Ptr a
F.unsafeForeignPtrToPtr ForeignPtr UInt64
fptrRemBits
          let ptrRemBitsLen :: Ptr UInt64
ptrRemBitsLen = ForeignPtr UInt64 -> Ptr UInt64
forall a. ForeignPtr a -> Ptr a
F.unsafeForeignPtrToPtr ForeignPtr UInt64
fptrRemBitsLen
          UInt64
remBits     <- Ptr UInt64 -> IO UInt64
forall a. Storable a => Ptr a -> IO a
F.peek Ptr UInt64
ptrRemBits
          UInt64
remBitsLen  <- Ptr UInt64 -> IO UInt64
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     -- remaining_bp_bits
            UInt64
remBitsLen  -- remaning_bp_bits_len
            Ptr UInt64
resBpPtr    -- out_buffer
          [(ByteString, ByteString)] -> IO [(ByteString, ByteString)]
forall (m :: * -> *) a. Monad m => a -> m a
return  [ ( ByteString
BS.empty
                    , ForeignPtr Word8 -> Int -> Int -> ByteString
BSI.fromForeignPtr ForeignPtr Word8
resBpFptr Int
0 (UInt64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral UInt64
bpByteLen Int -> Int -> Int
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
7) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8
          ForeignPtr Word8
resIbFptr  <- Int -> IO (ForeignPtr Word8)
forall a. Int -> IO (ForeignPtr a)
F.mallocForeignPtrBytes Int
idxByteLen
          ForeignPtr Word8
resBpFptr  <- Int -> IO (ForeignPtr Word8)
forall a. Int -> IO (ForeignPtr a)
F.mallocForeignPtrBytes Int
idxByteLen
          let resIbPtr :: Ptr UInt8
resIbPtr      = Ptr Word8 -> Ptr UInt8
forall a b. Ptr a -> Ptr b
F.castPtr (ForeignPtr Word8 -> Ptr Word8
forall a. ForeignPtr a -> Ptr a
F.unsafeForeignPtrToPtr ForeignPtr Word8
resIbFptr  )
          let resBpPtr :: Ptr UInt64
resBpPtr      = Ptr Word8 -> Ptr UInt64
forall a b. Ptr a -> Ptr b
F.castPtr (ForeignPtr Word8 -> Ptr Word8
forall a. ForeignPtr a -> Ptr a
F.unsafeForeignPtrToPtr ForeignPtr Word8
resBpFptr  )
          let bsPtr :: Ptr Any
bsPtr         = Ptr Word8 -> Ptr Any
forall a b. Ptr a -> Ptr b
F.castPtr (ForeignPtr Word8 -> Ptr Word8
forall a. ForeignPtr a -> Ptr a
F.unsafeForeignPtrToPtr ForeignPtr Word8
bsFptr)
          let ptrState :: Ptr UInt32
ptrState      = ForeignPtr UInt32 -> Ptr UInt32
forall a. ForeignPtr a -> Ptr a
F.unsafeForeignPtrToPtr ForeignPtr UInt32
fptrState
          let ptrRemBits :: Ptr UInt64
ptrRemBits    = ForeignPtr UInt64 -> Ptr UInt64
forall a. ForeignPtr a -> Ptr a
F.unsafeForeignPtrToPtr ForeignPtr UInt64
fptrRemBits
          let ptrRemBitsLen :: Ptr UInt64
ptrRemBitsLen = ForeignPtr UInt64 -> Ptr UInt64
forall a. ForeignPtr a -> Ptr a
F.unsafeForeignPtrToPtr ForeignPtr UInt64
fptrRemBitsLen
          Word8
s :: Word8 <- UInt32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (UInt32 -> Word8) -> IO UInt32 -> IO Word8
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr UInt32 -> IO UInt32
forall a. Storable a => Ptr a -> IO a
F.peek Ptr UInt32
ptrState
          IO () -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr UInt8 -> UInt64 -> Ptr UInt32 -> Ptr UInt32 -> IO ()
F.smProcessChunk
            (Ptr Any -> Int -> Ptr UInt8
forall a b. Ptr a -> Int -> Ptr b
F.plusPtr Ptr Any
bsPtr Int
bsOff) -- in_buffer:   Ptr UInt8
            (Int -> UInt64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
bsLen)    -- in_length:   Size
            Ptr UInt32
ptrState                -- work state:  Ptr UInt32
            (WorkBuffers -> Ptr UInt32
workBuffersP WorkBuffers
wb)       -- result_phi:  Ptr UInt8
          IO () -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ UInt8
-> Ptr UInt32
-> UInt64
-> Ptr UInt8
-> Ptr UInt8
-> Ptr UInt8
-> IO ()
F.smMakeIbOpClChunks
            (Word8 -> UInt8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
s)          -- state
            (WorkBuffers -> Ptr UInt32
workBuffersP WorkBuffers
wb)         -- in_phis
            (Int -> UInt64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
bsLen)      -- phi_length
            Ptr UInt8
resIbPtr                  -- out_ibs
            (WorkBuffers -> Ptr UInt8
workBuffersO WorkBuffers
wb)         -- out_ops
            (WorkBuffers -> Ptr UInt8
workBuffersC WorkBuffers
wb)         -- out_cls
          UInt64
bpByteLen <- Ptr UInt8
-> Ptr UInt8
-> UInt64
-> Ptr UInt64
-> Ptr UInt64
-> Ptr UInt64
-> IO UInt64
F.smWriteBpChunk
            (WorkBuffers -> Ptr UInt8
workBuffersO WorkBuffers
wb)         -- result_op
            (WorkBuffers -> Ptr UInt8
workBuffersC WorkBuffers
wb)         -- result_cl
            (Int -> UInt64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
idxByteLen) -- ib_bytes
            Ptr UInt64
ptrRemBits                -- remaining_bp_bits
            Ptr UInt64
ptrRemBitsLen             -- remaning_bp_bits_len
            Ptr UInt64
resBpPtr                  -- out_buffer
          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 (UInt64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral UInt64
bpByteLen Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8)
                )
          [(ByteString, ByteString)]
rs <- IO [(ByteString, ByteString)] -> IO [(ByteString, ByteString)]
forall a. IO a -> IO a
IO.unsafeInterleaveIO (IO [(ByteString, ByteString)] -> IO [(ByteString, ByteString)])
-> IO [(ByteString, ByteString)] -> IO [(ByteString, ByteString)]
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
          [(ByteString, ByteString)] -> IO [(ByteString, ByteString)]
forall (m :: * -> *) a. Monad m => a -> m a
return ((ByteString, ByteString)
r(ByteString, ByteString)
-> [(ByteString, ByteString)] -> [(ByteString, ByteString)]
forall 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