4e78b3c · typeable/attoparsec

git.iko.soy/typeable/attoparsec

on master help sign in

Tweaklet

4e78b3cBryan O'Sullivan18 years ago

src/Data/ParserCombinators/Attoparsec/Incremental.hs+35−23

compare with master

unifiedsplit

@@ -21,6 +21,7 @@ module Data.ParserCombinators.Attoparsec.Incremental

21 Parser

22 , Result(..)

23 , parse

24+ , parseWith

25 , (<?>)

26 , (<?>)

26 , takeWhile

27 , takeWhile

@@ -57,7 +58,7 @@ import Prelude hiding (takeWhile)

58data S = S {-# UNPACK #-} !S.ByteString -- ^ first chunk of input

59data S = S {-# UNPACK #-} !S.ByteString -- ^ first chunk of input

59 L.ByteString -- ^ rest of input

60 L.ByteString -- ^ rest of input

60− [S.ByteString] -- ^ input acquired during backtracks

61+ [L.ByteString] -- ^ input acquired during backtracks

61 {-# UNPACK #-} !Int -- ^ failure depth

62 {-# UNPACK #-} !Int -- ^ failure depth

63-- | The result of a partial parse

64-- | The result of a partial parse

@@ -66,7 +67,7 @@ data Result a = Failed String

66 | Done L.ByteString a

67 | Done L.ByteString a

67 -- ^ the parse finished and produced the given list of

68 -- ^ the parse finished and produced the given list of

68 -- results doing so. Any unparsed data is returned.

69 -- results doing so. Any unparsed data is returned.

69− | Partial (S.ByteString -> Result a)

70+ | Partial (L.ByteString -> Result a)

70 -- ^ the parse ran out of data before finishing, but produced

71 -- ^ the parse ran out of data before finishing, but produced

71 -- the given list of results before doing so. To continue the

72 -- the given list of results before doing so. To continue the

72 -- parse pass more data to the given continuation

73 -- parse pass more data to the given continuation

@@ -82,7 +83,7 @@ instance (Show a) => Show (Result a) where

82-- type just before giving it to the outside world.

83-- type just before giving it to the outside world.

83data IResult a = IFailed S String

84data IResult a = IFailed S String

84 | IDone S a

85 | IDone S a

85− | IPartial (S.ByteString -> IResult a)

86+ | IPartial (L.ByteString -> IResult a)

87instance Show (IResult a) where

88instance Show (IResult a) where

88 show (IFailed _ err) = "IFailed " ++ err

89 show (IFailed _ err) = "IFailed " ++ err

@@ -128,7 +129,7 @@ plus p1 p2 =

128 let

129 let

129 filt f@(IFailed (S _ _ adds' failDepth') _)

130 filt f@(IFailed (S _ _ adds' failDepth') _)

130 | failDepth' == failDepth + 1 =

131 | failDepth' == failDepth + 1 =

131− let lb' = lb `appL` L.fromChunks (reverse adds')

132+ let lb' = lb `appL` L.concat (reverse adds')

132 in unParser p2 (S sb lb' (adds' ++ adds) failDepth) k

133 in unParser p2 (S sb lb' (adds' ++ adds) failDepth) k

133 | otherwise = f

134 | otherwise = f

134 filt (IPartial cont) = IPartial (filt . cont)

135 filt (IPartial cont) = IPartial (filt . cont)

@@ -150,26 +151,23 @@ p <?> msg =

150 IFailed st' _ -> IFailed st' msg

151 IFailed st' _ -> IFailed st' msg

151 ok -> ok

152 ok -> ok

152

153

153−initState :: S.ByteString -> S

154+initState :: L.ByteString -> S

154−initState input = S input L.empty [] 0

155+initState (L.Chunk sb lb) = S sb lb [] 0

156+initState _ = S S.empty L.empty [] 0

155

157

156−mkState :: L.ByteString -> [S.ByteString] -> Int -> S

158+mkState :: L.ByteString -> [L.ByteString] -> Int -> S

157mkState bs adds failDepth =

159mkState bs adds failDepth =

158 case bs of

160 case bs of

159 L.Empty -> S S.empty L.empty adds failDepth

161 L.Empty -> S S.empty L.empty adds failDepth

160 L.Chunk sb lb -> S sb lb adds failDepth

162 L.Chunk sb lb -> S sb lb adds failDepth

161

163

162−toLazy :: S.ByteString -> L.ByteString

163−toLazy s | S.null s = L.Empty

164− | otherwise = L.Chunk s L.Empty

165−

166−addX :: S.ByteString -> [S.ByteString] -> [S.ByteString]

164+addX :: L.ByteString -> [L.ByteString] -> [L.ByteString]

167−addX s adds | S.null s = adds

165+addX s adds | L.null s = adds

168 | otherwise = s : adds

166 | otherwise = s : adds

169

167

170yield :: Parser r ()

168yield :: Parser r ()

