@@ -1,4 +1,4 @@
1−-----------------------------------------------------------------------------
1+------------------------------------------------------------------------------
3-- Module : Data.Attoparsec.FastSet
3-- Module : Data.Attoparsec.FastSet
4-- Copyright : Felipe Lessa 2010, Bryan O'Sullivan 2007-2014
4-- Copyright : Felipe Lessa 2010, Bryan O'Sullivan 2007-2014
@@ -8,10 +8,11 @@
8-- Stability : experimental
8-- Stability : experimental
9-- Portability : unknown
9-- Portability : unknown
11−-- Fast set membership tests for 'Char' values. The set
11+-- Fast set membership tests for 'Char' values. We test for
12−-- representation is unboxed for efficiency. We test for
13-- membership using a hashtable implemented with Robin Hood
12-- membership using a hashtable implemented with Robin Hood
14−-- collision resolution.
13+-- collision resolution. The set representation is unboxed,
14+-- and the characters and hashes interleaved, for efficiency.
16-----------------------------------------------------------------------------
17-----------------------------------------------------------------------------
17module Data.Attoparsec.Text.FastSet
18module Data.Attoparsec.Text.FastSet
@@ -34,8 +35,7 @@ import qualified Data.Array.Base as AB
34import qualified Data.Array.Unboxed as A
35import qualified Data.Array.Unboxed as A
35import qualified Data.Text as T
36import qualified Data.Text as T
37−data FastSet = FastSet {keys :: {-# UNPACK #-} !(A.UArray Int Char),
38− initialIndeces :: {-# UNPACK #-} !(A.UArray Int Int),
38+data FastSet = FastSet {table :: {-# UNPACK #-} !(A.UArray Int Int),
39 mask :: {-# UNPACK #-} !Int}
39 mask :: {-# UNPACK #-} !Int}
40 deriving (Eq, Ord, Show)
40 deriving (Eq, Ord, Show)
@@ -58,8 +58,8 @@ resolveCollisions (a:b:entries) = a' : resolveCollisions (b':entries)
58pad :: Int -> [Entry]-> [Entry]
58pad :: Int -> [Entry]-> [Entry]
60 where go _ m [] = replicate (max 1 m) empty
60 where go _ m [] = replicate (max 1 m) empty
61− go k m (e:entries) = map (const empty) [k..o - 1] ++ e : go (o + 1) (m + o - k - 1) entries
61+ go k m (e:entries) = map (const empty) [k..i - 1] ++ e : go (i + 1) (m + i - k - 1) entries
62− where o = index e
62+ where i = index e
63 empty = Entry '\0' maxBound 0
63 empty = Entry '\0' maxBound 0
65nextPowerOf2 :: Int -> Int
65nextPowerOf2 :: Int -> Int
@@ -72,7 +72,7 @@ fastHash :: Char -> Int
72fastHash = fromEnum
72fastHash = fromEnum
74fromList :: String -> FastSet
74fromList :: String -> FastSet
75−fromList s = FastSet (arr key) (arr initialIndex) mask'
75+fromList s = FastSet (AB.listArray (0, length interleaved - 1) interleaved) mask'
76 where s' = nub $ sort s
76 where s' = nub $ sort s
77 l = length s'
77 l = length s'
78 mask' = nextPowerOf2 ((5 * l) `div` 4) - 1
78 mask' = nextPowerOf2 ((5 * l) `div` 4) - 1
@@ -80,26 +80,24 @@ fromList s = FastSet (arr key) (arr initialIndex) mask'
80 entries = pad mask' .
80 entries = pad mask' .
81 resolveCollisions .
81 resolveCollisions .
82 sortBy (compare `on` initialIndex) $
82 sortBy (compare `on` initialIndex) $
83− zipWith (\c o -> Entry c o o) s' indeces
83+ zipWith (\c i -> Entry c i i) s' indeces
84− arr :: A.IArray a e => (Entry -> e) -> a Int e
84+ interleaved = concatMap (\(c, i) -> [c,i]) $ zip (map (fromEnum . key) entries) (map initialIndex entries)
85− arr f = AB.listArray (0, length entries - 1) $ map f entries
85+
87set :: T.Text -> FastSet
86set :: T.Text -> FastSet
88set = fromList . T.unpack
87set = fromList . T.unpack
90-- | Check the set for membership.
89-- | Check the set for membership.
91member :: Char -> FastSet -> Bool
90member :: Char -> FastSet -> Bool
92−member c a = go i
91+member c a = go (2 * i)
93− where i = (fastHash c .&. mask a)
92+ where i = fastHash c .&. mask a
94− go j
93+ lookupAt j b = (i' <= i) && (c == c' || b)
96− | i' == i && c == c' = True
97− | otherwise = go (j + 1)
98− where i' = AB.unsafeAt (initialIndeces a) j
94+ where c' = toEnum $ AB.unsafeAt (table a) j
99− c' = AB.unsafeAt (keys a) j
95+ i' = AB.unsafeAt (table a) $ j + 1
96+ go j = lookupAt j $ lookupAt (j + 2) $ lookupAt (j + 4) $ lookupAt (j + 6) $ go (j + 8)
101charClass :: String -> FastSet
98charClass :: String -> FastSet
102charClass = fromList . go
99charClass = fromList . go
103 where go (a:'-':b:xs) = [a..b] ++ go xs
100 where go (a:'-':b:xs) = [a..b] ++ go xs
104 go (x:xs) = x : go xs
101 go (x:xs) = x : go xs
105 go _ = ""
102 go _ = ""