X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-stream.lisp;h=3cc60e6ce236e551d95f54bb151ac981aeb45142;hb=7f1e94ae961a198e00daf281eb1dc858e5b2dcc7;hp=5e7a689651ed843de107829179643be2fbf1f887;hpb=dae76a317682df7472ee85d1a0f6a0248801a6ae;p=sbcl.git diff --git a/src/code/target-stream.lisp b/src/code/target-stream.lisp index 5e7a689..3cc60e6 100644 --- a/src/code/target-stream.lisp +++ b/src/code/target-stream.lisp @@ -18,49 +18,49 @@ ;;; ;;; 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 (whitespace[2]p ,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"))))) ;;; rudi (2004-08-09): There was an inline declaration for read-char, ;;; unread-char, read-byte, listen here that was removed because these @@ -77,14 +77,15 @@ (t (generalized-peeking-mechanism peek-type eof-value char - (ansi-stream-read-char stream eof-error-p eof-value recursive-p) + (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) + (stream *standard-input*) + (eof-error-p t) + eof-value + recursive-p) (the (or character boolean) peek-type) (let ((stream (in-synonym-of stream))) (if (ansi-stream-p stream) @@ -96,6 +97,7 @@ (if (null peek-type) (stream-peek-char stream) (stream-read-char stream)) + :eof (if (null peek-type) () (stream-unread-char stream char)) @@ -104,21 +106,21 @@ (defun echo-misc (stream operation &optional arg1 arg2) (let* ((in (two-way-stream-input-stream stream)) - (out (two-way-stream-output-stream stream))) + (out (two-way-stream-output-stream stream))) (case operation (:listen - (or (not (null (echo-stream-unread-stuff stream))) - (if (ansi-stream-p in) - (or (/= (the fixnum (ansi-stream-in-index in)) - +ansi-stream-in-buffer-length+) - (funcall (ansi-stream-misc in) in :listen)) - (stream-misc-dispatch in :listen)))) - (:unread (push arg1 (echo-stream-unread-stuff stream))) + (if (ansi-stream-p in) + (or (/= (the fixnum (ansi-stream-in-index in)) + +ansi-stream-in-buffer-length+) + (funcall (ansi-stream-misc in) in :listen)) + (stream-misc-dispatch in :listen))) + (:unread (setf (echo-stream-unread-stuff stream) t) + (unread-char arg1 in)) (:element-type (let ((in-type (stream-element-type in)) - (out-type (stream-element-type out))) - (if (equal in-type out-type) - in-type `(and ,in-type ,out-type)))) + (out-type (stream-element-type out))) + (if (equal in-type out-type) + in-type `(and ,in-type ,out-type)))) (:close (set-closed-flame stream)) (:peek-char @@ -131,36 +133,36 @@ ;; echo-stream specific, or PEEK-CHAR because it is peeking code. ;; -- mrd 2002-11-18 ;; - ;; UNREAD-CHAR-P indicates whether the current character was one - ;; that was previously unread. In that case, we need to ensure that - ;; the semantics for UNREAD-CHAR are held; the character should - ;; not be echoed again. - (let ((unread-char-p nil)) - (flet ((outfn (c) - (unless unread-char-p - (if (ansi-stream-p out) - (funcall (ansi-stream-out out) out c) - ;; gray-stream - (stream-write-char out c)))) - (infn () - ;; Obtain input from unread buffer or input stream, - ;; and set the flag appropriately. - (cond ((not (null (echo-stream-unread-stuff stream))) - (setf unread-char-p t) - (pop (echo-stream-unread-stuff stream))) - (t - (setf unread-char-p nil) - (read-char in (first arg2) (second arg2)))))) - (generalized-peeking-mechanism - arg1 (second arg2) char - (infn) - (unread-char char in) - (outfn char))))) + ;; UNREAD-P indicates whether the next character on IN was one + ;; that was previously unread. In that case, we need to ensure + ;; that the semantics for UNREAD-CHAR are held; the character + ;; should not be echoed again. + (let ((unread-p nil) + ;; The first peek shouldn't touch the unread-stuff slot. + (initial-peek-p t)) + (flet ((outfn (c) + (unless unread-p + (if (ansi-stream-p out) + (funcall (ansi-stream-out out) out c) + ;; gray-stream + (stream-write-char out c)))) + (infn () + (if initial-peek-p + (setf unread-p (echo-stream-unread-stuff stream)) + (setf (echo-stream-unread-stuff stream) nil)) + (setf initial-peek-p nil) + (read-char in (first arg2) :eof))) + (generalized-peeking-mechanism + arg1 (second arg2) char + (infn) + :eof + (unread-char char in) + (outfn char))))) (t (or (if (ansi-stream-p in) - (funcall (ansi-stream-misc in) in operation arg1 arg2) - (stream-misc-dispatch in operation arg1 arg2)) - (if (ansi-stream-p out) - (funcall (ansi-stream-misc out) out operation arg1 arg2) - (stream-misc-dispatch out operation arg1 arg2))))))) + (funcall (ansi-stream-misc in) in operation arg1 arg2) + (stream-misc-dispatch in operation arg1 arg2)) + (if (ansi-stream-p out) + (funcall (ansi-stream-misc out) out operation arg1 arg2) + (stream-misc-dispatch out operation arg1 arg2)))))))