Author: eweitz Date: Mon May 19 04:01:35 2008 New Revision: 31

Modified: branches/edi/conditions.lisp branches/edi/decode.lisp branches/edi/doc/index.html branches/edi/encode.lisp branches/edi/in-memory.lisp branches/edi/input.lisp branches/edi/lw-binary-stream.lisp branches/edi/output.lisp branches/edi/packages.lisp branches/edi/specials.lisp branches/edi/stream.lisp branches/edi/strings.lisp branches/edi/test/test.lisp branches/edi/util.lisp Log: Fix condition hierarchy

Passes tests

Modified: branches/edi/conditions.lisp ============================================================================== --- branches/edi/conditions.lisp (original) +++ branches/edi/conditions.lisp Mon May 19 04:01:35 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/conditions.lisp,v 1.4 2008/05/18 20:34:52 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/conditions.lisp,v 1.5 2008/05/19 07:57:07 edi Exp $

;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved.

@@ -31,8 +31,8 @@

(define-condition flexi-stream-error (stream-error) () - (:documentation "Superclass for all errors related to -flexi streams.")) + (:documentation "Superclass for all errors related to flexi +streams."))

(define-condition flexi-stream-simple-error (flexi-stream-error simple-condition) () @@ -48,33 +48,16 @@ (:documentation "Errors of this type are signalled if the flexi stream has a wrong element type."))

