X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-stream.lisp;h=3144550bfb3c77722b3eff05389e7bb9ad250eba;hb=dc33d6a6b84f8338e603759cec8e25da29055d50;hp=4b254f68ff67f588bd250b7ee4b54bae8916375e;hpb=c47519c9e63fd32a635943a84ec13d8a60d95f08;p=sbcl.git diff --git a/src/code/target-stream.lisp b/src/code/target-stream.lisp index 4b254f6..3144550 100644 --- a/src/code/target-stream.lisp +++ b/src/code/target-stream.lisp @@ -18,84 +18,91 @@ ;;; ;;; 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)) @@ -145,10 +152,11 @@ (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 @@ -159,4 +167,3 @@ (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