{-# LANGUAGE BangPatterns      #-}
{-# LANGUAGE CPP               #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MagicHash         #-}
{-# LANGUAGE UnboxedTuples     #-}

{-|
Module      : Z.Data.Array.UnalignedAccess
Description : unaligned access for primitive arrays
Copyright   : (c) Dong Han, 2017-2019
License     : BSD
Maintainer  : winterland1989@gmail.com
Stability   : experimental
Portability : non-portable

This module implements unaligned element access with ghc primitives (> 8.6).
-}

module Z.Data.Array.UnalignedAccess where

import           GHC.Int
import           GHC.Prim
import           GHC.Types
import           GHC.Word
import           GHC.Float (stgFloatToWord32, stgWord32ToFloat, stgWord64ToDouble, stgDoubleToWord64)

-- toggle these defs to test different implements
#define USE_BSWAP
-- #define USE_SHIFT

--------------------------------------------------------------------------------

newtype UnalignedSize a = UnalignedSize { UnalignedSize a -> Int
getUnalignedSize :: Int } deriving (Int -> UnalignedSize a -> ShowS
[UnalignedSize a] -> ShowS
UnalignedSize a -> String
(Int -> UnalignedSize a -> ShowS)
-> (UnalignedSize a -> String)
-> ([UnalignedSize a] -> ShowS)
-> Show (UnalignedSize a)
forall a. Int -> UnalignedSize a -> ShowS
forall a. [UnalignedSize a] -> ShowS
forall a. UnalignedSize a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UnalignedSize a] -> ShowS
$cshowList :: forall a. [UnalignedSize a] -> ShowS
show :: UnalignedSize a -> String
$cshow :: forall a. UnalignedSize a -> String
showsPrec :: Int -> UnalignedSize a -> ShowS
$cshowsPrec :: forall a. Int -> UnalignedSize a -> ShowS
Show, UnalignedSize a -> UnalignedSize a -> Bool
(UnalignedSize a -> UnalignedSize a -> Bool)
-> (UnalignedSize a -> UnalignedSize a -> Bool)
-> Eq (UnalignedSize a)
forall a. UnalignedSize a -> UnalignedSize a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UnalignedSize a -> UnalignedSize a -> Bool
$c/= :: forall a. UnalignedSize a -> UnalignedSize a -> Bool
== :: UnalignedSize a -> UnalignedSize a -> Bool
$c== :: forall a. UnalignedSize a -> UnalignedSize a -> Bool
Eq)

-- | Primitive types which can be unaligned accessed
--
class UnalignedAccess a where
    unalignedSize :: UnalignedSize a
    writeWord8ArrayAs :: MutableByteArray# s -> Int# -> a -> State# s -> State# s
    readWord8ArrayAs  :: MutableByteArray# s -> Int# -> State# s -> (# State# s, a #)
    indexWord8ArrayAs :: ByteArray# -> Int# -> a

instance UnalignedAccess Word8 where
    {-# INLINE unalignedSize #-}
    unalignedSize :: UnalignedSize Word8
unalignedSize = Int -> UnalignedSize Word8
forall a. Int -> UnalignedSize a
UnalignedSize Int
1
    {-# INLINE writeWord8ArrayAs #-}
    writeWord8ArrayAs :: MutableByteArray# s -> Int# -> Word8 -> State# s -> State# s
writeWord8ArrayAs MutableByteArray# s
mba# Int#
i# (W8# Word#
x#) = MutableByteArray# s -> Int# -> Word# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Word# -> State# d -> State# d
writeWord8Array# MutableByteArray# s
mba# Int#
i# Word#
x#
    {-# INLINE readWord8ArrayAs #-}
    readWord8ArrayAs :: MutableByteArray# s -> Int# -> State# s -> (# State# s, Word8 #)
readWord8ArrayAs MutableByteArray# s
mba# Int#
i# State# s
s0 =
        let !(# State# s
s1, Word#
x# #) = MutableByteArray# s -> Int# -> State# s -> (# State# s, Word# #)
forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Word# #)
readWord8Array# MutableByteArray# s
mba# Int#
i# State# s
s0 in (# State# s
s1, Word# -> Word8
W8# Word#
x# #)
    {-# INLINE indexWord8ArrayAs #-}
    indexWord8ArrayAs :: ByteArray# -> Int# -> Word8
indexWord8ArrayAs ByteArray#
ba# Int#
i# = Word# -> Word8
W8# (ByteArray# -> Int# -> Word#
indexWord8Array# ByteArray#
ba# Int#
i#)

instance UnalignedAccess Int8 where
    {-# INLINE unalignedSize #-}
    unalignedSize :: UnalignedSize Int8
unalignedSize = Int -> UnalignedSize Int8
forall a. Int -> UnalignedSize a
UnalignedSize Int
1
    {-# INLINE writeWord8ArrayAs #-}
    writeWord8ArrayAs :: MutableByteArray# s -> Int# -> Int8 -> State# s -> State# s
writeWord8ArrayAs MutableByteArray# s
mba# Int#
i# (I8# Int#
x#) = MutableByteArray# s -> Int# -> Int# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Int# -> State# d -> State# d
writeInt8Array# MutableByteArray# s
mba# Int#
i# Int#
x#
    {-# INLINE readWord8ArrayAs #-}
    readWord8ArrayAs :: MutableByteArray# s -> Int# -> State# s -> (# State# s, Int8 #)
readWord8ArrayAs MutableByteArray# s
mba# Int#
i# State# s
s0 =
        let !(# State# s
s1, Int#
x# #) = MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #)
forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Int# #)
readInt8Array# MutableByteArray# s
mba# Int#
i# State# s
s0 in (# State# s
s1, Int# -> Int8
I8# Int#
x# #)
    {-# INLINE indexWord8ArrayAs #-}
    indexWord8ArrayAs :: ByteArray# -> Int# -> Int8
indexWord8ArrayAs ByteArray#
ba# Int#
i# = Int# -> Int8
I8# (ByteArray# -> Int# -> Int#
indexInt8Array# ByteArray#
ba# Int#
i#)

-- | little endianess wrapper
--
newtype LE a = LE { LE a -> a
getLE :: a } deriving (Int -> LE a -> ShowS
[LE a] -> ShowS
LE a -> String
(Int -> LE a -> ShowS)
-> (LE a -> String) -> ([LE a] -> ShowS) -> Show (LE a)
forall a. Show a => Int -> LE a -> ShowS
forall a. Show a => [LE a] -> ShowS
forall a. Show a => LE a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LE a] -> ShowS
$cshowList :: forall a. Show a => [LE a] -> ShowS
show :: LE a -> String
$cshow :: forall a. Show a => LE a -> String
showsPrec :: Int -> LE a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> LE a -> ShowS
Show, LE a -> LE a -> Bool
(LE a -> LE a -> Bool) -> (LE a -> LE a -> Bool) -> Eq (LE a)
forall a. Eq a => LE a -> LE a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LE a -> LE a -> Bool
$c/= :: forall a. Eq a => LE a -> LE a -> Bool
== :: LE a -> LE a -> Bool
$c== :: forall a. Eq a => LE a -> LE a -> Bool
Eq)

-- | big endianess wrapper
--
newtype BE a = BE { BE a -> a
getBE :: a } deriving (Int -> BE a -> ShowS
[BE a] -> ShowS
BE a -> String
(Int -> BE a -> ShowS)
-> (BE a -> String) -> ([BE a] -> ShowS) -> Show (BE a)
forall a. Show a => Int -> BE a -> ShowS
forall a. Show a => [BE a] -> ShowS
forall a. Show a => BE a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BE a] -> ShowS
$cshowList :: forall a. Show a => [BE a] -> ShowS
show :: BE a -> String
$cshow :: forall a. Show a => BE a -> String
showsPrec :: Int -> BE a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> BE a -> ShowS
Show, BE a -> BE a -> Bool
(BE a -> BE a -> Bool) -> (BE a -> BE a -> Bool) -> Eq (BE a)
forall a. Eq a => BE a -> BE a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BE a -> BE a -> Bool
$c/= :: forall a. Eq a => BE a -> BE a -> Bool
== :: BE a -> BE a -> Bool
$c== :: forall a. Eq a => BE a -> BE a -> Bool
Eq)

#define USE_HOST_IMPL(END) \
    {-# INLINE writeWord8ArrayAs #-}; \
    writeWord8ArrayAs mba# i# (END x) = writeWord8ArrayAs mba# i# x; \
    {-# INLINE readWord8ArrayAs #-}; \
    readWord8ArrayAs mba# i# s0 = \
        let !(# s1, x #) = readWord8ArrayAs mba# i# s0 in (# s1, END x #); \
    {-# INLINE indexWord8ArrayAs #-}; \
    indexWord8ArrayAs ba# i# = END (indexWord8ArrayAs ba# i#);

--------------------------------------------------------------------------------

instance UnalignedAccess Word16 where
    {-# INLINE unalignedSize #-}
    unalignedSize :: UnalignedSize Word16
unalignedSize = Int -> UnalignedSize Word16
forall a. Int -> UnalignedSize a
UnalignedSize Int
2
    {-# INLINE writeWord8ArrayAs #-}
    writeWord8ArrayAs :: MutableByteArray# s -> Int# -> Word16 -> State# s -> State# s
writeWord8ArrayAs MutableByteArray# s
mba# Int#
i# (W16# Word#
x#) = MutableByteArray# s -> Int# -> Word# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Word# -> State# d -> State# d
writeWord8ArrayAsWord16# MutableByteArray# s
mba# Int#
i# Word#
x#
    {-# INLINE readWord8ArrayAs #-}
    readWord8ArrayAs :: MutableByteArray# s -> Int# -> State# s -> (# State# s, Word16 #)
readWord8ArrayAs MutableByteArray# s
mba# Int#
i# State# s
s0 =
        let !(# State# s
s1, Word#
x# #) = MutableByteArray# s -> Int# -> State# s -> (# State# s, Word# #)
forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Word# #)
readWord8ArrayAsWord16# MutableByteArray# s
mba# Int#
i# State# s
s0 in (# State# s
s1, Word# -> Word16
W16# Word#
x# #)
    {-# INLINE indexWord8ArrayAs #-}
    indexWord8ArrayAs :: ByteArray# -> Int# -> Word16
indexWord8ArrayAs ByteArray#
ba# Int#
i# = Word# -> Word16
W16# (ByteArray# -> Int# -> Word#
indexWord8ArrayAsWord16# ByteArray#
ba# Int#
i#)

instance UnalignedAccess (LE Word16) where
    {-# INLINE unalignedSize #-}
    unalignedSize :: UnalignedSize (LE Word16)
unalignedSize = Int -> UnalignedSize (LE Word16)
forall a. Int -> UnalignedSize a
UnalignedSize Int
2
#if defined(WORDS_BIGENDIAN) || defined(USE_SHIFT)
    {-# INLINE writeWord8ArrayAs #-}
    writeWord8ArrayAs mba# i# (LE (W16# x#)) s0# =
        let s1# = writeWord8Array# mba# i# x# s0#
        in        writeWord8Array# mba# (i# +# 1#) (uncheckedShiftRL# x# 8#) s1#
    {-# INLINE readWord8ArrayAs #-}
    readWord8ArrayAs mba# i# s0 =
        let !(# s1, w1# #) = readWord8Array# mba# i# s0
            !(# s2, w2# #) = readWord8Array# mba# (i# +# 1#) s1
        in (# s2, LE (W16# (uncheckedShiftL# w2# 8# `or#` w1#)) #)
    {-# INLINE indexWord8ArrayAs #-}
    indexWord8ArrayAs ba# i# =
        let w1# = indexWord8Array# ba# i#
            w2# = indexWord8Array# ba# (i# +# 1#)
        in LE (W16# (uncheckedShiftL# w2# 8# `or#` w1#))
#else
    USE_HOST_IMPL(LE)
#endif

instance UnalignedAccess (BE Word16) where
    {-# INLINE unalignedSize #-}
    unalignedSize :: UnalignedSize (BE Word16)
unalignedSize = Int -> UnalignedSize (BE Word16)
forall a. Int -> UnalignedSize a
UnalignedSize Int
2
#if defined(WORDS_BIGENDIAN) || defined(USE_SHIFT)
    USE_HOST_IMPL(BE)
#else
-- on X86 we use bswap
-- TODO: find out if arch64 support this
#if (defined(i386_HOST_ARCH) || defined(x86_64_HOST_ARCH)) && defined(USE_BSWAP)
    {-# INLINE writeWord8ArrayAs #-}
    writeWord8ArrayAs :: MutableByteArray# s -> Int# -> BE Word16 -> State# s -> State# s
writeWord8ArrayAs MutableByteArray# s
mba# Int#
i# (BE (W16# Word#
x#)) = MutableByteArray# s -> Int# -> Word# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Word# -> State# d -> State# d
writeWord8ArrayAsWord16# MutableByteArray# s
mba# Int#
i# (Word# -> Word#
byteSwap16# Word#
x#)
    {-# INLINE readWord8ArrayAs #-}
    readWord8ArrayAs :: MutableByteArray# s
-> Int# -> State# s -> (# State# s, BE Word16 #)
readWord8ArrayAs MutableByteArray# s
mba# Int#
i# State# s
s0 =
        let !(# State# s
s1, Word#
x# #) = MutableByteArray# s -> Int# -> State# s -> (# State# s, Word# #)
forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Word# #)
readWord8ArrayAsWord16# MutableByteArray# s
mba# Int#
i# State# s
s0
        in (# State# s
s1, Word16 -> BE Word16
forall a. a -> BE a
BE (Word# -> Word16
W16# (Word# -> Word#
byteSwap16# Word#
x#)) #)
    {-# INLINE indexWord8ArrayAs #-}
    indexWord8ArrayAs :: ByteArray# -> Int# -> BE Word16
indexWord8ArrayAs ByteArray#
ba# Int#
i# = Word16 -> BE Word16
forall a. a -> BE a
BE (Word# -> Word16
W16# (Word# -> Word#
byteSwap16# (ByteArray# -> Int# -> Word#
indexWord8ArrayAsWord16# ByteArray#
ba# Int#
i#)))
#else
    {-# INLINE writeWord8ArrayAs #-}
    writeWord8ArrayAs mba# i# (BE (W16# x#)) s0# =
        let s1# = writeWord8Array# mba# i# (uncheckedShiftRL# x# 8#) s0#
        in        writeWord8Array# mba# (i# +# 1#) x# s1#
    {-# INLINE readWord8ArrayAs #-}
    readWord8ArrayAs mba# i# s0 =
        let !(# s1, w2# #) = readWord8Array# mba# i# s0
            !(# s2, w1# #) = readWord8Array# mba# (i# +# 1#) s1
        in (# s2, BE (W16# (uncheckedShiftL# w2# 8# `or#`  w1#)) #)
    {-# INLINE indexWord8ArrayAs #-}
    indexWord8ArrayAs ba# i# =
        let w2# = indexWord8Array# ba# i#
            w1# = indexWord8Array# ba# (i# +# 1#)
        in BE (W16# (uncheckedShiftL# w2# 8# `or#`  w1#))
#endif
#endif

--------------------------------------------------------------------------------

instance UnalignedAccess Word32 where
    {-# INLINE unalignedSize #-}
    unalignedSize :: UnalignedSize Word32
unalignedSize = Int -> UnalignedSize Word32
forall a. Int -> UnalignedSize a
UnalignedSize Int
4
    {-# INLINE writeWord8ArrayAs #-}
    writeWord8ArrayAs :: MutableByteArray# s -> Int# -> Word32 -> State# s -> State# s
writeWord8ArrayAs MutableByteArray# s
mba# Int#
i# (W32# Word#
x#) =  MutableByteArray# s -> Int# -> Word# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Word# -> State# d -> State# d
writeWord8ArrayAsWord32# MutableByteArray# s
mba# Int#
i# Word#
x#
    {-# INLINE readWord8ArrayAs #-}
    readWord8ArrayAs :: MutableByteArray# s -> Int# -> State# s -> (# State# s, Word32 #)
readWord8ArrayAs MutableByteArray# s
mba# Int#
i# State# s
s0 =
        let !(# State# s
s1, Word#
x# #) = MutableByteArray# s -> Int# -> State# s -> (# State# s, Word# #)
forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Word# #)
readWord8ArrayAsWord32# MutableByteArray# s
mba# Int#
i# State# s
s0 in (# State# s
s1, Word# -> Word32
W32# Word#
x# #)
    {-# INLINE indexWord8ArrayAs #-}
    indexWord8ArrayAs :: ByteArray# -> Int# -> Word32
indexWord8ArrayAs ByteArray#
ba# Int#
i# = Word# -> Word32
W32# (ByteArray# -> Int# -> Word#
indexWord8ArrayAsWord32# ByteArray#
ba# Int#
i#)


instance UnalignedAccess (LE Word32) where
    {-# INLINE unalignedSize #-}
    unalignedSize :: UnalignedSize (LE Word32)
unalignedSize = Int -> UnalignedSize (LE Word32)
forall a. Int -> UnalignedSize a
UnalignedSize Int
4
#if defined(WORDS_BIGENDIAN) || defined(USE_SHIFT)
    {-# INLINE writeWord8ArrayAs #-}
    writeWord8ArrayAs mba# i# (LE (W32# x#)) s0# =
        let s1# = writeWord8Array# mba# i# x# s0#
            s2# = writeWord8Array# mba# (i# +# 1#) (uncheckedShiftRL# x# 8#) s1#
            s3# = writeWord8Array# mba# (i# +# 2#) (uncheckedShiftRL# x# 16#) s2#
        in        writeWord8Array# mba# (i# +# 3#) (uncheckedShiftRL# x# 24#) s3#
    {-# INLINE readWord8ArrayAs #-}
    readWord8ArrayAs mba# i# s0 =
        let !(# s1, w1# #) = readWord8Array# mba# i# s0
            !(# s2, w2# #) = readWord8Array# mba# (i# +# 1#) s1
            !(# s3, w3# #) = readWord8Array# mba# (i# +# 2#) s2
            !(# s4, w4# #) = readWord8Array# mba# (i# +# 3#) s3
        in (# s4, LE (W32# ((uncheckedShiftL# w4# 24#) `or#`
                    (uncheckedShiftL# w3# 16#) `or#`
                        (uncheckedShiftL# w2# 8#) `or#` w1#)) #)
    {-# INLINE indexWord8ArrayAs #-}
    indexWord8ArrayAs ba# i# =
        let w1# = indexWord8Array# ba# i#
            w2# = indexWord8Array# ba# (i# +# 1#)
            w3# = indexWord8Array# ba# (i# +# 2#)
            w4# = indexWord8Array# ba# (i# +# 3#)
        in LE (W32# ((uncheckedShiftL# w4# 24#) `or#`
                    (uncheckedShiftL# w3# 16#) `or#`
                        (uncheckedShiftL# w2# 8#) `or#` w1#))
#else
    USE_HOST_IMPL(LE)
#endif

instance UnalignedAccess (BE Word32) where
    {-# INLINE unalignedSize #-}
    unalignedSize :: UnalignedSize (BE Word32)
unalignedSize = Int -> UnalignedSize (BE Word32)
forall a. Int -> UnalignedSize a
UnalignedSize Int
4
#if defined(WORDS_BIGENDIAN) || defined(USE_SHIFT)
    USE_HOST_IMPL(BE)
#else
-- on X86 we use bswap
-- TODO: find out if arch64 support this
#if (defined(i386_HOST_ARCH) || defined(x86_64_HOST_ARCH)) && defined(USE_BSWAP)
    {-# INLINE writeWord8ArrayAs #-}
    writeWord8ArrayAs :: MutableByteArray# s -> Int# -> BE Word32 -> State# s -> State# s
writeWord8ArrayAs MutableByteArray# s
mba# Int#
i# (BE (W32# Word#
x#)) = MutableByteArray# s -> Int# -> Word# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Word# -> State# d -> State# d
writeWord8ArrayAsWord32# MutableByteArray# s
mba# Int#
i# (Word# -> Word#
byteSwap32# Word#
x#)
    {-# INLINE readWord8ArrayAs #-}
    readWord8ArrayAs :: MutableByteArray# s
-> Int# -> State# s -> (# State# s, BE Word32 #)
readWord8ArrayAs MutableByteArray# s
mba# Int#
i# State# s
s0 =
        let !(# State# s
s1, Word#
x# #) = MutableByteArray# s -> Int# -> State# s -> (# State# s, Word# #)
forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Word# #)
readWord8ArrayAsWord32# MutableByteArray# s
mba# Int#
i# State# s
s0
        in (# State# s
s1, Word32 -> BE Word32
forall a. a -> BE a
BE (Word# -> Word32
W32# (Word# -> Word#
byteSwap32# Word#
x#)) #)
    {-# INLINE indexWord8ArrayAs #-}
    indexWord8ArrayAs :: ByteArray# -> Int# -> BE Word32
indexWord8ArrayAs ByteArray#
ba# Int#
i# = Word32 -> BE Word32
forall a. a -> BE a
BE (Word# -> Word32
W32# (Word# -> Word#
byteSwap32# (ByteArray# -> Int# -> Word#
indexWord8ArrayAsWord32# ByteArray#
ba# Int#
i#)))
#else
    {-# INLINE writeWord8ArrayAs #-}
    writeWord8ArrayAs mba# i# (BE (W32# x#)) s0# =
        let s1# = writeWord8Array# mba# i# (uncheckedShiftRL# x# 24#) s0#
            s2# = writeWord8Array# mba# (i# +# 1#) (uncheckedShiftRL# x# 16#) s1#
            s3# = writeWord8Array# mba# (i# +# 2#) (uncheckedShiftRL# x# 8#) s2#
        in        writeWord8Array# mba# (i# +# 3#) x# s3#
    {-# INLINE readWord8ArrayAs #-}
    readWord8ArrayAs mba# i# s0 =
        let !(# s1, w4# #) = readWord8Array# mba# i# s0
            !(# s2, w3# #) = readWord8Array# mba# (i# +# 1#) s1
            !(# s3, w2# #) = readWord8Array# mba# (i# +# 2#) s2
            !(# s4, w1# #) = readWord8Array# mba# (i# +# 3#) s3
        in (# s4, BE (W32# ((uncheckedShiftL# w4# 24#) `or#`
                    (uncheckedShiftL# w3# 16#) `or#`
                        (uncheckedShiftL# w2# 8#) `or#` w1#)) #)
    {-# INLINE indexWord8ArrayAs #-}
    indexWord8ArrayAs ba# i# =
        let w4# = indexWord8Array# ba# i#
            w3# = indexWord8Array# ba# (i# +# 1#)
            w2# = indexWord8Array# ba# (i# +# 2#)
            w1# = indexWord8Array# ba# (i# +# 3#)
        in BE (W32# ((uncheckedShiftL# w4# 24#) `or#`
                    (uncheckedShiftL# w3# 16#) `or#`
                        (uncheckedShiftL# w2# 8#) `or#` w1#))
#endif
#endif

--------------------------------------------------------------------------------

instance UnalignedAccess Word64 where
    {-# INLINE unalignedSize #-}
    unalignedSize :: UnalignedSize Word64
unalignedSize = Int -> UnalignedSize Word64
forall a. Int -> UnalignedSize a
UnalignedSize Int
8
    {-# INLINE writeWord8ArrayAs #-}
    writeWord8ArrayAs :: MutableByteArray# s -> Int# -> Word64 -> State# s -> State# s
writeWord8ArrayAs MutableByteArray# s
mba# Int#
i# (W64# Word#
x#) =  MutableByteArray# s -> Int# -> Word# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Word# -> State# d -> State# d
writeWord8ArrayAsWord64# MutableByteArray# s
mba# Int#
i# Word#
x#
    {-# INLINE readWord8ArrayAs #-}
    readWord8ArrayAs :: MutableByteArray# s -> Int# -> State# s -> (# State# s, Word64 #)
readWord8ArrayAs MutableByteArray# s
mba# Int#
i# State# s
s0 =
        let !(# State# s
s1, Word#
x# #) = MutableByteArray# s -> Int# -> State# s -> (# State# s, Word# #)
forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Word# #)
readWord8ArrayAsWord64# MutableByteArray# s
mba# Int#
i# State# s
s0 in (# State# s
s1, Word# -> Word64
W64# Word#
x# #)
    {-# INLINE indexWord8ArrayAs #-}
    indexWord8ArrayAs :: ByteArray# -> Int# -> Word64
indexWord8ArrayAs ByteArray#
ba# Int#
i# = Word# -> Word64
W64# (ByteArray# -> Int# -> Word#
indexWord8ArrayAsWord64# ByteArray#
ba# Int#
i#)


instance UnalignedAccess (LE Word64) where
    {-# INLINE unalignedSize #-}
    unalignedSize :: UnalignedSize (LE Word64)
unalignedSize = Int -> UnalignedSize (LE Word64)
forall a. Int -> UnalignedSize a
UnalignedSize Int
8
#if defined(WORDS_BIGENDIAN) || defined(USE_SHIFT)
    {-# INLINE writeWord8ArrayAs #-}
    writeWord8ArrayAs mba# i# (LE (W64# x#)) s0# =
        let s1# = writeWord8Array# mba# i# x# s0#
            s2# = writeWord8Array# mba# (i# +# 1#) (uncheckedShiftRL# x# 8#) s1#
            s3# = writeWord8Array# mba# (i# +# 2#) (uncheckedShiftRL# x# 16#) s2#
            s4# = writeWord8Array# mba# (i# +# 3#) (uncheckedShiftRL# x# 24#) s3#
            s5# = writeWord8Array# mba# (i# +# 4#) (uncheckedShiftRL# x# 32#) s4#
            s6# = writeWord8Array# mba# (i# +# 5#) (uncheckedShiftRL# x# 40#) s5#
            s7# = writeWord8Array# mba# (i# +# 6#) (uncheckedShiftRL# x# 48#) s6#
        in        writeWord8Array# mba# (i# +# 7#) (uncheckedShiftRL# x# 56#) s7#
    {-# INLINE readWord8ArrayAs #-}
    readWord8ArrayAs mba# i# s0 =
        let !(# s1, w1# #) = readWord8Array# mba# i# s0
            !(# s2, w2# #) = readWord8Array# mba# (i# +# 1#) s1
            !(# s3, w3# #) = readWord8Array# mba# (i# +# 2#) s2
            !(# s4, w4# #) = readWord8Array# mba# (i# +# 3#) s3
            !(# s5, w5# #) = readWord8Array# mba# (i# +# 4#) s4
            !(# s6, w6# #) = readWord8Array# mba# (i# +# 5#) s5
            !(# s7, w7# #) = readWord8Array# mba# (i# +# 6#) s6
            !(# s8, w8# #) = readWord8Array# mba# (i# +# 7#) s7
        in (# s8, LE (W64# ((uncheckedShiftL# w8# 56#) `or#`
                    (uncheckedShiftL# w7# 48#) `or#`
                        (uncheckedShiftL# w6# 40#) `or#`
                            (uncheckedShiftL# w5# 32#) `or#`
                                (uncheckedShiftL# w4# 24#) `or#`
                                    (uncheckedShiftL# w3# 16#) `or#`
                                        (uncheckedShiftL# w2# 8#) `or#` w1#)) #)
    {-# INLINE indexWord8ArrayAs #-}
    indexWord8ArrayAs ba# i# =
        let w1# = indexWord8Array# ba# i#
            w2# = indexWord8Array# ba# (i# +# 1#)
            w3# = indexWord8Array# ba# (i# +# 2#)
            w4# = indexWord8Array# ba# (i# +# 3#)
            w5# = indexWord8Array# ba# (i# +# 4#)
            w6# = indexWord8Array# ba# (i# +# 5#)
            w7# = indexWord8Array# ba# (i# +# 6#)
            w8# = indexWord8Array# ba# (i# +# 7#)
        in LE (W64# ((uncheckedShiftL# w8# 56#) `or#`
                    (uncheckedShiftL# w7# 48#) `or#`
                        (uncheckedShiftL# w6# 40#) `or#`
                            (uncheckedShiftL# w5# 32#) `or#`
                                (uncheckedShiftL# w4# 24#) `or#`
                                    (uncheckedShiftL# w3# 16#) `or#`
                                        (uncheckedShiftL# w2# 8#) `or#` w1#))
#else
    USE_HOST_IMPL(LE)
#endif

instance UnalignedAccess (BE Word64) where
    {-# INLINE unalignedSize #-}
    unalignedSize :: UnalignedSize (BE Word64)
unalignedSize = Int -> UnalignedSize (BE Word64)
forall a. Int -> UnalignedSize a
UnalignedSize Int
8
#if defined(WORDS_BIGENDIAN) || defined(USE_SHIFT)
    USE_HOST_IMPL(BE)
#else
-- on X86 we use bswap
-- TODO: find out if arch64 support this
#if (defined(i386_HOST_ARCH) || defined(x86_64_HOST_ARCH)) && defined(USE_BSWAP)
    {-# INLINE writeWord8ArrayAs #-}
    writeWord8ArrayAs :: MutableByteArray# s -> Int# -> BE Word64 -> State# s -> State# s
writeWord8ArrayAs MutableByteArray# s
mba# Int#
i# (BE (W64# Word#
x#)) = MutableByteArray# s -> Int# -> Word# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Word# -> State# d -> State# d
writeWord8ArrayAsWord64# MutableByteArray# s
mba# Int#
i# (Word# -> Word#
byteSwap64# Word#
x#)
    {-# INLINE readWord8ArrayAs #-}
    readWord8ArrayAs :: MutableByteArray# s
-> Int# -> State# s -> (# State# s, BE Word64 #)
readWord8ArrayAs MutableByteArray# s
mba# Int#
i# State# s
s0 =
        let !(# State# s
s1, Word#
x# #) = MutableByteArray# s -> Int# -> State# s -> (# State# s, Word# #)
forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Word# #)
readWord8ArrayAsWord64# MutableByteArray# s
mba# Int#
i# State# s
s0
        in (# State# s
s1, Word64 -> BE Word64
forall a. a -> BE a
BE (Word# -> Word64
W64# (Word# -> Word#
byteSwap64# Word#
x#)) #)
    {-# INLINE indexWord8ArrayAs #-}
    indexWord8ArrayAs :: ByteArray# -> Int# -> BE Word64
indexWord8ArrayAs ByteArray#
ba# Int#
i# = Word64 -> BE Word64
forall a. a -> BE a
BE (Word# -> Word64
W64# (Word# -> Word#
byteSwap64# (ByteArray# -> Int# -> Word#
indexWord8ArrayAsWord64# ByteArray#
ba# Int#
i#)))
#else
    {-# INLINE writeWord8ArrayAs #-}
    writeWord8ArrayAs mba# i# (BE (W64# x#)) s0# =
        let s1# = writeWord8Array# mba# i# (uncheckedShiftRL# x# 56#) s0#
            s2# = writeWord8Array# mba# (i# +# 1#) (uncheckedShiftRL# x# 48#) s1#
            s3# = writeWord8Array# mba# (i# +# 2#) (uncheckedShiftRL# x# 40#) s2#
            s4# = writeWord8Array# mba# (i# +# 3#) (uncheckedShiftRL# x# 32#) s3#
            s5# = writeWord8Array# mba# (i# +# 4#) (uncheckedShiftRL# x# 24#) s4#
            s6# = writeWord8Array# mba# (i# +# 5#) (uncheckedShiftRL# x# 16#) s5#
            s7# = writeWord8Array# mba# (i# +# 6#) (uncheckedShiftRL# x# 8#) s6#
        in        writeWord8Array# mba# (i# +# 7#) x# s7#
    {-# INLINE readWord8ArrayAs #-}
    readWord8ArrayAs mba# i# s0 =
        let !(# s1, w8# #) = readWord8Array# mba# i# s0
            !(# s2, w7# #) = readWord8Array# mba# (i# +# 1#) s1
            !(# s3, w6# #) = readWord8Array# mba# (i# +# 2#) s2
            !(# s4, w5# #) = readWord8Array# mba# (i# +# 3#) s3
            !(# s5, w4# #) = readWord8Array# mba# (i# +# 4#) s4
            !(# s6, w3# #) = readWord8Array# mba# (i# +# 5#) s5
            !(# s7, w2# #) = readWord8Array# mba# (i# +# 6#) s6
            !(# s8, w1# #) = readWord8Array# mba# (i# +# 7#) s7
        in (# s8, BE (W64# ((uncheckedShiftL# w8# 56#) `or#`
                    (uncheckedShiftL# w7# 48#) `or#`
                        (uncheckedShiftL# w6# 40#) `or#`
                            (uncheckedShiftL# w5# 32#) `or#`
                                (uncheckedShiftL# w4# 24#) `or#`
                                    (uncheckedShiftL# w3# 16#) `or#`
                                        (uncheckedShiftL# w2# 8#) `or#` w1#)) #)
    {-# INLINE indexWord8ArrayAs #-}
    indexWord8ArrayAs ba# i# =
        let w8# = indexWord8Array# ba# i#
            w7# = indexWord8Array# ba# (i# +# 1#)
            w6# = indexWord8Array# ba# (i# +# 2#)
            w5# = indexWord8Array# ba# (i# +# 3#)
            w4# = indexWord8Array# ba# (i# +# 4#)
            w3# = indexWord8Array# ba# (i# +# 5#)
            w2# = indexWord8Array# ba# (i# +# 6#)
            w1# = indexWord8Array# ba# (i# +# 7#)
        in BE (W64# ((uncheckedShiftL# w8# 56#) `or#`
                    (uncheckedShiftL# w7# 48#) `or#`
                        (uncheckedShiftL# w6# 40#) `or#`
                            (uncheckedShiftL# w5# 32#) `or#`
                                (uncheckedShiftL# w4# 24#) `or#`
                                    (uncheckedShiftL# w3# 16#) `or#`
                                        (uncheckedShiftL# w2# 8#) `or#` w1#))
#endif
#endif

--------------------------------------------------------------------------------

instance UnalignedAccess Word where
#if SIZEOF_HSWORD == 4
    {-# INLINE unalignedSize #-}
    unalignedSize = UnalignedSize 4
#else
    {-# INLINE unalignedSize #-}
    unalignedSize :: UnalignedSize Word
unalignedSize = Int -> UnalignedSize Word
forall a. Int -> UnalignedSize a
UnalignedSize Int
8
#endif
    {-# INLINE writeWord8ArrayAs #-}
    writeWord8ArrayAs :: MutableByteArray# s -> Int# -> Word -> State# s -> State# s
writeWord8ArrayAs MutableByteArray# s
mba# Int#
i# (W# Word#
x#) = MutableByteArray# s -> Int# -> Word# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Word# -> State# d -> State# d
writeWord8ArrayAsWord# MutableByteArray# s
mba# Int#
i# Word#
x#
    {-# INLINE readWord8ArrayAs #-}
    readWord8ArrayAs :: MutableByteArray# s -> Int# -> State# s -> (# State# s, Word #)
readWord8ArrayAs MutableByteArray# s
mba# Int#
i# State# s
s0 =
        let !(# State# s
s1, Word#
x# #) = MutableByteArray# s -> Int# -> State# s -> (# State# s, Word# #)
forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Word# #)
readWord8ArrayAsWord# MutableByteArray# s
mba# Int#
i# State# s
s0 in (# State# s
s1, Word# -> Word
W# Word#
x# #)
    {-# INLINE indexWord8ArrayAs #-}
    indexWord8ArrayAs :: ByteArray# -> Int# -> Word
indexWord8ArrayAs ByteArray#
ba# Int#
i# = Word# -> Word
W# (ByteArray# -> Int# -> Word#
indexWord8ArrayAsWord# ByteArray#
ba# Int#
i#)

instance UnalignedAccess (LE Word) where
#if SIZEOF_HSWORD == 4
    {-# INLINE unalignedSize #-}
    unalignedSize = UnalignedSize 4
    {-# INLINE writeWord8ArrayAs #-}
    writeWord8ArrayAs mba# i# (LE (W# x#)) = writeWord8ArrayAs mba# i# (LE (W32# x#))
    {-# INLINE readWord8ArrayAs #-}
    readWord8ArrayAs mba# i# s0 =
        let !(# s1, LE (W32# x#) #) = readWord8ArrayAs mba# i# s0 in (# s1, LE (W# x#) #)
    {-# INLINE indexWord8ArrayAs #-}
    indexWord8ArrayAs ba# i# = case (indexWord8ArrayAs ba# i#) of (LE (W32# x#)) -> LE (W# x#)
#else
    {-# INLINE unalignedSize #-}
    unalignedSize :: UnalignedSize (LE Word)
unalignedSize = Int -> UnalignedSize (LE Word)
forall a. Int -> UnalignedSize a
UnalignedSize Int
8
    {-# INLINE writeWord8ArrayAs #-}
    writeWord8ArrayAs :: MutableByteArray# s -> Int# -> LE Word -> State# s -> State# s
writeWord8ArrayAs MutableByteArray# s
mba# Int#
i# (LE (W# Word#
x#)) = MutableByteArray# s -> Int# -> LE Word64 -> State# s -> State# s
forall a s.
UnalignedAccess a =>
MutableByteArray# s -> Int# -> a -> State# s -> State# s
writeWord8ArrayAs MutableByteArray# s
mba# Int#
i# (Word64 -> LE Word64
forall a. a -> LE a
LE (Word# -> Word64
W64# Word#
x#))
    {-# INLINE readWord8ArrayAs #-}
    readWord8ArrayAs :: MutableByteArray# s -> Int# -> State# s -> (# State# s, LE Word #)
readWord8ArrayAs MutableByteArray# s
mba# Int#
i# State# s
s0 =
        let !(# State# s
s1, LE (W64# Word#
x#) #) = MutableByteArray# s
-> Int# -> State# s -> (# State# s, LE Word64 #)
forall a s.
UnalignedAccess a =>
MutableByteArray# s -> Int# -> State# s -> (# State# s, a #)
readWord8ArrayAs MutableByteArray# s
mba# Int#
i# State# s
s0 in (# State# s
s1, Word -> LE Word
forall a. a -> LE a
LE (Word# -> Word
W# Word#
x#) #)
    {-# INLINE indexWord8ArrayAs #-}
    indexWord8ArrayAs :: ByteArray# -> Int# -> LE Word
indexWord8ArrayAs ByteArray#
ba# Int#
i# = case (ByteArray# -> Int# -> LE Word64
forall a. UnalignedAccess a => ByteArray# -> Int# -> a
indexWord8ArrayAs ByteArray#
ba# Int#
i#) of (LE (W64# Word#
x#)) -> Word -> LE Word
forall a. a -> LE a
LE (Word# -> Word
W# Word#
x#)
#endif

instance UnalignedAccess (BE Word) where
#if SIZEOF_HSWORD == 4
    {-# INLINE unalignedSize #-}
    unalignedSize = UnalignedSize 4
    {-# INLINE writeWord8ArrayAs #-}
    writeWord8ArrayAs mba# i# (BE (W# x#)) = writeWord8ArrayAs mba# i# (BE (W32# x#))
    {-# INLINE readWord8ArrayAs #-}
    readWord8ArrayAs mba# i# s0 =
        let !(# s1, BE (W32# x#) #) = readWord8ArrayAs mba# i# s0 in (# s1, BE (W# x#) #)
    {-# INLINE indexWord8ArrayAs #-}
    indexWord8ArrayAs ba# i# = case (indexWord8ArrayAs ba# i#) of (BE (W32# x#)) -> BE (W# x#)
#else
    {-# INLINE unalignedSize #-}
    unalignedSize :: UnalignedSize (BE Word)
unalignedSize = Int -> UnalignedSize (BE Word)
forall a. Int -> UnalignedSize a
UnalignedSize Int
8
    {-# INLINE writeWord8ArrayAs #-}
    writeWord8ArrayAs :: MutableByteArray# s -> Int# -> BE Word -> State# s -> State# s
writeWord8ArrayAs MutableByteArray# s
mba# Int#
i# (BE (W# Word#
x#)) = MutableByteArray# s -> Int# -> BE Word64 -> State# s -> State# s
forall a s.
UnalignedAccess a =>
MutableByteArray# s -> Int# -> a -> State# s -> State# s
writeWord8ArrayAs MutableByteArray# s
mba# Int#
i# (Word64 -> BE Word64
forall a. a -> BE a
BE (Word# -> Word64
W64# Word#
x#))
    {-# INLINE readWord8ArrayAs #-}
    readWord8ArrayAs :: MutableByteArray# s -> Int# -> State# s -> (# State# s, BE Word #)
readWord8ArrayAs MutableByteArray# s
mba# Int#
i# State# s
s0 =
        let !(# State# s
s1, BE (W64# Word#
x#) #) = MutableByteArray# s
-> Int# -> State# s -> (# State# s, BE Word64 #)
forall a s.
UnalignedAccess a =>
MutableByteArray# s -> Int# -> State# s -> (# State# s, a #)
readWord8ArrayAs MutableByteArray# s
mba# Int#
i# State# s
s0 in (# State# s
s1, Word -> BE Word
forall a. a -> BE a
BE (Word# -> Word
W# Word#
x#) #)
    {-# INLINE indexWord8ArrayAs #-}
    indexWord8ArrayAs :: ByteArray# -> Int# -> BE Word
indexWord8ArrayAs ByteArray#
ba# Int#
i# = case (ByteArray# -> Int# -> BE Word64
forall a. UnalignedAccess a => ByteArray# -> Int# -> a
indexWord8ArrayAs ByteArray#
ba# Int#
i#) of (BE (W64# Word#
x#)) -> Word -> BE Word
forall a. a -> BE a
BE (Word# -> Word
W# Word#
x#)
#endif

--------------------------------------------------------------------------------

instance UnalignedAccess Int16 where
    {-# INLINE unalignedSize #-}
    unalignedSize :: UnalignedSize Int16
unalignedSize = Int -> UnalignedSize Int16
forall a. Int -> UnalignedSize a
UnalignedSize Int
2
    {-# INLINE writeWord8ArrayAs #-}
    writeWord8ArrayAs :: MutableByteArray# s -> Int# -> Int16 -> State# s -> State# s
writeWord8ArrayAs MutableByteArray# s
mba# Int#
i# (I16# Int#
x#) = MutableByteArray# s -> Int# -> Int# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Int# -> State# d -> State# d
writeWord8ArrayAsInt16# MutableByteArray# s
mba# Int#
i# Int#
x#
    {-# INLINE readWord8ArrayAs #-}
    readWord8ArrayAs :: MutableByteArray# s -> Int# -> State# s -> (# State# s, Int16 #)
readWord8ArrayAs MutableByteArray# s
mba# Int#
i# State# s
s0 =
        let !(# State# s
s1, Int#
x# #) = MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #)
forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Int# #)
readWord8ArrayAsInt16# MutableByteArray# s
mba# Int#
i# State# s
s0 in (# State# s
s1, Int# -> Int16
I16# Int#
x# #)
    {-# INLINE indexWord8ArrayAs #-}
    indexWord8ArrayAs :: ByteArray# -> Int# -> Int16
indexWord8ArrayAs ByteArray#
ba# Int#
i# = Int# -> Int16
I16# (ByteArray# -> Int# -> Int#
indexWord8ArrayAsInt16# ByteArray#
ba# Int#
i#)

instance UnalignedAccess (LE Int16) where
    {-# INLINE unalignedSize #-}
    unalignedSize :: UnalignedSize (LE Int16)
unalignedSize = Int -> UnalignedSize (LE Int16)
forall a. Int -> UnalignedSize a
UnalignedSize Int
2
#if defined(WORDS_BIGENDIAN) || defined(USE_SHIFT)
    {-# INLINE writeWord8ArrayAs #-}
    writeWord8ArrayAs mba# i# (LE (I16# x#)) =
        writeWord8ArrayAs mba# i# (LE (W16# (int2Word# x#)))
    {-# INLINE readWord8ArrayAs #-}
    readWord8ArrayAs mba# i# s0 =
        let !(# s1, LE (W16# x#) #) = readWord8ArrayAs mba# i# s0
        in (# s1, LE (I16# (narrow16Int# (word2Int# x#))) #)
    {-# INLINE indexWord8ArrayAs #-}
    indexWord8ArrayAs ba# i# =
        let LE (W16# x#) = indexWord8ArrayAs ba# i#
        in LE (I16# (narrow16Int# (word2Int# x#)))
#else
    USE_HOST_IMPL(LE)
#endif

instance UnalignedAccess (BE Int16) where
    {-# INLINE unalignedSize #-}
    unalignedSize :: UnalignedSize (BE Int16)
unalignedSize = Int -> UnalignedSize (BE Int16)
forall a. Int -> UnalignedSize a
UnalignedSize Int
2
#if defined(WORDS_BIGENDIAN) || defined(USE_SHIFT)
    USE_HOST_IMPL(BE)
#else
    {-# INLINE writeWord8ArrayAs #-}
    writeWord8ArrayAs :: MutableByteArray# s -> Int# -> BE Int16 -> State# s -> State# s
writeWord8ArrayAs MutableByteArray# s
mba# Int#
i# (BE (I16# Int#
x#)) =
        MutableByteArray# s -> Int# -> BE Word16 -> State# s -> State# s
forall a s.
UnalignedAccess a =>
MutableByteArray# s -> Int# -> a -> State# s -> State# s
writeWord8ArrayAs MutableByteArray# s
mba# Int#
i# (Word16 -> BE Word16
forall a. a -> BE a
BE (Word# -> Word16
W16# (Int# -> Word#
int2Word# Int#
x#)))
    {-# INLINE readWord8ArrayAs #-}
    readWord8ArrayAs :: MutableByteArray# s -> Int# -> State# s -> (# State# s, BE Int16 #)
readWord8ArrayAs MutableByteArray# s
mba# Int#
i# State# s
s0 =
        let !(# State# s
s1, BE (W16# Word#
x#) #) = MutableByteArray# s
-> Int# -> State# s -> (# State# s, BE Word16 #)
forall a s.
UnalignedAccess a =>
MutableByteArray# s -> Int# -> State# s -> (# State# s, a #)
readWord8ArrayAs MutableByteArray# s
mba# Int#
i# State# s
s0
        in (# State# s
s1, Int16 -> BE Int16
forall a. a -> BE a
BE (Int# -> Int16
I16# (Int# -> Int#
narrow16Int# (Word# -> Int#
word2Int# Word#
x#))) #)
    {-# INLINE indexWord8ArrayAs #-}
    indexWord8ArrayAs :: ByteArray# -> Int# -> BE Int16
indexWord8ArrayAs ByteArray#
ba# Int#
i# =
        let !(BE (W16# Word#
x#)) = ByteArray# -> Int# -> BE Word16
forall a. UnalignedAccess a => ByteArray# -> Int# -> a
indexWord8ArrayAs ByteArray#
ba# Int#
i#
        in Int16 -> BE Int16
forall a. a -> BE a
BE (Int# -> Int16
I16# (Int# -> Int#
narrow16Int# (Word# -> Int#
word2Int# Word#
x#)))
#endif

--------------------------------------------------------------------------------

instance UnalignedAccess Int32 where
    {-# INLINE unalignedSize #-}
    unalignedSize :: UnalignedSize Int32
unalignedSize = Int -> UnalignedSize Int32
forall a. Int -> UnalignedSize a
UnalignedSize Int
4
    {-# INLINE writeWord8ArrayAs #-}
    writeWord8ArrayAs :: MutableByteArray# s -> Int# -> Int32 -> State# s -> State# s
writeWord8ArrayAs MutableByteArray# s
mba# Int#
i# (I32# Int#
x#) = MutableByteArray# s -> Int# -> Int# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Int# -> State# d -> State# d
writeWord8ArrayAsInt32# MutableByteArray# s
mba# Int#
i# Int#
x#
    {-# INLINE readWord8ArrayAs #-}
    readWord8ArrayAs :: MutableByteArray# s -> Int# -> State# s -> (# State# s, Int32 #)
readWord8ArrayAs MutableByteArray# s
mba# Int#
i# State# s
s0 =
        let !(# State# s
s1, Int#
x# #) = MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #)
forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Int# #)
readWord8ArrayAsInt32# MutableByteArray# s
mba# Int#
i# State# s
s0 in (# State# s
s1, Int# -> Int32
I32# Int#
x# #)
    {-# INLINE indexWord8ArrayAs #-}
    indexWord8ArrayAs :: ByteArray# -> Int# -> Int32
indexWord8ArrayAs ByteArray#
ba# Int#
i# = Int# -> Int32
I32# (ByteArray# -> Int# -> Int#
indexWord8ArrayAsInt32# ByteArray#
ba# Int#
i#)

instance UnalignedAccess (LE Int32) where
    {-# INLINE unalignedSize #-}
    unalignedSize :: UnalignedSize (LE Int32)
unalignedSize = Int -> UnalignedSize (LE Int32)
forall a. Int -> UnalignedSize a
UnalignedSize Int
4
#if defined(WORDS_BIGENDIAN) || defined(USE_SHIFT)
    {-# INLINE writeWord8ArrayAs #-}
    writeWord8ArrayAs mba# i# (LE (I32# x#)) =
        writeWord8ArrayAs mba# i# (LE (W32# (int2Word# x#)))
    {-# INLINE readWord8ArrayAs #-}
    readWord8ArrayAs mba# i# s0 =
        let !(# s1, LE (W32# x#) #) = readWord8ArrayAs mba# i# s0
        in (# s1, LE (I32# (narrow32Int# (word2Int# x#))) #)
    {-# INLINE indexWord8ArrayAs #-}
    indexWord8ArrayAs ba# i# =
        let LE (W32# x#) = indexWord8ArrayAs ba# i#
        in LE (I32# (narrow32Int# (word2Int# x#)))
#else
    USE_HOST_IMPL(LE)
#endif

instance UnalignedAccess (BE Int32) where
    {-# INLINE unalignedSize #-}
    unalignedSize :: UnalignedSize (BE Int32)
unalignedSize = Int -> UnalignedSize (BE Int32)
forall a. Int -> UnalignedSize a
UnalignedSize Int
4
#if defined(WORDS_BIGENDIAN) || defined(USE_SHIFT)
    USE_HOST_IMPL(BE)
#else
    {-# INLINE writeWord8ArrayAs #-}
    writeWord8ArrayAs :: MutableByteArray# s -> Int# -> BE Int32 -> State# s -> State# s
writeWord8ArrayAs MutableByteArray# s
mba# Int#
i# (BE (I32# Int#
x#)) =
        MutableByteArray# s -> Int# -> BE Word32 -> State# s -> State# s
forall a s.
UnalignedAccess a =>
MutableByteArray# s -> Int# -> a -> State# s -> State# s
writeWord8ArrayAs MutableByteArray# s
mba# Int#
i# (Word32 -> BE Word32
forall a. a -> BE a
BE (Word# -> Word32
W32# (Int# -> Word#
int2Word# Int#
x#)))
    {-# INLINE readWord8ArrayAs #-}
    readWord8ArrayAs :: MutableByteArray# s -> Int# -> State# s -> (# State# s, BE Int32 #)
readWord8ArrayAs MutableByteArray# s
mba# Int#
i# State# s
s0 =
        let !(# State# s
s1, BE (W32# Word#
x#) #) = MutableByteArray# s
-> Int# -> State# s -> (# State# s, BE Word32 #)
forall a s.
UnalignedAccess a =>
MutableByteArray# s -> Int# -> State# s -> (# State# s, a #)
readWord8ArrayAs MutableByteArray# s
mba# Int#
i# State# s
s0
        in (# State# s
s1, Int32 -> BE Int32
forall a. a -> BE a
BE (Int# -> Int32
I32# (Int# -> Int#
narrow32Int# (Word# -> Int#
word2Int# Word#
x#))) #)
    {-# INLINE indexWord8ArrayAs #-}
    indexWord8ArrayAs :: ByteArray# -> Int# -> BE Int32
indexWord8ArrayAs ByteArray#
ba# Int#
i# =
        let !(BE (W32# Word#
x#)) = ByteArray# -> Int# -> BE Word32
forall a. UnalignedAccess a => ByteArray# -> Int# -> a
indexWord8ArrayAs ByteArray#
ba# Int#
i#
        in Int32 -> BE Int32
forall a. a -> BE a
BE (Int# -> Int32
I32# (Int# -> Int#
narrow32Int# (Word# -> Int#
word2Int# Word#
x#)))
#endif

--------------------------------------------------------------------------------

instance UnalignedAccess Int64 where
    {-# INLINE unalignedSize #-}
    unalignedSize :: UnalignedSize Int64
unalignedSize = Int -> UnalignedSize Int64
forall a. Int -> UnalignedSize a
UnalignedSize Int
8
    {-# INLINE writeWord8ArrayAs #-}
    writeWord8ArrayAs :: MutableByteArray# s -> Int# -> Int64 -> State# s -> State# s
writeWord8ArrayAs MutableByteArray# s
mba# Int#
i# (I64# Int#
x#) = MutableByteArray# s -> Int# -> Int# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Int# -> State# d -> State# d
writeWord8ArrayAsInt64# MutableByteArray# s
mba# Int#
i# Int#
x#
    {-# INLINE readWord8ArrayAs #-}
    readWord8ArrayAs :: MutableByteArray# s -> Int# -> State# s -> (# State# s, Int64 #)
readWord8ArrayAs MutableByteArray# s
mba# Int#
i# State# s
s0 =
        let !(# State# s
s1, Int#
x# #) = MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #)
forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Int# #)
readWord8ArrayAsInt64# MutableByteArray# s
mba# Int#
i# State# s
s0 in (# State# s
s1, Int# -> Int64
I64# Int#
x# #)
    {-# INLINE indexWord8ArrayAs #-}
    indexWord8ArrayAs :: ByteArray# -> Int# -> Int64
indexWord8ArrayAs ByteArray#
ba# Int#
i# = Int# -> Int64
I64# (ByteArray# -> Int# -> Int#
indexWord8ArrayAsInt64# ByteArray#
ba# Int#
i#)

instance UnalignedAccess (LE Int64) where
    {-# INLINE unalignedSize #-}
    unalignedSize :: UnalignedSize (LE Int64)
unalignedSize = Int -> UnalignedSize (LE Int64)
forall a. Int -> UnalignedSize a
UnalignedSize Int
8
#if defined(WORDS_BIGENDIAN) || defined(USE_SHIFT)
    {-# INLINE writeWord8ArrayAs #-}
    writeWord8ArrayAs mba# i# (LE (I64# x#)) =
        writeWord8ArrayAs mba# i# (LE (W64# (int2Word# x#)))
    {-# INLINE readWord8ArrayAs #-}
    readWord8ArrayAs mba# i# s0 =
        let !(# s1, LE (W64# x#) #) = readWord8ArrayAs mba# i# s0
        in (# s1, LE (I64# (word2Int# x#)) #)
    {-# INLINE indexWord8ArrayAs #-}
    indexWord8ArrayAs ba# i# =
        let LE (W64# x#) = indexWord8ArrayAs ba# i#
        in LE (I64# (word2Int# x#))
#else
    USE_HOST_IMPL(LE)
#endif

instance UnalignedAccess (BE Int64) where
    {-# INLINE unalignedSize #-}
    unalignedSize :: UnalignedSize (BE Int64)
unalignedSize = Int -> UnalignedSize (BE Int64)
forall a. Int -> UnalignedSize a
UnalignedSize Int
8
#if defined(WORDS_BIGENDIAN) || defined(USE_SHIFT)
    USE_HOST_IMPL(BE)
#else
    {-# INLINE writeWord8ArrayAs #-}
    writeWord8ArrayAs :: MutableByteArray# s -> Int# -> BE Int64 -> State# s -> State# s
writeWord8ArrayAs MutableByteArray# s
mba# Int#
i# (BE (I64# Int#
x#)) =
        MutableByteArray# s -> Int# -> BE Word64 -> State# s -> State# s
forall a s.
UnalignedAccess a =>
MutableByteArray# s -> Int# -> a -> State# s -> State# s
writeWord8ArrayAs MutableByteArray# s
mba# Int#
i# (Word64 -> BE Word64
forall a. a -> BE a
BE (Word# -> Word64
W64# (Int# -> Word#
int2Word# Int#
x#)))
    {-# INLINE readWord8ArrayAs #-}
    readWord8ArrayAs :: MutableByteArray# s -> Int# -> State# s -> (# State# s, BE Int64 #)
readWord8ArrayAs MutableByteArray# s
mba# Int#
i# State# s
s0 =
        let !(# State# s
s1, BE (W64# Word#
x#) #) = MutableByteArray# s
-> Int# -> State# s -> (# State# s, BE Word64 #)
forall a s.
UnalignedAccess a =>
MutableByteArray# s -> Int# -> State# s -> (# State# s, a #)
readWord8ArrayAs MutableByteArray# s
mba# Int#
i# State# s
s0
        in (# State# s
s1, Int64 -> BE Int64
forall a. a -> BE a
BE (Int# -> Int64
I64# (Word# -> Int#
word2Int# Word#
x#)) #)
    {-# INLINE indexWord8ArrayAs #-}
    indexWord8ArrayAs :: ByteArray# -> Int# -> BE Int64
indexWord8ArrayAs ByteArray#
ba# Int#
i# =
        let !(BE (W64# Word#
x#)) = ByteArray# -> Int# -> BE Word64
forall a. UnalignedAccess a => ByteArray# -> Int# -> a
indexWord8ArrayAs ByteArray#
ba# Int#
i#
        in Int64 -> BE Int64
forall a. a -> BE a
BE (Int# -> Int64
I64# (Word# -> Int#
word2Int# Word#
x#))
#endif

--------------------------------------------------------------------------------

instance UnalignedAccess Int where
#if SIZEOF_HSWORD == 4
    {-# INLINE unalignedSize #-}
    unalignedSize = UnalignedSize 4
#else
    {-# INLINE unalignedSize #-}
    unalignedSize :: UnalignedSize Int
unalignedSize = Int -> UnalignedSize Int
forall a. Int -> UnalignedSize a
UnalignedSize Int
8
#endif
    {-# INLINE writeWord8ArrayAs #-}
    writeWord8ArrayAs :: MutableByteArray# s -> Int# -> Int -> State# s -> State# s
writeWord8ArrayAs MutableByteArray# s
mba# Int#
i# (I# Int#
x#) = MutableByteArray# s -> Int# -> Int# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Int# -> State# d -> State# d
writeWord8ArrayAsInt# MutableByteArray# s
mba# Int#
i# Int#
x#
    {-# INLINE readWord8ArrayAs #-}
    readWord8ArrayAs :: MutableByteArray# s -> Int# -> State# s -> (# State# s, Int #)
readWord8ArrayAs MutableByteArray# s
mba# Int#
i# State# s
s0 =
        let !(# State# s
s1, Int#
x# #) = MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #)
forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Int# #)
readWord8ArrayAsInt# MutableByteArray# s
mba# Int#
i# State# s
s0 in (# State# s
s1, Int# -> Int
I# Int#
x# #)
    {-# INLINE indexWord8ArrayAs #-}
    indexWord8ArrayAs :: ByteArray# -> Int# -> Int
indexWord8ArrayAs ByteArray#
ba# Int#
i# = Int# -> Int
I# (ByteArray# -> Int# -> Int#
indexWord8ArrayAsInt# ByteArray#
ba# Int#
i#)

instance UnalignedAccess (LE Int) where
#if SIZEOF_HSWORD == 4
    {-# INLINE unalignedSize #-}
    unalignedSize = UnalignedSize 4
    {-# INLINE writeWord8ArrayAs #-}
    writeWord8ArrayAs mba# i# (LE (I# x#)) = writeWord8ArrayAs mba# i# (LE (I32# x#))
    {-# INLINE readWord8ArrayAs #-}
    readWord8ArrayAs mba# i# s0 =
        let !(# s1, LE (I32# x#) #) = readWord8ArrayAs mba# i# s0 in (# s1, LE (I# x#) #)
    {-# INLINE indexWord8ArrayAs #-}
    indexWord8ArrayAs ba# i# = case (indexWord8ArrayAs ba# i#) of (LE (I32# x#)) -> LE (I# x#)
#else
    {-# INLINE unalignedSize #-}
    unalignedSize :: UnalignedSize (LE Int)
unalignedSize = Int -> UnalignedSize (LE Int)
forall a. Int -> UnalignedSize a
UnalignedSize Int
8
    {-# INLINE writeWord8ArrayAs #-}
    writeWord8ArrayAs :: MutableByteArray# s -> Int# -> LE Int -> State# s -> State# s
writeWord8ArrayAs MutableByteArray# s
mba# Int#
i# (LE (I# Int#
x#)) = MutableByteArray# s -> Int# -> LE Int64 -> State# s -> State# s
forall a s.
UnalignedAccess a =>
MutableByteArray# s -> Int# -> a -> State# s -> State# s
writeWord8ArrayAs MutableByteArray# s
mba# Int#
i# (Int64 -> LE Int64
forall a. a -> LE a
LE (Int# -> Int64
I64# Int#
x#))
    {-# INLINE readWord8ArrayAs #-}
    readWord8ArrayAs :: MutableByteArray# s -> Int# -> State# s -> (# State# s, LE Int #)
readWord8ArrayAs MutableByteArray# s
mba# Int#
i# State# s
s0 =
        let !(# State# s
s1, LE (I64# Int#
x#) #) = MutableByteArray# s -> Int# -> State# s -> (# State# s, LE Int64 #)
forall a s.
UnalignedAccess a =>
MutableByteArray# s -> Int# -> State# s -> (# State# s, a #)
readWord8ArrayAs MutableByteArray# s
mba# Int#
i# State# s
s0 in (# State# s
s1, Int -> LE Int
forall a. a -> LE a
LE (Int# -> Int
I# Int#
x#) #)
    {-# INLINE indexWord8ArrayAs #-}
    indexWord8ArrayAs :: ByteArray# -> Int# -> LE Int
indexWord8ArrayAs ByteArray#
ba# Int#
i# = case (ByteArray# -> Int# -> LE Int64
forall a. UnalignedAccess a => ByteArray# -> Int# -> a
indexWord8ArrayAs ByteArray#
ba# Int#
i#) of (LE (I64# Int#
x#)) -> Int -> LE Int
forall a. a -> LE a
LE (Int# -> Int
I# Int#
x#)
#endif

instance UnalignedAccess (BE Int) where
#if SIZEOF_HSWORD == 4
    {-# INLINE unalignedSize #-}
    unalignedSize = UnalignedSize 4
    {-# INLINE writeWord8ArrayAs #-}
    writeWord8ArrayAs mba# i# (BE (I# x#)) = writeWord8ArrayAs mba# i# (BE (I32# x#))
    {-# INLINE readWord8ArrayAs #-}
    readWord8ArrayAs mba# i# s0 =
        let !(# s1, BE (I32# x#) #) = readWord8ArrayAs mba# i# s0 in (# s1, BE (I# x#) #)
    {-# INLINE indexWord8ArrayAs #-}
    indexWord8ArrayAs ba# i# = case (indexWord8ArrayAs ba# i#) of (BE (I32# x#)) -> BE (I# x#)
#else
    {-# INLINE unalignedSize #-}
    unalignedSize :: UnalignedSize (BE Int)
unalignedSize = Int -> UnalignedSize (BE Int)
forall a. Int -> UnalignedSize a
UnalignedSize Int
8
    {-# INLINE writeWord8ArrayAs #-}
    writeWord8ArrayAs :: MutableByteArray# s -> Int# -> BE Int -> State# s -> State# s
writeWord8ArrayAs MutableByteArray# s
mba# Int#
i# (BE (I# Int#
x#)) = MutableByteArray# s -> Int# -> BE Int64 -> State# s -> State# s
forall a s.
UnalignedAccess a =>
MutableByteArray# s -> Int# -> a -> State# s -> State# s
writeWord8ArrayAs MutableByteArray# s
mba# Int#
i# (Int64 -> BE Int64
forall a. a -> BE a
BE (Int# -> Int64
I64# Int#
x#))
    {-# INLINE readWord8ArrayAs #-}
    readWord8ArrayAs :: MutableByteArray# s -> Int# -> State# s -> (# State# s, BE Int #)
readWord8ArrayAs MutableByteArray# s
mba# Int#
i# State# s
s0 =
        let !(# State# s
s1, BE (I64# Int#
x#) #) = MutableByteArray# s -> Int# -> State# s -> (# State# s, BE Int64 #)
forall a s.
UnalignedAccess a =>
MutableByteArray# s -> Int# -> State# s -> (# State# s, a #)
readWord8ArrayAs MutableByteArray# s
mba# Int#
i# State# s
s0 in (# State# s
s1, Int -> BE Int
forall a. a -> BE a
BE (Int# -> Int
I# Int#
x#) #)
    {-# INLINE indexWord8ArrayAs #-}
    indexWord8ArrayAs :: ByteArray# -> Int# -> BE Int
indexWord8ArrayAs ByteArray#
ba# Int#
i# = case (ByteArray# -> Int# -> BE Int64
forall a. UnalignedAccess a => ByteArray# -> Int# -> a
indexWord8ArrayAs ByteArray#
ba# Int#
i#) of (BE (I64# Int#
x#)) -> Int -> BE Int
forall a. a -> BE a
BE (Int# -> Int
I# Int#
x#)
#endif

--------------------------------------------------------------------------------

instance UnalignedAccess Float where
    {-# INLINE unalignedSize #-}
    unalignedSize :: UnalignedSize Float
unalignedSize = Int -> UnalignedSize Float
forall a. Int -> UnalignedSize a
UnalignedSize Int
4
    {-# INLINE writeWord8ArrayAs #-}
    writeWord8ArrayAs :: MutableByteArray# s -> Int# -> Float -> State# s -> State# s
writeWord8ArrayAs MutableByteArray# s
mba# Int#
i# (F# Float#
x#) = MutableByteArray# s -> Int# -> Float# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Float# -> State# d -> State# d
writeWord8ArrayAsFloat# MutableByteArray# s
mba# Int#
i# Float#
x#
    {-# INLINE readWord8ArrayAs #-}
    readWord8ArrayAs :: MutableByteArray# s -> Int# -> State# s -> (# State# s, Float #)
readWord8ArrayAs MutableByteArray# s
mba# Int#
i# State# s
s0 =
        let !(# State# s
s1, Float#
x# #) = MutableByteArray# s -> Int# -> State# s -> (# State# s, Float# #)
forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Float# #)
readWord8ArrayAsFloat# MutableByteArray# s
mba# Int#
i# State# s
s0 in (# State# s
s1, Float# -> Float
F# Float#
x# #)
    {-# INLINE indexWord8ArrayAs #-}
    indexWord8ArrayAs :: ByteArray# -> Int# -> Float
indexWord8ArrayAs ByteArray#
ba# Int#
i# = Float# -> Float
F# (ByteArray# -> Int# -> Float#
indexWord8ArrayAsFloat# ByteArray#
ba# Int#
i#)

instance UnalignedAccess (LE Float) where
    {-# INLINE unalignedSize #-}
    unalignedSize :: UnalignedSize (LE Float)
unalignedSize = Int -> UnalignedSize (LE Float)
forall a. Int -> UnalignedSize a
UnalignedSize Int
4
#if defined(WORDS_BIGENDIAN) || defined(USE_SHIFT)
    {-# INLINE writeWord8ArrayAs #-}
    writeWord8ArrayAs mba# i# (LE (F# x#)) =
        writeWord8ArrayAs mba# i# (LE (W32# (stgFloatToWord32 x#)))
    {-# INLINE readWord8ArrayAs #-}
    readWord8ArrayAs mba# i# s0 =
        let !(# s1, LE (W32# x#) #) = readWord8ArrayAs mba# i# s0
        in (# s1, LE (F# (stgWord32ToFloat x#)) #)
    {-# INLINE indexWord8ArrayAs #-}
    indexWord8ArrayAs ba# i# =
        let LE (W32# x#) = indexWord8ArrayAs ba# i#
        in LE (F# (stgWord32ToFloat x#))
#else
    USE_HOST_IMPL(LE)
#endif

instance UnalignedAccess (BE Float) where
    {-# INLINE unalignedSize #-}
    unalignedSize :: UnalignedSize (BE Float)
unalignedSize = Int -> UnalignedSize (BE Float)
forall a. Int -> UnalignedSize a
UnalignedSize Int
4
#if defined(WORDS_BIGENDIAN) || defined(USE_SHIFT)
    USE_HOST_IMPL(BE)
#else
    {-# INLINE writeWord8ArrayAs #-}
    writeWord8ArrayAs :: MutableByteArray# s -> Int# -> BE Float -> State# s -> State# s
writeWord8ArrayAs MutableByteArray# s
mba# Int#
i# (BE (F# Float#
x#)) =
        MutableByteArray# s -> Int# -> BE Word32 -> State# s -> State# s
forall a s.
UnalignedAccess a =>
MutableByteArray# s -> Int# -> a -> State# s -> State# s
writeWord8ArrayAs MutableByteArray# s
mba# Int#
i# (Word32 -> BE Word32
forall a. a -> BE a
BE (Word# -> Word32
W32# (Float# -> Word#
stgFloatToWord32 Float#
x#)))
    {-# INLINE readWord8ArrayAs #-}
    readWord8ArrayAs :: MutableByteArray# s -> Int# -> State# s -> (# State# s, BE Float #)
readWord8ArrayAs MutableByteArray# s
mba# Int#
i# State# s
s0 =
        let !(# State# s
s1, BE (W32# Word#
x#) #) = MutableByteArray# s
-> Int# -> State# s -> (# State# s, BE Word32 #)
forall a s.
UnalignedAccess a =>
MutableByteArray# s -> Int# -> State# s -> (# State# s, a #)
readWord8ArrayAs MutableByteArray# s
mba# Int#
i# State# s
s0
        in (# State# s
s1, Float -> BE Float
forall a. a -> BE a
BE (Float# -> Float
F# (Word# -> Float#
stgWord32ToFloat Word#
x#)) #)
    {-# INLINE indexWord8ArrayAs #-}
    indexWord8ArrayAs :: ByteArray# -> Int# -> BE Float
indexWord8ArrayAs ByteArray#
ba# Int#
i# =
        let !(BE (W32# Word#
x#)) = ByteArray# -> Int# -> BE Word32
forall a. UnalignedAccess a => ByteArray# -> Int# -> a
indexWord8ArrayAs ByteArray#
ba# Int#
i#
        in Float -> BE Float
forall a. a -> BE a
BE (Float# -> Float
F# (Word# -> Float#
stgWord32ToFloat Word#
x#))
#endif

--------------------------------------------------------------------------------

instance UnalignedAccess Double where
    {-# INLINE unalignedSize #-}
    unalignedSize :: UnalignedSize Double
unalignedSize = Int -> UnalignedSize Double
forall a. Int -> UnalignedSize a
UnalignedSize Int
8
    {-# INLINE writeWord8ArrayAs #-}
    writeWord8ArrayAs :: MutableByteArray# s -> Int# -> Double -> State# s -> State# s
writeWord8ArrayAs MutableByteArray# s
mba# Int#
i# (D# Double#
x#) = MutableByteArray# s -> Int# -> Double# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Double# -> State# d -> State# d
writeWord8ArrayAsDouble# MutableByteArray# s
mba# Int#
i# Double#
x#
    {-# INLINE readWord8ArrayAs #-}
    readWord8ArrayAs :: MutableByteArray# s -> Int# -> State# s -> (# State# s, Double #)
readWord8ArrayAs MutableByteArray# s
mba# Int#
i# State# s
s0 =
        let !(# State# s
s1, Double#
x# #) = MutableByteArray# s -> Int# -> State# s -> (# State# s, Double# #)
forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Double# #)
readWord8ArrayAsDouble# MutableByteArray# s
mba# Int#
i# State# s
s0 in (# State# s
s1, Double# -> Double
D# Double#
x# #)
    {-# INLINE indexWord8ArrayAs #-}
    indexWord8ArrayAs :: ByteArray# -> Int# -> Double
indexWord8ArrayAs ByteArray#
ba# Int#
i# = Double# -> Double
D# (ByteArray# -> Int# -> Double#
indexWord8ArrayAsDouble# ByteArray#
ba# Int#
i#)

instance UnalignedAccess (LE Double) where
    {-# INLINE unalignedSize #-}
    unalignedSize :: UnalignedSize (LE Double)
unalignedSize = Int -> UnalignedSize (LE Double)
forall a. Int -> UnalignedSize a
UnalignedSize Int
8
#if defined(WORDS_BIGENDIAN) || defined(USE_SHIFT)
    {-# INLINE writeWord8ArrayAs #-}
    writeWord8ArrayAs mba# i# (LE (D# x#)) =
        writeWord8ArrayAs mba# i# (LE (W64# (stgDoubleToWord64 x#)))
    {-# INLINE readWord8ArrayAs #-}
    readWord8ArrayAs mba# i# s0 =
        let !(# s1, LE (W64# x#) #) = readWord8ArrayAs mba# i# s0
        in (# s1, LE (D# (stgWord64ToDouble x#)) #)
    {-# INLINE indexWord8ArrayAs #-}
    indexWord8ArrayAs ba# i# =
        let LE (W64# x#) = indexWord8ArrayAs ba# i#
        in LE (D# (stgWord64ToDouble x#))
#else
    USE_HOST_IMPL(LE)
#endif

instance UnalignedAccess (BE Double) where
    {-# INLINE unalignedSize #-}
    unalignedSize :: UnalignedSize (BE Double)
unalignedSize = Int -> UnalignedSize (BE Double)
forall a. Int -> UnalignedSize a
UnalignedSize Int
4
#if defined(WORDS_BIGENDIAN) || defined(USE_SHIFT)
    USE_HOST_IMPL(BE)
#else
    {-# INLINE writeWord8ArrayAs #-}
    writeWord8ArrayAs :: MutableByteArray# s -> Int# -> BE Double -> State# s -> State# s
writeWord8ArrayAs MutableByteArray# s
mba# Int#
i# (BE (D# Double#
x#)) =
        MutableByteArray# s -> Int# -> BE Word64 -> State# s -> State# s
forall a s.
UnalignedAccess a =>
MutableByteArray# s -> Int# -> a -> State# s -> State# s
writeWord8ArrayAs MutableByteArray# s
mba# Int#
i# (Word64 -> BE Word64
forall a. a -> BE a
BE (Word# -> Word64
W64# (Double# -> Word#
stgDoubleToWord64 Double#
x#)))
    {-# INLINE readWord8ArrayAs #-}
    readWord8ArrayAs :: MutableByteArray# s
-> Int# -> State# s -> (# State# s, BE Double #)
readWord8ArrayAs MutableByteArray# s
mba# Int#
i# State# s
s0 =
        let !(# State# s
s1, BE (W64# Word#
x#) #) = MutableByteArray# s
-> Int# -> State# s -> (# State# s, BE Word64 #)
forall a s.
UnalignedAccess a =>
MutableByteArray# s -> Int# -> State# s -> (# State# s, a #)
readWord8ArrayAs MutableByteArray# s
mba# Int#
i# State# s
s0
        in (# State# s
s1, Double -> BE Double
forall a. a -> BE a
BE (Double# -> Double
D# (Word# -> Double#
stgWord64ToDouble Word#
x#)) #)
    {-# INLINE indexWord8ArrayAs #-}
    indexWord8ArrayAs :: ByteArray# -> Int# -> BE Double
indexWord8ArrayAs ByteArray#
ba# Int#
i# =
        let !(BE (W64# Word#
x#)) = ByteArray# -> Int# -> BE Word64
forall a. UnalignedAccess a => ByteArray# -> Int# -> a
indexWord8ArrayAs ByteArray#
ba# Int#
i#
        in Double -> BE Double
forall a. a -> BE a
BE (Double# -> Double
D# (Word# -> Double#
stgWord64ToDouble Word#
x#))
#endif

--------------------------------------------------------------------------------

instance UnalignedAccess Char where
    {-# INLINE unalignedSize #-}
    unalignedSize :: UnalignedSize Char
unalignedSize = Int -> UnalignedSize Char
forall a. Int -> UnalignedSize a
UnalignedSize Int
4
    {-# INLINE writeWord8ArrayAs #-}
    writeWord8ArrayAs :: MutableByteArray# s -> Int# -> Char -> State# s -> State# s
writeWord8ArrayAs MutableByteArray# s
mba# Int#
i# (C# Char#
x#) = MutableByteArray# s -> Int# -> Char# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Char# -> State# d -> State# d
writeWord8ArrayAsWideChar# MutableByteArray# s
mba# Int#
i# Char#
x#
    {-# INLINE readWord8ArrayAs #-}
    readWord8ArrayAs :: MutableByteArray# s -> Int# -> State# s -> (# State# s, Char #)
readWord8ArrayAs MutableByteArray# s
mba# Int#
i# State# s
s0 =
        let !(# State# s
s1, Char#
x# #) = MutableByteArray# s -> Int# -> State# s -> (# State# s, Char# #)
forall d.
MutableByteArray# d -> Int# -> State# d -> (# State# d, Char# #)
readWord8ArrayAsWideChar# MutableByteArray# s
mba# Int#
i# State# s
s0 in (# State# s
s1, Char# -> Char
C# Char#
x# #)
    {-# INLINE indexWord8ArrayAs #-}
    indexWord8ArrayAs :: ByteArray# -> Int# -> Char
indexWord8ArrayAs ByteArray#
ba# Int#
i# = Char# -> Char
C# (ByteArray# -> Int# -> Char#
indexWord8ArrayAsWideChar# ByteArray#
ba# Int#
i#)

instance UnalignedAccess (LE Char) where
    {-# INLINE unalignedSize #-}
    unalignedSize :: UnalignedSize (LE Char)
unalignedSize = Int -> UnalignedSize (LE Char)
forall a. Int -> UnalignedSize a
UnalignedSize Int
4
#if defined(WORDS_BIGENDIAN) || defined(USE_SHIFT)
    {-# INLINE writeWord8ArrayAs #-}
    writeWord8ArrayAs mba# i# (LE (C# x#)) =
        writeWord8ArrayAs mba# i# (LE (I32# (ord# x#)))
    {-# INLINE readWord8ArrayAs #-}
    readWord8ArrayAs mba# i# s0 =
        let !(# s1, LE (I32# x#) #) = readWord8ArrayAs mba# i# s0
        in (# s1, LE (C# (chr# x#)) #)
    {-# INLINE indexWord8ArrayAs #-}
    indexWord8ArrayAs ba# i# =
        let LE (I32# x#) = indexWord8ArrayAs ba# i#
        in LE (C# (chr# x#))
#else
    USE_HOST_IMPL(LE)
#endif

instance UnalignedAccess (BE Char) where
    {-# INLINE unalignedSize #-}
    unalignedSize :: UnalignedSize (BE Char)
unalignedSize = Int -> UnalignedSize (BE Char)
forall a. Int -> UnalignedSize a
UnalignedSize Int
4
#if defined(WORDS_BIGENDIAN) || defined(USE_SHIFT)
    USE_HOST_IMPL(BE)
#else
    {-# INLINE writeWord8ArrayAs #-}
    writeWord8ArrayAs :: MutableByteArray# s -> Int# -> BE Char -> State# s -> State# s
writeWord8ArrayAs MutableByteArray# s
mba# Int#
i# (BE (C# Char#
x#)) =
        MutableByteArray# s -> Int# -> BE Int32 -> State# s -> State# s
forall a s.
UnalignedAccess a =>
MutableByteArray# s -> Int# -> a -> State# s -> State# s
writeWord8ArrayAs MutableByteArray# s
mba# Int#
i# (Int32 -> BE Int32
forall a. a -> BE a
BE (Int# -> Int32
I32# (Char# -> Int#
ord# Char#
x#)))
    {-# INLINE readWord8ArrayAs #-}
    readWord8ArrayAs :: MutableByteArray# s -> Int# -> State# s -> (# State# s, BE Char #)
readWord8ArrayAs MutableByteArray# s
mba# Int#
i# State# s
s0 =
        let !(# State# s
s1, BE (I32# Int#
x#) #) = MutableByteArray# s -> Int# -> State# s -> (# State# s, BE Int32 #)
forall a s.
UnalignedAccess a =>
MutableByteArray# s -> Int# -> State# s -> (# State# s, a #)
readWord8ArrayAs MutableByteArray# s
mba# Int#
i# State# s
s0
        in (# State# s
s1, Char -> BE Char
forall a. a -> BE a
BE (Char# -> Char
C# (Int# -> Char#
chr# Int#
x#)) #)
    {-# INLINE indexWord8ArrayAs #-}
    indexWord8ArrayAs :: ByteArray# -> Int# -> BE Char
indexWord8ArrayAs ByteArray#
ba# Int#
i# =
        let !(BE (I32# Int#
x#)) = ByteArray# -> Int# -> BE Int32
forall a. UnalignedAccess a => ByteArray# -> Int# -> a
indexWord8ArrayAs ByteArray#
ba# Int#
i#
        in Char -> BE Char
forall a. a -> BE a
BE (Char# -> Char
C# (Int# -> Char#
chr# Int#
x#))
#endif