@@ -3,7 +3,7 @@
3{-# OPTIONS_GHC -fno-warn-orphans #-}
3{-# OPTIONS_GHC -fno-warn-orphans #-}
5-- Module : Data.Attoparsec.Text.Internal
5-- Module : Data.Attoparsec.Text.Internal
6−-- Copyright : Bryan O'Sullivan 2007-2015
6+-- Copyright : Bryan O'Sullivan 2007-2014
7-- License : BSD3
7-- License : BSD3
9-- Maintainer : bos@serpentine.com
9-- Maintainer : bos@serpentine.com
@@ -65,18 +65,17 @@ module Data.Attoparsec.Text.Internal
68−import Control.Applicative ((<|>), (<$>), pure, (*>))
68+import Control.Applicative ((<|>), (<$>))
69import Control.Monad (when)
69import Control.Monad (when)
70import Data.Attoparsec.Combinator ((<?>))
70import Data.Attoparsec.Combinator ((<?>))
71import Data.Attoparsec.Internal
71import Data.Attoparsec.Internal
72import Data.Attoparsec.Internal.Types hiding (Parser, Failure, Success)
72import Data.Attoparsec.Internal.Types hiding (Parser, Failure, Success)
73import qualified Data.Attoparsec.Text.Buffer as Buf
73import qualified Data.Attoparsec.Text.Buffer as Buf
74import Data.Attoparsec.Text.Buffer (Buffer, buffer)
74import Data.Attoparsec.Text.Buffer (Buffer, buffer)
75−import Data.Char (isAsciiUpper, isAsciiLower, toUpper, toLower)
75+import Data.Char (chr, ord)
76−import Data.List (intercalate)
77import Data.String (IsString(..))
76import Data.String (IsString(..))
78import Data.Text.Internal (Text(..))
77import Data.Text.Internal (Text(..))
79−import Prelude hiding (getChar, succ, take, takeWhile)
78+import Prelude hiding (getChar, length, succ, take, takeWhile)
80import qualified Data.Attoparsec.Internal.Types as T
79import qualified Data.Attoparsec.Internal.Types as T
81import qualified Data.Attoparsec.Text.FastSet as Set
80import qualified Data.Attoparsec.Text.FastSet as Set
82import qualified Data.Text as T
81import qualified Data.Text as T
@@ -160,46 +159,9 @@ take n = takeWith (max n 0) (const True)
160-- before failing. In attoparsec, the above parser will /succeed/ on
159-- before failing. In attoparsec, the above parser will /succeed/ on
161-- that input, because the failed first branch will consume nothing.
160-- that input, because the failed first branch will consume nothing.
162string :: Text -> Parser Text
161string :: Text -> Parser Text
163−string s = string_ (stringSuspended id) id s
162+string s = takeWith (T.length s) (==s)
164{-# INLINE string #-}
163{-# INLINE string #-}
166−string_ :: (forall r. Text -> Text -> Buffer -> Pos -> More
167− -> Failure r -> Success Text r -> Result r)
169− -> Text -> Parser Text
170−string_ suspended f s0 = T.Parser $ \t pos more lose succ ->
172− ft = f (Buf.unbufferAt (fromPos pos) t)
173− in case T.commonPrefixes s ft of
175− | T.null s -> succ t pos more T.empty
176− | T.null ft -> suspended s s t pos more lose succ
177− | otherwise -> lose t pos more [] "string"
178− Just (pfx,ssfx,tsfx)
179− | T.null ssfx -> let l = Pos (T.lengthWord16 pfx)
180− in succ t (pos + l) more (substring pos l t)
181− | not (T.null tsfx) -> lose t pos more [] "string"
182− | otherwise -> suspended s ssfx t pos more lose succ
183−{-# INLINE string_ #-}
185−stringSuspended :: (Text -> Text)
186− -> Text -> Text -> Buffer -> Pos -> More
190−stringSuspended f s000 s0 t0 pos0 more0 lose0 succ0 =
191− runParser (demandInput_ >>= go) t0 pos0 more0 lose0 succ0
193− go s' = T.Parser $ \t pos more lose succ ->
195− in case T.commonPrefixes s0 s of
196− Nothing -> lose t pos more [] "string"
197− Just (_pfx,ssfx,tsfx)
198− | T.null ssfx -> let l = Pos (T.lengthWord16 s000)
199− in succ t (pos + l) more (substring pos l t)
200− | T.null tsfx -> stringSuspended f s000 ssfx t pos more lose succ
201− | otherwise -> lose t pos more [] "string"
203-- | Satisfy a literal string, ignoring case.
165-- | Satisfy a literal string, ignoring case.
205-- Note: this function is currently quite inefficient. Unicode case
167-- Note: this function is currently quite inefficient. Unicode case
@@ -222,23 +184,30 @@ stringCI s = go 0
223-- | Satisfy a literal string, ignoring case for characters in the ASCII range.
185-- | Satisfy a literal string, ignoring case for characters in the ASCII range.
224asciiCI :: Text -> Parser Text
186asciiCI :: Text -> Parser Text
225−asciiCI s = fmap fst $ match $ T.foldr ((*>) . asciiCharCI) (pure ()) s
187+asciiCI input = do
189+ if asciiToLower t == s
190+ then advance k >> return t
194+ s = asciiToLower input
196+ -- convert letters in the ASCII range to lower-case
197+ asciiToLower = T.map f
199+ offset = ord 'a' - ord 'A'
200+ f c | 'A' <= c && c <= 'Z' = chr (ord c + offset)
226{-# INLINE asciiCI #-}
202{-# INLINE asciiCI #-}
228−asciiCharCI :: Char -> Parser Char
230− | isAsciiUpper c = char c <|> char (toLower c)
231− | isAsciiLower c = char c <|> char (toUpper c)
232− | otherwise = char c
233−{-# INLINE asciiCharCI #-}
235-- | Skip past input for as long as the predicate returns 'True'.
204-- | Skip past input for as long as the predicate returns 'True'.
236skipWhile :: (Char -> Bool) -> Parser ()
205skipWhile :: (Char -> Bool) -> Parser ()
237skipWhile p = go
206skipWhile p = go
240 t <- T.takeWhile p <$> get
209 t <- T.takeWhile p <$> get
241− continue <- inputSpansChunks (size t)
210+ continue <- inputSpansChunks (length t)
242 when continue go
211 when continue go
243{-# INLINE skipWhile #-}
212{-# INLINE skipWhile #-}
@@ -267,25 +236,14 @@ takeTill p = takeWhile (not . p)
267-- parsers loop until a failure occurs. Careless use will thus result
236-- parsers loop until a failure occurs. Careless use will thus result
268-- in an infinite loop.
237-- in an infinite loop.
269takeWhile :: (Char -> Bool) -> Parser Text
238takeWhile :: (Char -> Bool) -> Parser Text
270−takeWhile p = do
239+takeWhile p = (T.concat . reverse) `fmap` go []
271− h <- T.takeWhile p <$> get
272− continue <- inputSpansChunks (size h)
273− -- only use slow concat path if necessary
275− then takeWhileAcc p [h]
277−{-# INLINE takeWhile #-}
279−takeWhileAcc :: (Char -> Bool) -> [Text] -> Parser Text
282 go acc = do
241 go acc = do
283 h <- T.takeWhile p <$> get
242 h <- T.takeWhile p <$> get
284− continue <- inputSpansChunks (size h)
243+ continue <- inputSpansChunks (length h)
285 if continue
244 if continue
286 then go (h:acc)
245 then go (h:acc)
287− else return $ concatReverse (h:acc)
246+ else return (h:acc)
288−{-# INLINE takeWhileAcc #-}
290takeRest :: Parser [Text]
248takeRest :: Parser [Text]
291takeRest = go []
249takeRest = go []
@@ -295,7 +253,7 @@ takeRest = go []
298− advance (size s)
256+ advance (length s)
299 go (s:acc)
257 go (s:acc)
300 else return (reverse acc)
258 else return (reverse acc)
@@ -308,7 +266,7 @@ takeLazyText :: Parser L.Text
308takeLazyText = L.fromChunks `fmap` takeRest
266takeLazyText = L.fromChunks `fmap` takeRest
310data Scan s = Continue s
268data Scan s = Continue s
311− | Finished s {-# UNPACK #-} !Int Text
269+ | Finished {-# UNPACK #-} !Int Text
313scan_ :: (s -> [Text] -> Parser r) -> s -> (s -> Char -> Maybe s) -> Parser r
271scan_ :: (s -> [Text] -> Parser r) -> s -> (s -> Char -> Maybe s) -> Parser r
314scan_ f s0 p = go [] s0
272scan_ f s0 p = go [] s0
@@ -317,17 +275,17 @@ scan_ f s0 p = go [] s0
317 case T.uncons t of
275 case T.uncons t of
318 Just (c,t') -> case p s c of
276 Just (c,t') -> case p s c of
319 Just s' -> scanner s' (n+1) t'
277 Just s' -> scanner s' (n+1) t'
320− Nothing -> Finished s n t
278+ Nothing -> Finished n t
321 Nothing -> Continue s
279 Nothing -> Continue s
322 go acc s = do
280 go acc s = do
323 input <- get
281 input <- get
324 case scanner s 0 input of
282 case scanner s 0 input of
325− Continue s' -> do continue <- inputSpansChunks (size input)
283+ Continue s' -> do continue <- inputSpansChunks (length input)
326 if continue
284 if continue
327 then go (input : acc) s'
285 then go (input : acc) s'
328 else f s' (input : acc)
286 else f s' (input : acc)
329− Finished s' n t -> do advance (size input - size t)
287+ Finished n t -> do advance (length input - length t)
330− f s' (T.take n input : acc)
288+ f s (T.take n input : acc)
331{-# INLINE scan_ #-}
289{-# INLINE scan_ #-}
333-- | A stateful scanner. The predicate consumes and transforms a
291-- | A stateful scanner. The predicate consumes and transforms a
@@ -343,13 +301,16 @@ scan_ f s0 p = go [] s0
343-- parsers loop until a failure occurs. Careless use will thus result
301-- parsers loop until a failure occurs. Careless use will thus result
344-- in an infinite loop.
302-- in an infinite loop.
345scan :: s -> (s -> Char -> Maybe s) -> Parser Text
303scan :: s -> (s -> Char -> Maybe s) -> Parser Text
346−scan = scan_ $ \_ chunks -> return $! concatReverse chunks
304+scan = scan_ $ \_ chunks ->
307+ xs -> return . T.concat . reverse $ xs
347{-# INLINE scan #-}
308{-# INLINE scan #-}
349-- | Like 'scan', but generalized to return the final state of the
310-- | Like 'scan', but generalized to return the final state of the
350-- scanner.
311-- scanner.
351runScanner :: s -> (s -> Char -> Maybe s) -> Parser (Text, s)
312runScanner :: s -> (s -> Char -> Maybe s) -> Parser (Text, s)
352−runScanner = scan_ $ \s xs -> let !sx = concatReverse xs in return (sx, s)
313+runScanner = scan_ $ \s xs -> return (T.concat (reverse xs), s)
353{-# INLINE runScanner #-}
314{-# INLINE runScanner #-}
355-- | Consume input as long as the predicate returns 'True', and return
316-- | Consume input as long as the predicate returns 'True', and return
@@ -362,14 +323,13 @@ takeWhile1 :: (Char -> Bool) -> Parser Text
362takeWhile1 p = do
323takeWhile1 p = do
363 (`when` demandInput) =<< endOfChunk
324 (`when` demandInput) =<< endOfChunk
364 h <- T.takeWhile p <$> get
325 h <- T.takeWhile p <$> get
365− let size' = size h
326+ let len = length h
366− when (size' == 0) $ fail "takeWhile1"
327+ when (len == 0) $ fail "takeWhile1"
367− advance size'
328+ advance len
368 eoc <- endOfChunk
329 eoc <- endOfChunk
370− then takeWhileAcc p [h]
331+ then (h<>) `fmap` takeWhile p
371 else return h
332 else return h
372−{-# INLINE takeWhile1 #-}
374-- | Match any character in a set.
334-- | Match any character in a set.
@@ -469,10 +429,9 @@ parse m s = runParser m (buffer s) 0 Incomplete failK successK
470parseOnly :: Parser a -> Text -> Either String a
430parseOnly :: Parser a -> Text -> Either String a
471parseOnly m s = case runParser m (buffer s) 0 Complete failK successK of
431parseOnly m s = case runParser m (buffer s) 0 Complete failK successK of
472− Fail _ [] err -> Left err
473− Fail _ ctxs err -> Left (intercalate " > " ctxs ++ ": " ++ err)
432+ Fail _ _ err -> Left err
474− Done _ a -> Right a
433+ Done _ a -> Right a
475− _ -> error "parseOnly: impossible error!"
434+ _ -> error "parseOnly: impossible error!"
476{-# INLINE parseOnly #-}
435{-# INLINE parseOnly #-}
478get :: Parser Text
437get :: Parser Text
@@ -517,6 +476,7 @@ ensure n = T.Parser $ \t pos more lose succ ->
517 Just n' -> succ t pos more (n', substring pos n' t)
476 Just n' -> succ t pos more (n', substring pos n' t)
518 -- The uncommon case is kept out-of-line to reduce code size:
477 -- The uncommon case is kept out-of-line to reduce code size:
519 Nothing -> ensureSuspended n t pos more lose succ
478 Nothing -> ensureSuspended n t pos more lose succ
479+-- Non-recursive so the bounds check can be inlined:
520{-# INLINE ensure #-}
480{-# INLINE ensure #-}
522-- | Return both the result of a parse and the portion of the input
482-- | Return both the result of a parse and the portion of the input
@@ -527,8 +487,6 @@ match p = T.Parser $ \t pos more lose succ ->
527 (substring pos (pos'-pos) t', a)
487 (substring pos (pos'-pos) t', a)
528 in runParser p t pos more lose succ'
488 in runParser p t pos more lose succ'
530−-- | Ensure that at least @n@ code points of input are available.
531−-- Returns the number of words consumed while traversing.
532lengthAtLeast :: Pos -> Int -> Buffer -> Maybe Pos
490lengthAtLeast :: Pos -> Int -> Buffer -> Maybe Pos
533lengthAtLeast pos n t = go 0 (fromPos pos)
491lengthAtLeast pos n t = go 0 (fromPos pos)
534 where go i !p
492 where go i !p
@@ -545,5 +503,5 @@ substring (Pos pos) (Pos n) = Buf.substring pos n
545lengthOf :: Buffer -> Pos
503lengthOf :: Buffer -> Pos
546lengthOf = Pos . Buf.length
504lengthOf = Pos . Buf.length
548−size :: Text -> Pos
506+length :: Text -> Pos
549−size (Text _ _ l) = Pos l
507+length = Pos . T.length