dataframe-parsing 1.0.1.0 → 1.0.2.0

raw patch · 10 files changed

+1222/−5 lines, 10 filesdep +HUnitdep +QuickCheckdep +dataframe-parsingdep ~dataframe-coredep ~textPVP ok

version bump matches the API change (PVP)

Dependencies added: HUnit, QuickCheck, dataframe-parsing, vector

Dependency ranges changed: dataframe-core, text

API changes (from Hackage documentation)

Files

• bench/FieldParsers.hs +175/−0
• dataframe-parsing.cabal +40/−5
• src/DataFrame/Internal/Parsing/Fast.hs +107/−0
• src/DataFrame/Internal/Parsing/Fast/Common.hs +108/−0
• src/DataFrame/Internal/Parsing/Fast/Double.hs +133/−0
• src/DataFrame/Internal/Parsing/Fast/Int.hs +53/−0
• src/DataFrame/Internal/Parsing/Fast/Token.hs +110/−0
• tests/Main.hs +26/−0
• tests/Properties/FastParsing.hs +246/−0
• tests/Unit/FastParsing.hs +224/−0

@@ -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

@@ -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

@@ -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 #-}

@@ -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 #-}

@@ -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# #-}

@@ -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# #-}

@@ -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 #-}

@@ -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

@@ -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)+    ]

@@ -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"))+           ]