@@ -65,13 +65,14 @@ module Data.Attoparsec.Text.Internal
6565 , atEnd
6666 ) where
6767
68+import Debug.Trace
6869import Control.Applicative ((<|>), (<$>))
6970import Control.Monad (when)
7071import Data.Attoparsec.Combinator ((<?>))
7172import Data.Attoparsec.Internal.Types hiding (Parser, Failure, Success)
7273import Data.Char (chr, ord)
7374import Data.String (IsString(..))
74−import Data.Text (Text)
75+import Data.Text.Internal (Text(..))
7576import Prelude hiding (getChar, succ, take, takeWhile)
7677import qualified Data.Attoparsec.Internal.Types as T
7778import qualified Data.Attoparsec.Text.FastSet as Set
@@ -110,7 +111,7 @@ satisfy p = do
110111skip :: (Char -> Bool) -> Parser ()
111112skip p = do
112113 (k,s) <- ensure 1
113− if p (T.head s)
114+ if p (T.unsafeHead s)
114115 then advance k
115116 else fail "skip"
116117
@@ -120,7 +121,7 @@ skip p = do
120121satisfyWith :: (Char -> a) -> (a -> Bool) -> Parser a
121122satisfyWith f p = do
122123 (k,s) <- ensure 1
123− let c = f $! T.head s
124+ let c = f $! T.unsafeHead s
124125 if p c
125126 then advance k >> return c
126127 else fail "satisfyWith"
@@ -131,14 +132,13 @@ satisfyWith f p = do
131132takeWith :: Int -> (Text -> Bool) -> Parser Text
132133takeWith n p = do
133134 (k,s) <- ensure n
134− let h = T.take n s
135− if p h
136− then advance k >> return h
135+ if p s
136+ then advance k >> return s
137137 else fail "takeWith"
138138
139139-- | Consume exactly @n@ characters of input.
140140take :: Int -> Parser Text
141−take n = takeWith n (const True)
141+take n = takeWith (max n 0) (const True)
142142{-# INLINE take #-}
143143
144144-- | @string s@ parses a sequence of characters that identically match
@@ -184,9 +184,8 @@ stringCI s = go 0
184184asciiCI :: Text -> Parser Text
185185asciiCI input = do
186186 (k,t) <- ensure n
187− let h = T.take n t
188− if asciiToLower h == s
189− then advance k >> return h
187+ if asciiToLower t == s
188+ then advance k >> return t
190189 else fail "asciiCI"
191190 where
192191 n = T.length input
@@ -206,7 +205,7 @@ skipWhile p = go
206205 where
207206 go = do
208207 t <- T.takeWhile p <$> get
209− advance (T.length t)
208+ advance (lengthOf t)
210209 eoc <- endOfChunk
211210 when eoc $ do
212211 input <- wantInput
@@ -240,7 +239,7 @@ takeWhile p = (T.concat . reverse) `fmap` go []
240239 where
241240 go acc = do
242241 h <- T.takeWhile p <$> get
243− advance (T.length h)
242+ advance (lengthOf h)
244243 eoc <- endOfChunk
245244 if eoc
246245 then do
@@ -258,7 +257,7 @@ takeRest = go []
258257 if input
259258 then do
260259 s <- get
261− advance (T.length s)
260+ advance (lengthOf s)
262261 go (s:acc)
263262 else return (reverse acc)
264263
@@ -285,12 +284,12 @@ scan_ f s0 p = go [] s0
285284 go acc s = do
286285 input <- get
287286 case scanner s 0 input of
288− Continue s' -> do advance (T.length input)
287+ Continue s' -> do advance (lengthOf input)
289288 more <- wantInput
290289 if more
291290 then go (input : acc) s'
292291 else f s' (input : acc)
293− Finished n t -> do advance (T.length input - T.length t)
292+ Finished n t -> do advance (lengthOf input - lengthOf t)
294293 f s (T.take n input : acc)
295294{-# INLINE scan_ #-}
296295
@@ -328,7 +327,7 @@ takeWhile1 :: (Char -> Bool) -> Parser Text
328327takeWhile1 p = do
329328 (`when` demandInput) =<< endOfChunk
330329 h <- T.takeWhile p <$> get
331− let len = T.length h
330+ let len = lengthOf h
332331 when (len == 0) $ fail "takeWhile1"
333332 advance len
334333 eoc <- endOfChunk
@@ -381,14 +380,15 @@ notChar c = satisfy (/= c) <?> "not " ++ show c
381380peekChar :: Parser (Maybe Char)
382381peekChar = T.Parser $ \t pos more _lose succ ->
383382 case () of
384− _| lengthAtLeast pos 1 t ->
385− let !c = T.head (T.drop (fromPos pos) t)
383+ _| pos < lengthOf t ->
384+ let T.Iter !c _ = T.iter t (fromPos pos)
386385 in succ t pos more (Just c)
387386 | more == Complete ->
388387 succ t pos more Nothing
389388 | otherwise ->
390− let succ' t' pos' more' = let !c = T.head (T.drop (fromPos pos) t')
391− in succ t' pos' more' (Just c)
389+ let succ' t' pos' more' =
390+ let T.Iter !c _ = T.iter t' (fromPos pos')
391+ in succ t' pos' more' (Just c)
392392 lose' t' pos' more' = succ t' pos' more' Nothing
393393 in prompt t pos more lose' succ'
394394{-# INLINE peekChar #-}
@@ -398,7 +398,7 @@ peekChar = T.Parser $ \t pos more _lose succ ->
398398peekChar' :: Parser Char
399399peekChar' = do
400400 (_,s) <- ensure 1
401− return $! T.head s
401+ return $! T.unsafeHead s
402402{-# INLINE peekChar' #-}
403403
404404-- | Match either a single newline character @\'\\n\'@, or a carriage
@@ -408,12 +408,12 @@ endOfLine = (char '\n' >> return ()) <|> (string "\r\n" >> return ())
408408
409409-- | Terminal failure continuation.
410410failK :: Failure a
411−failK t (Pos pos) _more stack msg = Fail (T.drop pos t) stack msg
411+failK t (Pos pos) _more stack msg = Fail (T.dropWord16 pos t) stack msg
412412{-# INLINE failK #-}
413413
414414-- | Terminal success continuation.
415415successK :: Success a a
416−successK t (Pos pos) _more a = Done (T.drop pos t) a
416+successK t (Pos pos) _more a = Done (T.dropWord16 pos t) a
417417{-# INLINE successK #-}
418418
419419-- | Run a parser.
@@ -431,37 +431,36 @@ parseOnly m s = case runParser m s 0 Complete failK successK of
431431
432432get :: Parser Text
433433get = T.Parser $ \t pos more _lose succ ->
434− succ t pos more (T.drop (fromPos pos) t)
434+ succ t pos more (T.dropWord16 (fromPos pos) t)
435435{-# INLINE get #-}
436436
437437endOfChunk :: Parser Bool
438438endOfChunk = T.Parser $ \t pos more _lose succ ->
439− succ t pos more (fromPos pos == T.length t)
439+ succ t pos more (pos == lengthOf t)
440440{-# INLINE endOfChunk #-}
441441
442−advance :: Int -> Parser ()
443−advance n = T.Parser $ \t pos more _lose succ ->
444− succ t (Pos ((fromPos pos) + n)) more ()
442+advance :: Pos -> Parser ()
443+advance n = T.Parser $ \t pos more _lose succ -> succ t (pos+n) more ()
445444{-# INLINE advance #-}
446445
447446ensureSuspended :: Int -> Text -> Pos -> More
448− -> Failure r -> Success (Int,Text) r
447+ -> Failure r -> Success (Pos, Text) r
449448 -> Result r
450449ensureSuspended n t pos more lose succ =
451450 runParser (demandInput >> go) t pos more lose succ
452451 where go = T.Parser $ \t' pos' more' lose' succ' ->
453− if lengthAtLeast pos' n t'
454− then succ' t' pos' more' (n, substring pos n t')
455− else runParser (demandInput >> go) t' pos' more' lose' succ'
452+ case lengthAtLeast pos' n t' of
453+ Just n' -> succ' t' pos' more' (n', substring pos n' t')
454+ Nothing -> runParser (demandInput >> go) t' pos' more' lose' succ'
456455
457456-- | If at least @n@ elements of input are available, return the
458457-- current input, otherwise fail.
459−ensure :: Int -> Parser (Int, Text)
458+ensure :: Int -> Parser (Pos, Text)
460459ensure n = T.Parser $ \t pos more lose succ ->
461− if lengthAtLeast pos n t
462− then succ t pos more (n, substring pos n t)
463− -- The uncommon case is kept out-of-line to reduce code size:
464− else ensureSuspended n t pos more lose succ
460+ case lengthAtLeast pos n t of
461+ Just n' -> succ t pos more (n', substring pos n' t)
462+ -- The uncommon case is kept out-of-line to reduce code size:
463+ Nothing -> ensureSuspended n t pos more lose succ
465464-- Non-recursive so the bounds check can be inlined:
466465{-# INLINE ensure #-}
467466
@@ -492,7 +491,7 @@ demandInput = T.Parser $ \t pos more lose succ ->
492491wantInput :: Parser Bool
493492wantInput = T.Parser $ \t pos more _lose succ ->
494493 case () of
495− _ | lengthAtLeast pos 1 t -> succ t pos more True
494+ _ | pos < lengthOf t -> succ t pos more True
496495 | more == Complete -> succ t pos more False
497496 | otherwise -> let lose' t' pos' more' = succ t' pos' more' False
498497 succ' t' pos' more' = succ t' pos' more' True
@@ -502,7 +501,7 @@ wantInput = T.Parser $ \t pos more _lose succ ->
502501endOfInput :: Parser ()
503502endOfInput = T.Parser $ \t pos more lose succ ->
504503 case () of
505− _| lengthAtLeast pos 1 t -> lose t pos more [] "endOfInput"
504+ _| pos < lengthOf t -> lose t pos more [] "endOfInput"
506505 | more == Complete -> succ t pos more ()
507506 | otherwise ->
508507 let lose' t' pos' more' _ctx _msg = succ t' pos' more' ()
@@ -514,7 +513,7 @@ endOfInput = T.Parser $ \t pos more lose succ ->
514513match :: Parser a -> Parser (Text, a)
515514match p = T.Parser $ \t pos more lose succ ->
516515 let succ' t' pos' more' a = succ t' pos' more'
517− (substring pos (fromPos pos'-fromPos pos) t', a)
516+ (substring pos (pos'-pos) t', a)
518517 in runParser p t pos more lose succ'
519518
520519-- | Return an indication of whether the end of input has been
@@ -523,11 +522,18 @@ atEnd :: Parser Bool
523522atEnd = not <$> wantInput
524523{-# INLINE atEnd #-}
525524
526−lengthAtLeast :: Pos -> Int -> Text -> Bool
527−lengthAtLeast pos n t = T.lengthWord16 t `quot` 2 >= o || T.length t >= o
528− where o = fromPos pos + n
525+lengthAtLeast :: Pos -> Int -> Text -> Maybe Pos
526+lengthAtLeast pos n t = go 0 (fromPos pos)
527+ where go i !p
528+ | i == n = Just (Pos p)
529+ | p == len = Nothing
530+ | otherwise = go (i+1) (p + T.iter_ t p)
531+ Pos len = lengthOf t
529532{-# INLINE lengthAtLeast #-}
530533
531−substring :: Pos -> Int -> Text -> Text
532−substring (Pos pos) n t = T.take n (T.drop pos t)
534+substring :: Pos -> Pos -> Text -> Text
535+substring (Pos pos) (Pos n) t = T.takeWord16 n (T.dropWord16 pos t)
533536{-# INLINE substring #-}
537+
538+lengthOf :: Text -> Pos
539+lengthOf (Text _arr _off len) = Pos len