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 3d89aa3b2c0575b1c7aed3a4450cbbf355e28c5b..499eafb087cdd70de2a76763bc12c438b9ef3538 100644 (file)
--- 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 9eb7d89004b62cb48251e589ebeb0cc45ba8f6aa..80032d950a4577f0178af8358d114a1abdf5d32d 100644 (file)
--- 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!)))