c2ec0a4 · typeable/attoparsec

git.iko.soy/typeable/attoparsec

Failed experiment: add a Status type.

This is an attempt to address a bug I introduced when I changed the semantics of the <|> operator, I introduced a bug. Consider the following parser: (char 'f' *> char 'i') <|> char 'o' When I got rid of backtracking, this parser would accept an input of "fo", which is clearly not desirable. The Status type rescues this somewhat: when any parser consumes input, it enters the Committed state. The <|> operator only executes its RHS if its LHS fails while in the Uncommitted state (i.e. hasn't consumed any input). There's a nasty snag, of course: tracking this additional piece of state regresses aeson parsing performance to *worse* than when we had backtracking!

commitc2ec0a4fd956a8629327dbc7bbb924de45efe78e authorBryan O'Sullivan <bos@serpentine.com> dateFri 3 Jun 2011, 13:48 (15 years ago) parent6c8d050

2 files changed+74−62

compare with master

unifiedsplit

Data/Attoparsec/Internal.hs+50−49 Data/Attoparsec/Internal/Types.hs+24−13

Data/Attoparsec/Internal.hs+50−49

@@ -85,49 +85,49 @@ import qualified Data.ByteString.Unsafe as B

8585-- | If at least @n@ bytes of input are available, return the current

8686-- input, otherwise fail.

8787ensure :: Int -> Parser B.ByteString

88−ensure !n = Parser $ \i0 a0 m0 kf ks ->

88+ensure !n = Parser $ \i0 s0 a0 m0 kf ks ->

8989 if B.length (unI i0) >= n

90− then ks i0 a0 m0 (unI i0)

91− else runParser (demandInput >> ensure n) i0 a0 m0 kf ks

90+ then ks i0 s0 a0 m0 (unI i0)

91+ else runParser (demandInput >> ensure n) i0 s0 a0 m0 kf ks

9292

9393-- | Ask for input. If we receive any, pass it to a success

9494-- continuation, otherwise to a failure continuation.

95−prompt :: Input -> Added -> More

96− -> (Input -> Added -> More -> Result r)

97− -> (Input -> Added -> More -> Result r)

95+prompt :: Input -> Status -> Added -> More

96+ -> (Input -> Status -> Added -> More -> Result r)

97+ -> (Input -> Status -> Added -> More -> Result r)

9898 -> Result r

99−prompt i0 a0 _m0 kf ks = Partial $ \s ->

99+prompt i0 s0 a0 _m0 kf ks = Partial $ \s ->

100100 if B.null s

101− then kf i0 a0 Complete

102− else ks (i0 `mappend` I s) (a0 `mappend` Added s) Incomplete

101+ then kf i0 s0 a0 Complete

102+ else ks (i0 `mappend` I s) s0 (a0 `mappend` Added s) Incomplete

103103

104104-- | Immediately demand more input via a 'Partial' continuation

105105-- result.

106106demandInput :: Parser ()

107−demandInput = Parser $ \i0 a0 m0 kf ks ->

107+demandInput = Parser $ \i0 s0 a0 m0 kf ks ->

108108 if m0 == Complete

109− then kf i0 a0 m0 ["demandInput"] "not enough bytes"

110− else let kf' i a m = kf i a m ["demandInput"] "not enough bytes"

111− ks' i a m = ks i a m ()

112− in prompt i0 a0 m0 kf' ks'

109+ then kf i0 s0 a0 m0 ["demandInput"] "not enough bytes"

110+ else let kf' i s a m = kf i s a m ["demandInput"] "not enough bytes"

111+ ks' i s a m = ks i s a m ()

112+ in prompt i0 s0 a0 m0 kf' ks'

113113

114114-- | This parser always succeeds. It returns 'True' if any input is

115115-- available either immediately or on demand, and 'False' if the end

116116-- of all input has been reached.

117117wantInput :: Parser Bool

118−wantInput = Parser $ \i0 a0 m0 _kf ks ->

118+wantInput = Parser $ \i0 s0 a0 m0 _kf ks ->

119119 case () of

120− _ | not (B.null (unI i0)) -> ks i0 a0 m0 True

121− | m0 == Complete -> ks i0 a0 m0 False

122− | otherwise -> let kf' i a m = ks i a m False

123− ks' i a m = ks i a m True

124− in prompt i0 a0 m0 kf' ks'

120+ _ | not (B.null (unI i0)) -> ks i0 s0 a0 m0 True

121+ | m0 == Complete -> ks i0 s0 a0 m0 False

122+ | otherwise -> let kf' i s a m = ks i s a m False

123+ ks' i s a m = ks i s a m True

124+ in prompt i0 s0 a0 m0 kf' ks'

125125

126126get :: Parser B.ByteString

127−get = Parser $ \i0 a0 m0 _kf ks -> ks i0 a0 m0 (unI i0)

127+get = Parser $ \i0 s0 a0 m0 _kf ks -> ks i0 s0 a0 m0 (unI i0)

128128

129129put :: B.ByteString -> Parser ()

130−put s = Parser $ \_i0 a0 m0 _kf ks -> ks (I s) a0 m0 ()

130+put s = Parser $ \_i0 _s0 a0 m0 _kf ks -> ks (I s) Committed a0 m0 ()

131131

132132-- | Attempt a parse, and if it fails, rewind the input so that no

133133-- input appears to have been consumed.

@@ -137,22 +137,23 @@ put s = Parser $ \_i0 a0 m0 _kf ks -> ks (I s) a0 m0 ()

137137-- lookahead. The downside to using this combinator is that it can

138138-- retain input for longer than is desirable.

139139try :: Parser a -> Parser a

140−try p = Parser $ \i0 a0 m0 kf ks ->

141− noAdds i0 a0 m0 $ \i1 a1 m1 ->

142− let kf' i2 a2 m2 = addS i0 a0 m0 i2 a2 m2 kf

143− in runParser p i1 a1 m1 kf' ks

144− where noAdds i0 _a0 m0 f = f i0 mempty m0

140+try p = Parser $ \i0 s0 a0 m0 kf ks ->

141+ noAdds i0 s0 a0 m0 $ \i1 s1 a1 m1 ->

142+ let kf' i2 s2 a2 m2 = addS i0 s0 a0 m0 i2 s2 a2 m2 kf

143+ in runParser p i1 s1 a1 m1 kf' ks

144+ where noAdds i0 s0 _a0 m0 f = f i0 s0 mempty m0

145145

146−addS :: Input -> Added -> More

147− -> Input -> Added -> More

148− -> (Input -> Added -> More -> r) -> r

149−addS i0 a0 m0 _i1 a1 m1 f =

146+addS :: Input -> Status -> Added -> More

147+ -> Input -> Status -> Added -> More

148+ -> (Input -> Status -> Added -> More -> r) -> r

149+addS i0 s0 a0 m0 _i1 s1 a1 m1 f =

150150 let !i = case a1 of

151151 Dropped -> i0

152− Added s -> i0 `mappend` I s

152+ Added bs -> i0 `mappend` I bs

153+ !s = s0 `mappend` s1

153154 !a = a0 `mappend` a1

154155 !m = m0 `mappend` m1

155− in f i a m

156+ in f i s a m

156157{-# INLINE addS #-}

157158

158159-- | The parser @satisfy p@ succeeds for any byte for which the

@@ -410,17 +411,17 @@ notWord8 c = satisfy (/= c) <?> "not " ++ show c

410411

411412-- | Match only if all input has been consumed.

412413endOfInput :: Parser ()

413−endOfInput = Parser $ \i0 a0 m0 kf ks ->

414+endOfInput = Parser $ \i0 s0 a0 m0 kf ks ->

414415 if B.null (unI i0)

415416 then if m0 == Complete

416− then ks i0 a0 m0 ()

417− else let kf' i1 a1 m1 _ _ = addS i0 a0 m0 i1 a1 m1 $

418− \ i2 a2 m2 -> ks i2 a2 m2 ()

419− ks' i1 a1 m1 _ = addS i0 a0 m0 i1 a1 m1 $

420− \ i2 a2 m2 -> kf i2 a2 m2 []

421− "endOfInput"

422− in runParser demandInput i0 a0 m0 kf' ks'

423− else kf i0 a0 m0 [] "endOfInput"

417+ then ks i0 s0 a0 m0 ()

418+ else let kf' i1 s1 a1 m1 _ _ = addS i0 s0 a0 m0 i1 s1 a1 m1 $

419+ \ i2 s2 a2 m2 -> ks i2 s2 a2 m2 ()

420+ ks' i1 s1 a1 m1 _ = addS i0 s0 a0 m0 i1 s1 a1 m1 $

421+ \ i2 s2 a2 m2 -> kf i2 s2 a2 m2 []

422+ "endOfInput"

423+ in runParser demandInput i0 s0 a0 m0 kf' ks'

424+ else kf i0 s0 a0 m0 [] "endOfInput"

424425

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

426427-- reached.

@@ -437,30 +438,30 @@ endOfLine = (word8 10 >> return ()) <|> (string "\r\n" >> return ())

437438(<?>) :: Parser a

438439 -> String -- ^ the name to use if parsing fails

439440 -> Parser a

440−p <?> msg0 = Parser $ \i0 a0 m0 kf ks ->

441− let kf' i a m strs msg = kf i a m (msg0:strs) msg

442− in runParser p i0 a0 m0 kf' ks

441+p <?> msg0 = Parser $ \i0 s0 a0 m0 kf ks ->

442+ let kf' i s a m strs msg = kf i s a m (msg0:strs) msg

443+ in runParser p i0 s0 a0 m0 kf' ks

443444{-# INLINE (<?>) #-}

444445infix 0 <?>

445446

446447-- | Terminal failure continuation.

447448failK :: Failure a

448−failK i0 _a0 _m0 stack msg = Fail (unI i0) stack msg

449+failK i0 _s0 _a0 _m0 stack msg = Fail (unI i0) stack msg

449450{-# INLINE failK #-}

450451

451452-- | Terminal success continuation.

452453successK :: Success a a

453−successK i0 _a0 _m0 a = Done (unI i0) a

454+successK i0 _s0 _a0 _m0 a = Done (unI i0) a

454455{-# INLINE successK #-}

455456

456457-- | Run a parser.

457458parse :: Parser a -> B.ByteString -> Result a

458−parse m s = runParser m (I s) mempty Incomplete failK successK

459+parse m s = runParser m (I s) Uncommitted mempty Incomplete failK successK

459460{-# INLINE parse #-}

460461

461462-- | Run a parser that cannot be resupplied via a 'Partial' result.

462463parseOnly :: Parser a -> B.ByteString -> Either String a

463−parseOnly m s = case runParser m (I s) mempty Complete failK successK of

464+parseOnly m s = case runParser m (I s) Uncommitted mempty Complete failK successK of

464465 Fail _ _ err -> Left err

465466 Done _ a -> Right a

466467 _ -> error "parseOnly: impossible error!"

Data/Attoparsec/Internal/Types.hs+24−13

@@ -18,6 +18,7 @@ module Data.Attoparsec.Internal.Types

1818 , Success

1919 , Result(..)

2020 , Input(..)

21+ , Status(..)

2122 , Added(..)

2223 , More(..)

2324 , (+++)

@@ -86,14 +87,23 @@ instance Monoid Added where

8687

8788-- | The 'Parser' type is a monad.

8889newtype Parser a = Parser {

89− runParser :: forall r. Input -> Added -> More

90+ runParser :: forall r. Input -> Status -> Added -> More

9091 -> Failure r

9192 -> Success a r

9293 -> Result r

9394 }

9495

95−type Failure r = Input -> Added -> More -> [String] -> String -> Result r

96−type Success a r = Input -> Added -> More -> a -> Result r

96+type Failure r = Input -> Status -> Added -> More -> [String] -> String -> Result r

97+type Success a r = Input -> Status -> Added -> More -> a -> Result r

98+

99+data Status = Uncommitted | Committed

100+ deriving (Eq, Show)

101+

102+instance Monoid Status where

103+ mempty = Uncommitted

104+ mappend c@Committed _ = c

105+ mappend _ c@Committed = c

106+ mappend _ _ = Uncommitted

97107

98108-- | Have we read all available input?

99109data More = Complete | Incomplete

@@ -106,13 +116,13 @@ instance Monoid More where

106116 mappend _ _ = Incomplete

107117

108118bindP :: Parser a -> (a -> Parser b) -> Parser b

109−bindP m g =

110− Parser $ \i0 a0 m0 kf ks -> runParser m i0 a0 m0 kf $

111− \i1 a1 m1 a -> runParser (g a) i1 a1 m1 kf ks

119+bindP m g = Parser $ \i0 s0 a0 m0 kf ks ->

120+ runParser m i0 s0 a0 m0 kf $ \i1 s1 a1 m1 a ->

121+ runParser (g a) i1 s1 a1 m1 kf ks

112122{-# INLINE bindP #-}

113123

114124returnP :: a -> Parser a

115−returnP a = Parser (\i0 a0 m0 _kf ks -> ks i0 a0 m0 a)

125+returnP a = Parser (\i0 s0 a0 m0 _kf ks -> ks i0 s0 a0 m0 a)

116126{-# INLINE returnP #-}

117127

118128instance Monad Parser where

@@ -121,9 +131,10 @@ instance Monad Parser where

121131 fail = failDesc

122132

123133plus :: Parser a -> Parser a -> Parser a

124−plus a b = Parser $ \i0 a0 m0 kf ks ->

125− let kf' i1 a1 m1 _ _ = runParser b i1 a1 m1 kf ks

126− in runParser a i0 a0 m0 kf' ks

134+plus a b = Parser $ \i0 _s0 a0 m0 kf ks ->

135+ let kf' i1 s1@Uncommitted a1 m1 _ _ = runParser b i1 s1 a1 m1 kf ks

136+ kf' i1 s1 a1 m1 kf1 ks1 = kf i1 s1 a1 m1 kf1 ks1

137+ in runParser a i0 Uncommitted a0 m0 kf' ks

127138{-# INLINE plus #-}

128139

129140instance MonadPlus Parser where

@@ -132,8 +143,8 @@ instance MonadPlus Parser where

132143 mplus = plus

133144

134145fmapP :: (a -> b) -> Parser a -> Parser b

135−fmapP p m = Parser $ \i0 a0 m0 f k ->

136− runParser m i0 a0 m0 f $ \i1 a1 s1 a -> k i1 a1 s1 (p a)

146+fmapP p m = Parser $ \i0 s0 a0 m0 f k ->

147+ runParser m i0 s0 a0 m0 f $ \i1 s1 a1 m1 a -> k i1 s1 a1 m1 (p a)

137148{-# INLINE fmapP #-}

138149

139150instance Functor Parser where

@@ -174,7 +185,7 @@ instance Alternative Parser where

174185 {-# INLINE (<|>) #-}

175186

176187failDesc :: String -> Parser a

177−failDesc err = Parser (\i0 a0 m0 kf _ks -> kf i0 a0 m0 [] msg)

188+failDesc err = Parser (\i0 s0 a0 m0 kf _ks -> kf i0 s0 a0 m0 [] msg)

178189 where msg = "Failed reading: " ++ err

179190{-# INLINE failDesc #-}

180191