@@ -1,4 +1,4 @@
1−-----------------------------------------------------------------------------
1+------------------------------------------------------------------------------
22-- |
33-- Module : Data.Attoparsec.FastSet
44-- Copyright : Felipe Lessa 2010, Bryan O'Sullivan 2007-2014
@@ -8,9 +8,11 @@
88-- Stability : experimental
99-- Portability : unknown
1010--
11−-- Fast set membership tests for 'Char' values. The set
12−-- representation is unboxed for efficiency. We test for
13−-- membership using a binary search.
11+-- Fast set membership tests for 'Char' values. We test for
12+-- membership using a hashtable implemented with Robin Hood
13+-- collision resolution. The set representation is unboxed,
14+-- and the characters and hashes interleaved, for efficiency.
15+--
1416--
1517-----------------------------------------------------------------------------
1618module Data.Attoparsec.Text.FastSet
@@ -26,38 +28,76 @@ module Data.Attoparsec.Text.FastSet
2628 , charClass
2729 ) where
2830
29−import Data.List (sort)
31+import Data.Bits
32+import Data.List (sort, sortBy, nub)
33+import Data.Function (on)
3034import qualified Data.Array.Base as AB
3135import qualified Data.Array.Unboxed as A
3236import qualified Data.Text as T
3337
34−newtype FastSet = FastSet (A.UArray Int Char)
38+data FastSet = FastSet {table :: {-# UNPACK #-} !(A.UArray Int Int),
39+ mask :: {-# UNPACK #-} !Int}
3540 deriving (Eq, Ord, Show)
41+
42+data Entry = Entry {key :: {-# UNPACK #-} !Char,
43+ initialIndex :: {-# UNPACK #-} !Int,
44+ index :: {-# UNPACK #-} !Int} deriving (Show)
45+
46+offset :: Entry -> Int
47+offset e = index e - initialIndex e
3648
37−-- | Create a set.
38−set :: T.Text -> FastSet
39−set t = mkSet (T.length t) (sort $ T.unpack t)
40−
41−fromList :: [Char] -> FastSet
42−fromList cs = mkSet (length cs) (sort cs)
43−
44−mkSet :: Int -> [Char] -> FastSet
45−mkSet l = FastSet . A.listArray (0,l-1)
49+resolveCollisions :: [Entry] -> [Entry]
50+resolveCollisions [] = []
51+resolveCollisions [e] = [e]
52+resolveCollisions (a:b:entries) = a' : resolveCollisions (b':entries)
53+ where (a', b')
54+ | index a < index b = (a, b)
55+ | offset a < offset b = (b{index=index a}, a{index=index a + 1})
56+ | otherwise = (a, b{index=index a + 1})
57+
58+pad :: Int -> [Entry]-> [Entry]
59+pad = go 0
60+ where go _ m [] = replicate (max 1 m) empty
61+ go k m (e:entries) = map (const empty) [k..i - 1] ++ e : go (i + 1) (m + i - k - 1) entries
62+ where i = index e
63+ empty = Entry '\0' maxBound 0
64+
65+nextPowerOf2 :: Int -> Int
66+nextPowerOf2 0 = 1
67+nextPowerOf2 x = go (x - 1) 1
68+ where go y 32 = y + 1
69+ go y k = go (y .|. (y `shiftR` k)) $ k * 2
70+
71+fastHash :: Char -> Int
72+fastHash = fromEnum
4673
74+fromList :: String -> FastSet
75+fromList s = FastSet (AB.listArray (0, length interleaved - 1) interleaved) mask'
76+ where s' = nub $ sort s
77+ l = length s'
78+ mask' = nextPowerOf2 ((5 * l) `div` 4) - 1
79+ indeces = map ((.&. mask') . fastHash) s'
80+ entries = pad mask' .
81+ resolveCollisions .
82+ sortBy (compare `on` initialIndex) $
83+ zipWith (\c i -> Entry c i i) s' indeces
84+ interleaved = concatMap (\e -> [fromEnum $ key e, initialIndex e]) entries
85+
86+set :: T.Text -> FastSet
87+set = fromList . T.unpack
88+
4789-- | Check the set for membership.
4890member :: Char -> FastSet -> Bool
49−member c (FastSet a) = uncurry search (A.bounds a)
50− where search lo hi
51− | hi < lo = False
52− | otherwise =
53− let mid = (lo + hi) `quot` 2
54− in case compare c (AB.unsafeAt a mid) of
55− GT -> search (mid + 1) hi
56− LT -> search lo (mid - 1)
57− _ -> True
58−
91+member c a = go (2 * i)
92+ where i = fastHash c .&. mask a
93+ lookupAt j b = (i' <= i) && (c == c' || b)
94+ where c' = toEnum $ AB.unsafeAt (table 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)
97+
5998charClass :: String -> FastSet
6099charClass = fromList . go
61100 where go (a:'-':b:xs) = [a..b] ++ go xs
62101 go (x:xs) = x : go xs
63102 go _ = ""
103+