@@ -1,15 +1,15 @@
1−{-# LANGUAGE BangPatterns, CPP, GADTs, OverloadedStrings, RankNTypes,
2− RecordWildCards #-}
1+{-# LANGUAGE BangPatterns, Rank2Types, OverloadedStrings,
2+ RecordWildCards, MagicHash, UnboxedTuples #-}
33-- |
44-- Module : Data.Attoparsec.ByteString.Internal
5−-- Copyright : Bryan O'Sullivan 2007-2015
5+-- Copyright : Bryan O'Sullivan 2007-2011
66-- License : BSD3
77--
88-- Maintainer : bos@serpentine.com
99-- Stability : experimental
1010-- Portability : unknown
1111--
12−-- Simple, efficient parser combinators for 'ByteString' strings,
12+-- Simple, efficient parser combinators for 'B.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− , stringCI
50+ , stringTransform
5151 , take
5252 , scan
5353 , runScanner
@@ -61,30 +61,21 @@ module Data.Attoparsec.ByteString.Internal
6161
6262 -- * Utilities
6363 , endOfLine
64− , endOfInput
65− , match
66− , atEnd
6764 ) where
6865
69−#if !MIN_VERSION_base(4,8,0)
70−import Control.Applicative ((<$>))
71−#endif
72−import Control.Applicative ((<|>))
66+import Control.Applicative ((<|>), (<$>))
7367import Control.Monad (when)
74−import Data.Attoparsec.ByteString.Buffer (Buffer, buffer)
7568import Data.Attoparsec.ByteString.FastSet (charClass, memberWord8)
76−import Data.Attoparsec.Combinator ((<?>))
69+import Data.Attoparsec.Combinator
70+import Data.Attoparsec.Internal.Types
71+ hiding (Parser, Input, Added, Failure, Success)
7772import Data.Attoparsec.Internal
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)
73+import Data.Monoid (Monoid(..))
8274import Data.Word (Word8)
8375import Foreign.ForeignPtr (withForeignPtr)
8476import Foreign.Ptr (castPtr, minusPtr, plusPtr)
8577import Foreign.Storable (Storable(peek, sizeOf))
86−import Prelude hiding (getChar, succ, take, takeWhile)
87−import qualified Data.Attoparsec.ByteString.Buffer as Buf
78+import Prelude hiding (getChar, take, takeWhile)
8879import qualified Data.Attoparsec.Internal.Types as T
8980import qualified Data.ByteString as B8
9081import qualified Data.ByteString.Char8 as B
@@ -92,10 +83,13 @@ import qualified Data.ByteString.Internal as B
9283import qualified Data.ByteString.Lazy as L
9384import qualified Data.ByteString.Unsafe as B
9485
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
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
9993
10094-- | The parser @satisfy p@ succeeds for any byte for which the
10195-- predicate @p@ returns 'True'. Returns the byte that is actually
@@ -104,11 +98,7 @@ type Success a r = T.Success ByteString Buffer a r
10498-- >digit = satisfy isDigit
10599-- > where isDigit w = w >= 48 && w <= 57
106100satisfy :: (Word8 -> Bool) -> Parser Word8
107−satisfy p = do
108− h <- peekWord8'
109− if p h
110− then advance 1 >> return h
111− else fail "satisfy"
101+satisfy = satisfyElem
112102{-# INLINE satisfy #-}
113103
114104-- | The parser @skip p@ succeeds for any byte for which the predicate
@@ -118,9 +108,9 @@ satisfy p = do
118108-- > where isDigit w = w >= 48 && w <= 57
119109skip :: (Word8 -> Bool) -> Parser ()
120110skip p = do
121− h <- peekWord8'
122− if p h
123− then advance 1
111+ s <- ensure 1
112+ if p (B.unsafeHead s)
113+ then put (B.unsafeTail s)
124114 else fail "skip"
125115
126116-- | The parser @satisfyWith f p@ transforms a byte, and succeeds if
@@ -128,10 +118,11 @@ skip p = do
128118-- parser returns the transformed byte that was parsed.
129119satisfyWith :: (Word8 -> a) -> (a -> Bool) -> Parser a
130120satisfyWith f p = do
131− h <- peekWord8'
132− let c = f h
121+ s <- ensure 1
122+ let c = f $! B.unsafeHead s
133123 if p c
134− then advance 1 >> return c
124+ then let !t = B.unsafeTail s
125+ in put t >> return c
135126 else fail "satisfyWith"
136127{-# INLINE satisfyWith #-}
137128
@@ -141,15 +132,24 @@ storable = hack undefined
141132 hack :: Storable b => b -> Parser b
142133 hack dummy = do
143134 (fp,o,_) <- B.toForeignPtr `fmap` take (sizeOf dummy)
144− return . inlinePerformIO . withForeignPtr fp $ \p ->
135+ return . B.inlinePerformIO . withForeignPtr fp $ \p ->
145136 peek (castPtr $ p `plusPtr` o)
146137
147−-- | Consume exactly @n@ bytes of input.
148−take :: Int -> Parser ByteString
149−take n0 = do
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
150142 let n = max n0 0
151143 s <- ensure n
152− advance n >> return s
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)
153153{-# INLINE take #-}
154154
155155-- | @string s@ parses a sequence of bytes that identically match
@@ -165,71 +165,27 @@ take n0 = do
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 :: ByteString -> Parser ByteString
171−string s = string_ (stringSuspended id) id s
170+string :: B.ByteString -> Parser B.ByteString
171+string s = takeWith (B.length s) (==s)
172172{-# INLINE string #-}
173173
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"
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 #-}
224178
225179-- | Skip past input for as long as the predicate returns 'True'.
226180skipWhile :: (Word8 -> Bool) -> Parser ()
227181skipWhile p = go
228182 where
229183 go = do
230− t <- B8.takeWhile p <$> get
231− continue <- inputSpansChunks (B.length t)
232− when continue go
184+ t <- B8.dropWhile p <$> get
185+ put t
186+ when (B.null t) $ do
187+ input <- wantInput
188+ when input go
233189{-# INLINE skipWhile #-}
234190
235191-- | Consume input as long as the predicate returns 'False'
@@ -239,10 +195,9 @@ skipWhile p = go
239195-- predicate returns 'True' on the first byte of input.
240196--
241197-- /Note/: Because this parser does not fail, do not use it with
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
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
246201takeTill p = takeWhile (not . p)
247202{-# INLINE takeTill #-}
248203
@@ -253,30 +208,24 @@ takeTill p = takeWhile (not . p)
253208-- predicate returns 'False' on the first byte of input.
254209--
255210-- /Note/: Because this parser does not fail, do not use it with
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
266−{-# INLINE takeWhile #-}
267−
268−takeWhileAcc :: (Word8 -> Bool) -> [ByteString] -> Parser ByteString
269−takeWhileAcc p = go
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 []
270215 where
271216 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]
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)
226+{-# INLINE takeWhile #-}
227+
228+takeRest :: Parser [B.ByteString]
280229takeRest = go []
281230 where
282231 go acc = do
@@ -284,12 +233,12 @@ takeRest = go []
284233 if input
285234 then do
286235 s <- get
287− advance (B.length s)
236+ put B.empty
288237 go (s:acc)
289238 else return (reverse acc)
290239
291240-- | Consume all remaining input and return it as a single string.
292−takeByteString :: Parser ByteString
241+takeByteString :: Parser B.ByteString
293242takeByteString = B.concat `fmap` takeRest
294243
295244-- | Consume all remaining input and return it as a single string.
@@ -298,7 +247,7 @@ takeLazyByteString = L.fromChunks `fmap` takeRest
298247
299248data T s = T {-# UNPACK #-} !Int s
300249
301−scan_ :: (s -> [ByteString] -> Parser r) -> s -> (s -> Word8 -> Maybe s)
250+scan_ :: (s -> [B.ByteString] -> Parser r) -> s -> (s -> Word8 -> Maybe s)
302251 -> Parser r
303252scan_ f s0 p = go [] s0
304253 where
@@ -319,9 +268,14 @@ scan_ f s0 p = go [] s0
319268 bs <- get
320269 let T i s' = inlinePerformIO $ scanner bs
321270 !h = B.unsafeTake i bs
322− continue <- inputSpansChunks i
323− if continue
324− then go (h:acc) s'
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)
325279 else f s' (h:acc)
326280{-# INLINE scan_ #-}
327281
@@ -334,17 +288,19 @@ scan_ f s0 p = go [] s0
334288-- predicate returns 'Nothing' on the first byte of input.
335289--
336290-- /Note/: Because this parser does not fail, do not use it with
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
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
342298{-# INLINE scan #-}
343299
344300-- | Like 'scan', but generalized to return the final state of the
345301-- scanner.
346−runScanner :: s -> (s -> Word8 -> Maybe s) -> Parser (ByteString, s)
347−runScanner = scan_ $ \s xs -> let !sx = concatReverse xs in return (sx, s)
302+runScanner :: s -> (s -> Word8 -> Maybe s) -> Parser (B.ByteString, s)
303+runScanner = scan_ $ \s xs -> return (B.concat (reverse xs), s)
348304{-# INLINE runScanner #-}
349305
350306-- | Consume input as long as the predicate returns 'True', and return
@@ -353,20 +309,15 @@ runScanner = scan_ $ \s xs -> let !sx = concatReverse xs in return (sx, s)
353309-- This parser requires the predicate to succeed on at least one byte
354310-- of input: it will fail if the predicate never returns 'True' or if
355311-- there is no input left.
356−takeWhile1 :: (Word8 -> Bool) -> Parser ByteString
312+takeWhile1 :: (Word8 -> Bool) -> Parser B.ByteString
357313takeWhile1 p = do
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 #-}
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
370321
371322-- | Match any byte in a set.
372323--
@@ -408,32 +359,27 @@ notWord8 c = satisfy (/= c) <?> "not " ++ show c
408359-- input has been reached. Does not consume any input.
409360--
410361-- /Note/: Because this parser does not fail, do not use it with
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.
362+-- combinators such as 'many', because such parsers loop until a
363+-- failure occurs. Careless use will thus result in an infinite loop.
414364peekWord8 :: Parser (Maybe Word8)
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'
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)
427375{-# INLINE peekWord8 #-}
428376
429377-- | Match any byte, to perform lookahead. Does not consume any
430378-- input, but will fail if end of input has been reached.
431379peekWord8' :: Parser Word8
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'
380+peekWord8' = do
381+ s <- ensure 1
382+ return $! B.unsafeHead s
437383{-# INLINE peekWord8' #-}
438384
439385-- | Match either a single newline character @\'\\n\'@, or a carriage
@@ -443,94 +389,31 @@ endOfLine = (word8 10 >> return ()) <|> (string "\r\n" >> return ())
443389
444390-- | Terminal failure continuation.
445391failK :: Failure a
446−failK t (Pos pos) _more stack msg = Fail (Buf.unsafeDrop pos t) stack msg
392+failK i0 _a0 _m0 stack msg = Fail (unI i0) stack msg
447393{-# INLINE failK #-}
448394
449395-- | Terminal success continuation.
450396successK :: Success a a
451−successK t (Pos pos) _more a = Done (Buf.unsafeDrop pos t) a
397+successK i0 _a0 _m0 a = Done (unI i0) a
452398{-# INLINE successK #-}
453399
454400-- | Run a parser.
455−parse :: Parser a -> ByteString -> Result a
456−parse m s = T.runParser m (buffer s) (Pos 0) Incomplete failK successK
401+parse :: Parser a -> B.ByteString -> Result a
402+parse m s = T.runParser m (I s) mempty Incomplete failK successK
457403{-# INLINE parse #-}
458404
459405-- | Run a parser that cannot be resupplied via a 'Partial' result.
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!"
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!"
474411{-# INLINE parseOnly #-}
475412
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 #-}
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 #-}