1 ;;;; os-independent stream functions requiring reader machinery
3 ;;;; This software is part of the SBCL system. See the README file for
6 ;;;; This software is derived from the CMU CL system, which was
7 ;;;; written at Carnegie Mellon University and released into the
8 ;;;; public domain. The software is in the public domain and is
9 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
10 ;;;; files for more information.
12 (in-package "SB!IMPL")
14 ;;; In the interest of ``once and only once'' this macro contains the
15 ;;; framework necessary to implement a peek-char function, which has
16 ;;; two special-cases (one for gray streams and one for echo streams)
17 ;;; in addition to the normal case.
19 ;;; All arguments are forms which will be used for a specific purpose
20 ;;; PEEK-TYPE - the current peek-type as defined by ANSI CL
21 ;;; EOF-VALUE - the eof-value argument to peek-char
22 ;;; CHAR-VAR - the variable which will be used to store the current character
23 ;;; READ-FORM - the form which will be used to read a character
24 ;;; UNREAD-FORM - ditto for unread-char
25 ;;; SKIPPED-CHAR-FORM - the form to execute when skipping a character
26 ;;; EOF-DETECTED-FORM - the form to execute when EOF has been detected
27 ;;; (this will default to CHAR-VAR)
28 (eval-when (:compile-toplevel :execute)
29 (sb!xc:defmacro generalized-peeking-mechanism
30 (peek-type eof-value char-var read-form unread-form
31 &optional (skipped-char-form nil) (eof-detected-form nil))
32 `(let ((,char-var ,read-form))
33 (cond ((eql ,char-var ,eof-value)
34 ,(if eof-detected-form
37 ((characterp ,peek-type)
38 (do ((,char-var ,char-var ,read-form))
39 ((or (eql ,char-var ,eof-value)
40 (char= ,char-var ,peek-type))
41 (cond ((eql ,char-var ,eof-value)
42 ,(if eof-detected-form
49 (do ((,char-var ,char-var ,read-form))
50 ((or (eql ,char-var ,eof-value)
51 (not (whitespacep ,char-var)))
52 (cond ((eql ,char-var ,eof-value)
53 ,(if eof-detected-form
63 (bug "Impossible case reached in PEEK-CHAR"))))))
65 ;;; rudi (2004-08-09): There was an inline declaration for read-char,
66 ;;; unread-char, read-byte, listen here that was removed because these
67 ;;; functions are redefined when simple-streams are loaded.
69 #!-sb-fluid (declaim (inline ansi-stream-peek-char))
70 (defun ansi-stream-peek-char (peek-type stream eof-error-p eof-value
72 (cond ((typep stream 'echo-stream)
76 (list eof-error-p eof-value)))
78 (generalized-peeking-mechanism
79 peek-type eof-value char
80 (ansi-stream-read-char stream eof-error-p eof-value recursive-p)
81 (ansi-stream-unread-char char stream)))))
83 (defun peek-char (&optional (peek-type nil)
84 (stream *standard-input*)
88 (the (or character boolean) peek-type)
89 (let ((stream (in-synonym-of stream)))
90 (if (ansi-stream-p stream)
91 (ansi-stream-peek-char peek-type stream eof-error-p eof-value
93 ;; by elimination, must be Gray streams FUNDAMENTAL-STREAM
94 (generalized-peeking-mechanism
97 (stream-peek-char stream)
98 (stream-read-char stream))
101 (stream-unread-char stream char))
103 (eof-or-lose stream eof-error-p eof-value)))))
105 (defun echo-misc (stream operation &optional arg1 arg2)
106 (let* ((in (two-way-stream-input-stream stream))
107 (out (two-way-stream-output-stream stream)))
110 (or (not (null (echo-stream-unread-stuff stream)))
111 (if (ansi-stream-p in)
112 (or (/= (the fixnum (ansi-stream-in-index in))
113 +ansi-stream-in-buffer-length+)
114 (funcall (ansi-stream-misc in) in :listen))
115 (stream-misc-dispatch in :listen))))
116 (:unread (push arg1 (echo-stream-unread-stuff stream)))
118 (let ((in-type (stream-element-type in))
119 (out-type (stream-element-type out)))
120 (if (equal in-type out-type)
121 in-type `(and ,in-type ,out-type))))
123 (set-closed-flame stream))
125 ;; For the special case of peeking into an echo-stream
126 ;; arg1 is PEEK-TYPE, arg2 is (EOF-ERROR-P EOF-VALUE)
127 ;; returns peeked-char, eof-value, or errors end-of-file
129 ;; Note: This code could be moved into PEEK-CHAR if desired.
130 ;; I am unsure whether this belongs with echo-streams because it is
131 ;; echo-stream specific, or PEEK-CHAR because it is peeking code.
134 ;; UNREAD-CHAR-P indicates whether the current character was one
135 ;; that was previously unread. In that case, we need to ensure that
136 ;; the semantics for UNREAD-CHAR are held; the character should
137 ;; not be echoed again.
138 (let ((unread-char-p nil))
140 (unless unread-char-p
141 (if (ansi-stream-p out)
142 (funcall (ansi-stream-out out) out c)
144 (stream-write-char out c))))
146 ;; Obtain input from unread buffer or input stream,
147 ;; and set the flag appropriately.
148 (cond ((not (null (echo-stream-unread-stuff stream)))
149 (setf unread-char-p t)
150 (pop (echo-stream-unread-stuff stream)))
152 (setf unread-char-p nil)
153 (read-char in (first arg2) (second arg2))))))
154 (generalized-peeking-mechanism
155 arg1 (second arg2) char
157 (unread-char char in)
160 (or (if (ansi-stream-p in)
161 (funcall (ansi-stream-misc in) in operation arg1 arg2)
162 (stream-misc-dispatch in operation arg1 arg2))
163 (if (ansi-stream-p out)
164 (funcall (ansi-stream-misc out) out operation arg1 arg2)
165 (stream-misc-dispatch out operation arg1 arg2)))))))