;;;; more information.
(in-package "SB-GRAY")
+
+;;; BUG-OR-ERROR: because we have extensible streams, wherewith the
+;;; 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
+ "~@<The stream ~S has no suitable method for ~S, ~
+ and so has fallen through to this method. If you think that this is ~
+ a bug, please report it to the applicable authority (bugs in SBCL itself ~
+ should go to the mailing lists referenced from ~
+ <http://www.sbcl.org/>).~@:>"
+ ,stream ,fun))
\f
(fmakunbound 'stream-element-type)
(defmethod stream-element-type ((stream fundamental-character-stream))
'character)
+
+(defmethod stream-element-type ((stream stream))
+ (bug-or-error stream 'stream-element-type))
+
+(defmethod stream-element-type ((non-stream t))
+ (error 'type-error :datum non-stream :expected-type 'stream))
\f
(defgeneric pcl-open-stream-p (stream)
#+sb-doc
(defmethod pcl-open-stream-p ((stream fundamental-stream))
(stream-open-p stream))
+(defmethod pcl-open-stream-p ((stream stream))
+ (bug-or-error stream 'open-stream-p))
+
+(defmethod pcl-open-stream-p ((non-stream t))
+ (error 'type-error :datum non-stream :expected-type 'stream))
+
;;; bootstrapping hack
(pcl-open-stream-p (make-string-output-stream))
(setf (fdefinition 'open-stream-p) #'pcl-open-stream-p)
(setf (fdefinition 'close) #'pcl-close)
\f
-(fmakunbound 'input-stream-p)
-
-(defgeneric input-stream-p (stream)
- #+sb-doc
- (:documentation "Can STREAM perform input operations?"))
+(let ()
+ (fmakunbound 'input-stream-p)
+
+ (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)))
+\f
+(let ()
+ (fmakunbound 'output-stream-p)
-(defmethod input-stream-p ((stream ansi-stream))
- (ansi-stream-input-stream-p stream))
+ (defgeneric output-stream-p (stream)
+ #+sb-doc
+ (:documentation "Can STREAM perform output operations?"))
-(defmethod input-stream-p ((stream fundamental-input-stream))
- t)
-\f
-(fmakunbound 'output-stream-p)
+ (defmethod output-stream-p ((stream ansi-stream))
+ (ansi-stream-output-stream-p stream))
-(defgeneric output-stream-p (stream)
- #+sb-doc
- (:documentation "Can STREAM perform output operations?"))
+ (defmethod output-stream-p ((stream fundamental-stream))
+ nil)
+
+ (defmethod output-stream-p ((stream fundamental-output-stream))
+ t)
-(defmethod output-stream-p ((stream ansi-stream))
- (ansi-stream-output-stream-p stream))
+ (defmethod output-stream-p ((stream stream))
+ (bug-or-error stream 'output-stream-p))
-(defmethod output-stream-p ((stream fundamental-output-stream))
- t)
+ (defmethod output-stream-p ((non-stream t))
+ (error 'type-error :datum non-stream :expected-type 'stream)))
\f
;;; character input streams
;;;
(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
(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
(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
(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
"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.