;;;; os-independent stream functions requiring reader machinery ;;;; This software is part of the SBCL system. See the README file for ;;;; more information. ;;;; ;;;; This software is derived from the CMU CL system, which was ;;;; written at Carnegie Mellon University and released into the ;;;; public domain. The software is in the public domain and is ;;;; provided with absolutely no warranty. See the COPYING and CREDITS ;;;; files for more information. (in-package "SB!IMPL") ;;; In the interest of ``once and only once'' this macro contains the ;;; framework necessary to implement a peek-char function, which has ;;; two special-cases (one for gray streams and one for echo streams) ;;; in addition to the normal case. ;;; ;;; All arguments are forms which will be used for a specific purpose ;;; PEEK-TYPE - the current peek-type as defined by ANSI CL ;;; 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 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 ;;; 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) (the (or character boolean) peek-type) (let ((stream (in-synonym-of stream))) (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)) (out (two-way-stream-output-stream stream))) (case operation (:listen (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)))) (:close (set-closed-flame stream)) (:peek-char ;; For the special case of peeking into an echo-stream ;; arg1 is PEEK-TYPE, arg2 is (EOF-ERROR-P EOF-VALUE) ;; returns peeked-char, eof-value, or errors end-of-file ;; ;; Note: This code could be moved into PEEK-CHAR if desired. ;; I am unsure whether this belongs with echo-streams because it is ;; echo-stream specific, or PEEK-CHAR because it is peeking code. ;; -- mrd 2002-11-18 ;; ;; 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)))))))