Commit 0be40eba authored by Lennart Kolmodin's avatar Lennart Kolmodin
Browse files

Merge remote-tracking branch 'shimuuar/signed-int'

parents fa803227 cbc3e2d6
......@@ -40,17 +40,27 @@ module Data.Binary.Builder (
, putWord16be -- :: Word16 -> Builder
, putWord32be -- :: Word32 -> Builder
, putWord64be -- :: Word64 -> Builder
, putInt16be -- :: Int16 -> Builder
, putInt32be -- :: Int32 -> Builder
, putInt64be -- :: Int64 -> Builder
-- ** Little-endian writes
, putWord16le -- :: Word16 -> Builder
, putWord32le -- :: Word32 -> Builder
, putWord64le -- :: Word64 -> Builder
, putInt16le -- :: Int16 -> Builder
, putInt32le -- :: Int32 -> Builder
, putInt64le -- :: Int64 -> Builder
-- ** Host-endian, unaligned writes
, putWordhost -- :: Word -> Builder
, putWord16host -- :: Word16 -> Builder
, putWord32host -- :: Word32 -> Builder
, putWord64host -- :: Word64 -> Builder
, putInthost -- :: Int -> Builder
, putInt16host -- :: Int16 -> Builder
, putInt32host -- :: Int32 -> Builder
, putInt64host -- :: Int64 -> Builder
-- ** Unicode
, putCharUtf8
......
......@@ -44,17 +44,27 @@ module Data.Binary.Builder.Base (
, putWord16be -- :: Word16 -> Builder
, putWord32be -- :: Word32 -> Builder
, putWord64be -- :: Word64 -> Builder
, putInt16be -- :: Int16 -> Builder
, putInt32be -- :: Int32 -> Builder
, putInt64be -- :: Int64 -> Builder
-- ** Little-endian writes
, putWord16le -- :: Word16 -> Builder
, putWord32le -- :: Word32 -> Builder
, putWord64le -- :: Word64 -> Builder
, putInt16le -- :: Int16 -> Builder
, putInt32le -- :: Int32 -> Builder
, putInt64le -- :: Int64 -> Builder
-- ** Host-endian, unaligned writes
, putWordhost -- :: Word -> Builder
, putWord16host -- :: Word16 -> Builder
, putWord32host -- :: Word32 -> Builder
, putWord64host -- :: Word64 -> Builder
, putInthost -- :: Int -> Builder
, putInt16host -- :: Int16 -> Builder
, putInt32host -- :: Int32 -> Builder
, putInt64host -- :: Int64 -> Builder
-- ** Unicode
, putCharUtf8
......@@ -393,9 +403,42 @@ putWord64le w = writeN 8 $ \p -> do
#endif
{-# INLINE putWord64le #-}
-- on a little endian machine:
-- putWord64le w64 = writeN 8 (\p -> poke (castPtr p) w64)
-- | Write a Int16 in big endian format
putInt16be :: Int16 -> Builder
putInt16be = putWord16be . fromIntegral
{-# INLINE putInt16be #-}
-- | Write a Int16 in little endian format
putInt16le :: Int16 -> Builder
putInt16le = putWord16le . fromIntegral
{-# INLINE putInt16le #-}
-- | Write a Int32 in big endian format
putInt32be :: Int32 -> Builder
putInt32be = putWord32be . fromIntegral
{-# INLINE putInt32be #-}
-- | Write a Int32 in little endian format
putInt32le :: Int32 -> Builder
putInt32le = putWord32le . fromIntegral
{-# INLINE putInt32le #-}
-- | Write a Int64 in big endian format
putInt64be :: Int64 -> Builder
putInt64be = putWord64be . fromIntegral
-- | Write a Int64 in little endian format
putInt64le :: Int64 -> Builder
putInt64le = putWord64le . fromIntegral
------------------------------------------------------------------------
-- Unaligned, word size ops
......@@ -432,6 +475,40 @@ putWord64host w =
writeN (sizeOf (undefined :: Word64)) (\p -> poke (castPtr p) w)
{-# INLINE putWord64host #-}
-- | /O(1)./ A Builder taking a single native machine word. The word is
-- written in host order, host endian form, for the machine you're on.
-- On a 64 bit machine the Int is an 8 byte value, on a 32 bit machine,
-- 4 bytes. Values written this way are not portable to
-- different endian or word sized machines, without conversion.
--
putInthost :: Int -> Builder
putInthost w =
writeN (sizeOf (undefined :: Int)) (\p -> poke (castPtr p) w)
{-# INLINE putInthost #-}
-- | Write a Int16 in native host order and host endianness.
-- 2 bytes will be written, unaligned.
putInt16host :: Int16 -> Builder
putInt16host w16 =
writeN (sizeOf (undefined :: Int16)) (\p -> poke (castPtr p) w16)
{-# INLINE putInt16host #-}
-- | Write a Int32 in native host order and host endianness.
-- 4 bytes will be written, unaligned.
putInt32host :: Int32 -> Builder
putInt32host w32 =
writeN (sizeOf (undefined :: Int32)) (\p -> poke (castPtr p) w32)
{-# INLINE putInt32host #-}
-- | Write a Int64 in native host order.
-- On a 32 bit machine we write two host order Int32s, in big endian form.
-- 8 bytes will be written, unaligned.
putInt64host :: Int64 -> Builder
putInt64host w =
writeN (sizeOf (undefined :: Int64)) (\p -> poke (castPtr p) w)
{-# INLINE putInt64host #-}
------------------------------------------------------------------------
-- Unicode
......
......@@ -188,11 +188,33 @@ module Data.Binary.Get (
, getWord32host
, getWord64host
-- ** Decoding words
, getInt8
-- *** Big-endian decoding
, getInt16be
, getInt32be
, getInt64be
-- *** Little-endian decoding
, getInt16le
, getInt32le
, getInt64le
-- *** Host-endian, unaligned decoding
, getInthost
, getInt16host
, getInt32host
, getInt64host
-- * Deprecated functions
, runGetState -- DEPRECATED
, remaining -- DEPRECATED
, getBytes -- DEPRECATED
) where
#if ! MIN_VERSION_base(4,8,0)
import Control.Applicative
#endif
import Foreign
import qualified Data.ByteString as B
......@@ -410,6 +432,12 @@ getWord8 :: Get Word8
getWord8 = readN 1 B.unsafeHead
{-# INLINE[2] getWord8 #-}
-- | Read an Int8 from the monad state
getInt8 :: Get Int8
getInt8 = fromIntegral <$> getWord8
{-# INLINE getInt8 #-}
-- force GHC to inline getWordXX
{-# RULES
"getWord8/readN" getWord8 = readN 1 B.unsafeHead
......@@ -502,6 +530,39 @@ word64le = \s ->
{-# INLINE[2] getWord64le #-}
{-# INLINE word64le #-}
-- | Read an Int16 in big endian format
getInt16be :: Get Int16
getInt16be = fromIntegral <$> getWord16be
{-# INLINE getInt16be #-}
-- | Read an Int32 in big endian format
getInt32be :: Get Int32
getInt32be = fromIntegral <$> getWord32be
{-# INLINE getInt32be #-}
-- | Read an Int64 in big endian format
getInt64be :: Get Int64
getInt64be = fromIntegral <$> getWord64be
{-# INLINE getInt64be #-}
-- | Read an Int16 in little endian format
getInt16le :: Get Int16
getInt16le = fromIntegral <$> getWord16le
{-# INLINE getInt16le #-}
-- | Read an Int32 in little endian format
getInt32le :: Get Int32
getInt32le = fromIntegral <$> getWord32le
{-# INLINE getInt32le #-}
-- | Read an Int64 in little endian format
getInt64le :: Get Int64
getInt64le = fromIntegral <$> getWord64le
{-# INLINE getInt64le #-}
------------------------------------------------------------------------
-- Host-endian reads
......@@ -527,6 +588,28 @@ getWord64host :: Get Word64
getWord64host = getPtr (sizeOf (undefined :: Word64))
{-# INLINE getWord64host #-}
-- | /O(1)./ Read a single native machine word in native host
-- order. It works in the same way as 'getWordhost'.
getInthost :: Get Int
getInthost = getPtr (sizeOf (undefined :: Int))
{-# INLINE getInthost #-}
-- | /O(1)./ Read a 2 byte Int16 in native host order and host endianness.
getInt16host :: Get Int16
getInt16host = getPtr (sizeOf (undefined :: Int16))
{-# INLINE getInt16host #-}
-- | /O(1)./ Read an Int32 in native host order and host endianness.
getInt32host :: Get Int32
getInt32host = getPtr (sizeOf (undefined :: Int32))
{-# INLINE getInt32host #-}
-- | /O(1)./ Read an Int64 in native host order and host endianess.
getInt64host :: Get Int64
getInt64host = getPtr (sizeOf (undefined :: Int64))
{-# INLINE getInt64host #-}
------------------------------------------------------------------------
-- Unchecked shifts
......
......@@ -32,6 +32,7 @@ module Data.Binary.Put (
-- * Primitives
, putWord8
, putInt8
, putByteString
, putLazyByteString
#if MIN_VERSION_bytestring(0,10,4)
......@@ -42,17 +43,27 @@ module Data.Binary.Put (
, putWord16be
, putWord32be
, putWord64be
, putInt16be
, putInt32be
, putInt64be
-- * Little-endian primitives
, putWord16le
, putWord32le
, putWord64le
, putInt16le
, putInt32le
, putInt64le
-- * Host-endian, unaligned writes
, putWordhost -- :: Word -> Put
, putWord16host -- :: Word16 -> Put
, putWord32host -- :: Word32 -> Put
, putWord64host -- :: Word64 -> Put
, putInthost -- :: Int -> Put
, putInt16host -- :: Int16 -> Put
, putInt32host -- :: Int32 -> Put
, putInt64host -- :: Int64 -> Put
) where
......@@ -60,6 +71,7 @@ import Data.Monoid
import Data.Binary.Builder (Builder, toLazyByteString)
import qualified Data.Binary.Builder as B
import Data.Int
import Data.Word
import qualified Data.ByteString as S
import qualified Data.ByteString.Lazy as L
......@@ -154,6 +166,11 @@ putWord8 :: Word8 -> Put
putWord8 = tell . B.singleton
{-# INLINE putWord8 #-}
-- | Efficiently write a signed byte into the output buffer
putInt8 :: Int8 -> Put
putInt8 = tell . B.singleton . fromIntegral
{-# INLINE putInt8 #-}
-- | An efficient primitive to write a strict ByteString into the output buffer.
-- It flushes the current buffer, and writes the argument into a new chunk.
putByteString :: S.ByteString -> Put
......@@ -203,6 +220,37 @@ putWord64le :: Word64 -> Put
putWord64le = tell . B.putWord64le
{-# INLINE putWord64le #-}
-- | Write an Int16 in big endian format
putInt16be :: Int16 -> Put
putInt16be = tell . B.putInt16be
{-# INLINE putInt16be #-}
-- | Write an Int16 in little endian format
putInt16le :: Int16 -> Put
putInt16le = tell . B.putInt16le
{-# INLINE putInt16le #-}
-- | Write an Int32 in big endian format
putInt32be :: Int32 -> Put
putInt32be = tell . B.putInt32be
{-# INLINE putInt32be #-}
-- | Write an Int32 in little endian format
putInt32le :: Int32 -> Put
putInt32le = tell . B.putInt32le
{-# INLINE putInt32le #-}
-- | Write an Int64 in big endian format
putInt64be :: Int64 -> Put
putInt64be = tell . B.putInt64be
{-# INLINE putInt64be #-}
-- | Write an Int64 in little endian format
putInt64le :: Int64 -> Put
putInt64le = tell . B.putInt64le
{-# INLINE putInt64le #-}
------------------------------------------------------------------------
-- | /O(1)./ Write a single native machine word. The word is
......@@ -233,3 +281,32 @@ putWord32host = tell . B.putWord32host
putWord64host :: Word64 -> Put
putWord64host = tell . B.putWord64host
{-# INLINE putWord64host #-}
-- | /O(1)./ Write a single native machine word. The word is
-- written in host order, host endian form, for the machine you're on.
-- On a 64 bit machine the Int is an 8 byte value, on a 32 bit machine,
-- 4 bytes. Values written this way are not portable to
-- different endian or word sized machines, without conversion.
--
putInthost :: Int -> Put
putInthost = tell . B.putInthost
{-# INLINE putInthost #-}
-- | /O(1)./ Write an Int16 in native host order and host endianness.
-- For portability issues see @putInthost@.
putInt16host :: Int16 -> Put
putInt16host = tell . B.putInt16host
{-# INLINE putInt16host #-}
-- | /O(1)./ Write an Int32 in native host order and host endianness.
-- For portability issues see @putInthost@.
putInt32host :: Int32 -> Put
putInt32host = tell . B.putInt32host
{-# INLINE putInt32host #-}
-- | /O(1)./ Write an Int64 in native host order
-- On a 32 bit machine we write two host order Int32s, in big endian form.
-- For portability issues see @putInthost@.
putInt64host :: Int64 -> Put
putInt64host = tell . B.putInt64host
{-# INLINE putInt64host #-}
......@@ -66,6 +66,11 @@ mustThrowError a = unsafePerformIO $
(\(_e :: SomeException) -> return True)
-- low level ones:
--
-- Words
prop_Word8 :: Word8 -> Property
prop_Word8 = roundTripWith putWord8 getWord8
prop_Word16be :: Word16 -> Property
prop_Word16be = roundTripWith putWord16be getWord16be
......@@ -97,6 +102,41 @@ prop_Word64host = roundTripWith putWord64host getWord64host
prop_Wordhost :: Word -> Property
prop_Wordhost = roundTripWith putWordhost getWordhost
-- Ints
prop_Int8 :: Int8 -> Property
prop_Int8 = roundTripWith putInt8 getInt8
prop_Int16be :: Int16 -> Property
prop_Int16be = roundTripWith putInt16be getInt16be
prop_Int16le :: Int16 -> Property
prop_Int16le = roundTripWith putInt16le getInt16le
prop_Int16host :: Int16 -> Property
prop_Int16host = roundTripWith putInt16host getInt16host
prop_Int32be :: Int32 -> Property
prop_Int32be = roundTripWith putInt32be getInt32be
prop_Int32le :: Int32 -> Property
prop_Int32le = roundTripWith putInt32le getInt32le
prop_Int32host :: Int32 -> Property
prop_Int32host = roundTripWith putInt32host getInt32host
prop_Int64be :: Int64 -> Property
prop_Int64be = roundTripWith putInt64be getInt64be
prop_Int64le :: Int64 -> Property
prop_Int64le = roundTripWith putInt64le getInt64le
prop_Int64host :: Int64 -> Property
prop_Int64host = roundTripWith putInt64host getInt64host
prop_Inthost :: Int -> Property
prop_Inthost = roundTripWith putInthost getInthost
-- done, partial and fail
......@@ -469,7 +509,8 @@ tests =
Action.tests
, testGroup "Primitives"
[ testProperty "Word16be" (p prop_Word16be)
[ testProperty "Word8" (p prop_Word8)
, testProperty "Word16be" (p prop_Word16be)
, testProperty "Word16le" (p prop_Word16le)
, testProperty "Word16host" (p prop_Word16host)
, testProperty "Word32be" (p prop_Word32be)
......@@ -479,6 +520,18 @@ tests =
, testProperty "Word64le" (p prop_Word64le)
, testProperty "Word64host" (p prop_Word64host)
, testProperty "Wordhost" (p prop_Wordhost)
-- Int
, testProperty "Int8" (p prop_Int8)
, testProperty "Int16be" (p prop_Int16be)
, testProperty "Int16le" (p prop_Int16le)
, testProperty "Int16host" (p prop_Int16host)
, testProperty "Int32be" (p prop_Int32be)
, testProperty "Int32le" (p prop_Int32le)
, testProperty "Int32host" (p prop_Int32host)
, testProperty "Int64be" (p prop_Int64be)
, testProperty "Int64le" (p prop_Int64le)
, testProperty "Int64host" (p prop_Int64host)
, testProperty "Inthost" (p prop_Inthost)
]
, testGroup "String utils"
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment