X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fpcl%2Fgray-streams.lisp;h=3ad52a1d9ad0b97aea55b614bf05c0de6491aced;hb=696e38f7210c587ba0b54795f4795f58e62fed2d;hp=c09524afe8985868a9935f936d971f521d6c3746;hpb=f5133ab2ffcddbcdb330cbbceff3af8d66673ce8;p=sbcl.git

diff --git a/src/pcl/gray-streams.lisp b/src/pcl/gray-streams.lisp
index c09524a..3ad52a1 100644
--- a/src/pcl/gray-streams.lisp
+++ b/src/pcl/gray-streams.lisp
@@ -10,6 +10,18 @@
 ;;;; 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.
+(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))
+
 
 (fmakunbound 'stream-element-type)
 
@@ -21,10 +33,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 +52,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 +75,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 +84,43 @@
 
 (setf (fdefinition 'close) #'pcl-close)
 
-(fmakunbound 'input-stream-p)
+(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-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)
 
-(defgeneric input-stream-p (stream)
-  #+sb-doc
-  (:documentation "Can STREAM perform input operations?"))
+  (defgeneric output-stream-p (stream)
+    #+sb-doc
+    (:documentation "Can STREAM perform output operations?"))
 
-(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)))))
+  (defmethod output-stream-p ((stream ansi-stream))
+    (ansi-stream-output-stream-p stream))
 
-(defmethod input-stream-p ((stream fundamental-input-stream))
-  t)
-
-(fmakunbound 'output-stream-p)
+  (defmethod output-stream-p ((stream fundamental-output-stream))
+    t)
 
-(defgeneric output-stream-p (stream)
-  #+sb-doc
-  (:documentation "Can STREAM perform output operations?"))
+  (defmethod output-stream-p ((stream stream))
+    (bug-or-error stream 'output-stream-p))
 
-(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 fundamental-output-stream))
-  t)
+  (defmethod output-stream-p ((non-stream t))
+    (error 'type-error :datum non-stream :expected-type 'stream)))
 
 ;;; character input streams
 ;;;
@@ -232,6 +264,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
 ;;;
@@ -436,6 +475,16 @@
   (:documentation
    "Implements WRITE-BYTE; writes the integer to the stream and
   returns the integer as the result."))
+
+;; 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.