@@ -0,0 +1,119 @@
1+{-# LANGUAGE BangPatterns #-}
2+
3+------------------------------------------------------------------------------
4+-- |
5+-- Module : Data.Attoparsec.FastSet
6+-- Copyright : Felipe Lessa 2010, Bryan O'Sullivan 2007-2015
7+-- License : BSD3
8+--
9+-- Maintainer : felipe.lessa@gmail.com
10+-- Stability : experimental
11+-- Portability : unknown
12+--
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+-----------------------------------------------------------------------------
20+module TextFastSet
21+ (
22+ -- * Data type
23+ FastSet
24+ -- * Construction
25+ , fromList
26+ , set
27+ -- * Lookup
28+ , member
29+ -- * Handy interface
30+ , charClass
31+ ) where
32+
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+ }
50+
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
79+
80+fromList :: String -> FastSet
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
104+
105+-- | Check the set for membership.
106+member :: Char -> FastSet -> Bool
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
114+
115+charClass :: String -> FastSet
116+charClass = fromList . go
117+ where go (a:'-':b:xs) = [a..b] ++ go xs
118+ go (x:xs) = x : go xs
119+ go _ = ""