From 70121be1341e2f52b932644ca31752fdbd9dc85d Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Wed, 20 Dec 2006 15:50:51 +0000 Subject: [PATCH] 1.0.0.35: (belated addition of Gray streams examples file. Whoops). --- doc/manual/gray-streams-examples.texinfo | 238 ++++++++++++++++++++++++++++++ 1 file changed, 238 insertions(+) create mode 100644 doc/manual/gray-streams-examples.texinfo diff --git a/doc/manual/gray-streams-examples.texinfo b/doc/manual/gray-streams-examples.texinfo new file mode 100644 index 0000000..6868a66 --- /dev/null +++ b/doc/manual/gray-streams-examples.texinfo @@ -0,0 +1,238 @@ +@node Gray Streams examples +@subsection Gray Streams examples + +@macro codew{stuff} +@code{@w{\stuff\}} +@end macro + +Below are two classes of stream that can be conveniently defined as +wrappers for Common Lisp streams. These are meant to serve as +examples of minimal implementations of the protocols that must be +followed when defining Gray streams. Realistic uses of the Gray +Streams API would implement the various methods that can do I/O in +batches, such as @codew{stream-read-line}, @codew{stream-write-string}, +@codew{stream-read-sequence}, and @codew{stream-write-sequence}. + + +@menu +* Character counting input stream:: +* Output prefixing character stream:: +@end menu + +@node Character counting input stream +@subsubsection 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 @codew{stream-read-char} and +@codew{stream-unread-char}. + +@lisp +@group +(defclass wrapped-stream (fundamental-stream) + ((stream :initarg :stream :reader stream-of))) +@end group + +@group +(defmethod stream-element-type ((stream wrapped-stream)) + (stream-element-type (stream-of stream))) +@end group + +@group +(defmethod close ((stream wrapped-stream) &key abort) + (close (stream-of stream) :abort abort)) +@end group + +@group +(defclass wrapped-character-input-stream (wrapped-stream) + ()) +@end group + +@group +(defmethod stream-read-char ((stream wrapped-character-input-stream)) + (read-char (stream-of stream))) +@end group + +@group +(defmethod stream-unread-char ((stream wrapped-character-input-stream) + char) + (unread-char char (stream-of stream))) +@end group + +@group +(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))) +@end group + +@group +(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))))) +@end group + +@group +(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))) +@end group +@end lisp + +The default methods for @codew{stream-read-char-no-hang}, +@codew{stream-peek-char}, @codew{stream-listen}, +@codew{stream-clear-input}, @codew{stream-read-line}, and +@codew{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: + +@lisp +@group +(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)))) +@end group +@verbatim +1 +2 +3 +Non-number :FOO (line 2, column 5) + [Condition of type SIMPLE-ERROR] +@end verbatim +@end lisp + +@node Output prefixing character stream +@subsubsection Output prefixing character stream + +One use for a wrapped output stream might be to prefix each line of +text with a timestamp, e.g., for a logging stream. Here's a simple +stream that does this, though without any fancy line-wrapping. Note +that all character output stream classes must implement +@codew{stream-write-char} and @codew{stream-line-column}. + +@lisp +@group +(defclass wrapped-stream (fundamental-stream) + ((stream :initarg :stream :reader stream-of))) +@end group + +@group +(defmethod stream-element-type ((stream wrapped-stream)) + (stream-element-type (stream-of stream))) +@end group + +@group +(defmethod close ((stream wrapped-stream) &key abort) + (close (stream-of stream) :abort abort)) +@end group + +@group +(defclass wrapped-character-output-stream + (wrapped-stream fundamental-character-output-stream) + ((col-index :initform 0 :accessor col-index-of))) +@end group + +@group +(defmethod stream-line-column ((stream wrapped-character-output-stream)) + (col-index-of stream)) +@end group + +@group +(defmethod stream-write-char ((stream wrapped-character-output-stream) + char) + (with-accessors ((inner-stream stream-of) (cols col-index-of)) stream + (write-char char inner-stream) + (if (char= char #\Newline) + (setf cols 0) + (incf cols)))) +@end group + +@group +(defclass prefixed-character-output-stream + (wrapped-character-output-stream) + ((prefix :initarg :prefix :reader prefix-of))) +@end group + +@group +(defgeneric write-prefix (prefix stream) + (:method ((prefix string) stream) (write-string prefix stream)) + (:method ((prefix function) stream) (funcall prefix stream))) +@end group + +@group +(defmethod stream-write-char ((stream prefixed-character-output-stream) + char) + (with-accessors ((inner-stream stream-of) (cols col-index-of) + (prefix prefix-of)) stream + (when (zerop cols) + (write-prefix prefix inner-stream)) + (call-next-method))) +@end group +@end lisp + +As with the example input stream, this implements only the minimal +protocol. A production implementation should also provide methods for +at least @codew{stream-write-line}, @codew{stream-write-sequence}. + +And here's a sample use of this class: + +@lisp +@group +(flet ((format-timestamp (stream) + (apply #'format stream "[~2@@*~2,' D:~1@@*~2,'0D:~0@@*~2,'0D] " + (multiple-value-list (get-decoded-time))))) + (let ((output (make-instance 'prefixed-character-output-stream + :stream *standard-output* + :prefix #'format-timestamp))) + (loop for string in '("abc" "def" "ghi") do + (write-line string output) + (sleep 1)))) +@end group +@verbatim +[ 0:30:05] abc +[ 0:30:06] def +[ 0:30:07] ghi +NIL +@end verbatim +@end lisp +@unmacro codew -- 1.7.10.4