5dbce7d · typeable/attoparsec

git.iko.soy/typeable/attoparsec

on master help sign in

Switch Text to Word16-based indexing

5dbce7dBryan O'Sullivan12 years ago

Data/Attoparsec/Text/Internal.hs+51−45

compare with master

unifiedsplit

@@ -65,13 +65,14 @@ module Data.Attoparsec.Text.Internal

65 , atEnd

66 ) where

68+import Debug.Trace

68import Control.Applicative ((<|>), (<$>))

69import Control.Applicative ((<|>), (<$>))

69import Control.Monad (when)

70import Control.Monad (when)

70import Data.Attoparsec.Combinator ((<?>))

71import Data.Attoparsec.Combinator ((<?>))

71import Data.Attoparsec.Internal.Types hiding (Parser, Failure, Success)

72import Data.Attoparsec.Internal.Types hiding (Parser, Failure, Success)

72import Data.Char (chr, ord)

73import Data.Char (chr, ord)

73import Data.String (IsString(..))

74import Data.String (IsString(..))

74−import Data.Text (Text)

75+import Data.Text.Internal (Text(..))

75import Prelude hiding (getChar, succ, take, takeWhile)

76import Prelude hiding (getChar, succ, take, takeWhile)

76import qualified Data.Attoparsec.Internal.Types as T

77import qualified Data.Attoparsec.Internal.Types as T

77import qualified Data.Attoparsec.Text.FastSet as Set

78import qualified Data.Attoparsec.Text.FastSet as Set

@@ -110,7 +111,7 @@ satisfy p = do

110skip :: (Char -> Bool) -> Parser ()

111skip :: (Char -> Bool) -> Parser ()

111skip p = do

112skip p = do

112 (k,s) <- ensure 1

113 (k,s) <- ensure 1

113− if p (T.head s)

114+ if p (T.unsafeHead s)

114 then advance k

115 then advance k

115 else fail "skip"

116 else fail "skip"

116

117

@@ -120,7 +121,7 @@ skip p = do

120satisfyWith :: (Char -> a) -> (a -> Bool) -> Parser a

121satisfyWith :: (Char -> a) -> (a -> Bool) -> Parser a

121satisfyWith f p = do

122satisfyWith f p = do

122 (k,s) <- ensure 1

123 (k,s) <- ensure 1

123− let c = f $! T.head s

124+ let c = f $! T.unsafeHead s

124 if p c

125 if p c

125 then advance k >> return c

126 then advance k >> return c

126 else fail "satisfyWith"

127 else fail "satisfyWith"

@@ -131,14 +132,13 @@ satisfyWith f p = do

131takeWith :: Int -> (Text -> Bool) -> Parser Text

132takeWith :: Int -> (Text -> Bool) -> Parser Text

132takeWith n p = do

133takeWith n p = do

133 (k,s) <- ensure n

134 (k,s) <- ensure n

134− let h = T.take n s

135− if p h

135+ if p s

136− then advance k >> return h

136+ then advance k >> return s

137 else fail "takeWith"

138

139-- | Consume exactly @n@ characters of input.

140take :: Int -> Parser Text

141−take n = takeWith n (const True)

141+take n = takeWith (max n 0) (const True)

142{-# INLINE take #-}

143

144-- | @string s@ parses a sequence of characters that identically match

@@ -184,9 +184,8 @@ stringCI s = go 0

184asciiCI :: Text -> Parser Text

185asciiCI input = do

186 (k,t) <- ensure n

187− let h = T.take n t

188− if asciiToLower h == s

187+ if asciiToLower t == s

189− then advance k >> return h

188+ then advance k >> return t

190 else fail "asciiCI"

189 else fail "asciiCI"

191 where

190 where

192 n = T.length input

191 n = T.length input

@@ -206,7 +205,7 @@ skipWhile p = go

206 where

205 where

207 go = do

206 go = do

208 t <- T.takeWhile p <$> get

207 t <- T.takeWhile p <$> get

209− advance (T.length t)

208+ advance (lengthOf t)

210 eoc <- endOfChunk

209 eoc <- endOfChunk

211 when eoc $ do

210 when eoc $ do

212 input <- wantInput

211 input <- wantInput

@@ -240,7 +239,7 @@ takeWhile p = (T.concat . reverse) `fmap` go []

240 where

239 where

241 go acc = do

240 go acc = do

242 h <- T.takeWhile p <$> get

241 h <- T.takeWhile p <$> get

243− advance (T.length h)

242+ advance (lengthOf h)

244 eoc <- endOfChunk

243 eoc <- endOfChunk

245 if eoc

244 if eoc

246 then do

245 then do

@@ -258,7 +257,7 @@ takeRest = go []

258 if input

257 if input

259 then do

258 then do

260 s <- get

259 s <- get

261− advance (T.length s)

260+ advance (lengthOf s)

262 go (s:acc)

261 go (s:acc)

263 else return (reverse acc)

262 else return (reverse acc)

264

263

@@ -285,12 +284,12 @@ scan_ f s0 p = go [] s0

285 go acc s = do

284 go acc s = do

286 input <- get

285 input <- get

287 case scanner s 0 input of

286 case scanner s 0 input of

288− Continue s' -> do advance (T.length input)

287+ Continue s' -> do advance (lengthOf input)

289 more <- wantInput

288 more <- wantInput

290 if more

289 if more

291 then go (input : acc) s'

290 then go (input : acc) s'

292 else f s' (input : acc)

291 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)

