attoparsec 0.14.3 → 0.14.4
raw patch · 30 files changed
+736/−940 lines, 30 filesdep +attoparsecdep +tasty-benchdep −criteriondep ~QuickCheckdep ~bytestringdep ~ghc-primPVP ok
version bump matches the API change (PVP)
Dependencies added: attoparsec, tasty-bench
Dependencies removed: criterion
Dependency ranges changed: QuickCheck, bytestring, ghc-prim, text
API changes (from Hackage documentation)
Files
- Data/Attoparsec/ByteString/Buffer.hs +0/−157
- Data/Attoparsec/ByteString/FastSet.hs +0/−112
- Data/Attoparsec/Internal/Compat.hs +0/−27
- Data/Attoparsec/Internal/Fhthagn.hs +0/−18
- Data/Attoparsec/Text/Buffer.hs +0/−231
- Data/Attoparsec/Text/FastSet.hs +0/−121
- attoparsec.cabal +37/−42
- benchmarks/Aeson.hs +1/−1
- benchmarks/Alternative.hs +0/−20
- benchmarks/Benchmarks.hs +1/−1
- benchmarks/Genome.hs +1/−1
- benchmarks/HeadersByteString.hs +1/−2
- benchmarks/HeadersText.hs +1/−2
- benchmarks/IsSpace.hs +0/−123
- benchmarks/Links.hs +1/−1
- benchmarks/Main.hs +0/−4
- benchmarks/Numbers.hs +1/−2
- benchmarks/Sets.hs +1/−1
- benchmarks/Tiny.hs +0/−31
- benchmarks/Warp.hs +1/−2
- benchmarks/attoparsec-benchmarks.cabal +0/−41
- benchmarks/warp-3.0.1.1/Network/Wai/Handler/Warp/ReadInt.hs +5/−0
- changelog.md +6/−0
- internal/Data/Attoparsec/ByteString/Buffer.hs +157/−0
- internal/Data/Attoparsec/ByteString/FastSet.hs +112/−0
- internal/Data/Attoparsec/Internal/Compat.hs +27/−0
- internal/Data/Attoparsec/Internal/Fhthagn.hs +18/−0
- internal/Data/Attoparsec/Text/Buffer.hs +235/−0
- internal/Data/Attoparsec/Text/FastSet.hs +121/−0
- tests/QC/Buffer.hs +9/−0
− Data/Attoparsec/ByteString/Buffer.hs
@@ -1,157 +0,0 @@-{-# LANGUAGE BangPatterns #-}--- |--- Module : Data.Attoparsec.ByteString.Buffer--- Copyright : Bryan O'Sullivan 2007-2015--- License : BSD3------ Maintainer : bos@serpentine.com--- Stability : experimental--- Portability : GHC------ An "immutable" buffer that supports cheap appends.------ A Buffer is divided into an immutable read-only zone, followed by a--- mutable area that we've preallocated, but not yet written to.------ We overallocate at the end of a Buffer so that we can cheaply--- append. Since a user of an existing Buffer cannot see past the end--- of its immutable zone into the data that will change during an--- append, this is safe.------ Once we run out of space at the end of a Buffer, we do the usual--- doubling of the buffer size.------ The fact of having a mutable buffer really helps with performance,--- but it does have a consequence: if someone misuses the Partial API--- that attoparsec uses by calling the same continuation repeatedly--- (which never makes sense in practice), they could overwrite data.------ Since the API *looks* pure, it should *act* pure, too, so we use--- two generation counters (one mutable, one immutable) to track the--- number of appends to a mutable buffer. If the counters ever get out--- of sync, someone is appending twice to a mutable buffer, so we--- duplicate the entire buffer in order to preserve the immutability--- of its older self.------ While we could go a step further and gain protection against API--- abuse on a multicore system, by use of an atomic increment--- instruction to bump the mutable generation counter, that would be--- very expensive, and feels like it would also be in the realm of the--- ridiculous. Clients should never call a continuation more than--- once; we lack a linear type system that could enforce this; and--- there's only so far we should go to accommodate broken uses.--module Data.Attoparsec.ByteString.Buffer- (- Buffer- , buffer- , unbuffer- , pappend- , length- , unsafeIndex- , substring- , unsafeDrop- ) where--import Control.Exception (assert)-import Data.ByteString.Internal (ByteString(..), memcpy, nullForeignPtr)-import Data.Attoparsec.Internal.Fhthagn (inlinePerformIO)-import Data.Attoparsec.Internal.Compat-import Data.List (foldl1')-import Data.Monoid as Mon (Monoid(..))-import Data.Semigroup (Semigroup(..))-import Data.Word (Word8)-import Foreign.ForeignPtr (ForeignPtr, withForeignPtr)-import Foreign.Ptr (castPtr, plusPtr)-import Foreign.Storable (peek, peekByteOff, poke, sizeOf)-import GHC.ForeignPtr (mallocPlainForeignPtrBytes)-import Prelude hiding (length)---- If _cap is zero, this buffer is empty.-data Buffer = Buf {- _fp :: {-# UNPACK #-} !(ForeignPtr Word8)- , _off :: {-# UNPACK #-} !Int- , _len :: {-# UNPACK #-} !Int- , _cap :: {-# UNPACK #-} !Int- , _gen :: {-# UNPACK #-} !Int- }--instance Show Buffer where- showsPrec p = showsPrec p . unbuffer---- | The initial 'Buffer' has no mutable zone, so we can avoid all--- copies in the (hopefully) common case of no further input being fed--- to us.-buffer :: ByteString -> Buffer-buffer bs = withPS bs $ \fp off len -> Buf fp off len len 0--unbuffer :: Buffer -> ByteString-unbuffer (Buf fp off len _ _) = mkPS fp off len--instance Semigroup Buffer where- (Buf _ _ _ 0 _) <> b = b- a <> (Buf _ _ _ 0 _) = a- buf <> (Buf fp off len _ _) = append buf fp off len--instance Monoid Buffer where- mempty = Buf nullForeignPtr 0 0 0 0-- mappend = (<>)-- mconcat [] = Mon.mempty- mconcat xs = foldl1' mappend xs--pappend :: Buffer -> ByteString -> Buffer-pappend (Buf _ _ _ 0 _) bs = buffer bs-pappend buf bs = withPS bs $ \fp off len -> append buf fp off len--append :: Buffer -> ForeignPtr a -> Int -> Int -> Buffer-append (Buf fp0 off0 len0 cap0 gen0) !fp1 !off1 !len1 =- inlinePerformIO . withForeignPtr fp0 $ \ptr0 ->- withForeignPtr fp1 $ \ptr1 -> do- let genSize = sizeOf (0::Int)- newlen = len0 + len1- gen <- if gen0 == 0- then return 0- else peek (castPtr ptr0)- if gen == gen0 && newlen <= cap0- then do- let newgen = gen + 1- poke (castPtr ptr0) newgen- memcpy (ptr0 `plusPtr` (off0+len0))- (ptr1 `plusPtr` off1)- (fromIntegral len1)- return (Buf fp0 off0 newlen cap0 newgen)- else do- let newcap = newlen * 2- fp <- mallocPlainForeignPtrBytes (newcap + genSize)- withForeignPtr fp $ \ptr_ -> do- let ptr = ptr_ `plusPtr` genSize- newgen = 1- poke (castPtr ptr_) newgen- memcpy ptr (ptr0 `plusPtr` off0) (fromIntegral len0)- memcpy (ptr `plusPtr` len0) (ptr1 `plusPtr` off1)- (fromIntegral len1)- return (Buf fp genSize newlen newcap newgen)--length :: Buffer -> Int-length (Buf _ _ len _ _) = len-{-# INLINE length #-}--unsafeIndex :: Buffer -> Int -> Word8-unsafeIndex (Buf fp off len _ _) i = assert (i >= 0 && i < len) .- inlinePerformIO . withForeignPtr fp $ flip peekByteOff (off+i)-{-# INLINE unsafeIndex #-}--substring :: Int -> Int -> Buffer -> ByteString-substring s l (Buf fp off len _ _) =- assert (s >= 0 && s <= len) .- assert (l >= 0 && l <= len-s) $- mkPS fp (off+s) l-{-# INLINE substring #-}--unsafeDrop :: Int -> Buffer -> ByteString-unsafeDrop s (Buf fp off len _ _) =- assert (s >= 0 && s <= len) $- mkPS fp (off+s) (len-s)-{-# INLINE unsafeDrop #-}
− Data/Attoparsec/ByteString/FastSet.hs
@@ -1,112 +0,0 @@-{-# LANGUAGE BangPatterns, MagicHash #-}---------------------------------------------------------------------------------- |--- Module : Data.Attoparsec.ByteString.FastSet--- Copyright : Bryan O'Sullivan 2007-2015--- License : BSD3------ Maintainer : bos@serpentine.com--- Stability : experimental--- Portability : unknown------ Fast set membership tests for 'Word8' and 8-bit 'Char' values. The--- set representation is unboxed for efficiency. For small sets, we--- test for membership using a binary search. For larger sets, we use--- a lookup table.----------------------------------------------------------------------------------module Data.Attoparsec.ByteString.FastSet- (- -- * Data type- FastSet- -- * Construction- , fromList- , set- -- * Lookup- , memberChar- , memberWord8- -- * Debugging- , fromSet- -- * Handy interface- , charClass- ) where--import Data.Bits ((.&.), (.|.), unsafeShiftL)-import Foreign.Storable (peekByteOff, pokeByteOff)-import GHC.Exts (Int(I#), iShiftRA#)-import GHC.Word (Word8)-import qualified Data.ByteString as B-import qualified Data.ByteString.Char8 as B8-import qualified Data.ByteString.Internal as I-import qualified Data.ByteString.Unsafe as U--data FastSet = Sorted { fromSet :: !B.ByteString }- | Table { fromSet :: !B.ByteString }- deriving (Eq, Ord)--instance Show FastSet where- show (Sorted s) = "FastSet Sorted " ++ show (B8.unpack s)- show (Table _) = "FastSet Table"---- | The lower bound on the size of a lookup table. We choose this to--- balance table density against performance.-tableCutoff :: Int-tableCutoff = 8---- | Create a set.-set :: B.ByteString -> FastSet-set s | B.length s < tableCutoff = Sorted . B.sort $ s- | otherwise = Table . mkTable $ s--fromList :: [Word8] -> FastSet-fromList = set . B.pack--data I = I {-# UNPACK #-} !Int {-# UNPACK #-} !Word8--shiftR :: Int -> Int -> Int-shiftR (I# x#) (I# i#) = I# (x# `iShiftRA#` i#)--index :: Int -> I-index i = I (i `shiftR` 3) (1 `unsafeShiftL` (i .&. 7))-{-# INLINE index #-}---- | Check the set for membership.-memberWord8 :: Word8 -> FastSet -> Bool-memberWord8 w (Table t) =- let I byte bit = index (fromIntegral w)- in U.unsafeIndex t byte .&. bit /= 0-memberWord8 w (Sorted s) = search 0 (B.length s - 1)- where search lo hi- | hi < lo = False- | otherwise =- let mid = (lo + hi) `quot` 2- in case compare w (U.unsafeIndex s mid) of- GT -> search (mid + 1) hi- LT -> search lo (mid - 1)- _ -> True---- | Check the set for membership. Only works with 8-bit characters:--- characters above code point 255 will give wrong answers.-memberChar :: Char -> FastSet -> Bool-memberChar c = memberWord8 (I.c2w c)-{-# INLINE memberChar #-}--mkTable :: B.ByteString -> B.ByteString-mkTable s = I.unsafeCreate 32 $ \t -> do- _ <- I.memset t 0 32- U.unsafeUseAsCStringLen s $ \(p, l) ->- let loop n | n == l = return ()- | otherwise = do- c <- peekByteOff p n :: IO Word8- let I byte bit = index (fromIntegral c)- prev <- peekByteOff t byte :: IO Word8- pokeByteOff t byte (prev .|. bit)- loop (n + 1)- in loop 0--charClass :: String -> FastSet-charClass = set . B8.pack . go- where go (a:'-':b:xs) = [a..b] ++ go xs- go (x:xs) = x : go xs- go _ = ""
− Data/Attoparsec/Internal/Compat.hs
@@ -1,27 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE MagicHash #-}-module Data.Attoparsec.Internal.Compat where--import Data.ByteString.Internal (ByteString(..))-import Data.Word (Word8)-import Foreign.ForeignPtr (ForeignPtr)--#if MIN_VERSION_bytestring(0,11,0)-import Data.ByteString.Internal (plusForeignPtr)-#endif--withPS :: ByteString -> (ForeignPtr Word8 -> Int -> Int -> r) -> r-#if MIN_VERSION_bytestring(0,11,0)-withPS (BS fp len) kont = kont fp 0 len-#else-withPS (PS fp off len) kont = kont fp off len-#endif-{-# INLINE withPS #-}--mkPS :: ForeignPtr Word8 -> Int -> Int -> ByteString-#if MIN_VERSION_bytestring(0,11,0)-mkPS fp off len = BS (plusForeignPtr fp off) len-#else-mkPS fp off len = PS fp off len-#endif-{-# INLINE mkPS #-}
− Data/Attoparsec/Internal/Fhthagn.hs
@@ -1,18 +0,0 @@-{-# LANGUAGE BangPatterns, Rank2Types, OverloadedStrings,- RecordWildCards, MagicHash, UnboxedTuples #-}--module Data.Attoparsec.Internal.Fhthagn- (- inlinePerformIO- ) where--import GHC.Exts (realWorld#)-import GHC.IO (IO(IO))---- | Just like unsafePerformIO, but we inline it. Big performance gains as--- it exposes lots of things to further inlining. /Very unsafe/. In--- particular, you should do no memory allocation inside an--- 'inlinePerformIO' block. On Hugs this is just @unsafePerformIO@.-inlinePerformIO :: IO a -> a-inlinePerformIO (IO m) = case m realWorld# of (# _, r #) -> r-{-# INLINE inlinePerformIO #-}
− Data/Attoparsec/Text/Buffer.hs
@@ -1,231 +0,0 @@-{-# LANGUAGE BangPatterns, CPP, MagicHash, RankNTypes, RecordWildCards,- UnboxedTuples #-}---- |--- Module : Data.Attoparsec.Text.Buffer--- Copyright : Bryan O'Sullivan 2007-2015--- License : BSD3------ Maintainer : bos@serpentine.com--- Stability : experimental--- Portability : GHC------ An immutable buffer that supports cheap appends.---- A Buffer is divided into an immutable read-only zone, followed by a--- mutable area that we've preallocated, but not yet written to.------ We overallocate at the end of a Buffer so that we can cheaply--- append. Since a user of an existing Buffer cannot see past the end--- of its immutable zone into the data that will change during an--- append, this is safe.------ Once we run out of space at the end of a Buffer, we do the usual--- doubling of the buffer size.--module Data.Attoparsec.Text.Buffer- (- Buffer- , buffer- , unbuffer- , unbufferAt- , length- , pappend- , iter- , iter_- , substring- , lengthCodeUnits- , dropCodeUnits- ) where--import Control.Exception (assert)-import Data.Bits (shiftR)-import Data.List (foldl1')-import Data.Monoid as Mon (Monoid(..))-import Data.Semigroup (Semigroup(..))-import Data.Text ()-import Data.Text.Internal (Text(..))-#if MIN_VERSION_text(2,0,0)-import Data.Text.Internal.Encoding.Utf8 (utf8LengthByLeader)-import Data.Text.Unsafe (iterArray, lengthWord8)-#else-import Data.Text.Internal.Encoding.Utf16 (chr2)-import Data.Text.Internal.Unsafe.Char (unsafeChr)-import Data.Text.Unsafe (lengthWord16)-#endif-import Data.Text.Unsafe (Iter(..))-import Foreign.Storable (sizeOf)-import GHC.Exts (Int(..), indexIntArray#, unsafeCoerce#, writeIntArray#)-import GHC.ST (ST(..), runST)-import Prelude hiding (length)-import qualified Data.Text.Array as A---- If _cap is zero, this buffer is empty.-data Buffer = Buf {- _arr :: {-# UNPACK #-} !A.Array- , _off :: {-# UNPACK #-} !Int- , _len :: {-# UNPACK #-} !Int- , _cap :: {-# UNPACK #-} !Int- , _gen :: {-# UNPACK #-} !Int- }--instance Show Buffer where- showsPrec p = showsPrec p . unbuffer---- | The initial 'Buffer' has no mutable zone, so we can avoid all--- copies in the (hopefully) common case of no further input being fed--- to us.-buffer :: Text -> Buffer-buffer (Text arr off len) = Buf arr off len len 0--unbuffer :: Buffer -> Text-unbuffer (Buf arr off len _ _) = Text arr off len--unbufferAt :: Int -> Buffer -> Text-unbufferAt s (Buf arr off len _ _) =- assert (s >= 0 && s <= len) $- Text arr (off+s) (len-s)--instance Semigroup Buffer where- (Buf _ _ _ 0 _) <> b = b- a <> (Buf _ _ _ 0 _) = a- buf <> (Buf arr off len _ _) = append buf arr off len- {-# INLINE (<>) #-}--instance Monoid Buffer where- mempty = Buf A.empty 0 0 0 0- {-# INLINE mempty #-}-- mappend = (<>)-- mconcat [] = Mon.mempty- mconcat xs = foldl1' (<>) xs--pappend :: Buffer -> Text -> Buffer-pappend (Buf _ _ _ 0 _) t = buffer t-pappend buf (Text arr off len) = append buf arr off len--append :: Buffer -> A.Array -> Int -> Int -> Buffer-append (Buf arr0 off0 len0 cap0 gen0) !arr1 !off1 !len1 = runST $ do- let woff = sizeOf (0::Int) `shiftR` 1- newlen = len0 + len1- !gen = if gen0 == 0 then 0 else readGen arr0- if gen == gen0 && newlen <= cap0- then do- let newgen = gen + 1- marr <- unsafeThaw arr0- writeGen marr newgen-#if MIN_VERSION_text(2,0,0)- A.copyI newlen marr (off0+len0) arr1 off1-#else- A.copyI marr (off0+len0) arr1 off1 (off0+newlen)-#endif- arr2 <- A.unsafeFreeze marr- return (Buf arr2 off0 newlen cap0 newgen)- else do- let newcap = newlen * 2- newgen = 1- marr <- A.new (newcap + woff)- writeGen marr newgen-#if MIN_VERSION_text(2,0,0)- A.copyI len0 marr woff arr0 off0- A.copyI newlen marr (woff+len0) arr1 off1-#else- A.copyI marr woff arr0 off0 (woff+len0)- A.copyI marr (woff+len0) arr1 off1 (woff+newlen)-#endif- arr2 <- A.unsafeFreeze marr- return (Buf arr2 woff newlen newcap newgen)--length :: Buffer -> Int-length (Buf _ _ len _ _) = len-{-# INLINE length #-}--substring :: Int -> Int -> Buffer -> Text-substring s l (Buf arr off len _ _) =- assert (s >= 0 && s <= len) .- assert (l >= 0 && l <= len-s) $- Text arr (off+s) l-{-# INLINE substring #-}--#if MIN_VERSION_text(2,0,0)--lengthCodeUnits :: Text -> Int-lengthCodeUnits = lengthWord8--dropCodeUnits :: Int -> Buffer -> Text-dropCodeUnits s (Buf arr off len _ _) =- assert (s >= 0 && s <= len) $- Text arr (off+s) (len-s)-{-# INLINE dropCodeUnits #-}---- | /O(1)/ Iterate (unsafely) one step forwards through a UTF-8--- array, returning the current character and the delta to add to give--- the next offset to iterate at.-iter :: Buffer -> Int -> Iter-iter (Buf arr off _ _ _) i = iterArray arr (off + i)-{-# INLINE iter #-}---- | /O(1)/ Iterate one step through a UTF-8 array, returning the--- delta to add to give the next offset to iterate at.-iter_ :: Buffer -> Int -> Int-iter_ (Buf arr off _ _ _) i = utf8LengthByLeader $ A.unsafeIndex arr (off+i)-{-# INLINE iter_ #-}--unsafeThaw :: A.Array -> ST s (A.MArray s)-unsafeThaw (A.ByteArray a) = ST $ \s# ->- (# s#, A.MutableByteArray (unsafeCoerce# a) #)--readGen :: A.Array -> Int-readGen (A.ByteArray a) = case indexIntArray# a 0# of r# -> I# r#--writeGen :: A.MArray s -> Int -> ST s ()-writeGen (A.MutableByteArray a) (I# gen#) = ST $ \s0# ->- case writeIntArray# a 0# gen# s0# of- s1# -> (# s1#, () #)--#else--lengthCodeUnits :: Text -> Int-lengthCodeUnits = lengthWord16--dropCodeUnits :: Int -> Buffer -> Text-dropCodeUnits s (Buf arr off len _ _) =- assert (s >= 0 && s <= len) $- Text arr (off+s) (len-s)-{-# INLINE dropCodeUnits #-}---- | /O(1)/ Iterate (unsafely) one step forwards through a UTF-16--- array, returning the current character and the delta to add to give--- the next offset to iterate at.-iter :: Buffer -> Int -> Iter-iter (Buf arr off _ _ _) i- | m < 0xD800 || m > 0xDBFF = Iter (unsafeChr m) 1- | otherwise = Iter (chr2 m n) 2- where m = A.unsafeIndex arr j- n = A.unsafeIndex arr k- j = off + i- k = j + 1-{-# INLINE iter #-}---- | /O(1)/ Iterate one step through a UTF-16 array, returning the--- delta to add to give the next offset to iterate at.-iter_ :: Buffer -> Int -> Int-iter_ (Buf arr off _ _ _) i | m < 0xD800 || m > 0xDBFF = 1- | otherwise = 2- where m = A.unsafeIndex arr (off+i)-{-# INLINE iter_ #-}--unsafeThaw :: A.Array -> ST s (A.MArray s)-unsafeThaw A.Array{..} = ST $ \s# ->- (# s#, A.MArray (unsafeCoerce# aBA) #)--readGen :: A.Array -> Int-readGen a = case indexIntArray# (A.aBA a) 0# of r# -> I# r#--writeGen :: A.MArray s -> Int -> ST s ()-writeGen a (I# gen#) = ST $ \s0# ->- case writeIntArray# (A.maBA a) 0# gen# s0# of- s1# -> (# s1#, () #)--#endif
− Data/Attoparsec/Text/FastSet.hs
@@ -1,121 +0,0 @@-{-# LANGUAGE BangPatterns #-}----------------------------------------------------------------------------------- |--- Module : Data.Attoparsec.FastSet--- Copyright : Felipe Lessa 2010, Bryan O'Sullivan 2007-2015--- License : BSD3------ Maintainer : felipe.lessa@gmail.com--- Stability : experimental--- Portability : unknown------ Fast set membership tests for 'Char' values. We test for--- membership using a hashtable implemented with Robin Hood--- collision resolution. The set representation is unboxed,--- and the characters and hashes interleaved, for efficiency.-------------------------------------------------------------------------------------module Data.Attoparsec.Text.FastSet- (- -- * Data type- FastSet- -- * Construction- , fromList- , set- -- * Lookup- , member- -- * Handy interface- , charClass- ) where--import Data.Bits ((.|.), (.&.), shiftR)-import Data.Function (on)-import Data.List (sort, sortBy)-import qualified Data.Array.Base as AB-import qualified Data.Array.Unboxed as A-import qualified Data.Text as T--data FastSet = FastSet {- table :: {-# UNPACK #-} !(A.UArray Int Int)- , mask :: {-# UNPACK #-} !Int- }--data Entry = Entry {- key :: {-# UNPACK #-} !Char- , initialIndex :: {-# UNPACK #-} !Int- , index :: {-# UNPACK #-} !Int- }--offset :: Entry -> Int-offset e = index e - initialIndex e--resolveCollisions :: [Entry] -> [Entry]-resolveCollisions [] = []-resolveCollisions [e] = [e]-resolveCollisions (a:b:entries) = a' : resolveCollisions (b' : entries)- where (a', b')- | index a < index b = (a, b)- | offset a < offset b = (b { index=index a }, a { index=index a + 1 })- | otherwise = (a, b { index=index a + 1 })--pad :: Int -> [Entry] -> [Entry]-pad = go 0- where -- ensure that we pad enough so that lookups beyond the- -- last hash in the table fall within the array- go !_ !m [] = replicate (max 1 m + 1) empty- go k m (e:entries) = map (const empty) [k..i - 1] ++ e :- go (i + 1) (m + i - k - 1) entries- where i = index e- empty = Entry '\0' maxBound 0--nextPowerOf2 :: Int -> Int-nextPowerOf2 0 = 1-nextPowerOf2 x = go (x - 1) 1- where go y 32 = y + 1- go y k = go (y .|. (y `shiftR` k)) $ k * 2--fastHash :: Char -> Int-fastHash = fromEnum--fromList :: String -> FastSet-fromList s = FastSet (AB.listArray (0, length interleaved - 1) interleaved)- mask'- where s' = ordNub (sort s)- l = length s'- mask' = nextPowerOf2 ((5 * l) `div` 4) - 1- entries = pad mask' .- resolveCollisions .- sortBy (compare `on` initialIndex) .- zipWith (\c i -> Entry c i i) s' .- map ((.&. mask') . fastHash) $ s'- interleaved = concatMap (\e -> [fromEnum $ key e, initialIndex e])- entries--ordNub :: Eq a => [a] -> [a]-ordNub [] = []-ordNub (y:ys) = go y ys- where go x (z:zs)- | x == z = go x zs- | otherwise = x : go z zs- go x [] = [x]--set :: T.Text -> FastSet-set = fromList . T.unpack---- | Check the set for membership.-member :: Char -> FastSet -> Bool-member c a = go (2 * i)- where i = fastHash c .&. mask a- lookupAt j b = (i' <= i) && (c == c' || b)- where c' = toEnum $ AB.unsafeAt (table a) j- i' = AB.unsafeAt (table a) $ j + 1- go j = lookupAt j . lookupAt (j + 2) . lookupAt (j + 4) .- lookupAt (j + 6) . go $ j + 8--charClass :: String -> FastSet-charClass = fromList . go- where go (a:'-':b:xs) = [a..b] ++ go xs- go (x:xs) = x : go xs- go _ = ""
attoparsec.cabal view
@@ -1,12 +1,12 @@ name: attoparsec-version: 0.14.3+version: 0.14.4 license: BSD3 license-file: LICENSE category: Text, Parsing author: Bryan O'Sullivan <bos@serpentine.com> maintainer: Bryan O'Sullivan <bos@serpentine.com>, Ben Gamari <ben@smart-cactus.org> stability: experimental-tested-with: GHC == 7.4.2, GHC ==7.6.3, GHC ==7.8.4, GHC ==7.10.3, GHC ==8.0.2, GHC ==8.2.2, GHC==8.4.4, GHC==8.6.5, GHC==8.8.4, GHC==8.10.4, GHC == 9.0.1+tested-with: GHC == 7.4.2, GHC ==7.6.3, GHC ==7.8.4, GHC ==7.10.3, GHC ==8.0.2, GHC ==8.2.2, GHC==8.4.4, GHC==8.6.5, GHC==8.8.4, GHC==8.10.7, GHC ==9.0.2, GHC ==9.2.1 synopsis: Fast combinator parsing for bytestrings and text cabal-version: 2.0 homepage: https://github.com/bgamari/attoparsec@@ -18,8 +18,6 @@ file formats. extra-source-files: README.markdown- benchmarks/*.cabal- benchmarks/*.hs benchmarks/*.txt benchmarks/json-data/*.json benchmarks/Makefile@@ -28,15 +26,31 @@ examples/*.c examples/*.hs examples/Makefile- tests/*.hs- tests/QC/*.hs- tests/QC/IPv6/*.hs Flag developer Description: Whether to build the library in development mode Default: False Manual: True +-- We need to test and benchmark these modules,+-- but do not want to expose them to end users+library attoparsec-internal+ hs-source-dirs: internal+ build-depends: array,+ base >= 4.3 && < 5,+ bytestring <0.12,+ text >= 1.1.1.3+ if !impl(ghc >= 8.0)+ build-depends: semigroups >=0.16.1 && <0.21+ exposed-modules: Data.Attoparsec.ByteString.Buffer+ Data.Attoparsec.ByteString.FastSet+ Data.Attoparsec.Internal.Compat+ Data.Attoparsec.Internal.Fhthagn+ Data.Attoparsec.Text.Buffer+ Data.Attoparsec.Text.FastSet+ ghc-options: -O2 -Wall+ default-language: Haskell2010+ library build-depends: array, base >= 4.3 && < 5,@@ -44,9 +58,10 @@ containers, deepseq, scientific >= 0.3.1 && < 0.4,- transformers >= 0.2 && (< 0.4 || >= 0.4.1.0) && < 0.6,+ transformers >= 0.2 && (< 0.4 || >= 0.4.1.0) && < 0.7, text >= 1.1.1.3,- ghc-prim <0.9+ ghc-prim <0.9,+ attoparsec-internal if impl(ghc < 7.4) build-depends: bytestring < 0.10.4.0@@ -54,7 +69,7 @@ if !impl(ghc >= 8.0) -- Data.Semigroup && Control.Monad.Fail are available in base-4.9+ build-depends: fail == 4.9.*,- semigroups >=0.16.1 && <0.20+ semigroups >=0.16.1 && <0.21 exposed-modules: Data.Attoparsec Data.Attoparsec.ByteString@@ -70,13 +85,7 @@ Data.Attoparsec.Text.Lazy Data.Attoparsec.Types Data.Attoparsec.Zepto- other-modules: Data.Attoparsec.ByteString.Buffer- Data.Attoparsec.ByteString.FastSet- Data.Attoparsec.ByteString.Internal- Data.Attoparsec.Internal.Compat- Data.Attoparsec.Internal.Fhthagn- Data.Attoparsec.Text.Buffer- Data.Attoparsec.Text.FastSet+ other-modules: Data.Attoparsec.ByteString.Internal Data.Attoparsec.Text.Internal ghc-options: -O2 -Wall @@ -86,9 +95,9 @@ ghc-prof-options: -auto-all ghc-options: -Werror -test-suite tests+test-suite attoparsec-tests type: exitcode-stdio-1.0- hs-source-dirs: tests .+ hs-source-dirs: tests main-is: QC.hs other-modules: QC.Buffer QC.ByteString@@ -102,25 +111,6 @@ QC.Text.FastSet QC.Text.Regressions - other-modules: Data.Attoparsec.ByteString- Data.Attoparsec.ByteString.Buffer- Data.Attoparsec.ByteString.Char8- Data.Attoparsec.ByteString.FastSet- Data.Attoparsec.ByteString.Internal- Data.Attoparsec.ByteString.Lazy- Data.Attoparsec.Combinator- Data.Attoparsec.Internal- Data.Attoparsec.Internal.Compat- Data.Attoparsec.Internal.Fhthagn- Data.Attoparsec.Internal.Types- Data.Attoparsec.Number- Data.Attoparsec.Text- Data.Attoparsec.Text.Buffer- Data.Attoparsec.Text.FastSet- Data.Attoparsec.Text.Internal- Data.Attoparsec.Text.Lazy- Data.Attoparsec.Zepto- ghc-options: -Wall -threaded -rtsopts @@ -129,6 +119,8 @@ build-depends: array,+ attoparsec,+ attoparsec-internal, base, bytestring, deepseq >= 1.1,@@ -148,13 +140,15 @@ build-depends: fail == 4.9.*, semigroups >=0.16.1 && <0.19 -benchmark benchmarks+benchmark attoparsec-benchmarks type: exitcode-stdio-1.0- hs-source-dirs: benchmarks benchmarks/warp-3.0.1.1 .+ hs-source-dirs: benchmarks benchmarks/warp-3.0.1.1 ghc-options: -O2 -Wall -rtsopts main-is: Benchmarks.hs other-modules:+ Aeson Common+ Genome HeadersByteString HeadersByteString.Atto HeadersText@@ -172,11 +166,12 @@ build-depends: array,+ attoparsec,+ attoparsec-internal, base == 4.*, bytestring >= 0.10.4.0, case-insensitive, containers,- criterion >= 1.0, deepseq >= 1.1, directory, filepath,@@ -184,6 +179,7 @@ http-types, parsec >= 3.1.2, scientific,+ tasty-bench >= 0.3, text >= 1.1.1.0, transformers, unordered-containers,@@ -199,4 +195,3 @@ source-repository head type: git location: https://github.com/bgamari/attoparsec-
benchmarks/Aeson.hs view
@@ -39,7 +39,7 @@ import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Unsafe as B import qualified Data.HashMap.Strict as H-import Criterion.Main+import Test.Tasty.Bench #define BACKSLASH 92 #define CLOSE_CURLY 125
− benchmarks/Alternative.hs
@@ -1,20 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}---- This benchmark reveals a huge performance regression that showed up--- under GHC 7.8.1 (https://github.com/bos/attoparsec/issues/56).------ With GHC 7.6.3 and older, this program runs in 0.04 seconds. Under--- GHC 7.8.1 with (<|>) inlined, time jumps to 12 seconds!--import Control.Applicative-import Data.Text (Text)-import qualified Data.Attoparsec.Text as A-import qualified Data.Text as T--testParser :: Text -> Either String Int-testParser f = fmap length -- avoid printing out the entire matched list- . A.parseOnly (many ((() <$ A.string "b") <|> (() <$ A.anyChar)))- $ f--main :: IO ()-main = print . testParser $ T.replicate 50000 "a"
benchmarks/Benchmarks.hs view
@@ -2,7 +2,7 @@ import Common () import Control.Applicative (many)-import Criterion.Main (bench, bgroup, defaultMain, nf)+import Test.Tasty.Bench (bench, bgroup, defaultMain, nf) import Data.Bits import Data.Char (isAlpha) import Data.Word (Word32)
benchmarks/Genome.hs view
@@ -6,7 +6,7 @@ ) where import Control.Applicative-import Criterion.Main+import Test.Tasty.Bench import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as B8 import qualified Data.ByteString.Lazy.Char8 as L8
benchmarks/HeadersByteString.hs view
@@ -1,8 +1,7 @@ module HeadersByteString (headers) where import Common (pathTo, rechunkBS)-import Criterion.Main (bench, bgroup, nf, nfIO)-import Criterion.Types (Benchmark)+import Test.Tasty.Bench (Benchmark, bench, bgroup, nf, nfIO) import HeadersByteString.Atto (request, response) import Network.Wai.Handler.Warp.RequestHeader (parseHeaderLines) import qualified Data.Attoparsec.ByteString.Char8 as B
benchmarks/HeadersText.hs view
@@ -4,8 +4,7 @@ import Common (pathTo, rechunkT) import Control.Applicative-import Criterion.Main (bench, bgroup, nf)-import Criterion.Types (Benchmark)+import Test.Tasty.Bench (Benchmark, bench, bgroup, nf) import Data.Char (isSpace) import qualified Data.Attoparsec.Text as T import qualified Data.Attoparsec.Text.Lazy as TL
− benchmarks/IsSpace.hs
@@ -1,123 +0,0 @@-{-# OPTIONS_GHC -Wall -fwarn-tabs #-}-{-# LANGUAGE ForeignFunctionInterface #-}-------------------------------------------------------------------- 2010.10.09--- |--- Module : IsSpace--- Copyright : Copyright (c) 2010 wren ng thornton--- License : BSD--- Maintainer : wren@community.haskell.org--- Stability : experimental--- Portability : portable (FFI)------ A benchmark for comparing different definitions of predicates--- for detecting whitespace. As of the last run the results are:--- --- * Data.Char.isSpace : 14.44786 us +/- 258.0377 ns--- * isSpace_DataChar : 43.25154 us +/- 655.7037 ns--- * isSpace_Char : 29.26598 us +/- 454.1445 ns--- * isPerlSpace :--- * Data.Attoparsec.Char8.isSpace : 81.87335 us +/- 1.195903 us--- * isSpace_Char8 : 11.84677 us +/- 178.9795 ns--- * isSpace_w8 : 11.55470 us +/- 133.7644 ns------------------------------------------------------------------module IsSpace (main) where--import qualified Data.Char as C-import Data.Word (Word8)-import qualified Data.ByteString as B-import qualified Data.ByteString.Char8 as B8-import Foreign.C.Types (CInt)--import Criterion (bench, nf)-import Criterion.Main (defaultMain)------------------------------------------------------------------------ Character predicates--- N.B. \x9..\xD == "\t\n\v\f\r"---- | Recognize the same characters as Perl's @/\s/@ in Unicode mode.--- In particular, we recognize POSIX 1003.2 @[[:space:]]@ except--- @\'\v\'@, and recognize the Unicode @\'\x85\'@, @\'\x2028\'@,--- @\'\x2029\'@. Notably, @\'\x85\'@ belongs to Latin-1 (but not--- ASCII) and therefore does not belong to POSIX 1003.2 @[[:space:]]@--- (nor non-Unicode @/\s/@).-isPerlSpace :: Char -> Bool-isPerlSpace c- = (' ' == c)- || ('\t' <= c && c <= '\r' && c /= '\v')- || ('\x85' == c)- || ('\x2028' == c)- || ('\x2029' == c)-{-# INLINE isPerlSpace #-}----- | 'Data.Attoparsec.Char8.isSpace', duplicated here because it's--- not exported. This is the definition as of attoparsec-0.8.1.0.-isSpace :: Char -> Bool-isSpace c = c `B8.elem` spaces- where- spaces = B8.pack " \n\r\t\v\f"- {-# NOINLINE spaces #-}-{-# INLINE isSpace #-}----- | An alternate version of 'Data.Attoparsec.Char8.isSpace'.-isSpace_Char8 :: Char -> Bool-isSpace_Char8 c = (' ' == c) || ('\t' <= c && c <= '\r')-{-# INLINE isSpace_Char8 #-}----- | An alternate version of 'Data.Char.isSpace'. This uses the--- same trick as 'isSpace_Char8' but we include Unicode whitespaces--- too, in order to have the same results as 'Data.Char.isSpace'--- (whereas 'isSpace_Char8' doesn't recognize Unicode whitespace).-isSpace_Char :: Char -> Bool-isSpace_Char c- = (' ' == c)- || ('\t' <= c && c <= '\r')- || ('\xA0' == c)- || (iswspace (fromIntegral (C.ord c)) /= 0)-{-# INLINE isSpace_Char #-}--foreign import ccall unsafe "u_iswspace"- iswspace :: CInt -> CInt---- | Verbatim version of 'Data.Char.isSpace' (i.e., 'GHC.Unicode.isSpace'--- as of base-4.2.0.2) in order to try to figure out why 'isSpace_Char'--- is slower than 'Data.Char.isSpace'. It appears to be something--- special in how the base library was compiled.-isSpace_DataChar :: Char -> Bool-isSpace_DataChar c =- c == ' ' ||- c == '\t' ||- c == '\n' ||- c == '\r' ||- c == '\f' ||- c == '\v' ||- c == '\xa0' ||- iswspace (fromIntegral (C.ord c)) /= 0-{-# INLINE isSpace_DataChar #-}----- | A 'Word8' version of 'Data.Attoparsec.Char8.isSpace'.-isSpace_w8 :: Word8 -> Bool-isSpace_w8 w = (w == 32) || (9 <= w && w <= 13)-{-# INLINE isSpace_w8 #-}--------------------------------------------------------------------main :: IO ()-main = defaultMain- [ bench "Data.Char.isSpace" $ nf (map C.isSpace) ['\x0'..'\255']- , bench "isSpace_DataChar" $ nf (map isSpace_DataChar) ['\x0'..'\255']- , bench "isSpace_Char" $ nf (map isSpace_Char) ['\x0'..'\255']- , bench "isPerlSpace" $ nf (map isPerlSpace) ['\x0'..'\255']- , bench "Data.Attoparsec.Char8.isSpace"- $ nf (map isSpace) ['\x0'..'\255']- , bench "isSpace_Char8" $ nf (map isSpace_Char8) ['\x0'..'\255']- , bench "isSpace_w8" $ nf (map isSpace_w8) [0..255]- ]------------------------------------------------------------------------------------------------------------------------------ fin.
benchmarks/Links.hs view
@@ -4,7 +4,7 @@ import Control.Applicative import Control.DeepSeq (NFData(..))-import Criterion.Main (Benchmark, bench, nf)+import Test.Tasty.Bench (Benchmark, bench, nf) import Data.Attoparsec.ByteString as A import Data.Attoparsec.ByteString.Char8 as A8 import Data.ByteString.Char8 as B8
− benchmarks/Main.hs
@@ -1,4 +0,0 @@-import Sets-import Criterion.Main--main = defaultMain [Sets.benchmarks]
benchmarks/Numbers.hs view
@@ -3,8 +3,7 @@ module Numbers (numbers) where -import Criterion.Main (bench, bgroup, nf)-import Criterion.Types (Benchmark)+import Test.Tasty.Bench (Benchmark, bench, bgroup, nf) import Data.Scientific (Scientific(..)) import Text.Parsec.Text () import Text.Parsec.Text.Lazy ()
benchmarks/Sets.hs view
@@ -1,6 +1,6 @@ module Sets (benchmarks) where -import Criterion+import Test.Tasty.Bench import Data.Char (ord) import qualified Data.Attoparsec.Text.FastSet as FastSet import qualified TextFastSet
− benchmarks/Tiny.hs
@@ -1,31 +0,0 @@-import Control.Applicative ((<|>), many)-import Control.Monad (forM_)-import System.Environment (getArgs)-import qualified Data.Attoparsec.ByteString.Char8 as A-import qualified Data.ByteString.Char8 as B-import qualified Text.Parsec as P-import qualified Text.Parsec.ByteString as P--attoparsec = do- args <- getArgs- forM_ args $ \arg -> do- input <- B.readFile arg- case A.parse p input `A.feed` B.empty of- A.Done _ xs -> print (length xs)- what -> print what- where- slow = many (A.many1 A.letter_ascii <|> A.many1 A.digit)- fast = many (A.takeWhile1 isLetter <|> A.takeWhile1 isDigit)- isDigit c = c >= '0' && c <= '9'- isLetter c = (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z')- p = fast--parsec = do- args <- getArgs- forM_ args $ \arg -> do- input <- readFile arg- case P.parse (P.many (P.many1 P.letter P.<|> P.many1 P.digit)) "" input of- Left err -> print err- Right xs -> print (length xs)--main = attoparsec
benchmarks/Warp.hs view
@@ -2,8 +2,7 @@ module Warp (benchmarks) where -import Criterion.Main (bench, bgroup, nf)-import Criterion.Types (Benchmark)+import Test.Tasty.Bench (Benchmark, bench, bgroup, nf) import Data.ByteString (ByteString) import Network.Wai.Handler.Warp.ReadInt (readInt) import qualified Data.Attoparsec.ByteString.Char8 as B
− benchmarks/attoparsec-benchmarks.cabal
@@ -1,41 +0,0 @@--- These benchmarks are not intended to be installed.--- So don't install 'em.--name: attoparsec-benchmarks-version: 0-cabal-version: >=1.6-build-type: Simple--executable attoparsec-benchmarks- main-is: Benchmarks.hs- other-modules:- Common- HeadersByteString- HeadersByteString.Atto- HeadersText- Links- Numbers- Network.Wai.Handler.Warp.ReadInt- Sets- TextFastSet- Warp- hs-source-dirs: .. . warp-3.0.1.1- ghc-options: -O2 -Wall -rtsopts- build-depends:- array,- base == 4.*,- bytestring >= 0.10.4.0,- case-insensitive,- containers,- criterion >= 1.0,- deepseq >= 1.1,- directory,- filepath,- ghc-prim,- http-types,- parsec >= 3.1.2,- scientific >= 0.3.1,- text >= 1.1.1.0,- transformers,- unordered-containers,- vector
benchmarks/warp-3.0.1.1/Network/Wai/Handler/Warp/ReadInt.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE BangPatterns #-}@@ -41,7 +42,11 @@ {-# NOINLINE mhDigitToInt #-} mhDigitToInt :: Word8 -> Int+#if MIN_VERSION_base(4,16,0)+mhDigitToInt (W8# i) = I# (word2Int# (word8ToWord# (indexWord8OffAddr# addr (word2Int# (word8ToWord# i)))))+#else mhDigitToInt (W8# i) = I# (word2Int# (indexWord8OffAddr# addr (word2Int# i)))+#endif where !(Table addr) = table table :: Table
changelog.md view
@@ -1,3 +1,9 @@+# 0.14.4++* Fix a segmentation fault when built against `text-2.0`+* Restructure project to allow more convenient usage of benchmark suite+* Allow benchmarks to build with GHC 9.2+ # 0.14.3 * Support for GHC 9.2.1
+ internal/Data/Attoparsec/ByteString/Buffer.hs view
@@ -0,0 +1,157 @@+{-# LANGUAGE BangPatterns #-}+-- |+-- Module : Data.Attoparsec.ByteString.Buffer+-- Copyright : Bryan O'Sullivan 2007-2015+-- License : BSD3+--+-- Maintainer : bos@serpentine.com+-- Stability : experimental+-- Portability : GHC+--+-- An "immutable" buffer that supports cheap appends.+--+-- A Buffer is divided into an immutable read-only zone, followed by a+-- mutable area that we've preallocated, but not yet written to.+--+-- We overallocate at the end of a Buffer so that we can cheaply+-- append. Since a user of an existing Buffer cannot see past the end+-- of its immutable zone into the data that will change during an+-- append, this is safe.+--+-- Once we run out of space at the end of a Buffer, we do the usual+-- doubling of the buffer size.+--+-- The fact of having a mutable buffer really helps with performance,+-- but it does have a consequence: if someone misuses the Partial API+-- that attoparsec uses by calling the same continuation repeatedly+-- (which never makes sense in practice), they could overwrite data.+--+-- Since the API *looks* pure, it should *act* pure, too, so we use+-- two generation counters (one mutable, one immutable) to track the+-- number of appends to a mutable buffer. If the counters ever get out+-- of sync, someone is appending twice to a mutable buffer, so we+-- duplicate the entire buffer in order to preserve the immutability+-- of its older self.+--+-- While we could go a step further and gain protection against API+-- abuse on a multicore system, by use of an atomic increment+-- instruction to bump the mutable generation counter, that would be+-- very expensive, and feels like it would also be in the realm of the+-- ridiculous. Clients should never call a continuation more than+-- once; we lack a linear type system that could enforce this; and+-- there's only so far we should go to accommodate broken uses.++module Data.Attoparsec.ByteString.Buffer+ (+ Buffer+ , buffer+ , unbuffer+ , pappend+ , length+ , unsafeIndex+ , substring+ , unsafeDrop+ ) where++import Control.Exception (assert)+import Data.ByteString.Internal (ByteString(..), memcpy, nullForeignPtr)+import Data.Attoparsec.Internal.Fhthagn (inlinePerformIO)+import Data.Attoparsec.Internal.Compat+import Data.List (foldl1')+import Data.Monoid as Mon (Monoid(..))+import Data.Semigroup (Semigroup(..))+import Data.Word (Word8)+import Foreign.ForeignPtr (ForeignPtr, withForeignPtr)+import Foreign.Ptr (castPtr, plusPtr)+import Foreign.Storable (peek, peekByteOff, poke, sizeOf)+import GHC.ForeignPtr (mallocPlainForeignPtrBytes)+import Prelude hiding (length)++-- If _cap is zero, this buffer is empty.+data Buffer = Buf {+ _fp :: {-# UNPACK #-} !(ForeignPtr Word8)+ , _off :: {-# UNPACK #-} !Int+ , _len :: {-# UNPACK #-} !Int+ , _cap :: {-# UNPACK #-} !Int+ , _gen :: {-# UNPACK #-} !Int+ }++instance Show Buffer where+ showsPrec p = showsPrec p . unbuffer++-- | The initial 'Buffer' has no mutable zone, so we can avoid all+-- copies in the (hopefully) common case of no further input being fed+-- to us.+buffer :: ByteString -> Buffer+buffer bs = withPS bs $ \fp off len -> Buf fp off len len 0++unbuffer :: Buffer -> ByteString+unbuffer (Buf fp off len _ _) = mkPS fp off len++instance Semigroup Buffer where+ (Buf _ _ _ 0 _) <> b = b+ a <> (Buf _ _ _ 0 _) = a+ buf <> (Buf fp off len _ _) = append buf fp off len++instance Monoid Buffer where+ mempty = Buf nullForeignPtr 0 0 0 0++ mappend = (<>)++ mconcat [] = Mon.mempty+ mconcat xs = foldl1' mappend xs++pappend :: Buffer -> ByteString -> Buffer+pappend (Buf _ _ _ 0 _) bs = buffer bs+pappend buf bs = withPS bs $ \fp off len -> append buf fp off len++append :: Buffer -> ForeignPtr a -> Int -> Int -> Buffer+append (Buf fp0 off0 len0 cap0 gen0) !fp1 !off1 !len1 =+ inlinePerformIO . withForeignPtr fp0 $ \ptr0 ->+ withForeignPtr fp1 $ \ptr1 -> do+ let genSize = sizeOf (0::Int)+ newlen = len0 + len1+ gen <- if gen0 == 0+ then return 0+ else peek (castPtr ptr0)+ if gen == gen0 && newlen <= cap0+ then do+ let newgen = gen + 1+ poke (castPtr ptr0) newgen+ memcpy (ptr0 `plusPtr` (off0+len0))+ (ptr1 `plusPtr` off1)+ (fromIntegral len1)+ return (Buf fp0 off0 newlen cap0 newgen)+ else do+ let newcap = newlen * 2+ fp <- mallocPlainForeignPtrBytes (newcap + genSize)+ withForeignPtr fp $ \ptr_ -> do+ let ptr = ptr_ `plusPtr` genSize+ newgen = 1+ poke (castPtr ptr_) newgen+ memcpy ptr (ptr0 `plusPtr` off0) (fromIntegral len0)+ memcpy (ptr `plusPtr` len0) (ptr1 `plusPtr` off1)+ (fromIntegral len1)+ return (Buf fp genSize newlen newcap newgen)++length :: Buffer -> Int+length (Buf _ _ len _ _) = len+{-# INLINE length #-}++unsafeIndex :: Buffer -> Int -> Word8+unsafeIndex (Buf fp off len _ _) i = assert (i >= 0 && i < len) .+ inlinePerformIO . withForeignPtr fp $ flip peekByteOff (off+i)+{-# INLINE unsafeIndex #-}++substring :: Int -> Int -> Buffer -> ByteString+substring s l (Buf fp off len _ _) =+ assert (s >= 0 && s <= len) .+ assert (l >= 0 && l <= len-s) $+ mkPS fp (off+s) l+{-# INLINE substring #-}++unsafeDrop :: Int -> Buffer -> ByteString+unsafeDrop s (Buf fp off len _ _) =+ assert (s >= 0 && s <= len) $+ mkPS fp (off+s) (len-s)+{-# INLINE unsafeDrop #-}
+ internal/Data/Attoparsec/ByteString/FastSet.hs view
@@ -0,0 +1,112 @@+{-# LANGUAGE BangPatterns, MagicHash #-}++-----------------------------------------------------------------------------+-- |+-- Module : Data.Attoparsec.ByteString.FastSet+-- Copyright : Bryan O'Sullivan 2007-2015+-- License : BSD3+--+-- Maintainer : bos@serpentine.com+-- Stability : experimental+-- Portability : unknown+--+-- Fast set membership tests for 'Word8' and 8-bit 'Char' values. The+-- set representation is unboxed for efficiency. For small sets, we+-- test for membership using a binary search. For larger sets, we use+-- a lookup table.+--+-----------------------------------------------------------------------------+module Data.Attoparsec.ByteString.FastSet+ (+ -- * Data type+ FastSet+ -- * Construction+ , fromList+ , set+ -- * Lookup+ , memberChar+ , memberWord8+ -- * Debugging+ , fromSet+ -- * Handy interface+ , charClass+ ) where++import Data.Bits ((.&.), (.|.), unsafeShiftL)+import Foreign.Storable (peekByteOff, pokeByteOff)+import GHC.Exts (Int(I#), iShiftRA#)+import GHC.Word (Word8)+import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as B8+import qualified Data.ByteString.Internal as I+import qualified Data.ByteString.Unsafe as U++data FastSet = Sorted { fromSet :: !B.ByteString }+ | Table { fromSet :: !B.ByteString }+ deriving (Eq, Ord)++instance Show FastSet where+ show (Sorted s) = "FastSet Sorted " ++ show (B8.unpack s)+ show (Table _) = "FastSet Table"++-- | The lower bound on the size of a lookup table. We choose this to+-- balance table density against performance.+tableCutoff :: Int+tableCutoff = 8++-- | Create a set.+set :: B.ByteString -> FastSet+set s | B.length s < tableCutoff = Sorted . B.sort $ s+ | otherwise = Table . mkTable $ s++fromList :: [Word8] -> FastSet+fromList = set . B.pack++data I = I {-# UNPACK #-} !Int {-# UNPACK #-} !Word8++shiftR :: Int -> Int -> Int+shiftR (I# x#) (I# i#) = I# (x# `iShiftRA#` i#)++index :: Int -> I+index i = I (i `shiftR` 3) (1 `unsafeShiftL` (i .&. 7))+{-# INLINE index #-}++-- | Check the set for membership.+memberWord8 :: Word8 -> FastSet -> Bool+memberWord8 w (Table t) =+ let I byte bit = index (fromIntegral w)+ in U.unsafeIndex t byte .&. bit /= 0+memberWord8 w (Sorted s) = search 0 (B.length s - 1)+ where search lo hi+ | hi < lo = False+ | otherwise =+ let mid = (lo + hi) `quot` 2+ in case compare w (U.unsafeIndex s mid) of+ GT -> search (mid + 1) hi+ LT -> search lo (mid - 1)+ _ -> True++-- | Check the set for membership. Only works with 8-bit characters:+-- characters above code point 255 will give wrong answers.+memberChar :: Char -> FastSet -> Bool+memberChar c = memberWord8 (I.c2w c)+{-# INLINE memberChar #-}++mkTable :: B.ByteString -> B.ByteString+mkTable s = I.unsafeCreate 32 $ \t -> do+ _ <- I.memset t 0 32+ U.unsafeUseAsCStringLen s $ \(p, l) ->+ let loop n | n == l = return ()+ | otherwise = do+ c <- peekByteOff p n :: IO Word8+ let I byte bit = index (fromIntegral c)+ prev <- peekByteOff t byte :: IO Word8+ pokeByteOff t byte (prev .|. bit)+ loop (n + 1)+ in loop 0++charClass :: String -> FastSet+charClass = set . B8.pack . go+ where go (a:'-':b:xs) = [a..b] ++ go xs+ go (x:xs) = x : go xs+ go _ = ""
+ internal/Data/Attoparsec/Internal/Compat.hs view
@@ -0,0 +1,27 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE MagicHash #-}+module Data.Attoparsec.Internal.Compat where++import Data.ByteString.Internal (ByteString(..))+import Data.Word (Word8)+import Foreign.ForeignPtr (ForeignPtr)++#if MIN_VERSION_bytestring(0,11,0)+import Data.ByteString.Internal (plusForeignPtr)+#endif++withPS :: ByteString -> (ForeignPtr Word8 -> Int -> Int -> r) -> r+#if MIN_VERSION_bytestring(0,11,0)+withPS (BS fp len) kont = kont fp 0 len+#else+withPS (PS fp off len) kont = kont fp off len+#endif+{-# INLINE withPS #-}++mkPS :: ForeignPtr Word8 -> Int -> Int -> ByteString+#if MIN_VERSION_bytestring(0,11,0)+mkPS fp off len = BS (plusForeignPtr fp off) len+#else+mkPS fp off len = PS fp off len+#endif+{-# INLINE mkPS #-}
+ internal/Data/Attoparsec/Internal/Fhthagn.hs view
@@ -0,0 +1,18 @@+{-# LANGUAGE BangPatterns, Rank2Types, OverloadedStrings,+ RecordWildCards, MagicHash, UnboxedTuples #-}++module Data.Attoparsec.Internal.Fhthagn+ (+ inlinePerformIO+ ) where++import GHC.Exts (realWorld#)+import GHC.IO (IO(IO))++-- | Just like unsafePerformIO, but we inline it. Big performance gains as+-- it exposes lots of things to further inlining. /Very unsafe/. In+-- particular, you should do no memory allocation inside an+-- 'inlinePerformIO' block. On Hugs this is just @unsafePerformIO@.+inlinePerformIO :: IO a -> a+inlinePerformIO (IO m) = case m realWorld# of (# _, r #) -> r+{-# INLINE inlinePerformIO #-}
+ internal/Data/Attoparsec/Text/Buffer.hs view
@@ -0,0 +1,235 @@+{-# LANGUAGE BangPatterns, CPP, MagicHash, RankNTypes, RecordWildCards,+ UnboxedTuples #-}++-- |+-- Module : Data.Attoparsec.Text.Buffer+-- Copyright : Bryan O'Sullivan 2007-2015+-- License : BSD3+--+-- Maintainer : bos@serpentine.com+-- Stability : experimental+-- Portability : GHC+--+-- An immutable buffer that supports cheap appends.++-- A Buffer is divided into an immutable read-only zone, followed by a+-- mutable area that we've preallocated, but not yet written to.+--+-- We overallocate at the end of a Buffer so that we can cheaply+-- append. Since a user of an existing Buffer cannot see past the end+-- of its immutable zone into the data that will change during an+-- append, this is safe.+--+-- Once we run out of space at the end of a Buffer, we do the usual+-- doubling of the buffer size.++module Data.Attoparsec.Text.Buffer+ (+ Buffer+ , buffer+ , unbuffer+ , unbufferAt+ , length+ , pappend+ , iter+ , iter_+ , substring+ , lengthCodeUnits+ , dropCodeUnits+ ) where++import Control.Exception (assert)+import Data.List (foldl1')+import Data.Monoid as Mon (Monoid(..))+import Data.Semigroup (Semigroup(..))+import Data.Text ()+import Data.Text.Internal (Text(..))+#if MIN_VERSION_text(2,0,0)+import Data.Text.Internal.Encoding.Utf8 (utf8LengthByLeader)+import Data.Text.Unsafe (iterArray, lengthWord8)+#else+import Data.Bits (shiftR)+import Data.Text.Internal.Encoding.Utf16 (chr2)+import Data.Text.Internal.Unsafe.Char (unsafeChr)+import Data.Text.Unsafe (lengthWord16)+#endif+import Data.Text.Unsafe (Iter(..))+import Foreign.Storable (sizeOf)+import GHC.Exts (Int(..), indexIntArray#, unsafeCoerce#, writeIntArray#)+import GHC.ST (ST(..), runST)+import Prelude hiding (length)+import qualified Data.Text.Array as A++-- If _cap is zero, this buffer is empty.+data Buffer = Buf {+ _arr :: {-# UNPACK #-} !A.Array+ , _off :: {-# UNPACK #-} !Int+ , _len :: {-# UNPACK #-} !Int+ , _cap :: {-# UNPACK #-} !Int+ , _gen :: {-# UNPACK #-} !Int+ }++instance Show Buffer where+ showsPrec p = showsPrec p . unbuffer++-- | The initial 'Buffer' has no mutable zone, so we can avoid all+-- copies in the (hopefully) common case of no further input being fed+-- to us.+buffer :: Text -> Buffer+buffer (Text arr off len) = Buf arr off len len 0++unbuffer :: Buffer -> Text+unbuffer (Buf arr off len _ _) = Text arr off len++unbufferAt :: Int -> Buffer -> Text+unbufferAt s (Buf arr off len _ _) =+ assert (s >= 0 && s <= len) $+ Text arr (off+s) (len-s)++instance Semigroup Buffer where+ (Buf _ _ _ 0 _) <> b = b+ a <> (Buf _ _ _ 0 _) = a+ buf <> (Buf arr off len _ _) = append buf arr off len+ {-# INLINE (<>) #-}++instance Monoid Buffer where+ mempty = Buf A.empty 0 0 0 0+ {-# INLINE mempty #-}++ mappend = (<>)++ mconcat [] = Mon.mempty+ mconcat xs = foldl1' (<>) xs++pappend :: Buffer -> Text -> Buffer+pappend (Buf _ _ _ 0 _) t = buffer t+pappend buf (Text arr off len) = append buf arr off len++append :: Buffer -> A.Array -> Int -> Int -> Buffer+append (Buf arr0 off0 len0 cap0 gen0) !arr1 !off1 !len1 = runST $ do+#if MIN_VERSION_text(2,0,0)+ let woff = sizeOf (0::Int)+#else+ let woff = sizeOf (0::Int) `shiftR` 1+#endif+ newlen = len0 + len1+ !gen = if gen0 == 0 then 0 else readGen arr0+ if gen == gen0 && newlen <= cap0+ then do+ let newgen = gen + 1+ marr <- unsafeThaw arr0+ writeGen marr newgen+#if MIN_VERSION_text(2,0,0)+ A.copyI len1 marr (off0+len0) arr1 off1+#else+ A.copyI marr (off0+len0) arr1 off1 (off0+newlen)+#endif+ arr2 <- A.unsafeFreeze marr+ return (Buf arr2 off0 newlen cap0 newgen)+ else do+ let newcap = newlen * 2+ newgen = 1+ marr <- A.new (newcap + woff)+ writeGen marr newgen+#if MIN_VERSION_text(2,0,0)+ A.copyI len0 marr woff arr0 off0+ A.copyI len1 marr (woff+len0) arr1 off1+#else+ A.copyI marr woff arr0 off0 (woff+len0)+ A.copyI marr (woff+len0) arr1 off1 (woff+newlen)+#endif+ arr2 <- A.unsafeFreeze marr+ return (Buf arr2 woff newlen newcap newgen)++length :: Buffer -> Int+length (Buf _ _ len _ _) = len+{-# INLINE length #-}++substring :: Int -> Int -> Buffer -> Text+substring s l (Buf arr off len _ _) =+ assert (s >= 0 && s <= len) .+ assert (l >= 0 && l <= len-s) $+ Text arr (off+s) l+{-# INLINE substring #-}++#if MIN_VERSION_text(2,0,0)++lengthCodeUnits :: Text -> Int+lengthCodeUnits = lengthWord8++dropCodeUnits :: Int -> Buffer -> Text+dropCodeUnits s (Buf arr off len _ _) =+ assert (s >= 0 && s <= len) $+ Text arr (off+s) (len-s)+{-# INLINE dropCodeUnits #-}++-- | /O(1)/ Iterate (unsafely) one step forwards through a UTF-8+-- array, returning the current character and the delta to add to give+-- the next offset to iterate at.+iter :: Buffer -> Int -> Iter+iter (Buf arr off _ _ _) i = iterArray arr (off + i)+{-# INLINE iter #-}++-- | /O(1)/ Iterate one step through a UTF-8 array, returning the+-- delta to add to give the next offset to iterate at.+iter_ :: Buffer -> Int -> Int+iter_ (Buf arr off _ _ _) i = utf8LengthByLeader $ A.unsafeIndex arr (off+i)+{-# INLINE iter_ #-}++unsafeThaw :: A.Array -> ST s (A.MArray s)+unsafeThaw (A.ByteArray a) = ST $ \s# ->+ (# s#, A.MutableByteArray (unsafeCoerce# a) #)++readGen :: A.Array -> Int+readGen (A.ByteArray a) = case indexIntArray# a 0# of r# -> I# r#++writeGen :: A.MArray s -> Int -> ST s ()+writeGen (A.MutableByteArray a) (I# gen#) = ST $ \s0# ->+ case writeIntArray# a 0# gen# s0# of+ s1# -> (# s1#, () #)++#else++lengthCodeUnits :: Text -> Int+lengthCodeUnits = lengthWord16++dropCodeUnits :: Int -> Buffer -> Text+dropCodeUnits s (Buf arr off len _ _) =+ assert (s >= 0 && s <= len) $+ Text arr (off+s) (len-s)+{-# INLINE dropCodeUnits #-}++-- | /O(1)/ Iterate (unsafely) one step forwards through a UTF-16+-- array, returning the current character and the delta to add to give+-- the next offset to iterate at.+iter :: Buffer -> Int -> Iter+iter (Buf arr off _ _ _) i+ | m < 0xD800 || m > 0xDBFF = Iter (unsafeChr m) 1+ | otherwise = Iter (chr2 m n) 2+ where m = A.unsafeIndex arr j+ n = A.unsafeIndex arr k+ j = off + i+ k = j + 1+{-# INLINE iter #-}++-- | /O(1)/ Iterate one step through a UTF-16 array, returning the+-- delta to add to give the next offset to iterate at.+iter_ :: Buffer -> Int -> Int+iter_ (Buf arr off _ _ _) i | m < 0xD800 || m > 0xDBFF = 1+ | otherwise = 2+ where m = A.unsafeIndex arr (off+i)+{-# INLINE iter_ #-}++unsafeThaw :: A.Array -> ST s (A.MArray s)+unsafeThaw A.Array{..} = ST $ \s# ->+ (# s#, A.MArray (unsafeCoerce# aBA) #)++readGen :: A.Array -> Int+readGen a = case indexIntArray# (A.aBA a) 0# of r# -> I# r#++writeGen :: A.MArray s -> Int -> ST s ()+writeGen a (I# gen#) = ST $ \s0# ->+ case writeIntArray# (A.maBA a) 0# gen# s0# of+ s1# -> (# s1#, () #)++#endif
+ internal/Data/Attoparsec/Text/FastSet.hs view
@@ -0,0 +1,121 @@+{-# LANGUAGE BangPatterns #-}++------------------------------------------------------------------------------+-- |+-- Module : Data.Attoparsec.FastSet+-- Copyright : Felipe Lessa 2010, Bryan O'Sullivan 2007-2015+-- License : BSD3+--+-- Maintainer : felipe.lessa@gmail.com+-- Stability : experimental+-- Portability : unknown+--+-- Fast set membership tests for 'Char' values. We test for+-- membership using a hashtable implemented with Robin Hood+-- collision resolution. The set representation is unboxed,+-- and the characters and hashes interleaved, for efficiency.+--+--+-----------------------------------------------------------------------------+module Data.Attoparsec.Text.FastSet+ (+ -- * Data type+ FastSet+ -- * Construction+ , fromList+ , set+ -- * Lookup+ , member+ -- * Handy interface+ , charClass+ ) where++import Data.Bits ((.|.), (.&.), shiftR)+import Data.Function (on)+import Data.List (sort, sortBy)+import qualified Data.Array.Base as AB+import qualified Data.Array.Unboxed as A+import qualified Data.Text as T++data FastSet = FastSet {+ table :: {-# UNPACK #-} !(A.UArray Int Int)+ , mask :: {-# UNPACK #-} !Int+ }++data Entry = Entry {+ key :: {-# UNPACK #-} !Char+ , initialIndex :: {-# UNPACK #-} !Int+ , index :: {-# UNPACK #-} !Int+ }++offset :: Entry -> Int+offset e = index e - initialIndex e++resolveCollisions :: [Entry] -> [Entry]+resolveCollisions [] = []+resolveCollisions [e] = [e]+resolveCollisions (a:b:entries) = a' : resolveCollisions (b' : entries)+ where (a', b')+ | index a < index b = (a, b)+ | offset a < offset b = (b { index=index a }, a { index=index a + 1 })+ | otherwise = (a, b { index=index a + 1 })++pad :: Int -> [Entry] -> [Entry]+pad = go 0+ where -- ensure that we pad enough so that lookups beyond the+ -- last hash in the table fall within the array+ go !_ !m [] = replicate (max 1 m + 1) empty+ go k m (e:entries) = map (const empty) [k..i - 1] ++ e :+ go (i + 1) (m + i - k - 1) entries+ where i = index e+ empty = Entry '\0' maxBound 0++nextPowerOf2 :: Int -> Int+nextPowerOf2 0 = 1+nextPowerOf2 x = go (x - 1) 1+ where go y 32 = y + 1+ go y k = go (y .|. (y `shiftR` k)) $ k * 2++fastHash :: Char -> Int+fastHash = fromEnum++fromList :: String -> FastSet+fromList s = FastSet (AB.listArray (0, length interleaved - 1) interleaved)+ mask'+ where s' = ordNub (sort s)+ l = length s'+ mask' = nextPowerOf2 ((5 * l) `div` 4) - 1+ entries = pad mask' .+ resolveCollisions .+ sortBy (compare `on` initialIndex) .+ zipWith (\c i -> Entry c i i) s' .+ map ((.&. mask') . fastHash) $ s'+ interleaved = concatMap (\e -> [fromEnum $ key e, initialIndex e])+ entries++ordNub :: Eq a => [a] -> [a]+ordNub [] = []+ordNub (y:ys) = go y ys+ where go x (z:zs)+ | x == z = go x zs+ | otherwise = x : go z zs+ go x [] = [x]++set :: T.Text -> FastSet+set = fromList . T.unpack++-- | Check the set for membership.+member :: Char -> FastSet -> Bool+member c a = go (2 * i)+ where i = fastHash c .&. mask a+ lookupAt j b = (i' <= i) && (c == c' || b)+ where c' = toEnum $ AB.unsafeAt (table a) j+ i' = AB.unsafeAt (table a) $ j + 1+ go j = lookupAt j . lookupAt (j + 2) . lookupAt (j + 4) .+ lookupAt (j + 6) . go $ j + 8++charClass :: String -> FastSet+charClass = fromList . go+ where go (a:'-':b:xs) = [a..b] ++ go xs+ go (x:xs) = x : go xs+ go _ = ""
tests/QC/Buffer.hs view
@@ -47,6 +47,14 @@ t_unbuffer :: BPT -> Property t_unbuffer (BP _ts t buf) = t === BT.unbuffer buf +-- This test triggers both branches in Data.Attoparsec.Text.Buffer.append+-- and checks that Data.Text.Array.copyI manipulations are correct.+t_unbuffer_three :: Property+t_unbuffer_three = t_unbuffer $ toBP BT.buffer [t, t, t]+ where+ -- Make it long enough to increase chances of a segmentation fault+ t = T.replicate 1000 "\0"+ b_length :: BPB -> Property b_length (BP _ts t buf) = B.length t === BB.length buf @@ -92,6 +100,7 @@ tests = [ testProperty "b_unbuffer" b_unbuffer , testProperty "t_unbuffer" t_unbuffer+ , testProperty "t_unbuffer_three" t_unbuffer_three , testProperty "b_length" b_length , testProperty "t_length" t_length , testProperty "b_unsafeIndex" b_unsafeIndex