{-# LANGUAGE UnboxedTuples #-}

{- | Struct serializer: serialize fields of known length.

In Haskell-ish terminology, one may consider a C struct to be a product type
where each field is of known length. Thus, fields may be accessed by a fixed
offset from the struct start. This is convenient for efficient access, since
those offsets may be turned into immediates on a register in a MOV instruction.

Given a struct-like type, we don't need to track "bytes serialized so far" like
the general case. We can serialize fields in any order we like, since we know
where they will sit in the resulting bytestring.

This module provides a serializer specifically for these struct-like types.
Maybe GHC can write more efficient code for these super-simple types!
I have no idea. So I'm trying it, and will compare performance.

Notably, this serializer is much less flexible. No monoid! I don't really expect
anyone to write manual stuff with it-- you should just use the generics.
That reminds me, TODO could easily provide some TH too, and again compare.
-}

module Bytezap.Struct where

import GHC.Exts
import Raehik.Compat.Data.Primitive.Types

import Control.Monad.Primitive ( MonadPrim, primitive )
import Data.Word ( Word8 )
import Data.ByteString qualified as BS
import Data.ByteString.Internal qualified as BS

import GHC.Word ( Word8(W8#) )
import Raehik.Compat.GHC.Exts.GHC908MemcpyPrimops ( setAddrRange# )

-- | A struct poker: base address (constant), byte offset, state token.
--
-- We could combine base address and byte offset, but we're aiming for code that
-- stores the address in a register and uses immediates to access fields (like
-- a good C compiler will do for its structs). So by keeping them separate, I'm
-- hoping that we can nudge GHC towards such behaviour.
type Poke# s = Addr# -> Int# -> State# s -> State# s

-- | Poke newtype wrapper.
newtype Poke s = Poke { forall s. Poke s -> Poke# s
unPoke :: Poke# s }

-- One may write a valid 'Semigroup' instance, but it's nonsensical, so let's
-- not.

-- | Execute a 'Poke' at a fresh 'BS.ByteString' of the given length.
unsafeRunPokeBS :: Int -> Poke RealWorld -> BS.ByteString
unsafeRunPokeBS :: Int -> Poke RealWorld -> ByteString
unsafeRunPokeBS Int
len Poke RealWorld
p = Int -> (Ptr Word8 -> IO ()) -> ByteString
BS.unsafeCreate Int
len (Poke RealWorld -> Ptr Word8 -> IO ()
forall s (m :: Type -> Type).
MonadPrim s m =>
Poke s -> Ptr Word8 -> m ()
unsafeRunPoke Poke RealWorld
p)

-- | Execute a 'Poke' at a pointer. Returns the number of bytes written.
--
-- The pointer must be a mutable buffer with enough space to hold the poke.
-- Absolutely none of this is checked. Use with caution. Sensible uses:
--
-- * implementing pokes to ByteStrings and the like
-- * executing known-length (!!) pokes to known-length (!!) buffers e.g.
--   together with allocaBytes
unsafeRunPoke :: MonadPrim s m => Poke s -> Ptr Word8 -> m ()
unsafeRunPoke :: forall s (m :: Type -> Type).
MonadPrim s m =>
Poke s -> Ptr Word8 -> m ()
unsafeRunPoke (Poke Poke# s
p) (Ptr Addr#
base#) = (State# (PrimState m) -> (# State# (PrimState m), () #)) -> m ()
forall a.
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
forall (m :: Type -> Type) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive ((State# (PrimState m) -> (# State# (PrimState m), () #)) -> m ())
-> (State# (PrimState m) -> (# State# (PrimState m), () #)) -> m ()
forall a b. (a -> b) -> a -> b
$ \State# (PrimState m)
s0 -> (# Poke# s
p Addr#
base# Int#
0# State# s
State# (PrimState m)
s0, () #)

-- | Poke a type via its 'Prim'' instance.
prim :: forall a s. Prim' a => a -> Poke s
prim :: forall a s. Prim' a => a -> Poke s
prim a
a = Poke# s -> Poke s
forall s. Poke# s -> Poke s
Poke (Poke# s -> Poke s) -> Poke# s -> Poke s
forall a b. (a -> b) -> a -> b
$ \Addr#
base# Int#
os# State# s
s0 -> Addr# -> Int# -> a -> State# s -> State# s
forall s. Addr# -> Int# -> a -> State# s -> State# s
forall a s. Prim' a => Addr# -> Int# -> a -> State# s -> State# s
writeWord8OffAddrAs# Addr#
base# Int#
os# a
a State# s
s0

-- | The empty poke. Provided here as we can't provide it via 'Monoid.empty'.
emptyPoke :: Poke s
emptyPoke :: forall s. Poke s
emptyPoke = Poke# s -> Poke s
forall s. Poke# s -> Poke s
Poke (Poke# s -> Poke s) -> Poke# s -> Poke s
forall a b. (a -> b) -> a -> b
$ \Addr#
_base# Int#
_os# State# s
s0 -> State# s
s0

-- | Sequence two 'Poke's. We only require the length of the left poke.
sequencePokes :: Poke s -> Int -> Poke s -> Poke s
sequencePokes :: forall s. Poke s -> Int -> Poke s -> Poke s
sequencePokes (Poke Poke# s
pl) (I# Int#
ll#) (Poke Poke# s
pr) = Poke# s -> Poke s
forall s. Poke# s -> Poke s
Poke (Poke# s -> Poke s) -> Poke# s -> Poke s
forall a b. (a -> b) -> a -> b
$ \Addr#
base# Int#
os# State# s
s0 -> do
    case Poke# s
pl Addr#
base# Int#
os# State# s
s0 of State# s
s1 -> Poke# s
pr Addr#
base# (Int#
os# Int# -> Int# -> Int#
+# Int#
ll#) State# s
s1

-- | essentially memset
replicateByte :: Int -> Word8 -> Poke RealWorld
replicateByte :: Int -> Word8 -> Poke RealWorld
replicateByte (I# Int#
len#) (W8# Word8#
byte#) = Poke# RealWorld -> Poke RealWorld
forall s. Poke# s -> Poke s
Poke (Poke# RealWorld -> Poke RealWorld)
-> Poke# RealWorld -> Poke RealWorld
forall a b. (a -> b) -> a -> b
$ \Addr#
base# Int#
os# State# RealWorld
s0 ->
    Addr# -> Int# -> Int# -> State# RealWorld -> State# RealWorld
setAddrRange# (Addr#
base# Addr# -> Int# -> Addr#
`plusAddr#` Int#
os#) Int#
len# Int#
byteAsInt# State# RealWorld
s0
  where
    byteAsInt# :: Int#
byteAsInt# = Word# -> Int#
word2Int# (Word8# -> Word#
word8ToWord# Word8#
byte#)