Don't hardcode the number of gencgc generations.
[sbcl.git] / doc / manual / gray-streams-examples.texinfo
1 @node Gray Streams examples
2 @subsection Gray Streams examples
3
4 @macro codew{stuff}
5 @code{@w{\stuff\}}
6 @end macro
7
8 Below are two classes of stream that can be conveniently defined as
9 wrappers for Common Lisp streams.  These are meant to serve as
10 examples of minimal implementations of the protocols that must be
11 followed when defining Gray streams.  Realistic uses of the Gray
12 Streams API would implement the various methods that can do I/O in
13 batches, such as @codew{stream-read-line}, @codew{stream-write-string},
14 @codew{stream-read-sequence}, and @codew{stream-write-sequence}.
15
16
17 @menu
18 * Character counting input stream::
19 * Output prefixing character stream::
20 @end menu
21
22 @node Character counting input stream
23 @subsubsection  Character counting input stream
24
25 It is occasionally handy for programs that process input files to
26 count the number of characters and lines seen so far, and the number
27 of characters seen on the current line, so that useful messages may be
28 reported in case of parsing errors, etc.  Here is a character input
29 stream class that keeps track of these counts.  Note that all
30 character input streams must implement @codew{stream-read-char} and
31 @codew{stream-unread-char}.
32
33 @lisp
34 @group
35 (defclass wrapped-stream (fundamental-stream)
36   ((stream :initarg :stream :reader stream-of)))
37 @end group
38
39 @group
40 (defmethod stream-element-type ((stream wrapped-stream))
41   (stream-element-type (stream-of stream)))
42 @end group
43
44 @group
45 (defmethod close ((stream wrapped-stream) &key abort)
46   (close (stream-of stream) :abort abort))
47 @end group
48
49 @group
50 (defclass wrapped-character-input-stream
51     (wrapped-stream fundamental-character-input-stream)
52   ())
53 @end group
54
55 @group
56 (defmethod stream-read-char ((stream wrapped-character-input-stream))
57   (read-char (stream-of stream) nil :eof))
58 @end group
59
60 @group
61 (defmethod stream-unread-char ((stream wrapped-character-input-stream)
62                                char)
63   (unread-char char (stream-of stream)))
64 @end group
65
66 @group
67 (defclass counting-character-input-stream
68     (wrapped-character-input-stream)
69   ((char-count :initform 1 :accessor char-count-of)
70    (line-count :initform 1 :accessor line-count-of)
71    (col-count :initform 1 :accessor col-count-of)
72    (prev-col-count :initform 1 :accessor prev-col-count-of)))
73 @end group
74
75 @group
76 (defmethod stream-read-char ((stream counting-character-input-stream))
77   (with-accessors ((inner-stream stream-of) (chars char-count-of)
78                    (lines line-count-of) (cols col-count-of)
79                    (prev prev-col-count-of)) stream
80       (let ((char (call-next-method)))
81         (cond ((eql char :eof)
82                :eof)
83               ((char= char #\Newline)
84                (incf lines)
85                (incf chars)
86                (setf prev cols)
87                (setf cols 1)
88                char)
89               (t
90                (incf chars)
91                (incf cols)
92                char)))))
93 @end group
94
95 @group
96 (defmethod stream-unread-char ((stream counting-character-input-stream)
97                                char)
98   (with-accessors ((inner-stream stream-of) (chars char-count-of)
99                    (lines line-count-of) (cols col-count-of)
100                    (prev prev-col-count-of)) stream
101       (cond ((char= char #\Newline)
102              (decf lines)
103              (decf chars)
104              (setf cols prev))
105             (t
106              (decf chars)
107              (decf cols)
108              char))
109       (call-next-method)))
110 @end group
111 @end lisp
112
113 The default methods for @codew{stream-read-char-no-hang},
114 @codew{stream-peek-char}, @codew{stream-listen},
115 @codew{stream-clear-input}, @codew{stream-read-line}, and
116 @codew{stream-read-sequence} should be sufficient (though the last two
117 will probably be slower than methods that forwarded directly).
118
119 Here's a sample use of this class:
120
121 @lisp
122 @group
123 (with-input-from-string (input "1 2
124  3 :foo  ")
125   (let ((counted-stream (make-instance 'counting-character-input-stream
126                          :stream input)))
127     (loop for thing = (read counted-stream) while thing
128        unless (numberp thing) do
129          (error "Non-number ~S (line ~D, column ~D)" thing
130                 (line-count-of counted-stream)
131                 (- (col-count-of counted-stream) 
132                    (length (format nil "~S" thing))))
133        end
134        do (print thing))))
135 @end group
136 @verbatim
137
138
139 3
140 Non-number :FOO (line 2, column 5)
141   [Condition of type SIMPLE-ERROR]
142 @end verbatim
143 @end lisp
144
145 @node Output prefixing character stream
146 @subsubsection Output prefixing character stream
147
148 One use for a wrapped output stream might be to prefix each line of
149 text with a timestamp, e.g., for a logging stream.  Here's a simple
150 stream that does this, though without any fancy line-wrapping.  Note
151 that all character output stream classes must implement
152 @codew{stream-write-char} and @codew{stream-line-column}.
153
154 @lisp
155 @group
156 (defclass wrapped-stream (fundamental-stream)
157   ((stream :initarg :stream :reader stream-of)))
158 @end group
159
160 @group
161 (defmethod stream-element-type ((stream wrapped-stream))
162   (stream-element-type (stream-of stream)))
163 @end group
164
165 @group
166 (defmethod close ((stream wrapped-stream) &key abort)
167   (close (stream-of stream) :abort abort))
168 @end group
169
170 @group
171 (defclass wrapped-character-output-stream
172     (wrapped-stream fundamental-character-output-stream)
173   ((col-index :initform 0 :accessor col-index-of)))
174 @end group
175
176 @group
177 (defmethod stream-line-column ((stream wrapped-character-output-stream))
178   (col-index-of stream))
179 @end group
180
181 @group
182 (defmethod stream-write-char ((stream wrapped-character-output-stream)
183                               char)
184   (with-accessors ((inner-stream stream-of) (cols col-index-of)) stream
185     (write-char char inner-stream)
186     (if (char= char #\Newline)
187         (setf cols 0)
188         (incf cols))))
189 @end group
190
191 @group
192 (defclass prefixed-character-output-stream
193     (wrapped-character-output-stream)
194   ((prefix :initarg :prefix :reader prefix-of)))
195 @end group
196
197 @group
198 (defgeneric write-prefix (prefix stream)
199   (:method ((prefix string) stream) (write-string prefix stream))
200   (:method ((prefix function) stream) (funcall prefix stream)))
201 @end group
202
203 @group
204 (defmethod stream-write-char ((stream prefixed-character-output-stream)
205                               char)
206   (with-accessors ((inner-stream stream-of) (cols col-index-of)
207                    (prefix prefix-of)) stream
208     (when (zerop cols)
209       (write-prefix prefix inner-stream))
210     (call-next-method)))
211 @end group
212 @end lisp
213
214 As with the example input stream, this implements only the minimal
215 protocol.  A production implementation should also provide methods for
216 at least @codew{stream-write-line}, @codew{stream-write-sequence}.
217
218 And here's a sample use of this class:
219
220 @lisp
221 @group
222 (flet ((format-timestamp (stream)
223          (apply #'format stream "[~2@@*~2,' D:~1@@*~2,'0D:~0@@*~2,'0D] "
224                 (multiple-value-list (get-decoded-time)))))
225   (let ((output (make-instance 'prefixed-character-output-stream
226                                :stream *standard-output*
227                                :prefix #'format-timestamp)))
228     (loop for string in '("abc" "def" "ghi") do
229          (write-line string output)
230          (sleep 1))))
231 @end group
232 @verbatim
233 [ 0:30:05] abc
234 [ 0:30:06] def
235 [ 0:30:07] ghi
236 NIL
237 @end verbatim
238 @end lisp
239 @unmacro codew