@@ -1,38 +1,116 @@
1+{-# LANGUAGE BangPatterns #-}
2+
3+------------------------------------------------------------------------------
14-- |
2−-- Module : Data.Attoparsec.Text.FastSet
3−-- Copyright : Bryan O'Sullivan 2015
5+-- Module : Data.Attoparsec.FastSet
6+-- Copyright : Felipe Lessa 2010, Bryan O'Sullivan 2007-2015
47-- License : BSD3
58--
6−-- Maintainer : bos@serpentine.com
9+-- Maintainer : felipe.lessa@gmail.com
710-- Stability : experimental
811-- Portability : unknown
912--
10−-- Fast set membership tests for 'Char' values.
11−
13+-- Fast set membership tests for 'Char' values. We test for
14+-- membership using a hashtable implemented with Robin Hood
15+-- collision resolution. The set representation is unboxed,
16+-- and the characters and hashes interleaved, for efficiency.
17+--
18+--
19+-----------------------------------------------------------------------------
1220module Data.Attoparsec.Text.FastSet
1321 (
1422 -- * Data type
1523 FastSet
1624 -- * Construction
1725 , fromList
26+ , set
1827 -- * Lookup
1928 , member
2029 -- * Handy interface
2130 , charClass
2231 ) where
2332
24−import qualified Data.IntSet as I
25−import Data.Char (ord)
33+import Data.Bits ((.|.), (.&.), shiftR)
34+import Data.Function (on)
35+import Data.List (sort, sortBy)
36+import qualified Data.Array.Base as AB
37+import qualified Data.Array.Unboxed as A
38+import qualified Data.Text as T
39+
40+data FastSet = FastSet {
41+ table :: {-# UNPACK #-} !(A.UArray Int Int)
42+ , mask :: {-# UNPACK #-} !Int
43+ }
44+
45+data Entry = Entry {
46+ key :: {-# UNPACK #-} !Char
47+ , initialIndex :: {-# UNPACK #-} !Int
48+ , index :: {-# UNPACK #-} !Int
49+ }
2650
27−newtype FastSet = FastSet I.IntSet
51+offset :: Entry -> Int
52+offset e = index e - initialIndex e
53+
54+resolveCollisions :: [Entry] -> [Entry]
55+resolveCollisions [] = []
56+resolveCollisions [e] = [e]
57+resolveCollisions (a:b:entries) = a' : resolveCollisions (b' : entries)
58+ where (a', b')
59+ | index a < index b = (a, b)
60+ | offset a < offset b = (b { index=index a }, a { index=index a + 1 })
61+ | otherwise = (a, b { index=index a + 1 })
62+
63+pad :: Int -> [Entry] -> [Entry]
64+pad = go 0
65+ where go !_ !m [] = replicate (max 1 m) empty
66+ go k m (e:entries) = map (const empty) [k..i - 1] ++ e :
67+ go (i + 1) (m + i - k - 1) entries
68+ where i = index e
69+ empty = Entry '\0' maxBound 0
70+
71+nextPowerOf2 :: Int -> Int
72+nextPowerOf2 0 = 1
73+nextPowerOf2 x = go (x - 1) 1
74+ where go y 32 = y + 1
75+ go y k = go (y .|. (y `shiftR` k)) $ k * 2
76+
77+fastHash :: Char -> Int
78+fastHash = fromEnum
2879
2980fromList :: String -> FastSet
30−fromList = FastSet . I.fromList . map ord
81+fromList s = FastSet (AB.listArray (0, length interleaved - 1) interleaved)
82+ mask'
83+ where s' = ordNub (sort s)
84+ l = length s'
85+ mask' = nextPowerOf2 ((5 * l) `div` 4) - 1
86+ entries = pad mask' .
87+ resolveCollisions .
88+ sortBy (compare `on` initialIndex) .
89+ zipWith (\c i -> Entry c i i) s' .
90+ map ((.&. mask') . fastHash) $ s'
91+ interleaved = concatMap (\e -> [fromEnum $ key e, initialIndex e])
92+ entries
93+
94+ordNub :: Eq a => [a] -> [a]
95+ordNub [] = []
96+ordNub (y:ys) = go y ys
97+ where go x (z:zs)
98+ | x == z = go x zs
99+ | otherwise = x : go z zs
100+ go x [] = [x]
101+
102+set :: T.Text -> FastSet
103+set = fromList . T.unpack
31104
32105-- | Check the set for membership.
33106member :: Char -> FastSet -> Bool
34−member c (FastSet s) = I.member (ord c) s
35−{-# INLINE member #-}
107+member c a = go (2 * i)
108+ where i = fastHash c .&. mask a
109+ lookupAt j b = (i' <= i) && (c == c' || b)
110+ where c' = toEnum $ AB.unsafeAt (table a) j
111+ i' = AB.unsafeAt (table a) $ j + 1
112+ go j = lookupAt j . lookupAt (j + 2) . lookupAt (j + 4) .
113+ lookupAt (j + 6) . go $ j + 8
36114
37115charClass :: String -> FastSet
38116charClass = fromList . go