39fd7d0 · typeable/attoparsec

git.iko.soy/typeable/attoparsec

on master help sign in

Backed out changeset d7380d1e4b65, due to lacklustre performance

39fd7d0Bryan O'Sullivan17 years ago

Data/Attoparsec.hs+5−5

compare with master

unifiedsplit

@@ -83,9 +83,9 @@ parseTest :: (Show a) => I.Parser a -> B.ByteString -> IO ()

83parseTest p s = print (parse p s)

85translate :: I.Result a -> Result a

86−translate (I.Fail s0 a0 c0 stk msg) = Fail s0 stk msg

86+translate (I.Fail st stk msg) = Fail (I.input st) stk msg

87−translate (I.Partial k) = Partial (translate . k)

87+translate (I.Partial k) = Partial (translate . k)

88−translate (I.Done s0 a0 c0 r) = Done s0 r

88+translate (I.Done st r) = Done (I.input st) r

90parse :: I.Parser a -> B.ByteString -> Result a

91parse m s = translate (I.parse m s)

@@ -97,6 +97,6 @@ parseWith :: Monad m =>

97 -> B.ByteString

98 -> m (Result a)

99parseWith refill p s = step $ I.parse p s

100− where step (I.Fail s0 a0 c0 stk msg) = return $! Fail s0 stk msg

100+ where step (I.Fail st stk msg) = return $! Fail (I.input st) stk msg

101 step (I.Partial k) = (step . k) =<< refill

102− step (I.Done s0 a0 c0 r) = return $! Done s0 r

102+ step (I.Done st r) = return $! Done (I.input st) r

Data/Attoparsec/Internal.hs+58−44

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

18 -- * Parser types

19 Parser

20 , Result(..)

21+ , S(input)

22 -- * Running parsers

23 -- * Running parsers

23 , parse

24 , parse

@@ -75,25 +76,20 @@ import qualified Data.ByteString.Char8 as B

75import qualified Data.ByteString.Internal as B

76import qualified Data.ByteString.Internal as B

76import qualified Data.ByteString.Unsafe as B

77import qualified Data.ByteString.Unsafe as B

78−data Result r = Fail Input Added More [String] String

79+data Result r = Fail S [String] String

79 | Partial (B.ByteString -> Result r)

80 | Partial (B.ByteString -> Result r)

80− | Done Input Added More r

81+ | Done S r

81−

82−type Input = B.ByteString

83−type Added = B.ByteString

84−

85−type S a = Input -> Added -> More -> a

87-- | The Parser monad is an Exception and State monad.

83-- | The Parser monad is an Exception and State monad.

88newtype Parser a = Parser {

84newtype Parser a = Parser {

89 runParser :: forall r. S

85 runParser :: forall r. S

90− (Failure r

86+ -> Failure r

91− -> Success a r

87+ -> Success a r

92− -> Result r)

88+ -> Result r

93 }

89 }

95−type Failure r = S ([String] -> String -> Result r)

91+type Failure r = S -> [String] -> String -> Result r

96−type Success a r = S (a -> Result r)

92+type Success a r = S -> a -> Result r

98data More = Complete | Incomplete

94data More = Complete | Incomplete

99 deriving (Eq, Show)

95 deriving (Eq, Show)

@@ -108,18 +104,32 @@ instance Monoid More where

108 mempty = Incomplete

104 mempty = Incomplete

109 mappend = plusMore

105 mappend = plusMore

110

106

107+data S = S {

108+ input :: !B.ByteString

109+ , _added :: !B.ByteString

110+ , more :: !More

111+ } deriving (Show)

112+

111instance Show r => Show (Result r) where

113instance Show r => Show (Result r) where

112− show (Fail _ _ _ stack msg) = "Fail " ++ show stack ++ " " ++ show msg

114+ show (Fail _ stack msg) = "Fail " ++ show stack ++ " " ++ show msg

113 show (Partial _) = "Partial _"

115 show (Partial _) = "Partial _"

114− show (Done bs _ _ r) = "Done " ++ show bs ++ " " ++ show r

116+ show (Done bs r) = "Done " ++ show bs ++ " " ++ show r

117+

118+addS :: S -> S -> S

119+addS (S s0 a0 c0) (S _s1 a1 c1) = S (s0 +++ a1) (a0 +++ a1) (mappend c0 c1)

