[flexi-streams-cvs] r31 - in branches/edi: . doc test
eweitz at common-lisp.net
eweitz at common-lisp.net
Mon May 19 08:01:37 UTC 2008
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/">http://arcanes.fr.eu.org/~pierre/2007/02/weitz/</a>
thanks to Pierre Thierry.
-<!-- this chapter may be removed after several versions -->
-<br> <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"><code>USE-VALUE</code>
-restart</a>
-when a <a
-href="#flexi-stream-encoding-error"><code>FLEXI-STREAM-ENCODING-ERROR</code></a>
-is signalled.
-
<br> <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> => <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 > (defun foo ()
@@ -770,7 +774,7 @@
"xy"
T
-CL-USER 5 > (<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 > (<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> => <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> => <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 , at 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)
More information about the Flexi-streams-cvs
mailing list