diff --git a/Data/Attoparsec/ByteString.hs b/Data/Attoparsec/ByteString.hs --- a/Data/Attoparsec/ByteString.hs +++ b/Data/Attoparsec/ByteString.hs @@ -63,6 +63,7 @@ , I.skipWhile , I.take , I.scan + , I.runScanner , I.takeWhile , I.takeWhile1 , I.takeTill diff --git a/Data/Attoparsec/ByteString/Char8.hs b/Data/Attoparsec/ByteString/Char8.hs --- a/Data/Attoparsec/ByteString/Char8.hs +++ b/Data/Attoparsec/ByteString/Char8.hs @@ -444,9 +444,8 @@ -- | Parse and decode an unsigned decimal number. decimal :: Integral a => Parser a -decimal = B8.foldl' step 0 `fmap` I.takeWhile1 isDig - where isDig w = w >= 48 && w <= 57 - step a w = a * 10 + fromIntegral (w - 48) +decimal = B8.foldl' step 0 `fmap` I.takeWhile1 isDigit_w8 + where step a w = a * 10 + fromIntegral (w - 48) {-# SPECIALISE decimal :: Parser Int #-} {-# SPECIALISE decimal :: Parser Int8 #-} {-# SPECIALISE decimal :: Parser Int16 #-} diff --git a/Data/Attoparsec/Text.hs b/Data/Attoparsec/Text.hs --- a/Data/Attoparsec/Text.hs +++ b/Data/Attoparsec/Text.hs @@ -72,6 +72,7 @@ , skipSpace , I.skipWhile , I.scan + , I.runScanner , I.take , I.takeWhile , I.takeWhile1 diff --git a/Data/Attoparsec/Text/FastSet.hs b/Data/Attoparsec/Text/FastSet.hs --- a/Data/Attoparsec/Text/FastSet.hs +++ b/Data/Attoparsec/Text/FastSet.hs @@ -1,116 +1,38 @@ -{-# LANGUAGE BangPatterns #-} - ------------------------------------------------------------------------------- -- | --- Module : Data.Attoparsec.FastSet --- Copyright : Felipe Lessa 2010, Bryan O'Sullivan 2007-2015 +-- Module : Data.Attoparsec.Text.FastSet +-- Copyright : Bryan O'Sullivan 2015 -- License : BSD3 -- --- Maintainer : felipe.lessa@gmail.com +-- Maintainer : bos@serpentine.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. --- --- ------------------------------------------------------------------------------ +-- Fast set membership tests for 'Char' values. + 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 go !_ !m [] = replicate (max 1 m) 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 +import qualified Data.IntSet as I +import Data.Char (ord) -fastHash :: Char -> Int -fastHash = fromEnum +newtype FastSet = FastSet I.IntSet 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 +fromList = FastSet . I.fromList . map ord -- | 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 +member c (FastSet s) = I.member (ord c) s +{-# INLINE member #-} charClass :: String -> FastSet charClass = fromList . go diff --git a/Data/Attoparsec/Zepto.hs b/Data/Attoparsec/Zepto.hs --- a/Data/Attoparsec/Zepto.hs +++ b/Data/Attoparsec/Zepto.hs @@ -41,11 +41,14 @@ import Control.Monad.IO.Class (MonadIO(..)) import Data.ByteString (ByteString) import Data.Functor.Identity (Identity(runIdentity)) -import Data.Monoid (Monoid(..)) import Data.Word (Word8) import Prelude hiding (take, takeWhile) import qualified Data.ByteString as B import qualified Data.ByteString.Unsafe as B + +#if !MIN_VERSION_base(4,8,0) +import Data.Monoid (Monoid(..)) +#endif newtype S = S { input :: ByteString diff --git a/attoparsec.cabal b/attoparsec.cabal --- a/attoparsec.cabal +++ b/attoparsec.cabal @@ -1,5 +1,5 @@ name: attoparsec -version: 0.13.0.0 +version: 0.13.0.1 license: BSD3 license-file: LICENSE category: Text, Parsing @@ -74,6 +74,7 @@ if flag(developer) ghc-prof-options: -auto-all + ghc-options: -Werror test-suite tests type: exitcode-stdio-1.0 @@ -92,10 +93,14 @@ ghc-options: -Wall -threaded -rtsopts + if flag(developer) + ghc-options: -Werror + build-depends: array, base >= 4 && < 5, bytestring, + containers, deepseq >= 1.1, QuickCheck >= 2.7, quickcheck-unicode, @@ -118,14 +123,20 @@ HeadersText Links Numbers + Sets + TextFastSet Warp ghc-options: -O2 -Wall + if flag(developer) + ghc-options: -Werror + build-depends: array, base == 4.*, bytestring >= 0.10.4.0, case-insensitive, + containers, criterion >= 1.0, deepseq >= 1.1, directory, diff --git a/benchmarks/Benchmarks.hs b/benchmarks/Benchmarks.hs --- a/benchmarks/Benchmarks.hs +++ b/benchmarks/Benchmarks.hs @@ -28,6 +28,7 @@ import qualified HeadersText import qualified Links import qualified Text.Parsec as P +import qualified Sets main :: IO () main = do @@ -86,6 +87,7 @@ , headersT , Links.links , numbers + , Sets.benchmarks , Warp.benchmarks ] diff --git a/benchmarks/Sets.hs b/benchmarks/Sets.hs new file mode 100644 --- /dev/null +++ b/benchmarks/Sets.hs @@ -0,0 +1,21 @@ +module Sets (benchmarks) where + +import Criterion +import Data.Char (ord) +import qualified Data.Attoparsec.Text.FastSet as FastSet +import qualified TextFastSet +import qualified Data.HashSet as HashSet +import qualified Data.IntSet as IntSet + +smallSet :: String +smallSet = ['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9'] + +benchmarks :: Benchmark +benchmarks = bgroup "sets" [ + bench "Fast" $ whnf (FastSet.member '*') (FastSet.fromList smallSet) + , bench "Hash" $ whnf (HashSet.member '*') (HashSet.fromList smallSet) + , bench "Int" $ whnf (IntSet.member (ord '*')) + (IntSet.fromList (map ord smallSet)) + , bench "TextFast" $ whnf (TextFastSet.member '*') + (TextFastSet.fromList smallSet) + ] diff --git a/benchmarks/TextFastSet.hs b/benchmarks/TextFastSet.hs new file mode 100644 --- /dev/null +++ b/benchmarks/TextFastSet.hs @@ -0,0 +1,119 @@ +{-# 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 TextFastSet + ( + -- * 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 go !_ !m [] = replicate (max 1 m) 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 _ = "" diff --git a/benchmarks/attoparsec-benchmarks.cabal b/benchmarks/attoparsec-benchmarks.cabal --- a/benchmarks/attoparsec-benchmarks.cabal +++ b/benchmarks/attoparsec-benchmarks.cabal @@ -16,6 +16,7 @@ Links Numbers Network.Wai.Handler.Warp.ReadInt + Sets Warp hs-source-dirs: .. . warp-3.0.1.1 ghc-options: -O2 -Wall -rtsopts @@ -24,6 +25,7 @@ base == 4.*, bytestring >= 0.10.4.0, case-insensitive, + containers, criterion >= 1.0, deepseq >= 1.1, directory, @@ -33,5 +35,6 @@ parsec >= 3.1.2, scientific >= 0.3.1, text >= 1.1.1.0, + transformers, unordered-containers, vector diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,8 @@ +0.13.0.1 + +* Fixed a bug in the implementations of inClass and notInClass for + Text (https://github.com/bos/attoparsec/issues/103) + 0.13.0.0 * Made the parser type in the Zepto module a monad transformer