[flexi-streams-cvs] r13 - branches/hans
hhubner at common-lisp.net
hhubner at common-lisp.net
Thu May 8 16:18:16 UTC 2008
Author: hhubner
Date: Thu May 8 12:18:11 2008
New Revision: 13
Modified:
branches/hans/input.lisp
branches/hans/output.lisp
Log:
Incorporate review comments from Edi
Modified: branches/hans/input.lisp
==============================================================================
--- branches/hans/input.lisp (original)
+++ branches/hans/input.lisp Thu May 8 12:18:11 2008
@@ -242,40 +242,39 @@
(decf position)
(push #.(char-code #\Return) octet-stack)))))
+(declaim (inline code-char-with-newline-processing))
(defun code-char-with-newline-processing (char-code eol-style read-char-code-fn unread-char-code-fn)
"Perform newline conversion during octets-to-string processing.
CHAR-CODE is the code of the current character. If it denotes a
-#\Return character, newline processing accoring to EOL-STYLE is
+#\Return character, newline processing according to EOL-STYLE is
performed. READ-CHAR-CODE-FN and UNREAD-CHAR-CODE-FN are called to
read the next character code from the input, unread-char-code-fn is
called to skip back in the input by one octet. All this works under
the assumption that #\Return and #\Linefeed are single-octet codes."
- (declare (optimize speed (safety 0))
- (type fixnum char-code)
- (type symbol eol-style))
- (let ((char (code-char char-code)))
- (if (eql char #\Return)
- (case eol-style
- (:cr
- #\Newline)
- (:crlf
- (case (funcall read-char-code-fn)
- (:eof
- :eof)
- (#.(char-code #\Newline)
- #\Newline)
- (t
- (funcall unread-char-code-fn)
- #\Return)))
- (t
- #\Return))
- char)))
-(declaim (inline code-char-with-newline-processing))
+ (if (eql char-code :eof)
+ (return-from code-char-with-newline-processing :eof)
+ (let ((char (code-char char-code)))
+ (if (eql char #\Return)
+ (case eol-style
+ (:cr
+ #\Newline)
+ (:crlf
+ (case (funcall read-char-code-fn)
+ (:eof
+ :eof)
+ (#.(char-code #\Linefeed)
+ #\Newline)
+ (t
+ (funcall unread-char-code-fn)
+ #\Return)))
+ (t
+ #\Return))
+ char))))
-(defmacro define-char-reader ((stream-var stream-class) &body body)
+(defmacro define-char-reader ((stream stream-class) &body body)
"Helper macro to define methods for STREAM-READ-CHAR and
OCTETS-TO-STRING%. Defines a method for the class STREAM-CLASS using
-the variable STREAM-VAR and the code body BODY wrapped with some
+the variable STREAM and the code body BODY wrapped with some
standard code common to all methods defined here. The return value of
BODY is a character code. In case of encoding problems, BODY must
return the value returned by \(RECOVER-FROM-ENCODING-ERROR ...). In
@@ -284,15 +283,15 @@
the second argument being the vector of octets to convert and the
BEGIN and END keyword arguments which can be used to limit the
conversion to a subsequence of the octet vector."
- (with-unique-names (char-code body-fn octets-var)
+ (with-unique-names (char-code body-fn octets)
(let ((body body))
`(progn
- (defmethod stream-read-char ((,stream-var ,stream-class))
+ (defmethod stream-read-char ((,stream ,stream-class))
"This method was generated with the DEFINE-CHAR-READER macro."
(declare (optimize speed))
(with-accessors ((last-octet flexi-stream-last-octet)
(last-char-code flexi-stream-last-char-code))
- ,stream-var
+ ,stream
;; set LAST-OCTET slot to NIL because we can't UNREAD-BYTE after
;; this operation
(setq last-octet nil)
@@ -304,16 +303,18 @@
;; for UNREAD-CHAR
(setq last-char-code ,char-code)
(or (code-char ,char-code) ,char-code))))
- (defmethod octets-to-string% ((,stream-var ,stream-class) ,octets-var &key start end)
+ (defmethod octets-to-string% ((,stream ,stream-class) ,octets &key start end)
(let ((position start)
save-position
- (eol-style (external-format-eol-style (flexi-stream-external-format ,stream-var)))
- (string (make-array (- end start) :element-type 'character :fill-pointer 0)))
+ (eol-style (external-format-eol-style (flexi-stream-external-format ,stream)))
+ (string (make-array (- end start)
+ :element-type #-:lispworks 'character #+:lispworks 'lw:simple-char
+ :fill-pointer 0)))
;; High-speed version of OCTETS-TO-STRING: We need to
;; implement this as a macro as we want to stay with the
;; old "inner" API for bodies of character readers. In
;; particular, they shall be able to call (READ-BYTE*
- ;; STREAM) as before. To achive this, we create a local
+ ;; STREAM) as before. To achieve this, we create a local
;; function READ-BYTE* that gets the next byte from the
;; input vector. Additionally, we create local functions
;; for reading characters in a loop and for unreading a
@@ -323,7 +324,7 @@
(declare (ignore stream))
(when (< position end)
(prog1
- (aref ,octets-var position)
+ (aref ,octets position)
(incf position))))
(read-char-code ()
(setf save-position position)
@@ -331,15 +332,15 @@
, at body))
(unread-char-code ()
(setf position save-position)))
- (do ((char-code (read-char-code) (read-char-code)))
- ((eql char-code :eof)
- string)
- (vector-push (or (code-char-with-newline-processing char-code
- eol-style
- #'read-char-code
- #'unread-char-code)
- char-code)
- string)))))))))
+ (loop
+ for char = (code-char-with-newline-processing (read-char-code)
+ eol-style
+ #'read-char-code
+ #'unread-char-code)
+ until (eql char :eof)
+ do (format t "char ~S~%" char)
+ do (vector-push char string))
+ string)))))))
(defun recover-from-encoding-error (flexi-stream format-control &rest format-args)
"Helper function used by the STREAM-READ-CHAR methods below to deal
Modified: branches/hans/output.lisp
==============================================================================
--- branches/hans/output.lisp (original)
+++ branches/hans/output.lisp Thu May 8 12:18:11 2008
@@ -78,26 +78,26 @@
(declare (optimize speed))
(char-to-octets stream char stream))
-(defmacro define-char-writer (((stream-var stream-class) char-var sink-var) &body body)
+(defmacro define-char-writer (((stream stream-class) char sink) &body body)
(let ((body body))
- (with-unique-names (string-var start-var end-var dummy-sink-var byte-var i-var)
+ (with-unique-names (string start end dummy-sink byte i)
`(progn
- (defmethod char-to-octets ((,stream-var ,stream-class) ,char-var ,sink-var)
+ (defmethod char-to-octets ((,stream ,stream-class) ,char ,sink)
(declare (optimize speed))
, at body)
- (defmethod string-to-octets% ((,stream-var ,stream-class) ,string-var ,start-var ,end-var)
+ (defmethod string-to-octets% ((,stream ,stream-class) ,string ,start ,end)
(declare (optimize speed))
- (let ((,sink-var (make-array (truncate (* (float (- ,end-var ,start-var))
- (flexi-stream-output-size-factor ,stream-var)))
- :adjustable t :fill-pointer 0 :element-type '(unsigned-byte 8))))
+ (let ((,sink (make-array (truncate (* (- ,end ,start)
+ (flexi-stream-output-size-factor ,stream)))
+ :adjustable t :fill-pointer 0 :element-type '(unsigned-byte 8))))
(loop
- for ,i-var of-type fixnum from ,start-var below ,end-var
- for ,char-var of-type character = (aref ,string-var ,i-var)
- do (flet ((write-byte* (,byte-var ,dummy-sink-var)
- (declare (ignore ,dummy-sink-var))
- (vector-push-extend ,byte-var ,sink-var)))
+ for ,i of-type fixnum from ,start below ,end
+ for ,char of-type character = (aref ,string ,i)
+ do (flet ((write-byte* (,byte ,dummy-sink)
+ (declare (ignore ,dummy-sink))
+ (vector-push-extend ,byte ,sink)))
, at body))
- ,sink-var))))))
+ ,sink))))))
(define-char-writer ((stream flexi-latin-1-output-stream) char sink)
(let ((octet (char-code char)))
@@ -125,31 +125,31 @@
(define-char-writer ((stream flexi-utf-8-output-stream) char sink)
(let ((char-code (char-code char)))
(tagbody
- (cond ((< char-code #x80)
- (write-byte* char-code sink)
- (go zero))
- ((< char-code #x800)
- (write-byte* (logior #b11000000 (ldb (byte 5 6) char-code)) sink)
- (go one))
- ((< char-code #x10000)
- (write-byte* (logior #b11100000 (ldb (byte 4 12) char-code)) sink)
- (go two))
- ((< char-code #x200000)
- (write-byte* (logior #b11110000 (ldb (byte 3 18) char-code)) sink)
- (go three))
- ((< char-code #x4000000)
- (write-byte* (logior #b11111000 (ldb (byte 2 24) char-code)) sink)
- (go four))
- (t (write-byte* (logior #b11111100 (ldb (byte 1 30) char-code)) sink)))
- (write-byte* (logior #b10000000 (ldb (byte 6 24) char-code)) sink)
+ (cond ((< char-code #x80)
+ (write-byte* char-code sink)
+ (go zero))
+ ((< char-code #x800)
+ (write-byte* (logior #b11000000 (ldb (byte 5 6) char-code)) sink)
+ (go one))
+ ((< char-code #x10000)
+ (write-byte* (logior #b11100000 (ldb (byte 4 12) char-code)) sink)
+ (go two))
+ ((< char-code #x200000)
+ (write-byte* (logior #b11110000 (ldb (byte 3 18) char-code)) sink)
+ (go three))
+ ((< char-code #x4000000)
+ (write-byte* (logior #b11111000 (ldb (byte 2 24) char-code)) sink)
+ (go four))
+ (t (write-byte* (logior #b11111100 (ldb (byte 1 30) char-code)) sink)))
+ (write-byte* (logior #b10000000 (ldb (byte 6 24) char-code)) sink)
four
- (write-byte* (logior #b10000000 (ldb (byte 6 18) char-code)) sink)
+ (write-byte* (logior #b10000000 (ldb (byte 6 18) char-code)) sink)
three
- (write-byte* (logior #b10000000 (ldb (byte 6 12) char-code)) sink)
+ (write-byte* (logior #b10000000 (ldb (byte 6 12) char-code)) sink)
two
- (write-byte* (logior #b10000000 (ldb (byte 6 6) char-code)) sink)
+ (write-byte* (logior #b10000000 (ldb (byte 6 6) char-code)) sink)
one
- (write-byte* (logior #b10000000 (ldb (byte 6 0) char-code)) sink)
+ (write-byte* (logior #b10000000 (ldb (byte 6 0) char-code)) sink)
zero))
char)
@@ -202,7 +202,7 @@
(case (external-format-eol-style external-format)
(:cr (call-next-method stream #\Return sink))
(:crlf (call-next-method stream #\Return sink)
- (call-next-method stream #\Linefeed sink))))
+ (call-next-method stream #\Linefeed sink))))
(otherwise (call-next-method)))
char))
More information about the Flexi-streams-cvs
mailing list