git.iko.soy/typeable/aeson
on master help sign in
Use algorithm from base to do ByteString -> Integer
38272ecOleg Grenrus
Data/Aeson/Parser/Internal.hs+52−3
compare with master
unifiedsplit
@@ -328,12 +328,11 @@ data SP = SP !Integer {-# UNPACK #-}!Int
328
328
329decimal0 :: Parser Integer
329decimal0 :: Parser Integer
330decimal0 = do
330decimal0 = do
331− let step a w = a * 10 + fromIntegral (w - zero)
332− zero = 48
331+ let zero = 48
333 digits <- A.takeWhile1 isDigit_w8
332 digits <- A.takeWhile1 isDigit_w8
334 if B.length digits > 1 && B.unsafeHead digits == zero
333 if B.length digits > 1 && B.unsafeHead digits == zero
335 then fail "leading zero"
334 then fail "leading zero"
336− else return (B.foldl' step 0 digits)
335+ else return (bsToInteger digits)
337
336
338-- | Parse a JSON number.
337-- | Parse a JSON number.
339scientific :: Parser Scientific
338scientific :: Parser Scientific
@@ -366,3 +365,53 @@ scientific = do
366 fmap (Sci.scientific signedCoeff . (e +)) (signed decimal)) <|>
365 fmap (Sci.scientific signedCoeff . (e +)) (signed decimal)) <|>
367 return (Sci.scientific signedCoeff e)
366 return (Sci.scientific signedCoeff e)
368{-# INLINE scientific #-}
367{-# INLINE scientific #-}
368+
369+------------------ Copy-pasted and adapted from base ------------------------
370+
371+bsToInteger :: B.ByteString -> Integer
372+bsToInteger bs
373+ | l > 40 = valInteger 10 l [ fromIntegral (w - 48) | w <- B.unpack bs ]
374+ | otherwise = bsToIntegerSimple bs
375+ where
376+ l = B.length bs
377+
378+bsToIntegerSimple :: B.ByteString -> Integer
379+bsToIntegerSimple = B.foldl' step 0 where
380+ step a b = a * 10 + fromIntegral (b - 48) -- 48 = '0'
381+
382+-- A sub-quadratic algorithm for Integer. Pairs of adjacent radix b
383+-- digits are combined into a single radix b^2 digit. This process is
384+-- repeated until we are left with a single digit. This algorithm
385+-- performs well only on large inputs, so we use the simple algorithm
386+-- for smaller inputs.
387+valInteger :: Integer -> Int -> [Integer] -> Integer
388+valInteger = go
389+ where
390+ go :: Integer -> Int -> [Integer] -> Integer
391+ go _ _ [] = 0
392+ go _ _ [d] = d
393+ go b l ds
394+ | l > 40 = b' `seq` go b' l' (combine b ds')
395+ | otherwise = valSimple b ds
396+ where
397+ -- ensure that we have an even number of digits
398+ -- before we call combine:
399+ ds' = if even l then ds else 0 : ds
400+ b' = b * b
401+ l' = (l + 1) `quot` 2
402+
403+ combine b (d1 : d2 : ds) = d `seq` (d : combine b ds)
404+ where
405+ d = d1 * b + d2
406+ combine _ [] = []
407+ combine _ [_] = errorWithoutStackTrace "this should not happen"
408+
409+-- The following algorithm is only linear for types whose Num operations
410+-- are in constant time.
411+valSimple :: Integer -> [Integer] -> Integer
412+valSimple base = go 0
413+ where
414+ go r [] = r
415+ go r (d : ds) = r' `seq` go r' ds
416+ where
417+ r' = r * base + fromIntegral d
benchmarks/Issue673.hs+58−4
@@ -23,6 +23,7 @@ import Data.Aeson.Parser (scientific)
23import qualified Data.Attoparsec.ByteString.Lazy as AttoL
23import qualified Data.Attoparsec.ByteString.Lazy as AttoL
24import qualified Data.Attoparsec.ByteString.Char8 as Atto8
24import qualified Data.Attoparsec.ByteString.Char8 as Atto8
25import qualified Data.Aeson as A
25import qualified Data.Aeson as A
26+import qualified Data.ByteString as BS
26import qualified Data.ByteString.Lazy as LBS
27import qualified Data.ByteString.Lazy as LBS
27import qualified Data.ByteString.Lazy.Char8 as LBS8
28import qualified Data.ByteString.Lazy.Char8 as LBS8
28
29
@@ -35,9 +36,8 @@ decodeString = A.decode
35decodeScientific :: LBS.ByteString -> Maybe Scientific
36decodeScientific :: LBS.ByteString -> Maybe Scientific
36decodeScientific = A.decode
37decodeScientific = A.decode
37
38
38−decodeRaw :: LBS.ByteString -> Integer
39+decodeViaRead :: LBS.ByteString -> Integer
39−decodeRaw = LBS.foldl' step 0 where
40+decodeViaRead = read . LBS8.unpack
40− step a b = a * 10 + fromIntegral (b - 48) -- 48 = '0'
41
41
42decodeAtto :: LBS.ByteString -> Maybe Scientific
42decodeAtto :: LBS.ByteString -> Maybe Scientific
43decodeAtto
43decodeAtto
@@ -102,9 +102,63 @@ main = defaultMain
102 where
102 where
103 benchPair name input = bgroup name
103 benchPair name input = bgroup name
104 [ bench "Int" $ whnf decodeInt input
104 [ bench "Int" $ whnf decodeInt input
105− , bench "RawFold" $ whnf decodeRaw input
105+ , bench "Simple" $ whnf bsToIntegerSimple (LBS.toStrict input)
106+ , bench "Optim" $ whnf bsToInteger (LBS.toStrict input)
107+ , bench "Read" $ whnf decodeViaRead input
106 , bench "Scientific" $ whnf decodeScientific input
108 , bench "Scientific" $ whnf decodeScientific input
107 , bench "parserA" $ whnf decodeAtto input
109 , bench "parserA" $ whnf decodeAtto input
108 , bench "parserS" $ whnf decodeAtto8 input
110 , bench "parserS" $ whnf decodeAtto8 input
109 , bench "String" $ whnf decodeString $ "\"" <> input <> "\""
111 , bench "String" $ whnf decodeString $ "\"" <> input <> "\""
110 ]
112 ]
113+
114+-------------------------------------------------------------------------------
115+-- better fromInteger
116+-------------------------------------------------------------------------------
117+
118+bsToInteger :: BS.ByteString -> Integer
119+bsToInteger bs
120+ | l > 40 = valInteger 10 l [ fromIntegral (w - 48) | w <- BS.unpack bs ]
121+ | otherwise = bsToIntegerSimple bs
122+ where
123+ l = BS.length bs
124+
125+bsToIntegerSimple :: BS.ByteString -> Integer
126+bsToIntegerSimple = BS.foldl' step 0 where
127+ step a b = a * 10 + fromIntegral (b - 48) -- 48 = '0'
128+
129+-- A sub-quadratic algorithm for Integer. Pairs of adjacent radix b
130+-- digits are combined into a single radix b^2 digit. This process is
131+-- repeated until we are left with a single digit. This algorithm
132+-- performs well only on large inputs, so we use the simple algorithm
133+-- for smaller inputs.
134+valInteger :: Integer -> Int -> [Integer] -> Integer
135+valInteger = go
136+ where
137+ go :: Integer -> Int -> [Integer] -> Integer
138+ go _ _ [] = 0
139+ go _ _ [d] = d
140+ go b l ds
141+ | l > 40 = b' `seq` go b' l' (combine b ds')
142+ | otherwise = valSimple b ds
143+ where
144+ -- ensure that we have an even number of digits
145+ -- before we call combine:
146+ ds' = if even l then ds else 0 : ds
147+ b' = b * b
148+ l' = (l + 1) `quot` 2
149+
150+ combine b (d1 : d2 : ds) = d `seq` (d : combine b ds)
151+ where
152+ d = d1 * b + d2
153+ combine _ [] = []
154+ combine _ [_] = errorWithoutStackTrace "this should not happen"
155+
156+-- The following algorithm is only linear for types whose Num operations
157+-- are in constant time.
158+valSimple :: Integer -> [Integer] -> Integer
159+valSimple base = go 0
160+ where
161+ go r [] = r
162+ go r (d : ds) = r' `seq` go r' ds
163+ where
164+ r' = r * base + fromIntegral d