-(define-condition flexi-stream-encoding-error (flexi-stream-simple-error) - () - (:documentation "Errors of this type are signalled if there is an -encoding problem.")) - -(define-condition flexi-stream-position-spec-error (flexi-stream-simple-error) - ((position-spec :initarg :position-spec - :reader flexi-stream-position-spec-error-position-spec)) - (:documentation "Errors of this type are signalled if an -erroneous position spec is used in conjunction with -FILE-POSITION.")) - -;; TODO: stream might not be a stream... -(defun signal-encoding-error (format-control &rest format-args) - "Convenience function similar to ERROR to signal conditions of type -FLEXI-STREAM-ENCODING-ERROR." - (error 'flexi-stream-encoding-error - :format-control format-control - :format-arguments format-args - #+(or) #+(or) - :stream flexi-stream)) - (define-condition in-memory-stream-error (stream-error) () (:documentation "Superclass for all errors related to IN-MEMORY streams."))

+(define-condition in-memory-stream-simple-error (in-memory-stream-error simple-condition) + () + (:documentation "Like IN-MEMORY-STREAM-ERROR but with formatting +capabilities.")) + (define-condition in-memory-stream-closed-error (in-memory-stream-error) () (:report (lambda (condition stream) @@ -83,3 +66,33 @@ (:documentation "An error that is signalled when someone is trying to read from or write to a closed IN-MEMORY stream."))

+(define-condition in-memory-stream-position-spec-error (in-memory-stream-simple-error) + ((position-spec :initarg :position-spec + :reader in-memory-stream-position-spec-error-position-spec)) + (:documentation "Errors of this type are signalled if an erroneous +position spec is used in conjunction with FILE-POSITION.")) + +(define-condition external-format-error () + ((external-format :initarg :external-format + :initform nil + :reader external-format-error-external-format)) + (:documentation "Superclass for all errors related to external +formats.")) + +(define-condition external-format-simple-error (external-format-error simple-condition) + () + (:documentation "Like EXTERNAL-FORMAT-ERROR but with formatting +capabilities.")) + +(define-condition external-format-encoding-error (external-format-simple-error) + () + (:documentation "Errors of this type are signalled if there is an +encoding problem.")) + +(defun signal-encoding-error (external-format format-control &rest format-args) + "Convenience function similar to ERROR to signal conditions of type +EXTERNAL-FORMAT-ENCODING-ERROR." + (error 'external-format-encoding-error + :format-control format-control + :format-arguments format-args + :external-format external-format))

Modified: branches/edi/decode.lisp ============================================================================== --- branches/edi/decode.lisp (original) +++ branches/edi/decode.lisp Mon May 19 04:01:35 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/decode.lisp,v 1.7 2008/05/18 22:22:30 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/decode.lisp,v 1.9 2008/05/19 07:57:07 edi Exp $

;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved.

@@ -29,16 +29,16 @@

(in-package :flexi-streams)

-(defun recover-from-encoding-error (format-control &rest format-args) +(defun recover-from-encoding-error (external-format format-control &rest format-args) "Helper function used by OCTETS-TO-CHAR-CODE below to deal with encoding errors. Checks if *SUBSTITUTION-CHAR* is not NIL and returns -its character code in this case. Otherwise signals a -FLEXI-STREAM-ENCODING-ERROR as determined by the arguments to this +its character code in this case. Otherwise signals an +EXTERNAL-FORMAT-ENCODING-ERROR as determined by the arguments to this function and provides a corresponding USE-VALUE restart." (when *substitution-char* (return-from recover-from-encoding-error (char-code *substitution-char*))) (restart-case - (apply #'signal-encoding-error format-control format-args) + (apply #'signal-encoding-error external-format format-control format-args) (use-value (char) :report "Specify a character to be used instead." :interactive (lambda () @@ -72,7 +72,8 @@ (return-from octets-to-char-code :eof)))) (declare (type octet octet)) (if (> octet 127) - (recover-from-encoding-error "No character which corresponds to octet #x~X." octet) + (recover-from-encoding-error format + "No character which corresponds to octet #x~X." octet) octet)))

(defmethod octets-to-char-code ((format flexi-8-bit-format) reader) @@ -86,7 +87,8 @@ (declare (type octet octet)) (if (or (null char-code) (= (the char-code-integer char-code) 65533)) - (recover-from-encoding-error "No character which corresponds to octet #x~X." octet) + (recover-from-encoding-error format + "No character which corresponds to octet #x~X." octet) char-code))))

(defmethod octets-to-char-code ((format flexi-utf-8-format) reader) @@ -99,7 +101,8 @@ (or (funcall reader) (cond (first-octet-seen (return-from octets-to-char-code - (recover-from-encoding-error "End of file while in UTF-8 sequence."))) + (recover-from-encoding-error format + "End of data while in UTF-8 sequence."))) (t (return-from octets-to-char-code :eof)))) (setq first-octet-seen t)))) (let ((octet (read-next-byte))) @@ -118,7 +121,8 @@ ((= #b11111100 (logand octet #b11111110)) (values (logand octet #b00000001) 5)) (t (return-from octets-to-char-code - (recover-from-encoding-error "Unexpected value #x~X at start of UTF-8 sequence." + (recover-from-encoding-error format + "Unexpected value #x~X at start of UTF-8 sequence." octet)))) (declare (fixnum count)) ;; note that we currently don't check for "overlong" @@ -130,7 +134,8 @@ for octet of-type octet = (read-next-byte) unless (= #b10000000 (logand octet #b11000000)) do (return-from octets-to-char-code - (recover-from-encoding-error "Unexpected value #x~X in UTF-8 sequence." octet)) + (recover-from-encoding-error format + "Unexpected value #x~X in UTF-8 sequence." octet)) finally (return result)))))))

(defmethod octets-to-char-code ((format flexi-utf-16-le-format) reader) @@ -143,7 +148,8 @@ (or (funcall reader) (cond (first-octet-seen (return-from octets-to-char-code - (recover-from-encoding-error "End of file while in UTF-16 sequence."))) + (recover-from-encoding-error format + "End of data while in UTF-16 sequence."))) (t (return-from octets-to-char-code :eof)))) (setq first-octet-seen t)))) (flet ((read-next-word () @@ -156,7 +162,8 @@ (declare (type (unsigned-byte 16) next-word)) (unless (<= #xdc00 next-word #xdfff) (return-from octets-to-char-code - (recover-from-encoding-error "Unexpected UTF-16 word #x~X following #x~X." + (recover-from-encoding-error format + "Unexpected UTF-16 word #x~X following #x~X." next-word word))) (+ (ash (logand #b1111111111 word) 10) (logand #b1111111111 next-word) @@ -173,7 +180,8 @@ (or (funcall reader) (cond (first-octet-seen (return-from octets-to-char-code - (recover-from-encoding-error "End of file while in UTF-16 sequence."))) + (recover-from-encoding-error format + "End of data while in UTF-16 sequence."))) (t (return-from octets-to-char-code :eof)))) (setq first-octet-seen t)))) (flet ((read-next-word () @@ -186,7 +194,8 @@ (declare (type (unsigned-byte 16) next-word)) (unless (<= #xdc00 next-word #xdfff) (return-from octets-to-char-code - (recover-from-encoding-error "Unexpected UTF-16 word #x~X following #x~X." + (recover-from-encoding-error format + "Unexpected UTF-16 word #x~X following #x~X." next-word word))) (+ (ash (logand #b1111111111 word) 10) (logand #b1111111111 next-word) @@ -203,7 +212,8 @@ (or (funcall reader) (cond (first-octet-seen (return-from octets-to-char-code - (recover-from-encoding-error "End of file while in UTF-32 sequence."))) + (recover-from-encoding-error format + "End of data while in UTF-32 sequence."))) (t (return-from octets-to-char-code :eof)))) (setq first-octet-seen t)))) (loop for count of-type fixnum from 0 to 24 by 8 @@ -220,7 +230,8 @@ (or (funcall reader) (cond (first-octet-seen (return-from octets-to-char-code - (recover-from-encoding-error "End of file while in UTF-32 sequence."))) + (recover-from-encoding-error format + "End of data while in UTF-32 sequence."))) (t (return-from octets-to-char-code :eof)))) (setq first-octet-seen t)))) (loop for count of-type fixnum from 24 downto 0 by 8

Modified: branches/edi/doc/index.html ============================================================================== --- branches/edi/doc/index.html (original) +++ branches/edi/doc/index.html Mon May 19 04:01:35 2008 @@ -56,7 +56,6 @@ <ol> <li><a href="#example">Example usage</a> <li><a href="#install">Download and installation</a> - <li><a href="#backward-compatibility">Backward compatibility with version 0.10.3 and before</a> <li><a href="#mail">Support and mailing lists</a> <li><a href="#dictionary">The FLEXI-STREAMS dictionary</a> <ol> @@ -70,6 +69,7 @@ <li><a href="#external-format-equal"><code>external-format-equal</code></a> <li><a href="#*default-eol-style*"><code>*default-eol-style*</code></a> <li><a href="#*default-little-endian*"><code>*default-little-endian*</code></a> + <li><a href="#external-format-encoding-error"><code>external-format-encoding-error</code></a> </ol> <li><a href="#flexi-streams">Flexi streams</a> <ol> @@ -89,11 +89,8 @@ <li><a href="#*substitution-char*"><code>*substitution-char*</code></a> <li><a href="#octet"><code>octet</code></a> <li><a href="#flexi-stream-error"><code>flexi-stream-error</code></a> - <li><a href="#flexi-stream-encoding-error"><code>flexi-stream-encoding-error</code></a> <li><a href="#flexi-stream-element-type-error"><code>flexi-stream-element-type-error</code></a> <li><a href="#flexi-stream-element-type-error-element-type"><code>flexi-stream-element-type-error-element-type</code></a> - <li><a href="#flexi-stream-position-spec-error"><code>flexi-stream-position-spec-error</code></a> - <li><a href="#flexi-stream-position-spec-error-position-spec"><code>flexi-stream-position-spec-error-position-spec</code></a> </ol> <li><a href="#in-memory">In-memory streams</a> <ol> @@ -110,6 +107,8 @@ <li><a href="#with-output-to-sequence"><code>with-output-to-sequence</code></a> <li><a href="#in-memory-stream-error"><code>in-memory-stream-error</code></a> <li><a href="#in-memory-stream-closed-error"><code>in-memory-stream-closed-error</code></a> + <li><a href="#in-memory-stream-position-spec-error"><code>in-memory-stream-position-spec-error</code></a> + <li><a href="#in-memory-stream-position-spec-error-position-spec"><code>in-memory-stream-position-spec-error-position-spec</code></a> </ol> <li><a href="#strings">Strings</a> <ol> @@ -256,27 +255,6 @@ href="http://arcanes.fr.eu.org/~pierre/2007/02/weitz/%22%3Ehttp://arcanes.fr.eu.or...</a> thanks to Pierre Thierry.

-<!-- this chapter may be removed after several versions --> -<br>&nbsp;<br> -<h3><a name="backward-compatibility" class=none> -Backward compatibility with version 0.10.3 and before</a></h3> - -Two special variables used in flexi-streams 0.10.3 and before were removed - -<code>*PROVIDE-USE-VALUE-RESTART*</code> and <code>*USE-REPLACEMENT-CHAR*</code>. - -<p> -The code now behaves as if -<code>*PROVIDE-USE-VALUE-RESTART*</code> is always <code>T</code>. -Instead of <code>*USE-REPLACEMENT-CHAR*</code>, you can use -<a href="#*substitution-char*"><code>*SUBSTITUTION-CHAR*</code></a> or -invoke -a <a -href="http://www.lispworks.com/documentation/HyperSpec/Body/r_use_va.htm%22%3E<code>USE-VALUE</code> -restart</a> -when a <a -href="#flexi-stream-encoding-error"><code>FLEXI-STREAM-ENCODING-ERROR</code></a> -is signalled. - <br>&nbsp;<br><h3><a name="mail" class=none>Support and mailing lists</a></h3>

For questions, bug reports, feature requests, improvements, or patches @@ -542,6 +520,32 @@ The default value for the <code><i>little-endian</i></code> keyword argument of <a href="#make-external-format"><code>MAKE-EXTERNAL-FORMAT</code></a>. Its initial value corresponds to the endianess of the platform FLEXI-STREAMS is used on as revealed by the <code>:LITTLE-ENDIAN</code> <a href="http://www.lispworks.com/documentation/HyperSpec/Body/24_ab.htm">feature</a>. </blockquote>

+<p><br>[Condition] +<br><a class=none name="external-format-error"><b>external-format-error</b></a> + +<blockquote><br> +All errors related to <a href="#external-formats">external formats</a> are of this type. +There's a slot for the external format which can be accessed with <a href="#external-format-error-external-format"><code>EXTERNAL-FORMAT-ERROR-EXTERNAL-FORMAT</code></a>. +</blockquote> + +<p><br>[Reader] +<br><a class=none name="external-format-error-external-format"><b>external-format-error-external-format</b> <i>condition</i> =&gt; <i>external-format</i></a> + +<blockquote><br> If <code><i>condition</i></code> is of +type <a href="#external-format-error"><code>EXTERNAL-FORMAT-ERROR</code></a>, +this function will return the associated external format. Note that +there are errors which happen during the creation of external formats +where this method returns <code>NIL</code>. +</blockquote> + +<p><br>[Condition] +<br><a class=none name="external-format-encoding-error"><b>external-format-encoding-error</b></a> + +<blockquote><br> +All errors related to encoding problems with <a href="#flexi-streams">flexi streams</a> are of this type. (This includes situation where an end of file is encountered in the middle of a multi-octet character.) When this condition is signalled during reading, <a href="http://www.lispworks.com/documentation/HyperSpec/Body/r_use_va.htm"><code>USE-VALUE</code> +restart</a> is provided. See also <a href="#*substitution-char*"><code>*SUBSTITUTION-CHAR*</code></a> and example for it. <a href="#external-format-encoding-error"><code>EXTERNAL-FORMAT-ENCODING-ERROR</code></a> is a subtype of <a href="#external-format-error"><code>EXTERNAL-FORMAT-ERROR</code></a>. +</blockquote> + <h4><a name="flexi-streams" class=none>Flexi streams</a></h4>

<em>Flexi streams</em> are the core of the FLEXI-STREAMS library. You @@ -736,7 +740,7 @@ <blockquote><br> If this value is not NIL, it should be a character which is used (as if by a <a href="http://www.lispworks.com/documentation/HyperSpec/Body/r_use_va.htm"><code>USE-VALUE</code> restart</a>) whenever during reading an error of -type <a href="#flexi-stream-encoding-error"><code>FLEXI-STREAM-ENCODING-ERROR</code></a> would have been signalled otherwise. +type <a href="#external-format-encoding-error"><code>EXTERNAL-FORMAT-ENCODING-ERROR</code></a> would have been signalled otherwise.

<pre> CL-USER 1 &gt; (defun foo () @@ -770,7 +774,7 @@ "xy" T

-CL-USER 5 &gt; (<a href="http://www.lispworks.com/documentation/HyperSpec/Body/m_handle.htm" class=noborder>handler-bind</a> ((<a href="#flexi-stream-encoding-error" class=noborder>flexi-stream-encoding-error</a> (lambda (condition) +CL-USER 5 &gt; (<a href="http://www.lispworks.com/documentation/HyperSpec/Body/m_handle.htm" class=noborder>handler-bind</a> ((<a href="#external-format-encoding-error" class=noborder>external-format-encoding-error</a> (lambda (condition) (<a href="http://www.lispworks.com/documentation/HyperSpec/Body/r_use_va.htm" class=noborder>use-value</a> #-)))) (foo)) "--" @@ -798,14 +802,6 @@ </blockquote>

<p><br>[Condition] -<br><a class=none name="flexi-stream-encoding-error"><b>flexi-stream-encoding-error</b></a> - -<blockquote><br> -All errors related to encoding problems with <a href="#flexi-streams">flexi streams</a> are of this type. (This includes situation where an end of file is encountered in the middle of a multi-octet character.) When this condition is signalled during reading, <a href="http://www.lispworks.com/documentation/HyperSpec/Body/r_use_va.htm"><code>USE-VALUE</code> -restart</a> is provided. See also <a href="#*substitution-char*"><code>*SUBSTITUTION-CHAR*</code></a> and example for it. <a href="#flexi-encodingstream-error"><code>FLEXI-STREAM-ENCODING-ERROR</code></a> is a subtype of <a href="#flexi-stream-error"><code>FLEXI-STREAM-ERROR</code></a>. -</blockquote> - -<p><br>[Condition] <br><a class=none name="flexi-stream-element-type-error"><b>flexi-stream-element-type-error</b></a>

<blockquote><br> @@ -819,26 +815,6 @@ If <code><i>condition</i></code> is of type <a href="#flexi-stream-element-type-error"><code>FLEXI-STREAM-ELEMENT-TYPE-ERROR</code></a>, this function will return the offending element type. </blockquote>

-<p><br>[Condition] -<br><a class=none name="flexi-stream-position-spec-error"><b>flexi-stream-position-spec-error</b></a> - -<blockquote><br> Errors of this type are signalled if an erroneous -position spec is used in conjunction -with <a href="#position"><code>FILE-POSITION</code></a>. This is a -subtype -of <a href="#flexi-stream-error"><code>FLEXI-STREAM-ERROR</code></a> -and has an additional slot for the position spec which can be accessed -with <a -href="#flexi-stream-position-spec-error-position-spec"><code>FLEXI-STREAM-POSITION-SPEC-ERROR-POSITION-SPEC</code></a>. -</blockquote> - -<p><br>[Reader] -<br><a class=none name="flexi-stream-position-spec-error-position-spec"><b>flexi-stream-position-spec-error-position-spec</b> <i>condition</i> =&gt; <i>position-spec</i></a> - -<blockquote><br> -If <code><i>condition</i></code> is of type <a href="#flexi-stream-position-spec-error"><code>FLEXI-STREAM-POSITION-SPEC-ERROR</code></a>, this function will return the offending position spec. -</blockquote> - <h4><a name="in-memory" class=none>In-memory streams</a></h4>

The library also provides <em>in-memory</em> binary streams which are modeled after <a href="http://www.lispworks.com/documentation/HyperSpec/Body/t_stg_st.htm">string streams</a> and behave very similar only that they deal with <a href="#octet">octets</a> instead of characters and the underlying data structure is not a string but either a list or a vector. These streams can obviously be used as the underlying streams for <a href="#flexi-streams">flexi streams</a>. @@ -965,6 +941,25 @@ An error of this type is signalled if one tries to read from or write to an <a href="#in-memory">in-memory stream</a> which had already been closed. This is a subtype of <a href="#in-memory-stream-error"><code>IN-MEMORY-STREAM-ERROR</code></a>. </blockquote>

+<p><br>[Condition] +<br><a class=none name="in-memory-stream-position-spec-error"><b>in-memory-stream-position-spec-error</b></a> + +<blockquote><br> Errors of this type are signalled if an erroneous +position spec is used in conjunction +with <a href="#position"><code>FILE-POSITION</code></a>. This is a +subtype +of <a href="#in-memory-stream-error"><code>IN-MEMORY-STREAM-ERROR</code></a> +and has an additional slot for the position spec which can be accessed +with <a href="#in-memory-stream-position-spec-error-position-spec"><code>IN-MEMORY-STREAM-POSITION-SPEC-ERROR-POSITION-SPEC</code></a>. +</blockquote> + +<p><br>[Reader] +<br><a class=none name="in-memory-stream-position-spec-error-position-spec"><b>in-memory-stream-position-spec-error-position-spec</b> <i>condition</i> =&gt; <i>position-spec</i></a> + +<blockquote><br> +If <code><i>condition</i></code> is of type <a href="#in-memory-stream-position-spec-error"><code>IN-MEMORY-STREAM-POSITION-SPEC-ERROR</code></a>, this function will return the offending position spec. +</blockquote> + <h4><a name="strings" class=none>Strings</a></h4>

This section collects a few convenience functions for strings conversions: @@ -1037,7 +1032,7 @@ numerous patches and additions.

<p> -$Header: /usr/local/cvsrep/flexi-streams/doc/index.html,v 1.100 2008/05/18 14:59:02 edi Exp $ +$Header: /usr/local/cvsrep/flexi-streams/doc/index.html,v 1.102 2008/05/19 07:57:10 edi Exp $ <p><a href="http://weitz.de/index.html">BACK TO MY HOMEPAGE</a>

</body>

Modified: branches/edi/encode.lisp ============================================================================== --- branches/edi/encode.lisp (original) +++ branches/edi/encode.lisp Mon May 19 04:01:35 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/encode.lisp,v 1.7 2008/05/18 22:22:30 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/encode.lisp,v 1.8 2008/05/19 07:57:07 edi Exp $

;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved.

@@ -45,7 +45,7 @@ (declare (character char) (function writer)) (let ((octet (char-code char))) (when (> octet 255) - (signal-encoding-error "~S (code ~A) is not a LATIN-1 character." char octet)) + (signal-encoding-error format "~S (code ~A) is not a LATIN-1 character." char octet)) (funcall writer octet)))

(defmethod char-to-octets ((format flexi-ascii-format) char writer) @@ -53,7 +53,7 @@ (declare (character char) (function writer)) (let ((octet (char-code char))) (when (> octet 127) - (signal-encoding-error "~S (code ~A) is not an ASCII character." char octet)) + (signal-encoding-error format "~S (code ~A) is not an ASCII character." char octet)) (funcall writer octet)))

(defmethod char-to-octets ((format flexi-8-bit-format) char writer) @@ -63,7 +63,7 @@ format (let ((octet (gethash (char-code char) encoding-hash))) (unless octet - (signal-encoding-error "~S (code ~A) is not in this encoding." char octet)) + (signal-encoding-error format "~S (code ~A) is not in this encoding." char octet)) (funcall writer octet))))

(defmethod char-to-octets ((format flexi-utf-8-format) char writer)

Modified: branches/edi/in-memory.lisp ============================================================================== --- branches/edi/in-memory.lisp (original) +++ branches/edi/in-memory.lisp Mon May 19 04:01:35 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/in-memory.lisp,v 1.29 2008/05/17 16:35:58 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/in-memory.lisp,v 1.31 2008/05/19 07:57:07 edi Exp $

;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved.

@@ -107,163 +107,194 @@ #+:cmu (defmethod open-stream-p ((stream in-memory-stream)) "Returns a true value if STREAM is open. See ANSI standard." - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) (in-memory-stream-open-p stream))

#+:cmu (defmethod close ((stream in-memory-stream) &key abort) "Closes the stream STREAM. See ANSI standard." - (declare (ignore abort) - (optimize speed)) + (declare #.*standard-optimize-settings*) + (declare (ignore abort)) (prog1 (in-memory-stream-open-p stream) (setf (in-memory-stream-open-p stream) nil)))

(defmethod check-if-open ((stream in-memory-stream)) "Checks if STREAM is open and signals an error otherwise." - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) (unless (open-stream-p stream) (error 'in-memory-stream-closed-error :stream stream)))

(defmethod stream-element-type ((stream in-memory-stream)) "The element type is always OCTET by definition." - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) 'octet)

(defmethod transform-octet ((stream in-memory-stream) octet) "Applies the transformer of STREAM to octet and returns the result." + (declare #.*standard-optimize-settings*) (funcall (or (in-memory-stream-transformer stream) #'identity) octet))

(defmethod stream-read-byte ((stream list-input-stream)) "Reads one byte by simply popping it off of the top of the list." - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) (check-if-open stream) - (transform-octet stream (or (pop (list-stream-list stream)) - (return-from stream-read-byte :eof)))) + (with-accessors ((list list-stream-list)) + stream + (transform-octet stream (or (pop list) (return-from stream-read-byte :eof)))))

(defmethod stream-listen ((stream list-input-stream)) "Checks whether list is not empty." - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) (check-if-open stream) - (list-stream-list stream)) + (with-accessors ((list list-stream-list)) + stream + list))

(defmethod stream-read-sequence ((stream list-input-stream) sequence start end &key) "Repeatedly pops elements from the list until it's empty." - (declare (optimize speed) (type (integer 0 *) start end)) - (loop for index from start below end - while (list-stream-list stream) - do (setf (elt sequence index) - (pop (list-stream-list stream))) - finally (return index))) + (declare #.*standard-optimize-settings*) + (declare (fixnum start end)) + (with-accessors ((list list-stream-list)) + stream + (loop for index of-type fixnum from start below end + while list + do (setf (elt sequence index) (pop list)) + finally (return index))))

(defmethod stream-read-byte ((stream vector-input-stream)) "Reads one byte and increments INDEX pointer unless we're beyond END pointer." - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) (check-if-open stream) - (let ((index (vector-stream-index stream))) - (cond ((< index (vector-stream-end stream)) - (incf (vector-stream-index stream)) - (transform-octet stream (aref (vector-stream-vector stream) index))) - (t :eof)))) + (with-accessors ((index vector-stream-index) + (end vector-stream-end) + (vector vector-stream-vector)) + stream + (let ((current-index index)) + (declare (fixnum current-index)) + (cond ((< current-index (the fixnum end)) + (incf (the fixnum index)) + (transform-octet stream (aref vector current-index))) + (t :eof)))))

(defmethod stream-listen ((stream vector-input-stream)) "Checking whether INDEX is beyond END." - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) (check-if-open stream) - (< (vector-stream-index stream) (vector-stream-end stream))) + (with-accessors ((index vector-stream-index) + (end vector-stream-end)) + stream + (< (the fixnum index) (the fixnum end))))

(defmethod stream-read-sequence ((stream vector-input-stream) sequence start end &key) "Traverses both sequences in parallel until the end of one of them is reached." - (declare (optimize speed) (type (integer 0 *) start end)) - (loop with vector-end of-type (integer 0 #.array-dimension-limit) = (vector-stream-end stream) + (declare #.*standard-optimize-settings*) + (declare (fixnum start end)) + (loop with vector-end of-type fixnum = (vector-stream-end stream) with vector = (vector-stream-vector stream) - for index from start below end - for vector-index of-type (integer 0 #.array-dimension-limit) = (vector-stream-index stream) + for index of-type fixnum from start below end + for vector-index of-type fixnum = (vector-stream-index stream) while (< vector-index vector-end) do (setf (elt sequence index) (aref vector vector-index)) - (incf (vector-stream-index stream)) + (incf (the fixnum (vector-stream-index stream))) finally (return index)))

(defmethod stream-write-byte ((stream vector-output-stream) byte) "Writes a byte (octet) by extending the underlying vector." - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) (check-if-open stream) - (vector-push-extend (transform-octet stream byte) - (vector-stream-vector stream))) + (with-accessors ((vector vector-stream-vector)) + stream + (vector-push-extend (transform-octet stream byte) vector)))

(defmethod stream-write-sequence ((stream vector-output-stream) sequence start end &key) "Just calls VECTOR-PUSH-EXTEND repeatedly." - (declare (optimize speed) (type (integer 0 *) start end)) - (loop with vector = (vector-stream-vector stream) - for index from start below end - do (vector-push-extend (elt sequence index) vector)) - sequence) + (declare #.*standard-optimize-settings*) + (declare (fixnum start end)) + (with-accessors ((vector vector-stream-vector)) + stream + (loop for index of-type fixnum from start below end + do (vector-push-extend (elt sequence index) vector)) + sequence))

(defmethod stream-file-position ((stream vector-input-stream)) "Simply returns the index into the underlying vector." - (declare (optimize speed)) - (vector-stream-index stream)) + (declare #.*standard-optimize-settings*) + (with-accessors ((index vector-stream-index)) + stream + index))

(defmethod (setf stream-file-position) (position-spec (stream vector-input-stream)) "Sets the index into the underlying vector if POSITION-SPEC is acceptable." - (declare (optimize speed)) - (setf (vector-stream-index stream) - (case position-spec - (:start 0) - (:end (vector-stream-end stream)) - (otherwise - (unless (integerp position-spec) - (error 'flexi-stream-position-spec-error - :format-control "Unknown file position designator: ~S." - :format-arguments (list position-spec) - :position-spec position-spec)) - (unless (<= 0 position-spec (vector-stream-end stream)) - (error 'flexi-stream-position-spec-error - :format-control "File position designator ~S is out of bounds." - :format-arguments (list position-spec) - :position-spec position-spec)) - position-spec))) - position-spec) - -(defmethod stream-file-position ((stream vector-output-stream)) - "Simply returns the fill pointer of the underlying vector." - (declare (optimize speed)) - (fill-pointer (vector-stream-vector stream))) - -(defmethod (setf stream-file-position) (position-spec (stream vector-output-stream)) - "Sets the fill pointer underlying vector if POSITION-SPEC is -acceptable. Adjusts the vector if necessary." - (declare (optimize speed)) - (let* ((vector (vector-stream-vector stream)) - (total-size (array-total-size vector)) - (new-fill-pointer + (declare #.*standard-optimize-settings*) + (with-accessors ((index vector-stream-index) + (end vector-stream-end)) + stream + (setq index (case position-spec (:start 0) - (:end - (warn "File position designator :END doesn't really make sense for an output stream.") - total-size) + (:end end) (otherwise (unless (integerp position-spec) - (error 'flexi-stream-position-spec-error + (error 'in-memory-stream-position-spec-error :format-control "Unknown file position designator: ~S." :format-arguments (list position-spec) + :stream stream :position-spec position-spec)) - (unless (<= 0 position-spec array-total-size-limit) - (error 'flexi-stream-position-spec-error + (unless (<= 0 position-spec end) + (error 'in-memory-stream-position-spec-error :format-control "File position designator ~S is out of bounds." :format-arguments (list position-spec) + :stream stream :position-spec position-spec)) - position-spec)))) - (when (> new-fill-pointer total-size) - (adjust-array vector new-fill-pointer)) - (setf (fill-pointer vector) new-fill-pointer) + position-spec))) position-spec))

+(defmethod stream-file-position ((stream vector-output-stream)) + "Simply returns the fill pointer of the underlying vector." + (declare #.*standard-optimize-settings*) + (with-accessors ((vector vector-stream-vector)) + stream + (fill-pointer vector))) + +(defmethod (setf stream-file-position) (position-spec (stream vector-output-stream)) + "Sets the fill pointer underlying vector if POSITION-SPEC is +acceptable. Adjusts the vector if necessary." + (declare #.*standard-optimize-settings*) + (with-accessors ((vector vector-stream-vector)) + stream + (let* ((total-size (array-total-size vector)) + (new-fill-pointer + (case position-spec + (:start 0) + (:end + (warn "File position designator :END doesn't really make sense for an output stream.") + total-size) + (otherwise + (unless (integerp position-spec) + (error 'in-memory-stream-position-spec-error + :format-control "Unknown file position designator: ~S." + :format-arguments (list position-spec) + :stream stream + :position-spec position-spec)) + (unless (<= 0 position-spec array-total-size-limit) + (error 'in-memory-stream-position-spec-error + :format-control "File position designator ~S is out of bounds." + :format-arguments (list position-spec) + :stream stream + :position-spec position-spec)) + position-spec)))) + (declare (fixnum total-size new-fill-pointer)) + (when (> new-fill-pointer total-size) + (adjust-array vector new-fill-pointer)) + (setf (fill-pointer vector) new-fill-pointer) + position-spec))) + (defmethod make-in-memory-input-stream ((vector vector) &key (start 0) (end (length vector)) transformer) @@ -271,7 +302,7 @@ octets in the subsequence of VECTOR bounded by START and END. Each octet returned will be transformed in turn by the optional TRANSFORMER function." - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) (make-instance 'vector-input-stream :vector vector :index start @@ -285,7 +316,7 @@ octets in the subsequence of LIST bounded by START and END. Each octet returned will be transformed in turn by the optional TRANSFORMER function." - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) (make-instance 'list-input-stream :list (subseq list start end) :transformer transformer)) @@ -293,7 +324,7 @@ (defun make-output-vector (&key (element-type 'octet)) "Creates and returns an array which can be used as the underlying vector for a VECTOR-OUTPUT-STREAM." - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) (make-array 0 :adjustable t :fill-pointer 0 :element-type element-type)) @@ -304,7 +335,7 @@ that contains the octes that were actually output. The octets stored will each be transformed by the optional TRANSFORMER function." - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) (make-instance 'vector-output-stream :vector (make-output-vector :element-type element-type) :transformer transformer)) @@ -316,19 +347,23 @@ been output since the last call to GET-OUTPUT-STREAM-SEQUENCE or since the creation of the stream, whichever occurred most recently. If AS-LIST is true the return value is coerced to a list." - (declare (optimize speed)) - (prog1 - (if as-list - (coerce (vector-stream-vector stream) 'list) - (vector-stream-vector stream)) - (setf (vector-stream-vector stream) - (make-output-vector)))) + (declare #.*standard-optimize-settings*) + (with-accessors ((vector vector-stream-vector)) + stream + (prog1 + (if as-list + (coerce vector 'list) + vector) + (setq vector + (make-output-vector)))))

(defmethod output-stream-sequence-length ((stream in-memory-output-stream)) "Returns the current length of the underlying vector of the IN-MEMORY output stream STREAM." (declare (optimize speed)) - (length (the (simple-array * (*)) (vector-stream-vector stream)))) + (with-accessors ((vector vector-stream-vector)) + stream + (length (the (simple-array * (*)) vector))))

(defmacro with-input-from-sequence ((var sequence &key start end transformer) &body body)

Modified: branches/edi/input.lisp ============================================================================== --- branches/edi/input.lisp (original) +++ branches/edi/input.lisp Mon May 19 04:01:35 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/input.lisp,v 1.59 2008/05/18 21:39:40 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/input.lisp,v 1.60 2008/05/19 07:57:07 edi Exp $

;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved.

@@ -148,8 +148,7 @@ (octet-stack flexi-stream-octet-stack) (external-format flexi-stream-external-format)) flexi-input-stream - (let ((*current-stream* flexi-input-stream) - (counter 0) octets-reversed) + (let ((counter 0) octets-reversed) (declare (integer position) (fixnum counter)) (char-to-octets external-format @@ -174,7 +173,6 @@ (setq last-octet nil) (let* ((*current-unreader* (lambda (char) (unread-char% char stream))) - (*current-stream* stream) (char-code (octets-to-char-code external-format (lambda () (read-byte* stream)))))

Modified: branches/edi/lw-binary-stream.lisp ============================================================================== --- branches/edi/lw-binary-stream.lisp (original) +++ branches/edi/lw-binary-stream.lisp Mon May 19 04:01:35 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/lw-binary-stream.lisp,v 1.13 2008/05/17 14:21:20 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/lw-binary-stream.lisp,v 1.14 2008/05/18 23:13:59 edi Exp $

;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved.

@@ -48,251 +48,11 @@ optimizing input and output on LispWorks. See READ-BYTE* and WRITE-BYTE*."))

-(defclass flexi-binary-8-bit-input-stream (flexi-8-bit-input-stream flexi-binary-input-stream) - () - (:documentation "Like FLEXI-8-BIT-INPUT-STREAM but optimized -for LispWorks binary streams.")) - -(defclass flexi-binary-cr-8-bit-input-stream (flexi-cr-mixin flexi-binary-8-bit-input-stream) - () - (:documentation "Like FLEXI-CR-8-BIT-INPUT-STREAM but optimized -for LispWorks binary streams.")) - -(defclass flexi-binary-ascii-input-stream (flexi-ascii-input-stream flexi-binary-8-bit-input-stream) - () - (:documentation "Like FLEXI-ASCII-INPUT-STREAM but optimized -for LispWorks binary streams.")) - -(defclass flexi-binary-cr-ascii-input-stream (flexi-cr-mixin flexi-binary-ascii-input-stream) - () - (:documentation "Like FLEXI-CR-ASCII-INPUT-STREAM but optimized -for LispWorks binary streams.")) - -(defclass flexi-binary-latin-1-input-stream (flexi-latin-1-input-stream flexi-binary-8-bit-input-stream) - () - (:documentation "Like FLEXI-LATIN-1-INPUT-STREAM but optimized -for LispWorks binary streams.")) - -(defclass flexi-binary-cr-latin-1-input-stream (flexi-cr-mixin flexi-binary-latin-1-input-stream) - () - (:documentation "Like FLEXI-CR-LATIN-1-INPUT-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-utf-32-le-input-stream (flexi-utf-32-le-input-stream flexi-binary-input-stream) - () - (:documentation "Like FLEXI-UTF-32-LE-INPUT-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-cr-utf-32-le-input-stream (flexi-cr-mixin flexi-binary-utf-32-le-input-stream) - () - (:documentation "Like FLEXI-CR-UTF-32-LE-INPUT-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-utf-32-be-input-stream (flexi-utf-32-be-input-stream flexi-binary-input-stream) - () - (:documentation "Like FLEXI-UTF-32-BE-INPUT-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-cr-utf-32-be-input-stream (flexi-cr-mixin flexi-binary-utf-32-be-input-stream) - () - (:documentation "Like FLEXI-CR-UTF-32-BE-INPUT-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-utf-16-le-input-stream (flexi-utf-16-le-input-stream flexi-binary-input-stream) - () - (:documentation "Like FLEXI-UTF-16-LE-INPUT-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-cr-utf-16-le-input-stream (flexi-cr-mixin flexi-binary-utf-16-le-input-stream) - () - (:documentation "Like FLEXI-CR-UTF-16-LE-INPUT-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-utf-16-be-input-stream (flexi-utf-16-be-input-stream flexi-binary-input-stream) - () - (:documentation "Like FLEXI-UTF-16-BE-INPUT-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-cr-utf-16-be-input-stream (flexi-cr-mixin flexi-binary-utf-16-be-input-stream) - () - (:documentation "Like FLEXI-CR-UTF-16-BE-INPUT-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-utf-8-input-stream (flexi-utf-8-input-stream flexi-binary-input-stream) - () - (:documentation "Like FLEXI-UTF-8-INPUT-STREAM but optimized -for LispWorks binary streams.")) - -(defclass flexi-binary-cr-utf-8-input-stream (flexi-cr-mixin flexi-binary-utf-8-input-stream) - () - (:documentation "Like FLEXI-CR-UTF-8-INPUT-STREAM but optimized -for LispWorks binary streams.")) - -(defclass flexi-binary-8-bit-output-stream (flexi-8-bit-output-stream flexi-binary-output-stream) - () - (:documentation "Like FLEXI-8-BIT-OUTPUT-STREAM but optimized -for LispWorks binary streams.")) - -(defclass flexi-binary-cr-8-bit-output-stream (flexi-cr-mixin flexi-binary-8-bit-output-stream) - () - (:documentation "Like FLEXI-CR-8-BIT-OUTPUT-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-ascii-output-stream (flexi-ascii-output-stream flexi-binary-8-bit-output-stream) - () - (:documentation "Like FLEXI-ASCII-OUTPUT-STREAM but optimized -for LispWorks binary streams.")) - -(defclass flexi-binary-cr-ascii-output-stream (flexi-cr-mixin flexi-binary-ascii-output-stream) - () - (:documentation "Like FLEXI-CR-ASCII-OUTPUT-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-latin-1-output-stream (flexi-latin-1-output-stream flexi-binary-8-bit-output-stream) - () - (:documentation "Like FLEXI-LATIN-1-OUTPUT-STREAM but optimized -for LispWorks binary streams.")) - -(defclass flexi-binary-cr-latin-1-output-stream (flexi-cr-mixin flexi-binary-latin-1-output-stream) - () - (:documentation "Like FLEXI-CR-LATIN-1-OUTPUT-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-utf-32-le-output-stream (flexi-utf-32-le-output-stream flexi-binary-output-stream) - () - (:documentation "Like FLEXI-UTF-32-LE-OUTPUT-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-cr-utf-32-le-output-stream (flexi-cr-mixin flexi-binary-utf-32-le-output-stream) - () - (:documentation "Like FLEXI-CR-UTF-32-LE-OUTPUT-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-utf-32-be-output-stream (flexi-utf-32-be-output-stream flexi-binary-output-stream) - () - (:documentation "Like FLEXI-UTF-32-BE-OUTPUT-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-cr-utf-32-be-output-stream (flexi-cr-mixin flexi-binary-utf-32-be-output-stream) - () - (:documentation "Like FLEXI-CR-UTF-32-BE-OUTPUT-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-utf-16-le-output-stream (flexi-utf-16-le-output-stream flexi-binary-output-stream) - () - (:documentation "Like FLEXI-UTF-16-LE-OUTPUT-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-cr-utf-16-le-output-stream (flexi-cr-mixin flexi-binary-utf-16-le-output-stream) - () - (:documentation "Like FLEXI-CR-UTF-16-LE-OUTPUT-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-utf-16-be-output-stream (flexi-utf-16-be-output-stream flexi-binary-output-stream) - () - (:documentation "Like FLEXI-UTF-16-BE-OUTPUT-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-cr-utf-16-be-output-stream (flexi-cr-mixin flexi-binary-utf-16-be-output-stream) - () - (:documentation "Like FLEXI-CR-UTF-16-BE-OUTPUT-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-utf-8-output-stream (flexi-utf-8-output-stream flexi-binary-output-stream) - () - (:documentation "Like FLEXI-UTF-8-OUTPUT-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-cr-utf-8-output-stream (flexi-cr-mixin flexi-binary-utf-8-output-stream) - () - (:documentation "Like FLEXI-CR-UTF-8-OUTPUT-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-8-bit-io-stream (flexi-binary-io-stream flexi-8-bit-io-stream) - () - (:documentation "Like FLEXI-8-BIT-IO-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-cr-8-bit-io-stream (flexi-cr-mixin flexi-binary-8-bit-io-stream) - () - (:documentation "Like FLEXI-CR-8-BIT-IO-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-ascii-io-stream (flexi-ascii-io-stream flexi-binary-8-bit-io-stream) - () - (:documentation "Like FLEXI-ASCII-IO-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-cr-ascii-io-stream (flexi-cr-mixin flexi-binary-ascii-io-stream) - () - (:documentation "Like FLEXI-CR-ASCII-IO-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-latin-1-io-stream (flexi-latin-1-io-stream flexi-binary-8-bit-io-stream) - () - (:documentation "Like FLEXI-LATIN-1-IO-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-cr-latin-1-io-stream (flexi-cr-mixin flexi-binary-latin-1-io-stream) - () - (:documentation "Like FLEXI-CR-LATIN-1-IO-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-utf-32-le-io-stream (flexi-utf-32-le-io-stream flexi-binary-io-stream) - () - (:documentation "Like FLEXI-UTF-32-LE-IO-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-cr-utf-32-le-io-stream (flexi-cr-mixin flexi-binary-utf-32-le-io-stream) - () - (:documentation "Like FLEXI-CR-UTF-32-LE-IO-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-utf-32-be-io-stream (flexi-utf-32-be-io-stream flexi-binary-io-stream) - () - (:documentation "Like FLEXI-UTF-32-BE-IO-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-cr-utf-32-be-io-stream (flexi-cr-mixin flexi-binary-utf-32-be-io-stream) - () - (:documentation "Like FLEXI-CR-UTF-32-BE-IO-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-utf-16-le-io-stream (flexi-utf-16-le-io-stream flexi-binary-io-stream) - () - (:documentation "Like FLEXI-UTF-16-LE-IO-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-cr-utf-16-le-io-stream (flexi-cr-mixin flexi-binary-utf-16-le-io-stream) - () - (:documentation "Like FLEXI-CR-UTF-16-LE-IO-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-utf-16-be-io-stream (flexi-utf-16-be-io-stream flexi-binary-io-stream) - () - (:documentation "Like FLEXI-UTF-16-BE-IO-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-cr-utf-16-be-io-stream (flexi-cr-mixin flexi-binary-utf-16-be-io-stream) - () - (:documentation "Like FLEXI-CR-UTF-16-BE-IO-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-utf-8-io-stream (flexi-utf-8-io-stream flexi-binary-io-stream) - () - (:documentation "Like FLEXI-UTF-8-IO-STREAM but -optimized for LispWorks binary streams.")) - -(defclass flexi-binary-cr-utf-8-io-stream (flexi-cr-mixin flexi-binary-utf-8-io-stream) - () - (:documentation "Like FLEXI-CR-UTF-8-IO-STREAM but -optimized for LispWorks binary streams.")) - (defmethod initialize-instance :after ((flexi-stream flexi-output-stream) &rest initargs) "Might change the class of FLEXI-STREAM for optimization purposes. Only needed for LispWorks." - (declare (ignore initargs) - (optimize speed)) + (declare #.*standard-optimize-settings*) + (declare (ignore initargs)) (with-accessors ((stream flexi-stream-stream)) flexi-stream (when (subtypep (stream-element-type stream) 'octet) @@ -304,8 +64,8 @@ (defmethod initialize-instance :after ((flexi-stream flexi-input-stream) &rest initargs) "Might change the class of FLEXI-STREAM for optimization purposes. Only needed for LispWorks." - (declare (ignore initargs) - (optimize speed)) + (declare #.*standard-optimize-settings*) + (declare (ignore initargs)) (with-accessors ((stream flexi-stream-stream)) flexi-stream (when (subtypep (stream-element-type stream) 'octet)

Modified: branches/edi/output.lisp ============================================================================== --- branches/edi/output.lisp (original) +++ branches/edi/output.lisp Mon May 19 04:01:35 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/output.lisp,v 1.49 2008/05/18 22:22:30 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/output.lisp,v 1.50 2008/05/19 07:57:07 edi Exp $

;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved.

@@ -66,11 +66,10 @@ (declare (optimize speed)) (with-accessors ((external-format flexi-stream-external-format)) stream - (let ((*current-stream* stream)) - (char-to-octets external-format - char - (lambda (octet) - (write-byte* octet stream)))))) + (char-to-octets external-format + char + (lambda (octet) + (write-byte* octet stream)))))

(defmethod stream-write-char :after ((stream flexi-output-stream) char) (declare (optimize speed)) @@ -155,7 +154,6 @@ (stream-write-byte flexi-output-stream element)) sequence))))

-#+(or) (defmethod stream-write-sequence ((stream flexi-output-stream) (sequence string) start end &key) "Optimized method for the cases where SEQUENCE is a string. Fills an internal buffer and uses repeated calls to WRITE-SEQUENCE to write @@ -168,15 +166,14 @@ (unless (typep stream 'flexi-binary-output-stream) (return-from stream-write-sequence (call-next-method))) - (let* ((buffer (make-array (+ +buffer-size+ 20) - :element-type '(unsigned-byte 8) - :fill-pointer 0)) - (last-newline-pos (position #\Newline sequence - :test #'char= - :start start - :end end - :from-end t)) - (*current-stream* stream)) + (let ((buffer (make-array (+ +buffer-size+ 20) + :element-type '(unsigned-byte 8) + :fill-pointer 0)) + (last-newline-pos (position #\Newline sequence + :test #'char= + :start start + :end end + :from-end t))) (loop with format = (flexi-stream-external-format stream) for index from start below end do (char-to-octets format

Modified: branches/edi/packages.lisp ============================================================================== --- branches/edi/packages.lisp (original) +++ branches/edi/packages.lisp Mon May 19 04:01:35 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/packages.lisp,v 1.32 2008/05/18 21:32:15 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/packages.lisp,v 1.33 2008/05/19 07:57:08 edi Exp $

;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved.

@@ -41,6 +41,9 @@ :*default-little-endian* :*substitution-char* :external-format-eol-style + :external-format-error + :external-format-error-external-format + :external-format-encoding-error :external-format-equal :external-format-id :external-format-little-endian @@ -51,20 +54,19 @@ :flexi-stream :flexi-stream-bound :flexi-stream-external-format - :flexi-stream-encoding-error :flexi-stream-element-type :flexi-stream-element-type-error :flexi-stream-element-type-error-element-type :flexi-stream-error :flexi-stream-column :flexi-stream-position - :flexi-stream-position-spec-error - :flexi-stream-position-spec-error-position-spec :flexi-stream-stream :get-output-stream-sequence :in-memory-stream :in-memory-stream-closed-error :in-memory-stream-error + :in-memory-stream-position-spec-error + :in-memory-stream-position-spec-error-position-spec :in-memory-input-stream :in-memory-output-stream :list-stream

Modified: branches/edi/specials.lisp ============================================================================== --- branches/edi/specials.lisp (original) +++ branches/edi/specials.lisp Mon May 19 04:01:35 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/specials.lisp,v 1.30 2008/05/18 21:32:15 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/specials.lisp,v 1.31 2008/05/19 07:57:08 edi Exp $

;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved.

@@ -38,14 +38,6 @@ (compilation-speed 0)) "The standard optimize settings used by most declaration expressions.")

-(defvar *current-stream* nil - "The `stream' that is currently read from or written to. Not -necessarily a stream, can be any source or sink, like an array or a -list. Mainly used for error reporting. - -Must be bound to a suitable value when OCTETS-TO-CHAR-CODE or -CHAR-TO-OCTETS are called.") - (defvar *current-unreader* nil "A unary function which might be called to `unread' a character (i.e. the sequence of octets it represents).

Modified: branches/edi/stream.lisp ============================================================================== --- branches/edi/stream.lisp (original) +++ branches/edi/stream.lisp Mon May 19 04:01:35 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/stream.lisp,v 1.59 2008/05/18 01:21:34 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/stream.lisp,v 1.60 2008/05/18 23:14:00 edi Exp $

;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved.

@@ -52,8 +52,8 @@ (defmethod initialize-instance :after ((flexi-stream flexi-stream) &rest initargs) "Makes sure the EXTERNAL-FORMAT and ELEMENT-TYPE slots contain reasonable values." - (declare (ignore initargs) - (optimize speed)) + (declare #.*standard-optimize-settings*) + (declare (ignore initargs)) (with-accessors ((external-format flexi-stream-external-format) (element-type flexi-stream-element-type)) flexi-stream @@ -67,10 +67,12 @@ (defmethod (setf flexi-stream-external-format) :around (new-value (flexi-stream flexi-stream)) "Converts the new value to an EXTERNAL-FORMAT object if necessary." + (declare #.*standard-optimize-settings*) (call-next-method (maybe-convert-external-format new-value) flexi-stream))

(defmethod (setf flexi-stream-element-type) :before (new-value (flexi-stream flexi-stream)) "Checks whether the new value makes sense before it is set." + (declare #.*standard-optimize-settings*) (unless (or (subtypep new-value 'character) (subtypep new-value 'octet)) (error 'flexi-stream-element-type-error @@ -80,13 +82,15 @@ (defmethod stream-element-type ((stream flexi-stream)) "Returns the element type that was provided by the creator of the stream." - (declare (optimize speed)) - (flexi-stream-element-type stream)) + (declare #.*standard-optimize-settings*) + (with-accessors ((element-type flexi-stream-element-type)) + stream + element-type))

(defmethod close ((stream flexi-stream) &key abort) "Closes the flexi stream by closing the underlying `real' stream." - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) (with-accessors ((stream flexi-stream-stream)) stream (cond ((open-stream-p stream) @@ -95,19 +99,24 @@

(defmethod open-stream-p ((stream flexi-stream)) "A flexi stream is open if its underlying stream is open." - (declare (optimize speed)) - (open-stream-p (flexi-stream-stream stream))) + (declare #.*standard-optimize-settings*) + (with-accessors ((stream flexi-stream-stream)) + stream + (open-stream-p stream)))

(defmethod stream-file-position ((stream flexi-stream)) "Dispatch to method for underlying stream." - (declare (optimize speed)) - (stream-file-position (flexi-stream-stream stream))) + (declare #.*standard-optimize-settings*) + (with-accessors ((stream flexi-stream-stream)) + stream + (stream-file-position stream)))

(defmethod (setf stream-file-position) (position-spec (stream flexi-stream)) "Dispatch to method for underlying stream." - (declare (optimize speed)) - (setf (stream-file-position (flexi-stream-stream stream)) - position-spec)) + (declare #.*standard-optimize-settings*) + (with-accessors ((stream flexi-stream-stream)) + stream + (setf (stream-file-position stream) position-spec)))

(defclass flexi-output-stream (flexi-stream fundamental-binary-output-stream fundamental-character-output-stream) @@ -123,7 +132,7 @@ #+:cmu (defmethod input-stream-p ((stream flexi-output-stream)) "Explicitly states whether this is an input stream." - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) nil)

(defclass flexi-input-stream (flexi-stream fundamental-binary-input-stream @@ -166,7 +175,7 @@ #+:cmu (defmethod output-stream-p ((stream flexi-input-stream)) "Explicitly states whether this is an output stream." - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) nil)

(defclass flexi-io-stream (flexi-input-stream flexi-output-stream) @@ -179,13 +188,13 @@ #+:cmu (defmethod input-stream-p ((stream flexi-io-stream)) "Explicitly states whether this is an input stream." - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) t)

#+:cmu (defmethod output-stream-p ((stream flexi-io-stream)) "Explicitly states whether this is an output stream." - (declare (optimize speed)) + (declare #.*standard-optimize-settings*) t)

(defun make-flexi-stream (stream &rest args @@ -207,6 +216,7 @@ streams) should be NIL or an integer. If BOUND is not NIL and POSITION has gone beyond BOUND, then the stream will behave as if no more input is available." + (declare #.*standard-optimize-settings*) ;; these arguments are ignored - they are only there to provide a ;; meaningful parameter list for IDEs (declare (ignore element-type column position bound))

Modified: branches/edi/strings.lisp ============================================================================== --- branches/edi/strings.lisp (original) +++ branches/edi/strings.lisp Mon May 19 04:01:35 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/strings.lisp,v 1.12 2008/05/18 22:22:30 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/strings.lisp,v 1.14 2008/05/19 07:57:08 edi Exp $

;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved.

@@ -38,8 +38,7 @@ (declare (fixnum start end) (string string)) (setq external-format (maybe-convert-external-format external-format)) (let ((factor (encoding-factor external-format)) - (length (- end start)) - (*current-stream* string)) + (length (- end start))) (etypecase factor (float (let ((octets (make-array (round (* factor length)) @@ -47,6 +46,7 @@ :fill-pointer 0 :adjustable t))) (flet ((writer (octet) + ;; TODO: do this manually (vector-push-extend octet octets))) (loop for i of-type fixnum from start below end do (char-to-octets external-format @@ -102,13 +102,11 @@ (prog1 (nth i sequence) (incf i)))))) - (*current-stream* sequence) - (*current-unreader* (lambda (char) - (char-to-octets external-format - char - (lambda (octet) - (declare (ignore octet)) - (decf i)))))) + (*current-unreader* (flet ((pseudo-writer (octet) + (declare (ignore octet)) + (decf i))) + (lambda (char) + (char-to-octets external-format char #'pseudo-writer))))) (declare (fixnum i)) (flet ((next-char () (code-char (octets-to-char-code external-format reader)))) @@ -119,6 +117,7 @@ :fill-pointer 0 :adjustable t))) (loop while (< i end) + ;; TODO: do this manually do (vector-push-extend (next-char) string) finally (return string)))) (integer

Modified: branches/edi/test/test.lisp ============================================================================== --- branches/edi/test/test.lisp (original) +++ branches/edi/test/test.lisp Mon May 19 04:01:35 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS-TEST; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/test/test.lisp,v 1.22 2008/05/18 14:59:04 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/test/test.lisp,v 1.25 2008/05/19 07:57:12 edi Exp $

;;; Copyright (c) 2006-2008, Dr. Edmund Weitz. All rights reserved.

@@ -256,11 +256,40 @@ (terpri *error-output*)) ,successp))))

+(defun old-string-to-octets (string &key + (external-format (make-external-format :latin1)) + (start 0) end) + "The old version of STRING-TO-OCTETS. We can use it to test +in-memory streams." + (declare (optimize speed)) + (with-output-to-sequence (out) + (let ((flexi (make-flexi-stream out :external-format external-format))) + (write-string string flexi :start start :end end)))) + +(defun old-octets-to-string (vector &key + (external-format (make-external-format :latin1)) + (start 0) (end (length vector))) + "The old version of OCTETS-TO-STRING. We can use it to test +in-memory streams." + (declare (optimize speed)) + (with-input-from-sequence (in vector :start start :end end) + (let ((flexi (make-flexi-stream in :external-format external-format)) + (result (make-array (- end start) + :element-type #+:lispworks 'lw:simple-char + #-:lispworks 'character + :fill-pointer t))) + (setf (fill-pointer result) + (read-sequence result flexi)) + result))) + (defun string-test (pathspec external-format) "Tests whether conversion from strings to octets and vice versa using the external format EXTERNAL-FORMAT works as expected, using the contents of the file denoted by PATHSPEC as test data and assuming -that the stream conversion functions work." +that the stream conversion functions work. + +Also tests with the old versions of the conversion functions in order +to test in-memory streams." (let* ((full-path (merge-pathnames pathspec *this-file*)) (octets-vector (file-as-octet-vector full-path)) (octets-list (coerce octets-vector 'list)) @@ -269,27 +298,30 @@ (flex::normalize-external-format external-format))) (check (string= (octets-to-string octets-vector :external-format external-format) string)) (check (string= (octets-to-string octets-list :external-format external-format) string)) - (check (equalp (string-to-octets string :external-format external-format) octets-vector))))) + (check (equalp (string-to-octets string :external-format external-format) octets-vector)) + (check (string= (old-octets-to-string octets-vector :external-format external-format) string)) + (check (string= (old-octets-to-string octets-list :external-format external-format) string)) + (check (equalp (old-string-to-octets string :external-format external-format) octets-vector)))))

(defmacro using-values ((&rest values) &body body) "Executes BODY and feeds an element from VALUES to the USE-VALUE -restart each time a FLEXI-STREAM-ENCODING-ERROR is signalled. Signals -an error when there are more or less FLEXI-STREAM-ENCODING-ERRORs than -there are elements in VALUES." +restart each time a EXTERNAL-FORMAT-ENCODING-ERROR is signalled. +Signals an error when there are more or less +EXTERNAL-FORMAT-ENCODING-ERRORs than there are elements in VALUES." (flex::with-unique-names (value-stack condition-counter) `(let ((,value-stack ',values) (,condition-counter 0)) - (handler-bind ((flexi-stream-encoding-error + (handler-bind ((external-format-encoding-error #'(lambda (c) (declare (ignore c)) (unless ,value-stack - (error "Too many FLEXI-STREAM-ENCODING-ERRORs signalled, expected only ~A." + (error "Too many encoding errors signalled, expected only ~A." ,(length values))) (incf ,condition-counter) (use-value (pop ,value-stack))))) (prog1 (progn ,@body) (when ,value-stack - (error "~A FLEXI-STREAM-ENCODING-ERRORs signalled, but ~A were expected." + (error "~A encoding errors signalled, but ~A were expected." ,condition-counter ,(length values))))))))

(defun read-flexi-line (sequence external-format) @@ -299,9 +331,9 @@ (setq in (make-flexi-stream in :external-format external-format)) (read-line in)))

-(defun encoding-error-handling-test () - "Tests several possible encoding errors and how they are handled." - (with-test ("Handling of encoding errors.") +(defun error-handling-test () + "Tests several possible errors and how they are handled." + (with-test ("Handling of errors.") ;; handling of EOF in the middle of CRLF (check (string= #.(string #\Return) (read-flexi-line `(,(char-code #\Return)) '(:ascii :eol-style :crlf)))) @@ -382,7 +414,7 @@ (dolist (args string-test-args-list) (apply 'string-test args))) (incf no-tests) - (encoding-error-handling-test) + (error-handling-test) (incf no-tests) (unread-char-test) (format *error-output* "~%~%~:[~A of ~A tests failed..~;~*All ~A tests passed~].~%"

Modified: branches/edi/util.lisp ============================================================================== --- branches/edi/util.lisp (original) +++ branches/edi/util.lisp Mon May 19 04:01:35 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: FLEXI-STREAMS; Base: 10 -*- -;;; $Header: /usr/local/cvsrep/flexi-streams/util.lisp,v 1.16 2008/05/18 20:34:53 edi Exp $ +;;; $Header: /usr/local/cvsrep/flexi-streams/util.lisp,v 1.17 2008/05/19 07:57:08 edi Exp $

;;; Copyright (c) 2005-2008, Dr. Edmund Weitz. All rights reserved.

@@ -108,8 +108,9 @@ (unless (find real-name +name-map+ :test #'eq :key #'cdr) - ;; TODO... - (error "~S is not known to be a name for an external format." name)) + (error 'external-format-error + :format-control "~S is not known to be a name for an external format." + :format-arguments (list name))) real-name))

(defun ascii-name-p (name)