294 f s (T.take n input : acc)

293 f s (T.take n input : acc)

295{-# INLINE scan_ #-}

294{-# INLINE scan_ #-}

296

295

@@ -328,7 +327,7 @@ takeWhile1 :: (Char -> Bool) -> Parser Text

328takeWhile1 p = do

327takeWhile1 p = do

329 (`when` demandInput) =<< endOfChunk

328 (`when` demandInput) =<< endOfChunk

330 h <- T.takeWhile p <$> get

329 h <- T.takeWhile p <$> get

331− let len = T.length h

330+ let len = lengthOf h

332 when (len == 0) $ fail "takeWhile1"

331 when (len == 0) $ fail "takeWhile1"

333 advance len

332 advance len

334 eoc <- endOfChunk

333 eoc <- endOfChunk

@@ -381,14 +380,15 @@ notChar c = satisfy (/= c) <?> "not " ++ show c

381peekChar :: Parser (Maybe Char)

380peekChar :: Parser (Maybe Char)

382peekChar = T.Parser $ \t pos more _lose succ ->

381peekChar = T.Parser $ \t pos more _lose succ ->

383 case () of

382 case () of

384− _| lengthAtLeast pos 1 t ->

383+ _| pos < lengthOf t ->

385− let !c = T.head (T.drop (fromPos pos) t)

384+ let T.Iter !c _ = T.iter t (fromPos pos)

386 in succ t pos more (Just c)

385 in succ t pos more (Just c)

387 | more == Complete ->

386 | more == Complete ->

388 succ t pos more Nothing

387 succ t pos more Nothing

389 | otherwise ->

388 | otherwise ->

390− let succ' t' pos' more' = let !c = T.head (T.drop (fromPos pos) t')

389+ let succ' t' pos' more' =

390+ let T.Iter !c _ = T.iter t' (fromPos pos')

391− in succ t' pos' more' (Just c)

391+ in succ t' pos' more' (Just c)

392 lose' t' pos' more' = succ t' pos' more' Nothing

393 in prompt t pos more lose' succ'

394{-# INLINE peekChar #-}

@@ -398,7 +398,7 @@ peekChar = T.Parser $ \t pos more _lose succ ->

398peekChar' :: Parser Char

399peekChar' = do

400 (_,s) <- ensure 1

401− return $! T.head s

401+ return $! T.unsafeHead s

402{-# INLINE peekChar' #-}

403

404-- | Match either a single newline character @\'\\n\'@, or a carriage

@@ -408,12 +408,12 @@ endOfLine = (char '\n' >> return ()) <|> (string "\r\n" >> return ())

408

409-- | Terminal failure continuation.

410failK :: 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

412{-# INLINE failK #-}

413

414-- | Terminal success continuation.

415successK :: 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

417{-# INLINE successK #-}

418

419-- | Run a parser.

@@ -431,37 +431,36 @@ parseOnly m s = case runParser m s 0 Complete failK successK of

431

432get :: Parser Text

433get = 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)

435{-# INLINE get #-}

436

437endOfChunk :: Parser Bool

438endOfChunk = 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)

440{-# INLINE endOfChunk #-}

441

442−advance :: Int -> Parser ()

442+advance :: Pos -> Parser ()

443−advance n = T.Parser $ \t pos more _lose succ ->

443+advance n = T.Parser $ \t pos more _lose succ -> succ t (pos+n) more ()

444− succ t (Pos ((fromPos pos) + n)) more ()

445{-# INLINE advance #-}

444{-# INLINE advance #-}

446

445

447ensureSuspended :: Int -> Text -> Pos -> More

446ensureSuspended :: Int -> Text -> Pos -> More

448− -> Failure r -> Success (Int,Text) r

447+ -> Failure r -> Success (Pos, Text) r

449 -> Result r

448 -> Result r

450ensureSuspended n t pos more lose succ =

449ensureSuspended n t pos more lose succ =

451 runParser (demandInput >> go) t pos more lose succ

450 runParser (demandInput >> go) t pos more lose succ

452 where go = T.Parser $ \t' pos' more' lose' succ' ->

451 where go = T.Parser $ \t' pos' more' lose' succ' ->

453− if lengthAtLeast pos' n t'

452+ case lengthAtLeast pos' n t' of

454− then succ' t' pos' more' (n, substring pos n t')

453+ Just n' -> succ' t' pos' more' (n', substring pos n' t')

455− else runParser (demandInput >> go) t' pos' more' lose' succ'

454+ Nothing -> runParser (demandInput >> go) t' pos' more' lose' succ'

456

455

457-- | If at least @n@ elements of input are available, return the

456-- | If at least @n@ elements of input are available, return the

458-- current input, otherwise fail.

457-- current input, otherwise fail.

459−ensure :: Int -> Parser (Int, Text)

458+ensure :: Int -> Parser (Pos, Text)

460ensure n = T.Parser $ \t pos more lose succ ->

459ensure n = T.Parser $ \t pos more lose succ ->

461− if lengthAtLeast pos n t

460+ case lengthAtLeast pos n t of

462− then succ t pos more (n, substring pos n t)

461+ Just n' -> succ t pos more (n', substring pos n' t)

463− -- The uncommon case is kept out-of-line to reduce code size:

462+ -- The uncommon case is kept out-of-line to reduce code size:

464− else ensureSuspended n t pos more lose succ

463+ Nothing -> ensureSuspended n t pos more lose succ

465-- Non-recursive so the bounds check can be inlined:

464-- Non-recursive so the bounds check can be inlined:

466{-# INLINE ensure #-}

465{-# INLINE ensure #-}

467

466

@@ -492,7 +491,7 @@ demandInput = T.Parser $ \t pos more lose succ ->

492wantInput :: Parser Bool

491wantInput :: Parser Bool

493wantInput = T.Parser $ \t pos more _lose succ ->

492wantInput = T.Parser $ \t pos more _lose succ ->

494 case () of

493 case () of

495− _ | lengthAtLeast pos 1 t -> succ t pos more True

494+ _ | pos < lengthOf t -> succ t pos more True

496 | more == Complete -> succ t pos more False

495 | more == Complete -> succ t pos more False

497 | otherwise -> let lose' t' pos' more' = succ t' pos' more' False

496 | otherwise -> let lose' t' pos' more' = succ t' pos' more' False

498 succ' t' pos' more' = succ t' pos' more' True

497 succ' t' pos' more' = succ t' pos' more' True

@@ -502,7 +501,7 @@ wantInput = T.Parser $ \t pos more _lose succ ->

502endOfInput :: Parser ()

501endOfInput :: Parser ()

503endOfInput = T.Parser $ \t pos more lose succ ->

502endOfInput = T.Parser $ \t pos more lose succ ->

504 case () of

503 case () of

505− _| lengthAtLeast pos 1 t -> lose t pos more [] "endOfInput"

504+ _| pos < lengthOf t -> lose t pos more [] "endOfInput"

506 | more == Complete -> succ t pos more ()

505 | more == Complete -> succ t pos more ()

507 | otherwise ->

506 | otherwise ->

508 let lose' t' pos' more' _ctx _msg = succ t' pos' more' ()

507 let lose' t' pos' more' _ctx _msg = succ t' pos' more' ()

@@ -514,7 +513,7 @@ endOfInput = T.Parser $ \t pos more lose succ ->

514match :: Parser a -> Parser (Text, a)

513match :: Parser a -> Parser (Text, a)

515match p = T.Parser $ \t pos more lose succ ->

514match p = T.Parser $ \t pos more lose succ ->

516 let succ' t' pos' more' a = succ t' pos' more'

515 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)

518 in runParser p t pos more lose succ'

517 in runParser p t pos more lose succ'

519

518

520-- | Return an indication of whether the end of input has been

519-- | Return an indication of whether the end of input has been

@@ -523,11 +522,18 @@ atEnd :: Parser Bool

523atEnd = not <$> wantInput

522atEnd = not <$> wantInput

524{-# INLINE atEnd #-}

523{-# INLINE atEnd #-}

525

524

526−lengthAtLeast :: Pos -> Int -> Text -> Bool

525+lengthAtLeast :: Pos -> Int -> Text -> Maybe Pos

527−lengthAtLeast pos n t = T.lengthWord16 t `quot` 2 >= o || T.length t >= o

526+lengthAtLeast pos n t = go 0 (fromPos pos)

528− where o = fromPos pos + n

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

529{-# INLINE lengthAtLeast #-}

532{-# INLINE lengthAtLeast #-}

530

533

531−substring :: Pos -> Int -> Text -> Text

534+substring :: Pos -> Pos -> Text -> Text

532−substring (Pos pos) n t = T.take n (T.drop pos t)

535+substring (Pos pos) (Pos n) t = T.takeWord16 n (T.dropWord16 pos t)

533{-# INLINE substring #-}

536{-# INLINE substring #-}

537+

538+lengthOf :: Text -> Pos

539+lengthOf (Text _arr _off len) = Pos len