0.9.7.25:
[sbcl.git] / src / pcl / gray-streams.lisp
1 ;;;; Gray streams implementation for SBCL, based on the Gray streams
2 ;;;; implementation for CMU CL, based on the stream-definition-by-user
3 ;;;; proposal by David N. Gray.
4
5 ;;;; This software is part of the SBCL system. See the README file for
6 ;;;; more information.
7
8 ;;;; This software is in the public domain and is provided with
9 ;;;; absolutely no warranty. See the COPYING and CREDITS files for
10 ;;;; more information.
11
12 (in-package "SB-GRAY")
13
14 ;;; BUG-OR-ERROR: because we have extensible streams, wherewith the
15 ;;; user is responsible for some of the protocol implementation, it's
16 ;;; not necessarily a bug in SBCL itself if we fall through to one of
17 ;;; these default methods.
18 ;;;
19 ;;; FIXME: there's a lot of similarity in these Gray stream
20 ;;; implementation generic functions.  All of them could (maybe
21 ;;; should?) have two default methods: one on STREAM calling
22 ;;; BUG-OR-ERROR, and one on T signalling a TYPE-ERROR.
23 (defmacro bug-or-error (stream fun)
24   `(error
25     "~@<The stream ~S has no suitable method for ~S, ~
26      and so has fallen through to this method.  If you think that this is ~
27      a bug, please report it to the applicable authority (bugs in SBCL itself ~
28      should go to the mailing lists referenced from ~
29      <http://www.sbcl.org/>).~@:>"
30     ,stream ,fun))
31 \f
32 (fmakunbound 'stream-element-type)
33
34 (defgeneric stream-element-type (stream)
35   #+sb-doc
36   (:documentation
37    "Return a type specifier for the kind of object returned by the
38   STREAM. The class FUNDAMENTAL-CHARACTER-STREAM provides a default method
39   which returns CHARACTER."))
40
41 (defmethod stream-element-type ((stream ansi-stream))
42   (ansi-stream-element-type stream))
43
44 (defmethod stream-element-type ((stream fundamental-character-stream))
45   'character)
46
47 (defmethod stream-element-type ((stream stream))
48   (bug-or-error stream 'stream-element-type))
49
50 (defmethod stream-element-type ((non-stream t))
51   (error 'type-error :datum non-stream :expected-type 'stream))
52 \f
53 (defgeneric pcl-open-stream-p (stream)
54   #+sb-doc
55   (:documentation
56    "Return true if STREAM is not closed. A default method is provided
57   by class FUNDAMENTAL-STREAM which returns true if CLOSE has not been
58   called on the stream."))
59
60 (defmethod pcl-open-stream-p ((stream ansi-stream))
61   (ansi-stream-open-stream-p stream))
62
63 (defmethod pcl-open-stream-p ((stream fundamental-stream))
64   (stream-open-p stream))
65
66 (defmethod pcl-open-stream-p ((stream stream))
67   (bug-or-error stream 'open-stream-p))
68
69 (defmethod pcl-open-stream-p ((non-stream t))
70   (error 'type-error :datum non-stream :expected-type 'stream))
71
72 ;;; bootstrapping hack
73 (pcl-open-stream-p (make-string-output-stream))
74 (setf (fdefinition 'open-stream-p) #'pcl-open-stream-p)
75 \f
76 (defgeneric pcl-close (stream &key abort)
77   #+sb-doc
78   (:documentation
79    "Close the given STREAM. No more I/O may be performed, but
80   inquiries may still be made. If :ABORT is true, an attempt is made
81   to clean up the side effects of having created the stream."))
82
83 (defmethod pcl-close ((stream ansi-stream) &key abort)
84   (ansi-stream-close stream abort))
85
86 (defmethod pcl-close ((stream fundamental-stream) &key abort)
87   (declare (ignore abort))
88   (setf (stream-open-p stream) nil)
89   t)
90
91 (setf (fdefinition 'close) #'pcl-close)
92 \f
93 (let ()
94   (fmakunbound 'input-stream-p)
95
96   (defgeneric input-stream-p (stream)
97     #+sb-doc
98     (:documentation "Can STREAM perform input operations?"))
99
100   (defmethod input-stream-p ((stream ansi-stream))
101     (ansi-stream-input-stream-p stream))
102
103   (defmethod input-stream-p ((stream fundamental-stream))
104     nil)
105
106   (defmethod input-stream-p ((stream fundamental-input-stream))
107     t)
108
109   (defmethod input-stream-p ((stream stream))
110     (bug-or-error stream 'input-stream-p))
111
112   (defmethod input-stream-p ((non-stream t))
113     (error 'type-error :datum non-stream :expected-type 'stream)))
114 \f
115 (let ()
116   (fmakunbound 'interactive-stream-p)
117
118   (defgeneric interactive-stream-p (stream)
119     #+sb-doc
120     (:documentation "Is STREAM an interactive stream?"))
121
122   (defmethod interactive-stream-p ((stream ansi-stream))
123     (funcall (ansi-stream-misc stream) stream :interactive-p))
124
125   (defmethod interactive-stream-p ((stream fundamental-stream))
126     nil)
127
128   (defmethod interactive-stream-p ((stream stream))
129     (bug-or-error stream 'interactive-stream-p))
130
131   (defmethod interactive-stream-p ((non-stream t))
132     (error 'type-error :datum non-stream :expected-type 'stream)))
133 \f
134 (let ()
135   (fmakunbound 'output-stream-p)
136
137   (defgeneric output-stream-p (stream)
138     #+sb-doc
139     (:documentation "Can STREAM perform output operations?"))
140
141   (defmethod output-stream-p ((stream ansi-stream))
142     (ansi-stream-output-stream-p stream))
143
144   (defmethod output-stream-p ((stream fundamental-stream))
145     nil)
146
147   (defmethod output-stream-p ((stream fundamental-output-stream))
148     t)
149
150   (defmethod output-stream-p ((stream stream))
151     (bug-or-error stream 'output-stream-p))
152
153   (defmethod output-stream-p ((non-stream t))
154     (error 'type-error :datum non-stream :expected-type 'stream)))
155 \f
156 ;;; character input streams
157 ;;;
158 ;;; A character input stream can be created by defining a class that
159 ;;; includes FUNDAMENTAL-CHARACTER-INPUT-STREAM and defining methods
160 ;;; for the generic functions below.
161
162 (defgeneric stream-read-char (stream)
163   #+sb-doc
164   (:documentation
165    "Read one character from the stream. Return either a
166   character object, or the symbol :EOF if the stream is at end-of-file.
167   Every subclass of FUNDAMENTAL-CHARACTER-INPUT-STREAM must define a
168   method for this function."))
169
170 (defgeneric stream-unread-char (stream character)
171   #+sb-doc
172   (:documentation
173    "Un-do the last call to STREAM-READ-CHAR, as in UNREAD-CHAR.
174   Return NIL. Every subclass of FUNDAMENTAL-CHARACTER-INPUT-STREAM
175   must define a method for this function."))
176
177 (defgeneric stream-read-char-no-hang (stream)
178   #+sb-doc
179   (:documentation
180    "This is used to implement READ-CHAR-NO-HANG. It returns either a
181   character, or NIL if no input is currently available, or :EOF if
182   end-of-file is reached. The default method provided by
183   FUNDAMENTAL-CHARACTER-INPUT-STREAM simply calls STREAM-READ-CHAR; this
184   is sufficient for file streams, but interactive streams should define
185   their own method."))
186
187 (defmethod stream-read-char-no-hang ((stream fundamental-character-input-stream))
188   (stream-read-char stream))
189
190 (defgeneric stream-peek-char (stream)
191   #+sb-doc
192   (:documentation
193    "This is used to implement PEEK-CHAR; this corresponds to PEEK-TYPE of NIL.
194   It returns either a character or :EOF. The default method calls
195   STREAM-READ-CHAR and STREAM-UNREAD-CHAR."))
196
197 (defmethod stream-peek-char ((stream fundamental-character-input-stream))
198   (let ((char (stream-read-char stream)))
199     (unless (eq char :eof)
200       (stream-unread-char stream char))
201     char))
202
203 (defgeneric stream-listen (stream)
204   #+sb-doc
205   (:documentation
206    "This is used by LISTEN. It returns true or false. The default method uses
207   STREAM-READ-CHAR-NO-HANG and STREAM-UNREAD-CHAR. Most streams should
208   define their own method since it will usually be trivial and will
209   always be more efficient than the default method."))
210
211 (defmethod stream-listen ((stream fundamental-character-input-stream))
212   (let ((char (stream-read-char-no-hang stream)))
213     (when (characterp char)
214       (stream-unread-char stream char)
215       t)))
216
217 (defgeneric stream-read-line (stream)
218   #+sb-doc
219   (:documentation
220    "This is used by READ-LINE. A string is returned as the first value. The
221   second value is true if the string was terminated by end-of-file
222   instead of the end of a line. The default method uses repeated
223   calls to STREAM-READ-CHAR."))
224
225 (defmethod stream-read-line ((stream fundamental-character-input-stream))
226   (let ((res (make-string 80))
227         (len 80)
228         (index 0))
229     (loop
230      (let ((ch (stream-read-char stream)))
231        (cond ((eq ch :eof)
232               (return (values (%shrink-vector res index) t)))
233              (t
234               (when (char= ch #\newline)
235                 (return (values (%shrink-vector res index) nil)))
236               (when (= index len)
237                 (setq len (* len 2))
238                 (let ((new (make-string len)))
239                   (replace new res)
240                   (setq res new)))
241               (setf (schar res index) ch)
242               (incf index)))))))
243
244 (defgeneric stream-clear-input (stream)
245   #+sb-doc
246   (:documentation
247    "This is like CL:CLEAR-INPUT, but for Gray streams, returning NIL.
248   The default method does nothing."))
249
250 (defmethod stream-clear-input ((stream fundamental-character-input-stream))
251   nil)
252 (defmethod stream-clear-input ((stream stream))
253   (bug-or-error stream 'stream-clear-input))
254 (defmethod stream-clear-input ((non-stream t))
255   (error 'type-error :datum non-stream :expected-type 'stream))
256
257 (defgeneric stream-read-sequence (stream seq &optional start end)
258   (:documentation
259    "This is like CL:READ-SEQUENCE, but for Gray streams."))
260
261 ;;; Destructively modify SEQ by reading elements from STREAM. That
262 ;;; part of SEQ bounded by START and END is destructively modified by
263 ;;; copying successive elements into it from STREAM. If the end of
264 ;;; file for STREAM is reached before copying all elements of the
265 ;;; subsequence, then the extra elements near the end of sequence are
266 ;;; not updated, and the index of the next element is returned.
267 (defun basic-io-type-stream-read-sequence (stream seq start end read-fun)
268   (declare (type sequence seq)
269            (type stream stream)
270            (type index start)
271            (type sequence-end end)
272            (type function read-fun)
273            (values index))
274   (let ((end (or end (length seq))))
275     (declare (type index end))
276     (etypecase seq
277       (list
278         (do ((rem (nthcdr start seq) (rest rem))
279              (i start (1+ i)))
280             ((or (endp rem) (>= i end)) i)
281           (declare (type list rem)
282                    (type index i))
283           (let ((el (funcall read-fun stream)))
284             (when (eq el :eof)
285               (return i))
286             (setf (first rem) el))))
287       (vector
288         (with-array-data ((data seq) (offset-start start) (offset-end end))
289           (do ((i offset-start (1+ i)))
290               ((>= i offset-end) end)
291             (declare (type index i))
292             (let ((el (funcall read-fun stream)))
293               (when (eq el :eof)
294                 (return (+ start (- i offset-start))))
295               (setf (aref data i) el))))))))
296
297 (defmethod stream-read-sequence ((stream fundamental-character-input-stream)
298                                  (seq sequence)
299                                  &optional (start 0) (end nil))
300   (basic-io-type-stream-read-sequence stream seq start end
301                                       #'stream-read-char))
302
303 (defmethod stream-read-sequence ((stream fundamental-binary-input-stream)
304                                  (seq sequence)
305                                  &optional (start 0) (end nil))
306   (basic-io-type-stream-read-sequence stream seq start end
307                                       #'stream-read-byte))
308
309 \f
310 ;;; character output streams
311 ;;;
312 ;;; A character output stream can be created by defining a class that
313 ;;; includes FUNDAMENTAL-CHARACTER-OUTPUT-STREAM and defining methods
314 ;;; for the generic functions below.
315
316 (defgeneric stream-write-char (stream character)
317   #+sb-doc
318   (:documentation
319    "Write CHARACTER to STREAM and return CHARACTER. Every
320   subclass of FUNDAMENTAL-CHARACTER-OUTPUT-STREAM must have a method
321   defined for this function."))
322
323 (defgeneric stream-line-column (stream)
324   #+sb-doc
325   (:documentation
326    "Return the column number where the next character
327   will be written, or NIL if that is not meaningful for this stream.
328   The first column on a line is numbered 0. This function is used in
329   the implementation of PPRINT and the FORMAT ~T directive. For every
330   character output stream class that is defined, a method must be
331   defined for this function, although it is permissible for it to
332   always return NIL."))
333
334 (defmethod stream-line-column ((stream fundamental-character-output-stream))
335    nil)
336
337 ;;; STREAM-LINE-LENGTH is a CMU CL extension to Gray streams.
338 ;;; FIXME: Should we support it? Probably not..
339 (defgeneric stream-line-length (stream)
340   #+sb-doc
341   (:documentation "Return the stream line length or NIL."))
342
343 (defmethod stream-line-length ((stream fundamental-character-output-stream))
344   nil)
345
346 (defgeneric stream-start-line-p (stream)
347   #+sb-doc
348   (:documentation
349    "Is STREAM known to be positioned at the beginning of a line?
350   It is permissible for an implementation to always return
351   NIL. This is used in the implementation of FRESH-LINE. Note that
352   while a value of 0 from STREAM-LINE-COLUMN also indicates the
353   beginning of a line, there are cases where STREAM-START-LINE-P can be
354   meaningfully implemented although STREAM-LINE-COLUMN can't be. For
355   example, for a window using variable-width characters, the column
356   number isn't very meaningful, but the beginning of the line does have
357   a clear meaning. The default method for STREAM-START-LINE-P on class
358   FUNDAMENTAL-CHARACTER-OUTPUT-STREAM uses STREAM-LINE-COLUMN, so if
359   that is defined to return NIL, then a method should be provided for
360   either STREAM-START-LINE-P or STREAM-FRESH-LINE."))
361
362 (defmethod stream-start-line-p ((stream fundamental-character-output-stream))
363   (eql (stream-line-column stream) 0))
364
365 (defgeneric stream-write-string (stream string &optional start end)
366   #+sb-doc
367   (:documentation
368    "This is used by WRITE-STRING. It writes the string to the stream,
369   optionally delimited by start and end, which default to 0 and NIL.
370   The string argument is returned. The default method provided by
371   FUNDAMENTAL-CHARACTER-OUTPUT-STREAM uses repeated calls to
372   STREAM-WRITE-CHAR."))
373
374 (defmethod stream-write-string ((stream fundamental-character-output-stream)
375                                 string &optional (start 0) end)
376   (declare (string string)
377            (fixnum start))
378   (let ((end (or end (length string))))
379     (declare (fixnum end))
380     (do ((pos start (1+ pos)))
381         ((>= pos end))
382       (declare (type index pos))
383       (stream-write-char stream (aref string pos))))
384   string)
385
386 (defgeneric stream-terpri (stream)
387   #+sb-doc
388   (:documentation
389    "Writes an end of line, as for TERPRI. Returns NIL. The default
390   method does (STREAM-WRITE-CHAR stream #\NEWLINE)."))
391
392 (defmethod stream-terpri ((stream fundamental-character-output-stream))
393   (stream-write-char stream #\Newline))
394
395 (defgeneric stream-fresh-line (stream)
396   #+sb-doc
397   (:documentation
398    "Outputs a new line to the Stream if it is not positioned at the
399   begining of a line. Returns T if it output a new line, nil
400   otherwise. Used by FRESH-LINE. The default method uses
401   STREAM-START-LINE-P and STREAM-TERPRI."))
402
403 (defmethod stream-fresh-line ((stream fundamental-character-output-stream))
404   (unless (stream-start-line-p stream)
405     (stream-terpri stream)
406     t))
407
408 (defgeneric stream-finish-output (stream)
409   #+sb-doc
410   (:documentation
411    "Attempts to ensure that all output sent to the Stream has reached
412   its destination, and only then returns false. Implements
413   FINISH-OUTPUT. The default method does nothing."))
414
415 (defmethod stream-finish-output ((stream fundamental-output-stream))
416   nil)
417 (defmethod stream-finish-output ((stream stream))
418   (bug-or-error stream 'stream-finish-output))
419 (defmethod stream-finish-output ((non-stream t))
420   (error 'type-error :datum non-stream :expected-type 'stream))
421
422 (defgeneric stream-force-output (stream)
423   #+sb-doc
424   (:documentation
425    "Attempts to force any buffered output to be sent. Implements
426   FORCE-OUTPUT. The default method does nothing."))
427
428 (defmethod stream-force-output ((stream fundamental-output-stream))
429   nil)
430 (defmethod stream-force-output ((stream stream))
431   (bug-or-error stream 'stream-force-output))
432 (defmethod stream-force-output ((non-stream t))
433   (error 'type-error :datum non-stream :expected-type 'stream))
434
435 (defgeneric stream-clear-output (stream)
436   #+sb-doc
437   (:documentation
438    "This is like CL:CLEAR-OUTPUT, but for Gray streams: clear the given
439   output STREAM. The default method does nothing."))
440
441 (defmethod stream-clear-output ((stream fundamental-output-stream))
442   nil)
443 (defmethod stream-clear-output ((stream stream))
444   (bug-or-error stream 'stream-clear-output))
445 (defmethod stream-clear-output ((non-stream t))
446   (error 'type-error :datum non-stream :expected-type 'stream))
447
448 (defgeneric stream-advance-to-column (stream column)
449   #+sb-doc
450   (:documentation
451    "Write enough blank space so that the next character will be
452   written at the specified column. Returns true if the operation is
453   successful, or NIL if it is not supported for this stream. This is
454   intended for use by by PPRINT and FORMAT ~T. The default method uses
455   STREAM-LINE-COLUMN and repeated calls to STREAM-WRITE-CHAR with a
456   #\SPACE character; it returns NIL if STREAM-LINE-COLUMN returns NIL."))
457
458 (defmethod stream-advance-to-column ((stream fundamental-character-output-stream)
459                                      column)
460   (let ((current-column (stream-line-column stream)))
461     (when current-column
462       (let ((fill (- column current-column)))
463         (dotimes (i fill)
464           (stream-write-char stream #\Space)))
465       T)))
466
467 (defgeneric stream-write-sequence (stream seq &optional start end)
468   (:documentation
469    "This is like CL:WRITE-SEQUENCE, but for Gray streams."))
470
471 ;;; Write the elements of SEQ bounded by START and END to STREAM.
472 (defun basic-io-type-stream-write-sequence (stream seq start end write-fun)
473   (declare (type sequence seq)
474            (type stream stream)
475            (type index start)
476            (type sequence-end end)
477            (type function write-fun)
478            (values sequence))
479   (let ((end (or end (length seq))))
480     (declare (type index start end))
481     (etypecase seq
482       (list
483         (do ((rem (nthcdr start seq) (rest rem))
484              (i start (1+ i)))
485             ((or (endp rem) (>= i end)) seq)
486           (declare (type list rem)
487                    (type index i))
488           (funcall write-fun stream (first rem))))
489       (vector
490         (do ((i start (1+ i)))
491             ((>= i end) seq)
492           (declare (type index i))
493           (funcall write-fun stream (aref seq i)))))))
494
495 (defmethod stream-write-sequence ((stream fundamental-character-output-stream)
496                                   (seq sequence)
497                                   &optional (start 0) (end nil))
498   (typecase seq
499     (string
500       (stream-write-string stream seq start end))
501     (t
502       (basic-io-type-stream-write-sequence stream seq start end
503                                            #'stream-write-char))))
504
505 \f
506 ;;; binary streams
507 ;;;
508 ;;; Binary streams can be created by defining a class that includes
509 ;;; either FUNDAMENTAL-BINARY-INPUT-STREAM or
510 ;;; FUNDAMENTAL-BINARY-OUTPUT-STREAM (or both) and defining a method
511 ;;; for STREAM-ELEMENT-TYPE and for one or both of the following
512 ;;; generic functions.
513
514 (defgeneric stream-read-byte (stream)
515   #+sb-doc
516   (:documentation
517    "Used by READ-BYTE; returns either an integer, or the symbol :EOF
518   if the stream is at end-of-file."))
519
520 (defmethod stream-read-byte ((stream stream))
521   (bug-or-error stream 'stream-read-byte))
522 (defmethod stream-read-byte ((non-stream t))
523   (error 'type-error :datum non-stream :expected-type 'stream))
524
525 (defgeneric stream-write-byte (stream integer)
526   #+sb-doc
527   (:documentation
528    "Implements WRITE-BYTE; writes the integer to the stream and
529   returns the integer as the result."))
530
531 (defmethod stream-write-byte ((stream stream) integer)
532   (bug-or-error stream 'stream-write-byte))
533 (defmethod stream-write-byte ((non-stream t) integer)
534   (error 'type-error :datum non-stream :expected-type 'stream))
535
536 ;; Provide a reasonable default for binary Gray streams.  We might be
537 ;; able to do better by specializing on the sequence type, but at
538 ;; least the behaviour is reasonable. --tony 2003/05/08.
539 (defmethod stream-write-sequence ((stream fundamental-binary-output-stream)
540                                   (seq sequence)
541                                   &optional (start 0) (end nil))
542   (basic-io-type-stream-write-sequence stream seq start end
543                                        #'stream-write-byte))
544
545 \f
546 ;;; This is not in the Gray stream proposal, so it is left here
547 ;;; as example code.
548 #|
549 ;;; example character output stream encapsulating a lisp-stream
550 (defun make-character-output-stream (lisp-stream)
551   (declare (type lisp-stream lisp-stream))
552   (make-instance 'character-output-stream :lisp-stream lisp-stream))
553
554 (defmethod open-stream-p ((stream character-output-stream))
555   (open-stream-p (character-output-stream-lisp-stream stream)))
556
557 (defmethod close ((stream character-output-stream) &key abort)
558   (close (character-output-stream-lisp-stream stream) :abort abort))
559
560 (defmethod input-stream-p ((stream character-output-stream))
561   (input-stream-p (character-output-stream-lisp-stream stream)))
562
563 (defmethod output-stream-p ((stream character-output-stream))
564   (output-stream-p (character-output-stream-lisp-stream stream)))
565
566 (defmethod stream-write-char ((stream character-output-stream) character)
567   (write-char character (character-output-stream-lisp-stream stream)))
568
569 (defmethod stream-line-column ((stream character-output-stream))
570   (charpos (character-output-stream-lisp-stream stream)))
571
572 (defmethod stream-line-length ((stream character-output-stream))
573   (line-length (character-output-stream-lisp-stream stream)))
574
575 (defmethod stream-finish-output ((stream character-output-stream))
576   (finish-output (character-output-stream-lisp-stream stream)))
577
578 (defmethod stream-force-output ((stream character-output-stream))
579   (force-output (character-output-stream-lisp-stream stream)))
580
581 (defmethod stream-clear-output ((stream character-output-stream))
582   (clear-output (character-output-stream-lisp-stream stream)))
583 \f
584 ;;; example character input stream encapsulating a lisp-stream
585
586 (defun make-character-input-stream (lisp-stream)
587   (declare (type lisp-stream lisp-stream))
588   (make-instance 'character-input-stream :lisp-stream lisp-stream))
589
590 (defmethod open-stream-p ((stream character-input-stream))
591   (open-stream-p (character-input-stream-lisp-stream stream)))
592
593 (defmethod close ((stream character-input-stream) &key abort)
594   (close (character-input-stream-lisp-stream stream) :abort abort))
595
596 (defmethod input-stream-p ((stream character-input-stream))
597   (input-stream-p (character-input-stream-lisp-stream stream)))
598
599 (defmethod output-stream-p ((stream character-input-stream))
600   (output-stream-p (character-input-stream-lisp-stream stream)))
601
602 (defmethod stream-read-char ((stream character-input-stream))
603   (read-char (character-input-stream-lisp-stream stream) nil :eof))
604
605 (defmethod stream-unread-char ((stream character-input-stream) character)
606   (unread-char character (character-input-stream-lisp-stream stream)))
607
608 (defmethod stream-read-char-no-hang ((stream character-input-stream))
609   (read-char-no-hang (character-input-stream-lisp-stream stream) nil :eof))
610
611 #+nil
612 (defmethod stream-peek-char ((stream character-input-stream))
613   (peek-char nil (character-input-stream-lisp-stream stream) nil :eof))
614
615 #+nil
616 (defmethod stream-listen ((stream character-input-stream))
617   (listen (character-input-stream-lisp-stream stream)))
618
619 (defmethod stream-clear-input ((stream character-input-stream))
620   (clear-input (character-input-stream-lisp-stream stream)))
621 |#