From: Chris Hanson <org/chris-hanson/cph>
Date: Mon, 30 Jan 2017 01:56:53 +0000 (-0800)
Subject: Fix implementation of unicode-scalar-value? to not exclude non-characters.
X-Git-Tag: mit-scheme-pucked-9.2.12~227^2~31
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=67ee14b0644966550001d9fd3f24839e4c431a6b;p=mit-scheme.git

Fix implementation of unicode-scalar-value? to not exclude non-characters.

Also implement unicode-code-point?.
---

diff --git a/src/runtime/char.scm b/src/runtime/char.scm
index 3d89aa3b2..499eafb08 100644
--- a/src/runtime/char.scm
+++ b/src/runtime/char.scm
@@ -339,29 +339,28 @@ USA.
 
 (define (unicode-char? object)
   (and (char? object)
-       (legal-code-32? (char->integer object))))
+       (let ((n (char->integer object)))
+	 (and (unicode-scalar-value? n)
+	      (not (non-character? n))))))
 
-(define (unicode-scalar-value? object)
+(define-integrable (unicode-code-point? object)
   (and (index-fixnum? object)
-       (legal-code-32? object)))
+       (fix:< object char-code-limit)))
+
+(define (unicode-scalar-value? object)
+  (and (unicode-code-point? object)
+       (not (utf16-surrogate? object))))
 
 (define-guarantee unicode-char "a Unicode character")
 (define-guarantee unicode-scalar-value "a Unicode scalar value")
 
 (define (unicode-char->scalar-value char #!optional caller)
-  (let ((cp (char->integer char)))
-    (if (not (legal-code-32? cp))
-	(error:not-a unicode-char? char caller))
-    cp))
-
-(define-integrable (legal-code-32? cp)
-  (and (fix:< cp char-code-limit)
-       (not (utf16-surrogate? cp))
-       (not (non-character? cp))))
+  (guarantee unicode-char? char caller)
+  (char->integer char))
 
-(define (legal-code-16? pt)
-  (and (not (utf16-surrogate? pt))
-       (not (non-character? pt))))
+(define (unicode-scalar-value->char sv #!optional caller)
+  (guarantee unicode-scalar-value? sv caller)
+  (integer->char sv))
 
 (define-integrable (utf16-surrogate? cp)
   (fix:= #xD800 (fix:and #xF800 cp)))
diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 9eb7d8900..80032d950 100644
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -1392,6 +1392,8 @@ USA.
 	  set-char-bits
 	  unicode-char->scalar-value
 	  unicode-char?
+	  unicode-code-point?
+	  unicode-scalar-value->char
 	  unicode-scalar-value?)
   (initialization (initialize-package!)))