X-Git-Url: https://git.distorted.org.uk/~mdw/sod/blobdiff_plain/3dca7758421664a838c54b273bd9221f02072045..refs/heads/master:/src/parser/scanner-charbuf-impl.lisp

diff --git a/src/parser/scanner-charbuf-impl.lisp b/src/parser/scanner-charbuf-impl.lisp
index 1919b69..43d1f9f 100644
--- a/src/parser/scanner-charbuf-impl.lisp
+++ b/src/parser/scanner-charbuf-impl.lisp
@@ -7,7 +7,7 @@
 
 ;;;----- Licensing notice ---------------------------------------------------
 ;;;
-;;; This file is part of the Sensble Object Design, an object system for C.
+;;; This file is part of the Sensible Object Design, an object system for C.
 ;;;
 ;;; SOD is free software; you can redistribute it and/or modify
 ;;; it under the terms of the GNU General Public License as published by
@@ -67,8 +67,8 @@
 (defclass charbuf-scanner (character-scanner)
   ((%stream :initarg :stream :type stream)
    (buf :initform nil :type (or charbuf (member nil :eof)))
-   (size :initform 0 :type (integer 0 #.charbuf-size))
-   (index :initform 0 :type (integer 0 #.charbuf-size))
+   (size :initform 0 :type charbuf-index)
+   (index :initform 0 :type charbuf-index)
    (captures :initform 0 :type (and fixnum unsigned-byte))
    (tail :initform nil :type (or charbuf-chain-link null))
    (unread :initform nil :type (or charbuf-chain-link nil))
@@ -107,10 +107,10 @@
 
    Which leaves us with the need to determine whether there are outstanding
    captures.  We simply maintain a counter, and rely on the client releasing
-   captured places properly when he's finished.  In practice, this is usually
-   done using the `peek' parser macro so there isn't a problem."))
+   captured places properly when they've finished.  In practice, this is
+   usually done using the `peek' parser macro so there isn't a problem."))
 
-(export 'charbuf-scanner-place-p)
+(export '(charbuf-scanner-place charbuf-scanner-place-p))
 (defstruct charbuf-scanner-place
   "A captured place we can return to later.
 
@@ -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.
@@ -344,8 +354,9 @@
 
 (defstruct (charbuf-slice
 	     (:constructor make-charbuf-slice
-			   (buf &optional (start 0) %end
-			    &aux (end (or %end (length buf))))))
+		 (buf
+		  &optional (start 0) %end
+		  &aux (end (or %end (length buf))))))
   (buf nil :type (or charbuf (eql :eof)) :read-only t)
   (start 0 :type (and fixnum unsigned-byte) :read-only t)
   (end 0 :type (and fixnum unsigned-byte) :read-only t))
@@ -379,7 +390,7 @@
 						    :index index))))
 	 (last-link (charbuf-scanner-place-link place-b)))
     (flet ((bad ()
-	     (error "Incorrect places ~S and ~S to `scanner-interval'."
+	     (error "Incorrect places ~S and ~S to `scanner-interval'"
 		    place-a place-b)))
       (do ((link (charbuf-scanner-place-link place-a)
 		 (charbuf-chain-link-next link))
@@ -415,10 +426,7 @@
     (unless end (setf end (length seq)))
     (let ((i start) (n (- end start)))
       (labels ((copy (i buf start end)
-		 (do ((j i (1+ j))
-		      (k start (1+ k)))
-		     ((>= k end))
-		   (setf (char seq j) (schar buf k))))
+		 (replace seq buf :start1 i :start2 start :end2 end))
 	       (snarf (buf start end)
 		 (let ((m (- end start)))
 		   (cond ((< m n)
@@ -436,12 +444,10 @@
       (flet ((snarf (buf start end)
 	       (let ((pos (position #\newline buf :start start :end end)))
 		 (push (make-charbuf-slice buf start (or pos end)) slices)
-		 (if pos
-		     (values (concatenate-charbuf-slices (nreverse slices))
-			     (1+ pos))
-		     (values nil 0))))
-	     (fail ()
-	       (values (concatenate-charbuf-slices (nreverse slices)) t)))
-	(charbuf-scanner-map scanner #'snarf #'fail)))))
+		 (values pos (and pos (1+ pos))))))
+	(multiple-value-bind (result eofp consumedp)
+	    (charbuf-scanner-map scanner #'snarf)
+	  (declare (ignore result consumedp))
+	  (values (concatenate-charbuf-slices (nreverse slices))) eofp)))))
 
 ;;;----- That's all, folks --------------------------------------------------