diff --git a/cl-stream.lisp b/cl-stream.lisp
index ced8c3b..6330615 100644
--- a/cl-stream.lisp
+++ b/cl-stream.lisp
@@ -1,6 +1,15 @@
(in-package :cl-stream)
+;#+sbcl ;; duh ??
+;(defmethod sb-mop:compute-slots ((class sb-pcl:system-class))
+; )
+
+;(eval-when (:compile-toplevel :load-toplevel :execute)
+; (closer-mop:add-direct-subclass
+; (find-class 'io-stream)
+; (find-class 'cl:stream)))
+
(defmethod stream-close ((stream cl:stream))
(cl:close stream))
diff --git a/fundamental-character-input-stream.lisp b/fundamental-character-input-stream.lisp
new file mode 100644
index 0000000..74f0cf0
--- /dev/null
+++ b/fundamental-character-input-stream.lisp
@@ -0,0 +1,48 @@
+
+(in-package :cl-stream)
+
+(defmethod stream-close ((stream cl:stream))
+ (cl:close stream)
+ (call-next-method))
+
+(defmethod stream-element-type ((stream cl:stream))
+ (cl:stream-element-type stream))
+
+(defmethod stream-finish ((stream cl:stream))
+ (cl:finish-output stream))
+
+(defmethod stream-open-p ((stream cl:stream))
+ (cl:open-stream-p stream))
+
+(defmethod stream-read ((stream cl:stream))
+ (let ((element-type (cl:stream-element-type stream)))
+ (cond ((subtypep element-type 'unsigned-byte)
+ (let ((byte (cl:read-byte stream nil +eof+)))
+ (if (eq +eof+ byte)
+ (values nil :eof)
+ (values byte nil))))
+ ((subtypep element-type 'character)
+ (let ((char (cl:read-char stream nil +eof+ nil)))
+ (if (eq +eof+ char)
+ (values nil :eof)
+ (values char nil))))
+ (t
+ (error "Unknown stream element type ~S" element-type)))))
+
+(defmethod stream-read-sequence ((stream cl:stream) (seq sequence)
+ &key (start 0) (end (length seq)))
+ (let ((pos (cl:read-sequence seq stream :start start :end end)))
+ (values (- pos start) nil)))
+
+(defmethod stream-write ((stream cl:stream) (element integer))
+ (cl:write-byte element stream)
+ nil)
+
+(defmethod stream-write ((stream cl:stream) (element character))
+ (cl:write-char element stream)
+ nil)
+
+(defmethod stream-write-sequence ((stream cl:stream) (seq sequence)
+ &key (start 0) (end (length seq)))
+ (cl:write-sequence seq stream :start start :end end)
+ (values (- end start) nil))
diff --git a/package.lisp b/package.lisp
index a9025e6..03eff94 100644
--- a/package.lisp
+++ b/package.lisp
@@ -1,5 +1,4 @@
-;;
-;; cl-stream - Stream classes for Common Lisp
+;;;; cl-stream - Stream classes for Common Lisp
;;
;; Copyright 2017,2018 Thomas de Grivel <thoxdg@gmail.com>
;;
@@ -20,8 +19,7 @@
(defpackage :cl-stream
(:nicknames :stream)
- (:use
- :common-lisp)
+ (:use :common-lisp)
(:shadow
#:close
#:input-stream
diff --git a/sequence-output-stream.lisp b/sequence-output-stream.lisp
index 2782ccc..4dcf65f 100644
--- a/sequence-output-stream.lisp
+++ b/sequence-output-stream.lisp
@@ -21,63 +21,27 @@
(defclass sequence-output-stream (buffered-output-stream)
((open-p :initform t
:accessor stream-open-p
- :type boolean))
+ :type boolean)
+ (element-type :initarg :element-type
+ :initform t
+ :reader stream-element-type))
(:documentation "A buffered output stream that writes to a sequence."))
(defgeneric sequence-output-stream-sequence (sequence-output-stream)
(:documentation "Returns the sequence that was written to
SEQUENCE-OUTPUT-STREAM."))
-(defgeneric sequence-output-stream-reset (sequence-output-stream))
+(defgeneric sequence-output-stream-reset (sequence-output-stream)
+ (:documentation "Resets SEQUENCE-OUTPUT-STREAM to an empty
+ sequence."))
-(defmethod sequence-output-stream-sequence ((stream sequence-output-stream))
- (subseq (stream-output-buffer stream) 0 (stream-output-length stream)))
-
-(defmethod sequence-output-stream-reset ((stream sequence-output-stream))
- (setf (stream-output-length stream) 0))
-
-(defmethod initialize-instance ((stream sequence-output-stream)
- &rest initargs
- &key element-type &allow-other-keys)
- (declare (ignore initargs))
- (call-next-method)
- (setf (slot-value stream 'output-buffer)
- (make-array `(,*stream-default-buffer-size*)
- :element-type element-type
- :adjustable t)))
+(defmethod sequence-output-stream-sequence ((stream
+ sequence-output-stream))
+ (subseq (stream-output-buffer stream)
+ 0 (stream-output-length stream)))
(defmethod stream-close ((stream sequence-output-stream))
(setf (stream-open-p stream) nil))
-(defmethod stream-element-type ((stream sequence-output-stream))
- (array-element-type (stream-output-buffer stream)))
-
-(defmethod stream-output-buffer-size ((stream sequence-output-stream))
- (length (stream-output-buffer stream)))
-
(defmethod stream-flush ((stream sequence-output-stream))
nil)
-
-(defmethod stream-flush-output-buffer ((stream sequence-output-stream))
- (setf (slot-value stream 'output-buffer)
- (let ((output-buffer (stream-output-buffer stream)))
- (adjust-array output-buffer
- `(,(+ (length output-buffer)
- *stream-default-buffer-size*)))))
- nil)
-
-(defmacro with-output-to-sequence ((var element-type) &body body)
- "Binds VAR to a new sequence output stream with element-type
-ELEMENT-TYPE. Returns the sequence output stream sequence if
-BODY returns normally. The stream is closed after BODY returns
-normally or before it is aborted by a control transfer of some kind."
- (let ((stream (gensym "STREAM-")))
- `(let ((,stream (make-instance 'sequence-output-stream
- :element-type ,element-type)))
- (unwind-protect (let ((,var ,stream))
- ,@body
- (sequence-output-stream-sequence ,stream))
- (close ,stream)))))
-
-(defmacro with-output-to-string ((var) &body body)
- `(with-output-to-sequence (,var 'string) ,@body))
diff --git a/vector-output-stream.lisp b/vector-output-stream.lisp
new file mode 100644
index 0000000..7605883
--- /dev/null
+++ b/vector-output-stream.lisp
@@ -0,0 +1,55 @@
+;;
+;; cl-stream - Stream classes for Common Lisp
+;;
+;; Copyright 2017,2018 Thomas de Grivel <thoxdg@gmail.com>
+;;
+;; Permission to use, copy, modify, and distribute this software for any
+;; purpose with or without fee is hereby granted, provided that the above
+;; copyright notice and this permission notice appear in all copies.
+;;
+;; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+;; WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+;; MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+;; ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+;; WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+;; ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+;; OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+;;
+
+(in-package :cl-stream)
+
+(defclass vector-output-stream (sequence-output-stream)
+ ())
+
+(defmethod make-stream-output-buffer ((stream vector-output-stream))
+ (make-vector `(,(stream-output-buffer-size stream))
+ :element-type (stream-element-type stream)))
+
+(defmethod stream-flush-output ((stream vector-output-stream))
+ (setf (slot-value stream 'output-buffer)
+ (let* ((output-buffer (stream-output-buffer stream))
+ (length (length output-buffer))
+ (size (stream-output-buffer-size stream))
+ (new-size (+ length size)))
+ (adjust-array output-buffer `(,new-size))))
+ nil)
+
+(defmethod stream-write-element-to-buffer ((stream vector-output-stream)
+ element)
+ (setf (aref (stream-output-buffer stream) (stream-output-length stream))
+ element)
+ (incf (stream-output-length stream))
+ nil)
+
+(defmacro with-output-to-vector ((var &optional (element-type t))
+ &body body)
+ "Binds VAR to a new vector output stream with element-type
+ELEMENT-TYPE. Returns the output vector if BODY returns normally.
+The stream is closed after BODY returns normally or before it is
+aborted by a control transfer of some kind."
+ (let ((stream (gensym "STREAM-")))
+ `(with-stream (,stream (make-instance 'vector-output-stream
+ :element-type ,element-type))
+ (let ((,var ,stream))
+ ,@body
+ (sequence-output-stream-sequence ,stream)))))