deleting streams.lisp (did a pull from the wrong directory)

streams.lisp

@@ -1,255 +0,0 @@
-#+xcvb (module (:depends-on ("package")))
-
-(in-package :trivial-gray-streams)
-
-(defclass fundamental-stream (impl-specific-gray:fundamental-stream) ())
-(defclass fundamental-input-stream
-    (fundamental-stream impl-specific-gray:fundamental-input-stream) ())
-(defclass fundamental-output-stream
-    (fundamental-stream impl-specific-gray:fundamental-output-stream) ())
-(defclass fundamental-character-stream
-    (fundamental-stream impl-specific-gray:fundamental-character-stream) ())
-(defclass fundamental-binary-stream
-    (fundamental-stream impl-specific-gray:fundamental-binary-stream) ())
-(defclass fundamental-character-input-stream
-    (fundamental-input-stream fundamental-character-stream
-     impl-specific-gray:fundamental-character-input-stream) ())
-(defclass fundamental-character-output-stream
-    (fundamental-output-stream fundamental-character-stream
-     impl-specific-gray:fundamental-character-output-stream) ())
-(defclass fundamental-binary-input-stream
-    (fundamental-input-stream fundamental-binary-stream
-     impl-specific-gray:fundamental-binary-input-stream) ())
-(defclass fundamental-binary-output-stream
-    (fundamental-output-stream fundamental-binary-stream
-     impl-specific-gray:fundamental-binary-output-stream) ())
-
-(defgeneric stream-read-sequence
-    (stream sequence start end &key &allow-other-keys))
-(defgeneric stream-write-sequence
-    (stream sequence start end &key &allow-other-keys))
-
-(defgeneric stream-file-position (stream))
-(defgeneric (setf stream-file-position) (newval stream))
-
-;;; Default methods for stream-read/write-sequence.
-;;;
-;;; It would be nice to implement default methods
-;;; in trivial gray streams, maybe borrowing the code
-;;; from some of CL implementations. But now, for
-;;; simplicity we will fallback to default implementation
-;;; of the implementation-specific analogue function which calls us.
-
-(defmethod stream-read-sequence ((stream fundamental-input-stream) seq start end &key)
-  'fallback)
-
-(defmethod stream-write-sequence ((stream fundamental-output-stream) seq start end &key)
-  'fallback)
-
-(defmacro or-fallback (&body body)
-  `(let ((result ,@body))
-     (if (eq result (quote fallback))
-         (call-next-method)
-         result)))
-
-;; Implementations should provide this default method, I believe, but
-;; at least sbcl and allegro don't.
-(defmethod stream-terpri ((stream fundamental-output-stream))
-  (write-char #\newline stream))
-
-;; stream-file-position could be specialized to
-;; fundamental-stream, but to support backward
-;; compatibility with flexi-streams, we specialize
-;; it on T. The reason: flexi-streams calls stream-file-position
-;; for non-gray stream:
-;; https://github.com/edicl/flexi-streams/issues/4
-(defmethod stream-file-position ((stream t))
-  nil)
-
-(defmethod (setf stream-file-position) (newval (stream t))
-  (declare (ignore newval))
-  nil)
-
-#+abcl
-(progn
-  (defmethod gray-streams:stream-read-sequence 
-      ((s fundamental-input-stream) seq &optional start end)
-    (or-fallback (stream-read-sequence s seq (or start 0) (or end (length seq)))))
-  
-  (defmethod gray-streams:stream-write-sequence 
-      ((s fundamental-output-stream) seq &optional start end)
-    (or-fallback (stream-write-sequence s seq (or start 0) (or end (length seq)))))
-  
-  (defmethod gray-streams:stream-write-string 
-      ((stream xp::xp-structure) string &optional (start 0) (end (length string)))
-    (xp::write-string+ string stream start end))
-
-  #+#.(cl:if (cl:and (cl:find-package :gray-streams)
-		     (cl:find-symbol "STREAM-FILE-POSITION" :gray-streams))
-	     '(:and)
-	     '(:or))
-  (defmethod gray-streams:stream-file-position
-      ((s fundamental-stream) &optional position)
-    (if position
-        (setf (stream-file-position s) position)
-        (stream-file-position s))))
-
-#+allegro
-(progn
-  (defmethod excl:stream-read-sequence
-      ((s fundamental-input-stream) seq &optional start end)
-    (or-fallback (stream-read-sequence s seq (or start 0) (or end (length seq)))))
-
-  (defmethod excl:stream-write-sequence
-      ((s fundamental-output-stream) seq &optional start end)
-    (or-fallback (stream-write-sequence s seq (or start 0) (or end (length seq)))))
-
-  (defmethod excl::stream-file-position
-       ((stream fundamental-stream) &optional position)
-     (if position
-         (setf (stream-file-position stream) position)
-         (stream-file-position stream))))
-
-#+cmu
-(progn
-  (defmethod ext:stream-read-sequence
-      ((s fundamental-input-stream) seq &optional start end)
-    (or-fallback (stream-read-sequence s seq (or start 0) (or end (length seq)))))
-  (defmethod ext:stream-write-sequence
-      ((s fundamental-output-stream) seq &optional start end)
-    (or-fallback (stream-write-sequence s seq (or start 0) (or end (length seq))))))
-
-#+lispworks
-(progn
-  (defmethod stream:stream-read-sequence
-      ((s fundamental-input-stream) seq start end)
-    (or-fallback (stream-read-sequence s seq start end)))
-  (defmethod stream:stream-write-sequence
-      ((s fundamental-output-stream) seq start end)
-    (or-fallback (stream-write-sequence s seq start end)))
-
-  (defmethod stream:stream-file-position ((stream fundamental-stream))
-    (stream-file-position stream))
-  (defmethod (setf stream:stream-file-position)
-      (newval (stream fundamental-stream))
-    (setf (stream-file-position stream) newval)))
-
-#+openmcl
-(progn
-  (defmethod ccl:stream-read-vector
-      ((s fundamental-input-stream) seq start end)
-    (or-fallback (stream-read-sequence s seq start end)))
-  (defmethod ccl:stream-write-vector
-      ((s fundamental-output-stream) seq start end)
-    (or-fallback (stream-write-sequence s seq start end)))
-
-  (defmethod ccl:stream-read-list ((s fundamental-input-stream) list count)
-    (or-fallback (stream-read-sequence s list 0 count)))
-  (defmethod ccl:stream-write-list ((s fundamental-output-stream) list count)
-    (or-fallback (stream-write-sequence s list 0 count)))
-
-  (defmethod ccl::stream-position ((stream fundamental-stream) &optional new-position)
-    (if new-position
-	(setf (stream-file-position stream) new-position)
-	(stream-file-position stream))))
-
-;; up to version 2.43 there were no
-;; stream-read-sequence, stream-write-sequence
-;; functions in CLISP
-#+clisp
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (when (find-symbol (string '#:stream-read-sequence) '#:gray)
-    (pushnew :clisp-has-stream-read/write-sequence *features*)))
-
-#+clisp
-(progn
-
-  #+clisp-has-stream-read/write-sequence
-  (defmethod gray:stream-read-sequence
-      (seq (s fundamental-input-stream) &key start end)
-    (or-fallback (stream-read-sequence s seq (or start 0) (or end (length seq)))))
-
-  #+clisp-has-stream-read/write-sequence
-  (defmethod gray:stream-write-sequence
-      (seq (s fundamental-output-stream) &key start end)
-    (or-fallback (stream-write-sequence s seq (or start 0) (or end (length seq)))))
-
-  ;;; for old CLISP
-  (defmethod gray:stream-read-byte-sequence
-      ((s fundamental-input-stream)
-       seq
-       &optional start end no-hang interactive)
-    (when no-hang
-      (error "this stream does not support the NO-HANG argument"))
-    (when interactive
-      (error "this stream does not support the INTERACTIVE argument"))
-    (or-fallback (stream-read-sequence s seq start end)))
-
-  (defmethod gray:stream-write-byte-sequence
-      ((s fundamental-output-stream)
-       seq
-       &optional start end no-hang interactive)
-    (when no-hang
-      (error "this stream does not support the NO-HANG argument"))
-    (when interactive
-      (error "this stream does not support the INTERACTIVE argument"))
-    (or-fallback (stream-write-sequence s seq start end)))
-
-  (defmethod gray:stream-read-char-sequence
-      ((s fundamental-input-stream) seq &optional start end)
-    (or-fallback (stream-read-sequence s seq start end)))
-
-  (defmethod gray:stream-write-char-sequence
-      ((s fundamental-output-stream) seq &optional start end)
-    (or-fallback (stream-write-sequence s seq start end)))
-
-  ;;; end of old CLISP read/write-sequence support
-
-  (defmethod gray:stream-position ((stream fundamental-stream) position)
-    (if position
-        (setf (stream-file-position stream) position)
-        (stream-file-position stream))))
-
-#+sbcl
-(progn
-  (defmethod sb-gray:stream-read-sequence
-      ((s fundamental-input-stream) seq &optional start end)
-    (or-fallback (stream-read-sequence s seq (or start 0) (or end (length seq)))))
-  (defmethod sb-gray:stream-write-sequence
-      ((s fundamental-output-stream) seq &optional start end)
-    (or-fallback (stream-write-sequence s seq (or start 0) (or end (length seq)))))
-  (defmethod sb-gray:stream-file-position 
-      ((stream fundamental-stream) &optional position)
-    (if position
-        (setf (stream-file-position stream) position)
-        (stream-file-position stream)))
-  ;; SBCL extension:
-  (defmethod sb-gray:stream-line-length ((stream fundamental-stream))
-    80))
-
-#+ecl
-(progn
-  (defmethod gray:stream-read-sequence
-    ((s fundamental-input-stream) seq &optional start end)
-    (or-fallback (stream-read-sequence s seq (or start 0) (or end (length seq)))))
-  (defmethod gray:stream-write-sequence
-    ((s fundamental-output-stream) seq &optional start end)
-    (or-fallback (stream-write-sequence s seq (or start 0) (or end (length seq))))))
-
-#+mocl
-(progn
-  (defmethod gray:stream-read-sequence
-      ((s fundamental-input-stream) seq &optional start end)
-    (or-fallback (stream-read-sequence s seq (or start 0) (or end (length seq)))))
-  (defmethod gray:stream-write-sequence
-      ((s fundamental-output-stream) seq &optional start end)
-    (or-fallback (stream-write-sequence s seq (or start 0) (or end (length seq)))))
-  (defmethod gray:stream-file-position
-      ((stream fundamental-stream) &optional position)
-    (if position
-	(setf (stream-file-position stream) position)
-	(stream-file-position stream))))
-
-;; deprecated
-(defclass trivial-gray-stream-mixin () ())
-