[cmucl-cvs] CMUCL commit: src/code (intl.lisp)
Raymond Toy
rtoy at common-lisp.net
Sun Dec 19 03:01:48 UTC 2010
Date: Saturday, December 18, 2010 @ 22:01:48
Author: rtoy
Path: /project/cmucl/cvsroot/src/code
Modified: intl.lisp
Oops. If the domain-entry-encoding is NIL, we just want to return
NIL. (From Paul Foley.)
-----------+
intl.lisp | 74 ++++++++++++++++++++++++++++++------------------------------
1 file changed, 37 insertions(+), 37 deletions(-)
Index: src/code/intl.lisp
diff -u src/code/intl.lisp:1.10 src/code/intl.lisp:1.11
--- src/code/intl.lisp:1.10 Sun Dec 12 19:19:38 2010
+++ src/code/intl.lisp Sat Dec 18 22:01:47 2010
@@ -1,6 +1,6 @@
;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Package: INTL -*-
-;;; $Revision: 1.10 $
+;;; $Revision: 1.11 $
;;; Copyright 1999-2010 Paul Foley (mycroft at actrix.gen.nz)
;;;
;;; Permission is hereby granted, free of charge, to any person obtaining
@@ -23,7 +23,7 @@
;;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE
;;; USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
;;; DAMAGE.
-(ext:file-comment "$Header: /project/cmucl/cvsroot/src/code/intl.lisp,v 1.10 2010-12-13 00:19:38 rtoy Exp $")
+(ext:file-comment "$Header: /project/cmucl/cvsroot/src/code/intl.lisp,v 1.11 2010-12-19 03:01:47 rtoy Exp $")
(in-package "INTL")
@@ -468,42 +468,42 @@
(defun domain-lookup-plural (singular plural domain)
(declare (type string singular plural) (type domain-entry domain)
#+(or)(optimize (speed 3) (space 2) (safety 0)))
- (or (if (null (domain-entry-encoding domain)) nil)
- (gethash (cons singular plural) (domain-entry-hash domain))
- (let* ((octets (let* ((a (string-to-octets singular
- (domain-entry-encoding domain)))
- (b (string-to-octets plural
- (domain-entry-encoding domain)))
- (c (make-array (+ (length a) (length b) 1)
- :element-type '(unsigned-byte 8))))
- (declare (type (simple-array (unsigned-byte 8) (*))
- a b c))
- (replace c a)
- (setf (aref c (length a)) 0)
- (replace c b :start1 (+ (length a) 1))
- c))
- (length (length octets))
- (pos (gethash length (domain-entry-hash domain))))
- (declare (type (simple-array (unsigned-byte 8) (*)) octets)
- (type list pos))
- (multiple-value-bind (tmp entry) (search-domain octets domain pos)
- (declare (type (or null (simple-array (unsigned-byte 8) (*))) tmp))
- (when tmp
- (prog1
- (setf (gethash (cons (copy-seq singular) (copy-seq plural))
- (domain-entry-hash domain))
- (loop for i = 0 then (1+ j)
+ (when (domain-entry-encoding domain)
+ (or (gethash (cons singular plural) (domain-entry-hash domain))
+ (let* ((octets (let* ((a (string-to-octets singular
+ (domain-entry-encoding domain)))
+ (b (string-to-octets plural
+ (domain-entry-encoding domain)))
+ (c (make-array (+ (length a) (length b) 1)
+ :element-type '(unsigned-byte 8))))
+ (declare (type (simple-array (unsigned-byte 8) (*))
+ a b c))
+ (replace c a)
+ (setf (aref c (length a)) 0)
+ (replace c b :start1 (+ (length a) 1))
+ c))
+ (length (length octets))
+ (pos (gethash length (domain-entry-hash domain))))
+ (declare (type (simple-array (unsigned-byte 8) (*)) octets)
+ (type list pos))
+ (multiple-value-bind (tmp entry) (search-domain octets domain pos)
+ (declare (type (or null (simple-array (unsigned-byte 8) (*))) tmp))
+ (when tmp
+ (prog1
+ (setf (gethash (cons (copy-seq singular) (copy-seq plural))
+ (domain-entry-hash domain))
+ (loop for i = 0 then (1+ j)
as j = (position 0 tmp :start i)
- collect (octets-to-string (subseq tmp i j)
- (domain-entry-encoding domain))
- while j))
- (let ((temp (delete entry pos :test #'eq)))
- (if temp
- (setf (gethash length (domain-entry-hash domain)) temp)
- (remhash length (domain-entry-hash domain))))
- (when (null (domain-entry-plurals domain))
- (setf (domain-entry-plurals domain)
- (parse-plurals domain)))))))))
+ collect (octets-to-string (subseq tmp i j)
+ (domain-entry-encoding domain))
+ while j))
+ (let ((temp (delete entry pos :test #'eq)))
+ (if temp
+ (setf (gethash length (domain-entry-hash domain)) temp)
+ (remhash length (domain-entry-hash domain))))
+ (when (null (domain-entry-plurals domain))
+ (setf (domain-entry-plurals domain)
+ (parse-plurals domain))))))))))
(declaim (inline getenv)
(ftype (function (string) (or null string)) getenv))
More information about the cmucl-cvs
mailing list