{-# language MagicHash #-}
{-# language UnboxedTuples #-}
{-# language DerivingStrategies #-}
{-# language StandaloneDeriving #-}
{-# language GeneralizedNewtypeDeriving #-}
{-# language PolyKinds #-}
{-# language DataKinds #-}
{-# language CPP #-}

module Data.Primitive.ByteArray.Unaligned
  ( -- * Class
    PrimUnaligned(..)
    -- * Array access
  , indexUnalignedByteArray
  , readUnalignedByteArray
  , writeUnalignedByteArray
  ) where

import Control.Monad.Primitive (PrimMonad,PrimState)
import Control.Monad.Primitive (primitive,primitive_)
import Data.Primitive.ByteArray (MutableByteArray(..))
import Data.Primitive.ByteArray (ByteArray(..))
import Data.Word (Word8,Word64)
import Data.Int (Int8,Int64)
import GHC.Int (Int16(I16#),Int32(I32#),Int(I#))
import GHC.Word (Word16(W16#),Word32(W32#),Word(W#))
import GHC.Exts (Int#,State#,MutableByteArray#,ByteArray#)
import GHC.Exts (Char(C#),Double(D#),Float(F#),Ptr(Ptr))
import qualified Foreign.C.Types as C
import qualified System.Posix.Types as P
import qualified Data.Primitive.Unaligned.Mach as M
import qualified Data.Primitive as PM
import qualified GHC.Exts as E

-- | Class of types supporting primitive array operations
-- that are not necessarily aligned. The offsets for all
-- of the typeclass methods are interpreted as bytes,
-- not elements.
class PrimUnaligned a where
  indexUnalignedByteArray# ::
    ByteArray# -> Int# -> a
  readUnalignedByteArray# ::
       MutableByteArray# s
    -> Int#
    -> State# s
    -> (# State# s, a #)
  writeUnalignedByteArray# ::
       MutableByteArray# s
    -> Int#
    -> a
    -> State# s
    -> State# s

instance PrimUnaligned Word8 where
  indexUnalignedByteArray# :: ByteArray# -> Int# -> Word8
indexUnalignedByteArray# = forall a. Prim a => ByteArray# -> Int# -> a
PM.indexByteArray#
  readUnalignedByteArray# :: forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, Word8 #)
readUnalignedByteArray# = forall a s.
Prim a =>
MutableByteArray# s -> Int# -> State# s -> (# State# s, a #)
PM.readByteArray#
  writeUnalignedByteArray# :: forall s.
MutableByteArray# s -> Int# -> Word8 -> State# s -> State# s
writeUnalignedByteArray# = forall a s.
Prim a =>
MutableByteArray# s -> Int# -> a -> State# s -> State# s
PM.writeByteArray#

instance PrimUnaligned Word16 where
  {-# inline indexUnalignedByteArray# #-}
  {-# inline readUnalignedByteArray# #-}
  {-# inline writeUnalignedByteArray# #-}
  indexUnalignedByteArray# :: ByteArray# -> Int# -> Word16
indexUnalignedByteArray# ByteArray#
a Int#
i =
    Word16# -> Word16
W16# (ByteArray# -> Int# -> Word16#
E.indexWord8ArrayAsWord16# ByteArray#
a Int#
i)
  readUnalignedByteArray# :: forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, Word16 #)
readUnalignedByteArray# MutableByteArray# s
a Int#
i State# s
s0 =
    case forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Word16# #)
E.readWord8ArrayAsWord16# MutableByteArray# s
a Int#
i State# s
s0 of
      (# State# s
s1, Word16#
r #) -> (# State# s
s1, Word16# -> Word16
W16# Word16#
r #)
  writeUnalignedByteArray# :: forall s.
MutableByteArray# s -> Int# -> Word16 -> State# s -> State# s
writeUnalignedByteArray# MutableByteArray# s
a Int#
i (W16# Word16#
w) =
    forall d.
MutableByteArray# d -> Int# -> Word16# -> State# d -> State# d
E.writeWord8ArrayAsWord16# MutableByteArray# s
a Int#
i Word16#
w

instance PrimUnaligned Word32 where
  {-# inline indexUnalignedByteArray# #-}
  {-# inline readUnalignedByteArray# #-}
  {-# inline writeUnalignedByteArray# #-}
  indexUnalignedByteArray# :: ByteArray# -> Int# -> Word32
indexUnalignedByteArray# ByteArray#
a Int#
i =
    Word32# -> Word32
W32# (ByteArray# -> Int# -> Word32#
E.indexWord8ArrayAsWord32# ByteArray#
a Int#
i)
  readUnalignedByteArray# :: forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, Word32 #)
readUnalignedByteArray# MutableByteArray# s
a Int#
i State# s
s0 =
    case forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Word32# #)
E.readWord8ArrayAsWord32# MutableByteArray# s
a Int#
i State# s
s0 of
      (# State# s
s1, Word32#
r #) -> (# State# s
s1, Word32# -> Word32
W32# Word32#
r #)
  writeUnalignedByteArray# :: forall s.
MutableByteArray# s -> Int# -> Word32 -> State# s -> State# s
writeUnalignedByteArray# MutableByteArray# s
a Int#
i (W32# Word32#
w) =
    forall d.
MutableByteArray# d -> Int# -> Word32# -> State# d -> State# d
E.writeWord8ArrayAsWord32# MutableByteArray# s
a Int#
i Word32#
w

instance PrimUnaligned Word where
  {-# inline indexUnalignedByteArray# #-}
  {-# inline readUnalignedByteArray# #-}
  {-# inline writeUnalignedByteArray# #-}
  indexUnalignedByteArray# :: ByteArray# -> Int# -> Word
indexUnalignedByteArray# ByteArray#
a Int#
i =
    Word# -> Word
W# (ByteArray# -> Int# -> Word#
E.indexWord8ArrayAsWord# ByteArray#
a Int#
i)
  readUnalignedByteArray# :: forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, Word #)
readUnalignedByteArray# MutableByteArray# s
a Int#
i State# s
s0 =
    case forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Word# #)
E.readWord8ArrayAsWord# MutableByteArray# s
a Int#
i State# s
s0 of
      (# State# s
s1, Word#
r #) -> (# State# s
s1, Word# -> Word
W# Word#
r #)
  writeUnalignedByteArray# :: forall s.
MutableByteArray# s -> Int# -> Word -> State# s -> State# s
writeUnalignedByteArray# MutableByteArray# s
a Int#
i (W# Word#
w) =
    forall d.
MutableByteArray# d -> Int# -> Word# -> State# d -> State# d
E.writeWord8ArrayAsWord# MutableByteArray# s
a Int#
i Word#
w

instance PrimUnaligned Word64 where
  {-# inline indexUnalignedByteArray# #-}
  {-# inline readUnalignedByteArray# #-}
  {-# inline writeUnalignedByteArray# #-}
  indexUnalignedByteArray# :: ByteArray# -> Int# -> Word64
indexUnalignedByteArray# = ByteArray# -> Int# -> Word64
M.indexUnalignedWord64Array#
  readUnalignedByteArray# :: forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, Word64 #)
readUnalignedByteArray# = forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, Word64 #)
M.readUnalignedWord64Array#
  writeUnalignedByteArray# :: forall s.
MutableByteArray# s -> Int# -> Word64 -> State# s -> State# s
writeUnalignedByteArray# = forall s.
MutableByteArray# s -> Int# -> Word64 -> State# s -> State# s
M.writeUnalignedWord64Array#

instance PrimUnaligned Int8 where
  indexUnalignedByteArray# :: ByteArray# -> Int# -> Int8
indexUnalignedByteArray# = forall a. Prim a => ByteArray# -> Int# -> a
PM.indexByteArray#
  readUnalignedByteArray# :: forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, Int8 #)
readUnalignedByteArray# = forall a s.
Prim a =>
MutableByteArray# s -> Int# -> State# s -> (# State# s, a #)
PM.readByteArray#
  writeUnalignedByteArray# :: forall s.
MutableByteArray# s -> Int# -> Int8 -> State# s -> State# s
writeUnalignedByteArray# = forall a s.
Prim a =>
MutableByteArray# s -> Int# -> a -> State# s -> State# s
PM.writeByteArray#

instance PrimUnaligned Int16 where
  {-# inline indexUnalignedByteArray# #-}
  {-# inline readUnalignedByteArray# #-}
  {-# inline writeUnalignedByteArray# #-}
  indexUnalignedByteArray# :: ByteArray# -> Int# -> Int16
indexUnalignedByteArray# ByteArray#
a Int#
i =
    Int16# -> Int16
I16# (ByteArray# -> Int# -> Int16#
E.indexWord8ArrayAsInt16# ByteArray#
a Int#
i)
  readUnalignedByteArray# :: forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, Int16 #)
readUnalignedByteArray# MutableByteArray# s
a Int#
i State# s
s0 =
    case forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Int16# #)
E.readWord8ArrayAsInt16# MutableByteArray# s
a Int#
i State# s
s0 of
      (# State# s
s1, Int16#
r #) -> (# State# s
s1, Int16# -> Int16
I16# Int16#
r #)
  writeUnalignedByteArray# :: forall s.
MutableByteArray# s -> Int# -> Int16 -> State# s -> State# s
writeUnalignedByteArray# MutableByteArray# s
a Int#
i (I16# Int16#
w) =
    forall d.
MutableByteArray# d -> Int# -> Int16# -> State# d -> State# d
E.writeWord8ArrayAsInt16# MutableByteArray# s
a Int#
i Int16#
w

instance PrimUnaligned Int32 where
  {-# inline indexUnalignedByteArray# #-}
  {-# inline readUnalignedByteArray# #-}
  {-# inline writeUnalignedByteArray# #-}
  indexUnalignedByteArray# :: ByteArray# -> Int# -> Int32
indexUnalignedByteArray# ByteArray#
a Int#
i =
    Int32# -> Int32
I32# (ByteArray# -> Int# -> Int32#
E.indexWord8ArrayAsInt32# ByteArray#
a Int#
i)
  readUnalignedByteArray# :: forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, Int32 #)
readUnalignedByteArray# MutableByteArray# s
a Int#
i State# s
s0 =
    case forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Int32# #)
E.readWord8ArrayAsInt32# MutableByteArray# s
a Int#
i State# s
s0 of
      (# State# s
s1, Int32#
r #) -> (# State# s
s1, Int32# -> Int32
I32# Int32#
r #)
  writeUnalignedByteArray# :: forall s.
MutableByteArray# s -> Int# -> Int32 -> State# s -> State# s
writeUnalignedByteArray# MutableByteArray# s
a Int#
i (I32# Int32#
w) =
    forall d.
MutableByteArray# d -> Int# -> Int32# -> State# d -> State# d
E.writeWord8ArrayAsInt32# MutableByteArray# s
a Int#
i Int32#
w

instance PrimUnaligned Int where
  {-# inline indexUnalignedByteArray# #-}
  {-# inline readUnalignedByteArray# #-}
  {-# inline writeUnalignedByteArray# #-}
  indexUnalignedByteArray# :: ByteArray# -> Int# -> Int
indexUnalignedByteArray# ByteArray#
a Int#
i =
    Int# -> Int
I# (ByteArray# -> Int# -> Int#
E.indexWord8ArrayAsInt# ByteArray#
a Int#
i)
  readUnalignedByteArray# :: forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, Int #)
readUnalignedByteArray# MutableByteArray# s
a Int#
i State# s
s0 =
    case forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Int# #)
E.readWord8ArrayAsInt# MutableByteArray# s
a Int#
i State# s
s0 of
      (# State# s
s1, Int#
r #) -> (# State# s
s1, Int# -> Int
I# Int#
r #)
  writeUnalignedByteArray# :: forall s.
MutableByteArray# s -> Int# -> Int -> State# s -> State# s
writeUnalignedByteArray# MutableByteArray# s
a Int#
i (I# Int#
w) =
    forall d.
MutableByteArray# d -> Int# -> Int# -> State# d -> State# d
E.writeWord8ArrayAsInt# MutableByteArray# s
a Int#
i Int#
w

instance PrimUnaligned Int64 where
  {-# inline indexUnalignedByteArray# #-}
  {-# inline readUnalignedByteArray# #-}
  {-# inline writeUnalignedByteArray# #-}
  indexUnalignedByteArray# :: ByteArray# -> Int# -> Int64
indexUnalignedByteArray# = ByteArray# -> Int# -> Int64
M.indexUnalignedInt64Array#
  readUnalignedByteArray# :: forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, Int64 #)
readUnalignedByteArray# = forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, Int64 #)
M.readUnalignedInt64Array#
  writeUnalignedByteArray# :: forall s.
MutableByteArray# s -> Int# -> Int64 -> State# s -> State# s
writeUnalignedByteArray# = forall s.
MutableByteArray# s -> Int# -> Int64 -> State# s -> State# s
M.writeUnalignedInt64Array#

instance PrimUnaligned Char where
  {-# inline indexUnalignedByteArray# #-}
  {-# inline readUnalignedByteArray# #-}
  {-# inline writeUnalignedByteArray# #-}
  indexUnalignedByteArray# :: ByteArray# -> Int# -> Char
indexUnalignedByteArray# ByteArray#
a Int#
i =
    Char# -> Char
C# (ByteArray# -> Int# -> Char#
E.indexWord8ArrayAsWideChar# ByteArray#
a Int#
i)
  readUnalignedByteArray# :: forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, Char #)
readUnalignedByteArray# MutableByteArray# s
a Int#
i State# s
s0 =
    case forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Char# #)
E.readWord8ArrayAsWideChar# MutableByteArray# s
a Int#
i State# s
s0 of
      (# State# s
s1, Char#
r #) -> (# State# s
s1, Char# -> Char
C# Char#
r #)
  writeUnalignedByteArray# :: forall s.
MutableByteArray# s -> Int# -> Char -> State# s -> State# s
writeUnalignedByteArray# MutableByteArray# s
a Int#
i (C# Char#
w) =
    forall d.
MutableByteArray# d -> Int# -> Char# -> State# d -> State# d
E.writeWord8ArrayAsWideChar# MutableByteArray# s
a Int#
i Char#
w

instance PrimUnaligned Double where
  {-# inline indexUnalignedByteArray# #-}
  {-# inline readUnalignedByteArray# #-}
  {-# inline writeUnalignedByteArray# #-}
  indexUnalignedByteArray# :: ByteArray# -> Int# -> Double
indexUnalignedByteArray# ByteArray#
a Int#
i =
    Double# -> Double
D# (ByteArray# -> Int# -> Double#
E.indexWord8ArrayAsDouble# ByteArray#
a Int#
i)
  readUnalignedByteArray# :: forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, Double #)
readUnalignedByteArray# MutableByteArray# s
a Int#
i State# s
s0 =
    case forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Double# #)
E.readWord8ArrayAsDouble# MutableByteArray# s
a Int#
i State# s
s0 of
      (# State# s
s1, Double#
r #) -> (# State# s
s1, Double# -> Double
D# Double#
r #)
  writeUnalignedByteArray# :: forall s.
MutableByteArray# s -> Int# -> Double -> State# s -> State# s
writeUnalignedByteArray# MutableByteArray# s
a Int#
i (D# Double#
w) =
    forall d.
MutableByteArray# d -> Int# -> Double# -> State# d -> State# d
E.writeWord8ArrayAsDouble# MutableByteArray# s
a Int#
i Double#
w

instance PrimUnaligned Float where
  {-# inline indexUnalignedByteArray# #-}
  {-# inline readUnalignedByteArray# #-}
  {-# inline writeUnalignedByteArray# #-}
  indexUnalignedByteArray# :: ByteArray# -> Int# -> Float
indexUnalignedByteArray# ByteArray#
a Int#
i =
    Float# -> Float
F# (ByteArray# -> Int# -> Float#
E.indexWord8ArrayAsFloat# ByteArray#
a Int#
i)
  readUnalignedByteArray# :: forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, Float #)
readUnalignedByteArray# MutableByteArray# s
a Int#
i State# s
s0 =
    case forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Float# #)
E.readWord8ArrayAsFloat# MutableByteArray# s
a Int#
i State# s
s0 of
      (# State# s
s1, Float#
r #) -> (# State# s
s1, Float# -> Float
F# Float#
r #)
  writeUnalignedByteArray# :: forall s.
MutableByteArray# s -> Int# -> Float -> State# s -> State# s
writeUnalignedByteArray# MutableByteArray# s
a Int#
i (F# Float#
w) =
    forall d.
MutableByteArray# d -> Int# -> Float# -> State# d -> State# d
E.writeWord8ArrayAsFloat# MutableByteArray# s
a Int#
i Float#
w

instance PrimUnaligned (Ptr a) where
  {-# inline indexUnalignedByteArray# #-}
  {-# inline readUnalignedByteArray# #-}
  {-# inline writeUnalignedByteArray# #-}
  indexUnalignedByteArray# :: ByteArray# -> Int# -> Ptr a
indexUnalignedByteArray# ByteArray#
a Int#
i =
    forall a. Addr# -> Ptr a
Ptr (ByteArray# -> Int# -> Addr#
E.indexWord8ArrayAsAddr# ByteArray#
a Int#
i)
  readUnalignedByteArray# :: forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, Ptr a #)
readUnalignedByteArray# MutableByteArray# s
a Int#
i State# s
s0 =
    case forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Addr# #)
E.readWord8ArrayAsAddr# MutableByteArray# s
a Int#
i State# s
s0 of
      (# State# s
s1, Addr#
r #) -> (# State# s
s1, forall a. Addr# -> Ptr a
Ptr Addr#
r #)
  writeUnalignedByteArray# :: forall s.
MutableByteArray# s -> Int# -> Ptr a -> State# s -> State# s
writeUnalignedByteArray# MutableByteArray# s
a Int#
i (Ptr Addr#
w) =
    forall d.
MutableByteArray# d -> Int# -> Addr# -> State# d -> State# d
E.writeWord8ArrayAsAddr# MutableByteArray# s
a Int#
i Addr#
w

#if defined(HTYPE_CC_T)
deriving newtype instance PrimUnaligned P.CCc
#endif
#if defined(HTYPE_GID_T)
deriving newtype instance PrimUnaligned P.CGid
#endif
#if defined(HTYPE_NLINK_T)
deriving newtype instance PrimUnaligned P.CNlink
#endif
#if defined(HTYPE_UID_T)
deriving newtype instance PrimUnaligned P.CUid
#endif

deriving newtype instance PrimUnaligned C.CChar
deriving newtype instance PrimUnaligned P.CDev
deriving newtype instance PrimUnaligned C.CDouble
deriving newtype instance PrimUnaligned P.CIno
deriving newtype instance PrimUnaligned C.CInt
deriving newtype instance PrimUnaligned C.CLLong
deriving newtype instance PrimUnaligned C.CLong
deriving newtype instance PrimUnaligned P.CMode
deriving newtype instance PrimUnaligned P.COff
deriving newtype instance PrimUnaligned P.CPid
deriving newtype instance PrimUnaligned C.CSChar
deriving newtype instance PrimUnaligned P.CSsize
deriving newtype instance PrimUnaligned C.CShort
deriving newtype instance PrimUnaligned C.CUInt
deriving newtype instance PrimUnaligned C.CULLong
deriving newtype instance PrimUnaligned C.CULong
deriving newtype instance PrimUnaligned P.Fd

-- | Read a primitive value from the byte array.
-- The offset is given in bytes rather than in elements
-- of type @a@.
indexUnalignedByteArray ::
     PrimUnaligned a
  => ByteArray -- ^ Immutable array
  -> Int -- ^ Offset in bytes
  -> a
indexUnalignedByteArray :: forall a. PrimUnaligned a => ByteArray -> Int -> a
indexUnalignedByteArray (ByteArray ByteArray#
a) (I# Int#
i) =
  forall a. PrimUnaligned a => ByteArray# -> Int# -> a
indexUnalignedByteArray# ByteArray#
a Int#
i

-- | Read a primitive value from the byte array.
-- The offset is given in bytes rather than in elements
-- of type @a@.
readUnalignedByteArray ::
     (PrimMonad m, PrimUnaligned a)
  => MutableByteArray (PrimState m) -- ^ Mutable array
  -> Int -- ^ Offset in bytes
  -> m a
readUnalignedByteArray :: forall (m :: * -> *) a.
(PrimMonad m, PrimUnaligned a) =>
MutableByteArray (PrimState m) -> Int -> m a
readUnalignedByteArray (MutableByteArray MutableByteArray# (PrimState m)
a) (I# Int#
i) =
  forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive (forall a s.
PrimUnaligned a =>
MutableByteArray# s -> Int# -> State# s -> (# State# s, a #)
readUnalignedByteArray# MutableByteArray# (PrimState m)
a Int#
i)

-- | Write a primitive value to the byte array.
-- The offset is given in bytes rather than in elements
-- of type @a@.
writeUnalignedByteArray ::
     (PrimMonad m, PrimUnaligned a)
  => MutableByteArray (PrimState m) -- ^ Mutable array
  -> Int -- ^ Offset in bytes
  -> a -- ^ Element
  -> m ()
writeUnalignedByteArray :: forall (m :: * -> *) a.
(PrimMonad m, PrimUnaligned a) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeUnalignedByteArray (MutableByteArray MutableByteArray# (PrimState m)
a) (I# Int#
i) a
x =
  forall (m :: * -> *).
PrimMonad m =>
(State# (PrimState m) -> State# (PrimState m)) -> m ()
primitive_ (forall a s.
PrimUnaligned a =>
MutableByteArray# s -> Int# -> a -> State# s -> State# s
writeUnalignedByteArray# MutableByteArray# (PrimState m)
a Int#
i a
x)