{-# language CPP #-}
{-# language MagicHash #-}
{-# language UnboxedTuples #-}

module Data.Primitive.Unaligned.Mach
  ( indexUnalignedInt64Array#
  , indexUnalignedWord64Array#
  , readUnalignedInt64Array#
  , readUnalignedWord64Array#
  , writeUnalignedInt64Array#
  , writeUnalignedWord64Array#
  ) where

import GHC.Exts (Int#,ByteArray#,MutableByteArray#,State#)
import GHC.Word (Word64(W64#))
import GHC.Int (Int64(I64#))
import qualified GHC.Exts as E

indexUnalignedWord64Array# :: ByteArray# -> Int# -> Word64
indexUnalignedWord64Array# :: ByteArray# -> Int# -> Word64
indexUnalignedWord64Array# ByteArray#
a Int#
i =
  Word# -> Word64
W64# (
#if MIN_VERSION_base(4,17,0)
    E.wordToWord64#
#endif
    (ByteArray# -> Int# -> Word#
E.indexWord8ArrayAsWord# ByteArray#
a Int#
i))

indexUnalignedInt64Array# :: ByteArray# -> Int# -> Int64
indexUnalignedInt64Array# :: ByteArray# -> Int# -> Int64
indexUnalignedInt64Array# ByteArray#
a Int#
i =
  Int# -> Int64
I64# (
#if MIN_VERSION_base(4,17,0)
    E.intToInt64#
#endif
    (ByteArray# -> Int# -> Int#
E.indexWord8ArrayAsInt# ByteArray#
a Int#
i))

readUnalignedWord64Array# ::
     MutableByteArray# s
  -> Int#
  -> State# s
  -> (# State# s, Word64 #)
readUnalignedWord64Array# :: forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, Word64 #)
readUnalignedWord64Array# 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# -> Word64
W64# (
#if MIN_VERSION_base(4,17,0)
        E.wordToWord64#
#endif
        Word#
r)
        #)

readUnalignedInt64Array# ::
     MutableByteArray# s
  -> Int#
  -> State# s
  -> (# State# s, Int64 #)
readUnalignedInt64Array# :: forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, Int64 #)
readUnalignedInt64Array# 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# -> Int64
I64# (
#if MIN_VERSION_base(4,17,0)
       E.intToInt64#
#endif
        Int#
r) #)

writeUnalignedWord64Array# ::
       MutableByteArray# s
    -> Int#
    -> Word64
    -> State# s
    -> State# s
writeUnalignedWord64Array# :: forall s.
MutableByteArray# s -> Int# -> Word64 -> State# s -> State# s
writeUnalignedWord64Array# MutableByteArray# s
a Int#
i (W64# Word#
w) =
  forall d.
MutableByteArray# d -> Int# -> Word# -> State# d -> State# d
E.writeWord8ArrayAsWord# MutableByteArray# s
a Int#
i (
#if MIN_VERSION_base(4,17,0)
    E.word64ToWord#
#endif
    Word#
w)

writeUnalignedInt64Array# ::
       MutableByteArray# s
    -> Int#
    -> Int64
    -> State# s
    -> State# s
writeUnalignedInt64Array# :: forall s.
MutableByteArray# s -> Int# -> Int64 -> State# s -> State# s
writeUnalignedInt64Array# MutableByteArray# s
a Int#
i (I64# Int#
w) =
  forall d.
MutableByteArray# d -> Int# -> Int# -> State# d -> State# d
E.writeWord8ArrayAsInt# MutableByteArray# s
a Int#
i (
#if MIN_VERSION_base(4,17,0)
    E.int64ToInt#
#endif
    Int#
w)