X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fpcl%2Fgray-streams.lisp;h=28ed0f172c3da9f7089ae5884048598c1ae71f36;hb=7201fe2950a319884d4b449e135ad5879fd5b7e7;hp=3ad52a1d9ad0b97aea55b614bf05c0de6491aced;hpb=9afb0bc650cd36dc093be6958a224e86d59d3893;p=sbcl.git diff --git a/src/pcl/gray-streams.lisp b/src/pcl/gray-streams.lisp index 3ad52a1..28ed0f1 100644 --- a/src/pcl/gray-streams.lisp +++ b/src/pcl/gray-streams.lisp @@ -15,13 +15,19 @@ ;;; user is responsible for some of the protocol implementation, it's ;;; not necessarily a bug in SBCL itself if we fall through to one of ;;; these default methods. +;;; +;;; FIXME: there's a lot of similarity in these Gray stream +;;; implementation generic functions. All of them could (maybe +;;; should?) have two default methods: one on STREAM calling +;;; BUG-OR-ERROR, and one on T signalling a TYPE-ERROR. (defmacro bug-or-error (stream fun) - `(error "~@).~@:>" - ,stream ,fun)) - + `(error + "~@).~@:>" + ,stream ,fun)) (fmakunbound 'stream-element-type) @@ -90,20 +96,42 @@ (defgeneric input-stream-p (stream) #+sb-doc (:documentation "Can STREAM perform input operations?")) - + (defmethod input-stream-p ((stream ansi-stream)) (ansi-stream-input-stream-p stream)) - + + (defmethod input-stream-p ((stream fundamental-stream)) + nil) + (defmethod input-stream-p ((stream fundamental-input-stream)) t) (defmethod input-stream-p ((stream stream)) (bug-or-error stream 'input-stream-p)) - + (defmethod input-stream-p ((non-stream t)) (error 'type-error :datum non-stream :expected-type 'stream))) (let () + (fmakunbound 'interactive-stream-p) + + (defgeneric interactive-stream-p (stream) + #+sb-doc + (:documentation "Is STREAM an interactive stream?")) + + (defmethod interactive-stream-p ((stream ansi-stream)) + (funcall (ansi-stream-misc stream) stream :interactive-p)) + + (defmethod interactive-stream-p ((stream fundamental-stream)) + nil) + + (defmethod interactive-stream-p ((stream stream)) + (bug-or-error stream 'interactive-stream-p)) + + (defmethod interactive-stream-p ((non-stream t)) + (error 'type-error :datum non-stream :expected-type 'stream))) + +(let () (fmakunbound 'output-stream-p) (defgeneric output-stream-p (stream) @@ -113,6 +141,9 @@ (defmethod output-stream-p ((stream ansi-stream)) (ansi-stream-output-stream-p stream)) + (defmethod output-stream-p ((stream fundamental-stream)) + nil) + (defmethod output-stream-p ((stream fundamental-output-stream)) t) @@ -193,22 +224,22 @@ (defmethod stream-read-line ((stream fundamental-character-input-stream)) (let ((res (make-string 80)) - (len 80) - (index 0)) + (len 80) + (index 0)) (loop (let ((ch (stream-read-char stream))) (cond ((eq ch :eof) - (return (values (shrink-vector res index) t))) - (t - (when (char= ch #\newline) - (return (values (shrink-vector res index) nil))) - (when (= index len) - (setq len (* len 2)) - (let ((new (make-string len))) - (replace new res) - (setq res new))) - (setf (schar res index) ch) - (incf index))))))) + (return (values (%shrink-vector res index) t))) + (t + (when (char= ch #\newline) + (return (values (%shrink-vector res index) nil))) + (when (= index len) + (setq len (* len 2)) + (let ((new (make-string len))) + (replace new res) + (setq res new))) + (setf (schar res index) ch) + (incf index))))))) (defgeneric stream-clear-input (stream) #+sb-doc @@ -218,6 +249,10 @@ (defmethod stream-clear-input ((stream fundamental-character-input-stream)) nil) +(defmethod stream-clear-input ((stream stream)) + (bug-or-error stream 'stream-clear-input)) +(defmethod stream-clear-input ((non-stream t)) + (error 'type-error :datum non-stream :expected-type 'stream)) (defgeneric stream-read-sequence (stream seq &optional start end) (:documentation @@ -231,11 +266,11 @@ ;;; not updated, and the index of the next element is returned. (defun basic-io-type-stream-read-sequence (stream seq start end read-fun) (declare (type sequence seq) - (type stream stream) - (type index start) - (type sequence-end end) + (type stream stream) + (type index start) + (type sequence-end end) (type function read-fun) - (values index)) + (values index)) (let ((end (or end (length seq)))) (declare (type index end)) (etypecase seq @@ -337,13 +372,13 @@ STREAM-WRITE-CHAR.")) (defmethod stream-write-string ((stream fundamental-character-output-stream) - string &optional (start 0) end) + string &optional (start 0) end) (declare (string string) - (fixnum start)) + (fixnum start)) (let ((end (or end (length string)))) (declare (fixnum end)) (do ((pos start (1+ pos))) - ((>= pos end)) + ((>= pos end)) (declare (type index pos)) (stream-write-char stream (aref string pos)))) string) @@ -379,6 +414,10 @@ (defmethod stream-finish-output ((stream fundamental-output-stream)) nil) +(defmethod stream-finish-output ((stream stream)) + (bug-or-error stream 'stream-finish-output)) +(defmethod stream-finish-output ((non-stream t)) + (error 'type-error :datum non-stream :expected-type 'stream)) (defgeneric stream-force-output (stream) #+sb-doc @@ -388,6 +427,10 @@ (defmethod stream-force-output ((stream fundamental-output-stream)) nil) +(defmethod stream-force-output ((stream stream)) + (bug-or-error stream 'stream-force-output)) +(defmethod stream-force-output ((non-stream t)) + (error 'type-error :datum non-stream :expected-type 'stream)) (defgeneric stream-clear-output (stream) #+sb-doc @@ -397,6 +440,10 @@ (defmethod stream-clear-output ((stream fundamental-output-stream)) nil) +(defmethod stream-clear-output ((stream stream)) + (bug-or-error stream 'stream-clear-output)) +(defmethod stream-clear-output ((non-stream t)) + (error 'type-error :datum non-stream :expected-type 'stream)) (defgeneric stream-advance-to-column (stream column) #+sb-doc @@ -409,12 +456,12 @@ #\SPACE character; it returns NIL if STREAM-LINE-COLUMN returns NIL.")) (defmethod stream-advance-to-column ((stream fundamental-character-output-stream) - column) + column) (let ((current-column (stream-line-column stream))) (when current-column (let ((fill (- column current-column))) - (dotimes (i fill) - (stream-write-char stream #\Space))) + (dotimes (i fill) + (stream-write-char stream #\Space))) T))) (defgeneric stream-write-sequence (stream seq &optional start end) @@ -424,11 +471,11 @@ ;;; Write the elements of SEQ bounded by START and END to STREAM. (defun basic-io-type-stream-write-sequence (stream seq start end write-fun) (declare (type sequence seq) - (type stream stream) - (type index start) - (type sequence-end end) + (type stream stream) + (type index start) + (type sequence-end end) (type function write-fun) - (values sequence)) + (values sequence)) (let ((end (or end (length seq)))) (declare (type index start end)) (etypecase seq @@ -470,12 +517,22 @@ "Used by READ-BYTE; returns either an integer, or the symbol :EOF if the stream is at end-of-file.")) +(defmethod stream-read-byte ((stream stream)) + (bug-or-error stream 'stream-read-byte)) +(defmethod stream-read-byte ((non-stream t)) + (error 'type-error :datum non-stream :expected-type 'stream)) + (defgeneric stream-write-byte (stream integer) #+sb-doc (:documentation "Implements WRITE-BYTE; writes the integer to the stream and returns the integer as the result.")) +(defmethod stream-write-byte ((stream stream) integer) + (bug-or-error stream 'stream-write-byte)) +(defmethod stream-write-byte ((non-stream t) integer) + (error 'type-error :datum non-stream :expected-type 'stream)) + ;; Provide a reasonable default for binary Gray streams. We might be ;; able to do better by specializing on the sequence type, but at ;; least the behaviour is reasonable. --tony 2003/05/08.