;;;
;;; All arguments are forms which will be used for a specific purpose
;;; PEEK-TYPE - the current peek-type as defined by ANSI CL
-;;; EOF-VALUE - the eof-value argument to peek-char
+;;; EOF-RESULT - the eof-value argument to peek-char
;;; CHAR-VAR - the variable which will be used to store the current character
;;; READ-FORM - the form which will be used to read a character
+;;; EOF-VALUE - the result returned from READ-FORM when hitting eof
;;; UNREAD-FORM - ditto for unread-char
;;; SKIPPED-CHAR-FORM - the form to execute when skipping a character
;;; EOF-DETECTED-FORM - the form to execute when EOF has been detected
-;;; (this will default to CHAR-VAR)
-(eval-when (:compile-toplevel :execute)
- (sb!xc:defmacro generalized-peeking-mechanism
- (peek-type eof-value char-var read-form unread-form
- &optional (skipped-char-form nil) (eof-detected-form nil))
- `(let ((,char-var ,read-form))
- (cond ((eql ,char-var ,eof-value)
- ,(if eof-detected-form
- eof-detected-form
- char-var))
- ((characterp ,peek-type)
- (do ((,char-var ,char-var ,read-form))
- ((or (eql ,char-var ,eof-value)
- (char= ,char-var ,peek-type))
- (cond ((eql ,char-var ,eof-value)
- ,(if eof-detected-form
- eof-detected-form
- char-var))
- (t ,unread-form
- ,char-var)))
- ,skipped-char-form))
- ((eql ,peek-type t)
- (do ((,char-var ,char-var ,read-form))
- ((or (eql ,char-var ,eof-value)
- (not (whitespacep ,char-var)))
- (cond ((eql ,char-var ,eof-value)
- ,(if eof-detected-form
- eof-detected-form
- char-var))
- (t ,unread-form
- ,char-var)))
- ,skipped-char-form))
- ((null ,peek-type)
- ,unread-form
- ,char-var)
- (t
- (bug "Impossible case reached in PEEK-CHAR"))))))
+;;; (this will default to EOF-RESULT)
+(sb!xc:defmacro generalized-peeking-mechanism
+ (peek-type eof-value char-var read-form read-eof unread-form
+ &optional (skipped-char-form nil) (eof-detected-form nil))
+ `(let ((,char-var ,read-form))
+ (cond ((eql ,char-var ,read-eof)
+ ,(if eof-detected-form
+ eof-detected-form
+ eof-value))
+ ((characterp ,peek-type)
+ (do ((,char-var ,char-var ,read-form))
+ ((or (eql ,char-var ,read-eof)
+ (char= ,char-var ,peek-type))
+ (cond ((eql ,char-var ,read-eof)
+ ,(if eof-detected-form
+ eof-detected-form
+ eof-value))
+ (t ,unread-form
+ ,char-var)))
+ ,skipped-char-form))
+ ((eql ,peek-type t)
+ (do ((,char-var ,char-var ,read-form))
+ ((or (eql ,char-var ,read-eof)
+ (not (whitespacep ,char-var)))
+ (cond ((eql ,char-var ,read-eof)
+ ,(if eof-detected-form
+ eof-detected-form
+ eof-value))
+ (t ,unread-form
+ ,char-var)))
+ ,skipped-char-form))
+ ((null ,peek-type)
+ ,unread-form
+ ,char-var)
+ (t
+ (bug "Impossible case reached in PEEK-CHAR")))))
-;;; We proclaim them INLINE here, then proclaim them MAYBE-INLINE at EOF,
-;;; so, except in this file, they are not inline by default, but they can be.
-#!-sb-fluid (declaim (inline read-char unread-char read-byte listen))
+;;; rudi (2004-08-09): There was an inline declaration for read-char,
+;;; unread-char, read-byte, listen here that was removed because these
+;;; functions are redefined when simple-streams are loaded.
+
+#!-sb-fluid (declaim (inline ansi-stream-peek-char))
+(defun ansi-stream-peek-char (peek-type stream eof-error-p eof-value
+ recursive-p)
+ (cond ((typep stream 'echo-stream)
+ (echo-misc stream
+ :peek-char
+ peek-type
+ (list eof-error-p eof-value)))
+ (t
+ (generalized-peeking-mechanism
+ peek-type eof-value char
+ (ansi-stream-read-char stream eof-error-p :eof recursive-p)
+ :eof
+ (ansi-stream-unread-char char stream)))))
(defun peek-char (&optional (peek-type nil)
(stream *standard-input*)
(eof-error-p t)
eof-value
recursive-p)
- (declare (ignore recursive-p))
(the (or character boolean) peek-type)
(let ((stream (in-synonym-of stream)))
- (cond ((typep stream 'echo-stream)
- (echo-misc stream
- :peek-char
- peek-type
- (list eof-error-p eof-value)))
- ((ansi-stream-p stream)
- (generalized-peeking-mechanism
- peek-type eof-value char
- (read-char stream eof-error-p eof-value)
- (unread-char char stream)))
- (t
- ;; by elimination, must be Gray streams FUNDAMENTAL-STREAM
- (generalized-peeking-mechanism
- peek-type :eof char
- (if (null peek-type)
- (stream-peek-char stream)
- (stream-read-char stream))
- (if (null peek-type)
- ()
- (stream-unread-char stream char))
- ()
- (eof-or-lose stream eof-error-p eof-value))))))
+ (if (ansi-stream-p stream)
+ (ansi-stream-peek-char peek-type stream eof-error-p eof-value
+ recursive-p)
+ ;; by elimination, must be Gray streams FUNDAMENTAL-STREAM
+ (generalized-peeking-mechanism
+ peek-type :eof char
+ (if (null peek-type)
+ (stream-peek-char stream)
+ (stream-read-char stream))
+ :eof
+ (if (null peek-type)
+ ()
+ (stream-unread-char stream char))
+ ()
+ (eof-or-lose stream eof-error-p eof-value)))))
(defun echo-misc (stream operation &optional arg1 arg2)
(let* ((in (two-way-stream-input-stream stream))
(pop (echo-stream-unread-stuff stream)))
(t
(setf unread-char-p nil)
- (read-char in (first arg2) (second arg2))))))
+ (read-char in (first arg2) :eof)))))
(generalized-peeking-mechanism
arg1 (second arg2) char
(infn)
+ :eof
(unread-char char in)
(outfn char)))))
(t
(funcall (ansi-stream-misc out) out operation arg1 arg2)
(stream-misc-dispatch out operation arg1 arg2)))))))
-(declaim (maybe-inline read-char unread-char read-byte listen))
\ No newline at end of file
projects / sbcl.git / blobdiff