;;;----- 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
(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))
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."))
(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.
(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))
: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))
(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)
(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 --------------------------------------------------
~mdw / sod / blobdiff