{-# OPTIONS_GHC -Wall -fwarn-tabs #-}
module Data.ByteString.Lex.Integral
(
readSigned
, readDecimal
, readDecimal_
, packDecimal
, readHexadecimal
, packHexadecimal
, asHexadecimal
, readOctal
, packOctal
) where
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8 (pack)
import qualified Data.ByteString.Internal as BSI
import qualified Data.ByteString.Unsafe as BSU
import Data.Int
import Data.Word
import Data.Bits
import Foreign.Ptr (Ptr, plusPtr)
import qualified Foreign.ForeignPtr as FFI (withForeignPtr)
import Foreign.Storable (peek, poke)
import Data.ByteString.Lex.Internal
readSigned
:: (Num a)
=> (ByteString -> Maybe (a, ByteString))
-> ByteString -> Maybe (a, ByteString)
readSigned f xs
| BS.null xs = Nothing
| otherwise =
case BSU.unsafeHead xs of
0x2D -> f (BSU.unsafeTail xs) >>= \(n, ys) -> return (negate n, ys)
0x2B -> f (BSU.unsafeTail xs)
_ -> f xs
readDecimal :: (Integral a) => ByteString -> Maybe (a, ByteString)
{-# SPECIALIZE readDecimal ::
ByteString -> Maybe (Int, ByteString),
ByteString -> Maybe (Int8, ByteString),
ByteString -> Maybe (Int16, ByteString),
ByteString -> Maybe (Int32, ByteString),
ByteString -> Maybe (Int64, ByteString),
ByteString -> Maybe (Integer, ByteString),
ByteString -> Maybe (Word, ByteString),
ByteString -> Maybe (Word8, ByteString),
ByteString -> Maybe (Word16, ByteString),
ByteString -> Maybe (Word32, ByteString),
ByteString -> Maybe (Word64, ByteString) #-}
readDecimal = start
where
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 :: (Integral a) => ByteString -> Maybe (a, ByteString)
start xs
| BS.null xs = Nothing
| otherwise =
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
| BS.null xs = (m, BS.empty)
| otherwise =
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
| m `seq` n `seq` xs `seq` False = undefined
| BS.null xs = (m*10 + fromIntegral n, BS.empty)
| otherwise =
case BSU.unsafeHead xs of
w | isDecimal w -> loop2 m (addDigit n w) (BSU.unsafeTail xs)
| otherwise -> (m*10 + fromIntegral n, xs)
loop2 m n xs
| m `seq` n `seq` xs `seq` False = undefined
| BS.null xs = (m*100 + fromIntegral n, BS.empty)
| otherwise =
case BSU.unsafeHead xs of
w | isDecimal w -> loop3 m (addDigit n w) (BSU.unsafeTail xs)
| otherwise -> (m*100 + fromIntegral n, xs)
loop3 m n xs
| m `seq` n `seq` xs `seq` False = undefined
| BS.null xs = (m*1000 + fromIntegral n, BS.empty)
| otherwise =
case BSU.unsafeHead xs of
w | isDecimal w -> loop4 m (addDigit n w) (BSU.unsafeTail xs)
| otherwise -> (m*1000 + fromIntegral n, xs)
loop4 m n xs
| m `seq` n `seq` xs `seq` False = undefined
| BS.null xs = (m*10000 + fromIntegral n, BS.empty)
| otherwise =
case BSU.unsafeHead xs of
w | isDecimal w -> loop5 m (addDigit n w) (BSU.unsafeTail xs)
| otherwise -> (m*10000 + fromIntegral n, xs)
loop5 m n xs
| m `seq` n `seq` xs `seq` False = undefined
| BS.null xs = (m*100000 + fromIntegral n, BS.empty)
| otherwise =
case BSU.unsafeHead xs of
w | isDecimal w -> loop6 m (addDigit n w) (BSU.unsafeTail xs)
| otherwise -> (m*100000 + fromIntegral n, xs)
loop6 m n xs
| m `seq` n `seq` xs `seq` False = undefined
| BS.null xs = (m*1000000 + fromIntegral n, BS.empty)
| otherwise =
case BSU.unsafeHead xs of
w | isDecimal w -> loop7 m (addDigit n w) (BSU.unsafeTail xs)
| otherwise -> (m*1000000 + fromIntegral n, xs)
loop7 m n xs
| m `seq` n `seq` xs `seq` False = undefined
| BS.null xs = (m*10000000 + fromIntegral n, BS.empty)
| otherwise =
case BSU.unsafeHead xs of
w | isDecimal w -> loop8 m (addDigit n w) (BSU.unsafeTail xs)
| otherwise -> (m*10000000 + fromIntegral n, xs)
loop8 m n xs
| m `seq` n `seq` xs `seq` False = undefined
| BS.null xs = (m*100000000 + fromIntegral n, BS.empty)
| otherwise =
case BSU.unsafeHead xs of
w | isDecimal w -> loop0
(m*1000000000 + fromIntegral (addDigit n w))
(BSU.unsafeTail xs)
| otherwise -> (m*100000000 + fromIntegral n, xs)
readDecimal_ :: (Integral a) => ByteString -> a
{-# SPECIALIZE readDecimal_ ::
ByteString -> Int,
ByteString -> Int8,
ByteString -> Int16,
ByteString -> Int32,
ByteString -> Int64,
ByteString -> Integer,
ByteString -> Word,
ByteString -> Word8,
ByteString -> Word16,
ByteString -> Word32,
ByteString -> Word64 #-}
readDecimal_ = start
where
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
| BS.null xs = m
| otherwise =
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
| m `seq` n `seq` xs `seq` False = undefined
| BS.null xs = m*10 + fromIntegral n
| otherwise =
case BSU.unsafeHead xs of
w | isDecimal w -> loop2 m (addDigit n w) (BSU.unsafeTail xs)
| otherwise -> m*10 + fromIntegral n
loop2 m n xs
| m `seq` n `seq` xs `seq` False = undefined
| BS.null xs = m*100 + fromIntegral n
| otherwise =
case BSU.unsafeHead xs of
w | isDecimal w -> loop3 m (addDigit n w) (BSU.unsafeTail xs)
| otherwise -> m*100 + fromIntegral n
loop3 m n xs
| m `seq` n `seq` xs `seq` False = undefined
| BS.null xs = m*1000 + fromIntegral n
| otherwise =
case BSU.unsafeHead xs of
w | isDecimal w -> loop4 m (addDigit n w) (BSU.unsafeTail xs)
| otherwise -> m*1000 + fromIntegral n
loop4 m n xs
| m `seq` n `seq` xs `seq` False = undefined
| BS.null xs = m*10000 + fromIntegral n
| otherwise =
case BSU.unsafeHead xs of
w | isDecimal w -> loop5 m (addDigit n w) (BSU.unsafeTail xs)
| otherwise -> m*10000 + fromIntegral n
loop5 m n xs
| m `seq` n `seq` xs `seq` False = undefined
| BS.null xs = m*100000 + fromIntegral n
| otherwise =
case BSU.unsafeHead xs of
w | isDecimal w -> loop6 m (addDigit n w) (BSU.unsafeTail xs)
| otherwise -> m*100000 + fromIntegral n
loop6 m n xs
| m `seq` n `seq` xs `seq` False = undefined
| BS.null xs = m*1000000 + fromIntegral n
| otherwise =
case BSU.unsafeHead xs of
w | isDecimal w -> loop7 m (addDigit n w) (BSU.unsafeTail xs)
| otherwise -> m*1000000 + fromIntegral n
loop7 m n xs
| m `seq` n `seq` xs `seq` False = undefined
| BS.null xs = m*10000000 + fromIntegral n
| otherwise =
case BSU.unsafeHead xs of
w | isDecimal w -> loop8 m (addDigit n w) (BSU.unsafeTail xs)
| otherwise -> m*10000000 + fromIntegral n
loop8 m n xs
| m `seq` n `seq` xs `seq` False = undefined
| BS.null xs = m*100000000 + fromIntegral n
| otherwise =
case BSU.unsafeHead xs of
w | isDecimal w -> loop0
(m*1000000000 + fromIntegral (addDigit n w))
(BSU.unsafeTail xs)
| otherwise -> m*100000000 + fromIntegral n
packDecimal :: (Integral a) => a -> Maybe ByteString
{-# INLINE packDecimal #-}
packDecimal n
| n < 0 = Nothing
| otherwise = Just (unsafePackDecimal n)
unsafePackDecimal :: (Integral a) => a -> ByteString
{-# SPECIALIZE unsafePackDecimal ::
Int -> ByteString,
Int8 -> ByteString,
Int16 -> ByteString,
Int32 -> ByteString,
Int64 -> ByteString,
Integer -> ByteString,
Word -> ByteString,
Word8 -> ByteString,
Word16 -> ByteString,
Word32 -> ByteString,
Word64 -> ByteString #-}
unsafePackDecimal n0 =
let size = numDecimalDigits n0
in BSI.unsafeCreate size $ \p0 -> loop n0 (p0 `plusPtr` (size - 1))
where
getDigit = BSU.unsafeIndex packDecimal_digits
loop n p
| n `seq` p `seq` False = undefined
| 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
| otherwise = do
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"
readHexadecimal :: (Integral a) => ByteString -> Maybe (a, ByteString)
{-# SPECIALIZE readHexadecimal ::
ByteString -> Maybe (Int, ByteString),
ByteString -> Maybe (Int8, ByteString),
ByteString -> Maybe (Int16, ByteString),
ByteString -> Maybe (Int32, ByteString),
ByteString -> Maybe (Int64, ByteString),
ByteString -> Maybe (Integer, ByteString),
ByteString -> Maybe (Word, ByteString),
ByteString -> Maybe (Word8, ByteString),
ByteString -> Maybe (Word16, ByteString),
ByteString -> Maybe (Word32, ByteString),
ByteString -> Maybe (Word64, ByteString) #-}
readHexadecimal = start
where
start xs
| BS.null xs = Nothing
| otherwise =
case BSU.unsafeHead xs of
w | 0x39 >= w && w >= 0x30 ->
Just $ loop (fromIntegral (w - 0x30)) (BSU.unsafeTail xs)
| 0x46 >= w && w >= 0x41 ->
Just $ loop (fromIntegral (w-0x41+10)) (BSU.unsafeTail xs)
| 0x66 >= w && w >= 0x61 ->
Just $ loop (fromIntegral (w-0x61+10)) (BSU.unsafeTail xs)
| otherwise -> Nothing
loop n xs
| n `seq` xs `seq` False = undefined
| BS.null xs = (n, BS.empty)
| otherwise =
case BSU.unsafeHead xs of
w | 0x39 >= w && w >= 0x30 ->
loop (n*16 + fromIntegral (w - 0x30)) (BSU.unsafeTail xs)
| 0x46 >= w && w >= 0x41 ->
loop (n*16 + fromIntegral (w-0x41+10)) (BSU.unsafeTail xs)
| 0x66 >= w && w >= 0x61 ->
loop (n*16 + fromIntegral (w-0x61+10)) (BSU.unsafeTail xs)
| otherwise -> (n,xs)
packHexadecimal :: (Integral a) => a -> Maybe ByteString
{-# INLINE packHexadecimal #-}
packHexadecimal n
| n < 0 = Nothing
| otherwise = Just (unsafePackHexadecimal n)
unsafePackHexadecimal :: (Integral a) => a -> ByteString
{-# SPECIALIZE unsafePackHexadecimal ::
Int -> ByteString,
Int8 -> ByteString,
Int16 -> ByteString,
Int32 -> ByteString,
Int64 -> ByteString,
Integer -> ByteString,
Word -> ByteString,
Word8 -> ByteString,
Word16 -> ByteString,
Word32 -> ByteString,
Word64 -> ByteString #-}
unsafePackHexadecimal n0 =
let size = numTwoPowerDigits 4 (toInteger n0)
in BSI.unsafeCreate size $ \p0 ->
loop n0 (p0 `plusPtr` (size - 1))
where
loop :: (Integral a) => a -> Ptr Word8 -> IO ()
loop n p
| n <= 15 = do
poke p (BSU.unsafeIndex hexDigits (fromIntegral n .&. 0x0F))
| otherwise = do
let (q,r) = n `quotRem` 16
poke p (BSU.unsafeIndex hexDigits (fromIntegral r .&. 0x0F))
loop q (p `plusPtr` negate 1)
asHexadecimal :: ByteString -> ByteString
asHexadecimal = start
where
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 ()
step :: Ptr Word8 -> Word8 -> IO (Ptr Word8)
step p w
| p `seq` w `seq` False = undefined
| otherwise = do
let ix = fromIntegral w
poke p (BSU.unsafeIndex hexDigits ((ix .&. 0xF0) `shiftR` 4))
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)"
hexDigits :: ByteString
{-# NOINLINE hexDigits #-}
hexDigits = BS8.pack "0123456789abcdef"
foldIO :: (a -> Word8 -> IO a) -> a -> ByteString -> IO a
{-# INLINE foldIO #-}
foldIO f z0 (BSI.PS fp off len) =
FFI.withForeignPtr fp $ \p0 -> do
let q = p0 `plusPtr` (off+len)
let go z p
| z `seq` p `seq` False = undefined
| p == q = return z
| otherwise = do
w <- peek p
z' <- f z w
go z' (p `plusPtr` 1)
go z0 (p0 `plusPtr` off)
readOctal :: (Integral a) => ByteString -> Maybe (a, ByteString)
{-# SPECIALIZE readOctal ::
ByteString -> Maybe (Int, ByteString),
ByteString -> Maybe (Int8, ByteString),
ByteString -> Maybe (Int16, ByteString),
ByteString -> Maybe (Int32, ByteString),
ByteString -> Maybe (Int64, ByteString),
ByteString -> Maybe (Integer, ByteString),
ByteString -> Maybe (Word, ByteString),
ByteString -> Maybe (Word8, ByteString),
ByteString -> Maybe (Word16, ByteString),
ByteString -> Maybe (Word32, ByteString),
ByteString -> Maybe (Word64, ByteString) #-}
readOctal = start
where
start xs
| BS.null xs = Nothing
| otherwise =
case BSU.unsafeHead xs of
w | 0x37 >= w && w >= 0x30 ->
Just $ loop (fromIntegral (w - 0x30)) (BSU.unsafeTail xs)
| otherwise -> Nothing
loop n xs
| n `seq` xs `seq` False = undefined
| BS.null xs = (n, BS.empty)
| otherwise =
case BSU.unsafeHead xs of
w | 0x37 >= w && w >= 0x30 ->
loop (n * 8 + fromIntegral (w - 0x30)) (BSU.unsafeTail xs)
| otherwise -> (n,xs)
packOctal :: (Integral a) => a -> Maybe ByteString
{-# INLINE packOctal #-}
packOctal n
| n < 0 = Nothing
| otherwise = Just (unsafePackOctal n)
unsafePackOctal :: (Integral a) => a -> ByteString
{-# SPECIALIZE unsafePackOctal ::
Int -> ByteString,
Int8 -> ByteString,
Int16 -> ByteString,
Int32 -> ByteString,
Int64 -> ByteString,
Integer -> ByteString,
Word -> ByteString,
Word8 -> ByteString,
Word16 -> ByteString,
Word32 -> ByteString,
Word64 -> ByteString #-}
unsafePackOctal n0 =
let size = numTwoPowerDigits 3 (toInteger n0)
in BSI.unsafeCreate size $ \p0 ->
loop n0 (p0 `plusPtr` (size - 1))
where
loop :: (Integral a) => a -> Ptr Word8 -> IO ()
loop n p
| n <= 7 = do
poke p (0x30 + fromIntegral n)
| otherwise = do
let (q,r) = n `quotRem` 8
poke p (0x30 + fromIntegral r)
loop q (p `plusPtr` negate 1)