on master help sign in
Move the DFA LUT into Haskell

--HG-- extra : convert_revision : ec24fe9a293d988595ae56eef9571948e70d7779

commitaeade621164cc8d15f9e63e07c842702407406fc authorBryan O'Sullivan <bos@serpentine.com> dateThu 19 Aug 2010, 20:19 (16 years ago) parent2469a55
4 files changed+40−39
Data/Text/Array.hs+22−3 Data/Text/Encoding/Fusion.hs+18−10 cbits/utf8d.c−25 text.cabal−1
Data/Text/Array.hs+22−3
@@ -39,8 +39,10 @@ module Data.Text.Array
3939 , toList
4040 , unsafeFreeze
4141 , unsafeIndex
42+ , unsafeIndexWord8
4243 , unsafeNew
4344 , unsafeWrite
45+ , unsafeWriteWord8
4446 ) where
4547
4648#if defined(ASSERTS)
@@ -60,11 +62,11 @@ import Control.Exception (assert)
6062import Data.Bits ((.&.))
6163import Data.Text.UnsafeShift (shiftL, shiftR)
6264import GHC.Base (ByteArray#, MutableByteArray#, Int(..),
63− indexWord16Array#, indexWordArray#, newByteArray#,
65+ indexWord16Array#, indexWord8Array#, indexWordArray#, newByteArray#,
6466 readWord16Array#, readWordArray#, unsafeCoerce#,
65− writeWord16Array#, writeWordArray#)
67+ writeWord16Array#, writeWord8Array#, writeWordArray#)
6668import GHC.ST (ST(..), runST)
67−import GHC.Word (Word16(..), Word(..))
69+import GHC.Word (Word16(..), Word8(..), Word(..))
6870import Prelude hiding (length, read)
6971
7072-- | Immutable array type.
@@ -134,6 +136,14 @@ unsafeIndexWord (Array len ba#) i@(I# i#) =
134136 case indexWordArray# ba# i# of r# -> (W# r#)
135137{-# INLINE unsafeIndexWord #-}
136138
139+-- | Unchecked read of an immutable array. May return garbage or
140+-- crash on an out-of-bounds access.
141+unsafeIndexWord8 :: Array -> Int -> Word8
142+unsafeIndexWord8 (Array len ba#) i@(I# i#) =
143+ CHECK_BOUNDS("unsafeIndexWord8",len,i)
144+ case indexWord8Array# ba# i# of r# -> (W8# r#)
145+{-# INLINE unsafeIndexWord8 #-}
146+
137147-- | Unchecked read of a mutable array. May return garbage or
138148-- crash on an out-of-bounds access.
139149unsafeRead :: MArray s -> Int -> ST s Word16
@@ -170,6 +180,15 @@ unsafeWriteWord (MArray len marr#) i@(I# i#) (W# e#) = ST $ \s1# ->
170180 s2# -> (# s2#, () #)
171181{-# INLINE unsafeWriteWord #-}
172182
183+-- | Unchecked write of a mutable array. May return garbage or crash
184+-- on an out-of-bounds access.
185+unsafeWriteWord8 :: MArray s -> Int -> Word8 -> ST s ()
186+unsafeWriteWord8 (MArray len marr#) i@(I# i#) (W8# e#) = ST $ \s1# ->
187+ CHECK_BOUNDS("unsafeWriteWord8",len,i)
188+ case writeWord8Array# marr# i# e# s1# of
189+ s2# -> (# s2#, () #)
190+{-# INLINE unsafeWriteWord8 #-}
191+
173192-- | Convert an immutable array to a list.
174193toList :: Array -> [Word16]
175194toList a = loop 0
Data/Text/Encoding/Fusion.hs+18−10
@@ -1,4 +1,4 @@
1−{-# LANGUAGE BangPatterns, CPP, ForeignFunctionInterface, Rank2Types #-}
1+{-# LANGUAGE BangPatterns, CPP, Rank2Types #-}
22
33-- |
44-- Module : Data.Text.Encoding.Fusion
@@ -36,18 +36,17 @@ import Control.Exception (assert)
3636#endif
3737import Data.Bits ((.&.), (.|.))
3838import Data.ByteString.Internal (ByteString(..), mallocByteString, memcpy)
39+import Control.Monad.ST
40+import Data.Text.Array
3941import Data.Text.Fusion (Step(..), Stream(..))
4042import Data.Text.Fusion.Size
4143import Data.Text.Encoding.Error
4244import Data.Text.Encoding.Fusion.Common
43−import Data.Text.Unsafe (inlinePerformIO)
4445import Data.Text.UnsafeChar (unsafeChr, unsafeChr8, unsafeChr32)
4546import Data.Text.UnsafeShift (shiftL, shiftR)
4647import Data.Word (Word8, Word16, Word32)
4748import Foreign.ForeignPtr (withForeignPtr, ForeignPtr)
48−import Foreign.Ptr (Ptr, plusPtr)
49−import GHC.Ptr (Ptr(..))
50−import Foreign.Storable (peek, pokeByteOff)
49+import Foreign.Storable (pokeByteOff)
5150import System.IO.Unsafe (unsafePerformIO)
5251import qualified Data.ByteString as B
5352import qualified Data.ByteString.Unsafe as B
@@ -108,7 +107,7 @@ streamUtf8 onErr bs = Stream next (S8 accept 0 0) (maxSize l)
108107 byte = B.unsafeIndex bs i
109108 word = fromIntegral byte
110109 peeku :: Int -> Word32
111− peeku n = fromIntegral (inlinePerformIO (peek (utf8d `plusPtr` n) :: IO Word8))
110+ peeku n = fromIntegral (unsafeIndexWord8 utf8d n)
112111 !kind = peeku (fromIntegral word)
113112 !code' | state /= accept = (word .&. 0x3f) .|. (code `shiftL` 6)
114113 | otherwise = (0xff `shiftR` fromIntegral kind) .&. word
@@ -234,8 +233,17 @@ decodeError func kind onErr mb i =
234233 where desc = "Data.Text.Encoding.Fusion." ++ func ++ ": Invalid " ++
235234 kind ++ " stream"
236235
237−utf8d :: Ptr Word8
238−utf8d@(Ptr _) = hs_utf8d
236+utf8d :: Array
239237{-# NOINLINE utf8d #-}
240−
241−foreign import ccall unsafe "__hs_utf8d" hs_utf8d :: Ptr Word8
238+utf8d = runST fill where
239+ fill = do
240+ ary <- unsafeNew . (`div` 2) . sum . map fst $ xs
241+ mapM_ (uncurry (unsafeWriteWord8 ary))
242+ (zip [0..] (concatMap (uncurry replicate) xs))
243+ unsafeFreeze ary
244+ xs = [(128,0),(16,1),(16,9),(32,7),(2,8),(30,2),(1,10),(12,3),(1,4),(2,3),
245+ (1,11),(3,6),(1,5),(11,8),(1,0),(1,12),(1,24),(1,36),(1,60),(1,96),
246+ (1,84),(3,12),(1,48),(1,72),(13,12),(1,0),(5,12),(1,0),(1,12),(1,0),
247+ (3,12),(1,24),(5,12),(1,24),(1,12),(1,24),(9,12),(1,24),(5,12),(1,24),
248+ (7,12),(1,24),(9,12),(1,36),(1,12),(1,36),(3,12),(1,36),(5,12),(1,36),
249+ (1,12),(1,36),(3,12),(1,36),(10,12)]
cbits/utf8d.cdeleted−25
@@ -1,25 +0,0 @@
1−static const unsigned char utf8d[364] = {
2− // The first part of the table maps bytes to character classes that
3− // to reduce the size of the transition table and create bitmasks.
4− 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
5− 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
6− 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
7− 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
8− 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, 9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,
9− 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7, 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,
10− 8,8,2,2,2,2,2,2,2,2,2,2,2,2,2,2, 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,
11− 10,3,3,3,3,3,3,3,3,3,3,3,3,4,3,3, 11,6,6,6,5,8,8,8,8,8,8,8,8,8,8,8,
12−
13− // The second part is a transition table that maps a combination
14− // of a state of the automaton and a character class to a state.
15− 0,12,24,36,60,96,84,12,12,12,48,72, 12,12,12,12,12,12,12,12,12,12,12,12,
16− 12, 0,12,12,12,12,12, 0,12, 0,12,12, 12,24,12,12,12,12,12,24,12,24,12,12,
17− 12,12,12,12,12,12,12,24,12,12,12,12, 12,24,12,12,12,12,12,12,12,24,12,12,
18− 12,12,12,12,12,12,12,36,12,36,12,12, 12,36,12,12,12,12,12,36,12,36,12,12,
19− 12,36,12,12,12,12,12,12,12,12,12,12,
20−};
21−
22−const unsigned char *__hs_utf8d()
23−{
24− return utf8d;
25−}
text.cabal−1
@@ -33,7 +33,6 @@ flag developer
3333 default: False
3434
3535library
36− c-sources: cbits/utf8d.c
3736 exposed-modules:
3837 Data.Text
3938 Data.Text.Encoding