module Data.Repa.Convert.Format.Binary
( Format (..)
, Word8be (..), Int8be (..)
, Word16be (..), Int16be (..)
, Word32be (..), Int32be (..)
, Word64be (..), Int64be (..)
, Float32be (..)
, Float64be (..))
where
import Data.Repa.Convert.Internal.Format
import Data.Repa.Convert.Internal.Packable
import Data.Bits
import Data.Int as V
import Data.Word as V
import qualified Foreign.Storable as S
import qualified Foreign.Marshal.Alloc as S
import qualified Foreign.Ptr as S
import qualified Control.Monad.Primitive as Prim
import GHC.Exts
import Prelude hiding (fail)
#include "repa-convert.h"
data Word8be = Word8be deriving (Word8be -> Word8be -> Bool
(Word8be -> Word8be -> Bool)
-> (Word8be -> Word8be -> Bool) -> Eq Word8be
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Word8be -> Word8be -> Bool
== :: Word8be -> Word8be -> Bool
$c/= :: Word8be -> Word8be -> Bool
/= :: Word8be -> Word8be -> Bool
Eq, Int -> Word8be -> ShowS
[Word8be] -> ShowS
Word8be -> String
(Int -> Word8be -> ShowS)
-> (Word8be -> String) -> ([Word8be] -> ShowS) -> Show Word8be
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Word8be -> ShowS
showsPrec :: Int -> Word8be -> ShowS
$cshow :: Word8be -> String
show :: Word8be -> String
$cshowList :: [Word8be] -> ShowS
showList :: [Word8be] -> ShowS
Show)
instance Format Word8be where
type Value Word8be = Word8
fieldCount :: Word8be -> Int
fieldCount Word8be
_ = Int
1
minSize :: Word8be -> Int
minSize Word8be
_ = Int
1
fixedSize :: Word8be -> Maybe Int
fixedSize Word8be
_ = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1
packedSize :: Word8be -> Value Word8be -> Maybe Int
packedSize Word8be
_ Value Word8be
_ = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1
{-# INLINE minSize #-}
{-# INLINE fieldCount #-}
{-# INLINE fixedSize #-}
{-# INLINE packedSize #-}
instance Packable Word8be where
packer :: Word8be
-> Value Word8be -> Addr# -> IO () -> (Addr# -> IO ()) -> IO ()
packer Word8be
_ Value Word8be
x Addr#
dst IO ()
_fails Addr# -> IO ()
k
= do Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
S.poke (Addr# -> Ptr Word8
forall a. Addr# -> Ptr a
Ptr Addr#
dst) (Word8 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
Value Word8be
x :: Word8)
let !(Ptr Addr#
dst') = Ptr Any -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
S.plusPtr (Addr# -> Ptr Any
forall a. Addr# -> Ptr a
Ptr Addr#
dst) Int
1
Addr# -> IO ()
k Addr#
dst'
{-# INLINE packer #-}
instance Unpackable Word8be where
unpacker :: Word8be
-> Addr#
-> Addr#
-> (Word8 -> Bool)
-> IO ()
-> (Addr# -> Value Word8be -> IO ())
-> IO ()
unpacker Word8be
_ Addr#
start Addr#
_end Word8 -> Bool
_stop IO ()
_fail Addr# -> Value Word8be -> IO ()
eat
= do Word8
x <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
S.peek (Addr# -> Ptr Word8
pw8 Addr#
start)
Addr# -> Value Word8be -> IO ()
eat (Addr# -> Int# -> Addr#
plusAddr# Addr#
start Int#
1#) (Word8 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
x)
{-# INLINE unpacker #-}
w8 :: Integral a => a -> Word8
w8 :: forall a. Integral a => a -> Word8
w8 = a -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral
{-# INLINE w8 #-}
data Int8be = Int8be deriving (Int8be -> Int8be -> Bool
(Int8be -> Int8be -> Bool)
-> (Int8be -> Int8be -> Bool) -> Eq Int8be
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Int8be -> Int8be -> Bool
== :: Int8be -> Int8be -> Bool
$c/= :: Int8be -> Int8be -> Bool
/= :: Int8be -> Int8be -> Bool
Eq, Int -> Int8be -> ShowS
[Int8be] -> ShowS
Int8be -> String
(Int -> Int8be -> ShowS)
-> (Int8be -> String) -> ([Int8be] -> ShowS) -> Show Int8be
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Int8be -> ShowS
showsPrec :: Int -> Int8be -> ShowS
$cshow :: Int8be -> String
show :: Int8be -> String
$cshowList :: [Int8be] -> ShowS
showList :: [Int8be] -> ShowS
Show)
instance Format Int8be where
type Value Int8be = V.Int8
fieldCount :: Int8be -> Int
fieldCount Int8be
_ = Int
1
minSize :: Int8be -> Int
minSize Int8be
_ = Int
1
fixedSize :: Int8be -> Maybe Int
fixedSize Int8be
_ = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1
packedSize :: Int8be -> Value Int8be -> Maybe Int
packedSize Int8be
_ Value Int8be
_ = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1
{-# INLINE minSize #-}
{-# INLINE fieldCount #-}
{-# INLINE fixedSize #-}
{-# INLINE packedSize #-}
instance Packable Int8be where
packer :: Int8be
-> Value Int8be -> Addr# -> IO () -> (Addr# -> IO ()) -> IO ()
packer Int8be
Int8be Value Int8be
x Addr#
buf IO ()
k
= Word8be
-> Value Word8be -> Addr# -> IO () -> (Addr# -> IO ()) -> IO ()
forall format.
Packable format =>
format
-> Value format -> Addr# -> IO () -> (Addr# -> IO ()) -> IO ()
packer Word8be
Word8be (Int8 -> Word8
forall a. Integral a => a -> Word8
w8 Int8
Value Int8be
x) Addr#
buf IO ()
k
{-# INLINE packer #-}
instance Unpackable Int8be where
unpacker :: Int8be
-> Addr#
-> Addr#
-> (Word8 -> Bool)
-> IO ()
-> (Addr# -> Value Int8be -> IO ())
-> IO ()
unpacker Int8be
Int8be Addr#
start Addr#
end Word8 -> Bool
stop IO ()
fail Addr# -> Value Int8be -> IO ()
eat
= Word8be
-> Addr#
-> Addr#
-> (Word8 -> Bool)
-> IO ()
-> (Addr# -> Value Word8be -> IO ())
-> IO ()
forall format.
Unpackable format =>
format
-> Addr#
-> Addr#
-> (Word8 -> Bool)
-> IO ()
-> (Addr# -> Value format -> IO ())
-> IO ()
unpacker Word8be
Word8be Addr#
start Addr#
end Word8 -> Bool
stop IO ()
fail
((Addr# -> Value Word8be -> IO ()) -> IO ())
-> (Addr# -> Value Word8be -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Addr#
addr Value Word8be
v -> Addr# -> Value Int8be -> IO ()
eat Addr#
addr (Word8 -> Int8
forall a. Integral a => a -> Int8
i8 Word8
Value Word8be
v)
{-# INLINE unpacker #-}
i8 :: Integral a => a -> Int8
i8 :: forall a. Integral a => a -> Int8
i8 = a -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral
{-# INLINE i8 #-}
data Word16be = Word16be deriving (Word16be -> Word16be -> Bool
(Word16be -> Word16be -> Bool)
-> (Word16be -> Word16be -> Bool) -> Eq Word16be
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Word16be -> Word16be -> Bool
== :: Word16be -> Word16be -> Bool
$c/= :: Word16be -> Word16be -> Bool
/= :: Word16be -> Word16be -> Bool
Eq, Int -> Word16be -> ShowS
[Word16be] -> ShowS
Word16be -> String
(Int -> Word16be -> ShowS)
-> (Word16be -> String) -> ([Word16be] -> ShowS) -> Show Word16be
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Word16be -> ShowS
showsPrec :: Int -> Word16be -> ShowS
$cshow :: Word16be -> String
show :: Word16be -> String
$cshowList :: [Word16be] -> ShowS
showList :: [Word16be] -> ShowS
Show)
instance Format Word16be where
type Value Word16be = V.Word16
fieldCount :: Word16be -> Int
fieldCount Word16be
_ = Int
1
minSize :: Word16be -> Int
minSize Word16be
_ = Int
2
fixedSize :: Word16be -> Maybe Int
fixedSize Word16be
_ = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
2
packedSize :: Word16be -> Value Word16be -> Maybe Int
packedSize Word16be
_ Value Word16be
_ = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
2
{-# INLINE minSize #-}
{-# INLINE fieldCount #-}
{-# INLINE fixedSize #-}
{-# INLINE packedSize #-}
instance Packable Word16be where
packer :: Word16be
-> Value Word16be -> Addr# -> IO () -> (Addr# -> IO ()) -> IO ()
packer Word16be
Word16be Value Word16be
x Addr#
dst IO ()
_fails Addr# -> IO ()
k
= do Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
S.poke (Addr# -> Ptr Word8
forall a. Addr# -> Ptr a
Ptr Addr#
dst) (Word16 -> Word8
forall a. Integral a => a -> Word8
w8 ((Word16 -> Word16
forall a. Integral a => a -> Word16
w16 Word16
Value Word16be
x Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. Word16
0x0ff00) Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`shiftR` Int
8))
Ptr Any -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
S.pokeByteOff (Addr# -> Ptr Any
forall a. Addr# -> Ptr a
Ptr Addr#
dst) Int
1 (Word16 -> Word8
forall a. Integral a => a -> Word8
w8 ((Word16 -> Word16
forall a. Integral a => a -> Word16
w16 Word16
Value Word16be
x Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. Word16
0x000ff)))
let !(Ptr Addr#
dst') = Ptr Any -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
S.plusPtr (Addr# -> Ptr Any
forall a. Addr# -> Ptr a
Ptr Addr#
dst) Int
2
Addr# -> IO ()
k Addr#
dst'
{-# INLINE packer #-}
instance Unpackable Word16be where
unpacker :: Word16be
-> Addr#
-> Addr#
-> (Word8 -> Bool)
-> IO ()
-> (Addr# -> Value Word16be -> IO ())
-> IO ()
unpacker Word16be
Word16be Addr#
start Addr#
_end Word8 -> Bool
_stop IO ()
_fail Addr# -> Value Word16be -> IO ()
eat
= do Word8
x0 :: Word8 <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
S.peek (Addr# -> Ptr Word8
pw8 Addr#
start)
Word8
x1 :: Word8 <- Ptr Word8 -> Int -> IO Word8
forall b. Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
S.peekByteOff (Addr# -> Ptr Word8
pw8 Addr#
start) Int
1
Addr# -> Value Word16be -> IO ()
eat (Addr# -> Int# -> Addr#
plusAddr# Addr#
start Int#
2#)
(Word16 -> Word16
forall a. Integral a => a -> Word16
w16 ((Word8 -> Word16
forall a. Integral a => a -> Word16
w16 Word8
x0 Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`shiftL` Int
8) Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.|. Word8 -> Word16
forall a. Integral a => a -> Word16
w16 Word8
x1))
{-# INLINE unpacker #-}
w16 :: Integral a => a -> Word16
w16 :: forall a. Integral a => a -> Word16
w16 = a -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral
{-# INLINE w16 #-}
data Int16be = Int16be deriving (Int16be -> Int16be -> Bool
(Int16be -> Int16be -> Bool)
-> (Int16be -> Int16be -> Bool) -> Eq Int16be
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Int16be -> Int16be -> Bool
== :: Int16be -> Int16be -> Bool
$c/= :: Int16be -> Int16be -> Bool
/= :: Int16be -> Int16be -> Bool
Eq, Int -> Int16be -> ShowS
[Int16be] -> ShowS
Int16be -> String
(Int -> Int16be -> ShowS)
-> (Int16be -> String) -> ([Int16be] -> ShowS) -> Show Int16be
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Int16be -> ShowS
showsPrec :: Int -> Int16be -> ShowS
$cshow :: Int16be -> String
show :: Int16be -> String
$cshowList :: [Int16be] -> ShowS
showList :: [Int16be] -> ShowS
Show)
instance Format Int16be where
type Value Int16be = V.Int16
fieldCount :: Int16be -> Int
fieldCount Int16be
_ = Int
1
minSize :: Int16be -> Int
minSize Int16be
_ = Int
2
fixedSize :: Int16be -> Maybe Int
fixedSize Int16be
_ = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
2
packedSize :: Int16be -> Value Int16be -> Maybe Int
packedSize Int16be
_ Value Int16be
_ = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
2
{-# INLINE minSize #-}
{-# INLINE fieldCount #-}
{-# INLINE fixedSize #-}
{-# INLINE packedSize #-}
instance Packable Int16be where
packer :: Int16be
-> Value Int16be -> Addr# -> IO () -> (Addr# -> IO ()) -> IO ()
packer Int16be
Int16be Value Int16be
x Addr#
buf IO ()
k
= Word16be
-> Value Word16be -> Addr# -> IO () -> (Addr# -> IO ()) -> IO ()
forall format.
Packable format =>
format
-> Value format -> Addr# -> IO () -> (Addr# -> IO ()) -> IO ()
packer Word16be
Word16be (Int16 -> Word16
forall a. Integral a => a -> Word16
w16 Int16
Value Int16be
x) Addr#
buf IO ()
k
{-# INLINE packer #-}
instance Unpackable Int16be where
unpacker :: Int16be
-> Addr#
-> Addr#
-> (Word8 -> Bool)
-> IO ()
-> (Addr# -> Value Int16be -> IO ())
-> IO ()
unpacker Int16be
Int16be Addr#
start Addr#
end Word8 -> Bool
stop IO ()
fail Addr# -> Value Int16be -> IO ()
eat
= Word16be
-> Addr#
-> Addr#
-> (Word8 -> Bool)
-> IO ()
-> (Addr# -> Value Word16be -> IO ())
-> IO ()
forall format.
Unpackable format =>
format
-> Addr#
-> Addr#
-> (Word8 -> Bool)
-> IO ()
-> (Addr# -> Value format -> IO ())
-> IO ()
unpacker Word16be
Word16be Addr#
start Addr#
end Word8 -> Bool
stop IO ()
fail
((Addr# -> Value Word16be -> IO ()) -> IO ())
-> (Addr# -> Value Word16be -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Addr#
addr Value Word16be
v -> Addr# -> Value Int16be -> IO ()
eat Addr#
addr (Word16 -> Int16
forall a. Integral a => a -> Int16
i16 Word16
Value Word16be
v)
{-# INLINE unpacker #-}
i16 :: Integral a => a -> Int16
i16 :: forall a. Integral a => a -> Int16
i16 = a -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral
{-# INLINE i16 #-}
data Word32be = Word32be deriving (Word32be -> Word32be -> Bool
(Word32be -> Word32be -> Bool)
-> (Word32be -> Word32be -> Bool) -> Eq Word32be
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Word32be -> Word32be -> Bool
== :: Word32be -> Word32be -> Bool
$c/= :: Word32be -> Word32be -> Bool
/= :: Word32be -> Word32be -> Bool
Eq, Int -> Word32be -> ShowS
[Word32be] -> ShowS
Word32be -> String
(Int -> Word32be -> ShowS)
-> (Word32be -> String) -> ([Word32be] -> ShowS) -> Show Word32be
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Word32be -> ShowS
showsPrec :: Int -> Word32be -> ShowS
$cshow :: Word32be -> String
show :: Word32be -> String
$cshowList :: [Word32be] -> ShowS
showList :: [Word32be] -> ShowS
Show)
instance Format Word32be where
type Value Word32be = V.Word32
fieldCount :: Word32be -> Int
fieldCount Word32be
_ = Int
1
minSize :: Word32be -> Int
minSize Word32be
_ = Int
4
fixedSize :: Word32be -> Maybe Int
fixedSize Word32be
_ = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
4
packedSize :: Word32be -> Value Word32be -> Maybe Int
packedSize Word32be
_ Value Word32be
_ = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
4
{-# INLINE minSize #-}
{-# INLINE fieldCount #-}
{-# INLINE fixedSize #-}
{-# INLINE packedSize #-}
instance Packable Word32be where
packer :: Word32be
-> Value Word32be -> Addr# -> IO () -> (Addr# -> IO ()) -> IO ()
packer Word32be
Word32be Value Word32be
x Addr#
dst IO ()
_fails Addr# -> IO ()
k
= do Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
S.poke (Addr# -> Ptr Word8
forall a. Addr# -> Ptr a
Ptr Addr#
dst) (Word32 -> Word8
forall a. Integral a => a -> Word8
w8 ((Word32 -> Word32
forall a. Integral a => a -> Word32
w32 Word32
Value Word32be
x Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0x0ff000000) Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
24))
Ptr Any -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
S.pokeByteOff (Addr# -> Ptr Any
forall a. Addr# -> Ptr a
Ptr Addr#
dst) Int
1 (Word32 -> Word8
forall a. Integral a => a -> Word8
w8 ((Word32 -> Word32
forall a. Integral a => a -> Word32
w32 Word32
Value Word32be
x Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0x000ff0000) Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
16))
Ptr Any -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
S.pokeByteOff (Addr# -> Ptr Any
forall a. Addr# -> Ptr a
Ptr Addr#
dst) Int
2 (Word32 -> Word8
forall a. Integral a => a -> Word8
w8 ((Word32 -> Word32
forall a. Integral a => a -> Word32
w32 Word32
Value Word32be
x Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0x00000ff00) Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
8))
Ptr Any -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
S.pokeByteOff (Addr# -> Ptr Any
forall a. Addr# -> Ptr a
Ptr Addr#
dst) Int
3 (Word32 -> Word8
forall a. Integral a => a -> Word8
w8 ((Word32 -> Word32
forall a. Integral a => a -> Word32
w32 Word32
Value Word32be
x Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0x0000000ff)))
let !(Ptr Addr#
dst') = Ptr Any -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
S.plusPtr (Addr# -> Ptr Any
forall a. Addr# -> Ptr a
Ptr Addr#
dst) Int
4
Addr# -> IO ()
k Addr#
dst'
{-# INLINE packer #-}
instance Unpackable Word32be where
unpacker :: Word32be
-> Addr#
-> Addr#
-> (Word8 -> Bool)
-> IO ()
-> (Addr# -> Value Word32be -> IO ())
-> IO ()
unpacker Word32be
Word32be Addr#
start Addr#
_end Word8 -> Bool
_fail IO ()
_stop Addr# -> Value Word32be -> IO ()
eat
= do Word8
x0 :: Word8 <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
S.peek (Addr# -> Ptr Word8
pw8 Addr#
start)
Word8
x1 :: Word8 <- Ptr Word8 -> Int -> IO Word8
forall b. Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
S.peekByteOff (Addr# -> Ptr Word8
pw8 Addr#
start) Int
1
Word8
x2 :: Word8 <- Ptr Word8 -> Int -> IO Word8
forall b. Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
S.peekByteOff (Addr# -> Ptr Word8
pw8 Addr#
start) Int
2
Word8
x3 :: Word8 <- Ptr Word8 -> Int -> IO Word8
forall b. Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
S.peekByteOff (Addr# -> Ptr Word8
pw8 Addr#
start) Int
3
Addr# -> Value Word32be -> IO ()
eat (Addr# -> Int# -> Addr#
plusAddr# Addr#
start Int#
4#)
(Word32 -> Word32
forall a. Integral a => a -> Word32
w32 ( (Word8 -> Word32
forall a. Integral a => a -> Word32
w32 Word8
x0 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
24)
Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word32
forall a. Integral a => a -> Word32
w32 Word8
x1 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
16)
Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word32
forall a. Integral a => a -> Word32
w32 Word8
x2 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
8)
Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word32
forall a. Integral a => a -> Word32
w32 Word8
x3)))
{-# INLINE unpacker #-}
w32 :: Integral a => a -> Word32
w32 :: forall a. Integral a => a -> Word32
w32 = a -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral
{-# INLINE w32 #-}
data Int32be = Int32be deriving (Int32be -> Int32be -> Bool
(Int32be -> Int32be -> Bool)
-> (Int32be -> Int32be -> Bool) -> Eq Int32be
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Int32be -> Int32be -> Bool
== :: Int32be -> Int32be -> Bool
$c/= :: Int32be -> Int32be -> Bool
/= :: Int32be -> Int32be -> Bool
Eq, Int -> Int32be -> ShowS
[Int32be] -> ShowS
Int32be -> String
(Int -> Int32be -> ShowS)
-> (Int32be -> String) -> ([Int32be] -> ShowS) -> Show Int32be
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Int32be -> ShowS
showsPrec :: Int -> Int32be -> ShowS
$cshow :: Int32be -> String
show :: Int32be -> String
$cshowList :: [Int32be] -> ShowS
showList :: [Int32be] -> ShowS
Show)
instance Format Int32be where
type Value Int32be = V.Int32
fieldCount :: Int32be -> Int
fieldCount Int32be
_ = Int
1
minSize :: Int32be -> Int
minSize Int32be
_ = Int
4
fixedSize :: Int32be -> Maybe Int
fixedSize Int32be
_ = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
4
packedSize :: Int32be -> Value Int32be -> Maybe Int
packedSize Int32be
_ Value Int32be
_ = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
4
{-# INLINE minSize #-}
{-# INLINE fieldCount #-}
{-# INLINE fixedSize #-}
{-# INLINE packedSize #-}
instance Packable Int32be where
packer :: Int32be
-> Value Int32be -> Addr# -> IO () -> (Addr# -> IO ()) -> IO ()
packer Int32be
Int32be Value Int32be
x Addr#
buf IO ()
k
= Word32be
-> Value Word32be -> Addr# -> IO () -> (Addr# -> IO ()) -> IO ()
forall format.
Packable format =>
format
-> Value format -> Addr# -> IO () -> (Addr# -> IO ()) -> IO ()
packer Word32be
Word32be (Int32 -> Word32
forall a. Integral a => a -> Word32
w32 Int32
Value Int32be
x) Addr#
buf IO ()
k
{-# INLINE packer #-}
instance Unpackable Int32be where
unpacker :: Int32be
-> Addr#
-> Addr#
-> (Word8 -> Bool)
-> IO ()
-> (Addr# -> Value Int32be -> IO ())
-> IO ()
unpacker Int32be
Int32be Addr#
start Addr#
end Word8 -> Bool
stop IO ()
fail Addr# -> Value Int32be -> IO ()
eat
= Word32be
-> Addr#
-> Addr#
-> (Word8 -> Bool)
-> IO ()
-> (Addr# -> Value Word32be -> IO ())
-> IO ()
forall format.
Unpackable format =>
format
-> Addr#
-> Addr#
-> (Word8 -> Bool)
-> IO ()
-> (Addr# -> Value format -> IO ())
-> IO ()
unpacker Word32be
Word32be Addr#
start Addr#
end Word8 -> Bool
stop IO ()
fail
((Addr# -> Value Word32be -> IO ()) -> IO ())
-> (Addr# -> Value Word32be -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Addr#
addr Value Word32be
v -> Addr# -> Value Int32be -> IO ()
eat Addr#
addr (Word32 -> Int32
forall a. Integral a => a -> Int32
i32 Word32
Value Word32be
v)
{-# INLINE unpacker #-}
i32 :: Integral a => a -> Int32
i32 :: forall a. Integral a => a -> Int32
i32 = a -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral
{-# INLINE i32 #-}
data Word64be = Word64be deriving (Word64be -> Word64be -> Bool
(Word64be -> Word64be -> Bool)
-> (Word64be -> Word64be -> Bool) -> Eq Word64be
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Word64be -> Word64be -> Bool
== :: Word64be -> Word64be -> Bool
$c/= :: Word64be -> Word64be -> Bool
/= :: Word64be -> Word64be -> Bool
Eq, Int -> Word64be -> ShowS
[Word64be] -> ShowS
Word64be -> String
(Int -> Word64be -> ShowS)
-> (Word64be -> String) -> ([Word64be] -> ShowS) -> Show Word64be
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Word64be -> ShowS
showsPrec :: Int -> Word64be -> ShowS
$cshow :: Word64be -> String
show :: Word64be -> String
$cshowList :: [Word64be] -> ShowS
showList :: [Word64be] -> ShowS
Show)
instance Format Word64be where
type Value Word64be = V.Word64
fieldCount :: Word64be -> Int
fieldCount Word64be
_ = Int
1
minSize :: Word64be -> Int
minSize Word64be
_ = Int
8
fixedSize :: Word64be -> Maybe Int
fixedSize Word64be
_ = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
8
packedSize :: Word64be -> Value Word64be -> Maybe Int
packedSize Word64be
_ Value Word64be
_ = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
8
{-# INLINE minSize #-}
{-# INLINE fieldCount #-}
{-# INLINE fixedSize #-}
{-# INLINE packedSize #-}
instance Packable Word64be where
packer :: Word64be
-> Value Word64be -> Addr# -> IO () -> (Addr# -> IO ()) -> IO ()
packer Word64be
Word64be Value Word64be
x Addr#
dst IO ()
_fails Addr# -> IO ()
k
= do Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
S.poke (Addr# -> Ptr Word8
forall a. Addr# -> Ptr a
Ptr Addr#
dst) (Word64 -> Word8
forall a. Integral a => a -> Word8
w8 ((Word64 -> Word64
forall a. Integral a => a -> Word64
w64 Word64
Value Word64be
x Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0x0ff00000000000000) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
56))
Ptr Any -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
S.pokeByteOff (Addr# -> Ptr Any
forall a. Addr# -> Ptr a
Ptr Addr#
dst) Int
1 (Word64 -> Word8
forall a. Integral a => a -> Word8
w8 ((Word64 -> Word64
forall a. Integral a => a -> Word64
w64 Word64
Value Word64be
x Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0x000ff000000000000) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
48))
Ptr Any -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
S.pokeByteOff (Addr# -> Ptr Any
forall a. Addr# -> Ptr a
Ptr Addr#
dst) Int
2 (Word64 -> Word8
forall a. Integral a => a -> Word8
w8 ((Word64 -> Word64
forall a. Integral a => a -> Word64
w64 Word64
Value Word64be
x Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0x00000ff0000000000) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
40))
Ptr Any -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
S.pokeByteOff (Addr# -> Ptr Any
forall a. Addr# -> Ptr a
Ptr Addr#
dst) Int
3 (Word64 -> Word8
forall a. Integral a => a -> Word8
w8 ((Word64 -> Word64
forall a. Integral a => a -> Word64
w64 Word64
Value Word64be
x Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0x0000000ff00000000) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
32))
Ptr Any -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
S.pokeByteOff (Addr# -> Ptr Any
forall a. Addr# -> Ptr a
Ptr Addr#
dst) Int
4 (Word64 -> Word8
forall a. Integral a => a -> Word8
w8 ((Word64 -> Word64
forall a. Integral a => a -> Word64
w64 Word64
Value Word64be
x Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0x000000000ff000000) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
24))
Ptr Any -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
S.pokeByteOff (Addr# -> Ptr Any
forall a. Addr# -> Ptr a
Ptr Addr#
dst) Int
5 (Word64 -> Word8
forall a. Integral a => a -> Word8
w8 ((Word64 -> Word64
forall a. Integral a => a -> Word64
w64 Word64
Value Word64be
x Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0x00000000000ff0000) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
16))
Ptr Any -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
S.pokeByteOff (Addr# -> Ptr Any
forall a. Addr# -> Ptr a
Ptr Addr#
dst) Int
6 (Word64 -> Word8
forall a. Integral a => a -> Word8
w8 ((Word64 -> Word64
forall a. Integral a => a -> Word64
w64 Word64
Value Word64be
x Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0x0000000000000ff00) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
8))
Ptr Any -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
S.pokeByteOff (Addr# -> Ptr Any
forall a. Addr# -> Ptr a
Ptr Addr#
dst) Int
7 (Word64 -> Word8
forall a. Integral a => a -> Word8
w8 ((Word64 -> Word64
forall a. Integral a => a -> Word64
w64 Word64
Value Word64be
x Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0x000000000000000ff) ))
let !(Ptr Addr#
dst') = Ptr Any -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
S.plusPtr (Addr# -> Ptr Any
forall a. Addr# -> Ptr a
Ptr Addr#
dst) Int
8
Addr# -> IO ()
k Addr#
dst'
{-# INLINE packer #-}
instance Unpackable Word64be where
unpacker :: Word64be
-> Addr#
-> Addr#
-> (Word8 -> Bool)
-> IO ()
-> (Addr# -> Value Word64be -> IO ())
-> IO ()
unpacker Word64be
Word64be Addr#
start Addr#
_end Word8 -> Bool
_fail IO ()
_stop Addr# -> Value Word64be -> IO ()
eat
= do Word8
x0 :: Word8 <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
S.peek (Addr# -> Ptr Word8
pw8 Addr#
start)
Word8
x1 :: Word8 <- Ptr Word8 -> Int -> IO Word8
forall b. Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
S.peekByteOff (Addr# -> Ptr Word8
pw8 Addr#
start) Int
1
Word8
x2 :: Word8 <- Ptr Word8 -> Int -> IO Word8
forall b. Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
S.peekByteOff (Addr# -> Ptr Word8
pw8 Addr#
start) Int
2
Word8
x3 :: Word8 <- Ptr Word8 -> Int -> IO Word8
forall b. Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
S.peekByteOff (Addr# -> Ptr Word8
pw8 Addr#
start) Int
3
Word8
x4 :: Word8 <- Ptr Word8 -> Int -> IO Word8
forall b. Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
S.peekByteOff (Addr# -> Ptr Word8
pw8 Addr#
start) Int
4
Word8
x5 :: Word8 <- Ptr Word8 -> Int -> IO Word8
forall b. Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
S.peekByteOff (Addr# -> Ptr Word8
pw8 Addr#
start) Int
5
Word8
x6 :: Word8 <- Ptr Word8 -> Int -> IO Word8
forall b. Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
S.peekByteOff (Addr# -> Ptr Word8
pw8 Addr#
start) Int
6
Word8
x7 :: Word8 <- Ptr Word8 -> Int -> IO Word8
forall b. Ptr b -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
S.peekByteOff (Addr# -> Ptr Word8
pw8 Addr#
start) Int
7
Addr# -> Value Word64be -> IO ()
eat (Addr# -> Int# -> Addr#
plusAddr# Addr#
start Int#
8#)
(Word64 -> Word64
forall a. Integral a => a -> Word64
w64 ( (Word8 -> Word64
forall a. Integral a => a -> Word64
w64 Word8
x0 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
56)
Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word64
forall a. Integral a => a -> Word64
w64 Word8
x1 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
48)
Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word64
forall a. Integral a => a -> Word64
w64 Word8
x2 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
40)
Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word64
forall a. Integral a => a -> Word64
w64 Word8
x3 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
32)
Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word64
forall a. Integral a => a -> Word64
w64 Word8
x4 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
24)
Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word64
forall a. Integral a => a -> Word64
w64 Word8
x5 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
16)
Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word64
forall a. Integral a => a -> Word64
w64 Word8
x6 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
8)
Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word64
forall a. Integral a => a -> Word64
w64 Word8
x7 )))
{-# INLINE unpacker #-}
w64 :: Integral a => a -> Word64
w64 :: forall a. Integral a => a -> Word64
w64 = a -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
{-# INLINE w64 #-}
data Int64be = Int64be deriving (Int64be -> Int64be -> Bool
(Int64be -> Int64be -> Bool)
-> (Int64be -> Int64be -> Bool) -> Eq Int64be
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Int64be -> Int64be -> Bool
== :: Int64be -> Int64be -> Bool
$c/= :: Int64be -> Int64be -> Bool
/= :: Int64be -> Int64be -> Bool
Eq, Int -> Int64be -> ShowS
[Int64be] -> ShowS
Int64be -> String
(Int -> Int64be -> ShowS)
-> (Int64be -> String) -> ([Int64be] -> ShowS) -> Show Int64be
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Int64be -> ShowS
showsPrec :: Int -> Int64be -> ShowS
$cshow :: Int64be -> String
show :: Int64be -> String
$cshowList :: [Int64be] -> ShowS
showList :: [Int64be] -> ShowS
Show)
instance Format Int64be where
type Value Int64be = V.Int64
fieldCount :: Int64be -> Int
fieldCount Int64be
_ = Int
1
minSize :: Int64be -> Int
minSize Int64be
_ = Int
8
fixedSize :: Int64be -> Maybe Int
fixedSize Int64be
_ = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
8
packedSize :: Int64be -> Value Int64be -> Maybe Int
packedSize Int64be
_ Value Int64be
_ = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
8
{-# INLINE minSize #-}
{-# INLINE fieldCount #-}
{-# INLINE fixedSize #-}
{-# INLINE packedSize #-}
instance Packable Int64be where
packer :: Int64be
-> Value Int64be -> Addr# -> IO () -> (Addr# -> IO ()) -> IO ()
packer Int64be
Int64be Value Int64be
x Addr#
buf IO ()
k
= Word64be
-> Value Word64be -> Addr# -> IO () -> (Addr# -> IO ()) -> IO ()
forall format.
Packable format =>
format
-> Value format -> Addr# -> IO () -> (Addr# -> IO ()) -> IO ()
packer Word64be
Word64be (Int64 -> Word64
forall a. Integral a => a -> Word64
w64 Int64
Value Int64be
x) Addr#
buf IO ()
k
{-# INLINE packer #-}
instance Unpackable Int64be where
unpacker :: Int64be
-> Addr#
-> Addr#
-> (Word8 -> Bool)
-> IO ()
-> (Addr# -> Value Int64be -> IO ())
-> IO ()
unpacker Int64be
Int64be Addr#
start Addr#
end Word8 -> Bool
stop IO ()
fail Addr# -> Value Int64be -> IO ()
eat
= Word64be
-> Addr#
-> Addr#
-> (Word8 -> Bool)
-> IO ()
-> (Addr# -> Value Word64be -> IO ())
-> IO ()
forall format.
Unpackable format =>
format
-> Addr#
-> Addr#
-> (Word8 -> Bool)
-> IO ()
-> (Addr# -> Value format -> IO ())
-> IO ()
unpacker Word64be
Word64be Addr#
start Addr#
end Word8 -> Bool
stop IO ()
fail
((Addr# -> Value Word64be -> IO ()) -> IO ())
-> (Addr# -> Value Word64be -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Addr#
addr Value Word64be
v -> Addr# -> Value Int64be -> IO ()
eat Addr#
addr (Word64 -> Int64
forall a. Integral a => a -> Int64
i64 Word64
Value Word64be
v)
{-# INLINE unpacker #-}
i64 :: Integral a => a -> Int64
i64 :: forall a. Integral a => a -> Int64
i64 = a -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
{-# INLINE i64 #-}
data Float32be = Float32be deriving (Float32be -> Float32be -> Bool
(Float32be -> Float32be -> Bool)
-> (Float32be -> Float32be -> Bool) -> Eq Float32be
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Float32be -> Float32be -> Bool
== :: Float32be -> Float32be -> Bool
$c/= :: Float32be -> Float32be -> Bool
/= :: Float32be -> Float32be -> Bool
Eq, Int -> Float32be -> ShowS
[Float32be] -> ShowS
Float32be -> String
(Int -> Float32be -> ShowS)
-> (Float32be -> String)
-> ([Float32be] -> ShowS)
-> Show Float32be
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Float32be -> ShowS
showsPrec :: Int -> Float32be -> ShowS
$cshow :: Float32be -> String
show :: Float32be -> String
$cshowList :: [Float32be] -> ShowS
showList :: [Float32be] -> ShowS
Show)
instance Format Float32be where
type Value Float32be = Float
fieldCount :: Float32be -> Int
fieldCount Float32be
_ = Int
1
minSize :: Float32be -> Int
minSize Float32be
_ = Int
4
fixedSize :: Float32be -> Maybe Int
fixedSize Float32be
_ = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
4
packedSize :: Float32be -> Value Float32be -> Maybe Int
packedSize Float32be
_ Value Float32be
_ = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
4
{-# INLINE minSize #-}
{-# INLINE fieldCount #-}
{-# INLINE fixedSize #-}
{-# INLINE packedSize #-}
instance Packable Float32be where
packer :: Float32be
-> Value Float32be -> Addr# -> IO () -> (Addr# -> IO ()) -> IO ()
packer Float32be
Float32be Value Float32be
x Addr#
buf IO ()
k
= Word32be
-> Value Word32be -> Addr# -> IO () -> (Addr# -> IO ()) -> IO ()
forall format.
Packable format =>
format
-> Value format -> Addr# -> IO () -> (Addr# -> IO ()) -> IO ()
packer Word32be
Word32be (Float -> Word32
floatToWord32 Float
Value Float32be
x) Addr#
buf IO ()
k
{-# INLINE packer #-}
instance Unpackable Float32be where
unpacker :: Float32be
-> Addr#
-> Addr#
-> (Word8 -> Bool)
-> IO ()
-> (Addr# -> Value Float32be -> IO ())
-> IO ()
unpacker Float32be
Float32be Addr#
start Addr#
end Word8 -> Bool
stop IO ()
fail Addr# -> Value Float32be -> IO ()
eat
= Word32be
-> Addr#
-> Addr#
-> (Word8 -> Bool)
-> IO ()
-> (Addr# -> Value Word32be -> IO ())
-> IO ()
forall format.
Unpackable format =>
format
-> Addr#
-> Addr#
-> (Word8 -> Bool)
-> IO ()
-> (Addr# -> Value format -> IO ())
-> IO ()
unpacker Word32be
Word32be Addr#
start Addr#
end Word8 -> Bool
stop IO ()
fail
((Addr# -> Value Word32be -> IO ()) -> IO ())
-> (Addr# -> Value Word32be -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Addr#
addr Value Word32be
v -> Addr# -> Value Float32be -> IO ()
eat Addr#
addr (Word32 -> Float
word32ToFloat Word32
Value Word32be
v)
{-# INLINE unpacker #-}
floatToWord32 :: Float -> Word32
floatToWord32 :: Float -> Word32
floatToWord32 Float
d
= IO Word32 -> Word32
forall a. IO a -> a
Prim.unsafeInlineIO
(IO Word32 -> Word32) -> IO Word32 -> Word32
forall a b. (a -> b) -> a -> b
$ (Ptr Word32 -> IO Word32) -> IO Word32
forall a b. Storable a => (Ptr a -> IO b) -> IO b
S.alloca ((Ptr Word32 -> IO Word32) -> IO Word32)
-> (Ptr Word32 -> IO Word32) -> IO Word32
forall a b. (a -> b) -> a -> b
$ \Ptr Word32
buf ->
do Ptr Float -> Float -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
S.poke (Ptr Word32 -> Ptr Float
forall a b. Ptr a -> Ptr b
S.castPtr Ptr Word32
buf) Float
d
Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
S.peek Ptr Word32
buf
{-# INLINE floatToWord32 #-}
word32ToFloat :: Word32 -> Float
word32ToFloat :: Word32 -> Float
word32ToFloat Word32
w
= IO Float -> Float
forall a. IO a -> a
Prim.unsafeInlineIO
(IO Float -> Float) -> IO Float -> Float
forall a b. (a -> b) -> a -> b
$ (Ptr Float -> IO Float) -> IO Float
forall a b. Storable a => (Ptr a -> IO b) -> IO b
S.alloca ((Ptr Float -> IO Float) -> IO Float)
-> (Ptr Float -> IO Float) -> IO Float
forall a b. (a -> b) -> a -> b
$ \Ptr Float
buf ->
do Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
S.poke (Ptr Float -> Ptr Word32
forall a b. Ptr a -> Ptr b
S.castPtr Ptr Float
buf) Word32
w
Ptr Float -> IO Float
forall a. Storable a => Ptr a -> IO a
S.peek Ptr Float
buf
{-# INLINE word32ToFloat #-}
data Float64be = Float64be deriving (Float64be -> Float64be -> Bool
(Float64be -> Float64be -> Bool)
-> (Float64be -> Float64be -> Bool) -> Eq Float64be
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Float64be -> Float64be -> Bool
== :: Float64be -> Float64be -> Bool
$c/= :: Float64be -> Float64be -> Bool
/= :: Float64be -> Float64be -> Bool
Eq, Int -> Float64be -> ShowS
[Float64be] -> ShowS
Float64be -> String
(Int -> Float64be -> ShowS)
-> (Float64be -> String)
-> ([Float64be] -> ShowS)
-> Show Float64be
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Float64be -> ShowS
showsPrec :: Int -> Float64be -> ShowS
$cshow :: Float64be -> String
show :: Float64be -> String
$cshowList :: [Float64be] -> ShowS
showList :: [Float64be] -> ShowS
Show)
instance Format Float64be where
type Value Float64be = Double
fieldCount :: Float64be -> Int
fieldCount Float64be
_ = Int
1
minSize :: Float64be -> Int
minSize Float64be
_ = Int
8
fixedSize :: Float64be -> Maybe Int
fixedSize Float64be
_ = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
8
packedSize :: Float64be -> Value Float64be -> Maybe Int
packedSize Float64be
_ Value Float64be
_ = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
8
{-# INLINE minSize #-}
{-# INLINE fieldCount #-}
{-# INLINE fixedSize #-}
{-# INLINE packedSize #-}
instance Packable Float64be where
packer :: Float64be
-> Value Float64be -> Addr# -> IO () -> (Addr# -> IO ()) -> IO ()
packer Float64be
Float64be Value Float64be
x Addr#
start IO ()
fails Addr# -> IO ()
eat
= Word64be
-> Value Word64be -> Addr# -> IO () -> (Addr# -> IO ()) -> IO ()
forall format.
Packable format =>
format
-> Value format -> Addr# -> IO () -> (Addr# -> IO ()) -> IO ()
packer Word64be
Word64be (Double -> Word64
doubleToWord64 Double
Value Float64be
x) Addr#
start IO ()
fails Addr# -> IO ()
eat
{-# INLINE packer #-}
instance Unpackable Float64be where
unpacker :: Float64be
-> Addr#
-> Addr#
-> (Word8 -> Bool)
-> IO ()
-> (Addr# -> Value Float64be -> IO ())
-> IO ()
unpacker Float64be
Float64be Addr#
start Addr#
end Word8 -> Bool
stop IO ()
fail Addr# -> Value Float64be -> IO ()
eat
= Word64be
-> Addr#
-> Addr#
-> (Word8 -> Bool)
-> IO ()
-> (Addr# -> Value Word64be -> IO ())
-> IO ()
forall format.
Unpackable format =>
format
-> Addr#
-> Addr#
-> (Word8 -> Bool)
-> IO ()
-> (Addr# -> Value format -> IO ())
-> IO ()
unpacker Word64be
Word64be Addr#
start Addr#
end Word8 -> Bool
stop IO ()
fail
((Addr# -> Value Word64be -> IO ()) -> IO ())
-> (Addr# -> Value Word64be -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Addr#
addr Value Word64be
v -> Addr# -> Value Float64be -> IO ()
eat Addr#
addr (Word64 -> Double
word64ToDouble Word64
Value Word64be
v)
{-# INLINE unpacker #-}
doubleToWord64 :: Double -> Word64
doubleToWord64 :: Double -> Word64
doubleToWord64 Double
d
= IO Word64 -> Word64
forall a. IO a -> a
Prim.unsafeInlineIO
(IO Word64 -> Word64) -> IO Word64 -> Word64
forall a b. (a -> b) -> a -> b
$ (Ptr Word64 -> IO Word64) -> IO Word64
forall a b. Storable a => (Ptr a -> IO b) -> IO b
S.alloca ((Ptr Word64 -> IO Word64) -> IO Word64)
-> (Ptr Word64 -> IO Word64) -> IO Word64
forall a b. (a -> b) -> a -> b
$ \Ptr Word64
buf ->
do Ptr Double -> Double -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
S.poke (Ptr Word64 -> Ptr Double
forall a b. Ptr a -> Ptr b
S.castPtr Ptr Word64
buf) Double
d
Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
S.peek Ptr Word64
buf
{-# INLINE doubleToWord64 #-}
word64ToDouble :: Word64 -> Double
word64ToDouble :: Word64 -> Double
word64ToDouble Word64
w
= IO Double -> Double
forall a. IO a -> a
Prim.unsafeInlineIO
(IO Double -> Double) -> IO Double -> Double
forall a b. (a -> b) -> a -> b
$ (Ptr Double -> IO Double) -> IO Double
forall a b. Storable a => (Ptr a -> IO b) -> IO b
S.alloca ((Ptr Double -> IO Double) -> IO Double)
-> (Ptr Double -> IO Double) -> IO Double
forall a b. (a -> b) -> a -> b
$ \Ptr Double
buf ->
do Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
S.poke (Ptr Double -> Ptr Word64
forall a b. Ptr a -> Ptr b
S.castPtr Ptr Double
buf) Word64
w
Ptr Double -> IO Double
forall a. Storable a => Ptr a -> IO a
S.peek Ptr Double
buf
{-# INLINE word64ToDouble #-}
pw8 :: Addr# -> Ptr Word8
pw8 :: Addr# -> Ptr Word8
pw8 Addr#
addr = Addr# -> Ptr Word8
forall a. Addr# -> Ptr a
Ptr Addr#
addr
{-# INLINE pw8 #-}