Character counting input stream - SBCL 1.0.31 User Manual
Description: SBCL 1.0.31 User Manual

Next: Output prefixing character stream, Up: Gray Streams examples

##### 10.2.8.1 Character counting input stream

It is occasionally handy for programs that process input files to count the number of characters and lines seen so far, and the number of characters seen on the current line, so that useful messages may be reported in case of parsing errors, etc. Here is a character input stream class that keeps track of these counts. Note that all character input streams must implement `stream-read-char` and `stream-unread-char`.

         (defclass wrapped-stream (fundamental-stream)
           ((stream :initarg :stream :reader stream-of)))

         (defmethod stream-element-type ((stream wrapped-stream))
           (stream-element-type (stream-of stream)))

         (defmethod close ((stream wrapped-stream) &key abort)
           (close (stream-of stream) :abort abort))

         (defclass wrapped-character-input-stream
             (wrapped-stream fundamental-character-input-stream)
           ())

         (defmethod stream-read-char ((stream wrapped-character-input-stream))
           (read-char (stream-of stream) nil :eof))

         (defmethod stream-unread-char ((stream wrapped-character-input-stream)
                                        char)
           (unread-char char (stream-of stream)))

         (defclass counting-character-input-stream
             (wrapped-character-input-stream)
           ((char-count :initform 1 :accessor char-count-of)
            (line-count :initform 1 :accessor line-count-of)
            (col-count :initform 1 :accessor col-count-of)
            (prev-col-count :initform 1 :accessor prev-col-count-of)))

         (defmethod stream-read-char ((stream counting-character-input-stream))
           (with-accessors ((inner-stream stream-of) (chars char-count-of)
                            (lines line-count-of) (cols col-count-of)
                            (prev prev-col-count-of)) stream
               (let ((char (call-next-method)))
                 (cond ((eql char :eof)
                        :eof)
                       ((char= char #\Newline)
                        (incf lines)
                        (incf chars)
                        (setf prev cols)
                        (setf cols 1)
                        char)
                       (t
                        (incf chars)
                        (incf cols)
                        char)))))

         (defmethod stream-unread-char ((stream counting-character-input-stream)
                                        char)
           (with-accessors ((inner-stream stream-of) (chars char-count-of)
                            (lines line-count-of) (cols col-count-of)
                            (prev prev-col-count-of)) stream
               (cond ((char= char #\Newline)
                      (decf lines)
                      (decf chars)
                      (setf cols prev))
                     (t
                      (decf chars)
                      (decf cols)
                      char))
               (call-next-method)))

The default methods for `stream-read-char-no-hang`, `stream-peek-char`, `stream-listen`, `stream-clear-input`, `stream-read-line`, and `stream-read-sequence` should be sufficient (though the last two will probably be slower than methods that forwarded directly).

Here's a sample use of this class:

         (with-input-from-string (input "1 2
          3 :foo  ")
           (let ((counted-stream (make-instance 'counting-character-input-stream
                                  :stream input)))
             (loop for thing = (read counted-stream) while thing
                unless (numberp thing) do
                  (error "Non-number ~S (line ~D, column ~D)" thing
                         (line-count-of counted-stream)
                         (- (col-count-of counted-stream)
                            (length (format nil "~S" thing))))
                end
                do (print thing))))

         1
         2
         3
         Non-number :FOO (line 2, column 5)
           [Condition of type SIMPLE-ERROR]