diff --git a/bench/FieldParsers.hs b/bench/FieldParsers.hs new file mode 100644 --- /dev/null +++ b/bench/FieldParsers.hs @@ -0,0 +1,175 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedTuples #-} + +{- | Per-field microbenchmark for "DataFrame.Internal.Parsing.Fast" +against the reference parsers (WS-B exit criterion: parseDoubleField +>= 5x Data.Text.Read.double on doubles_100mb-shaped fields). + +Style follows benchmarks/csv: monotonic-clock wall over a strict fold, +best of 5 runs, ns/field plus speedup printed per pairing. +-} +module Main (main) where + +import qualified Data.ByteString.Char8 as C +import qualified Data.Text as T +import qualified Data.Text.Encoding as TE +import qualified Data.Vector as V + +import Data.Bits (shiftR, xor) +import Data.Maybe (fromMaybe) +import Data.Time.Calendar (toModifiedJulianDay) +import Data.Word (Word64) +import GHC.Clock (getMonotonicTimeNSec) +import GHC.Exts (Double (..), Int (..)) +import Text.Printf (printf) + +import qualified DataFrame.Internal.Parsing as Ref +import DataFrame.Internal.Parsing.Fast + +fieldCount :: Int +fieldCount = 1000000 + +-- | SplitMix64 finalizer; deterministic pseudo-random stream. +mix64 :: Word64 -> Word64 +mix64 z0 = + let z1 = (z0 `xor` (z0 `shiftR` 33)) * 0xFF51AFD7ED558CCD + z2 = (z1 `xor` (z1 `shiftR` 33)) * 0xC4CEB9FE1A85EC53 + in z2 `xor` (z2 `shiftR` 33) + +{- | Round-trip-precision doubles, the doubles_100mb shape +(full 17-significant-digit mantissas from @show@). +-} +doubleFields :: V.Vector C.ByteString +doubleFields = V.generate fieldCount gen + where + gen i = + let w = mix64 (fromIntegral i + 1) + mag = fromIntegral (w `shiftR` 11) / 9007199254740992 :: Double + scaled = (mag - 0.5) * 2000000 + in C.pack (show scaled) + +intFields :: V.Vector C.ByteString +intFields = V.generate fieldCount gen + where + gen i = + let w = mix64 (fromIntegral i + 0x9E3779B97F4A7C15) + spans = [99, 9999, 999999, 99999999, 9223372036854775807] :: [Word64] + bound = spans !! (i `mod` 5) + v = toInteger (w `mod` bound) - toInteger (bound `div` 2) + in C.pack (show v) + +boolFields :: V.Vector C.ByteString +boolFields = V.generate fieldCount gen + where + gen i = map C.pack ["True", "False", "true", "false", "TRUE", "FALSE"] !! (i `mod` 6) + +dateFields :: V.Vector C.ByteString +dateFields = V.generate fieldCount gen + where + gen i = + let w = mix64 (fromIntegral i + 7) + y = 1900 + fromIntegral (w `mod` 200) :: Int + m = 1 + fromIntegral ((w `shiftR` 8) `mod` 12) :: Int + d = 1 + fromIntegral ((w `shiftR` 16) `mod` 28) :: Int + pad2 n = (if n < 10 then "0" else "") ++ show n + in C.pack (show y ++ "-" ++ pad2 m ++ "-" ++ pad2 d) + +-- | mixed_100mb-flavoured missing-check stream: mostly non-missing. +missingFields :: V.Vector C.ByteString +missingFields = V.generate fieldCount gen + where + gen i = + map C.pack ["12345", "NA", "hello world", "", "3.14159", "Nothing", "x", "null"] + !! (i `mod` 8) + +forceBS :: V.Vector C.ByteString -> Int +forceBS = V.foldl' (\ !acc b -> acc + C.length b) 0 + +forceT :: V.Vector T.Text -> Int +forceT = V.foldl' (\ !acc t -> acc + T.length t) 0 + +-- | Best-of-5 wall nanoseconds for a strict fold over the fields. +bench :: V.Vector a -> (a -> Double) -> IO Double +bench fields step = minimum <$> mapM run [1 .. 5 :: Int] + where + -- Seed the accumulator with the run index so the fold cannot be + -- floated out and shared between the five runs. + run k = do + t0 <- getMonotonicTimeNSec + let !s = V.foldl' (\ !acc f -> acc + step f) (fromIntegral k) fields + s `seq` return () + t1 <- getMonotonicTimeNSec + return (fromIntegral (t1 - t0)) + +report :: String -> Double -> Double -> IO () +report name refNs fastNs = do + let n = fromIntegral fieldCount + printf + "%-34s ref %8.1f ns/field fast %7.1f ns/field speedup %5.2fx\n" + name + (refNs / n) + (fastNs / n) + (refNs / fastNs) + +mb :: Maybe Bool -> Double +mb = maybe 0 (\b -> if b then 1 else 2) + +mi :: Maybe Int -> Double +mi = fromIntegral . fromMaybe 0 + +md :: Maybe Double -> Double +md = fromMaybe 0 + +main :: IO () +main = do + printf "fields per stream: %d (best of 5 runs)\n\n" fieldCount + let doubleTexts = V.map TE.decodeUtf8Lenient doubleFields + intTexts = V.map TE.decodeUtf8Lenient intFields + printf + "force: %d\n\n" + ( forceBS doubleFields + + forceBS intFields + + forceBS boolFields + + forceBS missingFields + + forceBS dateFields + + forceT doubleTexts + + forceT intTexts + ) + + refD <- bench doubleFields (md . Ref.readByteStringDouble) + refDT <- bench doubleTexts (md . Ref.readDouble) + fastD <- bench doubleFields (md . parseDoubleField) + fastDU <- + bench doubleFields $ \f -> + case parseDoubleField# f 0 (C.length f) of + (# 0#, _ #) -> 0 + (# _, d #) -> D# d + report "double (vs readByteStringDouble)" refD fastD + report "double (vs Text readDouble)" refDT fastD + report "double unboxed core (vs BS ref)" refD fastDU + + refI <- bench intFields (mi . Ref.readByteStringInt) + refIT <- bench intTexts (mi . Ref.readInt) + fastI <- bench intFields (mi . parseIntField) + fastIU <- + bench intFields $ \f -> + case parseIntField# f 0 (C.length f) of + (# 0#, _ #) -> 0 + (# _, n #) -> fromIntegral (I# n) + report "int (vs readByteStringInt)" refI fastI + report "int (vs Text readInt)" refIT fastI + report "int unboxed core (vs BS ref)" refI fastIU + + refB <- bench boolFields (mb . Ref.readByteStringBool) + fastB <- bench boolFields (mb . parseBoolField) + report "bool (vs readByteStringBool)" refB fastB + + refM <- bench missingFields (\f -> if Ref.isNullishBS f then 1 else 0) + fastM <- bench missingFields (\f -> if isMissingField f then 1 else 0) + report "missing (vs isNullishBS)" refM fastM + + let mday = maybe 0 (fromIntegral . toModifiedJulianDay) + refDay <- bench dateFields (mday . Ref.readByteStringDate "%Y-%m-%d") + fastDay <- bench dateFields (mday . parseDateField) + report "date %Y-%m-%d (vs parseTimeM)" refDay fastDay diff --git a/dataframe-parsing.cabal b/dataframe-parsing.cabal --- a/dataframe-parsing.cabal +++ b/dataframe-parsing.cabal @@ -1,7 +1,6 @@ cabal-version: 2.4 name: dataframe-parsing -version: 1.0.1.0 - +version: 1.0.2.0 synopsis: Shared text/binary parsing helpers for the dataframe ecosystem. description: Parsing primitives used by the @dataframe@ family: CSV-friendly text @@ -16,7 +15,7 @@ license-file: LICENSE author: Michael Chavinda maintainer: mschavinda@gmail.com -copyright: (c) 2024-2025 Michael Chavinda +copyright: (c) 2024-2026 Michael Chavinda category: Data tested-with: GHC ==9.4.8 || ==9.6.7 || ==9.8.4 || ==9.10.3 || ==9.12.2 @@ -33,14 +32,50 @@ exposed-modules: DataFrame.Internal.Binary DataFrame.Internal.Parsing + DataFrame.Internal.Parsing.Fast + DataFrame.Internal.Parsing.Fast.Common + DataFrame.Internal.Parsing.Fast.Double + DataFrame.Internal.Parsing.Fast.Int + DataFrame.Internal.Parsing.Fast.Token DataFrame.Internal.Schema build-depends: base >= 4 && < 5, attoparsec >= 0.12 && < 0.15, bytestring >= 0.11 && < 0.13, bytestring-lexing >= 0.5 && < 0.6, containers >= 0.6.7 && < 0.9, - dataframe-core ^>= 1.0, + dataframe-core ^>= 1.1, text >= 2.0 && < 3, - time >= 1.12 && < 2 + time >= 1.12 && < 2, + vector >= 0.12 && < 0.14 hs-source-dirs: src + default-language: Haskell2010 + +test-suite tests + import: warnings + type: exitcode-stdio-1.0 + main-is: Main.hs + other-modules: Properties.FastParsing + Unit.FastParsing + build-depends: base >= 4 && < 5, + bytestring >= 0.11 && < 0.13, + dataframe-parsing, + HUnit ^>= 1.6, + QuickCheck >= 2 && < 3, + text >= 2.0 && < 3 + hs-source-dirs: tests + ghc-options: -O2 + default-language: Haskell2010 + +benchmark field-parsers + import: warnings + type: exitcode-stdio-1.0 + main-is: FieldParsers.hs + build-depends: base >= 4 && < 5, + bytestring >= 0.11 && < 0.13, + dataframe-parsing, + text >= 2.0 && < 3, + time >= 1.12 && < 2, + vector >= 0.12 && < 0.14 + hs-source-dirs: bench + ghc-options: -O2 default-language: Haskell2010 diff --git a/src/DataFrame/Internal/Parsing/Fast.hs b/src/DataFrame/Internal/Parsing/Fast.hs new file mode 100644 --- /dev/null +++ b/src/DataFrame/Internal/Parsing/Fast.hs @@ -0,0 +1,107 @@ +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedTuples #-} + +{- | Fast, non-backtracking field parsers for CSV ingest (Round-2 WS-B). + +Each parser is a pure function over a @(buf, start, end)@ byte slice +(the SIMD scan already yields field boundaries) and is bit-exact with +the reference parsers in "DataFrame.Internal.Parsing": the Double fast +path covers fixed-width mantissas (<= 19 significant digits per +component) via a power-of-ten table and falls back to +'DataFrame.Internal.Parsing.readByteStringDouble' whenever exactness +is in doubt. The unboxed @#@ variants avoid all 'Maybe' boxing; the +plain names are thin 'Maybe' wrappers over the whole ByteString. +-} +module DataFrame.Internal.Parsing.Fast ( + -- * Int fields + parseIntField, + parseIntFieldSlice, + parseIntField#, + + -- * Double fields + parseDoubleField, + parseDoubleFieldSlice, + parseDoubleField#, + + -- * Bool fields + parseBoolField, + parseBoolFieldSlice, + parseBoolField#, + + -- * Date fields (default @%Y-%m-%d@ format) + parseDateField, + parseDateFieldSlice, + + -- * Missing-token test + isMissingField, + isMissingFieldSlice, + isMissingFieldIn, +) where + +import qualified Data.ByteString as BS + +import Data.Time (Day) +import GHC.Exts (Double (..), Int (..)) + +import DataFrame.Internal.Parsing.Fast.Double (parseDoubleField#) +import DataFrame.Internal.Parsing.Fast.Int (parseIntField#) +import DataFrame.Internal.Parsing.Fast.Token ( + isMissingFieldIn, + isMissingFieldSlice, + parseBoolField#, + parseDateFieldSlice, + ) + +{- | Strip-tolerant @Int@ parse of a whole field; rejects overflow, +matching @readByteStringInt@ exactly. +-} +parseIntField :: BS.ByteString -> Maybe Int +parseIntField bs = parseIntFieldSlice bs 0 (BS.length bs) +{-# INLINE parseIntField #-} + +parseIntFieldSlice :: BS.ByteString -> Int -> Int -> Maybe Int +parseIntFieldSlice bs start end = + case parseIntField# bs start end of + (# 0#, _ #) -> Nothing + (# _, n #) -> Just (I# n) +{-# INLINE parseIntFieldSlice #-} + +{- | Strip-tolerant @Double@ parse of a whole field; bit-exact with +@readByteStringDouble@ (falls back to it outside the fast window). +-} +parseDoubleField :: BS.ByteString -> Maybe Double +parseDoubleField bs = parseDoubleFieldSlice bs 0 (BS.length bs) +{-# INLINE parseDoubleField #-} + +parseDoubleFieldSlice :: BS.ByteString -> Int -> Int -> Maybe Double +parseDoubleFieldSlice bs start end = + case parseDoubleField# bs start end of + (# 0#, _ #) -> Nothing + (# _, d #) -> Just (D# d) +{-# INLINE parseDoubleFieldSlice #-} + +-- | Exact-match Bool parse (@True|true|TRUE|False|false|FALSE@, no strip). +parseBoolField :: BS.ByteString -> Maybe Bool +parseBoolField bs = parseBoolFieldSlice bs 0 (BS.length bs) +{-# INLINE parseBoolField #-} + +parseBoolFieldSlice :: BS.ByteString -> Int -> Int -> Maybe Bool +parseBoolFieldSlice bs start end = + case parseBoolField# bs start end of + (# 0#, _ #) -> Nothing + (# _, b #) -> Just (I# b /= 0) +{-# INLINE parseBoolFieldSlice #-} + +{- | @%Y-%m-%d@ date parse: byte-level fast path for the padded +10-byte shape, 'Data.Time.parseTimeM' fallback for everything else. +-} +parseDateField :: BS.ByteString -> Maybe Day +parseDateField bs = parseDateFieldSlice bs 0 (BS.length bs) +{-# INLINE parseDateField #-} + +{- | Byte-level test against the canonical missing-token list +(@Nothing NULL \"\" \" \" nan null N\/A NaN NAN NA@), no Text decode. +-} +isMissingField :: BS.ByteString -> Bool +isMissingField bs = isMissingFieldSlice bs 0 (BS.length bs) +{-# INLINE isMissingField #-} diff --git a/src/DataFrame/Internal/Parsing/Fast/Common.hs b/src/DataFrame/Internal/Parsing/Fast/Common.hs new file mode 100644 --- /dev/null +++ b/src/DataFrame/Internal/Parsing/Fast/Common.hs @@ -0,0 +1,108 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} + +{- | Shared byte-level helpers for the fast slice parsers. + +All functions operate on @(buf, start, end)@ slices with the hsthrift +one-bounds-check discipline: the caller guarantees +@0 <= start <= end <= length buf@ and everything below uses 'unsafeIndex'. +-} +module DataFrame.Internal.Parsing.Fast.Common ( + isStripByte, + isDigitByte, + skipStrip, + skipStripEnd, + skipZeroes, + takeDigits64, +) where + +import qualified Data.ByteString as BS +import qualified Data.ByteString.Unsafe as BSU + +import Data.Word (Word64, Word8) +import GHC.Exts ( + Int (..), + Int#, + RuntimeRep, + TYPE, + Word64#, + isTrue#, + plusWord64#, + timesWord64#, + wordToWord64#, + (+#), + (>=#), + ) +import GHC.Word (Word64 (..)) + +{- | Bytes removed by 'Data.ByteString.Char8.strip' (Latin-1 'isSpace'): +HT LF VT FF CR SP and NBSP 0xA0. Probed over all 256 bytes; parity +with the strip-based reference parsers depends on this exact set. +-} +isStripByte :: Word8 -> Bool +isStripByte w = w == 0x20 || (w - 0x09) <= 4 || w == 0xA0 +{-# INLINE isStripByte #-} + +isDigitByte :: Word8 -> Bool +isDigitByte w = (w - 0x30) <= 9 +{-# INLINE isDigitByte #-} + +-- | Index of the first non-strip byte in @[i, end)@. +skipStrip :: BS.ByteString -> Int -> Int -> Int +skipStrip bs = go + where + go !i !end + | i < end && isStripByte (BSU.unsafeIndex bs i) = go (i + 1) end + | otherwise = i +{-# INLINE skipStrip #-} + +-- | New exclusive end after dropping trailing strip bytes in @[i, end)@. +skipStripEnd :: BS.ByteString -> Int -> Int -> Int +skipStripEnd bs = go + where + go !i !end + | end > i && isStripByte (BSU.unsafeIndex bs (end - 1)) = go i (end - 1) + | otherwise = end +{-# INLINE skipStripEnd #-} + +-- | Index of the first non-@\'0\'@ byte in @[i, end)@. +skipZeroes :: BS.ByteString -> Int -> Int -> Int +skipZeroes bs = go + where + go !i !end + | i < end && BSU.unsafeIndex bs i == 0x30 = go (i + 1) end + | otherwise = i +{-# INLINE skipZeroes #-} + +{- | Consume ASCII digits from @i@, passing the stop index and the +wrapping 'Word64' accumulation to the (possibly unboxed-result) +continuation. Callers must bound the significant digit count before +trusting the value. The loop carries @Int#@/@Word64#@ explicitly: +GHC does not worker\/wrapper join points, so boxed loop arguments +would otherwise allocate 16 bytes per digit (ticky-verified). +-} +takeDigits64 :: + forall (rep :: RuntimeRep) (r :: TYPE rep). + BS.ByteString -> + Int -> + Int -> + (Int -> Word64 -> r) -> + r +takeDigits64 bs (I# i0) (I# end) k = go i0 (wordToWord64# 0##) + where + go :: Int# -> Word64# -> r + go i acc + | isTrue# (i >=# end) = k (I# i) (W64# acc) + | isDigitByte w = + case fromIntegral (w - 0x30) :: Word64 of + W64# d -> + go + (i +# 1#) + ((acc `timesWord64#` wordToWord64# 10##) `plusWord64#` d) + | otherwise = k (I# i) (W64# acc) + where + w = BSU.unsafeIndex bs (I# i) +{-# INLINE takeDigits64 #-} diff --git a/src/DataFrame/Internal/Parsing/Fast/Double.hs b/src/DataFrame/Internal/Parsing/Fast/Double.hs new file mode 100644 --- /dev/null +++ b/src/DataFrame/Internal/Parsing/Fast/Double.hs @@ -0,0 +1,133 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedTuples #-} + +{- | Fast @Double@ slice parser, BIT-EXACT with @readByteStringDouble@ +(bytestring-lexing's @readSigned readDecimal\/readExponential@). + +Instead of replaying the reference parser's Integer-mantissa chain, the +fast path replays its exact floating-point operation sequence +(@fromInteger whole + fromInteger part \/ 10^k@, then @* 10^^e@) using +'Word64' digit accumulation and tables of @10 ^ k@ \/ @recip (10 ^ k)@ +built with the very same @(^)@\/'recip' calls. Whenever a component +exceeds the 19-significant-digit 'Word64' window (or the exponent could +wrap 'Int'), exactness is in doubt and we fall back to the reference +parser on the raw slice. +-} +module DataFrame.Internal.Parsing.Fast.Double (parseDoubleField#) where + +import qualified Data.ByteString as BS +import qualified Data.ByteString.Unsafe as BSU +import qualified Data.Vector.Unboxed as VU + +import Data.Word (Word64) +import GHC.Exts (Double (..), Double#, Int#) + +import DataFrame.Internal.Parsing (readByteStringDouble) +import DataFrame.Internal.Parsing.Fast.Common + +{- | @10 ^ k@ for @k <= tableMax@, computed with the same @(^)@ the +reference parser uses, so every entry is bit-identical to its +runtime computation. Entries from @10^309@ up are @Infinity@, so +clamping larger exponents to 'tableMax' is exact. +-} +pow10Table :: VU.Vector Double +pow10Table = VU.generate (tableMax + 1) (10 ^) +{-# NOINLINE pow10Table #-} + +-- | @recip (10 ^ k)@, replaying @10 ^^ negate k@ bit-for-bit. +recipPow10Table :: VU.Vector Double +recipPow10Table = VU.map recip pow10Table +{-# NOINLINE recipPow10Table #-} + +tableMax :: Int +tableMax = 1024 + +{- | 'Word64' to 'Double' exactly as the reference parser's +'fromInteger' rounds it; values up to @2^53@ take the exact +'Int' conversion (int2Double#), larger ones the 'Integer' route. +-} +w2d :: Word64 -> Double +w2d w + | w <= 9007199254740991 = fromIntegral (fromIntegral w :: Int) + | otherwise = fromInteger (toInteger w) +{-# INLINE w2d #-} + +-- | Exactness in doubt: hand the raw slice to the reference parser. +referenceSlice :: BS.ByteString -> Int -> Int -> (# Int#, Double# #) +referenceSlice bs start end = + case readByteStringDouble (BSU.unsafeTake (end - start) (BSU.unsafeDrop start bs)) of + Just (D# d) -> (# 1#, d #) + Nothing -> (# 0#, 0.0## #) +{-# NOINLINE referenceSlice #-} + +{- | Result is @(# ok, value #)@ with @ok@ 0 or 1. Caller guarantees +@0 <= start <= end <= length buf@. +-} +parseDoubleField# :: BS.ByteString -> Int -> Int -> (# Int#, Double# #) +parseDoubleField# bs start end0 + | i0 >= end = none + | otherwise = + let !c0 = BSU.unsafeIndex bs i0 + !neg = c0 == 0x2D + !i1 = if neg || c0 == 0x2B then i0 + 1 else i0 + in if i1 >= end || not (isDigitByte (BSU.unsafeIndex bs i1)) + then none + else + let !iz = skipZeroes bs i1 end + in takeDigits64 bs iz end $ \wEnd w -> + if wEnd - iz > 19 + then referenceSlice bs start end0 + else afterWhole neg w wEnd + where + !i0 = skipStrip bs start end0 + !end = skipStripEnd bs i0 end0 + + none = (# 0#, 0.0## #) + + afterWhole !neg !w !i + | i < end && BSU.unsafeIndex bs i == 0x2E = + let !f0 = i + 1 + !fz = skipZeroes bs f0 end + in takeDigits64 bs fz end $ \fEnd p -> + if fEnd == f0 + then none + else + if fEnd - fz > 19 + then referenceSlice bs start end0 + else afterExponent neg (w2d w + (w2d p / pow10 (fEnd - f0))) fEnd + | otherwise = afterExponent neg (w2d w) i + + afterExponent !neg !val !i + | i >= end = done neg val + | BSU.unsafeIndex bs i == 0x65 || BSU.unsafeIndex bs i == 0x45 = + let !i1 = i + 1 + !eneg = i1 < end && BSU.unsafeIndex bs i1 == 0x2D + !i2 = if i1 < end && (eneg || BSU.unsafeIndex bs i1 == 0x2B) then i1 + 1 else i1 + in if i2 >= end || not (isDigitByte (BSU.unsafeIndex bs i2)) + then none + else + let !ez = skipZeroes bs i2 end + in takeDigits64 bs ez end $ \eEnd e -> + if eEnd /= end + then none + else + if eEnd - ez > 18 + then referenceSlice bs start end0 + else done neg (val * scale eneg (fromIntegral e)) + | otherwise = none + + scale !eneg !ex + | eneg = VU.unsafeIndex recipPow10Table k + | otherwise = VU.unsafeIndex pow10Table k + where + !k = min ex tableMax + {-# INLINE scale #-} + + pow10 !k = VU.unsafeIndex pow10Table (min k tableMax) + {-# INLINE pow10 #-} + + done !neg !v = case if neg then negate v else v of + D# d -> (# 1#, d #) + {-# INLINE done #-} +{-# INLINE parseDoubleField# #-} diff --git a/src/DataFrame/Internal/Parsing/Fast/Int.hs b/src/DataFrame/Internal/Parsing/Fast/Int.hs new file mode 100644 --- /dev/null +++ b/src/DataFrame/Internal/Parsing/Fast/Int.hs @@ -0,0 +1,53 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedTuples #-} + +{- | Non-backtracking @Int@ slice parser, bit-compatible with +@readByteStringInt@ (i.e. @Data.ByteString.Char8.readInt . strip@): +grammar @WS* sign? digit+ WS*@, whole slice consumed, 'Nothing' on +64-bit overflow. +-} +module DataFrame.Internal.Parsing.Fast.Int (parseIntField#) where + +import qualified Data.ByteString as BS +import qualified Data.ByteString.Unsafe as BSU + +import GHC.Exts (Int (..), Int#) + +import DataFrame.Internal.Parsing.Fast.Common + +{- | Result is @(# ok, value #)@ with @ok@ 0 or 1. Caller guarantees +@0 <= start <= end <= length buf@. +-} +parseIntField# :: BS.ByteString -> Int -> Int -> (# Int#, Int# #) +parseIntField# bs start end0 + | i0 >= end = none + | otherwise = + let !c0 = BSU.unsafeIndex bs i0 + !neg = c0 == 0x2D + !i1 = if neg || c0 == 0x2B then i0 + 1 else i0 + in if i1 >= end || not (isDigitByte (BSU.unsafeIndex bs i1)) + then none + else + let !iz = skipZeroes bs i1 end + in takeDigits64 bs iz end $ \dEnd w -> + if dEnd /= end || dEnd - iz > 19 + then none + else + if neg + then + if w <= 9223372036854775808 + then done (negate (fromIntegral w)) + else none + else + if w <= 9223372036854775807 + then done (fromIntegral w) + else none + where + !i0 = skipStrip bs start end0 + !end = skipStripEnd bs i0 end0 + none = (# 0#, 0# #) + done :: Int -> (# Int#, Int# #) + done (I# n) = (# 1#, n #) + {-# INLINE done #-} +{-# INLINE parseIntField# #-} diff --git a/src/DataFrame/Internal/Parsing/Fast/Token.hs b/src/DataFrame/Internal/Parsing/Fast/Token.hs new file mode 100644 --- /dev/null +++ b/src/DataFrame/Internal/Parsing/Fast/Token.hs @@ -0,0 +1,110 @@ +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedTuples #-} + +{- | Byte-level token tests: Bool fields, the canonical missing-token +set, and the default @%Y-%m-%d@ date shape. All length-bucketed with +first-byte dispatch; no Text decode, no list walk. +-} +module DataFrame.Internal.Parsing.Fast.Token ( + parseBoolField#, + isMissingFieldSlice, + isMissingFieldIn, + parseDateFieldSlice, +) where + +import qualified Data.ByteString as BS +import qualified Data.ByteString.Unsafe as BSU + +import Data.Time (Day, fromGregorianValid) +import Data.Word (Word8) +import GHC.Exts (Int#) + +import DataFrame.Internal.Parsing (readByteStringDate) +import DataFrame.Internal.Parsing.Fast.Common (isDigitByte) + +{- | Exactly @True|true|TRUE|False|false|FALSE@, no strip (the +'readByteStringBool' grammar). Result is @(# ok, bool #)@. +-} +parseBoolField# :: BS.ByteString -> Int -> Int -> (# Int#, Int# #) +parseBoolField# bs s e = case e - s of + 4 + | ix 0 == 0x54 && rue 0x72 0x75 0x65 -> (# 1#, 1# #) -- True + | ix 0 == 0x54 && rue 0x52 0x55 0x45 -> (# 1#, 1# #) -- TRUE + | ix 0 == 0x74 && rue 0x72 0x75 0x65 -> (# 1#, 1# #) -- true + 5 + | ix 0 == 0x46 && alse 0x61 0x6C 0x73 0x65 -> (# 1#, 0# #) -- False + | ix 0 == 0x46 && alse 0x41 0x4C 0x53 0x45 -> (# 1#, 0# #) -- FALSE + | ix 0 == 0x66 && alse 0x61 0x6C 0x73 0x65 -> (# 1#, 0# #) -- false + _ -> (# 0#, 0# #) + where + ix d = BSU.unsafeIndex bs (s + d) + rue a b c = ix 1 == a && ix 2 == b && ix 3 == c + alse a b c d = ix 1 == a && ix 2 == b && ix 3 == c && ix 4 == d +{-# INLINE parseBoolField# #-} + +{- | Membership in the canonical missing list +@[\"Nothing\",\"NULL\",\"\",\" \",\"nan\",\"null\",\"N\/A\",\"NaN\",\"NAN\",\"NA\"]@ +(case-sensitive, exact), dispatched on length then first byte. +-} +isMissingFieldSlice :: BS.ByteString -> Int -> Int -> Bool +isMissingFieldSlice bs s e = case e - s of + 0 -> True + 1 -> ix 0 == 0x20 -- " " + 2 -> ix 0 == 0x4E && ix 1 == 0x41 -- NA + 3 -> case ix 0 of + 0x6E -> ix 1 == 0x61 && ix 2 == 0x6E -- nan + 0x4E -> + (ix 2 == 0x4E && (ix 1 == 0x61 || ix 1 == 0x41)) -- NaN NAN + || (ix 1 == 0x2F && ix 2 == 0x41) -- N/A + _ -> False + 4 -> + (ix 0 == 0x4E && ix 1 == 0x55 && ix 2 == 0x4C && ix 3 == 0x4C) -- NULL + || (ix 0 == 0x6E && ix 1 == 0x75 && ix 2 == 0x6C && ix 3 == 0x6C) -- null + 7 -> + ix 0 == 0x4E -- Nothing + && ix 1 == 0x6F + && ix 2 == 0x74 + && ix 3 == 0x68 + && ix 4 == 0x69 + && ix 5 == 0x6E + && ix 6 == 0x67 + _ -> False + where + ix :: Int -> Word8 + ix d = BSU.unsafeIndex bs (s + d) + {-# INLINE ix #-} +{-# INLINE isMissingFieldSlice #-} + +-- | Generic fallback for user-supplied missing-indicator lists. +isMissingFieldIn :: [BS.ByteString] -> BS.ByteString -> Bool +isMissingFieldIn toks f = f `elem` toks +{-# INLINE isMissingFieldIn #-} + +{- | @%Y-%m-%d@: byte-level fast path for the padded 10-byte shape +(@dddd-dd-dd@); anything else (unpadded, whitespace-tolerant, long +years, invalid) falls back to 'readByteStringDate'. +-} +parseDateFieldSlice :: BS.ByteString -> Int -> Int -> Maybe Day +parseDateFieldSlice bs s e + | e - s == 10 + && isDigitByte (ix 0) + && isDigitByte (ix 1) + && isDigitByte (ix 2) + && isDigitByte (ix 3) + && ix 4 == 0x2D + && isDigitByte (ix 5) + && isDigitByte (ix 6) + && ix 7 == 0x2D + && isDigitByte (ix 8) + && isDigitByte (ix 9) = + fromGregorianValid + (toInteger (dig 0 * 1000 + dig 1 * 100 + dig 2 * 10 + dig 3)) + (dig 5 * 10 + dig 6) + (dig 8 * 10 + dig 9) + | otherwise = + readByteStringDate "%Y-%m-%d" (BSU.unsafeTake (e - s) (BSU.unsafeDrop s bs)) + where + ix d = BSU.unsafeIndex bs (s + d) + dig :: Int -> Int + dig d = fromIntegral (ix d) - 0x30 +{-# INLINE parseDateFieldSlice #-} diff --git a/tests/Main.hs b/tests/Main.hs new file mode 100644 --- /dev/null +++ b/tests/Main.hs @@ -0,0 +1,26 @@ +module Main where + +import qualified System.Exit as Exit + +import Test.HUnit +import Test.QuickCheck + +import qualified Properties.FastParsing +import qualified Unit.FastParsing + +isSuccessful :: Result -> Bool +isSuccessful (Success{}) = True +isSuccessful _ = False + +runProp :: (String, Property) -> IO Result +runProp (name, prop) = do + putStrLn ("=== prop " ++ name) + quickCheckWithResult stdArgs{maxSuccess = 20000} prop + +main :: IO () +main = do + result <- runTestTT (TestList Unit.FastParsing.tests) + propsRes <- mapM runProp Properties.FastParsing.tests + if failures result > 0 || errors result > 0 || not (all isSuccessful propsRes) + then Exit.exitFailure + else Exit.exitSuccess diff --git a/tests/Properties/FastParsing.hs b/tests/Properties/FastParsing.hs new file mode 100644 --- /dev/null +++ b/tests/Properties/FastParsing.hs @@ -0,0 +1,246 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} + +{- | QuickCheck parity properties for "DataFrame.Internal.Parsing.Fast". + +Every fast slice parser must agree with the existing reference parser +(`readByteStringInt` / `readByteStringDouble` / `readByteStringBool` / +`readByteStringDate` / `isNullishBS`) on arbitrary byte fields, with +Doubles compared bit-for-bit ('castDoubleToWord64'). +-} +module Properties.FastParsing (tests) where + +import qualified Data.ByteString as BS +import qualified Data.ByteString.Char8 as C +import qualified Data.Text.Encoding as TE + +import Data.Word (Word64, Word8) +import GHC.Float (castDoubleToWord64) +import Test.QuickCheck + +import DataFrame.Internal.Parsing ( + isNullish, + isNullishBS, + readByteStringBool, + readByteStringDate, + readByteStringDouble, + readByteStringInt, + ) +import DataFrame.Internal.Parsing.Fast + +-- | Bytes 'Data.ByteString.Char8.strip' removes (probed over all 256). +stripBytes :: [Word8] +stripBytes = [0x09, 0x0A, 0x0B, 0x0C, 0x0D, 0x20, 0xA0] + +genPad :: Gen BS.ByteString +genPad = + frequency + [ (4, pure BS.empty) + , (3, BS.pack <$> resize 3 (listOf (elements stripBytes))) + ] + +genDigits :: Int -> Int -> Gen BS.ByteString +genDigits lo hi = do + n <- chooseInt (lo, hi) + C.pack <$> vectorOf n (elements "0123456789") + +-- | Digit runs that probe the 18/19/20-digit mantissa window edges. +genDigitRun :: Gen BS.ByteString +genDigitRun = + frequency + [ (6, genDigits 1 17) + , (3, genDigits 18 21) + , (1, genDigits 22 40) + , (2, BS.append <$> genDigits 1 6 <*> pure "") + , + ( 1 + , (BS.append . BS.pack . flip replicate 0x30 <$> chooseInt (1, 25)) + <*> genDigits 0 19 + ) + ] + +genNumeric :: Gen BS.ByteString +genNumeric = do + sign <- elements ["", "-", "+"] + whole <- frequency [(8, genDigitRun), (1, pure "")] + frac <- + frequency + [ (3, pure "") + , (4, BS.append "." <$> genDigitRun) + , (1, pure ".") + ] + ex <- + frequency + [ (4, pure "") + , (3, genExponent) + ] + pre <- genPad + post <- genPad + pure (BS.concat [pre, sign, whole, frac, ex, post]) + where + genExponent = do + e <- elements ["e", "E"] + s <- elements ["", "-", "+"] + ds <- + frequency + [ (6, genDigits 1 3) + , (2, genDigits 4 25) + , (1, pure "") + ] + pure (BS.concat [e, s, ds]) + +genToken :: Gen BS.ByteString +genToken = do + tok <- + elements @BS.ByteString + [ "Nothing" + , "NULL" + , "" + , " " + , "nan" + , "null" + , "N/A" + , "NaN" + , "NAN" + , "NA" + , "True" + , "true" + , "TRUE" + , "False" + , "false" + , "FALSE" + , "Infinity" + , "-Infinity" + , "na" + , "Null" + , "N/a" + , "TRUe" + , "FALSe" + ] + frequency [(4, pure tok), (1, flip BS.append tok <$> genPad)] + +genDateLike :: Gen BS.ByteString +genDateLike = do + y <- chooseInt (0, 12000) + m <- chooseInt (0, 15) + d <- chooseInt (0, 35) + sep <- elements ["-", "/", "-"] + let pad2 n = (if n < 10 then "0" else "") ++ show n + body <- + elements + [ show y ++ "-" ++ pad2 m ++ "-" ++ pad2 d + , show y ++ sep ++ show m ++ sep ++ show d + , pad2 y ++ "-" ++ pad2 m ++ "-" ++ pad2 d + ] + pre <- genPad + post <- genPad + pure (BS.concat [pre, C.pack body, post]) + +genJunk :: Gen BS.ByteString +genJunk = + frequency + [ (3, C.pack <$> resize 12 (listOf (elements "0123456789.eE+- aZ_,"))) + , (1, BS.pack <$> resize 12 (listOf arbitrary)) + ] + +-- | An arbitrary CSV field, weighted towards adversarial numerics. +newtype Field = Field {unField :: BS.ByteString} + deriving (Eq, Show) + +instance Arbitrary Field where + arbitrary = + Field + <$> frequency + [ (6, genNumeric) + , (2, genToken) + , (1, genDateLike) + , (2, genJunk) + ] + shrink (Field b) = map (Field . BS.pack) (shrink (BS.unpack b)) + +bitsOf :: Maybe Double -> Maybe Word64 +bitsOf = fmap castDoubleToWord64 + +-- | Embed a field in junk and parse it through the slice interface. +slicedOn :: + (BS.ByteString -> Int -> Int -> a) -> + BS.ByteString -> + BS.ByteString -> + BS.ByteString -> + a +slicedOn p pre f post = + p (BS.concat [pre, f, post]) (BS.length pre) (BS.length pre + BS.length f) + +prop_intParity :: Field -> Property +prop_intParity (Field f) = parseIntField f === readByteStringInt f + +prop_intShowRoundTrip :: Int -> Property +prop_intShowRoundTrip n = parseIntField (C.pack (show n)) === Just n + +prop_intSlice :: Field -> Field -> Field -> Property +prop_intSlice (Field pre) (Field f) (Field post) = + slicedOn parseIntFieldSlice pre f post === readByteStringInt f + +prop_doubleParity :: Field -> Property +prop_doubleParity (Field f) = + bitsOf (parseDoubleField f) === bitsOf (readByteStringDouble f) + +prop_doubleShowRoundTrip :: Double -> Property +prop_doubleShowRoundTrip d = + let f = C.pack (show d) + in bitsOf (parseDoubleField f) === bitsOf (readByteStringDouble f) + +prop_doubleSlice :: Field -> Field -> Field -> Property +prop_doubleSlice (Field pre) (Field f) (Field post) = + bitsOf (slicedOn parseDoubleFieldSlice pre f post) + === bitsOf (readByteStringDouble f) + +prop_boolParity :: Field -> Property +prop_boolParity (Field f) = parseBoolField f === readByteStringBool f + +prop_boolSlice :: Field -> Field -> Field -> Property +prop_boolSlice (Field pre) (Field f) (Field post) = + slicedOn parseBoolFieldSlice pre f post === readByteStringBool f + +prop_missingParity :: Field -> Property +prop_missingParity (Field f) = isMissingField f === isNullishBS f + +prop_missingTextParity :: Field -> Property +prop_missingTextParity (Field f) = + isMissingField f === isNullish (TE.decodeUtf8Lenient f) + +prop_missingSlice :: Field -> Field -> Field -> Property +prop_missingSlice (Field pre) (Field f) (Field post) = + slicedOn isMissingFieldSlice pre f post === isNullishBS f + +prop_missingIn :: Field -> Property +prop_missingIn (Field f) = + isMissingFieldIn ["NA", "nope", ""] f + === (f `elem` ["NA", "nope", ""]) + +prop_dateParity :: Field -> Property +prop_dateParity (Field f) = + parseDateField f === readByteStringDate "%Y-%m-%d" f + +prop_dateSlice :: Field -> Field -> Field -> Property +prop_dateSlice (Field pre) (Field f) (Field post) = + slicedOn parseDateFieldSlice pre f post + === readByteStringDate "%Y-%m-%d" f + +tests :: [(String, Property)] +tests = + [ ("intParity", property prop_intParity) + , ("intShowRoundTrip", property prop_intShowRoundTrip) + , ("intSlice", property prop_intSlice) + , ("doubleParity", property prop_doubleParity) + , ("doubleShowRoundTrip", property prop_doubleShowRoundTrip) + , ("doubleSlice", property prop_doubleSlice) + , ("boolParity", property prop_boolParity) + , ("boolSlice", property prop_boolSlice) + , ("missingParity", property prop_missingParity) + , ("missingTextParity", property prop_missingTextParity) + , ("missingSlice", property prop_missingSlice) + , ("missingIn", property prop_missingIn) + , ("dateParity", property prop_dateParity) + , ("dateSlice", property prop_dateSlice) + ] diff --git a/tests/Unit/FastParsing.hs b/tests/Unit/FastParsing.hs new file mode 100644 --- /dev/null +++ b/tests/Unit/FastParsing.hs @@ -0,0 +1,224 @@ +{-# LANGUAGE OverloadedStrings #-} + +{- | Pinned adversarial cases for "DataFrame.Internal.Parsing.Fast". + +Each case asserts parity with the reference parsers plus, where the +parser-semantics contract (benchmarks/csv/results/code-audit.md section 2) +pins a concrete value, the value itself. +-} +module Unit.FastParsing (tests) where + +import qualified Data.ByteString as BS + +import Data.Word (Word64) +import GHC.Float (castDoubleToWord64) +import Test.HUnit + +import DataFrame.Internal.Parsing ( + isNullishBS, + readByteStringBool, + readByteStringDate, + readByteStringDouble, + readByteStringInt, + ) +import DataFrame.Internal.Parsing.Fast + +bitsOf :: Maybe Double -> Maybe Word64 +bitsOf = fmap castDoubleToWord64 + +intCases :: [BS.ByteString] +intCases = + [ "" + , "-" + , "+" + , "0" + , "-0" + , "042" + , " \t42\n " + , "- 42" + , "+42" + , "1 2" + , "9223372036854775807" + , "9223372036854775808" + , "-9223372036854775808" + , "-9223372036854775809" + , "00000000000000000000042" + , "18446744073709551616" + , "99999999999999999999999999" + , "12e3" + , "0x10" + , BS.pack [0xA0, 0x34, 0x32, 0xA0] + ] + +doubleCases :: [BS.ByteString] +doubleCases = + [ ".5" + , "+.5" + , "5." + , "5.e3" + , "1e3.5" + , "1_000" + , "1e+3" + , "1E-3" + , " 1.5 " + , "1e999" + , "-1e999" + , "0e999" + , "-0e999" + , "1e-999" + , "0.1" + , "-0" + , "-0.0" + , "2.2250738585072011e-308" + , "1.7976931348623157e308" + , "4.9406564584124654e-324" + , "2.225073858507201e-308" + , "0.30000000000000004" + , "9007199254740993" + , "9007199254740993.9007199254740993" + , "12345678901234567890" + , "12345678901234567890.12345678901234567890" + , "123456789012345678901234567890e-25" + , "1e00000000000000005" + , "1e-00000000000000005" + , "00000000000000000000001.5" + , "1.00000000000000000000005" + , "0.000000000000000000000000000005" + , "1e308" + , "1e309" + , "1e-308" + , "1e-309" + , "1e1023" + , "1e1024" + , "1e1025" + , "1e-1024" + , "1e-1025" + , "Infinity" + , "NaN" + , "1e" + , "1e+" + , "1e-" + , "1.5e " + , "1.2.3" + , "--5" + , "1e18446744073709551617" + ] + +pinnedDoubles :: [(BS.ByteString, Maybe Double)] +pinnedDoubles = + [ ("1e+3", Just 1000) + , (" 1.5 ", Just 1.5) + , ("1e999", Just (1 / 0)) + , ("1e-999", Just 0) + , (".5", Nothing) + , ("5.", Nothing) + , ("1e3.5", Nothing) + , ("1_000", Nothing) + , ("Infinity", Nothing) + , ("NaN", Nothing) + , -- The reference parser is NOT correctly rounded here; bit-exact + -- parity means we must reproduce its 2.2250738585072e-308. + ("2.2250738585072011e-308", Just 2.2250738585072e-308) + ] + +boolCases :: [BS.ByteString] +boolCases = + [ "True" + , "true" + , "TRUE" + , "False" + , "false" + , "FALSE" + , " True" + , "True " + , "TRUe" + , "tRue" + , "FALSe" + , "" + , "T" + , "Truee" + ] + +missingCases :: [BS.ByteString] +missingCases = + [ "Nothing" + , "NULL" + , "" + , " " + , "nan" + , "null" + , "N/A" + , "NaN" + , "NAN" + , "NA" + , "na" + , "Na" + , "Null" + , "N/a" + , " " + , "NULL " + , " NA" + , "Nothing!" + , "nothing" + , "n" + , "N" + ] + +dateCases :: [BS.ByteString] +dateCases = + [ "2024-02-29" + , "2023-02-29" + , "2023-02-30" + , "2023-13-01" + , "2023-00-10" + , "2023-01-00" + , "2023-1-2" + , " 2024-02-29 " + , "0001-01-01" + , "0000-01-01" + , "10000-01-01" + , "2023/01/02" + , "2023-01-023" + , "" + ] + +parityCase :: + (Eq a, Show a) => + String -> (BS.ByteString -> a) -> (BS.ByteString -> a) -> BS.ByteString -> Test +parityCase name fast ref input = + TestLabel (name ++ ": " ++ show input) . TestCase $ + assertEqual (name ++ " parity on " ++ show input) (ref input) (fast input) + +pinnedCase :: BS.ByteString -> Maybe Double -> Test +pinnedCase input expected = + TestLabel ("pinned double: " ++ show input) . TestCase $ + assertEqual + ("pinned value for " ++ show input) + (bitsOf expected) + (bitsOf (parseDoubleField input)) + +tests :: [Test] +tests = + map (parityCase "int" parseIntField readByteStringInt) intCases + ++ map + (parityCase "double" (bitsOf . parseDoubleField) (bitsOf . readByteStringDouble)) + doubleCases + ++ map (uncurry pinnedCase) pinnedDoubles + ++ map (parityCase "bool" parseBoolField readByteStringBool) boolCases + ++ map (parityCase "missing" isMissingField isNullishBS) missingCases + ++ map (parityCase "date" parseDateField (readByteStringDate "%Y-%m-%d")) dateCases + ++ [ TestLabel "int maxBound" . TestCase $ + assertEqual + "maxBound" + (Just (maxBound :: Int)) + (parseIntField "9223372036854775807") + , TestLabel "int overflow" . TestCase $ + assertEqual "maxBound+1" Nothing (parseIntField "9223372036854775808") + , TestLabel "int minBound" . TestCase $ + assertEqual + "minBound" + (Just (minBound :: Int)) + (parseIntField "-9223372036854775808") + , TestLabel "negative zero" . TestCase $ + assertEqual "-0.0 bits" (bitsOf (Just (-0.0))) (bitsOf (parseDoubleField "-0")) + ]