diff --git a/AUTHORS b/AUTHORS --- a/AUTHORS +++ b/AUTHORS @@ -6,7 +6,8 @@ like to give thanks to the following contributers: Bryan O'Sullivan --- For adding support for parsing Doubles from - lazy bytestrings back during Don's maintainership. + lazy bytestrings back during Don's maintainership. Also for + inspiring the improved (v0.4.2) packDecimal implementation. Erik de Castro Lopo, Vincent Hanquez, and Christoph Breitkopf --- for excessive tweaking and benchmarking of the readDecimal diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) wren ng thornton 2012; Don Stewart 2008, 2010 +Copyright (c) wren ng thornton 2012--2013; Don Stewart 2008, 2010 All rights reserved. diff --git a/README b/README --- a/README +++ b/README @@ -19,9 +19,11 @@ $> runhaskell Setup.hs build $> runhaskell Setup.hs test $> runhaskell Setup.hs haddock --hyperlink-source - $> runhaskell Setup.hs install + $> runhaskell Setup.hs copy + $> runhaskell Setup.hs register -The test step is optional and currently does nothing. +The test step is optional and currently does nothing. The Haddock +step is also optional. Portability diff --git a/VERSION b/VERSION --- a/VERSION +++ b/VERSION @@ -1,4 +1,8 @@ -0.4.0 (2012.00.00): +0.4.2 (2013.03.20): + - Data.ByteString.Lex.Integral: Improved packDecimal. +0.4.1 (2012.00.00): + - Data.ByteString.Lex.Integral: Added buffer overflow check for asHexadecimal +0.4.0 (2012.02.03): - Data.ByteString.Lex.Integral: added readDecimal_ 0.3.0 (2012.01.28): diff --git a/bytestring-lexing.cabal b/bytestring-lexing.cabal --- a/bytestring-lexing.cabal +++ b/bytestring-lexing.cabal @@ -1,28 +1,35 @@ ---------------------------------------------------------------- --- wren ng thornton ~ 2012.02.03 +-- wren ng thornton ~ 2013.03.20 ---------------------------------------------------------------- -Name: bytestring-lexing -Version: 0.4.0 --- Source-Repository requires version 1.6 +-- By and large Cabal >=1.2 is fine; but >= 1.6 gives tested-with: +-- and source-repository:. Cabal-Version: >= 1.6 Build-Type: Simple + +Name: bytestring-lexing +Version: 0.4.2 Stability: provisional -Copyright: Copyright (c) 2012 wren ng thornton, 2008--2011 Don Stewart -License: BSD3 -License-File: LICENSE +Homepage: http://code.haskell.org/~wren/ Author: wren ng thornton, Don Stewart Maintainer: wren@community.haskell.org -Homepage: http://code.haskell.org/~wren/ +Copyright: Copyright (c) 2012--2013 wren ng thornton, 2008--2011 Don Stewart +License: BSD3 +License-File: LICENSE + Category: Data -Synopsis: Parse and produce literals efficiently from strict or lazy bytestrings. +Synopsis: + Parse and produce literals efficiently from strict or lazy bytestrings. Description: Parse and produce literals efficiently from strict or lazy bytestrings. . - Some benchmarks for this package can be found at: + Some benchmarks for this package can be found at: + -Extra-source-files: AUTHORS, README, VERSION -Tested-With: GHC ==6.8.2, GHC ==6.10.1, GHC ==6.12.1, GHC ==7.0.3 +Tested-With: + GHC ==6.8.2, GHC ==6.10.1, GHC ==6.12.1, GHC ==7.0.3, GHC ==7.6.1 +Extra-source-files: + AUTHORS, README, VERSION Source-Repository head Type: darcs Location: http://community.haskell.org/~wren/bytestring-lexing diff --git a/src/Data/ByteString/Lex/Integral.hs b/src/Data/ByteString/Lex/Integral.hs --- a/src/Data/ByteString/Lex/Integral.hs +++ b/src/Data/ByteString/Lex/Integral.hs @@ -1,9 +1,9 @@ {-# OPTIONS_GHC -Wall -fwarn-tabs #-} ---------------------------------------------------------------- --- 2012.01.31 +-- 2013.03.20 -- | -- Module : Data.ByteString.Lex.Integral --- Copyright : Copyright (c) 2010--2012 wren ng thornton +-- Copyright : Copyright (c) 2010--2013 wren ng thornton -- License : BSD3 -- Maintainer : wren@community.haskell.org -- Stability : provisional @@ -30,7 +30,7 @@ -- * Octal conversions , readOctal , packOctal - -- TODO: asOctal -- this will be hard to make really efficient... + -- asOctal -- this will be really hard to make efficient... ) where import Data.ByteString (ByteString) @@ -92,7 +92,7 @@ w | 0x39 >= w && w >= 0x30 -> Just $ loop (fromIntegral (w - 0x30)) (BSU.unsafeTail xs) | otherwise -> Nothing - + loop n xs | n `seq` xs `seq` False = undefined -- for strictness analysis | BS.null xs = (n, BS.empty) -- not @xs@, to help GC @@ -131,15 +131,16 @@ isDecimal :: Word8 -> Bool {-# INLINE isDecimal #-} isDecimal w = 0x39 >= w && w >= 0x30 - + toDigit :: Integral a => Word8 -> a {-# INLINE toDigit #-} toDigit w = fromIntegral (w - 0x30) - + addDigit :: Int -> Word8 -> Int {-# INLINE addDigit #-} addDigit n w = n * 10 + toDigit w + -- TODO: should we explicitly drop all leading zeros before we jump into the unrolled loop? start :: Integral a => ByteString -> Maybe (a, ByteString) start xs | BS.null xs = Nothing @@ -147,7 +148,7 @@ case BSU.unsafeHead xs of w | isDecimal w -> Just $ loop0 (toDigit w) (BSU.unsafeTail xs) | otherwise -> Nothing - + loop0 :: Integral a => a -> ByteString -> (a, ByteString) loop0 m xs | m `seq` xs `seq` False = undefined @@ -156,7 +157,7 @@ case BSU.unsafeHead xs of w | isDecimal w -> loop1 m (toDigit w) (BSU.unsafeTail xs) | otherwise -> (m, xs) - + loop1, loop2, loop3, loop4, loop5, loop6, loop7, loop8 :: Integral a => a -> Int -> ByteString -> (a, ByteString) loop1 m n xs @@ -242,22 +243,22 @@ isDecimal :: Word8 -> Bool {-# INLINE isDecimal #-} isDecimal w = 0x39 >= w && w >= 0x30 - + toDigit :: Integral a => Word8 -> a {-# INLINE toDigit #-} toDigit w = fromIntegral (w - 0x30) - + addDigit :: Int -> Word8 -> Int {-# INLINE addDigit #-} addDigit n w = n * 10 + toDigit w - + start xs | BS.null xs = 0 | otherwise = case BSU.unsafeHead xs of w | isDecimal w -> loop0 (toDigit w) (BSU.unsafeTail xs) | otherwise -> 0 - + loop0 :: Integral a => a -> ByteString -> a loop0 m xs | m `seq` xs `seq` False = undefined @@ -266,7 +267,7 @@ case BSU.unsafeHead xs of w | isDecimal w -> loop1 m (toDigit w) (BSU.unsafeTail xs) | otherwise -> m - + loop1, loop2, loop3, loop4, loop5, loop6, loop7, loop8 :: Integral a => a -> Int -> ByteString -> a loop1 m n xs @@ -338,7 +339,9 @@ | otherwise = Just (unsafePackDecimal n) --- Beware the overflow issues of 'numDigits', noted at bottom. +-- This implementation is modified from: +-- +-- -- | Convert a non-negative integer into an (unsigned) ASCII decimal -- string. This function is unsafe to use on negative inputs. unsafePackDecimal :: (Integral a) => a -> ByteString @@ -355,22 +358,36 @@ Word32 -> ByteString, Word64 -> ByteString #-} unsafePackDecimal n0 = - let size = numDigits 10 (toInteger n0) - in BSI.unsafeCreate size $ \p0 -> - loop n0 (p0 `plusPtr` (size - 1)) + let size = numDecimalDigits n0 + in BSI.unsafeCreate size $ \p0 -> loop n0 (p0 `plusPtr` (size - 1)) where - loop :: (Integral a) => a -> Ptr Word8 -> IO () + getDigit = BSU.unsafeIndex packDecimal_digits + loop n p | n `seq` p `seq` False = undefined -- for strictness analysis - | n <= 9 = do - poke p (0x30 + fromIntegral n) + | n >= 100 = do + let (q,r) = n `quotRem` 100 + write2 r p + loop q (p `plusPtr` negate 2) + | n >= 10 = write2 n p + | otherwise = poke p (0x30 + fromIntegral n) + + write2 i0 p + | i0 `seq` p `seq` False = undefined -- for strictness analysis | otherwise = do - -- quotRem == divMod when both @n@ and @b@ are positive, - -- but 'quotRem' is often faster (for Int it's one machine-op!) - let (q,r) = n `quotRem` 10 - poke p (0x30 + fromIntegral r) - loop q (p `plusPtr` negate 1) + let i = fromIntegral i0; j = i + i + poke p (getDigit $! j + 1) + poke (p `plusPtr` negate 1) (getDigit j) +packDecimal_digits :: ByteString +{-# NOINLINE packDecimal_digits #-} +packDecimal_digits = BS8.pack + "0001020304050607080910111213141516171819\ + \2021222324252627282930313233343536373839\ + \4041424344454647484950515253545556575859\ + \6061626364656667686970717273747576777879\ + \8081828384858687888990919293949596979899" + -- BUG: syntax highlighting fail: -> ---------------------------------------------------------------- ---------------------------------------------------------------- @@ -404,7 +421,7 @@ -- TODO: Would it be worth trying to do the magichash trick -- used by Warp here? It'd really help remove branch prediction -- issues etc. - -- + -- -- Beware the urge to make this code prettier, cf 'readDecimal'. start xs | BS.null xs = Nothing @@ -417,7 +434,7 @@ | 0x66 >= w && w >= 0x61 -> Just $ loop (fromIntegral (w-0x61+10)) (BSU.unsafeTail xs) | otherwise -> Nothing - + loop n xs | n `seq` xs `seq` False = undefined -- for strictness analysis | BS.null xs = (n, BS.empty) -- not @xs@, to help GC @@ -457,7 +474,7 @@ Word32 -> ByteString, Word64 -> ByteString #-} unsafePackHexadecimal n0 = - let size = twoPowerNumDigits 4 (toInteger n0) -- for Bits + let size = numTwoPowerDigits 4 (toInteger n0) -- for Bits in BSI.unsafeCreate size $ \p0 -> loop n0 (p0 `plusPtr` (size - 1)) where @@ -479,11 +496,14 @@ asHexadecimal :: ByteString -> ByteString asHexadecimal = start where - start buf = - BSI.unsafeCreate (2 * BS.length buf) $ \p0 -> do - _ <- foldIO step p0 buf - return () -- needed for type checking - + start buf + | BS.length buf > maxBound `quot` 2 = + error _asHexadecimal_overflow + | otherwise = + BSI.unsafeCreate (2 * BS.length buf) $ \p0 -> do + _ <- foldIO step p0 buf + return () -- needed for type checking + step :: Ptr Word8 -> Word8 -> IO (Ptr Word8) step p w | p `seq` w `seq` False = undefined -- for strictness analysis @@ -493,7 +513,12 @@ poke (p `plusPtr` 1) (BSU.unsafeIndex hexDigits (ix .&. 0x0F)) return (p `plusPtr` 2) +_asHexadecimal_overflow :: String +{-# NOINLINE _asHexadecimal_overflow #-} +_asHexadecimal_overflow = + "asHexadecimal: cannot create buffer larger than (maxBound::Int)" + -- TODO: benchmark against the magichash hack used in Warp. -- | The lower-case ASCII hexadecimal digits, in numerical order -- for use as a lookup table. @@ -554,7 +579,7 @@ w | 0x37 >= w && w >= 0x30 -> Just $ loop (fromIntegral (w - 0x30)) (BSU.unsafeTail xs) | otherwise -> Nothing - + loop n xs | n `seq` xs `seq` False = undefined -- for strictness analysis | BS.null xs = (n, BS.empty) -- not @xs@, to help GC @@ -590,7 +615,7 @@ Word32 -> ByteString, Word64 -> ByteString #-} unsafePackOctal n0 = - let size = twoPowerNumDigits 3 (toInteger n0) -- for Bits + let size = numTwoPowerDigits 3 (toInteger n0) -- for Bits in BSI.unsafeCreate size $ \p0 -> loop n0 (p0 `plusPtr` (size - 1)) where @@ -603,34 +628,76 @@ poke p (0x30 + fromIntegral r) loop q (p `plusPtr` negate 1) - {- --- @ceilEightThirds x == ceiling (fromIntegral x * 8 / 3)@ -ceilEightThirds :: Nat -> Nat -ceilEightThirds (Nat# x) - | 0 == r = Nat# q - | otherwise = Nat# (q+1) - where - (q,r) = (x * 8) `quotRem` 3 - +-- BUG: This doesn't quite work right... asOctal :: ByteString -> ByteString asOctal buf = BSI.unsafeCreate (ceilEightThirds $ BS.length buf) $ \p0 -> do let (BSI.PS fq off len) = buf FFI.withForeignPtr fq $ \q0 -> do let qF = q0 `plusPtr` (off + len - rem len 3) - let loop p q - | q == qF = ...{- Handle the last one or two Word8 -} - | otherwise = do - ...{- Take three Word8 and write 8 chars at a time -} - -- Cf. the @word24@ package + let loop :: Ptr Word8 -> Ptr Word8 -> IO () + loop p q + | q /= qF = do + {- Take three Word8s and write 8 chars at a time -} + i <- peek q + j <- peek (q `plusPtr` 1) :: IO Word8 + k <- peek (q `plusPtr` 2) :: IO Word8 + let w = fromIntegral i + .|. (fromIntegral j `shiftL` 8) + .|. (fromIntegral k `shiftL` 16) + poke p (toC8( w .&. 0x07)) + poke (p `plusPtr` 1) (toC8((w `shiftR` 3) .&. 0x07)) + poke (p `plusPtr` 2) (toC8((w `shiftR` 6) .&. 0x07)) + poke (p `plusPtr` 3) (toC8((w `shiftR` 9) .&. 0x07)) + poke (p `plusPtr` 4) (toC8((w `shiftR` 12) .&. 0x07)) + poke (p `plusPtr` 5) (toC8((w `shiftR` 15) .&. 0x07)) + poke (p `plusPtr` 6) (toC8((w `shiftR` 18) .&. 0x07)) + poke (p `plusPtr` 7) (toC8((w `shiftR` 21) .&. 0x07)) loop (p `plusPtr` 8) (q `plusPtr` 3) - + | 2 == rem len 3 = do + {- Handle the last two Word8s -} + i <- peek q + j <- peek (q `plusPtr` 1) :: IO Word8 + let w = fromIntegral i + .|. (fromIntegral j `shiftL` 8) + poke p (toC8( w .&. 0x07)) + poke (p `plusPtr` 1) (toC8((w `shiftR` 3) .&. 0x07)) + poke (p `plusPtr` 2) (toC8((w `shiftR` 6) .&. 0x07)) + poke (p `plusPtr` 3) (toC8((w `shiftR` 9) .&. 0x07)) + poke (p `plusPtr` 4) (toC8((w `shiftR` 12) .&. 0x07)) + poke (p `plusPtr` 5) (toC8((w `shiftR` 15) .&. 0x01)) + | otherwise = do + {- Handle the last Word8 -} + i <- peek q + let w = fromIntegral i + poke p (toC8( w .&. 0x07)) + poke (p `plusPtr` 1) (toC8((w `shiftR` 3) .&. 0x07)) + poke (p `plusPtr` 2) (toC8((w `shiftR` 6) .&. 0x03)) + -- loop p0 (q0 `plusPtr` off) + where + toC8 :: Int -> Word8 + toC8 i = fromIntegral (0x30+i) + {-# INLINE toC8 #-} + -- We can probably speed that up by using (.|.) in lieu of (+) - {- N.B., @BSU.unsafeIndex octDigits == (0x30 +)@ -} --} + -- See the benchmark file for credits and implementation details. + ceilEightThirds x + | x >= 3*(b-1) = error _asOctal_overflow + | x >= b = ceiling (fromIntegral x / 3 * 8 :: Double) + | otherwise = (x*8 + 2) `quot` 3 + where + {-# INLINE b #-} + b = 2^(28::Int)::Int -- b*8-1 is the last positive number for Int=Int32 + -- TODO: need to generalize for Int=Int64 +_asOctal_overflow :: String +{-# NOINLINE _asOctal_overflow #-} +_asOctal_overflow = + "asOctal: cannot create buffer larger than (maxBound::Int)" +-- -} + ---------------------------------------------------------------- ---------------------------------------------------------------- ----- Integral logarithms @@ -650,7 +717,7 @@ -- to represent the number @n@. N.B., this implementation is unsafe -- and will throw errors if the base is @(<= 1)@, or if the number -- is negative. If the base happens to be a power of 2, then see --- 'twoPowerNumDigits' for a more efficient implementation. +-- 'numTwoPowerDigits' for a more efficient implementation. -- -- We must be careful about the input types here. When using small -- unsigned types or very large values, the repeated squaring can @@ -663,8 +730,9 @@ numDigits :: Integer -> Integer -> Int {-# INLINE numDigits #-} numDigits b0 n0 - | b0 <= 1 = error _numDigits_nonpositiveBase - | n0 < 0 = error _numDigits_negativeNumber + | b0 <= 1 = error (_numDigits ++ _nonpositiveBase) + | n0 < 0 = error (_numDigits ++ _negativeNumber) + -- BUG: need to check n0 to be sure we won't overflow Int | otherwise = 1 + fst (ilog b0 n0) where ilog b n @@ -674,26 +742,19 @@ where (e, r) = ilog (b*b) n -_numDigits_nonpositiveBase :: String -{-# NOINLINE _numDigits_nonpositiveBase #-} -_numDigits_nonpositiveBase = "numDigits: base must be greater than one" -_numDigits_negativeNumber :: String -{-# NOINLINE _numDigits_negativeNumber #-} -_numDigits_negativeNumber = "numDigits: number must be non-negative" - - -- | Compute the number of base-@2^p@ digits required to represent a -- number @n@. N.B., this implementation is unsafe and will throw -- errors if the base power is non-positive, or if the number is -- negative. For bases which are not a power of 2, see 'numDigits' -- for a more general implementation. -twoPowerNumDigits :: (Integral a, Bits a) => Int -> a -> Int -{-# INLINE twoPowerNumDigits #-} -twoPowerNumDigits p n0 - | p <= 0 = error _twoPowerNumDigits_nonpositiveBase - | n0 < 0 = error _twoPowerNumDigits_negativeNumber +numTwoPowerDigits :: (Integral a, Bits a) => Int -> a -> Int +{-# INLINE numTwoPowerDigits #-} +numTwoPowerDigits p n0 + | p <= 0 = error (_numTwoPowerDigits ++ _nonpositiveBase) + | n0 < 0 = error (_numTwoPowerDigits ++ _negativeNumber) | n0 == 0 = 1 + -- BUG: need to check n0 to be sure we won't overflow Int | otherwise = go 0 n0 where go d n @@ -701,15 +762,58 @@ | n > 0 = go (d+1) (n `shiftR` p) | otherwise = d -_twoPowerNumDigits_nonpositiveBase :: String -{-# NOINLINE _twoPowerNumDigits_nonpositiveBase #-} -_twoPowerNumDigits_nonpositiveBase = - "twoPowerNumDigits: base must be positive" -_twoPowerNumDigits_negativeNumber :: String -{-# NOINLINE _twoPowerNumDigits_negativeNumber #-} -_twoPowerNumDigits_negativeNumber = - "twoPowerNumDigits: number must be non-negative" +-- This implementation is from: +-- +-- +-- | Compute the number of base-@10@ digits required to represent +-- a number @n@. N.B., this implementation is unsafe and will throw +-- errors if the number is negative. +numDecimalDigits :: (Integral a) => a -> Int +{-# INLINE numDecimalDigits #-} +numDecimalDigits n0 + | n0 < 0 = error (_numDecimalDigits ++ _negativeNumber) + -- BUG: need to check n0 to be sure we won't overflow Word64 + | otherwise = go 1 (fromIntegral n0 :: Word64) + where + fin n bound = if n >= bound then 1 else 0 + go k n + | k `seq` False = undefined -- For strictness analysis + | n < 10 = k + | n < 100 = k + 1 + | n < 1000 = k + 2 + | n < 1000000000000 = + k + if n < 100000000 + then if n < 1000000 + then if n < 10000 + then 3 + else 4 + fin n 100000 + else 6 + fin n 10000000 + else if n < 10000000000 + then 8 + fin n 1000000000 + else 10 + fin n 100000000000 + | otherwise = go (k + 12) (n `quot` 1000000000000) + + +_numDigits :: String +_numDigits = "numDigits" +{-# NOINLINE _numDigits #-} + +_numTwoPowerDigits :: String +_numTwoPowerDigits = "numTwoPowerDigits" +{-# NOINLINE _numTwoPowerDigits #-} + +_numDecimalDigits :: String +_numDecimalDigits = "numDecimalDigits" +{-# NOINLINE _numDecimalDigits #-} + +_nonpositiveBase :: String +_nonpositiveBase = ": base must be greater than one" +{-# NOINLINE _nonpositiveBase #-} + +_negativeNumber :: String +_negativeNumber = ": number must be non-negative" +{-# NOINLINE _negativeNumber #-} ---------------------------------------------------------------- ----------------------------------------------------------- fin.