git.iko.soy/typeable/attoparsec
on master help sign in
Switch to a Buffer-driven implementation for Text

--HG-- rename : Data/Attoparsec/ByteString/Buffer.hs => Data/Attoparsec/Text/Buffer.hs

commitdf8cd39dad8d07638fcb087c317cb43f95db4709 authorBryan O'Sullivan <bos@serpentine.com> dateTue 20 May 2014, 22:43 (12 years ago) parent8ccebee
3 files changed+166−33
compare with master
unifiedsplit
Data/Attoparsec/Text/Buffer.hs+128 Data/Attoparsec/Text/Internal.hs+35−30 attoparsec.cabal+3−3
Data/Attoparsec/Text/Buffer.hsnew file+128
@@ -0,0 +1,128 @@
1+{-# LANGUAGE MagicHash, RankNTypes, RecordWildCards, UnboxedTuples #-}
2+
3+-- |
4+-- Module : Data.Attoparsec.Text.Buffer
5+-- Copyright : Bryan O'Sullivan 2007-2014
6+-- License : BSD3
7+--
8+-- Maintainer : bos@serpentine.com
9+-- Stability : experimental
10+-- Portability : GHC
11+--
12+-- An immutable buffer that supports cheap appends.
13+
14+-- A Buffer is divided into an immutable read-only zone, followed by a
15+-- mutable area that we've preallocated, but not yet written to.
16+--
17+-- We overallocate at the end of a Buffer so that we can cheaply
18+-- append. Since a user of an existing Buffer cannot see past the end
19+-- of its immutable zone into the data that will change during an
20+-- append, this is safe.
21+--
22+-- Once we run out of space at the end of a Buffer, we do the usual
23+-- doubling of the buffer size.
24+
25+module Data.Attoparsec.Text.Buffer
26+ (
27+ Buffer
28+ , buffer
29+ , unbuffer
30+ , length
31+ , iter
32+ , iter_
33+ , substring
34+ , dropWord16
35+ ) where
36+
37+import Control.Exception (assert)
38+import Data.Monoid (Monoid(..))
39+import Data.Text.Internal (Text(..))
40+import Data.Text.Internal.Encoding.Utf16 (chr2)
41+import Data.Text.Internal.Unsafe.Char (unsafeChr)
42+import Data.Text.Unsafe (Iter(..))
43+import GHC.Base (unsafeCoerce#)
44+import GHC.ST (ST(..), runST)
45+import Prelude hiding (length)
46+import qualified Data.Text.Array as A
47+
48+data Buffer = Buf {
49+ _arr :: {-# UNPACK #-} !A.Array
50+ , _off :: {-# UNPACK #-} !Int
51+ , _len :: {-# UNPACK #-} !Int
52+ , _cap :: {-# UNPACK #-} !Int
53+ }
54+
55+instance Show Buffer where
56+ showsPrec p = showsPrec p . unbuffer
57+
58+-- | The initial 'Buffer' has no mutable zone, so we can avoid all
59+-- copies in the (hopefully) common case of no further input being fed
60+-- to us.
61+buffer :: Text -> Buffer
62+buffer (Text arr off len) = Buf arr off len len
63+
64+unbuffer :: Buffer -> Text
65+unbuffer (Buf arr off len _cap) = Text arr off len
66+
67+instance Monoid Buffer where
68+ mempty = Buf A.empty 0 0 0
69+
70+ mappend (Buf _ _ _ 0) b = b
71+ mappend a (Buf _ _ _ 0) = a
72+ mappend (Buf arr0 off0 len0 cap0) (Buf arr1 off1 len1 _cap1) = runST $ do
73+ let newlen = len0 + len1
74+ if newlen <= cap0
75+ then do
76+ marr <- unsafeThaw arr0
77+ A.copyI marr (off0+len0) arr1 off1 (off0+newlen)
78+ arr2 <- A.unsafeFreeze marr
79+ return (Buf arr2 off0 newlen cap0)
80+ else do
81+ let newcap = newlen * 2
82+ marr <- A.new newcap
83+ A.copyI marr 0 arr0 off0 len0
84+ A.copyI marr len0 arr1 off1 newlen
85+ arr2 <- A.unsafeFreeze marr
86+ return (Buf arr2 0 newlen newcap)
87+
88+length :: Buffer -> Int
89+length (Buf _ _ len _) = len
90+{-# INLINE length #-}
91+
92+substring :: Int -> Int -> Buffer -> Text
93+substring s l (Buf arr off len _cap) =
94+ assert (s >= 0 && s <= len) .
95+ assert (l >= 0 && l <= len-s) $
96+ Text arr (off+s) l
97+{-# INLINE substring #-}
98+
99+dropWord16 :: Int -> Buffer -> Text
100+dropWord16 s (Buf arr off len _cap) =
101+ assert (s >= 0 && s <= len) $
102+ Text arr (off+s) (len-s)
103+{-# INLINE dropWord16 #-}
104+
105+-- | /O(1)/ Iterate (unsafely) one step forwards through a UTF-16
106+-- array, returning the current character and the delta to add to give
107+-- the next offset to iterate at.
108+iter :: Buffer -> Int -> Iter
109+iter (Buf arr off _len _cap) i
110+ | m < 0xD800 || m > 0xDBFF = Iter (unsafeChr m) 1
111+ | otherwise = Iter (chr2 m n) 2
112+ where m = A.unsafeIndex arr j
113+ n = A.unsafeIndex arr k
114+ j = off + i
115+ k = j + 1
116+{-# INLINE iter #-}
117+
118+-- | /O(1)/ Iterate one step through a UTF-16 array, returning the
119+-- delta to add to give the next offset to iterate at.
120+iter_ :: Buffer -> Int -> Int
121+iter_ (Buf arr off _len _cap) i | m < 0xD800 || m > 0xDBFF = 1
122+ | otherwise = 2
123+ where m = A.unsafeIndex arr (off+i)
124+{-# INLINE iter_ #-}
125+
126+unsafeThaw :: A.Array -> ST s (A.MArray s)
127+unsafeThaw A.Array{..} = ST $ \s# ->
128+ (# s#, A.MArray (unsafeCoerce# aBA) #)
Data/Attoparsec/Text/Internal.hs+35−30
@@ -69,20 +69,22 @@ import Control.Applicative ((<|>), (<$>))
6969import Control.Monad (when)
7070import Data.Attoparsec.Combinator ((<?>))
7171import Data.Attoparsec.Internal.Types hiding (Parser, Failure, Success)
72+import qualified Data.Attoparsec.Text.Buffer as Buf
73+import Data.Attoparsec.Text.Buffer (Buffer, buffer)
7274import Data.Char (chr, ord)
7375import Data.String (IsString(..))
7476import Data.Text.Internal (Text(..))
75−import Prelude hiding (getChar, succ, take, takeWhile)
77+import Prelude hiding (getChar, length, succ, take, takeWhile)
7678import qualified Data.Attoparsec.Internal.Types as T
7779import qualified Data.Attoparsec.Text.FastSet as Set
7880import qualified Data.Text as T
7981import qualified Data.Text.Lazy as L
8082import qualified Data.Text.Unsafe as T
8183
82−type Parser = T.Parser Text Text
83−type Result = IResult Text Text
84−type Failure r = T.Failure Text Text r
85−type Success a r = T.Success Text Text a r
84+type Parser = T.Parser Text Buffer
85+type Result = IResult Text Buffer
86+type Failure r = T.Failure Text Buffer r
87+type Success a r = T.Success Text Buffer a r
8688
8789instance (a ~ Text) => IsString (Parser a) where
8890 fromString = string . T.pack
@@ -204,7 +206,7 @@ skipWhile p = go
204206 where
205207 go = do
206208 t <- T.takeWhile p <$> get
207− advance (lengthOf t)
209+ advance (length t)
208210 eoc <- endOfChunk
209211 when eoc $ do
210212 input <- wantInput
@@ -240,7 +242,7 @@ takeWhile p = (T.concat . reverse) `fmap` go []
240242 where
241243 go acc = do
242244 h <- T.takeWhile p <$> get
243− advance (lengthOf h)
245+ advance (length h)
244246 eoc <- endOfChunk
245247 if eoc
246248 then do
@@ -258,7 +260,7 @@ takeRest = go []
258260 if input
259261 then do
260262 s <- get
261− advance (lengthOf s)
263+ advance (length s)
262264 go (s:acc)
263265 else return (reverse acc)
264266
@@ -285,12 +287,12 @@ scan_ f s0 p = go [] s0
285287 go acc s = do
286288 input <- get
287289 case scanner s 0 input of
288− Continue s' -> do advance (lengthOf input)
290+ Continue s' -> do advance (length input)
289291 more <- wantInput
290292 if more
291293 then go (input : acc) s'
292294 else f s' (input : acc)
293− Finished n t -> do advance (lengthOf input - lengthOf t)
295+ Finished n t -> do advance (length input - length t)
294296 f s (T.take n input : acc)
295297{-# INLINE scan_ #-}
296298
@@ -329,7 +331,7 @@ takeWhile1 :: (Char -> Bool) -> Parser Text
329331takeWhile1 p = do
330332 (`when` demandInput) =<< endOfChunk
331333 h <- T.takeWhile p <$> get
332− let len = lengthOf h
334+ let len = length h
333335 when (len == 0) $ fail "takeWhile1"
334336 advance len
335337 eoc <- endOfChunk
@@ -384,13 +386,13 @@ peekChar :: Parser (Maybe Char)
384386peekChar = T.Parser $ \t pos more _lose succ ->
385387 case () of
386388 _| pos < lengthOf t ->
387− let T.Iter !c _ = T.iter t (fromPos pos)
389+ let T.Iter !c _ = Buf.iter t (fromPos pos)
388390 in succ t pos more (Just c)
389391 | more == Complete ->
390392 succ t pos more Nothing
391393 | otherwise ->
392394 let succ' t' pos' more' =
393− let T.Iter !c _ = T.iter t' (fromPos pos')
395+ let T.Iter !c _ = Buf.iter t' (fromPos pos')
394396 in succ t' pos' more' (Just c)
395397 lose' t' pos' more' = succ t' pos' more' Nothing
396398 in prompt t pos more lose' succ'
@@ -411,22 +413,22 @@ endOfLine = (char '\n' >> return ()) <|> (string "\r\n" >> return ())
411413
412414-- | Terminal failure continuation.
413415failK :: Failure a
414−failK t (Pos pos) _more stack msg = Fail (T.dropWord16 pos t) stack msg
416+failK t (Pos pos) _more stack msg = Fail (Buf.dropWord16 pos t) stack msg
415417{-# INLINE failK #-}
416418
417419-- | Terminal success continuation.
418420successK :: Success a a
419−successK t (Pos pos) _more a = Done (T.dropWord16 pos t) a
421+successK t (Pos pos) _more a = Done (Buf.dropWord16 pos t) a
420422{-# INLINE successK #-}
421423
422424-- | Run a parser.
423425parse :: Parser a -> Text -> Result a
424−parse m s = runParser m s 0 Incomplete failK successK
426+parse m s = runParser m (buffer s) 0 Incomplete failK successK
425427{-# INLINE parse #-}
426428
427429-- | Run a parser that cannot be resupplied via a 'Partial' result.
428430parseOnly :: Parser a -> Text -> Either String a
429−parseOnly m s = case runParser m s 0 Complete failK successK of
431+parseOnly m s = case runParser m (buffer s) 0 Complete failK successK of
430432 Fail _ _ err -> Left err
431433 Done _ a -> Right a
432434 _ -> error "parseOnly: impossible error!"
@@ -434,7 +436,7 @@ parseOnly m s = case runParser m s 0 Complete failK successK of
434436
435437get :: Parser Text
436438get = T.Parser $ \t pos more _lose succ ->
437− succ t pos more (T.dropWord16 (fromPos pos) t)
439+ succ t pos more (Buf.dropWord16 (fromPos pos) t)
438440{-# INLINE get #-}
439441
440442endOfChunk :: Parser Bool
@@ -446,7 +448,7 @@ advance :: Pos -> Parser ()
446448advance n = T.Parser $ \t pos more _lose succ -> succ t (pos+n) more ()
447449{-# INLINE advance #-}
448450
449−ensureSuspended :: Int -> Text -> Pos -> More
451+ensureSuspended :: Int -> Buffer -> Pos -> More
450452 -> Failure r -> Success (Pos, Text) r
451453 -> Result r
452454ensureSuspended n t pos more lose succ =
@@ -469,14 +471,14 @@ ensure n = T.Parser $ \t pos more lose succ ->
469471
470472-- | Ask for input. If we receive any, pass it to a success
471473-- continuation, otherwise to a failure continuation.
472−prompt :: Text -> Pos -> More
473− -> (Text -> Pos -> More -> IResult Text Text r)
474− -> (Text -> Pos -> More -> IResult Text Text r)
475− -> Result r
474+prompt :: Buffer -> Pos -> More
475+ -> (Buffer -> Pos -> More -> IResult Text Buffer r)
476+ -> (Buffer -> Pos -> More -> IResult Text Buffer r)
477+ -> IResult Text Buffer r
476478prompt t pos _more lose succ = Partial $ \s ->
477479 if T.null s
478480 then lose t pos Complete
479− else succ (t <> s) pos Incomplete
481+ else succ (t <> buffer s) pos Incomplete
480482
481483-- | Immediately demand more input via a 'Partial' continuation
482484-- result.
@@ -525,18 +527,21 @@ atEnd :: Parser Bool
525527atEnd = not <$> wantInput
526528{-# INLINE atEnd #-}
527529
528−lengthAtLeast :: Pos -> Int -> Text -> Maybe Pos
530+lengthAtLeast :: Pos -> Int -> Buffer -> Maybe Pos
529531lengthAtLeast pos n t = go 0 (fromPos pos)
530532 where go i !p
531533 | i == n = Just (Pos p - pos)
532534 | p == len = Nothing
533− | otherwise = go (i+1) (p + T.iter_ t p)
535+ | otherwise = go (i+1) (p + Buf.iter_ t p)
534536 Pos len = lengthOf t
535537{-# INLINE lengthAtLeast #-}
536538
537−substring :: Pos -> Pos -> Text -> Text
538−substring (Pos pos) (Pos n) t = T.takeWord16 n (T.dropWord16 pos t)
539+substring :: Pos -> Pos -> Buffer -> Text
540+substring (Pos pos) (Pos n) = Buf.substring pos n
539541{-# INLINE substring #-}
540542
541−lengthOf :: Text -> Pos
542−lengthOf (Text _arr _off len) = Pos len
543+lengthOf :: Buffer -> Pos
544+lengthOf = Pos . Buf.length
545+
546+length :: Text -> Pos
547+length = Pos . T.length
attoparsec.cabal+3−3
@@ -44,11 +44,10 @@ library
4444 containers,
4545 deepseq,
4646 scientific >= 0.3.1 && < 0.4,
47− text >= 0.11.3.1
47+ text >= 1.1.1.3
4848 if impl(ghc < 7.4)
4949 build-depends:
50− bytestring < 0.10.4.0,
51− text < 1.1
50+ bytestring < 0.10.4.0
5251
5352 exposed-modules: Data.Attoparsec
5453 Data.Attoparsec.ByteString
@@ -68,6 +67,7 @@ library
6867 Data.Attoparsec.ByteString.Internal
6968 Data.Attoparsec.Internal
7069 Data.Attoparsec.Internal.Types
70+ Data.Attoparsec.Text.Buffer
7171 Data.Attoparsec.Text.FastSet
7272 Data.Attoparsec.Text.Internal
7373 ghc-options: -O2 -Wall