@@ -1,15 +1,15 @@
1−{-# LANGUAGE BangPatterns, Rank2Types, OverloadedStrings,
2− RecordWildCards, MagicHash, UnboxedTuples #-}
1+{-# LANGUAGE BangPatterns, CPP, GADTs, OverloadedStrings, RankNTypes,
2+ RecordWildCards #-}
33-- |
44-- Module : Data.Attoparsec.ByteString.Internal
5−-- Copyright : Bryan O'Sullivan 2007-2011
5+-- Copyright : Bryan O'Sullivan 2007-2015
66-- License : BSD3
77--
88-- Maintainer : bos@serpentine.com
99-- Stability : experimental
1010-- Portability : unknown
1111--
12−-- Simple, efficient parser combinators for 'B.ByteString' strings,
12+-- Simple, efficient parser combinators for 'ByteString' strings,
1313-- loosely based on the Parsec library.
1414
1515module Data.Attoparsec.ByteString.Internal
@@ -47,7 +47,7 @@ module Data.Attoparsec.ByteString.Internal
4747 -- * Efficient string handling
4848 , skipWhile
4949 , string
50− , stringTransform
50+ , stringCI
5151 , take
5252 , scan
5353 , runScanner
@@ -61,21 +61,30 @@ module Data.Attoparsec.ByteString.Internal
6161
6262 -- * Utilities
6363 , endOfLine
64+ , endOfInput
65+ , match
66+ , atEnd
6467 ) where
6568
66−import Control.Applicative ((<|>), (<$>))
69+#if !MIN_VERSION_base(4,8,0)
70+import Control.Applicative ((<$>))
71+#endif
72+import Control.Applicative ((<|>))
6773import Control.Monad (when)
74+import Data.Attoparsec.ByteString.Buffer (Buffer, buffer)
6875import Data.Attoparsec.ByteString.FastSet (charClass, memberWord8)
69−import Data.Attoparsec.Combinator
70−import Data.Attoparsec.Internal.Types
71− hiding (Parser, Input, Added, Failure, Success)
76+import Data.Attoparsec.Combinator ((<?>))
7277import Data.Attoparsec.Internal
73−import Data.Monoid (Monoid(..))
78+import Data.Attoparsec.Internal.Fhthagn (inlinePerformIO)
79+import Data.Attoparsec.Internal.Types hiding (Parser, Failure, Success)
80+import Data.ByteString (ByteString)
81+import Data.List (intercalate)
7482import Data.Word (Word8)
7583import Foreign.ForeignPtr (withForeignPtr)
7684import Foreign.Ptr (castPtr, minusPtr, plusPtr)
7785import Foreign.Storable (Storable(peek, sizeOf))
78−import Prelude hiding (getChar, take, takeWhile)
86+import Prelude hiding (getChar, succ, take, takeWhile)
87+import qualified Data.Attoparsec.ByteString.Buffer as Buf
7988import qualified Data.Attoparsec.Internal.Types as T
8089import qualified Data.ByteString as B8
8190import qualified Data.ByteString.Char8 as B
@@ -83,13 +92,10 @@ import qualified Data.ByteString.Internal as B
8392import qualified Data.ByteString.Lazy as L
8493import qualified Data.ByteString.Unsafe as B
8594
86−import GHC.Base (realWorld#)
87−import GHC.IO (IO(IO))
88−
89−type Parser = T.Parser B.ByteString
90−type Result = IResult B.ByteString
91−type Failure r = T.Failure B.ByteString r
92−type Success a r = T.Success B.ByteString a r
95+type Parser = T.Parser ByteString
96+type Result = IResult ByteString
97+type Failure r = T.Failure ByteString Buffer r
98+type Success a r = T.Success ByteString Buffer a r
9399
94100-- | The parser @satisfy p@ succeeds for any byte for which the
95101-- predicate @p@ returns 'True'. Returns the byte that is actually
@@ -98,7 +104,11 @@ type Success a r = T.Success B.ByteString a r
98104-- >digit = satisfy isDigit
99105-- > where isDigit w = w >= 48 && w <= 57
100106satisfy :: (Word8 -> Bool) -> Parser Word8
101−satisfy = satisfyElem
107+satisfy p = do
108+ h <- peekWord8'
109+ if p h
110+ then advance 1 >> return h
111+ else fail "satisfy"
102112{-# INLINE satisfy #-}
103113
104114-- | The parser @skip p@ succeeds for any byte for which the predicate
@@ -108,9 +118,9 @@ satisfy = satisfyElem
108118-- > where isDigit w = w >= 48 && w <= 57
109119skip :: (Word8 -> Bool) -> Parser ()
110120skip p = do
111− s <- ensure 1
112− if p (B.unsafeHead s)
113− then put (B.unsafeTail s)
121+ h <- peekWord8'
122+ if p h
123+ then advance 1
114124 else fail "skip"
115125
116126-- | The parser @satisfyWith f p@ transforms a byte, and succeeds if
@@ -118,11 +128,10 @@ skip p = do
118128-- parser returns the transformed byte that was parsed.
119129satisfyWith :: (Word8 -> a) -> (a -> Bool) -> Parser a
120130satisfyWith f p = do
121− s <- ensure 1
122− let c = f $! B.unsafeHead s
131+ h <- peekWord8'
132+ let c = f h
123133 if p c
124− then let !t = B.unsafeTail s
125− in put t >> return c
134+ then advance 1 >> return c
126135 else fail "satisfyWith"
127136{-# INLINE satisfyWith #-}
128137
@@ -132,24 +141,15 @@ storable = hack undefined
132141 hack :: Storable b => b -> Parser b
133142 hack dummy = do
134143 (fp,o,_) <- B.toForeignPtr `fmap` take (sizeOf dummy)
135− return . B.inlinePerformIO . withForeignPtr fp $ \p ->
144+ return . inlinePerformIO . withForeignPtr fp $ \p ->
136145 peek (castPtr $ p `plusPtr` o)
137146
138−-- | Consume @n@ bytes of input, but succeed only if the predicate
139−-- returns 'True'.
140−takeWith :: Int -> (B.ByteString -> Bool) -> Parser B.ByteString
141−takeWith n0 p = do
147+-- | Consume exactly @n@ bytes of input.
148+take :: Int -> Parser ByteString
149+take n0 = do
142150 let n = max n0 0
143151 s <- ensure n
144− let h = B.unsafeTake n s
145− t = B.unsafeDrop n s
146− if p h
147− then put t >> return h
148− else fail "takeWith"
149−
150−-- | Consume exactly @n@ bytes of input.
151−take :: Int -> Parser B.ByteString
152−take n = takeWith n (const True)
152+ advance n >> return s
153153{-# INLINE take #-}
154154
155155-- | @string s@ parses a sequence of bytes that identically match
@@ -165,27 +165,71 @@ take n = takeWith n (const True)
165165--
166166-- The reason for its failure is that the first branch is a
167167-- partial match, and will consume the letters @\'f\'@ and @\'o\'@
168−-- before failing. In Attoparsec, the above parser will /succeed/ on
168+-- before failing. In attoparsec, the above parser will /succeed/ on
169169-- that input, because the failed first branch will consume nothing.
170−string :: B.ByteString -> Parser B.ByteString
171−string s = takeWith (B.length s) (==s)
170+string :: ByteString -> Parser ByteString
171+string s = string_ (stringSuspended id) id s
172172{-# INLINE string #-}
173173
174−stringTransform :: (B.ByteString -> B.ByteString) -> B.ByteString
175− -> Parser B.ByteString
176−stringTransform f s = takeWith (B.length s) ((==f s) . f)
177−{-# INLINE stringTransform #-}
174+-- ASCII-specific but fast, oh yes.
175+toLower :: Word8 -> Word8
176+toLower w | w >= 65 && w <= 90 = w + 32
177+ | otherwise = w
178+
179+-- | Satisfy a literal string, ignoring case.
180+stringCI :: ByteString -> Parser ByteString
181+stringCI s = string_ (stringSuspended lower) lower s
182+ where lower = B8.map toLower
183+{-# INLINE stringCI #-}
184+
185+string_ :: (forall r. ByteString -> ByteString -> Buffer -> Pos -> More
186+ -> Failure r -> Success ByteString r -> Result r)
187+ -> (ByteString -> ByteString)
188+ -> ByteString -> Parser ByteString
189+string_ suspended f s0 = T.Parser $ \t pos more lose succ ->
190+ let n = B.length s
191+ s = f s0
192+ in if lengthAtLeast pos n t
193+ then let t' = substring pos (Pos n) t
194+ in if s == f t'
195+ then succ t (pos + Pos n) more t'
196+ else lose t pos more [] "string"
197+ else let t' = Buf.unsafeDrop (fromPos pos) t
198+ in if f t' `B.isPrefixOf` s
199+ then suspended s (B.drop (B.length t') s) t pos more lose succ
200+ else lose t pos more [] "string"
201+{-# INLINE string_ #-}
202+
203+stringSuspended :: (ByteString -> ByteString)
204+ -> ByteString -> ByteString -> Buffer -> Pos -> More
205+ -> Failure r
206+ -> Success ByteString r
207+ -> Result r
208+stringSuspended f s0 s t pos more lose succ =
209+ runParser (demandInput_ >>= go) t pos more lose succ
210+ where go s'0 = T.Parser $ \t' pos' more' lose' succ' ->
211+ let m = B.length s
212+ s' = f s'0
213+ n = B.length s'
214+ in if n >= m
215+ then if B.unsafeTake m s' == s
216+ then let o = Pos (B.length s0)
217+ in succ' t' (pos' + o) more'
218+ (substring pos' o t')
219+ else lose' t' pos' more' [] "string"
220+ else if s' == B.unsafeTake n s
221+ then stringSuspended f s0 (B.unsafeDrop n s)
222+ t' pos' more' lose' succ'
223+ else lose' t' pos' more' [] "string"
178224
179225-- | Skip past input for as long as the predicate returns 'True'.
180226skipWhile :: (Word8 -> Bool) -> Parser ()
181227skipWhile p = go
182228 where
183229 go = do
184− t <- B8.dropWhile p <$> get
185− put t
186− when (B.null t) $ do
187− input <- wantInput
188− when input go
230+ t <- B8.takeWhile p <$> get
231+ continue <- inputSpansChunks (B.length t)
232+ when continue go
189233{-# INLINE skipWhile #-}
190234
191235-- | Consume input as long as the predicate returns 'False'
@@ -195,9 +239,10 @@ skipWhile p = go
195239-- predicate returns 'True' on the first byte of input.
196240--
197241-- /Note/: Because this parser does not fail, do not use it with
198−-- combinators such as 'many', because such parsers loop until a
199−-- failure occurs. Careless use will thus result in an infinite loop.
200−takeTill :: (Word8 -> Bool) -> Parser B.ByteString
242+-- combinators such as 'Control.Applicative.many', because such
243+-- parsers loop until a failure occurs. Careless use will thus result
244+-- in an infinite loop.
245+takeTill :: (Word8 -> Bool) -> Parser ByteString
201246takeTill p = takeWhile (not . p)
202247{-# INLINE takeTill #-}
203248
@@ -208,24 +253,30 @@ takeTill p = takeWhile (not . p)
208253-- predicate returns 'False' on the first byte of input.
209254--
210255-- /Note/: Because this parser does not fail, do not use it with
211−-- combinators such as 'many', because such parsers loop until a
212−-- failure occurs. Careless use will thus result in an infinite loop.
213−takeWhile :: (Word8 -> Bool) -> Parser B.ByteString
214−takeWhile p = (B.concat . reverse) `fmap` go []
215− where
216− go acc = do
217− (h,t) <- B8.span p <$> get
218− put t
219− if B.null t
220− then do
221− input <- wantInput
222− if input
223− then go (h:acc)
224− else return (h:acc)
225− else return (h:acc)
256+-- combinators such as 'Control.Applicative.many', because such
257+-- parsers loop until a failure occurs. Careless use will thus result
258+-- in an infinite loop.
259+takeWhile :: (Word8 -> Bool) -> Parser ByteString
260+takeWhile p = do
261+ s <- B8.takeWhile p <$> get
262+ continue <- inputSpansChunks (B.length s)
263+ if continue
264+ then takeWhileAcc p [s]
265+ else return s
226266{-# INLINE takeWhile #-}
227267
228−takeRest :: Parser [B.ByteString]
268+takeWhileAcc :: (Word8 -> Bool) -> [ByteString] -> Parser ByteString
269+takeWhileAcc p = go
270+ where
271+ go acc = do
272+ s <- B8.takeWhile p <$> get
273+ continue <- inputSpansChunks (B.length s)
274+ if continue
275+ then go (s:acc)
276+ else return $ concatReverse (s:acc)
277+{-# INLINE takeWhileAcc #-}
278+
279+takeRest :: Parser [ByteString]
229280takeRest = go []
230281 where
231282 go acc = do
@@ -233,12 +284,12 @@ takeRest = go []
233284 if input
234285 then do
235286 s <- get
236− put B.empty
287+ advance (B.length s)
237288 go (s:acc)
238289 else return (reverse acc)
239290
240291-- | Consume all remaining input and return it as a single string.
241−takeByteString :: Parser B.ByteString
292+takeByteString :: Parser ByteString
242293takeByteString = B.concat `fmap` takeRest
243294
244295-- | Consume all remaining input and return it as a single string.
@@ -247,7 +298,7 @@ takeLazyByteString = L.fromChunks `fmap` takeRest
247298
248299data T s = T {-# UNPACK #-} !Int s
249300
250−scan_ :: (s -> [B.ByteString] -> Parser r) -> s -> (s -> Word8 -> Maybe s)
301+scan_ :: (s -> [ByteString] -> Parser r) -> s -> (s -> Word8 -> Maybe s)
251302 -> Parser r
252303scan_ f s0 p = go [] s0
253304 where
@@ -268,14 +319,9 @@ scan_ f s0 p = go [] s0
268319 bs <- get
269320 let T i s' = inlinePerformIO $ scanner bs
270321 !h = B.unsafeTake i bs
271− !t = B.unsafeDrop i bs
272− put t
273− if B.null t
274− then do
275− input <- wantInput
276− if input
277− then go (h:acc) s'
278− else f s' (h:acc)
322+ continue <- inputSpansChunks i
323+ if continue
324+ then go (h:acc) s'
279325 else f s' (h:acc)
280326{-# INLINE scan_ #-}
281327
@@ -288,19 +334,17 @@ scan_ f s0 p = go [] s0
288334-- predicate returns 'Nothing' on the first byte of input.
289335--
290336-- /Note/: Because this parser does not fail, do not use it with
291−-- combinators such as 'many', because such parsers loop until a
292−-- failure occurs. Careless use will thus result in an infinite loop.
293−scan :: s -> (s -> Word8 -> Maybe s) -> Parser B.ByteString
294−scan = scan_ $ \_ chunks ->
295− case chunks of
296− [x] -> return x
297− xs -> return $! B.concat $ reverse xs
337+-- combinators such as 'Control.Applicative.many', because such
338+-- parsers loop until a failure occurs. Careless use will thus result
339+-- in an infinite loop.
340+scan :: s -> (s -> Word8 -> Maybe s) -> Parser ByteString
341+scan = scan_ $ \_ chunks -> return $! concatReverse chunks
298342{-# INLINE scan #-}
299343
300344-- | Like 'scan', but generalized to return the final state of the
301345-- scanner.
302−runScanner :: s -> (s -> Word8 -> Maybe s) -> Parser (B.ByteString, s)
303−runScanner = scan_ $ \s xs -> return (B.concat (reverse xs), s)
346+runScanner :: s -> (s -> Word8 -> Maybe s) -> Parser (ByteString, s)
347+runScanner = scan_ $ \s xs -> let !sx = concatReverse xs in return (sx, s)
304348{-# INLINE runScanner #-}
305349
306350-- | Consume input as long as the predicate returns 'True', and return
@@ -309,15 +353,20 @@ runScanner = scan_ $ \s xs -> return (B.concat (reverse xs), s)
309353-- This parser requires the predicate to succeed on at least one byte
310354-- of input: it will fail if the predicate never returns 'True' or if
311355-- there is no input left.
312−takeWhile1 :: (Word8 -> Bool) -> Parser B.ByteString
356+takeWhile1 :: (Word8 -> Bool) -> Parser ByteString
313357takeWhile1 p = do
314− (`when` demandInput) =<< B.null <$> get
315− (h,t) <- B8.span p <$> get
316− when (B.null h) $ fail "takeWhile1"
317− put t
318− if B.null t
319− then (h<>) `fmap` takeWhile p
320− else return h
358+ (`when` demandInput) =<< endOfChunk
359+ s <- B8.takeWhile p <$> get
360+ let len = B.length s
361+ if len == 0
362+ then fail "takeWhile1"
363+ else do
364+ advance len
365+ eoc <- endOfChunk
366+ if eoc
367+ then takeWhileAcc p [s]
368+ else return s
369+{-# INLINE takeWhile1 #-}
321370
322371-- | Match any byte in a set.
323372--
@@ -359,27 +408,32 @@ notWord8 c = satisfy (/= c) <?> "not " ++ show c
359408-- input has been reached. Does not consume any input.
360409--
361410-- /Note/: Because this parser does not fail, do not use it with
362−-- combinators such as 'many', because such parsers loop until a
363−-- failure occurs. Careless use will thus result in an infinite loop.
411+-- combinators such as 'Control.Applicative.many', because such
412+-- parsers loop until a failure occurs. Careless use will thus result
413+-- in an infinite loop.
364414peekWord8 :: Parser (Maybe Word8)
365−peekWord8 = T.Parser $ \i0 a0 m0 _kf ks ->
366− if B.null (unI i0)
367− then if m0 == Complete
368− then ks i0 a0 m0 Nothing
369− else let ks' i a m = let !w = B.unsafeHead (unI i)
370− in ks i a m (Just w)
371− kf' i a m = ks i a m Nothing
372− in prompt i0 a0 m0 kf' ks'
373− else let !w = B.unsafeHead (unI i0)
374− in ks i0 a0 m0 (Just w)
415+peekWord8 = T.Parser $ \t pos@(Pos pos_) more _lose succ ->
416+ case () of
417+ _| pos_ < Buf.length t ->
418+ let !w = Buf.unsafeIndex t pos_
419+ in succ t pos more (Just w)
420+ | more == Complete ->
421+ succ t pos more Nothing
422+ | otherwise ->
423+ let succ' t' pos' more' = let !w = Buf.unsafeIndex t' pos_
424+ in succ t' pos' more' (Just w)
425+ lose' t' pos' more' = succ t' pos' more' Nothing
426+ in prompt t pos more lose' succ'
375427{-# INLINE peekWord8 #-}
376428
377429-- | Match any byte, to perform lookahead. Does not consume any
378430-- input, but will fail if end of input has been reached.
379431peekWord8' :: Parser Word8
380−peekWord8' = do
381− s <- ensure 1
382− return $! B.unsafeHead s
432+peekWord8' = T.Parser $ \t pos more lose succ ->
433+ if lengthAtLeast pos 1 t
434+ then succ t pos more (Buf.unsafeIndex t (fromPos pos))
435+ else let succ' t' pos' more' bs' = succ t' pos' more' $! B.unsafeHead bs'
436+ in ensureSuspended 1 t pos more lose succ'
383437{-# INLINE peekWord8' #-}
384438
385439-- | Match either a single newline character @\'\\n\'@, or a carriage
@@ -389,31 +443,94 @@ endOfLine = (word8 10 >> return ()) <|> (string "\r\n" >> return ())
389443
390444-- | Terminal failure continuation.
391445failK :: Failure a
392−failK i0 _a0 _m0 stack msg = Fail (unI i0) stack msg
446+failK t (Pos pos) _more stack msg = Fail (Buf.unsafeDrop pos t) stack msg
393447{-# INLINE failK #-}
394448
395449-- | Terminal success continuation.
396450successK :: Success a a
397−successK i0 _a0 _m0 a = Done (unI i0) a
451+successK t (Pos pos) _more a = Done (Buf.unsafeDrop pos t) a
398452{-# INLINE successK #-}
399453
400454-- | Run a parser.
401−parse :: Parser a -> B.ByteString -> Result a
402−parse m s = T.runParser m (I s) mempty Incomplete failK successK
455+parse :: Parser a -> ByteString -> Result a
456+parse m s = T.runParser m (buffer s) (Pos 0) Incomplete failK successK
403457{-# INLINE parse #-}
404458
405459-- | Run a parser that cannot be resupplied via a 'Partial' result.
406−parseOnly :: Parser a -> B.ByteString -> Either String a
407−parseOnly m s = case T.runParser m (I s) mempty Complete failK successK of
408− Fail _ _ err -> Left err
409− Done _ a -> Right a
410− _ -> error "parseOnly: impossible error!"
460+--
461+-- This function does not force a parser to consume all of its input.
462+-- Instead, any residual input will be discarded. To force a parser
463+-- to consume all of its input, use something like this:
464+--
465+-- @
466+--'parseOnly' (myParser 'Control.Applicative.<*' 'endOfInput')
467+-- @
468+parseOnly :: Parser a -> ByteString -> Either String a
469+parseOnly m s = case T.runParser m (buffer s) (Pos 0) Complete failK successK of
470+ Fail _ [] err -> Left err
471+ Fail _ ctxs err -> Left (intercalate " > " ctxs ++ ": " ++ err)
472+ Done _ a -> Right a
473+ _ -> error "parseOnly: impossible error!"
411474{-# INLINE parseOnly #-}
412475
413−-- | Just like unsafePerformIO, but we inline it. Big performance gains as
414−-- it exposes lots of things to further inlining. /Very unsafe/. In
415−-- particular, you should do no memory allocation inside an
416−-- 'inlinePerformIO' block. On Hugs this is just @unsafePerformIO@.
417−inlinePerformIO :: IO a -> a
418−inlinePerformIO (IO m) = case m realWorld# of (# _, r #) -> r
419−{-# INLINE inlinePerformIO #-}
476+get :: Parser ByteString
477+get = T.Parser $ \t pos more _lose succ ->
478+ succ t pos more (Buf.unsafeDrop (fromPos pos) t)
479+{-# INLINE get #-}
480+
481+endOfChunk :: Parser Bool
482+endOfChunk = T.Parser $ \t pos more _lose succ ->
483+ succ t pos more (fromPos pos == Buf.length t)
484+{-# INLINE endOfChunk #-}
485+
486+inputSpansChunks :: Int -> Parser Bool
487+inputSpansChunks i = T.Parser $ \t pos_ more _lose succ ->
488+ let pos = pos_ + Pos i
489+ in if fromPos pos < Buf.length t || more == Complete
490+ then succ t pos more False
491+ else let lose' t' pos' more' = succ t' pos' more' False
492+ succ' t' pos' more' = succ t' pos' more' True
493+ in prompt t pos more lose' succ'
494+{-# INLINE inputSpansChunks #-}
495+
496+advance :: Int -> Parser ()
497+advance n = T.Parser $ \t pos more _lose succ ->
498+ succ t (pos + Pos n) more ()
499+{-# INLINE advance #-}
500+
501+ensureSuspended :: Int -> Buffer -> Pos -> More
502+ -> Failure r
503+ -> Success ByteString r
504+ -> Result r
505+ensureSuspended n t pos more lose succ =
506+ runParser (demandInput >> go) t pos more lose succ
507+ where go = T.Parser $ \t' pos' more' lose' succ' ->
508+ if lengthAtLeast pos' n t'
509+ then succ' t' pos' more' (substring pos (Pos n) t')
510+ else runParser (demandInput >> go) t' pos' more' lose' succ'
511+
512+-- | If at least @n@ elements of input are available, return the
513+-- current input, otherwise fail.
514+ensure :: Int -> Parser ByteString
515+ensure n = T.Parser $ \t pos more lose succ ->
516+ if lengthAtLeast pos n t
517+ then succ t pos more (substring pos (Pos n) t)
518+ -- The uncommon case is kept out-of-line to reduce code size:
519+ else ensureSuspended n t pos more lose succ
520+{-# INLINE ensure #-}
521+
522+-- | Return both the result of a parse and the portion of the input
523+-- that was consumed while it was being parsed.
524+match :: Parser a -> Parser (ByteString, a)
525+match p = T.Parser $ \t pos more lose succ ->
526+ let succ' t' pos' more' a =
527+ succ t' pos' more' (substring pos (pos'-pos) t', a)
528+ in runParser p t pos more lose succ'
529+
530+lengthAtLeast :: Pos -> Int -> Buffer -> Bool
531+lengthAtLeast (Pos pos) n bs = Buf.length bs >= pos + n
532+{-# INLINE lengthAtLeast #-}
533+
534+substring :: Pos -> Pos -> Buffer -> ByteString
535+substring (Pos pos) (Pos n) = Buf.substring pos n
536+{-# INLINE substring #-}