171yield = Parser $ \(S sb lb adds failDepth) k ->

169yield = Parser $ \(S sb lb adds failDepth) k ->

172− IPartial $ \s -> k () (S sb (lb `appL` toLazy s) (addX s adds) failDepth)

170+ IPartial $ \s -> k () (S sb (lb `appL` s) (addX s adds) failDepth)

173

171

174takeWith :: (L.ByteString -> (L.ByteString, L.ByteString))

172takeWith :: (L.ByteString -> (L.ByteString, L.ByteString))

175 -> Parser r L.ByteString

173 -> Parser r L.ByteString

@@ -178,7 +176,7 @@ takeWith splitf =

178 let (left,rest) = splitf (sb +: lb)

176 let (left,rest) = splitf (sb +: lb)

179 in case rest of

177 in case rest of

180 L.Empty -> IPartial $ \s ->

178 L.Empty -> IPartial $ \s ->

181− let s' = S s L.empty (addX s adds) failDepth

179+ let s' = mkState s (addX s adds) failDepth

182 k' a = k (appL left a)

180 k' a = k (appL left a)

183 in unParser (takeWith splitf) s' k'

181 in unParser (takeWith splitf) s' k'

184 L.Chunk h t -> k left (S h t adds failDepth)

182 L.Chunk h t -> k left (S h t adds failDepth)

@@ -197,7 +195,7 @@ takeCount = tc . fromIntegral where

197 in if L.length h == n

195 in if L.length h == n

198 then k h (mkState t adds failDepth)

196 then k h (mkState t adds failDepth)

199 else IPartial $ \s ->

197 else IPartial $ \s ->

200− let st = S s L.empty (addX s adds) failDepth

198+ let st = mkState s (addX s adds) failDepth

201 k' a = k (appL h a)

199 k' a = k (appL h a)

202 in unParser (tc (n - l)) st k'

200 in unParser (tc (n - l)) st k'

203

201

@@ -210,21 +208,28 @@ string s =

210 (h,L.Empty)

208 (h,L.Empty)

211 | h `L.isPrefixOf` s ->

209 | h `L.isPrefixOf` s ->

212 IPartial $ \s' ->

210 IPartial $ \s' ->

213− let st' = S s' L.empty (addX s' adds) failDepth

211+ let st' = mkState s' (addX s' adds) failDepth

214 k' a = k (appL h a)

212 k' a = k (appL h a)

215 r' = L.drop (L.length h) s

213 r' = L.drop (L.length h) s

216 in unParser (string r') st' k'

214 in unParser (string r') st' k'

217 _ -> IFailed st "string failed to match"

215 _ -> IFailed st "string failed to match"

218

216

217+emptyState = S S.empty L.empty

218+

219satisfy :: (Word8 -> Bool) -> Parser r Word8

220satisfy p =

221 Parser $ \st@(S sb lb adds failDepth) k ->

222− case L.uncons (sb +: lb) of

222+ case S.uncons sb of

223− Just (w, lb') | p w -> k w (mkState lb' adds failDepth)

223+ Just (w, sb') | p w -> k w (S sb' lb adds failDepth)

224 | otherwise -> IFailed st "failed to match"

225+ Nothing -> case L.uncons lb of

226+ Just (w, lb') | p w -> k w (mkState lb' adds failDepth)

227+ | otherwise -> IFailed st "failed to match"

225− Nothing -> IPartial $ \s ->

228+ Nothing -> IPartial $ \s ->

226− let st' = S s L.empty (addX s adds) failDepth

229+ let st' = emptyState adds failDepth

230+ in if L.null s

231+ then IFailed st "barf"

227− in unParser (satisfy p) st' k

232+ else unParser (satisfy p) st' k

228

233

229pushBack :: L.ByteString -> Parser r ()

234pushBack :: L.ByteString -> Parser r ()

230pushBack bs =

235pushBack bs =

@@ -239,9 +244,16 @@ toplevelTranslate (IPartial k) = Partial $ toplevelTranslate . k

239terminalContinuation :: a -> S -> IResult a

244terminalContinuation :: a -> S -> IResult a

240terminalContinuation v s = IDone s v

245terminalContinuation v s = IDone s v

241

246

242−parse :: Parser r r -> S.ByteString -> Result r

247+parse :: Parser r r -> L.ByteString -> Result r

243parse m input =

248parse m input =

244 toplevelTranslate $ unParser m (initState input) terminalContinuation

249 toplevelTranslate $ unParser m (initState input) terminalContinuation

245

250

251+parseWith :: Applicative f => f L.ByteString -> Parser r r -> L.ByteString

252+ -> f (Result r)

253+parseWith refill p s =

254+ case parse p s of

255+ Partial k -> k <$> refill

256+ ok -> pure ok

257+

246#define PARSER Parser r

258#define PARSER Parser r

247#include "Word8Boilerplate.h"

259#include "Word8Boilerplate.h"