bytesmith 0.2.0.0 → 0.2.0.1
raw patch · 4 files changed
+141/−48 lines, 4 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- CHANGELOG.md +5/−0
- bytesmith.cabal +1/−1
- src/Data/Bytes/Parser/Latin.hs +38/−34
- test/Main.hs +97/−13
CHANGELOG.md view
@@ -1,5 +1,10 @@ # Revision history for bytesmith +## 0.2.0.1 -- 2019-09-24++* Correct an overflow-detection mistake in the implementation+ of machine-word parsers.+ ## 0.2.0.0 -- 2019-09-24 * Add big-endian word parsers.
bytesmith.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.2 name: bytesmith-version: 0.2.0.0+version: 0.2.0.1 synopsis: Nonresumable byte parser description: Parse bytes as fast as possible. This is a nonresumable parser
src/Data/Bytes/Parser/Latin.hs view
@@ -72,7 +72,8 @@ import Data.Char (ord) import Data.Kind (Type) import GHC.Exts (Int(I#),Char(C#),Word#,Int#,Char#,(+#),(-#),indexCharArray#)-import GHC.Exts (TYPE,RuntimeRep)+import GHC.Exts (TYPE,RuntimeRep,int2Word#,or#)+import GHC.Exts (ltWord#,gtWord#,notI#) import GHC.Word (Word(W#),Word8(W8#),Word16(W16#),Word32(W32#)) import qualified GHC.Exts as Exts@@ -429,8 +430,11 @@ -> Int# -- Leading digit, should be between @0@ and @9@. -> Parser e s Int# decTrailingInt# e !w =- Parser (\chunk0 s0 -> (# s0, decPosIntMore e (I# w) (boxBytes chunk0) #))+ Parser (\chunk0 s0 -> (# s0, decPosIntMore e (W# (int2Word# w)) maxIntAsWord (boxBytes chunk0) #)) +maxIntAsWord :: Word+maxIntAsWord = fromIntegral (maxBound :: Int)+ -- | Parse a decimal-encoded number. If the number is too large to be -- represented by a machine integer, this fails with the provided -- error message. This allows the number to optionally be prefixed@@ -455,7 +459,7 @@ (\chunk0 s0 -> let !w = char2Word c - 48 in if w < 10- then (# s0, decPosIntMore e (fromIntegral @Word @Int w) (boxBytes chunk0) #)+ then (# s0, decPosIntMore e w maxIntAsWord (boxBytes chunk0) #) else (# s0, (# e | #) #) ) @@ -470,7 +474,7 @@ (\chunk0 s0 -> let !w = char2Word c - 48 in if w < 10- then (# s0, decPosIntMore e (fromIntegral @Word @Int w) (boxBytes chunk0) #)+ then (# s0, decPosIntMore e w maxIntAsWord (boxBytes chunk0) #) else (# s0, (# e | #) #) ) @@ -526,7 +530,7 @@ let !w = fromIntegral @Word8 @Word (PM.indexByteArray (array chunk0) (offset chunk0)) - 48 in if w < 10- then (# s0, decPosIntMore e (fromIntegral @Word @Int w) (Bytes.unsafeDrop 1 chunk0) #)+ then (# s0, decPosIntMore e w maxIntAsWord (Bytes.unsafeDrop 1 chunk0) #) else (# s0, (# e | #) #) else (# s0, (# e | #) #) @@ -539,7 +543,12 @@ let !w = fromIntegral @Word8 @Word (PM.indexByteArray (array chunk0) (offset chunk0)) - 48 in if w < 10- then (# s0, decNegIntMore e (negate (fromIntegral @Word @Int w)) (Bytes.unsafeDrop 1 chunk0) #)+ then + case decPosIntMore e w (maxIntAsWord + 1) (Bytes.unsafeDrop 1 chunk0) of+ (# | (# x, y, z #) #) -> + (# s0, (# | (# (notI# x +# 1# ), y, z #) #) #)+ (# err | #) -> + (# s0, (# err | #) #) else (# s0, (# e | #) #) else (# s0, (# e | #) #) @@ -562,43 +571,26 @@ else (# s0, (# e | #) #) -- This will not inline since it is recursive, but worker--- wrapper will still happen.-decNegIntMore ::- e -- Error message- -> Int -- Accumulator- -> Bytes -- Chunk- -> Result# e Int#-decNegIntMore e !acc !chunk0 = if length chunk0 > 0- then- let !w = fromIntegral @Word8 @Word- (PM.indexByteArray (array chunk0) (offset chunk0)) - 48- !acc' = acc * 10 - (fromIntegral @Word @Int w)- in if w < 10- then if acc' <= acc- then decNegIntMore e acc' (Bytes.unsafeDrop 1 chunk0)- else (# e | #)- else (# | (# unI acc, unI (offset chunk0), unI (length chunk0) #) #)- else (# | (# unI acc, unI (offset chunk0), 0# #) #)---- This will not inline since it is recursive, but worker -- wrapper will still happen. Fails if the accumulator--- exceeds the size of a machine integer.+-- exceeds the upper bound. decPosIntMore :: e -- Error message- -> Int -- Accumulator+ -> Word -- Accumulator, precondition: less than or equal to bound + -> Word -- Inclusive Upper Bound, either (2^63 - 1) or 2^63 -> Bytes -- Chunk -> Result# e Int#-decPosIntMore e !acc !chunk0 = if len > 0+decPosIntMore e !acc !upper !chunk0 = if len > 0 then let !w = fromIntegral @Word8 @Word (PM.indexByteArray (array chunk0) (offset chunk0)) - 48- !acc' = acc * 10 + (fromIntegral @Word @Int w) in if w < 10- then if acc' >= acc- then decPosIntMore e acc' (Bytes.unsafeDrop 1 chunk0)- else (# e | #)- else (# | (# unI acc, unI (offset chunk0), len# #) #)- else (# | (# unI acc, unI (offset chunk0), 0# #) #)+ then+ let (overflow,acc') = positivePushBase10 acc w upper+ in if overflow+ then (# e | #)+ else decPosIntMore e acc' upper (Bytes.unsafeDrop 1 chunk0)+ else (# | (# unI (fromIntegral acc), unI (offset chunk0), len# #) #)+ else (# | (# unI (fromIntegral acc), unI (offset chunk0), 0# #) #) where !len@(I# len# ) = length chunk0 @@ -724,3 +716,15 @@ uneffectfulWord# f = Parser ( \b s0 -> (# s0, (f (boxBytes b)) #) ) +-- Precondition: the arguments are non-negative. Boolean is+-- true when overflow happens. Performs: a * 10 + b+-- Postcondition: when overflow is false, the resulting+-- word is less than or equal to the upper bound+positivePushBase10 :: Word -> Word -> Word -> (Bool,Word)+positivePushBase10 (W# a) (W# b) (W# upper) = + let !(# ca, r0 #) = Exts.timesWord2# a 10##+ !r1 = Exts.plusWord# r0 b+ !cb = int2Word# (gtWord# r1 upper)+ !cc = int2Word# (ltWord# r1 0##)+ !c = ca `or#` cb `or#` cc+ in (case c of { 0## -> False; _ -> True }, W# r1)
test/Main.hs view
@@ -56,13 +56,33 @@ @=? P.parseBytes (Latin.decUnsignedInt ()) (bytes "4654667,55")+ , testCase "C" $+ P.Failure ()+ @=?+ P.parseBytes (Latin.decUnsignedInt ())+ (bytes ('1' : show (maxBound :: Int)))+ , testCase "D" $+ P.Failure ()+ @=?+ P.parseBytes (Latin.decUnsignedInt ())+ (bytes "2481030337885070917891")+ , testCase "E" $+ P.Failure ()+ @=?+ P.parseBytes (Latin.decUnsignedInt ())+ (bytes (show (fromIntegral @Int @Word maxBound + 1)))+ , testCase "F" $+ P.Success maxBound 0+ @=?+ P.parseBytes (Latin.decUnsignedInt ())+ (bytes (show (maxBound :: Int))) , testProperty "property" $ \(QC.NonNegative i) -> P.parseBytes (Latin.decUnsignedInt ()) (bytes (show i)) === P.Success i 0 ] , testGroup "decPositiveInteger"- [ testCase "A" $ + [ testCase "A" $ P.parseBytes (Latin.decUnsignedInteger ()) (bytes "5469999463123462573426452736423546373235260") @=?@@ -74,25 +94,89 @@ === P.Success i 0 ]+ , testGroup "decTrailingInteger"+ [ testProperty "property" $ \(LargeInteger i) ->+ i >= 0+ QC.==>+ P.parseBytes (Latin.decTrailingInteger 2) (bytes (show i))+ ===+ (P.Success (read ('2' : show i) :: Integer) 0 :: P.Result () Integer)+ ] , testGroup "decSignedInteger"- [ testCase "A" $ + [ testCase "A" $ P.parseBytes (Latin.decSignedInteger ()) (bytes "-54699994631234625734264527364235463732352601") @=? P.Success (-54699994631234625734264527364235463732352601) 0+ , testCase "B" $+ P.Success (3,(-206173954435705292503)) 0+ @=?+ P.parseBytes+ ( pure (,)+ <*> Latin.decSignedInteger ()+ <* Latin.char () 'e'+ <*> Latin.decSignedInteger ()+ ) (bytes "3e-206173954435705292503") , testProperty "property" $ \(LargeInteger i) -> P.parseBytes (Latin.decSignedInteger ()) (bytes (show i)) === P.Success i 0 ]- , testProperty "decSignedInt-A" $ \i ->- P.parseBytes (Latin.decSignedInt ()) (bytes (show i)) === P.Success i 0- , testProperty "decSignedInt-B" $ \i ->- P.parseBytes- (Latin.decSignedInt ())- (bytes ((if i >= 0 then "+" else "") ++ show i))- ===- P.Success i 0+ , testGroup "decSignedInt"+ [ testProperty "A" $ \i ->+ P.parseBytes (Latin.decSignedInt ()) (bytes (show i))+ ===+ P.Success i 0+ , testProperty "B" $ \i ->+ P.parseBytes+ (Latin.decSignedInt ())+ (bytes ((if i >= 0 then "+" else "") ++ show i))+ ===+ P.Success i 0+ , testCase "C" $+ P.Failure ()+ @=?+ P.parseBytes (Latin.decSignedInt ())+ (bytes ('1' : show (maxBound :: Int)))+ , testCase "D" $+ P.Failure ()+ @=?+ P.parseBytes (Latin.decSignedInt ())+ (bytes ('-' : '3' : show (maxBound :: Int)))+ , testCase "E" $+ P.Failure ()+ @=?+ P.parseBytes (Latin.decSignedInt ())+ (bytes "2481030337885070917891")+ , testCase "F" $+ P.Failure ()+ @=?+ P.parseBytes (Latin.decSignedInt ())+ (bytes "-4305030950553840988981")+ , testCase "G" $+ P.Success minBound 0+ @=?+ P.parseBytes (Latin.decSignedInt ())+ (bytes (show (minBound :: Int)))+ , testCase "H" $+ P.Success maxBound 0+ @=?+ P.parseBytes (Latin.decSignedInt ())+ (bytes (show (maxBound :: Int)))+ , testCase "I" $+ P.Failure ()+ @=?+ P.parseBytes (Latin.decSignedInt ())+ (bytes (show (fromIntegral @Int @Word maxBound + 1)))+ , testCase "J" $+ -- This is one number lower than the minimum bound for+ -- a signed 64-bit number, but this test will pass on+ -- 32-bit architectures as well.+ P.Failure ()+ @=?+ P.parseBytes (Latin.decSignedInt ())+ (bytes "-9223372036854775809")+ ] , testCase "decWord-composition" $ P.Success (42,8) 0 @=?@@ -121,7 +205,7 @@ Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> QC.Property-bigEndianWord64 a b c d e f g h = +bigEndianWord64 a b c d e f g h = let arr = runST $ do m <- PM.newByteArray 11 PM.writeByteArray m 0 (0xFF :: Word8)@@ -155,8 +239,8 @@ deriving (Eq,Show) instance QC.Arbitrary LargeInteger where- arbitrary = QC.sized $ \sz -> do- n <- QC.choose (1, sz)+ arbitrary = do+ n <- QC.choose (1, 27) sign <- QC.arbitrary r <- (if sign then negate else id) . foldr f 0 <$> replicateM n QC.arbitrary