diff options
author | Sam T <pxqr.sta@gmail.com> | 2013-05-20 13:20:06 +0400 |
---|---|---|
committer | Sam T <pxqr.sta@gmail.com> | 2013-05-20 13:20:06 +0400 |
commit | 665c7fe8e106c2920323586cedbdd52f8db09b0f (patch) | |
tree | cb5781ed2ac897a7cf7abce0d1f5b5d51ce14aa5 | |
parent | 5078ee93caf0de29f04f38b268d68d5b0276d990 (diff) |
~ Avoid backtracking in list and integer parsing.
-rw-r--r-- | bench/Main.hs | 7 | ||||
-rw-r--r-- | src/Data/BEncode.hs | 27 |
2 files changed, 25 insertions, 9 deletions
diff --git a/bench/Main.hs b/bench/Main.hs index 08ebab8..2c1da50 100644 --- a/bench/Main.hs +++ b/bench/Main.hs | |||
@@ -76,15 +76,18 @@ main = do | |||
76 | 76 | ||
77 | , let d = A.bPack $ A.BList $ | 77 | , let d = A.bPack $ A.BList $ |
78 | L.map A.BInt (L.replicate 1000 (0 :: Integer)) | 78 | L.map A.BInt (L.replicate 1000 (0 :: Integer)) |
79 | in d `seq` (bench "list10000int/bencode/decode" $ nf | 79 | in d `seq` (bench "list1000int/bencode/decode" $ nf |
80 | (fromJust . A.bRead :: BL.ByteString -> A.BEncode) d) | 80 | (fromJust . A.bRead :: BL.ByteString -> A.BEncode) d) |
81 | 81 | ||
82 | , let d = BL.toStrict (C.encoded (L.replicate 10000 ())) | 82 | , let d = BL.toStrict (C.encoded (L.replicate 10000 ())) |
83 | in d `seq` (bench "list10000unit/bencoding/decode" $ nf | 83 | in d `seq` (bench "list10000unit/bencoding/decode" $ nf |
84 | (C.decoded :: B.ByteString -> Either String [()]) d) | 84 | (C.decoded :: B.ByteString -> Either String [()]) d) |
85 | 85 | ||
86 | , let d = BL.toStrict (C.encoded (L.replicate 10000 (0 :: Int))) | 86 | , let d = BL.toStrict $ C.encoded $ L.replicate 10000 (0 :: Int) |
87 | in d `seq` (bench "list10000int/bencoding/decode" $ nf | 87 | in d `seq` (bench "list10000int/bencoding/decode" $ nf |
88 | (C.decoded :: B.ByteString -> Either String [Int]) d) | 88 | (C.decoded :: B.ByteString -> Either String [Int]) d) |
89 | 89 | ||
90 | , let d = L.replicate 10000 0 | ||
91 | in bench "list10000int/bencoding/encode>>decode" $ nf | ||
92 | (getRight . C.decoded . BL.toStrict . C.encoded :: [Int] -> [Int] ) d | ||
90 | ] | 93 | ] |
diff --git a/src/Data/BEncode.hs b/src/Data/BEncode.hs index 5acab09..5097fe8 100644 --- a/src/Data/BEncode.hs +++ b/src/Data/BEncode.hs | |||
@@ -104,8 +104,8 @@ type Dict = Map ByteString BEncode | |||
104 | -- Lists is not required to be sorted through. | 104 | -- Lists is not required to be sorted through. |
105 | -- Also note that 'BEncode' have JSON-like instance for 'Pretty'. | 105 | -- Also note that 'BEncode' have JSON-like instance for 'Pretty'. |
106 | -- | 106 | -- |
107 | data BEncode = BInteger Int64 | 107 | data BEncode = BInteger {-# UNPACK #-} !Int64 |
108 | | BString ByteString | 108 | | BString !ByteString |
109 | | BList [BEncode] | 109 | | BList [BEncode] |
110 | | BDict Dict | 110 | | BDict Dict |
111 | deriving (Show, Read, Eq, Ord) | 111 | deriving (Show, Read, Eq, Ord) |
@@ -122,6 +122,7 @@ decodingError s = Left ("fromBEncode: unable to decode " ++ s) | |||
122 | {-# INLINE decodingError #-} | 122 | {-# INLINE decodingError #-} |
123 | 123 | ||
124 | instance BEncodable BEncode where | 124 | instance BEncodable BEncode where |
125 | {-# SPECIALIZE instance BEncodable BEncode #-} | ||
125 | toBEncode = id | 126 | toBEncode = id |
126 | {-# INLINE toBEncode #-} | 127 | {-# INLINE toBEncode #-} |
127 | 128 | ||
@@ -129,6 +130,7 @@ instance BEncodable BEncode where | |||
129 | {-# INLINE fromBEncode #-} | 130 | {-# INLINE fromBEncode #-} |
130 | 131 | ||
131 | instance BEncodable Int where | 132 | instance BEncodable Int where |
133 | {-# SPECIALIZE instance BEncodable Int #-} | ||
132 | toBEncode = BInteger . fromIntegral | 134 | toBEncode = BInteger . fromIntegral |
133 | {-# INLINE toBEncode #-} | 135 | {-# INLINE toBEncode #-} |
134 | 136 | ||
@@ -385,7 +387,7 @@ builder = go | |||
385 | B.byteString s | 387 | B.byteString s |
386 | {-# INLINE buildString #-} | 388 | {-# INLINE buildString #-} |
387 | 389 | ||
388 | -- | todo zepto | 390 | -- | TODO try to replace peekChar with something else |
389 | parser :: Parser BEncode | 391 | parser :: Parser BEncode |
390 | parser = valueP | 392 | parser = valueP |
391 | where | 393 | where |
@@ -397,14 +399,20 @@ parser = valueP | |||
397 | case c of | 399 | case c of |
398 | -- if we have digit it always should be string length | 400 | -- if we have digit it always should be string length |
399 | di | di <= '9' -> BString <$> stringP | 401 | di | di <= '9' -> BString <$> stringP |
400 | 'i' -> P.anyChar *> ((BInteger <$> integerP) <* P.anyChar) | 402 | 'i' -> P.anyChar *> ((BInteger <$> integerP) <* P.anyChar) |
401 | 'l' -> P.anyChar *> ((BList <$> many valueP) <* P.anyChar) | 403 | 'l' -> P.anyChar *> ((BList <$> listBody) <* P.anyChar) |
402 | 'd' -> do | 404 | 'd' -> do |
403 | P.anyChar | 405 | P.anyChar |
404 | (BDict . M.fromDistinctAscList <$> many ((,) <$> stringP <*> valueP)) | 406 | (BDict . M.fromDistinctAscList <$> many ((,) <$> stringP <*> valueP)) |
405 | <* P.anyChar | 407 | <* P.anyChar |
406 | t -> fail ("bencode unknown tag: " ++ [t]) | 408 | t -> fail ("bencode unknown tag: " ++ [t]) |
407 | 409 | ||
410 | listBody = do | ||
411 | c <- P.peekChar | ||
412 | case c of | ||
413 | Just 'e' -> return [] | ||
414 | _ -> (:) <$> valueP <*> listBody | ||
415 | |||
408 | stringP :: Parser ByteString | 416 | stringP :: Parser ByteString |
409 | stringP = do | 417 | stringP = do |
410 | n <- P.decimal :: Parser Int | 418 | n <- P.decimal :: Parser Int |
@@ -413,8 +421,13 @@ parser = valueP | |||
413 | {-# INLINE stringP #-} | 421 | {-# INLINE stringP #-} |
414 | 422 | ||
415 | integerP :: Parser Int64 | 423 | integerP :: Parser Int64 |
416 | integerP = negate <$> (P.char8 '-' *> P.decimal) | 424 | integerP = do |
417 | <|> P.decimal | 425 | c <- P.peekChar |
426 | case c of | ||
427 | Just '-' -> do | ||
428 | P.anyChar | ||
429 | negate <$> P.decimal | ||
430 | _ -> P.decimal | ||
418 | {-# INLINE integerP #-} | 431 | {-# INLINE integerP #-} |
419 | 432 | ||
420 | -------------------------------- pretty printing ------------------------------- | 433 | -------------------------------- pretty printing ------------------------------- |