From 8eb6f7d3da3960c827b704e23b5a47008274be7d Mon Sep 17 00:00:00 2001 From: William Harold Newman Date: Wed, 31 Oct 2001 19:42:57 +0000 Subject: [PATCH] 0.pre7.75: merged MNA READ-SEQUENCE and WRITE-SEQUENCE patch ("Re: .. horks" sbcl-devel 2001-10-23) renamed LISP-STREAM to ANSI-STREAM renamed lisp-stream.lisp to ansi-stream.lisp renamed ANSI-STREAM-related IN-BUFFER-FOO stuff to ANSI-STREAM-IN-BUFFER-FOO renamed +IN-BUFFER-EXTRA+ to +ANSI-STREAM-IN-BUFFER-EXTRA+ renamed ANSI-STREAM-IN-BUFFER-TYPE to ANSI-STREAM-IN-BUFFER (If you have half a dozen namespaces, why not use them?:-|) --- package-data-list.lisp-expr | 18 +- src/code/ansi-stream.lisp | 119 ++++++++++ src/code/cross-misc.lisp | 8 +- src/code/defboot.lisp | 1 - src/code/defstruct.lisp | 8 +- src/code/early-fasl.lisp | 2 +- src/code/fd-stream.lisp | 6 +- src/code/lisp-stream.lisp | 42 ---- src/code/pprint.lisp | 2 +- src/code/reader.lisp | 8 +- src/code/sharpm.lisp | 2 +- src/code/stream.lisp | 455 ++++++++++++++++++--------------------- src/code/sysmacs.lisp | 38 ++-- src/pcl/cache.lisp | 6 +- src/pcl/gray-streams-class.lisp | 8 +- src/pcl/gray-streams.lisp | 129 +++++++++-- stems-and-flags.lisp-expr | 2 +- tests/gray-streams.impure.lisp | 45 ++-- version.lisp-expr | 2 +- 19 files changed, 523 insertions(+), 378 deletions(-) create mode 100644 src/code/ansi-stream.lisp delete mode 100644 src/code/lisp-stream.lisp diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index f8097d6..0ecf37c 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -628,8 +628,10 @@ Lisp extension proposal by David N. Gray" "STREAM-FRESH-LINE" "STREAM-LINE-COLUMN" "STREAM-LINE-LENGTH" "STREAM-LISTEN" "STREAM-PEEK-CHAR" "STREAM-READ-BYTE" "STREAM-READ-CHAR" "STREAM-READ-CHAR-NO-HANG" "STREAM-READ-LINE" - "STREAM-START-LINE-P" "STREAM-TERPRI" "STREAM-UNREAD-CHAR" - "STREAM-WRITE-BYTE" "STREAM-WRITE-CHAR" "STREAM-WRITE-STRING")) + "STREAM-READ-SEQUENCE" "STREAM-START-LINE-P" "STREAM-TERPRI" + "STREAM-UNREAD-CHAR" + "STREAM-WRITE-BYTE" "STREAM-WRITE-CHAR" "STREAM-WRITE-SEQUENCE" + "STREAM-WRITE-STRING")) #s(sb-cold:package-data :name "SB!INT" @@ -1053,12 +1055,12 @@ is a good idea, but see SB-SYS re. blurring of boundaries." "LAYOUT-DEPTHOID" "LAYOUT-INVALID-ERROR" "LEXENV" "LINE-LENGTH" - "LISP-STREAM" - "LISP-STREAM-BIN" "LISP-STREAM-BOUT" - "LISP-STREAM-IN" "LISP-STREAM-IN-BUFFER" - "LISP-STREAM-IN-INDEX" - "LISP-STREAM-MISC" "LISP-STREAM-N-BIN" - "LISP-STREAM-OUT" "LISP-STREAM-SOUT" + "ANSI-STREAM" + "ANSI-STREAM-BIN" "ANSI-STREAM-BOUT" + "ANSI-STREAM-IN" "ANSI-STREAM-IN-BUFFER" + "ANSI-STREAM-IN-INDEX" + "ANSI-STREAM-MISC" "ANSI-STREAM-N-BIN" + "ANSI-STREAM-OUT" "ANSI-STREAM-SOUT" "LIST-TO-SIMPLE-STRING*" "LIST-TO-BIT-VECTOR*" "LIST-TO-VECTOR*" "LONG-FLOAT-EXPONENT" "LONG-FLOAT-EXP-BITS" diff --git a/src/code/ansi-stream.lisp b/src/code/ansi-stream.lisp new file mode 100644 index 0000000..819cd89 --- /dev/null +++ b/src/code/ansi-stream.lisp @@ -0,0 +1,119 @@ +;;;; the abstract class ANSI-STREAM + +;;;; This software is part of the SBCL system. See the README file for +;;;; more information. +;;;; +;;;; This software is derived from the CMU CL system, which was +;;;; written at Carnegie Mellon University and released into the +;;;; public domain. The software is in the public domain and is +;;;; provided with absolutely no warranty. See the COPYING and CREDITS +;;;; files for more information. + +(in-package "SB!IMPL") + +;;; HOW THE ANSI-STREAM STRUCTURE IS USED +;;; +;;; Many of the slots of the ANSI-STREAM structure contain functions +;;; which are called to perform some operation on the stream. Closed +;;; streams have #'CLOSED-FLAME in all of their function slots. If +;;; one side of an I/O or echo stream is closed, the whole stream is +;;; considered closed. The functions in the operation slots take +;;; arguments as follows: +;;; +;;; In: Stream, Eof-Errorp, Eof-Value +;;; Bin: Stream, Eof-Errorp, Eof-Value +;;; N-Bin: Stream, Buffer, Start, Numbytes, Eof-Errorp +;;; Out: Stream, Character +;;; Bout: Stream, Integer +;;; Sout: Stream, String, Start, End +;;; Misc: Stream, Operation, &Optional Arg1, Arg2 +;;; +;;; In order to save space, some of the less common stream operations +;;; are handled by just one function, the MISC method. This function +;;; is passed a keyword which indicates the operation to perform. +;;; The following keywords are used: +;;; :listen - Return the following values: +;;; t if any input waiting. +;;; :eof if at eof. +;;; nil if no input is available and not at eof. +;;; :unread - Unread the character Arg. +;;; :close - Do any stream specific stuff to close the stream. +;;; The methods are set to closed-flame by the close +;;; function, so that need not be done by this +;;; function. +;;; :clear-input - Clear any unread input +;;; :finish-output, +;;; :force-output - Cause output to happen +;;; :clear-output - Clear any undone output +;;; :element-type - Return the type of element the stream deals with. +;;; :line-length - Return the length of a line of output. +;;; :charpos - Return current output position on the line. +;;; :file-length - Return the file length of a file stream. +;;; :file-position - Return or change the current position of a +;;; file stream. +;;; :file-name - Return the name of an associated file. +;;; :interactive-p - Is this an interactive device? +;;; +;;; In order to do almost anything useful, it is necessary to +;;; define a new type of structure that includes stream, so that the +;;; stream can have some state information. +;;; +;;; THE STREAM IN-BUFFER: +;;; +;;; The IN-BUFFER in the stream holds characters or bytes that +;;; are ready to be read by some input function. If there is any +;;; stuff in the IN-BUFFER, then the reading function can use it +;;; without calling any stream method. Any stream may put stuff in +;;; the IN-BUFFER, and may also assume that any input in the IN-BUFFER +;;; has been consumed before any in-method is called. If a text +;;; stream has in IN-BUFFER, then the first character should not be +;;; used to buffer normal input so that it is free for unreading into. +;;; +;;; When the ANSI-STREAM-IN-BUFFER slot, and its index, is only +;;; accessed by the normal stream functions, the number of function +;;; calls is halved, thus potentially doubling the speed of simple +;;; operations. If the FAST-READ-CHAR and FAST-READ-BYTE macros are +;;; used, nearly all function call overhead is removed, vastly +;;; speeding up these important operations. + +;;; the size of a stream in-buffer +;;; +;;; KLUDGE: The EVAL-WHEN wrapper isn't needed except when using CMU +;;; CL as a cross-compilation host. Without it, cmucl-2.4.19 issues +;;; full WARNINGs (not just STYLE-WARNINGs!) when processing this +;;; file, and when processing other files which use ANSI-STREAM. +;;; -- WHN 2000-12-13 +(eval-when (:compile-toplevel :load-toplevel :execute) + (defconstant +ansi-stream-in-buffer-length+ 512)) + +(deftype ansi-stream-in-buffer () + `(simple-array (unsigned-byte 8) (,+ansi-stream-in-buffer-length+))) + +;;; base class for ANSI standard streams (as opposed to the Gray +;;; streams extension) +(defstruct (ansi-stream (:constructor nil) + (:copier nil)) + + ;; input buffer + ;; + ;; (If a stream does not have an input buffer, then the IN-BUFFER + ;; slot must must be NIL, and the IN-INDEX must be + ;; +ANSI-STREAM-IN-BUFFER-LENGTH+.) + (in-buffer nil :type (or ansi-stream-in-buffer null)) + (in-index +ansi-stream-in-buffer-length+ :type index) + + ;; buffered input functions + (in #'ill-in :type function) ; READ-CHAR function + (bin #'ill-bin :type function) ; byte input function + (n-bin #'ill-bin :type function) ; n-byte input function + + ;; output functions + (out #'ill-out :type function) ; WRITE-CHAR function + (bout #'ill-bout :type function) ; byte output function + (sout #'ill-out :type function) ; string output function + + ;; other, less-used methods + (misc #'do-nothing :type function)) + +(def!method print-object ((x ansi-stream) stream) + (print-unreadable-object (x stream :type t :identity t))) diff --git a/src/code/cross-misc.lisp b/src/code/cross-misc.lisp index 18f7fbb..7a4152e 100644 --- a/src/code/cross-misc.lisp +++ b/src/code/cross-misc.lisp @@ -41,10 +41,10 @@ (defvar *after-gc-hooks* nil) ;;; The GENESIS function works with fasl code which would, in the -;;; target SBCL, work on LISP-STREAMs. A true LISP-STREAM doesn't seem -;;; to be a meaningful concept in ANSI Common Lisp, but we can fake it -;;; acceptably well using a standard STREAM. -(deftype lisp-stream () 'stream) +;;; target SBCL, work on ANSI-STREAMs (streams which aren't extended +;;; Gray streams). In ANSI Common Lisp, an ANSI-STREAM is just a +;;; CL:STREAM. +(deftype ansi-stream () 'stream) ;;; In the target SBCL, the INSTANCE type refers to a base ;;; implementation for compound types. There's no way to express diff --git a/src/code/defboot.lisp b/src/code/defboot.lisp index fb80dc3..08736d3 100644 --- a/src/code/defboot.lisp +++ b/src/code/defboot.lisp @@ -174,7 +174,6 @@ ,@decls (block ,(fun-name-block-name name) ,@forms))) - (want-to-inline ) (inline-lambda (cond (;; Does the user not even want to inline? (not (inline-fun-name-p name)) diff --git a/src/code/defstruct.lisp b/src/code/defstruct.lisp index d19a42c..19ffc14 100644 --- a/src/code/defstruct.lisp +++ b/src/code/defstruct.lisp @@ -1011,8 +1011,8 @@ (class-layout (sb!xc:find-class (or (first superclass-opt) 'structure-object)))))) - (if (eq (dd-name info) 'lisp-stream) - ;; a hack to added the stream class as a mixin for LISP-STREAMs + (if (eq (dd-name info) 'ansi-stream) + ;; a hack to add the CL:STREAM class as a mixin for ANSI-STREAMs (concatenate 'simple-vector (layout-inherits super) (vector super @@ -1306,8 +1306,8 @@ (sb!xc:typep x (sb!xc:find-class class)))) (fdefinition constructor))) (setf (class-direct-superclasses class) - (if (eq (dd-name info) 'lisp-stream) - ;; a hack to add STREAM as a superclass mixin to LISP-STREAMs + (if (eq (dd-name info) 'ansi-stream) + ;; a hack to add CL:STREAM as a superclass mixin to ANSI-STREAMs (list (layout-class (svref inherits (1- (length inherits)))) (layout-class (svref inherits (- (length inherits) 2)))) (list (layout-class (svref inherits (1- (length inherits))))))) diff --git a/src/code/early-fasl.lisp b/src/code/early-fasl.lisp index 22c6625..a0f5c64 100644 --- a/src/code/early-fasl.lisp +++ b/src/code/early-fasl.lisp @@ -134,7 +134,7 @@ ;;; the FASL file we're reading from (defvar *fasl-input-stream*) -(declaim (type lisp-stream *fasl-input-stream*)) +(declaim (type ansi-stream *fasl-input-stream*)) (defvar *load-print* nil #!+sb-doc diff --git a/src/code/fd-stream.lisp b/src/code/fd-stream.lisp index 2bf7810..06c75b4 100644 --- a/src/code/fd-stream.lisp +++ b/src/code/fd-stream.lisp @@ -43,7 +43,7 @@ (defstruct (fd-stream (:constructor %make-fd-stream) - (:include lisp-stream + (:include ansi-stream (misc #'fd-stream-misc-routine)) (:copier nil)) @@ -683,8 +683,8 @@ (when (eql size 1) (setf (fd-stream-n-bin fd-stream) #'fd-stream-read-n-bytes) (when buffer-p - (setf (lisp-stream-in-buffer fd-stream) - (make-array +in-buffer-length+ + (setf (ansi-stream-in-buffer fd-stream) + (make-array +ansi-stream-in-buffer-length+ :element-type '(unsigned-byte 8))))) (setf input-size size) (setf input-type type))) diff --git a/src/code/lisp-stream.lisp b/src/code/lisp-stream.lisp deleted file mode 100644 index f65e0dc..0000000 --- a/src/code/lisp-stream.lisp +++ /dev/null @@ -1,42 +0,0 @@ -;;;; the abstract class LISP-STREAM - -;;;; This software is part of the SBCL system. See the README file for -;;;; more information. -;;;; -;;;; This software is derived from the CMU CL system, which was -;;;; written at Carnegie Mellon University and released into the -;;;; public domain. The software is in the public domain and is -;;;; provided with absolutely no warranty. See the COPYING and CREDITS -;;;; files for more information. - -(in-package "SB!IMPL") - -;;; the size of a stream in-buffer -;;; -;;; KLUDGE: The EVAL-WHEN wrapper isn't needed except when using CMU -;;; CL as a cross-compilation host. Without it, cmucl-2.4.19 issues -;;; full WARNINGs (not just STYLE-WARNINGs!) when processing this -;;; file, and when processing other files which use LISP-STREAM. -;;; -- WHN 2000-12-13 -(eval-when (:compile-toplevel :load-toplevel :execute) - (defconstant +in-buffer-length+ 512)) - -(deftype in-buffer-type () - `(simple-array (unsigned-byte 8) (,+in-buffer-length+))) - -;;; base class for ANSI standard streams (as opposed to the Gray streams -;;; extension) -(defstruct (lisp-stream (:constructor nil) - (:copier nil)) - ;; buffered input - (in-buffer nil :type (or in-buffer-type null)) - (in-index +in-buffer-length+ :type index) ; index into IN-BUFFER - (in #'ill-in :type function) ; READ-CHAR function - (bin #'ill-bin :type function) ; byte input function - (n-bin #'ill-bin :type function) ; n-byte input function - (out #'ill-out :type function) ; WRITE-CHAR function - (bout #'ill-bout :type function) ; byte output function - (sout #'ill-out :type function) ; string output function - (misc #'do-nothing :type function)) ; less-used methods -(def!method print-object ((x lisp-stream) stream) - (print-unreadable-object (x stream :type t :identity t))) diff --git a/src/code/pprint.lisp b/src/code/pprint.lisp index d5ab150..fee0c7f 100644 --- a/src/code/pprint.lisp +++ b/src/code/pprint.lisp @@ -28,7 +28,7 @@ (defconstant default-line-length 80) -(defstruct (pretty-stream (:include sb!kernel:lisp-stream +(defstruct (pretty-stream (:include sb!kernel:ansi-stream (:out #'pretty-out) (:sout #'pretty-sout) (:misc #'pretty-misc)) diff --git a/src/code/reader.lisp b/src/code/reader.lisp index 51df957..d630514 100644 --- a/src/code/reader.lisp +++ b/src/code/reader.lisp @@ -225,7 +225,7 @@ ;; This flushes whitespace chars, returning the last char it read (a ;; non-white one). It always gets an error on end-of-file. (let ((stream (in-synonym-of stream))) - (if (lisp-stream-p stream) + (if (ansi-stream-p stream) (prepare-for-fast-read-char stream (do ((attribute-table (character-attribute-table *readtable*)) (char (fast-read-char t) (fast-read-char t))) @@ -448,7 +448,7 @@ (defun read-comment (stream ignore) (declare (ignore ignore)) (let ((stream (in-synonym-of stream))) - (if (lisp-stream-p stream) + (if (ansi-stream-p stream) (prepare-for-fast-read-char stream (do ((char (fast-read-char nil nil) (fast-read-char nil nil))) @@ -511,7 +511,7 @@ ;; For a very long string, this could end up bloating the read buffer. (reset-read-buffer) (let ((stream (in-synonym-of stream))) - (if (lisp-stream-p stream) + (if (ansi-stream-p stream) (prepare-for-fast-read-char stream (do ((char (fast-read-char t) (fast-read-char t))) ((char= char closech) @@ -879,7 +879,7 @@ (t (go SYMBOL))) SYMBOL ; not a dot, dots, or number (let ((stream (in-synonym-of stream))) - (if (lisp-stream-p stream) + (if (ansi-stream-p stream) (prepare-for-fast-read-char stream (prog () SYMBOL-LOOP diff --git a/src/code/sharpm.lisp b/src/code/sharpm.lisp index e03e1a3..f0a1168 100644 --- a/src/code/sharpm.lisp +++ b/src/code/sharpm.lisp @@ -313,7 +313,7 @@ (defun sharp-vertical-bar (stream sub-char numarg) (ignore-numarg sub-char numarg) (let ((stream (in-synonym-of stream))) - (if (lisp-stream-p stream) + (if (ansi-stream-p stream) (prepare-for-fast-read-char stream (do ((level 1) (prev (fast-read-char) char) diff --git a/src/code/stream.lisp b/src/code/stream.lisp index 3652f87..19cde5e 100644 --- a/src/code/stream.lisp +++ b/src/code/stream.lisp @@ -61,80 +61,6 @@ (defun do-nothing (&rest ignore) (declare (ignore ignore))) -;;; HOW THE STREAM STRUCTURE IS USED: -;;; -;;; Many of the slots of the stream structure contain functions -;;; which are called to perform some operation on the stream. Closed -;;; streams have #'CLOSED-FLAME in all of their function slots. If -;;; one side of an I/O or echo stream is closed, the whole stream is -;;; considered closed. The functions in the operation slots take -;;; arguments as follows: -;;; -;;; In: Stream, Eof-Errorp, Eof-Value -;;; Bin: Stream, Eof-Errorp, Eof-Value -;;; N-Bin: Stream, Buffer, Start, Numbytes, Eof-Errorp -;;; Out: Stream, Character -;;; Bout: Stream, Integer -;;; Sout: Stream, String, Start, End -;;; Misc: Stream, Operation, &Optional Arg1, Arg2 -;;; -;;; In order to save space, some of the less common stream operations -;;; are handled by just one function, the MISC method. This function -;;; is passed a keyword which indicates the operation to perform. -;;; The following keywords are used: -;;; :listen - Return the following values: -;;; t if any input waiting. -;;; :eof if at eof. -;;; nil if no input is available and not at eof. -;;; :unread - Unread the character Arg. -;;; :close - Do any stream specific stuff to close the stream. -;;; The methods are set to closed-flame by the close -;;; function, so that need not be done by this -;;; function. -;;; :clear-input - Clear any unread input -;;; :finish-output, -;;; :force-output - Cause output to happen -;;; :clear-output - Clear any undone output -;;; :element-type - Return the type of element the stream deals with. -;;; :line-length - Return the length of a line of output. -;;; :charpos - Return current output position on the line. -;;; :file-length - Return the file length of a file stream. -;;; :file-position - Return or change the current position of a -;;; file stream. -;;; :file-name - Return the name of an associated file. -;;; :interactive-p - Is this an interactive device? -;;; -;;; In order to do almost anything useful, it is necessary to -;;; define a new type of structure that includes stream, so that the -;;; stream can have some state information. -;;; -;;; THE STREAM IN-BUFFER: -;;; -;;; The IN-BUFFER in the stream holds characters or bytes that -;;; are ready to be read by some input function. If there is any -;;; stuff in the IN-BUFFER, then the reading function can use it -;;; without calling any stream method. Any stream may put stuff in -;;; the IN-BUFFER, and may also assume that any input in the IN-BUFFER -;;; has been consumed before any in-method is called. If a text -;;; stream has in IN-BUFFER, then the first character should not be -;;; used to buffer normal input so that it is free for unreading into. -;;; -;;; The IN-BUFFER slot is a vector +IN-BUFFER-LENGTH+ long. The -;;; IN-INDEX is the index in the IN-BUFFER of the first available -;;; object. The available objects are thus between IN-INDEX and the -;;; length of the IN-BUFFER. -;;; -;;; When this buffer is only accessed by the normal stream -;;; functions, the number of function calls is halved, thus -;;; potentially doubling the speed of simple operations. If the -;;; FAST-READ-CHAR and FAST-READ-BYTE macros are used, nearly all -;;; function call overhead is removed, vastly speeding up these -;;; important operations. -;;; -;;; If a stream does not have an IN-BUFFER, then the IN-BUFFER slot -;;; must be nil, and the IN-INDEX must be +IN-BUFFER-LENGTH+. These are -;;; the default values for the slots. - ;;; stream manipulation functions (defun input-stream-p (stream) @@ -145,14 +71,14 @@ (setf stream (symbol-value (synonym-stream-symbol stream)))) - (and (lisp-stream-p stream) - (not (eq (lisp-stream-in stream) #'closed-flame)) + (and (ansi-stream-p stream) + (not (eq (ansi-stream-in stream) #'closed-flame)) ;;; KLUDGE: It's probably not good to have EQ tests on function ;;; values like this. What if someone's redefined the function? ;;; Is there a better way? (Perhaps just VALID-FOR-INPUT and ;;; VALID-FOR-OUTPUT flags? -- WHN 19990902 - (or (not (eq (lisp-stream-in stream) #'ill-in)) - (not (eq (lisp-stream-bin stream) #'ill-bin))))) + (or (not (eq (ansi-stream-in stream) #'ill-in)) + (not (eq (ansi-stream-bin stream) #'ill-bin))))) (defun output-stream-p (stream) (declare (type stream stream)) @@ -162,38 +88,38 @@ (setf stream (symbol-value (synonym-stream-symbol stream)))) - (and (lisp-stream-p stream) - (not (eq (lisp-stream-in stream) #'closed-flame)) - (or (not (eq (lisp-stream-out stream) #'ill-out)) - (not (eq (lisp-stream-bout stream) #'ill-bout))))) + (and (ansi-stream-p stream) + (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))))) (defun open-stream-p (stream) (declare (type stream stream)) - (not (eq (lisp-stream-in stream) #'closed-flame))) + (not (eq (ansi-stream-in stream) #'closed-flame))) (defun stream-element-type (stream) (declare (type stream stream)) - (funcall (lisp-stream-misc stream) stream :element-type)) + (funcall (ansi-stream-misc stream) stream :element-type)) (defun interactive-stream-p (stream) (declare (type stream stream)) - (funcall (lisp-stream-misc stream) stream :interactive-p)) + (funcall (ansi-stream-misc stream) stream :interactive-p)) (defun close (stream &key abort) (declare (type stream stream)) (when (open-stream-p stream) - (funcall (lisp-stream-misc stream) stream :close abort)) + (funcall (ansi-stream-misc stream) stream :close abort)) t) (defun set-closed-flame (stream) - (setf (lisp-stream-in stream) #'closed-flame) - (setf (lisp-stream-bin stream) #'closed-flame) - (setf (lisp-stream-n-bin stream) #'closed-flame) - (setf (lisp-stream-in stream) #'closed-flame) - (setf (lisp-stream-out stream) #'closed-flame) - (setf (lisp-stream-bout stream) #'closed-flame) - (setf (lisp-stream-sout stream) #'closed-flame) - (setf (lisp-stream-misc stream) #'closed-flame)) + (setf (ansi-stream-in stream) #'closed-flame) + (setf (ansi-stream-bin stream) #'closed-flame) + (setf (ansi-stream-n-bin stream) #'closed-flame) + (setf (ansi-stream-in stream) #'closed-flame) + (setf (ansi-stream-out stream) #'closed-flame) + (setf (ansi-stream-bout stream) #'closed-flame) + (setf (ansi-stream-sout stream) #'closed-flame) + (setf (ansi-stream-misc stream) #'closed-flame)) ;;;; file position and file length @@ -203,12 +129,14 @@ (declare (type (or index (member nil :start :end)) position)) (cond (position - (setf (lisp-stream-in-index stream) +in-buffer-length+) - (funcall (lisp-stream-misc stream) stream :file-position position)) + (setf (ansi-stream-in-index stream) +ansi-stream-in-buffer-length+) + (funcall (ansi-stream-misc stream) stream :file-position position)) (t - (let ((res (funcall (lisp-stream-misc stream) stream :file-position nil))) + (let ((res (funcall (ansi-stream-misc stream) stream :file-position nil))) (when res - (- res (- +in-buffer-length+ (lisp-stream-in-index stream)))))))) + (- res + (- +ansi-stream-in-buffer-length+ + (ansi-stream-in-index stream)))))))) ;;; This is a literal translation of the ANSI glossary entry "stream ;;; associated with a file". @@ -246,7 +174,7 @@ (defun file-length (stream) (declare (type (or file-stream synonym-stream) stream)) (stream-must-be-associated-with-file stream) - (funcall (lisp-stream-misc stream) stream :file-length)) + (funcall (ansi-stream-misc stream) stream :file-length)) ;;;; input functions @@ -254,7 +182,7 @@ recursive-p) (declare (ignore recursive-p)) (let ((stream (in-synonym-of stream))) - (if (lisp-stream-p stream) + (if (ansi-stream-p stream) (prepare-for-fast-read-char stream (let ((res (make-string 80)) (len 80) @@ -299,7 +227,7 @@ recursive-p) (declare (ignore recursive-p)) (let ((stream (in-synonym-of stream))) - (if (lisp-stream-p stream) + (if (ansi-stream-p stream) (prepare-for-fast-read-char stream (prog1 (fast-read-char eof-error-p eof-value) @@ -312,16 +240,16 @@ (defun unread-char (character &optional (stream *standard-input*)) (let ((stream (in-synonym-of stream))) - (if (lisp-stream-p stream) - (let ((index (1- (lisp-stream-in-index stream))) - (buffer (lisp-stream-in-buffer stream))) + (if (ansi-stream-p stream) + (let ((index (1- (ansi-stream-in-index stream))) + (buffer (ansi-stream-in-buffer stream))) (declare (fixnum index)) (when (minusp index) (error "nothing to unread")) (cond (buffer (setf (aref buffer index) (char-code character)) - (setf (lisp-stream-in-index stream) index)) + (setf (ansi-stream-in-index stream) index)) (t - (funcall (lisp-stream-misc stream) stream + (funcall (ansi-stream-misc stream) stream :unread character)))) ;; must be Gray streams FUNDAMENTAL-STREAM (stream-unread-char stream character))) @@ -345,7 +273,7 @@ :format-control "~@" :format-arguments (list peek-type '(or character boolean)))) (let ((stream (in-synonym-of stream))) - (if (lisp-stream-p stream) + (if (ansi-stream-p stream) (let ((char (read-char stream eof-error-p eof-value))) (cond ((eq char eof-value) char) ((characterp peek-type) @@ -394,10 +322,11 @@ (defun listen (&optional (stream *standard-input*)) (let ((stream (in-synonym-of stream))) - (if (lisp-stream-p stream) - (or (/= (the fixnum (lisp-stream-in-index stream)) +in-buffer-length+) + (if (ansi-stream-p stream) + (or (/= (the fixnum (ansi-stream-in-index stream)) + +ansi-stream-in-buffer-length+) ;; Test for T explicitly since misc methods return :EOF sometimes. - (eq (funcall (lisp-stream-misc stream) stream :listen) t)) + (eq (funcall (ansi-stream-misc stream) stream :listen) t)) ;; Fall through to Gray streams FUNDAMENTAL-STREAM case. (stream-listen stream)))) @@ -407,8 +336,8 @@ recursive-p) (declare (ignore recursive-p)) (let ((stream (in-synonym-of stream))) - (if (lisp-stream-p stream) - (if (funcall (lisp-stream-misc stream) stream :listen) + (if (ansi-stream-p stream) + (if (funcall (ansi-stream-misc stream) stream :listen) ;; On T or :EOF get READ-CHAR to do the work. (read-char stream eof-error-p eof-value) nil) @@ -420,9 +349,9 @@ (defun clear-input (&optional (stream *standard-input*)) (let ((stream (in-synonym-of stream))) - (cond ((lisp-stream-p stream) - (setf (lisp-stream-in-index stream) +in-buffer-length+) - (funcall (lisp-stream-misc stream) stream :clear-input)) + (cond ((ansi-stream-p stream) + (setf (ansi-stream-in-index stream) +ansi-stream-in-buffer-length+) + (funcall (ansi-stream-misc stream) stream :clear-input)) (t (stream-clear-input stream)))) nil) @@ -430,7 +359,7 @@ (declaim (maybe-inline read-byte)) (defun read-byte (stream &optional (eof-error-p t) eof-value) (let ((stream (in-synonym-of stream))) - (if (lisp-stream-p stream) + (if (ansi-stream-p stream) (prepare-for-fast-read-byte stream (prog1 (fast-read-byte eof-error-p eof-value t) @@ -452,17 +381,17 @@ ;;; If we ever need it, it could be added later as a new variant N-BIN ;;; method (perhaps N-BIN-ASAP?) or something. (defun read-n-bytes (stream buffer start numbytes &optional (eof-error-p t)) - (declare (type lisp-stream stream) + (declare (type ansi-stream stream) (type index numbytes start) (type (or (simple-array * (*)) system-area-pointer) buffer)) - (let* ((stream (in-synonym-of stream lisp-stream)) - (in-buffer (lisp-stream-in-buffer stream)) - (index (lisp-stream-in-index stream)) - (num-buffered (- +in-buffer-length+ index))) + (let* ((stream (in-synonym-of stream ansi-stream)) + (in-buffer (ansi-stream-in-buffer stream)) + (index (ansi-stream-in-index stream)) + (num-buffered (- +ansi-stream-in-buffer-length+ index))) (declare (fixnum index num-buffered)) (cond ((not in-buffer) - (funcall (lisp-stream-n-bin stream) + (funcall (ansi-stream-n-bin stream) stream buffer start @@ -471,13 +400,13 @@ ((<= numbytes num-buffered) (%byte-blt in-buffer index buffer start (+ start numbytes)) - (setf (lisp-stream-in-index stream) (+ index numbytes)) + (setf (ansi-stream-in-index stream) (+ index numbytes)) numbytes) (t (let ((end (+ start num-buffered))) (%byte-blt in-buffer index buffer start end) - (setf (lisp-stream-in-index stream) +in-buffer-length+) - (+ (funcall (lisp-stream-n-bin stream) + (setf (ansi-stream-in-index stream) +ansi-stream-in-buffer-length+) + (+ (funcall (ansi-stream-n-bin stream) stream buffer end @@ -489,48 +418,51 @@ ;;; unreading ;;; ;;; (It's 4 instead of 1 to allow word-aligned copies.) -(defconstant +in-buffer-extra+ 4) ; FIXME: should be symbolic constant +(defconstant +ansi-stream-in-buffer-extra+ + 4) ; FIXME: should be symbolic constant ;;; This function is called by the FAST-READ-CHAR expansion to refill ;;; the IN-BUFFER for text streams. There is definitely an IN-BUFFER, ;;; and hence must be an N-BIN method. (defun fast-read-char-refill (stream eof-error-p eof-value) - (let* ((ibuf (lisp-stream-in-buffer stream)) - (count (funcall (lisp-stream-n-bin stream) + (let* ((ibuf (ansi-stream-in-buffer stream)) + (count (funcall (ansi-stream-n-bin stream) stream ibuf - +in-buffer-extra+ - (- +in-buffer-length+ +in-buffer-extra+) + +ansi-stream-in-buffer-extra+ + (- +ansi-stream-in-buffer-length+ + +ansi-stream-in-buffer-extra+) nil)) - (start (- +in-buffer-length+ count))) + (start (- +ansi-stream-in-buffer-length+ count))) (declare (type index start count)) (cond ((zerop count) - (setf (lisp-stream-in-index stream) +in-buffer-length+) - (funcall (lisp-stream-in stream) stream eof-error-p eof-value)) + (setf (ansi-stream-in-index stream) +ansi-stream-in-buffer-length+) + (funcall (ansi-stream-in stream) stream eof-error-p eof-value)) (t - (when (/= start +in-buffer-extra+) - (bit-bash-copy ibuf (+ (* +in-buffer-extra+ sb!vm:n-byte-bits) + (when (/= start +ansi-stream-in-buffer-extra+) + (bit-bash-copy ibuf (+ (* +ansi-stream-in-buffer-extra+ + sb!vm:n-byte-bits) (* sb!vm:vector-data-offset sb!vm:n-word-bits)) ibuf (+ (the index (* start sb!vm:n-byte-bits)) (* sb!vm:vector-data-offset sb!vm:n-word-bits)) (* count sb!vm:n-byte-bits))) - (setf (lisp-stream-in-index stream) (1+ start)) + (setf (ansi-stream-in-index stream) (1+ start)) (code-char (aref ibuf start)))))) ;;; This is similar to FAST-READ-CHAR-REFILL, but we don't have to ;;; leave room for unreading. (defun fast-read-byte-refill (stream eof-error-p eof-value) - (let* ((ibuf (lisp-stream-in-buffer stream)) - (count (funcall (lisp-stream-n-bin stream) stream - ibuf 0 +in-buffer-length+ + (let* ((ibuf (ansi-stream-in-buffer stream)) + (count (funcall (ansi-stream-n-bin stream) stream + ibuf 0 +ansi-stream-in-buffer-length+ nil)) - (start (- +in-buffer-length+ count))) + (start (- +ansi-stream-in-buffer-length+ count))) (declare (type index start count)) (cond ((zerop count) - (setf (lisp-stream-in-index stream) +in-buffer-length+) - (funcall (lisp-stream-bin stream) stream eof-error-p eof-value)) + (setf (ansi-stream-in-index stream) +ansi-stream-in-buffer-length+) + (funcall (ansi-stream-bin stream) stream eof-error-p eof-value)) (t (unless (zerop start) (bit-bash-copy ibuf (* sb!vm:vector-data-offset sb!vm:n-word-bits) @@ -538,25 +470,25 @@ (* sb!vm:vector-data-offset sb!vm:n-word-bits)) (* count sb!vm:n-byte-bits))) - (setf (lisp-stream-in-index stream) (1+ start)) + (setf (ansi-stream-in-index stream) (1+ start)) (aref ibuf start))))) ;;; output functions (defun write-char (character &optional (stream *standard-output*)) - (with-out-stream stream (lisp-stream-out character) + (with-out-stream stream (ansi-stream-out character) (stream-write-char character)) character) (defun terpri (&optional (stream *standard-output*)) - (with-out-stream stream (lisp-stream-out #\newline) (stream-terpri)) + (with-out-stream stream (ansi-stream-out #\newline) (stream-terpri)) nil) (defun fresh-line (&optional (stream *standard-output*)) (let ((stream (out-synonym-of stream))) - (if (lisp-stream-p stream) + (if (ansi-stream-p stream) (when (/= (or (charpos stream) 1) 0) - (funcall (lisp-stream-out stream) stream #\newline) + (funcall (ansi-stream-out stream) stream #\newline) t) ;; must be Gray streams FUNDAMENTAL-STREAM (stream-fresh-line stream)))) @@ -586,13 +518,13 @@ string)) (let ((stream (out-synonym-of stream))) - (cond ((lisp-stream-p stream) + (cond ((ansi-stream-p stream) (if (array-header-p string) (with-array-data ((data string) (offset-start start) (offset-end end)) - (funcall (lisp-stream-sout stream) + (funcall (ansi-stream-sout stream) stream data offset-start offset-end)) - (funcall (lisp-stream-sout stream) stream string start end)) + (funcall (ansi-stream-sout stream) stream string start end)) string) (t ; must be Gray streams FUNDAMENTAL-STREAM (stream-write-string stream string start end))))) @@ -606,33 +538,33 @@ string) (defun charpos (&optional (stream *standard-output*)) - (with-out-stream stream (lisp-stream-misc :charpos) (stream-line-column))) + (with-out-stream stream (ansi-stream-misc :charpos) (stream-line-column))) (defun line-length (&optional (stream *standard-output*)) - (with-out-stream stream (lisp-stream-misc :line-length) + (with-out-stream stream (ansi-stream-misc :line-length) (stream-line-length))) (defun finish-output (&optional (stream *standard-output*)) - (with-out-stream stream (lisp-stream-misc :finish-output) + (with-out-stream stream (ansi-stream-misc :finish-output) (stream-finish-output)) nil) (defun force-output (&optional (stream *standard-output*)) - (with-out-stream stream (lisp-stream-misc :force-output) + (with-out-stream stream (ansi-stream-misc :force-output) (stream-force-output)) nil) (defun clear-output (&optional (stream *standard-output*)) - (with-out-stream stream (lisp-stream-misc :clear-output) + (with-out-stream stream (ansi-stream-misc :clear-output) (stream-force-output)) nil) (defun write-byte (integer stream) - (with-out-stream stream (lisp-stream-bout integer) + (with-out-stream stream (ansi-stream-bout integer) (stream-write-byte integer)) integer) -;;; This is called from LISP-STREAM routines that encapsulate CLOS +;;; This is called from ANSI-STREAM routines that encapsulate CLOS ;;; streams to handle the misc routines and dispatch to the ;;; appropriate Gray stream functions. (defun stream-misc-dispatch (stream operation &optional arg1 arg2) @@ -670,7 +602,7 @@ ;;;; broadcast streams -(defstruct (broadcast-stream (:include lisp-stream +(defstruct (broadcast-stream (:include ansi-stream (out #'broadcast-out) (bout #'broadcast-bout) (sout #'broadcast-sout) @@ -699,12 +631,12 @@ (macrolet ((out-fun (fun method stream-method &rest args) `(defun ,fun (stream ,@args) (dolist (stream (broadcast-stream-streams stream)) - (if (lisp-stream-p stream) + (if (ansi-stream-p stream) (funcall (,method stream) stream ,@args) (,stream-method stream ,@args)))))) - (out-fun broadcast-out lisp-stream-out stream-write-char char) - (out-fun broadcast-bout lisp-stream-bout stream-write-byte byte) - (out-fun broadcast-sout lisp-stream-sout stream-write-string + (out-fun broadcast-out ansi-stream-out stream-write-char char) + (out-fun broadcast-bout ansi-stream-bout stream-write-byte byte) + (out-fun broadcast-sout ansi-stream-sout stream-write-string string start end)) (defun broadcast-misc (stream operation &optional arg1 arg2) @@ -728,14 +660,14 @@ (let ((res nil)) (dolist (stream streams res) (setq res - (if (lisp-stream-p stream) - (funcall (lisp-stream-misc stream) stream operation + (if (ansi-stream-p stream) + (funcall (ansi-stream-misc stream) stream operation arg1 arg2) (stream-misc-dispatch stream operation arg1 arg2))))))))) ;;;; synonym streams -(defstruct (synonym-stream (:include lisp-stream +(defstruct (synonym-stream (:include ansi-stream (in #'synonym-in) (bin #'synonym-bin) (n-bin #'synonym-n-bin) @@ -757,12 +689,12 @@ `(defun ,name (stream ,@args) (declare (optimize (safety 1))) (let ((syn (symbol-value (synonym-stream-symbol stream)))) - (if (lisp-stream-p syn) + (if (ansi-stream-p syn) (funcall (,slot syn) syn ,@args) (,stream-method syn ,@args)))))) - (out-fun synonym-out lisp-stream-out stream-write-char ch) - (out-fun synonym-bout lisp-stream-bout stream-write-byte n) - (out-fun synonym-sout lisp-stream-sout stream-write-string string start end)) + (out-fun synonym-out ansi-stream-out stream-write-char ch) + (out-fun synonym-bout ansi-stream-bout stream-write-byte n) + (out-fun synonym-sout ansi-stream-sout stream-write-string string start end)) ;;; For the input methods, we just call the corresponding function on the ;;; synonymed stream. These functions deal with getting input out of @@ -779,24 +711,24 @@ (defun synonym-misc (stream operation &optional arg1 arg2) (declare (optimize (safety 1))) (let ((syn (symbol-value (synonym-stream-symbol stream)))) - (if (lisp-stream-p syn) + (if (ansi-stream-p syn) ;; We have to special-case some operations which interact with ;; the in-buffer of the wrapped stream, since just calling - ;; LISP-STREAM-MISC on them + ;; ANSI-STREAM-MISC on them (case operation - (:listen (or (/= (the fixnum (lisp-stream-in-index syn)) - +in-buffer-length+) - (funcall (lisp-stream-misc syn) syn :listen))) + (:listen (or (/= (the fixnum (ansi-stream-in-index syn)) + +ansi-stream-in-buffer-length+) + (funcall (ansi-stream-misc syn) syn :listen))) (:clear-input (clear-input syn)) (:unread (unread-char arg1 syn)) (t - (funcall (lisp-stream-misc syn) syn operation arg1 arg2))) + (funcall (ansi-stream-misc syn) syn operation arg1 arg2))) (stream-misc-dispatch syn operation arg1 arg2)))) ;;;; two-way streams (defstruct (two-way-stream - (:include lisp-stream + (:include ansi-stream (in #'two-way-in) (bin #'two-way-bin) (n-bin #'two-way-n-bin) @@ -844,12 +776,12 @@ (macrolet ((out-fun (name slot stream-method &rest args) `(defun ,name (stream ,@args) (let ((syn (two-way-stream-output-stream stream))) - (if (lisp-stream-p syn) + (if (ansi-stream-p syn) (funcall (,slot syn) syn ,@args) (,stream-method syn ,@args)))))) - (out-fun two-way-out lisp-stream-out stream-write-char ch) - (out-fun two-way-bout lisp-stream-bout stream-write-byte n) - (out-fun two-way-sout lisp-stream-sout stream-write-string string start end)) + (out-fun two-way-out ansi-stream-out stream-write-char ch) + (out-fun two-way-bout ansi-stream-bout stream-write-byte n) + (out-fun two-way-sout ansi-stream-sout stream-write-string string start end)) (macrolet ((in-fun (name fun &rest args) `(defun ,name (stream ,@args) @@ -862,17 +794,18 @@ (defun two-way-misc (stream operation &optional arg1 arg2) (let* ((in (two-way-stream-input-stream stream)) (out (two-way-stream-output-stream stream)) - (in-lisp-stream-p (lisp-stream-p in)) - (out-lisp-stream-p (lisp-stream-p out))) + (in-ansi-stream-p (ansi-stream-p in)) + (out-ansi-stream-p (ansi-stream-p out))) (case operation (:listen - (if in-lisp-stream-p - (or (/= (the fixnum (lisp-stream-in-index in)) +in-buffer-length+) - (funcall (lisp-stream-misc in) in :listen)) + (if in-ansi-stream-p + (or (/= (the fixnum (ansi-stream-in-index in)) + +ansi-stream-in-buffer-length+) + (funcall (ansi-stream-misc in) in :listen)) (stream-listen in))) ((:finish-output :force-output :clear-output) - (if out-lisp-stream-p - (funcall (lisp-stream-misc out) out operation arg1 arg2) + (if out-ansi-stream-p + (funcall (ansi-stream-misc out) out operation arg1 arg2) (stream-misc-dispatch out operation arg1 arg2))) (:clear-input (clear-input in)) (:unread (unread-char arg1 in)) @@ -884,17 +817,17 @@ (:close (set-closed-flame stream)) (t - (or (if in-lisp-stream-p - (funcall (lisp-stream-misc in) in operation arg1 arg2) + (or (if in-ansi-stream-p + (funcall (ansi-stream-misc in) in operation arg1 arg2) (stream-misc-dispatch in operation arg1 arg2)) - (if out-lisp-stream-p - (funcall (lisp-stream-misc out) out operation arg1 arg2) + (if out-ansi-stream-p + (funcall (ansi-stream-misc out) out operation arg1 arg2) (stream-misc-dispatch out operation arg1 arg2))))))) ;;;; concatenated streams (defstruct (concatenated-stream - (:include lisp-stream + (:include ansi-stream (in #'concatenated-in) (bin #'concatenated-bin) (n-bin #'concatenated-n-bin) @@ -977,8 +910,8 @@ (case operation (:listen (loop - (let ((stuff (if (lisp-stream-p current) - (funcall (lisp-stream-misc current) current + (let ((stuff (if (ansi-stream-p current) + (funcall (ansi-stream-misc current) current :listen) (stream-misc-dispatch current :listen)))) (cond ((eq stuff :eof) @@ -1000,8 +933,8 @@ (:close (set-closed-flame stream)) (t - (if (lisp-stream-p current) - (funcall (lisp-stream-misc current) current operation arg1 arg2) + (if (ansi-stream-p current) + (funcall (ansi-stream-misc current) current operation arg1 arg2) (stream-misc-dispatch current operation arg1 arg2)))))))) ;;;; echo streams @@ -1028,13 +961,13 @@ (let* ((in (echo-stream-input-stream stream)) (out (echo-stream-output-stream stream)) (result (,fun in ,@args))) - (if (lisp-stream-p out) + (if (ansi-stream-p out) (funcall (,out-slot out) out result) (,stream-method out result)) result))))) - (in-fun echo-in read-char lisp-stream-out stream-write-char + (in-fun echo-in read-char ansi-stream-out stream-write-char eof-error-p eof-value) - (in-fun echo-bin read-byte lisp-stream-bout stream-write-byte + (in-fun echo-bin read-byte ansi-stream-bout stream-write-byte eof-error-p eof-value)) (defun echo-misc (stream operation &optional arg1 arg2) @@ -1043,10 +976,10 @@ (case operation (:listen (or (not (null (echo-stream-unread-stuff stream))) - (if (lisp-stream-p in) - (or (/= (the fixnum (lisp-stream-in-index in)) - +in-buffer-length+) - (funcall (lisp-stream-misc in) in :listen)) + (if (ansi-stream-p in) + (or (/= (the fixnum (ansi-stream-in-index in)) + +ansi-stream-in-buffer-length+) + (funcall (ansi-stream-misc in) in :listen)) (stream-misc-dispatch in :listen)))) (:unread (push arg1 (echo-stream-unread-stuff stream))) (:element-type @@ -1057,11 +990,11 @@ (:close (set-closed-flame stream)) (t - (or (if (lisp-stream-p in) - (funcall (lisp-stream-misc in) in operation arg1 arg2) + (or (if (ansi-stream-p in) + (funcall (ansi-stream-misc in) in operation arg1 arg2) (stream-misc-dispatch in operation arg1 arg2)) - (if (lisp-stream-p out) - (funcall (lisp-stream-misc out) out operation arg1 arg2) + (if (ansi-stream-p out) + (funcall (ansi-stream-misc out) out operation arg1 arg2) (stream-misc-dispatch out operation arg1 arg2))))))) #!+sb-doc @@ -1073,7 +1006,7 @@ ;;;; string input streams (defstruct (string-input-stream - (:include lisp-stream + (:include ansi-stream (in #'string-inch) (bin #'string-binch) (n-bin #'string-stream-read-n-bytes) @@ -1165,7 +1098,7 @@ ;;;; string output streams (defstruct (string-output-stream - (:include lisp-stream + (:include ansi-stream (out #'string-ouch) (sout #'string-sout) (misc #'string-out-misc)) @@ -1257,7 +1190,7 @@ ;;; WITH-OUTPUT-TO-STRING. (defstruct (fill-pointer-output-stream - (:include lisp-stream + (:include ansi-stream (out #'fill-pointer-ouch) (sout #'fill-pointer-sout) (misc #'fill-pointer-misc)) @@ -1339,7 +1272,7 @@ ;;;; indenting streams -(defstruct (indenting-stream (:include lisp-stream +(defstruct (indenting-stream (:include ansi-stream (out #'indenting-out) (sout #'indenting-sout) (misc #'indenting-misc)) @@ -1394,8 +1327,8 @@ ;;; the base stream minus the stream's indentation. (defun indenting-misc (stream operation &optional arg1 arg2) (let ((sub-stream (indenting-stream-stream stream))) - (if (lisp-stream-p sub-stream) - (let ((method (lisp-stream-misc sub-stream))) + (if (ansi-stream-p sub-stream) + (let ((method (ansi-stream-misc sub-stream))) (case operation (:line-length (let ((line-length (funcall method sub-stream operation))) @@ -1425,7 +1358,7 @@ ;;;; case frobbing streams, used by FORMAT ~(...~) (defstruct (case-frob-stream - (:include lisp-stream + (:include ansi-stream (:misc #'case-frob-misc)) (:constructor %make-case-frob-stream (target out sout)) (:copier nil)) @@ -1472,8 +1405,8 @@ (:close) (t (let ((target (case-frob-stream-target stream))) - (if (lisp-stream-p target) - (funcall (lisp-stream-misc target) target op arg1 arg2) + (if (ansi-stream-p target) + (funcall (ansi-stream-misc target) target op arg1 arg2) (stream-misc-dispatch target op arg1 arg2)))))) (defun case-frob-upcase-out (stream char) @@ -1481,8 +1414,8 @@ (type base-char char)) (let ((target (case-frob-stream-target stream)) (char (char-upcase char))) - (if (lisp-stream-p target) - (funcall (lisp-stream-out target) target char) + (if (ansi-stream-p target) + (funcall (ansi-stream-out target) target char) (stream-write-char target char)))) (defun case-frob-upcase-sout (stream str start end) @@ -1497,8 +1430,8 @@ (string-upcase str) (nstring-upcase (subseq str start end)))) (string-len (- end start))) - (if (lisp-stream-p target) - (funcall (lisp-stream-sout target) target string 0 string-len) + (if (ansi-stream-p target) + (funcall (ansi-stream-sout target) target string 0 string-len) (stream-write-string target string 0 string-len)))) (defun case-frob-downcase-out (stream char) @@ -1506,8 +1439,8 @@ (type base-char char)) (let ((target (case-frob-stream-target stream)) (char (char-downcase char))) - (if (lisp-stream-p target) - (funcall (lisp-stream-out target) target char) + (if (ansi-stream-p target) + (funcall (ansi-stream-out target) target char) (stream-write-char target char)))) (defun case-frob-downcase-sout (stream str start end) @@ -1522,8 +1455,8 @@ (string-downcase str) (nstring-downcase (subseq str start end)))) (string-len (- end start))) - (if (lisp-stream-p target) - (funcall (lisp-stream-sout target) target string 0 string-len) + (if (ansi-stream-p target) + (funcall (ansi-stream-sout target) target string 0 string-len) (stream-write-string target string 0 string-len)))) (defun case-frob-capitalize-out (stream char) @@ -1532,15 +1465,15 @@ (let ((target (case-frob-stream-target stream))) (cond ((alphanumericp char) (let ((char (char-upcase char))) - (if (lisp-stream-p target) - (funcall (lisp-stream-out target) target char) + (if (ansi-stream-p target) + (funcall (ansi-stream-out target) target char) (stream-write-char target char))) (setf (case-frob-stream-out stream) #'case-frob-capitalize-aux-out) (setf (case-frob-stream-sout stream) #'case-frob-capitalize-aux-sout)) (t - (if (lisp-stream-p target) - (funcall (lisp-stream-out target) target char) + (if (ansi-stream-p target) + (funcall (ansi-stream-out target) target char) (stream-write-char target char)))))) (defun case-frob-capitalize-sout (stream str start end) @@ -1566,8 +1499,8 @@ #'case-frob-capitalize-aux-out) (setf (case-frob-stream-sout stream) #'case-frob-capitalize-aux-sout)) - (if (lisp-stream-p target) - (funcall (lisp-stream-sout target) target str 0 len) + (if (ansi-stream-p target) + (funcall (ansi-stream-sout target) target str 0 len) (stream-write-string target str 0 len)))) (defun case-frob-capitalize-aux-out (stream char) @@ -1576,12 +1509,12 @@ (let ((target (case-frob-stream-target stream))) (cond ((alphanumericp char) (let ((char (char-downcase char))) - (if (lisp-stream-p target) - (funcall (lisp-stream-out target) target char) + (if (ansi-stream-p target) + (funcall (ansi-stream-out target) target char) (stream-write-char target char)))) (t - (if (lisp-stream-p target) - (funcall (lisp-stream-out target) target char) + (if (ansi-stream-p target) + (funcall (ansi-stream-out target) target char) (stream-write-char target char)) (setf (case-frob-stream-out stream) #'case-frob-capitalize-out) @@ -1611,8 +1544,8 @@ #'case-frob-capitalize-out) (setf (case-frob-stream-sout stream) #'case-frob-capitalize-sout)) - (if (lisp-stream-p target) - (funcall (lisp-stream-sout target) target str 0 len) + (if (ansi-stream-p target) + (funcall (ansi-stream-sout target) target str 0 len) (stream-write-string target str 0 len)))) (defun case-frob-capitalize-first-out (stream char) @@ -1621,16 +1554,16 @@ (let ((target (case-frob-stream-target stream))) (cond ((alphanumericp char) (let ((char (char-upcase char))) - (if (lisp-stream-p target) - (funcall (lisp-stream-out target) target char) + (if (ansi-stream-p target) + (funcall (ansi-stream-out target) target char) (stream-write-char target char))) (setf (case-frob-stream-out stream) #'case-frob-downcase-out) (setf (case-frob-stream-sout stream) #'case-frob-downcase-sout)) (t - (if (lisp-stream-p target) - (funcall (lisp-stream-out target) target char) + (if (ansi-stream-p target) + (funcall (ansi-stream-out target) target char) (stream-write-char target char)))))) (defun case-frob-capitalize-first-sout (stream str start end) @@ -1653,8 +1586,8 @@ (setf (case-frob-stream-sout stream) #'case-frob-downcase-sout) (return)))) - (if (lisp-stream-p target) - (funcall (lisp-stream-sout target) target str 0 len) + (if (ansi-stream-p target) + (funcall (ansi-stream-sout target) target str 0 len) (stream-write-string target str 0 len)))) ;;;; stream commands @@ -1680,7 +1613,7 @@ ;;; had some input. If the LISTEN fails, then we have some stream we ;;; must wait on. (defun get-stream-command (stream) - (let ((cmdp (funcall (lisp-stream-misc stream) stream :get-command))) + (let ((cmdp (funcall (ansi-stream-misc stream) stream :get-command))) (cond (cmdp) ((listen stream) nil) @@ -1688,6 +1621,8 @@ ;; This waits for input and returns NIL when it arrives. (unread-char (read-char stream) stream))))) +;;;; READ-SEQUENCE + (defun read-sequence (seq stream &key (start 0) (end nil)) #!+sb-doc "Destructively modify SEQ by reading elements from STREAM. @@ -1701,7 +1636,18 @@ (type index start) (type sequence-end end) (values index)) - (let ((end (or end (length seq)))) + (if (ansi-stream-p stream) + (ansi-stream-read-sequence seq stream start end) + ;; must be Gray streams FUNDAMENTAL-STREAM + (stream-read-sequence stream seq start end))) + +(defun ansi-stream-read-sequence (seq stream start %end) + (declare (type sequence seq) + (type ansi-stream stream) + (type index start) + (type sequence-end %end) + (values index)) + (let ((end (or %end (length seq)))) (declare (type index end)) (etypecase seq (list @@ -1720,7 +1666,7 @@ (setf (first rem) el))))) (vector (with-array-data ((data seq) (offset-start start) (offset-end end)) - (typecase data + (typecase data ((or (simple-array (unsigned-byte 8) (*)) (simple-array (signed-byte 8) (*)) simple-string) @@ -1745,6 +1691,8 @@ (when (eq el :eof) (return (+ start (- i offset-start)))) (setf (aref data i) el))))))))))) + +;;;; WRITE-SEQUENCE (defun write-sequence (seq stream &key (start 0) (end nil)) #!+sb-doc @@ -1754,8 +1702,19 @@ (type index start) (type sequence-end end) (values sequence)) - (let ((end (or end (length seq)))) - (declare (type index start end)) + (if (ansi-stream-p stream) + (ansi-stream-write-sequence seq stream start end) + ;; must be Gray-streams FUNDAMENTAL-STREAM + (stream-write-sequence stream seq start end))) + +(defun ansi-stream-write-sequence (seq stream start %end) + (declare (type sequence seq) + (type ansi-stream stream) + (type index start) + (type sequence-end %end) + (values sequence)) + (let ((end (or %end (length seq)))) + (declare (type index end)) (etypecase seq (list (let ((write-function @@ -1779,6 +1738,8 @@ ((>= i end) seq) (declare (type index i)) (funcall write-function (aref seq i) stream))))))) + +;;;; etc. ;;; (These were inline throughout this file, but that's not appropriate ;;; globally.) diff --git a/src/code/sysmacs.lisp b/src/code/sysmacs.lisp index 81acb91..aba0098 100644 --- a/src/code/sysmacs.lisp +++ b/src/code/sysmacs.lisp @@ -60,12 +60,12 @@ ,svar))))) ;;; WITH-mumble-STREAM calls the function in the given SLOT of the -;;; STREAM with the ARGS for LISP-STREAMs, or the FUNCTION with the +;;; STREAM with the ARGS for ANSI-STREAMs, or the FUNCTION with the ;;; ARGS for FUNDAMENTAL-STREAMs. (defmacro with-in-stream (stream (slot &rest args) &optional stream-dispatch) `(let ((stream (in-synonym-of ,stream))) ,(if stream-dispatch - `(if (lisp-stream-p stream) + `(if (ansi-stream-p stream) (funcall (,slot stream) stream ,@args) ,@(when stream-dispatch `(,(destructuring-bind (function &rest args) stream-dispatch @@ -75,7 +75,7 @@ (defmacro with-out-stream (stream (slot &rest args) &optional stream-dispatch) `(let ((stream (out-synonym-of ,stream))) ,(if stream-dispatch - `(if (lisp-stream-p stream) + `(if (ansi-stream-p stream) (funcall (,slot stream) stream ,@args) ,@(when stream-dispatch `(,(destructuring-bind (function &rest args) stream-dispatch @@ -86,20 +86,20 @@ ;;; This macro sets up some local vars for use by the ;;; FAST-READ-CHAR macro within the enclosed lexical scope. The stream -;;; is assumed to be a LISP-STREAM. +;;; is assumed to be a ANSI-STREAM. (defmacro prepare-for-fast-read-char (stream &body forms) `(let* ((%frc-stream% ,stream) - (%frc-method% (lisp-stream-in %frc-stream%)) - (%frc-buffer% (lisp-stream-in-buffer %frc-stream%)) - (%frc-index% (lisp-stream-in-index %frc-stream%))) + (%frc-method% (ansi-stream-in %frc-stream%)) + (%frc-buffer% (ansi-stream-in-buffer %frc-stream%)) + (%frc-index% (ansi-stream-in-index %frc-stream%))) (declare (type index %frc-index%) - (type lisp-stream %frc-stream%)) + (type ansi-stream %frc-stream%)) ,@forms)) ;;; This macro must be called after one is done with FAST-READ-CHAR -;;; inside its scope to decache the lisp-stream-in-index. +;;; inside its scope to decache the ANSI-STREAM-IN-INDEX. (defmacro done-with-fast-read-char () - `(setf (lisp-stream-in-index %frc-stream%) %frc-index%)) + `(setf (ansi-stream-in-index %frc-stream%) %frc-index%)) ;;; a macro with the same calling convention as READ-CHAR, to be used ;;; within the scope of a PREPARE-FOR-FAST-READ-CHAR @@ -107,9 +107,9 @@ `(cond ((not %frc-buffer%) (funcall %frc-method% %frc-stream% ,eof-error-p ,eof-value)) - ((= %frc-index% +in-buffer-length+) + ((= %frc-index% +ansi-stream-in-buffer-length+) (prog1 (fast-read-char-refill %frc-stream% ,eof-error-p ,eof-value) - (setq %frc-index% (lisp-stream-in-index %frc-stream%)))) + (setq %frc-index% (ansi-stream-in-index %frc-stream%)))) (t (prog1 (code-char (aref %frc-buffer% %frc-index%)) (incf %frc-index%))))) @@ -117,7 +117,7 @@ ;;;; And these for the fasloader... ;;; Just like PREPARE-FOR-FAST-READ-CHAR except that we get the BIN -;;; method. The stream is assumed to be a LISP-STREAM. +;;; method. The stream is assumed to be a ANSI-STREAM. ;;; ;;; KLUDGE: It seems weird to have to remember to explicitly call ;;; DONE-WITH-FAST-READ-BYTE at the end of this, given that we're @@ -128,11 +128,11 @@ ;;; for the FAST-READ-CHAR stuff) -- WHN 19990825 (defmacro prepare-for-fast-read-byte (stream &body forms) `(let* ((%frc-stream% ,stream) - (%frc-method% (lisp-stream-bin %frc-stream%)) - (%frc-buffer% (lisp-stream-in-buffer %frc-stream%)) - (%frc-index% (lisp-stream-in-index %frc-stream%))) + (%frc-method% (ansi-stream-bin %frc-stream%)) + (%frc-buffer% (ansi-stream-in-buffer %frc-stream%)) + (%frc-index% (ansi-stream-in-index %frc-stream%))) (declare (type index %frc-index%) - (type lisp-stream %frc-stream%)) + (type ansi-stream %frc-stream%)) ,@forms)) ;;; Similar to fast-read-char, but we use a different refill routine & don't @@ -145,9 +145,9 @@ (cond ((not %frc-buffer%) (funcall %frc-method% %frc-stream% ,eof-error-p ,eof-value)) - ((= %frc-index% +in-buffer-length+) + ((= %frc-index% +ansi-stream-in-buffer-length+) (prog1 (fast-read-byte-refill %frc-stream% ,eof-error-p ,eof-value) - (setq %frc-index% (lisp-stream-in-index %frc-stream%)))) + (setq %frc-index% (ansi-stream-in-index %frc-stream%)))) (t (prog1 (aref %frc-buffer% %frc-index%) (incf %frc-index%)))))) diff --git a/src/pcl/cache.lisp b/src/pcl/cache.lisp index cde6f9b..f8f0f35 100644 --- a/src/pcl/cache.lisp +++ b/src/pcl/cache.lisp @@ -323,16 +323,16 @@ :length length :class (sb-kernel:make-standard-class :name name :pcl-class class)))))) -;;; The following variable may be set to a standard-class that has +;;; The following variable may be set to a STANDARD-CLASS that has ;;; already been created by the lisp code and which is to be redefined -;;; by PCL. This allows standard-classes to be defined and used for +;;; by PCL. This allows STANDARD-CLASSes to be defined and used for ;;; type testing and dispatch before PCL is loaded. (defvar *pcl-class-boot* nil) ;;; In SBCL, as in CMU CL, the layouts (a.k.a wrappers) for built-in ;;; and structure classes already exist when PCL is initialized, so we ;;; don't necessarily always make a wrapper. Also, we help maintain -;;; the mapping between cl:class and pcl::class objects. +;;; the mapping between CL:CLASS and PCL::CLASS objects. (defun make-wrapper (length class) (cond ((typep class 'std-class) diff --git a/src/pcl/gray-streams-class.lisp b/src/pcl/gray-streams-class.lisp index 2f4e3a9..a999b41 100644 --- a/src/pcl/gray-streams-class.lisp +++ b/src/pcl/gray-streams-class.lisp @@ -39,11 +39,11 @@ (defclass fundamental-binary-output-stream (fundamental-output-stream fundamental-binary-stream) nil) -#| -This is not in the gray-stream proposal, so it is left here -as example code. +;;; This is not in the Gray stream proposal, so it is left here +;;; as example code. +;;; ;;; example character input and output streams - +#| (defclass character-output-stream (fundamental-character-output-stream) ((lisp-stream :initarg :lisp-stream :accessor character-output-stream-lisp-stream))) diff --git a/src/pcl/gray-streams.lisp b/src/pcl/gray-streams.lisp index 1da8246..02a3a06 100644 --- a/src/pcl/gray-streams.lisp +++ b/src/pcl/gray-streams.lisp @@ -20,8 +20,8 @@ STREAM. The class FUNDAMENTAL-CHARACTER-STREAM provides a default method which returns CHARACTER.")) -(defmethod stream-element-type ((stream lisp-stream)) - (funcall (lisp-stream-misc stream) stream :element-type)) +(defmethod stream-element-type ((stream ansi-stream)) + (funcall (ansi-stream-misc stream) stream :element-type)) (defmethod stream-element-type ((stream fundamental-character-stream)) 'character) @@ -33,8 +33,8 @@ by class FUNDAMENTAL-STREAM which returns true if CLOSE has not been called on the stream.")) -(defmethod pcl-open-stream-p ((stream lisp-stream)) - (not (eq (lisp-stream-in stream) #'closed-flame))) +(defmethod pcl-open-stream-p ((stream ansi-stream)) + (not (eq (ansi-stream-in stream) #'closed-flame))) (defmethod pcl-open-stream-p ((stream fundamental-stream)) (stream-open-p stream)) @@ -50,9 +50,9 @@ inquiries may still be made. If :ABORT is true, an attempt is made to clean up the side effects of having created the stream.")) -(defmethod pcl-close ((stream lisp-stream) &key abort) +(defmethod pcl-close ((stream ansi-stream) &key abort) (when (open-stream-p stream) - (funcall (lisp-stream-misc stream) stream :close abort)) + (funcall (ansi-stream-misc stream) stream :close abort)) t) (defmethod pcl-close ((stream fundamental-stream) &key abort) @@ -68,10 +68,10 @@ #+sb-doc (:documentation "Can STREAM perform input operations?")) -(defmethod input-stream-p ((stream lisp-stream)) - (and (not (eq (lisp-stream-in stream) #'closed-flame)) - (or (not (eq (lisp-stream-in stream) #'ill-in)) - (not (eq (lisp-stream-bin stream) #'ill-bin))))) +(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 input-stream-p ((stream fundamental-input-stream)) t) @@ -82,10 +82,10 @@ #+sb-doc (:documentation "Can STREAM perform output operations?")) -(defmethod output-stream-p ((stream lisp-stream)) - (and (not (eq (lisp-stream-in stream) #'closed-flame)) - (or (not (eq (lisp-stream-out stream) #'ill-out)) - (not (eq (lisp-stream-bout stream) #'ill-bout))))) +(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) @@ -181,11 +181,57 @@ (defgeneric stream-clear-input (stream) #+sb-doc (:documentation - "Implements CLEAR-INPUT for the stream, returning NIL. The default - method does nothing.")) + "This is like CL:CLEAR-INPUT, but for Gray streams, returning NIL. + The default method does nothing.")) (defmethod stream-clear-input ((stream fundamental-character-input-stream)) nil) + +(defgeneric stream-read-sequence (stream seq &optional start end) + (:documentation + "This is like CL:READ-SEQUENCE, but for Gray streams.")) + +;;; Destructively modify SEQ by reading elements from STREAM. That +;;; part of SEQ bounded by START and END is destructively modified by +;;; copying successive elements into it from STREAM. If the end of +;;; file for STREAM is reached before copying all elements of the +;;; subsequence, then the extra elements near the end of sequence are +;;; not updated, and the index of the next element is returned. +(defun basic-io-type-stream-read-sequence (stream seq start end read-fun) + (declare (type sequence seq) + (type stream stream) + (type index start) + (type sequence-end end) + (type function read-fun) + (values index)) + (let ((end (or end (length seq)))) + (declare (type index end)) + (etypecase seq + (list + (do ((rem (nthcdr start seq) (rest rem)) + (i start (1+ i))) + ((or (endp rem) (>= i end)) i) + (declare (type list rem) + (type index i)) + (let ((el (funcall read-fun stream))) + (when (eq el :eof) + (return i)) + (setf (first rem) el)))) + (vector + (with-array-data ((data seq) (offset-start start) (offset-end end)) + (do ((i offset-start (1+ i))) + ((>= i offset-end) end) + (declare (type index i)) + (let ((el (funcall read-fun stream))) + (when (eq el :eof) + (return (+ start (- i offset-start)))) + (setf (aref data i) el)))))))) + +(defmethod stream-read-sequence ((stream fundamental-character-input-stream) + (seq sequence) + &optional (start 0) (end nil)) + (basic-io-type-stream-read-sequence stream seq start end + #'stream-read-char)) ;;; character output streams ;;; @@ -307,8 +353,8 @@ (defgeneric stream-clear-output (stream) #+sb-doc (:documentation - "Clears the given output Stream. Implements CLEAR-OUTPUT. The - default method does nothing.")) + "This is like CL:CLEAR-OUTPUT, but for Gray streams: clear the given + output STREAM. The default method does nothing.")) (defmethod stream-clear-output ((stream fundamental-output-stream)) nil) @@ -316,7 +362,7 @@ (defgeneric stream-advance-to-column (stream column) #+sb-doc (:documentation - "Writes enough blank space so that the next character will be + "Write enough blank space so that the next character will be written at the specified column. Returns true if the operation is successful, or NIL if it is not supported for this stream. This is intended for use by by PPRINT and FORMAT ~T. The default method uses @@ -331,6 +377,45 @@ (dotimes (i fill) (stream-write-char stream #\Space))) T))) + +(defgeneric stream-write-sequence (stream seq &optional start end) + (:documentation + "This is like CL:WRITE-SEQUENCE, but for Gray streams.")) + +;;; Write the elements of SEQ bounded by START and END to STREAM. +(defun basic-io-type-stream-write-sequence (stream seq start end write-fun) + (declare (type sequence seq) + (type stream stream) + (type index start) + (type sequence-end end) + (type function write-fun) + (values sequence)) + (let ((end (or end (length seq)))) + (declare (type index start end)) + (etypecase seq + (list + (do ((rem (nthcdr start seq) (rest rem)) + (i start (1+ i))) + ((or (endp rem) (>= i end)) seq) + (declare (type list rem) + (type index i)) + (funcall write-fun stream (first rem)))) + (vector + (do ((i start (1+ i))) + ((>= i end) seq) + (declare (type index i)) + (funcall write-fun stream (aref seq i))))))) + +(defmethod stream-write-sequence ((stream fundamental-character-output-stream) + (seq sequence) + &optional (start 0) (end nil)) + (typecase seq + (string + (stream-write-string stream seq start end)) + (t + (basic-io-type-stream-write-sequence stream seq start end + #'stream-write-char)))) + ;;; binary streams ;;; @@ -352,9 +437,9 @@ "Implements WRITE-BYTE; writes the integer to the stream and returns the integer as the result.")) +;;; This is not in the Gray stream proposal, so it is left here +;;; as example code. #| -This is not in the gray-stream proposal, so it is left here -as example code. ;;; example character output stream encapsulating a lisp-stream (defun make-character-output-stream (lisp-stream) (declare (type lisp-stream lisp-stream)) @@ -409,7 +494,7 @@ as example code. (output-stream-p (character-input-stream-lisp-stream stream))) (defmethod stream-read-char ((stream character-input-stream)) - (read-char (character-input-stream-lisp-stream stream))) + (read-char (character-input-stream-lisp-stream stream) nil :eof)) (defmethod stream-unread-char ((stream character-input-stream) character) (unread-char character (character-input-stream-lisp-stream stream))) diff --git a/stems-and-flags.lisp-expr b/stems-and-flags.lisp-expr index b30b3b5..dae1556 100644 --- a/stems-and-flags.lisp-expr +++ b/stems-and-flags.lisp-expr @@ -125,7 +125,7 @@ ("src/code/pcounter" :not-host) - ("src/code/lisp-stream" :not-host) + ("src/code/ansi-stream" :not-host) ("src/code/sysmacs" :not-host) diff --git a/tests/gray-streams.impure.lisp b/tests/gray-streams.impure.lisp index 585aa0a..471530b 100644 --- a/tests/gray-streams.impure.lisp +++ b/tests/gray-streams.impure.lisp @@ -73,7 +73,6 @@ ;;;; example character output stream encapsulating a lisp-stream (defun make-character-output-stream (lisp-stream) - (declare (type sb-kernel:lisp-stream lisp-stream)) (make-instance 'character-output-stream :lisp-stream lisp-stream)) (defmethod open-stream-p ((stream character-output-stream)) @@ -109,7 +108,6 @@ ;;;; example character input stream encapsulating a lisp-stream (defun make-character-input-stream (lisp-stream) - (declare (type sb-kernel:lisp-stream lisp-stream)) (make-instance 'character-input-stream :lisp-stream lisp-stream)) (defmethod open-stream-p ((stream character-input-stream)) @@ -133,14 +131,6 @@ (defmethod stream-read-char-no-hang ((stream character-input-stream)) (read-char-no-hang (character-input-stream-lisp-stream stream) nil :eof)) -#+nil -(defmethod stream-peek-char ((stream character-input-stream)) - (peek-char nil (character-input-stream-lisp-stream stream) nil :eof)) - -#+nil -(defmethod stream-listen ((stream character-input-stream)) - (listen (character-input-stream-lisp-stream stream))) - (defmethod stream-clear-input ((stream character-input-stream)) (clear-input (character-input-stream-lisp-stream stream))) @@ -196,6 +186,39 @@ "~@~%"))))) (assert (= 1 (count #\newline (let ((*print-pretty* nil)) (frob))))) (assert (= 2 (count #\newline (let ((*print-pretty* t)) (frob)))))) + +;;; tests for STREAM-READ-SEQUENCE/STREAM-WRITE-SEQUENCE for +;;; subclasses of FUNDAMENTAL-CHARACTER-INPUT-/OUTPUT-STREAM (i.e., +;;; where the default methods are available) +(let* ((test-string (format nil + "~% Testing for STREAM-*-SEQUENCE.~ + ~& This is the second line.~ + ~% This should be the third and last line.~%")) + (test-string-len (length test-string)) + (output-test-string (make-string test-string-len))) + ;; test for READ-/WRITE-SEQUENCE on strings/vectors + (with-input-from-string (foo test-string) + (assert (equal + (with-output-to-string (bar) + (let ((our-char-input (make-character-input-stream foo)) + (our-char-output (make-character-output-stream bar))) + (read-sequence output-test-string our-char-input) + (assert (typep output-test-string 'string)) + (write-sequence output-test-string our-char-output) + (assert (null (peek-char nil our-char-input nil nil nil))))) + test-string))) + ;; test for READ-/WRITE-SEQUENCE on lists + (let ((output-test-list (make-list test-string-len))) + (with-input-from-string (foo test-string) + (assert (equal + (with-output-to-string (bar) + (let ((our-char-input (make-character-input-stream foo)) + (our-char-output (make-character-output-stream bar))) + (read-sequence output-test-list our-char-input) + (assert (typep output-test-list 'list)) + (write-sequence output-test-list our-char-output) + (assert (null (peek-char nil our-char-input nil nil nil))))) + test-string))))) ;;;; example classes for binary output @@ -213,12 +236,10 @@ '(unsigned-byte 8)) (defun make-binary-to-char-input-stream (lisp-stream) - (declare (type sb-kernel:lisp-stream lisp-stream)) (make-instance 'binary-to-char-input-stream :lisp-stream lisp-stream)) (defun make-binary-to-char-output-stream (lisp-stream) - (declare (type sb-kernel:lisp-stream lisp-stream)) (make-instance 'binary-to-char-output-stream :lisp-stream lisp-stream)) diff --git a/version.lisp-expr b/version.lisp-expr index c1444ae..ca5e02d 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -18,4 +18,4 @@ ;;; for internal versions, especially for internal versions off the ;;; main CVS branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.pre7.74" +"0.pre7.75" -- 1.7.10.4