[flexi-streams-cvs] r28 - branches/edi

[eweitz at common-lisp.net]

Author: eweitz
Date: Sun May 18 10:01:12 2008
New Revision: 28

Modified:
   branches/edi/strings.lisp
Log:
Reduce consing


Modified: branches/edi/strings.lisp
==============================================================================
--- branches/edi/strings.lisp	(original)
+++ branches/edi/strings.lisp	Sun May 18 10:01:12 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.8 2008/05/18 01:21:34 edi Exp $
+;;; $Header: /usr/local/cvsrep/flexi-streams/strings.lisp,v 1.9 2008/05/18 13:59:13 edi Exp $
 
 ;;; Copyright (c) 2005-2008, Dr. Edmund Weitz.  All rights reserved.
 
@@ -36,31 +36,33 @@
 octets corresponding to the external format EXTERNAL-FORMAT."
   (setq external-format (maybe-convert-external-format external-format))
   (let ((factor (encoding-factor external-format))
-        (length (- end start)))
+        (length (- end start)))    
     (etypecase factor
       (float
        (let ((octets (make-array (round (* factor length))
                                  :element-type 'octet
                                  :fill-pointer 0
                                  :adjustable t)))
-         (loop for i from start below end
-               do (char-to-octets external-format
-                                  (char string i)
-                                  (lambda (octet)
-                                    (vector-push-extend octet octets))
-                                  nil))
+         (flet ((writer (octet)
+                  (vector-push-extend octet octets)))
+           (loop for i from start below end
+                 do (char-to-octets external-format
+                                    (char string i)
+                                    #'writer
+                                    nil)))
          octets))
       (integer
        (let ((octets (make-array (* factor length)
-                                 :element-type 'octet)))
-         (loop with j = 0
-               for i from start below end
-               do (char-to-octets external-format
-                                  (char string i)
-                                  (lambda (octet)
-                                    (setf (aref octets j) octet)
-                                    (incf j))
-                                  nil))
+                                 :element-type 'octet))
+             (j 0))
+         (flet ((writer (octet)
+                  (setf (aref octets j) octet)
+                  (incf j)))
+           (loop for i from start below end do
+                 (char-to-octets external-format
+                                 (char string i)
+                                 #'writer
+                                 nil)))
          octets)))))
 
 (defun octets-to-string (vector &key
@@ -72,24 +74,27 @@
   (let ((factor (encoding-factor external-format))
         (length (- end start))
         (i start))
-    (flet ((next-char ()
-             (code-char
-              (octets-to-char-code external-format
-                                   (lambda ()
-                                     (when (>= i end)
-                                       ;; TODO...
-                                       (error "End of data."))
-                                     (prog1
-                                         (aref vector i)
-                                       (incf i)))
-                                   (lambda (char)
-                                     (char-to-octets external-format
-                                                     char
-                                                     (lambda (octet)
-                                                       (declare (ignore octet))
-                                                       (decf i))
-                                                     nil))
-                                   nil))))
+    (labels ((reader ()
+               (when (>= i end)
+                 ;; TODO...
+                 (error "End of data."))
+               (prog1
+                   (aref vector i)
+                 (incf i)))
+             (pseudo-writer (octet)
+               (declare (ignore octet))
+               (decf i))
+             (unreader (char)
+               (char-to-octets external-format
+                               char
+                               #'pseudo-writer
+                               nil))
+             (next-char ()
+               (code-char
+                (octets-to-char-code external-format
+                                     #'reader
+                                     #'unreader
+                                     nil))))
       (etypecase factor
         (float
          (let ((string (make-array (round (/ length factor))