[cmucl-cvs] CMUCL commit: src/code (string.lisp)

[Raymond Toy]

    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