src/parser/scanner-charbuf.impl (charbuf-scanner-map): Return CONSUMEDP.

The docstring says that the function implements the parser protocol, but
it misses an important part of it out.  Fix this omission.

diff --git a/src/parser/scanner-charbuf-impl.lisp b/src/parser/scanner-charbuf-impl.lisp
index 8377a74..f9cd792 100644 (file)
--- a/src/parser/scanner-charbuf-impl.lisp
+++ b/src/parser/scanner-charbuf-impl.lisp
@@ -198,11 +198,12 @@
    and wishes to read more.  If DONEP is true then the condition (<= START
    USED END) must hold; the FUNC has consumed the buffer as far as USED
    (exclusive) and has completed successfully; the values DONEP and `t' are
-   returned as the result of `charbuf-scanner-map'.
+   returned as the result of `charbuf-scanner-map', along with a CONSUMEDP
+   flag.
 
    If end-of-file is encountered before FUNC completes successfully then FAIL
-   is called with no arguments, and `charbuf-scanner-map' returns whatever
-   FAIL returns.
+   is called with no arguments and expected to return two values, and
+   `charbuf-scanner-map' returns these values, along with a CONSUMEDP flag.
 
    Observe that, if FAIL returns a second value of nil, then
    `charbuf-scanner-map' is usable as a parser expression."))
@@ -210,40 +211,49 @@
 (defmethod charbuf-scanner-map
     ((scanner charbuf-scanner) func &optional fail)
   (with-slots (buf index size) scanner
-    (flet ((offer (buf start end)
-
-            ;; Pass the buffer to the function, and see what it thought.
-            (multiple-value-bind (donep used) (funcall func buf start end)
-
-              ;; Update the position as far as the function read.
-              (with-slots (line column) scanner
-                (let ((l line) (c column) (limit (if donep used end)))
-                  (do ((i start (1+ i)))
-                      ((>= i limit))
-                    (setf (values l c)
-                          (update-position (char buf i) l c)))
-                  (setf line l column c)))
-
-              ;; If the function is finished then update our state and
-              ;; return.
-              (when donep
-                (setf index used)
-                (when (>= index size)
-                  (charbuf-scanner-fetch scanner))
-                (return-from charbuf-scanner-map (values donep t))))))
-
-      ;; If there's anything in the current buffer, offer it to the function.
-      (when (< index size)
-       (offer buf index size))
-
-      ;; Repeatedly fetch new buffers and offer them to the function.
-      ;; Because the buffers are fresh, we know that we must process them
-      ;; from the beginning.  Note that `offer' will exit if FUNC has
-      ;; finished, so we don't need to worry about that.
-      (loop
-       (unless (charbuf-scanner-fetch scanner)
-         (return (if fail (funcall fail) (values nil nil))))
-       (offer buf 0 size)))))
+    (let ((consumedp nil))
+      (flet ((offer (buf start end)
+
+              ;; Pass the buffer to the function, and see what it thought.
+              (multiple-value-bind (donep used) (funcall func buf start end)
+
+                ;; Update the position as far as the function read.
+                (with-slots (line column) scanner
+                  (let ((l line) (c column) (limit (if donep used end)))
+                    (do ((i start (1+ i)))
+                        ((>= i limit))
+                      (setf (values l c)
+                            (update-position (char buf i) l c)))
+                    (setf line l column c)))
+
+                ;; If the function is finished then update our state and
+                ;; return.
+                (when donep
+                  (setf index used)
+                  (when (>= index size)
+                    (charbuf-scanner-fetch scanner))
+                  (return-from charbuf-scanner-map
+                    (values donep t (or consumedp (> used start)))))
+
+                ;; We've definitely used that buffer.
+                (setf consumedp t))))
+
+       ;; If there's anything in the current buffer, offer it to the
+       ;; function.
+       (when (< index size)
+         (offer buf index size))
+
+       ;; Repeatedly fetch new buffers and offer them to the function.
+       ;; Because the buffers are fresh, we know that we must process them
+       ;; from the beginning.  Note that `offer' will exit if FUNC has
+       ;; finished, so we don't need to worry about that.
+       (loop
+         (unless (charbuf-scanner-fetch scanner)
+           (return (if fail
+                       (multiple-value-bind (result win) (funcall fail)
+                         (values result win consumedp))
+                       (values nil nil consumedp))))
+         (offer buf 0 size))))))
 
 ;;;--------------------------------------------------------------------------
 ;;; Initialization.
@@ -434,9 +444,9 @@
               (let ((pos (position #\newline buf :start start :end end)))
                 (push (make-charbuf-slice buf start (or pos end)) slices)
                 (values pos (and pos (1+ pos))))))
-       (multiple-value-bind (result eofp)
+       (multiple-value-bind (result eofp consumedp)
            (charbuf-scanner-map scanner #'snarf)
-         (declare (ignore result))
+         (declare (ignore result consumedp))
          (values (concatenate-charbuf-slices (nreverse slices))) eofp)))))
 
 ;;;----- That's all, folks --------------------------------------------------