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))