{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE CPP #-}

module Bytezap.Poke.Int where

import Bytezap
import GHC.Exts
import Data.Word
import GHC.Word
import Data.Int
import GHC.Int

w8 :: Word8 -> Poke
w8 :: Word8 -> Poke
w8 (W8# Word8#
a#) = Poke# -> Poke
Poke (Poke# -> Poke) -> Poke# -> Poke
forall a b. (a -> b) -> a -> b
$ \Addr#
addr# State# RealWorld
st# ->
    case Addr# -> Int# -> Word8# -> State# RealWorld -> State# RealWorld
forall d. Addr# -> Int# -> Word8# -> State# d -> State# d
writeWord8OffAddr# Addr#
addr# Int#
0# Word8#
a# State# RealWorld
st# of
      State# RealWorld
st'# -> (# State# RealWorld
st'#, Addr#
addr# Addr# -> Int# -> Addr#
`plusAddr#` Int#
1# #)
{-# INLINE w8 #-}

w16 :: Word16 -> Poke
w16 :: Word16 -> Poke
w16 (W16# Word16#
a#) = Poke# -> Poke
Poke (Poke# -> Poke) -> Poke# -> Poke
forall a b. (a -> b) -> a -> b
$ \Addr#
addr# State# RealWorld
st# ->
    case Addr# -> Int# -> Word16# -> State# RealWorld -> State# RealWorld
forall d. Addr# -> Int# -> Word16# -> State# d -> State# d
writeWord16OffAddr# Addr#
addr# Int#
0# Word16#
a# State# RealWorld
st# of
      State# RealWorld
st'# -> (# State# RealWorld
st'#, Addr#
addr# Addr# -> Int# -> Addr#
`plusAddr#` Int#
2# #)
{-# INLINE w16 #-}

w32 :: Word32 -> Poke
w32 :: Word32 -> Poke
w32 (W32# Word32#
a#) = Poke# -> Poke
Poke (Poke# -> Poke) -> Poke# -> Poke
forall a b. (a -> b) -> a -> b
$ \Addr#
addr# State# RealWorld
st# ->
    case Addr# -> Int# -> Word32# -> State# RealWorld -> State# RealWorld
forall d. Addr# -> Int# -> Word32# -> State# d -> State# d
writeWord32OffAddr# Addr#
addr# Int#
0# Word32#
a# State# RealWorld
st# of
      State# RealWorld
st'# -> (# State# RealWorld
st'#, Addr#
addr# Addr# -> Int# -> Addr#
`plusAddr#` Int#
4# #)
{-# INLINE w32 #-}

w64 :: Word64 -> Poke
w64 :: Word64 -> Poke
w64 (W64# Word64#
a#) = Poke# -> Poke
Poke (Poke# -> Poke) -> Poke# -> Poke
forall a b. (a -> b) -> a -> b
$ \Addr#
addr# State# RealWorld
st# ->
    case Addr# -> Int# -> Word64# -> State# RealWorld -> State# RealWorld
forall d. Addr# -> Int# -> Word64# -> State# d -> State# d
writeWord64OffAddr# Addr#
addr# Int#
0# Word64#
a# State# RealWorld
st# of
      State# RealWorld
st'# -> (# State# RealWorld
st'#, Addr#
addr# Addr# -> Int# -> Addr#
`plusAddr#` Int#
8# #)
{-# INLINE w64 #-}

{-# INLINE w16le #-}
{-# INLINE w16be #-}
w16le, w16be :: Word16 -> Poke
#ifdef WORDS_BIGENDIAN
w16le = w16 . byteSwap16
w16be = w16
#else
w16le :: Word16 -> Poke
w16le = Word16 -> Poke
w16
w16be :: Word16 -> Poke
w16be = Word16 -> Poke
w16 (Word16 -> Poke) -> (Word16 -> Word16) -> Word16 -> Poke
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Word16
byteSwap16
#endif

{-# INLINE w32le #-}
{-# INLINE w32be #-}
w32le, w32be :: Word32 -> Poke
#ifdef WORDS_BIGENDIAN
w32le = w32 . byteSwap32
w32be = w32
#else
w32le :: Word32 -> Poke
w32le = Word32 -> Poke
w32
w32be :: Word32 -> Poke
w32be = Word32 -> Poke
w32 (Word32 -> Poke) -> (Word32 -> Word32) -> Word32 -> Poke
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Word32
byteSwap32
#endif

{-# INLINE w64le #-}
{-# INLINE w64be #-}
w64le, w64be :: Word64 -> Poke
#ifdef WORDS_BIGENDIAN
w64le = w64 . byteSwap64
w64be = w64
#else
w64le :: Word64 -> Poke
w64le = Word64 -> Poke
w64
w64be :: Word64 -> Poke
w64be = Word64 -> Poke
w64 (Word64 -> Poke) -> (Word64 -> Word64) -> Word64 -> Poke
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Word64
byteSwap64
#endif

i8 :: Int8 -> Poke
i8 :: Int8 -> Poke
i8 (I8# Int8#
a#) = Poke# -> Poke
Poke (Poke# -> Poke) -> Poke# -> Poke
forall a b. (a -> b) -> a -> b
$ \Addr#
addr# State# RealWorld
st# ->
    case Addr# -> Int# -> Int8# -> State# RealWorld -> State# RealWorld
forall d. Addr# -> Int# -> Int8# -> State# d -> State# d
writeInt8OffAddr# Addr#
addr# Int#
0# Int8#
a# State# RealWorld
st# of
      State# RealWorld
st'# -> (# State# RealWorld
st'#, Addr#
addr# Addr# -> Int# -> Addr#
`plusAddr#` Int#
1# #)
{-# INLINE i8 #-}

i16 :: Int16 -> Poke
i16 :: Int16 -> Poke
i16 (I16# Int16#
a#) = Poke# -> Poke
Poke (Poke# -> Poke) -> Poke# -> Poke
forall a b. (a -> b) -> a -> b
$ \Addr#
addr# State# RealWorld
st# ->
    case Addr# -> Int# -> Int16# -> State# RealWorld -> State# RealWorld
forall d. Addr# -> Int# -> Int16# -> State# d -> State# d
writeInt16OffAddr# Addr#
addr# Int#
0# Int16#
a# State# RealWorld
st# of
      State# RealWorld
st'# -> (# State# RealWorld
st'#, Addr#
addr# Addr# -> Int# -> Addr#
`plusAddr#` Int#
2# #)
{-# INLINE i16 #-}

i32 :: Int32 -> Poke
i32 :: Int32 -> Poke
i32 (I32# Int32#
a#) = Poke# -> Poke
Poke (Poke# -> Poke) -> Poke# -> Poke
forall a b. (a -> b) -> a -> b
$ \Addr#
addr# State# RealWorld
st# ->
    case Addr# -> Int# -> Int32# -> State# RealWorld -> State# RealWorld
forall d. Addr# -> Int# -> Int32# -> State# d -> State# d
writeInt32OffAddr# Addr#
addr# Int#
0# Int32#
a# State# RealWorld
st# of
      State# RealWorld
st'# -> (# State# RealWorld
st'#, Addr#
addr# Addr# -> Int# -> Addr#
`plusAddr#` Int#
4# #)
{-# INLINE i32 #-}

i64 :: Int64 -> Poke
i64 :: Int64 -> Poke
i64 (I64# Int64#
a#) = Poke# -> Poke
Poke (Poke# -> Poke) -> Poke# -> Poke
forall a b. (a -> b) -> a -> b
$ \Addr#
addr# State# RealWorld
st# ->
    case Addr# -> Int# -> Int64# -> State# RealWorld -> State# RealWorld
forall d. Addr# -> Int# -> Int64# -> State# d -> State# d
writeInt64OffAddr# Addr#
addr# Int#
0# Int64#
a# State# RealWorld
st# of
      State# RealWorld
st'# -> (# State# RealWorld
st'#, Addr#
addr# Addr# -> Int# -> Addr#
`plusAddr#` Int#
8# #)
{-# INLINE i64 #-}

byteSwapI16 :: Int16 -> Int16
byteSwapI16 :: Int16 -> Int16
byteSwapI16 = Int16 -> Int16
forall a. HasCallStack => a
undefined

byteSwapI32 :: Int32 -> Int32
byteSwapI32 :: Int32 -> Int32
byteSwapI32 = Int32 -> Int32
forall a. HasCallStack => a
undefined

byteSwapI64 :: Int64 -> Int64
byteSwapI64 :: Int64 -> Int64
byteSwapI64 = Int64 -> Int64
forall a. HasCallStack => a
undefined

{-# INLINE i16le #-}
{-# INLINE i16be #-}
i16le, i16be :: Int16 -> Poke
#ifdef WORDS_BIGENDIAN
i16le = i16 . byteSwapI16
i16be = i16
#else
i16le :: Int16 -> Poke
i16le = Int16 -> Poke
i16
i16be :: Int16 -> Poke
i16be = Int16 -> Poke
i16 (Int16 -> Poke) -> (Int16 -> Int16) -> Int16 -> Poke
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> Int16
byteSwapI16
#endif

{-# INLINE i32le #-}
{-# INLINE i32be #-}
i32le, i32be :: Int32 -> Poke
#ifdef WORDS_BIGENDIAN
i32le = i32 . byteSwapI32
i32be = i32
#else
i32le :: Int32 -> Poke
i32le = Int32 -> Poke
i32
i32be :: Int32 -> Poke
i32be = Int32 -> Poke
i32 (Int32 -> Poke) -> (Int32 -> Int32) -> Int32 -> Poke
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Int32
byteSwapI32
#endif

{-# INLINE i64le #-}
{-# INLINE i64be #-}
i64le, i64be :: Int64 -> Poke
#ifdef WORDS_BIGENDIAN
i64le = i64 . byteSwapI64
i64be = i64
#else
i64le :: Int64 -> Poke
i64le = Int64 -> Poke
i64
i64be :: Int64 -> Poke
i64be = Int64 -> Poke
i64 (Int64 -> Poke) -> (Int64 -> Int64) -> Int64 -> Poke
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Int64
byteSwapI64
#endif

-- TODO assumes 64-bit
int# :: Int# -> Poke
int# :: Int# -> Poke
int# Int#
a# = Poke# -> Poke
Poke (Poke# -> Poke) -> Poke# -> Poke
forall a b. (a -> b) -> a -> b
$ \Addr#
addr# State# RealWorld
st# ->
    case Addr# -> Int# -> Int# -> State# RealWorld -> State# RealWorld
forall d. Addr# -> Int# -> Int# -> State# d -> State# d
writeIntOffAddr# Addr#
addr# Int#
0# Int#
a# State# RealWorld
st# of
      State# RealWorld
st'# -> (# State# RealWorld
st'#, Addr#
addr# Addr# -> Int# -> Addr#
`plusAddr#` Int#
8# #)
{-# INLINE int# #-}