Date: Monday, September 20, 2010 @ 19:01:15 Author: rtoy Path: /project/cmucl/cvsroot/src/code
Modified: string.lisp
o Inhibit warnings from SURROGATEP; I'm tired seeing the code deletion notes now. o Tell the compiler what type the first return value of CODEPOINT is. Apparently, the compiler can't figure that out itself.
-------------+ string.lisp | 18 +++++++++++------- 1 file changed, 11 insertions(+), 7 deletions(-)
Index: src/code/string.lisp diff -u src/code/string.lisp:1.26 src/code/string.lisp:1.27 --- src/code/string.lisp:1.26 Wed Sep 15 17:06:38 2010 +++ src/code/string.lisp Mon Sep 20 19:01:15 2010 @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /project/cmucl/cvsroot/src/code/string.lisp,v 1.26 2010-09-15 21:06:38 rtoy Exp $") + "$Header: /project/cmucl/cvsroot/src/code/string.lisp,v 1.27 2010-09-20 23:01:15 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -40,7 +40,9 @@ for. :High means to test for the high (leading) surrogate; :Low tests for the low (trailing surrogate). A value of :Any or Nil tests for any surrogate value (high or low)." - (declare (type (or character codepoint) char-or-code)) + (declare (type (or character codepoint) char-or-code) + (type (or null (member :high :leading :low :trailing :any)) surrogate-type) + (optimize (inhibit-warnings 3))) (let ((code (if (characterp char-or-code) (char-code char-or-code) char-or-code))) @@ -74,14 +76,16 @@ (cond ((and (surrogatep code :high) (< (1+ i) end)) (let ((tmp (char-code (schar string (1+ i))))) (if (surrogatep tmp :low) - (values (+ (ash (- code #xD800) 10) tmp #x2400) +1) - (values code nil)))) + (values (truly-the codepoint (+ (ash (- code #xD800) 10) tmp #x2400)) + +1) + (values (truly-the codepoint code) nil)))) ((and (surrogatep code :low) (> i 0)) (let ((tmp (char-code (schar string (1- i))))) (if (surrogatep tmp :high) - (values (+ (ash (- tmp #xD800) 10) code #x2400) -1) - (values code nil)))) - (t (values code nil))))) + (values (truly-the codepoint (+ (ash (- tmp #xD800) 10) code #x2400)) + -1) + (values (truly-the codepoint code) nil)))) + (t (values (truly-the codepoint code) nil)))))
(defun surrogates (codepoint) "Return the high and low surrogate characters for Codepoint. If