module Data.Repa.Convert.Format.Binary
( Format (..)
, Word8be (..), Int8be (..)
, Word16be (..), Int16be (..)
, Word32be (..), Int32be (..)
, Word64be (..), Int64be (..)
, Float32be (..)
, Float64be (..))
where
import Data.Repa.Convert.Format.Base
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
data Int8be = Int8be deriving (Eq, Show)
instance Format Int8be where
type Value Int8be = V.Int8
fixedSize _ = Just 1
packedSize _ _ = Just 1
i8 :: Integral a => a -> Int8
i8 = fromIntegral
data Word8be = Word8be deriving (Eq, Show)
instance Format Word8be where
type Value Word8be = V.Word8
fixedSize _ = Just 1
packedSize _ _ = Just 1
instance Packable Word8be where
pack buf Word8be x k
= do S.poke buf (fromIntegral x)
k 1
unpack buf Word8be k
= do x <- S.peek buf
k (fromIntegral x, 1)
instance Packable Int8be where
pack buf Int8be x k = pack buf Word8be (w8 x) k
unpack buf Int8be k = unpack buf Word8be (\(x, o) -> k (i8 x, o))
w8 :: Integral a => a -> Word8
w8 = fromIntegral
data Int16be = Int16be deriving (Eq, Show)
instance Format Int16be where
type Value Int16be = V.Int16
fixedSize _ = Just 2
packedSize _ _ = Just 2
i16 :: Integral a => a -> Int16
i16 = fromIntegral
data Word16be = Word16be deriving (Eq, Show)
instance Format Word16be where
type Value Word16be = V.Word16
fixedSize _ = Just 2
packedSize _ _ = Just 2
instance Packable Word16be where
pack buf Word16be x k
= do S.poke buf (w8 ((w16 x .&. 0x0ff00) `shiftR` 8))
S.pokeByteOff buf 1 (w8 ((w16 x .&. 0x000ff)))
k 2
unpack buf Word16be k
= do x0 :: Word8 <- S.peek buf
x1 :: Word8 <- S.peekByteOff buf 1
let !x = w16 ((w16 x0 `shiftL` 8) .|. w16 x1)
k (x, 2)
instance Packable Int16be where
pack buf Int16be x k = pack buf Word16be (w16 x) k
unpack buf Int16be k = unpack buf Word16be (\(x, o) -> k (i16 x, o))
w16 :: Integral a => a -> Word16
w16 = fromIntegral
data Int32be = Int32be deriving (Eq, Show)
instance Format Int32be where
type Value Int32be = V.Int32
fixedSize _ = Just 4
packedSize _ _ = Just 4
instance Packable Int32be where
pack buf Int32be x k = pack buf Word32be (w32 x) k
unpack buf Int32be k = unpack buf Word32be (\(x, o) -> k (i32 x, o))
i32 :: Integral a => a -> Int32
i32 = fromIntegral
data Word32be = Word32be deriving (Eq, Show)
instance Format Word32be where
type Value Word32be = V.Word32
fixedSize _ = Just 4
packedSize _ _ = Just 4
instance Packable Word32be where
pack buf Word32be x k
= do S.poke buf (w8 ((w32 x .&. 0x0ff000000) `shiftR` 24))
S.pokeByteOff buf 1 (w8 ((w32 x .&. 0x000ff0000) `shiftR` 16))
S.pokeByteOff buf 2 (w8 ((w32 x .&. 0x00000ff00) `shiftR` 8))
S.pokeByteOff buf 3 (w8 ((w32 x .&. 0x0000000ff)))
k 4
unpack buf Word32be k
= do x0 :: Word8 <- S.peek buf
x1 :: Word8 <- S.peekByteOff buf 1
x2 :: Word8 <- S.peekByteOff buf 2
x3 :: Word8 <- S.peekByteOff buf 3
let !x = w32 ( (w32 x0 `shiftL` 24)
.|. (w32 x1 `shiftL` 16)
.|. (w32 x2 `shiftL` 8)
.|. (w32 x3))
k (x, 4)
w32 :: Integral a => a -> Word32
w32 = fromIntegral
data Int64be = Int64be deriving (Eq, Show)
instance Format Int64be where
type Value Int64be = V.Int64
fixedSize _ = Just 8
packedSize _ _ = Just 8
instance Packable Int64be where
pack buf Int64be x k = pack buf Word64be (w64 x) k
unpack buf Int64be k = unpack buf Word64be (\(x, o) -> k (i64 x, o))
i64 :: Integral a => a -> Int64
i64 = fromIntegral
data Word64be = Word64be deriving (Eq, Show)
instance Format Word64be where
type Value Word64be = V.Word64
fixedSize _ = Just 8
packedSize _ _ = Just 8
instance Packable Word64be where
pack buf Word64be x k
= do S.poke buf (w8 ((w64 x .&. 0x0ff00000000000000) `shiftR` 56))
S.pokeByteOff buf 1 (w8 ((w64 x .&. 0x000ff000000000000) `shiftR` 48))
S.pokeByteOff buf 2 (w8 ((w64 x .&. 0x00000ff0000000000) `shiftR` 40))
S.pokeByteOff buf 3 (w8 ((w64 x .&. 0x0000000ff00000000) `shiftR` 32))
S.pokeByteOff buf 4 (w8 ((w64 x .&. 0x000000000ff000000) `shiftR` 24))
S.pokeByteOff buf 5 (w8 ((w64 x .&. 0x00000000000ff0000) `shiftR` 16))
S.pokeByteOff buf 6 (w8 ((w64 x .&. 0x0000000000000ff00) `shiftR` 8))
S.pokeByteOff buf 7 (w8 ((w64 x .&. 0x000000000000000ff) ))
k 8
unpack buf Word64be k
= do x0 :: Word8 <- S.peek buf
x1 :: Word8 <- S.peekByteOff buf 1
x2 :: Word8 <- S.peekByteOff buf 2
x3 :: Word8 <- S.peekByteOff buf 3
x4 :: Word8 <- S.peekByteOff buf 4
x5 :: Word8 <- S.peekByteOff buf 5
x6 :: Word8 <- S.peekByteOff buf 6
x7 :: Word8 <- S.peekByteOff buf 7
let !x = w64 ( (w64 x0 `shiftL` 56)
.|. (w64 x1 `shiftL` 48)
.|. (w64 x2 `shiftL` 40)
.|. (w64 x3 `shiftL` 32)
.|. (w64 x4 `shiftL` 24)
.|. (w64 x5 `shiftL` 16)
.|. (w64 x6 `shiftL` 8)
.|. (w64 x7 ))
k (x, 8)
w64 :: Integral a => a -> Word64
w64 = fromIntegral
data Float32be = Float32be deriving (Eq, Show)
instance Format Float32be where
type Value Float32be = Float
fixedSize _ = Just 4
packedSize _ _ = Just 4
instance Packable Float32be where
pack buf Float32be x k
= pack buf Word32be (floatToWord32 x) k
unpack buf Float32be k
= unpack buf Word32be (\(v, i) -> k (word32ToFloat v, i))
floatToWord32 :: Float -> Word32
floatToWord32 d
= Prim.unsafeInlineIO
$ S.alloca $ \buf ->
do S.poke (S.castPtr buf) d
S.peek buf
word32ToFloat :: Word32 -> Float
word32ToFloat w
= Prim.unsafeInlineIO
$ S.alloca $ \buf ->
do S.poke (S.castPtr buf) w
S.peek buf
data Float64be = Float64be deriving (Eq, Show)
instance Format Float64be where
type Value Float64be = Double
fixedSize _ = Just 8
packedSize _ _ = Just 8
instance Packable Float64be where
pack buf Float64be x k
= pack buf Word64be (doubleToWord64 x) k
unpack buf Float64be k
= unpack buf Word64be (\(v, i) -> k (word64ToDouble v, i))
doubleToWord64 :: Double -> Word64
doubleToWord64 d
= Prim.unsafeInlineIO
$ S.alloca $ \buf ->
do S.poke (S.castPtr buf) d
S.peek buf
word64ToDouble :: Word64 -> Double
word64ToDouble w
= Prim.unsafeInlineIO
$ S.alloca $ \buf ->
do S.poke (S.castPtr buf) w
S.peek buf