@@ -1,3 +1,5 @@
1+{-# LANGUAGE BangPatterns #-}
2+
13-----------------------------------------------------------------------------
24-- |
35-- Module : Text.ParserCombinators.ByteStringParser.FastSet
@@ -13,29 +15,82 @@
1315-----------------------------------------------------------------------------
1416module Text.ParserCombinators.ByteStringParser.FastSet
1517 (
18+ -- * Data type
1619 FastSet
20+ -- * Construction
1721 , set
22+ -- * Lookup
1823 , member
24+ , member8
25+ -- * Debugging
26+ , fromSet
1927 ) where
2028
21−import Data.ByteString.Char8 as SB
22−import Data.ByteString.Internal as SB
23−import Data.ByteString.Unsafe as SB
29+import qualified Data.ByteString as B
30+-- import Data.ByteString.Char8 (pack)
31+import qualified Data.ByteString.Internal as I
32+import qualified Data.ByteString.Unsafe as U
33+import Data.Word (Word8)
34+import Foreign.Storable (peekByteOff, pokeByteOff)
35+
36+data FastSet = Sorted { fromSet :: {-# UNPACK #-} !B.ByteString }
37+ | Table { fromSet :: {-# UNPACK #-} !B.ByteString }
38+ deriving (Eq, Ord)
2439
25−newtype FastSet = FastSet SB.ByteString
26− deriving (Eq, Ord, Show)
40+instance Show FastSet where
41+ show (Sorted s) = "FastSet " ++ show s
42+ show (Table t) = "FastSet " ++ fromTable t
2743
28−set :: SB.ByteString -> FastSet
29−set = FastSet . SB.sort
44+-- | The lower bound on the size of a lookup table. We choose this to
45+-- balance table density against performance.
46+tableCutoff :: Int
47+tableCutoff = 32
3048
49+-- | Create a character set.
50+set :: B.ByteString -> FastSet
51+set s | B.length s < tableCutoff = Sorted . B.sort $ s
52+ | otherwise = Table . mkTable $ s
53+
54+-- | Check the table for membership.
3155member :: Char -> FastSet -> Bool
32−member c (FastSet s) = search 0 (SB.length s - 1)
33− where w = SB.c2w c
34− search lo hi | hi < lo = False
35− | otherwise =
36− let mid = (lo + hi) `div` 2
37− cur = SB.unsafeIndex s mid
38− in case compare cur w of
39− GT -> search lo (mid - 1)
40− LT -> search (mid + 1) hi
41− _ -> True
56+member c = member8 (I.c2w c)
57+
58+-- | Check the table for membership.
59+member8 :: Word8 -> FastSet -> Bool
60+member8 w (Table t) = U.unsafeIndex t (fromIntegral w) == entry
61+member8 w (Sorted s) = search 0 (B.length s - 1)
62+ where search !lo !hi
63+ | hi < lo = False
64+ | otherwise =
65+ let mid = (lo + hi) `div` 2
66+ in case compare w (U.unsafeIndex s mid) of
67+ GT -> search lo (mid - 1)
68+ LT -> search (mid + 1) hi
69+ _ -> True
70+
71+-- | The value in a table that indicates that a character is not
72+-- present. We avoid NUL to make the table representation printable.
73+noEntry :: Word8
74+noEntry = 0x5f
75+
76+-- | The value in a table that indicates that a character is present.
77+-- We use a printable character for readability.
78+entry :: Word8
79+entry = 0x21
80+
81+mkTable :: B.ByteString -> B.ByteString
82+mkTable s = I.unsafeCreate 256 $ \t -> do
83+ I.memset t noEntry 256
84+ U.unsafeUseAsCStringLen s $ \(p, l) ->
85+ let loop n | n == l = return ()
86+ | otherwise = do
87+ c <- peekByteOff p n :: IO Word8
88+ pokeByteOff t (fromIntegral c) entry
89+ loop (n + 1)
90+ in loop 0
91+
92+-- | Turn the table representation into a string, for debugging.
93+fromTable :: B.ByteString -> String
94+fromTable = snd . B.foldr go (0xff, [])
95+ where go c (!n, cs) | c == noEntry = (n - 1, cs)
96+ | otherwise = (n - 1, I.w2c n:cs)