X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fpcl%2Fgray-streams.lisp;h=2b0cc85d3e4aa9bff25871903757ca5cc239721b;hb=f3f677703e37f5a335b3be7fa64f7748ad969517;hp=c09524afe8985868a9935f936d971f521d6c3746;hpb=f5133ab2ffcddbcdb330cbbceff3af8d66673ce8;p=sbcl.git diff --git a/src/pcl/gray-streams.lisp b/src/pcl/gray-streams.lisp index c09524a..2b0cc85 100644 --- a/src/pcl/gray-streams.lisp +++ b/src/pcl/gray-streams.lisp @@ -10,6 +10,24 @@ ;;;; 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 + "~@).~@:>" + ,stream ,fun)) (fmakunbound 'stream-element-type) @@ -21,10 +39,16 @@ which returns CHARACTER.")) (defmethod stream-element-type ((stream ansi-stream)) - (funcall (ansi-stream-misc stream) stream :element-type)) + (ansi-stream-element-type stream)) (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)) (defgeneric pcl-open-stream-p (stream) #+sb-doc @@ -34,11 +58,17 @@ called on the stream.")) (defmethod pcl-open-stream-p ((stream ansi-stream)) - (not (eq (ansi-stream-in stream) #'closed-flame))) + (ansi-stream-open-stream-p stream)) (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) @@ -51,9 +81,7 @@ to clean up the side effects of having created the stream.")) (defmethod pcl-close ((stream ansi-stream) &key abort) - (when (open-stream-p stream) - (funcall (ansi-stream-misc stream) stream :close abort)) - t) + (ansi-stream-close stream abort)) (defmethod pcl-close ((stream fundamental-stream) &key abort) (declare (ignore abort)) @@ -62,33 +90,49 @@ (setf (fdefinition 'close) #'pcl-close) -(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))) + +(let () + (fmakunbound 'output-stream-p) -(defmethod input-stream-p ((stream ansi-stream)) - (and (not (eq (ansi-stream-in stream) #'closed-flame)) - (or (not (eq (ansi-stream-in stream) #'ill-in)) - (not (eq (ansi-stream-bin stream) #'ill-bin))))) + (defgeneric output-stream-p (stream) + #+sb-doc + (:documentation "Can STREAM perform output operations?")) -(defmethod input-stream-p ((stream fundamental-input-stream)) - t) - -(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)) - (and (not (eq (ansi-stream-in stream) #'closed-flame)) - (or (not (eq (ansi-stream-out stream) #'ill-out)) - (not (eq (ansi-stream-bout stream) #'ill-bout))))) + (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))) ;;; character input streams ;;; @@ -186,6 +230,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 @@ -232,6 +280,13 @@ &optional (start 0) (end nil)) (basic-io-type-stream-read-sequence stream seq start end #'stream-read-char)) + +(defmethod stream-read-sequence ((stream fundamental-binary-input-stream) + (seq sequence) + &optional (start 0) (end nil)) + (basic-io-type-stream-read-sequence stream seq start end + #'stream-read-byte)) + ;;; character output streams ;;; @@ -340,6 +395,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 @@ -349,6 +408,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 @@ -358,6 +421,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 @@ -431,11 +498,31 @@ "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. +(defmethod stream-write-sequence ((stream fundamental-binary-output-stream) + (seq sequence) + &optional (start 0) (end nil)) + (basic-io-type-stream-write-sequence stream seq start end + #'stream-write-byte)) + ;;; This is not in the Gray stream proposal, so it is left here ;;; as example code.