From c688af8f42d54d5d313cb890c2dad73cb60f5551 Mon Sep 17 00:00:00 2001 From: rtoy <rtoy> Date: Mon, 20 Sep 2010 23:01:15 +0000 Subject: [PATCH] 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. --- code/string.lisp | 18 +++++++++++------- 1 file changed, 11 insertions(+), 7 deletions(-) diff --git a/code/string.lisp b/code/string.lisp index cbea623ec..f84ae5a89 100644 --- a/code/string.lisp +++ b/code/string.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/string.lisp,v 1.26 2010/09/15 21:06:38 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/string.lisp,v 1.27 2010/09/20 23:01:15 rtoy Rel $") ;;; ;;; ********************************************************************** ;;; @@ -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 -- GitLab