Bryan O'Sullivan committed 1ed270b

Fix a bug in wantInput reported by Gregory Collins.

The following parser should go into an infinite loop:

parse (many (A.takeWhile isSpace)) "" `feed` ""

Gregory noticed that it was always returning a Partial result. The root
cause lay in wantInput not correctly setting the completion status of its
input to Complete.

I moved the common Partial-returning code into a function named prompt
(apparently this is what folks in the world of delimited continuations call
that function).

Happily, the code motion sped up examples/TestRFC2616.hs by almost 10%!

Comments (0)

Files changed (1)


     then ks st0 ()
     else runParser (demandInput >> ensure n) st0 kf ks
+-- | Ask for input.  If we receive any, pass it to a success
+-- continuation, otherwise to a failure continuation.
+prompt :: S -> (S -> Result r) -> (S -> Result r) -> Result r
+prompt (S s0 a0 _c0) kf ks = Partial $ \s ->
+    if B.null s
+    then kf $! S s0 a0 Complete
+    else ks $! S (s0 +++ s) (a0 +++ s) Incomplete
 -- | Immediately demand more input via a 'Partial' continuation
 -- result.
 demandInput :: Parser ()
-demandInput = Parser $ \st0@(S s0 a0 c0) kf ks ->
-    if c0 == Complete
+demandInput = Parser $ \st0 kf ks ->
+    if more st0 == Complete
     then kf st0 ["demandInput"] "not enough bytes"
-    else Partial $ \s ->
-         if B.null s
-         then kf (S s0 a0 Complete) ["demandInput"] "not enough bytes"
-         else let st1 = S (s0 +++ s) (a0 +++ s) Incomplete
-              in  ks st1 ()
+    else prompt st0 (\st -> kf st ["demandInput"] "not enough bytes") (`ks` ())
 -- | This parser always succeeds.  It returns 'True' if any input is
 -- available either immediately or on demand, and 'False' if the end
 -- of all input has been reached.
 wantInput :: Parser Bool
-wantInput = Parser $ \st0@(S s0 a0 c0) _kf ks ->
-  case undefined of
+wantInput = Parser $ \st0@(S s0 _a0 c0) _kf ks ->
+  case () of
     _ | not (B.null s0) -> ks st0 True
       | c0 == Complete  -> ks st0 False
-      | otherwise       -> Partial $ \s ->
-                           if B.null s
-                           then ks st0 False
-                           else let st1 = S (s0 +++ s) (a0 +++ s) Incomplete
-                                in  ks st1 True
+      | otherwise       -> prompt st0 (`ks` False) (`ks` True)
 get :: Parser B.ByteString
 get  = Parser (\st0 _kf ks -> ks st0 (input st0))
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.