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 Word8be = Word8be deriving (Eq, Show)
instance Format Word8be where
type Value Word8be = Word8
fieldCount _ = 1
minSize _ = 1
fixedSize _ = Just 1
packedSize _ _ = Just 1
instance Packable Word8be where
pack Word8be x
= Packer $ \buf k
-> do S.poke buf (fromIntegral x)
k (S.plusPtr buf 1)
unpack Word8be
= Unpacker $ \start _end _stop _fail eat
-> do x <- S.peek start
eat (S.plusPtr start 1) (fromIntegral x)
w8 :: Integral a => a -> Word8
w8 = fromIntegral
data Int8be = Int8be deriving (Eq, Show)
instance Format Int8be where
type Value Int8be = V.Int8
fieldCount _ = 1
minSize _ = 1
fixedSize _ = Just 1
packedSize _ _ = Just 1
instance Packable Int8be where
pack Int8be x = pack Word8be (w8 x)
unpack Int8be = fmap i8 (unpack Word8be)
i8 :: Integral a => a -> Int8
i8 = fromIntegral
data Word16be = Word16be deriving (Eq, Show)
instance Format Word16be where
type Value Word16be = V.Word16
fieldCount _ = 1
minSize _ = 2
fixedSize _ = Just 2
packedSize _ _ = Just 2
instance Packable Word16be where
pack Word16be x
= Packer $ \buf k
-> do S.poke buf (w8 ((w16 x .&. 0x0ff00) `shiftR` 8))
S.pokeByteOff buf 1 (w8 ((w16 x .&. 0x000ff)))
k (S.plusPtr buf 2)
unpack Word16be
= Unpacker $ \start _end _stop _fail eat
-> do x0 :: Word8 <- S.peek start
x1 :: Word8 <- S.peekByteOff start 1
eat (S.plusPtr start 2)
(w16 ((w16 x0 `shiftL` 8) .|. w16 x1))
w16 :: Integral a => a -> Word16
w16 = fromIntegral
data Int16be = Int16be deriving (Eq, Show)
instance Format Int16be where
type Value Int16be = V.Int16
fieldCount _ = 1
minSize _ = 2
fixedSize _ = Just 2
packedSize _ _ = Just 2
instance Packable Int16be where
pack Int16be x = pack Word16be (w16 x)
unpack Int16be = fmap i16 (unpack Word16be)
i16 :: Integral a => a -> Int16
i16 = fromIntegral
data Word32be = Word32be deriving (Eq, Show)
instance Format Word32be where
type Value Word32be = V.Word32
fieldCount _ = 1
minSize _ = 4
fixedSize _ = Just 4
packedSize _ _ = Just 4
instance Packable Word32be where
pack Word32be x
= Packer $ \buf 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 (S.plusPtr buf 4)
unpack Word32be
= Unpacker $ \start _end _fail _stop eat
-> do x0 :: Word8 <- S.peek start
x1 :: Word8 <- S.peekByteOff start 1
x2 :: Word8 <- S.peekByteOff start 2
x3 :: Word8 <- S.peekByteOff start 3
eat (S.plusPtr start 4)
(w32 ( (w32 x0 `shiftL` 24)
.|. (w32 x1 `shiftL` 16)
.|. (w32 x2 `shiftL` 8)
.|. (w32 x3)))
w32 :: Integral a => a -> Word32
w32 = fromIntegral
data Int32be = Int32be deriving (Eq, Show)
instance Format Int32be where
type Value Int32be = V.Int32
fieldCount _ = 1
minSize _ = 4
fixedSize _ = Just 4
packedSize _ _ = Just 4
instance Packable Int32be where
pack Int32be x = pack Word32be (w32 x)
unpack Int32be = fmap i32 (unpack Word32be)
i32 :: Integral a => a -> Int32
i32 = fromIntegral
data Word64be = Word64be deriving (Eq, Show)
instance Format Word64be where
type Value Word64be = V.Word64
fieldCount _ = 1
minSize _ = 8
fixedSize _ = Just 8
packedSize _ _ = Just 8
instance Packable Word64be where
pack Word64be x
= Packer $ \buf 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 (S.plusPtr buf 8)
unpack Word64be
= Unpacker $ \start _end _fail _stop eat
-> do x0 :: Word8 <- S.peek start
x1 :: Word8 <- S.peekByteOff start 1
x2 :: Word8 <- S.peekByteOff start 2
x3 :: Word8 <- S.peekByteOff start 3
x4 :: Word8 <- S.peekByteOff start 4
x5 :: Word8 <- S.peekByteOff start 5
x6 :: Word8 <- S.peekByteOff start 6
x7 :: Word8 <- S.peekByteOff start 7
eat (S.plusPtr start 8)
(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 )))
w64 :: Integral a => a -> Word64
w64 = fromIntegral
data Int64be = Int64be deriving (Eq, Show)
instance Format Int64be where
type Value Int64be = V.Int64
fieldCount _ = 1
minSize _ = 8
fixedSize _ = Just 8
packedSize _ _ = Just 8
instance Packable Int64be where
pack Int64be x = pack Word64be (w64 x)
unpack Int64be = fmap i64 (unpack Word64be)
i64 :: Integral a => a -> Int64
i64 = fromIntegral
data Float32be = Float32be deriving (Eq, Show)
instance Format Float32be where
type Value Float32be = Float
fieldCount _ = 1
minSize _ = 4
fixedSize _ = Just 4
packedSize _ _ = Just 4
instance Packable Float32be where
pack Float32be x = pack Word32be (floatToWord32 x)
unpack Float32be = fmap word32ToFloat (unpack Word32be)
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
fieldCount _ = 1
minSize _ = 8
fixedSize _ = Just 8
packedSize _ _ = Just 8
instance Packable Float64be where
pack Float64be x = pack Word64be (doubleToWord64 x)
unpack Float64be = fmap word64ToDouble (unpack Word64be)
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