X-Git-Url: https://git.distorted.org.uk/~mdw/sod/blobdiff_plain/502df9a219a1a8b94eca0038b1e7203b91f11a30..6e5e19055a818fecda4d20672be221d43e627b3a:/src/parser/scanner-charbuf-impl.lisp diff --git a/src/parser/scanner-charbuf-impl.lisp b/src/parser/scanner-charbuf-impl.lisp index 65f6e1e..f9cd792 100644 --- a/src/parser/scanner-charbuf-impl.lisp +++ b/src/parser/scanner-charbuf-impl.lisp @@ -65,7 +65,7 @@ (export 'charbuf-scanner) (defclass charbuf-scanner (character-scanner) - ((stream :initarg :stream :type stream) + ((%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)) @@ -143,7 +143,7 @@ (if we're currently rewound) or with a new buffer from the stream.")) (defmethod charbuf-scanner-fetch ((scanner charbuf-scanner)) - (with-slots (stream buf size index tail captures) scanner + (with-slots ((stream %stream) buf size index tail captures) scanner (loop (acond @@ -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. @@ -254,7 +264,7 @@ ;; Grab the filename from the underlying stream if we don't have a better ;; guess. (default-slot (scanner 'filename slot-names) - (with-slots (stream) scanner + (with-slots ((stream %stream)) scanner (aif (stream-pathname stream) (namestring it) nil))) ;; Get ready with the first character. @@ -415,10 +425,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 +443,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 --------------------------------------------------