120+{-# INLINE addS #-}

121+

122+instance Monoid S where

123+ mempty = S B.empty B.empty Incomplete

124+ mappend = addS

115

125

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

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

117bindP m g =

127bindP m g =

118− Parser (\s0 a0 c0 kf ks -> runParser m s0 a0 c0 kf (\s1 a1 c1 a -> runParser (g a) s1 a1 c1 kf ks))

128+ Parser (\st0 kf ks -> runParser m st0 kf (\s a -> runParser (g a) s kf ks))

119{-# INLINE bindP #-}

129{-# INLINE bindP #-}

120

130

121returnP :: a -> Parser a

131returnP :: a -> Parser a

122−returnP a = Parser (\s0 a0 c0 _kf ks -> ks s0 a0 c0 a)

132+returnP a = Parser (\st0 _kf ks -> ks st0 a)

123{-# INLINE returnP #-}

133{-# INLINE returnP #-}

124

134

125instance Monad Parser where

135instance Monad Parser where

@@ -127,10 +137,14 @@ instance Monad Parser where

127 (>>=) = bindP

137 (>>=) = bindP

128 fail = failDesc

138 fail = failDesc

129

139

140+noAdds :: S -> S

141+noAdds (S s0 _a0 c0) = S s0 B.empty c0

142+{-# INLINE noAdds #-}

143+

130plus :: Parser a -> Parser a -> Parser a

144plus :: Parser a -> Parser a -> Parser a

131−plus a b = Parser $ \s0 a0 c0 kf ks ->

145+plus a b = Parser $ \st0 kf ks ->

132− let kf' s1 a1 c1 _ _ = runParser b (s0 +++ a1) (a0 +++ a1) (mappend c0 c1) kf ks

146+ let kf' st1 _ _ = runParser b (mappend st0 st1) kf ks

133− in runParser a s0 B.empty c0 kf' ks

147+ in runParser a (noAdds st0) kf' ks

134{-# INLINE plus #-}

148{-# INLINE plus #-}

135

149

136instance MonadPlus Parser where

150instance MonadPlus Parser where

@@ -138,7 +152,7 @@ instance MonadPlus Parser where

138 mplus = plus

152 mplus = plus

139

153

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

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

141−fmapP p m = Parser (\s0 a0 c0 f k -> runParser m s0 a0 c0 f (\s1 a1 c1 a -> k s1 a1 c1 (p a)))

155+fmapP p m = Parser (\st0 f k -> runParser m st0 f (\s a -> k s (p a)))

142{-# INLINE fmapP #-}

156{-# INLINE fmapP #-}

143

157

144instance Functor Parser where

158instance Functor Parser where

@@ -160,30 +174,31 @@ instance Alternative Parser where

160 (<|>) = mplus

174 (<|>) = mplus

161

175

162failDesc :: String -> Parser a

176failDesc :: String -> Parser a

163−failDesc err = Parser (\s0 a0 c0 kf _ks -> kf s0 a0 c0 [] msg)

177+failDesc err = Parser (\st0 kf _ks -> kf st0 [] msg)

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

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

165{-# INLINE failDesc #-}

179{-# INLINE failDesc #-}

166

180

167ensure :: Int -> Parser ()

181ensure :: Int -> Parser ()

168−ensure n = Parser $ \s0 a0 c0 kf ks ->

182+ensure n = Parser $ \st0@(S s0 _a0 _c0) kf ks ->

169 if B.length s0 >= n

183 if B.length s0 >= n

170− then ks s0 a0 c0 ()

184+ then ks st0 ()

171− else runParser (requireInput >> ensure n) s0 a0 c0 kf ks

185+ else runParser (requireInput >> ensure n) st0 kf ks

172

186

173requireInput :: Parser ()

187requireInput :: Parser ()

174−requireInput = Parser $ \s0 a0 c0 kf ks ->

188+requireInput = Parser $ \st0@(S s0 a0 c0) kf ks ->

175 if c0 == Complete

189 if c0 == Complete

176− then kf s0 a0 c0 ["requireInput"] "not enough bytes"

190+ then kf st0 ["requireInput"] "not enough bytes"

177 else Partial $ \s ->

191 else Partial $ \s ->

178 if B.null s

192 if B.null s

179− then kf s0 a0 Complete ["requireInput"] "not enough bytes"

193+ then kf (S s0 a0 Complete) ["requireInput"] "not enough bytes"

180− else ks (s0 +++ s) (a0 +++ s) Incomplete ()

194+ else let st1 = S (s0 +++ s) (a0 +++ s) Incomplete

195+ in ks st1 ()

181

196

182get :: Parser B.ByteString

197get :: Parser B.ByteString

183−get = Parser $ \s0 a0 c0 _kf ks -> ks s0 a0 c0 s0

198+get = Parser (\st0 _kf ks -> ks st0 (input st0))

184

199

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

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

186−put s = Parser $ \_s0 a0 c0 _kf ks -> ks s a0 c0 ()

201+put s = Parser (\(S _s0 a0 c0) _kf ks -> ks (S s a0 c0) ())

187

202

188take :: Int -> Parser B.ByteString

203take :: Int -> Parser B.ByteString

189take n = takeWith n (const True)

204take n = takeWith n (const True)

@@ -193,9 +208,8 @@ take n = takeWith n (const True)

193{-# INLINE (+++) #-}

208{-# INLINE (+++) #-}

194

209

195try :: Parser a -> Parser a

210try :: Parser a -> Parser a

196−try p = Parser $ \s0 a0 c0 kf ks ->

211+try p = Parser $ \st0 kf ks ->

197− let kf' s1 a1 c1 = kf (s0 +++ a1) (a0 +++ a1) (mappend c0 c1)

198− in runParser p s0 B.empty c0 kf' ks

212+ runParser p (noAdds st0) (kf . mappend st0) ks

199

213

200satisfy :: (Word8 -> Bool) -> Parser Word8

214satisfy :: (Word8 -> Bool) -> Parser Word8

201satisfy p = do

215satisfy p = do

@@ -314,14 +328,14 @@ notWord8 c = satisfy (/= c) <?> "not " ++ show c

314{-# INLINE notWord8 #-}

328{-# INLINE notWord8 #-}

315

329

316endOfInput :: Parser ()

330endOfInput :: Parser ()

317−endOfInput = Parser $ \s0 a0 c0 kf ks ->

331+endOfInput = Parser $ \st0@S{..} kf ks ->

318− if B.null s0

332+ if B.null input

319− then if c0 == Complete

333+ then if more == Complete

320− then ks s0 a0 c0 ()

334+ then ks st0 ()

321− else let kf' s1 a1 c1 _ _ = ks (s0 +++ a1) (a0 +++ a1) (mappend c0 c1) ()

335+ else let kf' st1 _ _ = ks (mappend st0 st1) ()

322− ks' s1 a1 c1 _ = kf (s0 +++ a1) (a0 +++ a1) (mappend c0 c1) [] "endOfInput"

336+ ks' st1 _ = kf (mappend st0 st1) [] "endOfInput"

323− in runParser requireInput s0 a0 c0 kf' ks'

337+ in runParser requireInput st0 kf' ks'

324− else kf s0 a0 c0 [] "endOfInput"

338+ else kf st0 [] "endOfInput"

325

339

326endOfLine :: Parser ()

340endOfLine :: Parser ()

327endOfLine = (word8 10 >> return ()) <|> (string (B.pack "\r\n") >> return ())

341endOfLine = (word8 10 >> return ()) <|> (string (B.pack "\r\n") >> return ())

@@ -341,13 +355,13 @@ successK :: Success a a

341successK state a = Done state a

355successK state a = Done state a

342

356

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

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

344−parse m s = runParser m s B.empty Incomplete failK successK

358+parse m s = runParser m (S s B.empty Incomplete) failK successK

345{-# INLINE parse #-}

359{-# INLINE parse #-}

346

360

347feed :: Result r -> B.ByteString -> Result r

361feed :: Result r -> B.ByteString -> Result r

348−feed f@(Fail _ _ _ _ _) _ = f

362+feed f@(Fail _ _ _) _ = f

349feed (Partial k) d = k d

363feed (Partial k) d = k d

350−feed (Done s a c r) d = Done (s +++ d) a c r

364+feed (Done (S s a c) r) d = Done (S (s +++ d) a c) r

351

365

352parseAll :: Parser a -> [B.ByteString] -> Result a

366parseAll :: Parser a -> [B.ByteString] -> Result a

353parseAll p ss = case ss of

367parseAll p ss = case ss of