diff --git a/flatparse.cabal b/flatparse.cabal --- a/flatparse.cabal +++ b/flatparse.cabal @@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.35.2. +-- This file has been generated from package.yaml by hpack version 0.36.0. -- -- see: https://github.com/sol/hpack name: flatparse -version: 0.5.0.1 +version: 0.5.0.2 synopsis: High-performance parsing from strict bytestrings description: @Flatparse@ is a high-performance parsing library for strict bytestring input. See the README for more information: . diff --git a/src/FlatParse/Basic.hs b/src/FlatParse/Basic.hs --- a/src/FlatParse/Basic.hs +++ b/src/FlatParse/Basic.hs @@ -3,6 +3,7 @@ {-# LANGUAGE KindSignatures #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE ScopedTypeVariables #-} {-| Parser supporting custom error types and embeddable `IO` or `ST` actions, but @@ -22,6 +23,7 @@ , runParserUtf8 , runParserIO , runParserST + , embedParserST -- ** Primitive result types , type FP.Parser.Res# @@ -73,6 +75,7 @@ , FP.Base.withEnsure1 , FP.Base.withEnsure# , FP.Base.isolate + , isolateToNextNull , FP.Base.isolate# , FP.Base.isolateUnsafe# , FP.Switch.switch @@ -259,6 +262,11 @@ (# st, a #) -> OK# st a s {-# inline liftST #-} +-- | Run a `ParserST` inside a pure parser. +embedParserST :: forall e a. (forall s. ParserST s e a) -> Parser e a +embedParserST f = unsafeCoerce# (f :: ParserST RealWorld e a) +{-# inline embedParserST #-} + -------------------------------------------------------------------------------- -- | Parse a given 'B.ByteString'. @@ -437,26 +445,81 @@ -------------------------------------------------------------------------------- --- | Read a null-terminated bytestring (a C-style string). +-- | Isolate the given parser up to (excluding) the next null byte. -- --- Consumes the null terminator. -anyCString :: ParserT st e B.ByteString -anyCString = ParserT go' +-- Like 'isolate', all isolated bytes must be consumed. The null byte is +-- consumed afterwards. +-- +-- Useful for defining parsers for null-terminated data. +isolateToNextNull :: ParserT st e a -> ParserT st e a +isolateToNextNull (ParserT p) = ParserT \fp eob s st -> go fp eob s st s where - go' fp eob s0 st = go 0# s0 - where - go n# s = case eqAddr# eob s of - 1# -> Fail# st + goP fp sNull s0 st = + case p fp sNull s0 st of + OK# st' a s' -> + case eqAddr# s' sNull of + 1# -> -- consumed up to null: skip null, return + OK# st' a (sNull `plusAddr#` 1#) + _ -> Fail# st' -- didn't consume fully up to null: fail + x -> x + + go8 fp eob s0 st s = + case eqAddr# eob s of + 1# -> Fail# st -- end of input, no null: fail _ -> - let s' = plusAddr# s 1# + let s' = s `plusAddr#` 1# in #if MIN_VERSION_base(4,16,0) - -- TODO below is a candidate for improving with ExtendedLiterals! - in case eqWord8# (indexWord8OffAddr# s 0#) (wordToWord8# 0##) of + -- below may be made clearer with ExtendedLiterals (GHC 9.8) + case eqWord8# (indexWord8OffAddr# s 0#) (wordToWord8# 0##) of #else - in case eqWord# (indexWord8OffAddr# s 0#) 0## of + case eqWord# (indexWord8OffAddr# s 0#) 0## of #endif - 1# -> OK# st (B.PS (ForeignPtr s0 fp) 0 (I# n#)) s' - _ -> go (n# +# 1#) s' + 1# -> goP fp s s0 st -- 0x00: isolate, execute parser + _ -> go8 fp eob s0 st s' -- not 0x00: next please! + + {- The "find first null byte" algorithms used here are adapted from + Hacker's Delight (2012) ch.6. + + We read a word (8 bytes) at a time for efficiency. The internal algorithm + does byte indexing, thus endianness matters. We switch between indexing + algorithms depending on compile-time native endianness. (The code + surrounding the indexing is endian-independent, so we do this inline). + -} + go fp eob s0 st s = + let sWord = s `plusAddr#` 8# in + case gtAddr# sWord eob of + 1# -> -- < 8 bytes of input: revert to scanning byte by byte + -- we _could_ operate on a word and simply ensure not to use the + -- out-of-bounds data, which would be faster, but the act of + -- reading could probably segfault + go8 fp eob s0 st s + _ -> -- >= 8 bytes of input: use efficient 8-byte scanning +#ifdef WORDS_BIGENDIAN + -- big-endian ("L->R"): find leftmost null byte + let !x@(I# x#) = Common.zbytel'intermediate (I# (indexIntOffAddr# s 0#)) in +#else + -- little-endian ("R->L"): find rightmost null byte + let !x@(I# x#) = Common.zbyter'intermediate (I# (indexIntOffAddr# s 0#)) in +#endif + case x# ==# 0# of + 1# -> go fp eob s0 st sWord -- no 0x00 in next word + _ -> -- 0x00 somewhere in next word +#ifdef WORDS_BIGENDIAN + let !(I# nullIdx#) = Common.zbytel'toIdx x in +#else + let !(I# nullIdx#) = Common.zbyter'toIdx x in + -- TO TEST BE ON LE: change above CPP to zbytel, uncomment below + -- let !(I# nullIdx#) = Common.zbytel'toIdx (I# (word2Int# (byteSwap# (int2Word# x#)))) in +#endif + let sNull = s `plusAddr#` nullIdx# in + goP fp sNull s0 st +{-# inline isolateToNextNull #-} + +-- | Read a null-terminated bytestring (a C-style string). +-- +-- Consumes the null terminator. +anyCString :: ParserT st e B.ByteString +anyCString = isolateToNextNull takeRest {-# inline anyCString #-} -- | Read a null-terminated bytestring (a C-style string), where the bytestring diff --git a/src/FlatParse/Basic/Integers.hs b/src/FlatParse/Basic/Integers.hs --- a/src/FlatParse/Basic/Integers.hs +++ b/src/FlatParse/Basic/Integers.hs @@ -71,8 +71,7 @@ withAnySizedUnsafe# :: Int# -> (Addr# -> Int# -> a) -> (a -> ParserT st e r) -> ParserT st e r withAnySizedUnsafe# size# indexOffAddr p = ParserT \fp eob buf st -> --- TODO force? i.e. @let !a, !buf'@ ? - let a = indexOffAddr buf 0# + let !a = indexOffAddr buf 0# buf' = plusAddr# buf size# in runParserT# (p a) fp eob buf' st {-# inline withAnySizedUnsafe# #-} diff --git a/src/FlatParse/Common/Assorted.hs b/src/FlatParse/Common/Assorted.hs --- a/src/FlatParse/Common/Assorted.hs +++ b/src/FlatParse/Common/Assorted.hs @@ -24,6 +24,10 @@ -- * Helpers , withPosInt#, withIntUnwrap# + + -- * Bit manipulation + , zbytel, zbytel'intermediate, zbytel'toIdx + , zbyter, zbyter'intermediate, zbyter'toIdx ) where import Data.Bits @@ -166,3 +170,51 @@ utf8ToStr :: B.ByteString -> String utf8ToStr = UTF8.toString {-# inline utf8ToStr #-} + +-------------------------------------------------------------------------------- + +-- | Index of leftmost null byte, or (number of bytes in type) if not present. +-- +-- Adapted from Hacker's Delight 6-1. Useful in big-endian environments. +zbytel :: (FiniteBits a, Num a) => a -> Int +zbytel = zbytel'toIdx . zbytel'intermediate +{-# inline zbytel #-} + +-- | bit mangling, returns 0 for inputs without a null byte +-- +-- Separating allows us to skip some index calculation if there was no null byte. +zbytel'intermediate :: (FiniteBits a, Num a) => a -> a +zbytel'intermediate a = + let a' = (a .&. mask) + mask + in complement (a' .|. a .|. mask) + where + mask = 0x7F7F7F7F7F7F7F7F +{-# inline zbytel'intermediate #-} + +-- | bit mangling, turns intermediate value into an index +-- +-- Separating allows us to skip some index calculation if there was no null byte. +zbytel'toIdx :: (FiniteBits a, Num a) => a -> Int +zbytel'toIdx a = countLeadingZeros a `unsafeShiftR` 3 +{-# inline zbytel'toIdx #-} + +-- | Index of rightmost null byte, or (number of bytes in type) if not present +-- +-- Adapted from Hacker's Delight 6-1. Useful in little-endian environments. +zbyter :: (FiniteBits a, Num a) => a -> Int +zbyter = zbyter'toIdx . zbyter'intermediate +{-# inline zbyter #-} + +-- | bit mangling, returns 0 for inputs without a null byte +-- +-- Separating allows us to skip some index calculation if there was no null byte. +zbyter'intermediate :: (FiniteBits a, Num a) => a -> a +zbyter'intermediate a = (a - 0x0101010101010101) .&. (complement a) .&. 0x8080808080808080 +{-# inline zbyter'intermediate #-} + +-- | bit mangling, turns intermediate value into an index +-- +-- Separating allows us to skip some index calculation if there was no null byte. +zbyter'toIdx :: (FiniteBits a, Num a) => a -> Int +zbyter'toIdx a = countTrailingZeros a `unsafeShiftR` 3 +{-# inline zbyter'toIdx #-} diff --git a/src/FlatParse/Stateful.hs b/src/FlatParse/Stateful.hs --- a/src/FlatParse/Stateful.hs +++ b/src/FlatParse/Stateful.hs @@ -3,6 +3,7 @@ {-# LANGUAGE KindSignatures #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE ScopedTypeVariables #-} {-| Parser supporting a custom reader environment, custom error types and an 'Int' @@ -22,6 +23,7 @@ , runParserUtf8 , runParserIO , runParserST + , embedParserST -- ** Primitive result types , type FP.Parser.Res# @@ -82,6 +84,7 @@ , FP.Base.withEnsure1 , FP.Base.withEnsure# , FP.Base.isolate + , isolateToNextNull , FP.Base.isolate# , FP.Base.isolateUnsafe# , FP.Switch.switch @@ -261,6 +264,11 @@ Fail# rw' -> (# rw', Fail #) {-# inlinable runParserIO #-} +-- | Run a `ParserST` inside a pure parser. +embedParserST :: forall r e a. (forall s. ParserST s r e a) -> Parser r e a +embedParserST f = unsafeCoerce# (f :: ParserST RealWorld r e a) +{-# inline embedParserST #-} + -------------------------------------------------------------------------------- -- | Run an `ST` action in a `ParserST`. @@ -415,26 +423,81 @@ -------------------------------------------------------------------------------- --- | Read a null-terminated bytestring (a C-style string). +-- | Isolate the given parser up to (excluding) the next null byte. -- --- Consumes the null terminator. -anyCString :: ParserT st r e B.ByteString -anyCString = ParserT \fp !r eob s n st -> go' fp eob s n st +-- Like 'isolate', all isolated bytes must be consumed. The null byte is +-- consumed afterwards. +-- +-- Useful for defining parsers for null-terminated data. +isolateToNextNull :: ParserT st r e a -> ParserT st r e a +isolateToNextNull (ParserT p) = ParserT \fp !r eob s n st -> go fp r n eob s st s where - go' fp eob s0 n st = go 0# s0 n - where - go n# s n = case eqAddr# eob s of - 1# -> Fail# st + goP fp r n sNull s0 st = + case p fp r sNull s0 n st of + OK# st' a s' n' -> + case eqAddr# s' sNull of + 1# -> -- consumed up to null: skip null, return + OK# st' a (sNull `plusAddr#` 1#) n' + _ -> Fail# st' -- didn't consume fully up to null: fail + x -> x + + go8 fp r n eob s0 st s = + case eqAddr# eob s of + 1# -> Fail# st -- end of input, no null: fail _ -> - let s' = plusAddr# s 1# + let s' = s `plusAddr#` 1# in #if MIN_VERSION_base(4,16,0) - -- TODO below is a candidate for improving with ExtendedLiterals! - in case eqWord8# (indexWord8OffAddr# s 0#) (wordToWord8# 0##) of + -- below may be made clearer with ExtendedLiterals (GHC 9.8) + case eqWord8# (indexWord8OffAddr# s 0#) (wordToWord8# 0##) of #else - in case eqWord# (indexWord8OffAddr# s 0#) 0## of + case eqWord# (indexWord8OffAddr# s 0#) 0## of #endif - 1# -> OK# st (B.PS (ForeignPtr s0 fp) 0 (I# n#)) s' n - _ -> go (n# +# 1#) s' n + 1# -> goP fp r n s s0 st -- 0x00: isolate, execute parser + _ -> go8 fp r n eob s0 st s' -- not 0x00: next please! + + {- The "find first null byte" algorithms used here are adapted from + Hacker's Delight (2012) ch.6. + + We read a word (8 bytes) at a time for efficiency. The internal algorithm + does byte indexing, thus endianness matters. We switch between indexing + algorithms depending on compile-time native endianness. (The code + surrounding the indexing is endian-independent, so we do this inline). + -} + go fp r n eob s0 st s = + let sWord = s `plusAddr#` 8# in + case gtAddr# sWord eob of + 1# -> -- < 8 bytes of input: revert to scanning byte by byte + -- we _could_ operate on a word and simply ensure not to use the + -- out-of-bounds data, which would be faster, but the act of + -- reading could probably segfault + go8 fp r n eob s0 st s + _ -> -- >= 8 bytes of input: use efficient 8-byte scanning +#ifdef WORDS_BIGENDIAN + -- big-endian ("L->R"): find leftmost null byte + let !x@(I# x#) = Common.zbytel'intermediate (I# (indexIntOffAddr# s 0#)) in +#else + -- little-endian ("R->L"): find rightmost null byte + let !x@(I# x#) = Common.zbyter'intermediate (I# (indexIntOffAddr# s 0#)) in +#endif + case x# ==# 0# of + 1# -> go fp r n eob s0 st sWord -- no 0x00 in next word + _ -> -- 0x00 somewhere in next word +#ifdef WORDS_BIGENDIAN + let !(I# nullIdx#) = Common.zbytel'toIdx x in +#else + let !(I# nullIdx#) = Common.zbyter'toIdx x in + -- TO TEST BE ON LE: change above CPP to zbytel, uncomment below + -- let !(I# nullIdx#) = Common.zbytel'toIdx (I# (word2Int# (byteSwap# (int2Word# x#)))) in +#endif + let sNull = s `plusAddr#` nullIdx# in + goP fp r n sNull s0 st +{-# inline isolateToNextNull #-} + +-- | Read a null-terminated bytestring (a C-style string). +-- +-- Consumes the null terminator. +anyCString :: ParserT st r e B.ByteString +anyCString = isolateToNextNull takeRest {-# inline anyCString #-} -- | Read a null-terminated bytestring (a C-style string), where the bytestring