diff --git a/dataframe-parsing.cabal b/dataframe-parsing.cabal --- a/dataframe-parsing.cabal +++ b/dataframe-parsing.cabal @@ -1,6 +1,6 @@ -cabal-version: 2.4 +cabal-version: 3.4 name: dataframe-parsing -version: 1.0.2.1 +version: 2.1.1.0 synopsis: Shared text/binary parsing helpers for the dataframe ecosystem. description: Parsing primitives used by the @dataframe@ family: CSV-friendly text @@ -30,24 +30,26 @@ library import: warnings exposed-modules: + DataFrame.Schema DataFrame.Internal.Binary DataFrame.Internal.Parsing DataFrame.Internal.Parsing.Fast + other-modules: + DataFrame.Internal.Schema 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.1, + attoparsec >= 0.12 && < 0.16, + bytestring >= 0.11 && < 0.14, + bytestring-lexing >= 0.5 && < 0.7, + containers >= 0.6.7 && < 0.10, + dataframe-core >= 2.1 && < 2.2, text >= 2.1 && < 3, time >= 1.12 && < 2, - vector >= 0.12 && < 0.14 - hs-source-dirs: src + vector >= 0.12 && < 0.15 + hs-source-dirs: src, src-internal default-language: Haskell2010 test-suite tests @@ -57,9 +59,9 @@ other-modules: Properties.FastParsing Unit.FastParsing build-depends: base >= 4 && < 5, - bytestring >= 0.11 && < 0.13, + bytestring >= 0.11 && < 0.14, dataframe-parsing, - HUnit ^>= 1.6, + HUnit >= 1.6 && < 1.8, QuickCheck >= 2 && < 3, text >= 2.1 && < 3 hs-source-dirs: tests @@ -71,11 +73,11 @@ type: exitcode-stdio-1.0 main-is: FieldParsers.hs build-depends: base >= 4 && < 5, - bytestring >= 0.11 && < 0.13, + bytestring >= 0.11 && < 0.14, dataframe-parsing, text >= 2.1 && < 3, time >= 1.12 && < 2, - vector >= 0.12 && < 0.14 + vector >= 0.12 && < 0.15 hs-source-dirs: bench ghc-options: -O2 default-language: Haskell2010 diff --git a/src-internal/DataFrame/Internal/Binary.hs b/src-internal/DataFrame/Internal/Binary.hs new file mode 100644 --- /dev/null +++ b/src-internal/DataFrame/Internal/Binary.hs @@ -0,0 +1,94 @@ +{-# LANGUAGE BangPatterns #-} + +module DataFrame.Internal.Binary where + +import Data.Bits (Bits (unsafeShiftL, (.|.))) +import Data.ByteString (toStrict) +import qualified Data.ByteString as BS +import Data.ByteString.Builder (toLazyByteString, word32LE, word64LE) +import qualified Data.ByteString.Unsafe as BS +import Data.Int (Int32) +import Data.Word (Word32, Word64, Word8) + +littleEndianWord32 :: BS.ByteString -> Word32 +littleEndianWord32 bytes + | len >= 4 = + assembleWord32 + (BS.unsafeIndex bytes 0) + (BS.unsafeIndex bytes 1) + (BS.unsafeIndex bytes 2) + (BS.unsafeIndex bytes 3) + | otherwise = + assembleWord32 + (byteAtOrZero len bytes 0) + (byteAtOrZero len bytes 1) + (byteAtOrZero len bytes 2) + (byteAtOrZero len bytes 3) + where + len = BS.length bytes +{-# INLINE littleEndianWord32 #-} + +littleEndianWord64 :: BS.ByteString -> Word64 +littleEndianWord64 bytes + | len >= 8 = + assembleWord64 + (BS.index bytes 0) + (BS.index bytes 1) + (BS.index bytes 2) + (BS.index bytes 3) + (BS.index bytes 4) + (BS.index bytes 5) + (BS.index bytes 6) + (BS.index bytes 7) + | otherwise = + assembleWord64 + (byteAtOrZero len bytes 0) + (byteAtOrZero len bytes 1) + (byteAtOrZero len bytes 2) + (byteAtOrZero len bytes 3) + (byteAtOrZero len bytes 4) + (byteAtOrZero len bytes 5) + (byteAtOrZero len bytes 6) + (byteAtOrZero len bytes 7) + where + len = BS.length bytes +{-# INLINE littleEndianWord64 #-} + +littleEndianInt32 :: BS.ByteString -> Int32 +littleEndianInt32 = fromIntegral . littleEndianWord32 +{-# INLINE littleEndianInt32 #-} + +word64ToLittleEndian :: Word64 -> BS.ByteString +word64ToLittleEndian = toStrict . toLazyByteString . word64LE +{-# INLINE word64ToLittleEndian #-} + +word32ToLittleEndian :: Word32 -> BS.ByteString +word32ToLittleEndian = toStrict . toLazyByteString . word32LE +{-# INLINE word32ToLittleEndian #-} + +byteAtOrZero :: Int -> BS.ByteString -> Int -> Word8 +byteAtOrZero len bytes i + | i >= 0 && i < len = BS.unsafeIndex bytes i + | otherwise = 0 +{-# INLINE byteAtOrZero #-} + +assembleWord32 :: Word8 -> Word8 -> Word8 -> Word8 -> Word32 +assembleWord32 !b0 !b1 !b2 !b3 = + fromIntegral b0 + .|. (fromIntegral b1 `unsafeShiftL` 8) + .|. (fromIntegral b2 `unsafeShiftL` 16) + .|. (fromIntegral b3 `unsafeShiftL` 24) +{-# INLINE assembleWord32 #-} + +assembleWord64 :: + Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word64 +assembleWord64 !b0 !b1 !b2 !b3 !b4 !b5 !b6 !b7 = + fromIntegral b0 + .|. (fromIntegral b1 `unsafeShiftL` 8) + .|. (fromIntegral b2 `unsafeShiftL` 16) + .|. (fromIntegral b3 `unsafeShiftL` 24) + .|. (fromIntegral b4 `unsafeShiftL` 32) + .|. (fromIntegral b5 `unsafeShiftL` 40) + .|. (fromIntegral b6 `unsafeShiftL` 48) + .|. (fromIntegral b7 `unsafeShiftL` 56) +{-# INLINE assembleWord64 #-} diff --git a/src-internal/DataFrame/Internal/Parsing.hs b/src-internal/DataFrame/Internal/Parsing.hs new file mode 100644 --- /dev/null +++ b/src-internal/DataFrame/Internal/Parsing.hs @@ -0,0 +1,238 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module DataFrame.Internal.Parsing where + +import qualified Data.ByteString.Char8 as C +import qualified Data.Set as S +import qualified Data.Text as T +import qualified Data.Text.IO as TIO + +import Control.Applicative (many, (<|>)) +import Data.Attoparsec.Text hiding (decimal, double, signed) +import Data.ByteString.Lex.Fractional +import Data.Foldable (fold) +import Data.Text.Read (decimal, double, signed) +import Data.Time (Day, defaultTimeLocale, parseTimeM) +import GHC.Stack (HasCallStack) +import System.IO (Handle, IOMode (..), hIsEOF, hTell, withFile) +import Prelude hiding (takeWhile) + +isNullish :: T.Text -> Bool +isNullish = + ( `S.member` + S.fromList + ["Nothing", "NULL", "", " ", "nan", "null", "N/A", "NaN", "NAN", "NA"] + ) + +isNullishBS :: C.ByteString -> Bool +isNullishBS = + ( `S.member` + S.fromList + ["Nothing", "NULL", "", " ", "nan", "null", "N/A", "NaN", "NAN", "NA"] + ) + +isTrueish :: T.Text -> Bool +isTrueish t = t `elem` ["True", "true", "TRUE"] + +isFalseish :: T.Text -> Bool +isFalseish t = t `elem` ["False", "false", "FALSE"] + +readBool :: (HasCallStack) => T.Text -> Maybe Bool +readBool s + | isTrueish s = Just True + | isFalseish s = Just False + | otherwise = Nothing + +readByteStringBool :: C.ByteString -> Maybe Bool +readByteStringBool s + | s `elem` ["True", "true", "TRUE"] = Just True + | s `elem` ["False", "false", "FALSE"] = Just False + | otherwise = Nothing + +readByteStringDate :: String -> C.ByteString -> Maybe Day +readByteStringDate fmt = parseTimeM True defaultTimeLocale fmt . C.unpack + +readInteger :: (HasCallStack) => T.Text -> Maybe Integer +readInteger s = case signed decimal (T.strip s) of + Left _ -> Nothing + Right (value, "") -> Just value + Right (_value, _) -> Nothing + +readInt :: (HasCallStack) => T.Text -> Maybe Int +readInt s = case signed decimal (T.strip s) of + Left _ -> Nothing + Right (value, "") -> Just value + Right (_value, _) -> Nothing +{-# INLINE readInt #-} + +readByteStringInt :: (HasCallStack) => C.ByteString -> Maybe Int +#if MIN_VERSION_bytestring(0,12,0) +-- bytestring >= 0.12: 'C.readInt' returns 'Nothing' on overflow. +readByteStringInt s = case C.readInt (C.strip s) of + Just (value, "") -> Just value + _ -> Nothing +#else +-- bytestring < 0.12: 'C.readInt' silently wraps on overflow. Fields of +-- <= 18 characters fit in an 'Int' and keep the fast path; longer ones fall +-- back to arbitrary-precision 'C.readInteger' with a range check. +readByteStringInt s + | C.length t <= 18 = case C.readInt t of + Just (value, "") -> Just value + _ -> Nothing + | otherwise = case C.readInteger t of + Just (value, "") + | value >= toInteger (minBound :: Int) + , value <= toInteger (maxBound :: Int) -> + Just (fromInteger value) + _ -> Nothing + where + t = C.strip s +#endif +{-# INLINE readByteStringInt #-} + +readByteStringDouble :: (HasCallStack) => C.ByteString -> Maybe Double +readByteStringDouble s = + let + readFunc = if C.any (\c -> c == 'e' || c == 'E') s then readExponential else readDecimal + in + case readSigned readFunc (C.strip s) of + Nothing -> Nothing + Just (value, "") -> Just value + Just (_value, _) -> Nothing +{-# INLINE readByteStringDouble #-} + +readDouble :: (HasCallStack) => T.Text -> Maybe Double +readDouble s = + case signed double s of + Left _ -> Nothing + Right (value, "") -> Just value + Right (_value, _) -> Nothing +{-# INLINE readDouble #-} + +readIntegerEither :: (HasCallStack) => T.Text -> Either T.Text Integer +readIntegerEither s = case signed decimal (T.strip s) of + Left _ -> Left s + Right (value, "") -> Right value + Right (_value, _) -> Left s +{-# INLINE readIntegerEither #-} + +readIntEither :: (HasCallStack) => T.Text -> Either T.Text Int +readIntEither s = case signed decimal (T.strip s) of + Left _ -> Left s + Right (value, "") -> Right value + Right (_value, _) -> Left s +{-# INLINE readIntEither #-} + +readDoubleEither :: (HasCallStack) => T.Text -> Either T.Text Double +readDoubleEither s = + case signed double s of + Left _ -> Left s + Right (value, "") -> Right value + Right (_value, _) -> Left s +{-# INLINE readDoubleEither #-} + +-- --------------------------------------------------------------------------- +-- Attoparsec CSV parser combinators (shared between Lazy.IO.CSV and others) +-- --------------------------------------------------------------------------- + +parseSep :: Char -> T.Text -> [T.Text] +parseSep c s = either error id (parseOnly (record c) s) +{-# INLINE parseSep #-} + +record :: Char -> Parser [T.Text] +record c = + field c `sepBy1` char c + "record" +{-# INLINE record #-} + +parseRow :: Char -> Parser [T.Text] +parseRow c = (record c <* lineEnd) "record-new-line" + +field :: Char -> Parser T.Text +field c = + quotedField <|> unquotedField c + "field" +{-# INLINE field #-} + +unquotedTerminators :: Char -> S.Set Char +unquotedTerminators sep = S.fromList [sep, '\n', '\r', '"'] + +unquotedField :: Char -> Parser T.Text +unquotedField sep = + takeWhile (not . (`S.member` terminators)) "unquoted field" + where + terminators = unquotedTerminators sep +{-# INLINE unquotedField #-} + +quotedField :: Parser T.Text +quotedField = char '"' *> contents <* char '"' "quoted field" + where + contents = fold <$> many (unquote <|> unescape) + where + unquote = takeWhile1 (notInClass "\"\\") + unescape = + char '\\' *> do + T.singleton <$> do + char '\\' <|> char '"' +{-# INLINE quotedField #-} + +lineEnd :: Parser () +lineEnd = + (endOfLine <|> endOfInput) + "end of line" +{-# INLINE lineEnd #-} + +-- | First pass to count rows for exact allocation. +countRows :: Char -> FilePath -> IO Int +countRows c path = withFile path ReadMode $! go 0 "" + where + go n input h = do + isEOF <- hIsEOF h + if isEOF && input == mempty + then pure n + else + parseWith (TIO.hGetChunk h) (parseRow c) input >>= \case + Fail unconsumed ctx er -> do + erpos <- hTell h + fail $ + "Failed to parse CSV file around " + <> show erpos + <> " byte; due: " + <> show er + <> "; context: " + <> show ctx + <> " " + <> show unconsumed + Partial _ -> fail $ "Partial handler is called; n = " <> show n + Done (unconsumed :: T.Text) _ -> + go (n + 1) unconsumed h +{-# INLINE countRows #-} + +-- | Infer the Haskell type name from a text sample. +inferValueType :: T.Text -> T.Text +inferValueType s = case readInt s of + Just _ -> "Int" + Nothing -> case readDouble s of + Just _ -> "Double" + Nothing -> "Other" +{-# INLINE inferValueType #-} + +-- | Read a single CSV row from a handle using the given separator. +readSingleLine :: Char -> T.Text -> Handle -> IO ([T.Text], T.Text) +readSingleLine c unused handle = + parseWith (TIO.hGetChunk handle) (parseRow c) unused >>= \case + Fail _unconsumed ctx er -> do + erpos <- hTell handle + fail $ + "Failed to parse CSV file around " + <> show erpos + <> " byte; due: " + <> show er + <> "; context: " + <> show ctx + Partial _ -> fail "Partial handler is called" + Done (unconsumed :: T.Text) (row :: [T.Text]) -> + return (row, unconsumed) diff --git a/src-internal/DataFrame/Internal/Parsing/Fast.hs b/src-internal/DataFrame/Internal/Parsing/Fast.hs new file mode 100644 --- /dev/null +++ b/src-internal/DataFrame/Internal/Parsing/Fast.hs @@ -0,0 +1,100 @@ +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedTuples #-} + +{- | Fast, non-backtracking field parsers for CSV ingest. Each is a pure +function over a @(buf, start, end)@ byte slice, bit-exact with the reference +parsers in "DataFrame.Internal.Parsing". Unboxed @#@ variants avoid boxing. +-} +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-internal/DataFrame/Internal/Parsing/Fast/Common.hs b/src-internal/DataFrame/Internal/Parsing/Fast/Common.hs new file mode 100644 --- /dev/null +++ b/src-internal/DataFrame/Internal/Parsing/Fast/Common.hs @@ -0,0 +1,103 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} + +{- | Shared byte-level helpers for the fast slice parsers. All operate on +@(buf, start, end)@ slices; the caller guarantees +@0 <= start <= end <= length buf@ so 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 continuation. Callers must bound the +significant digit count before trusting the value. +-} +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-internal/DataFrame/Internal/Parsing/Fast/Double.hs b/src-internal/DataFrame/Internal/Parsing/Fast/Double.hs new file mode 100644 --- /dev/null +++ b/src-internal/DataFrame/Internal/Parsing/Fast/Double.hs @@ -0,0 +1,124 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedTuples #-} + +{- | Fast @Double@ slice parser, bit-exact with @readByteStringDouble@. +Replays the reference parser's exact floating-point operations via 'Word64' +digit accumulation and 10^k tables, falling back when exactness is in doubt. +-} +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. 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-internal/DataFrame/Internal/Parsing/Fast/Int.hs b/src-internal/DataFrame/Internal/Parsing/Fast/Int.hs new file mode 100644 --- /dev/null +++ b/src-internal/DataFrame/Internal/Parsing/Fast/Int.hs @@ -0,0 +1,52 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedTuples #-} + +{- | Non-backtracking @Int@ slice parser, bit-compatible with +@readByteStringInt@: 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-internal/DataFrame/Internal/Parsing/Fast/Token.hs b/src-internal/DataFrame/Internal/Parsing/Fast/Token.hs new file mode 100644 --- /dev/null +++ b/src-internal/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# #) + | ix 0 == 0x54 && rue 0x52 0x55 0x45 -> (# 1#, 1# #) + | ix 0 == 0x74 && rue 0x72 0x75 0x65 -> (# 1#, 1# #) + 5 + | ix 0 == 0x46 && alse 0x61 0x6C 0x73 0x65 -> (# 1#, 0# #) + | ix 0 == 0x46 && alse 0x41 0x4C 0x53 0x45 -> (# 1#, 0# #) + | ix 0 == 0x66 && alse 0x61 0x6C 0x73 0x65 -> (# 1#, 0# #) + _ -> (# 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 + 3 -> case ix 0 of + 0x6E -> ix 1 == 0x61 && ix 2 == 0x6E + 0x4E -> + (ix 2 == 0x4E && (ix 1 == 0x61 || ix 1 == 0x41)) + || (ix 1 == 0x2F && ix 2 == 0x41) + _ -> False + 4 -> + (ix 0 == 0x4E && ix 1 == 0x55 && ix 2 == 0x4C && ix 3 == 0x4C) + || (ix 0 == 0x6E && ix 1 == 0x75 && ix 2 == 0x6C && ix 3 == 0x6C) + 7 -> + ix 0 == 0x4E + && 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/src/DataFrame/Internal/Binary.hs b/src/DataFrame/Internal/Binary.hs deleted file mode 100644 --- a/src/DataFrame/Internal/Binary.hs +++ /dev/null @@ -1,94 +0,0 @@ -{-# LANGUAGE BangPatterns #-} - -module DataFrame.Internal.Binary where - -import Data.Bits (Bits (unsafeShiftL, (.|.))) -import Data.ByteString (toStrict) -import qualified Data.ByteString as BS -import Data.ByteString.Builder (toLazyByteString, word32LE, word64LE) -import qualified Data.ByteString.Unsafe as BS -import Data.Int (Int32) -import Data.Word (Word32, Word64, Word8) - -littleEndianWord32 :: BS.ByteString -> Word32 -littleEndianWord32 bytes - | len >= 4 = - assembleWord32 - (BS.unsafeIndex bytes 0) - (BS.unsafeIndex bytes 1) - (BS.unsafeIndex bytes 2) - (BS.unsafeIndex bytes 3) - | otherwise = - assembleWord32 - (byteAtOrZero len bytes 0) - (byteAtOrZero len bytes 1) - (byteAtOrZero len bytes 2) - (byteAtOrZero len bytes 3) - where - len = BS.length bytes -{-# INLINE littleEndianWord32 #-} - -littleEndianWord64 :: BS.ByteString -> Word64 -littleEndianWord64 bytes - | len >= 8 = - assembleWord64 - (BS.index bytes 0) - (BS.index bytes 1) - (BS.index bytes 2) - (BS.index bytes 3) - (BS.index bytes 4) - (BS.index bytes 5) - (BS.index bytes 6) - (BS.index bytes 7) - | otherwise = - assembleWord64 - (byteAtOrZero len bytes 0) - (byteAtOrZero len bytes 1) - (byteAtOrZero len bytes 2) - (byteAtOrZero len bytes 3) - (byteAtOrZero len bytes 4) - (byteAtOrZero len bytes 5) - (byteAtOrZero len bytes 6) - (byteAtOrZero len bytes 7) - where - len = BS.length bytes -{-# INLINE littleEndianWord64 #-} - -littleEndianInt32 :: BS.ByteString -> Int32 -littleEndianInt32 = fromIntegral . littleEndianWord32 -{-# INLINE littleEndianInt32 #-} - -word64ToLittleEndian :: Word64 -> BS.ByteString -word64ToLittleEndian = toStrict . toLazyByteString . word64LE -{-# INLINE word64ToLittleEndian #-} - -word32ToLittleEndian :: Word32 -> BS.ByteString -word32ToLittleEndian = toStrict . toLazyByteString . word32LE -{-# INLINE word32ToLittleEndian #-} - -byteAtOrZero :: Int -> BS.ByteString -> Int -> Word8 -byteAtOrZero len bytes i - | i >= 0 && i < len = BS.unsafeIndex bytes i - | otherwise = 0 -{-# INLINE byteAtOrZero #-} - -assembleWord32 :: Word8 -> Word8 -> Word8 -> Word8 -> Word32 -assembleWord32 !b0 !b1 !b2 !b3 = - fromIntegral b0 - .|. (fromIntegral b1 `unsafeShiftL` 8) - .|. (fromIntegral b2 `unsafeShiftL` 16) - .|. (fromIntegral b3 `unsafeShiftL` 24) -{-# INLINE assembleWord32 #-} - -assembleWord64 :: - Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word64 -assembleWord64 !b0 !b1 !b2 !b3 !b4 !b5 !b6 !b7 = - fromIntegral b0 - .|. (fromIntegral b1 `unsafeShiftL` 8) - .|. (fromIntegral b2 `unsafeShiftL` 16) - .|. (fromIntegral b3 `unsafeShiftL` 24) - .|. (fromIntegral b4 `unsafeShiftL` 32) - .|. (fromIntegral b5 `unsafeShiftL` 40) - .|. (fromIntegral b6 `unsafeShiftL` 48) - .|. (fromIntegral b7 `unsafeShiftL` 56) -{-# INLINE assembleWord64 #-} diff --git a/src/DataFrame/Internal/Parsing.hs b/src/DataFrame/Internal/Parsing.hs deleted file mode 100644 --- a/src/DataFrame/Internal/Parsing.hs +++ /dev/null @@ -1,238 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} - -module DataFrame.Internal.Parsing where - -import qualified Data.ByteString.Char8 as C -import qualified Data.Set as S -import qualified Data.Text as T -import qualified Data.Text.IO as TIO - -import Control.Applicative (many, (<|>)) -import Data.Attoparsec.Text hiding (decimal, double, signed) -import Data.ByteString.Lex.Fractional -import Data.Foldable (fold) -import Data.Text.Read (decimal, double, signed) -import Data.Time (Day, defaultTimeLocale, parseTimeM) -import GHC.Stack (HasCallStack) -import System.IO (Handle, IOMode (..), hIsEOF, hTell, withFile) -import Prelude hiding (takeWhile) - -isNullish :: T.Text -> Bool -isNullish = - ( `S.member` - S.fromList - ["Nothing", "NULL", "", " ", "nan", "null", "N/A", "NaN", "NAN", "NA"] - ) - -isNullishBS :: C.ByteString -> Bool -isNullishBS = - ( `S.member` - S.fromList - ["Nothing", "NULL", "", " ", "nan", "null", "N/A", "NaN", "NAN", "NA"] - ) - -isTrueish :: T.Text -> Bool -isTrueish t = t `elem` ["True", "true", "TRUE"] - -isFalseish :: T.Text -> Bool -isFalseish t = t `elem` ["False", "false", "FALSE"] - -readBool :: (HasCallStack) => T.Text -> Maybe Bool -readBool s - | isTrueish s = Just True - | isFalseish s = Just False - | otherwise = Nothing - -readByteStringBool :: C.ByteString -> Maybe Bool -readByteStringBool s - | s `elem` ["True", "true", "TRUE"] = Just True - | s `elem` ["False", "false", "FALSE"] = Just False - | otherwise = Nothing - -readByteStringDate :: String -> C.ByteString -> Maybe Day -readByteStringDate fmt = parseTimeM True defaultTimeLocale fmt . C.unpack - -readInteger :: (HasCallStack) => T.Text -> Maybe Integer -readInteger s = case signed decimal (T.strip s) of - Left _ -> Nothing - Right (value, "") -> Just value - Right (_value, _) -> Nothing - -readInt :: (HasCallStack) => T.Text -> Maybe Int -readInt s = case signed decimal (T.strip s) of - Left _ -> Nothing - Right (value, "") -> Just value - Right (_value, _) -> Nothing -{-# INLINE readInt #-} - -readByteStringInt :: (HasCallStack) => C.ByteString -> Maybe Int -#if MIN_VERSION_bytestring(0,12,0) --- bytestring >= 0.12: 'C.readInt' returns 'Nothing' on overflow. -readByteStringInt s = case C.readInt (C.strip s) of - Just (value, "") -> Just value - _ -> Nothing -#else --- bytestring < 0.12: 'C.readInt' silently wraps on overflow. Fields of --- <= 18 characters fit in an 'Int' and keep the fast path; longer ones fall --- back to arbitrary-precision 'C.readInteger' with a range check. -readByteStringInt s - | C.length t <= 18 = case C.readInt t of - Just (value, "") -> Just value - _ -> Nothing - | otherwise = case C.readInteger t of - Just (value, "") - | value >= toInteger (minBound :: Int) - , value <= toInteger (maxBound :: Int) -> - Just (fromInteger value) - _ -> Nothing - where - t = C.strip s -#endif -{-# INLINE readByteStringInt #-} - -readByteStringDouble :: (HasCallStack) => C.ByteString -> Maybe Double -readByteStringDouble s = - let - readFunc = if C.any (\c -> c == 'e' || c == 'E') s then readExponential else readDecimal - in - case readSigned readFunc (C.strip s) of - Nothing -> Nothing - Just (value, "") -> Just value - Just (_value, _) -> Nothing -{-# INLINE readByteStringDouble #-} - -readDouble :: (HasCallStack) => T.Text -> Maybe Double -readDouble s = - case signed double s of - Left _ -> Nothing - Right (value, "") -> Just value - Right (_value, _) -> Nothing -{-# INLINE readDouble #-} - -readIntegerEither :: (HasCallStack) => T.Text -> Either T.Text Integer -readIntegerEither s = case signed decimal (T.strip s) of - Left _ -> Left s - Right (value, "") -> Right value - Right (_value, _) -> Left s -{-# INLINE readIntegerEither #-} - -readIntEither :: (HasCallStack) => T.Text -> Either T.Text Int -readIntEither s = case signed decimal (T.strip s) of - Left _ -> Left s - Right (value, "") -> Right value - Right (_value, _) -> Left s -{-# INLINE readIntEither #-} - -readDoubleEither :: (HasCallStack) => T.Text -> Either T.Text Double -readDoubleEither s = - case signed double s of - Left _ -> Left s - Right (value, "") -> Right value - Right (_value, _) -> Left s -{-# INLINE readDoubleEither #-} - --- --------------------------------------------------------------------------- --- Attoparsec CSV parser combinators (shared between Lazy.IO.CSV and others) --- --------------------------------------------------------------------------- - -parseSep :: Char -> T.Text -> [T.Text] -parseSep c s = either error id (parseOnly (record c) s) -{-# INLINE parseSep #-} - -record :: Char -> Parser [T.Text] -record c = - field c `sepBy1` char c - "record" -{-# INLINE record #-} - -parseRow :: Char -> Parser [T.Text] -parseRow c = (record c <* lineEnd) "record-new-line" - -field :: Char -> Parser T.Text -field c = - quotedField <|> unquotedField c - "field" -{-# INLINE field #-} - -unquotedTerminators :: Char -> S.Set Char -unquotedTerminators sep = S.fromList [sep, '\n', '\r', '"'] - -unquotedField :: Char -> Parser T.Text -unquotedField sep = - takeWhile (not . (`S.member` terminators)) "unquoted field" - where - terminators = unquotedTerminators sep -{-# INLINE unquotedField #-} - -quotedField :: Parser T.Text -quotedField = char '"' *> contents <* char '"' "quoted field" - where - contents = fold <$> many (unquote <|> unescape) - where - unquote = takeWhile1 (notInClass "\"\\") - unescape = - char '\\' *> do - T.singleton <$> do - char '\\' <|> char '"' -{-# INLINE quotedField #-} - -lineEnd :: Parser () -lineEnd = - (endOfLine <|> endOfInput) - "end of line" -{-# INLINE lineEnd #-} - --- | First pass to count rows for exact allocation. -countRows :: Char -> FilePath -> IO Int -countRows c path = withFile path ReadMode $! go 0 "" - where - go n input h = do - isEOF <- hIsEOF h - if isEOF && input == mempty - then pure n - else - parseWith (TIO.hGetChunk h) (parseRow c) input >>= \case - Fail unconsumed ctx er -> do - erpos <- hTell h - fail $ - "Failed to parse CSV file around " - <> show erpos - <> " byte; due: " - <> show er - <> "; context: " - <> show ctx - <> " " - <> show unconsumed - Partial _ -> fail $ "Partial handler is called; n = " <> show n - Done (unconsumed :: T.Text) _ -> - go (n + 1) unconsumed h -{-# INLINE countRows #-} - --- | Infer the Haskell type name from a text sample. -inferValueType :: T.Text -> T.Text -inferValueType s = case readInt s of - Just _ -> "Int" - Nothing -> case readDouble s of - Just _ -> "Double" - Nothing -> "Other" -{-# INLINE inferValueType #-} - --- | Read a single CSV row from a handle using the given separator. -readSingleLine :: Char -> T.Text -> Handle -> IO ([T.Text], T.Text) -readSingleLine c unused handle = - parseWith (TIO.hGetChunk handle) (parseRow c) unused >>= \case - Fail _unconsumed ctx er -> do - erpos <- hTell handle - fail $ - "Failed to parse CSV file around " - <> show erpos - <> " byte; due: " - <> show er - <> "; context: " - <> show ctx - Partial _ -> fail "Partial handler is called" - Done (unconsumed :: T.Text) (row :: [T.Text]) -> - return (row, unconsumed) diff --git a/src/DataFrame/Internal/Parsing/Fast.hs b/src/DataFrame/Internal/Parsing/Fast.hs deleted file mode 100644 --- a/src/DataFrame/Internal/Parsing/Fast.hs +++ /dev/null @@ -1,107 +0,0 @@ -{-# 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 deleted file mode 100644 --- a/src/DataFrame/Internal/Parsing/Fast/Common.hs +++ /dev/null @@ -1,108 +0,0 @@ -{-# 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 deleted file mode 100644 --- a/src/DataFrame/Internal/Parsing/Fast/Double.hs +++ /dev/null @@ -1,133 +0,0 @@ -{-# 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 deleted file mode 100644 --- a/src/DataFrame/Internal/Parsing/Fast/Int.hs +++ /dev/null @@ -1,53 +0,0 @@ -{-# 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 deleted file mode 100644 --- a/src/DataFrame/Internal/Parsing/Fast/Token.hs +++ /dev/null @@ -1,110 +0,0 @@ -{-# 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/src/DataFrame/Internal/Schema.hs b/src/DataFrame/Internal/Schema.hs --- a/src/DataFrame/Internal/Schema.hs +++ b/src/DataFrame/Internal/Schema.hs @@ -1,10 +1,14 @@ {-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} {- | Runtime schema representation. The Template-Haskell @deriveSchema@ splice @@ -16,14 +20,18 @@ schemaType, Schema (..), makeSchema, + RuntimeSchema (..), ) where +import Data.Kind (Type) import qualified Data.Map as M import Data.Maybe (isJust) import qualified Data.Proxy as P import qualified Data.Text as T import Data.Type.Equality (TestEquality (..)) import DataFrame.Internal.Column (Columnable) +import DataFrame.Typed.Types (Column) +import GHC.TypeLits (KnownSymbol, symbolVal) import Type.Reflection (typeRep) -- | A runtime tag for a column’s element type. @@ -86,3 +94,32 @@ -- | Construct a 'Schema' from a list of @(columnName, schemaType)@ pairs. makeSchema :: [(T.Text, SchemaType)] -> Schema makeSchema = Schema . M.fromList + +{- | The runtime 'Schema' behind a type-level schema — names /and/ element +types — so a reader can project to a schema's columns and skip inference for +them in one step. + +Every column type must have a 'Read' instance, which 'Columnable' does not +imply; that is what lets the names carry their types across to a reader. + +==== __Examples__ +>>> :set -XTypeApplications -XDataKinds +>>> elements (runtimeSchema @'[Column "n" Int]) +fromList [("n",Int)] +-} +class RuntimeSchema (cols :: [Type]) where + runtimeSchema :: Schema + +instance RuntimeSchema '[] where + runtimeSchema = makeSchema [] + +instance + (KnownSymbol name, Columnable a, Read a, RuntimeSchema rest) => + RuntimeSchema (Column name a ': rest) + where + runtimeSchema = + Schema $ + M.insert + (T.pack (symbolVal (P.Proxy @name))) + (schemaType @a) + (elements (runtimeSchema @rest)) diff --git a/src/DataFrame/Schema.hs b/src/DataFrame/Schema.hs new file mode 100644 --- /dev/null +++ b/src/DataFrame/Schema.hs @@ -0,0 +1,9 @@ +{- | The runtime schema surface for the @dataframe@ ecosystem: the 'Schema' +tag, its element types, and builders to describe a frame's columns by name. +Re-exported so callers never reach into @DataFrame.Internal.Schema@. +-} +module DataFrame.Schema ( + module DataFrame.Internal.Schema, +) where + +import DataFrame.Internal.Schema