Extend DIGIT-CHAR-P to include all HexDigit characters.
authorKen Harris <kengruven@gmail.com>
Sun, 2 Jun 2013 17:31:06 +0000 (10:31 -0700)
committerKen Harris <kengruven@gmail.com>
Sun, 2 Jun 2013 17:31:06 +0000 (10:31 -0700)
src/char.lisp
tests/characters.lisp

index 2a36d91..645597c 100644 (file)
@@ -254,21 +254,26 @@ character exists."
        (>= weight 0) (< weight radix) (< weight 36)
        (code-char (if (< weight 10) (+ 48 weight) (+ 55 weight)))))
 
-;; borrowed from my proposed fix to SBCL: https://bugs.launchpad.net/sbcl/+bug/1177986
+;; From comment #4 on <https://bugs.launchpad.net/sbcl/+bug/1177986>:
 (defun digit-char-p (char &optional (radix 10))
-  (let ((number (unicode-digit-value char))
-        (code (char-code char))
-        (little-a (char-code #\a))
-        (big-a (char-code #\A)))
-    (cond ((and number (< number radix))
-           number)
-          (number
-           nil)
-          ((<= big-a code (+ big-a radix -10 -1))
-           (+ code (- big-a) 10))
-          ((<= little-a code (+ little-a radix -10 -1))
-           (+ code (- little-a) 10))
-          (t nil))))
+  "Includes ASCII 0-9 a-z A-Z, plus Unicode HexDigit characters (fullwidth variants of 0-9 and A-F)."
+  (let* ((number (unicode-digit-value char))
+        (code (char-code char))
+        (upper (char-upcase char))
+        (code-upper (char-code upper))
+        (potential (cond (number number)
+                         ((char<= #\0 char #\9)
+                          (- code (char-code #\0)))
+                         ((<= 65296 code 65305)  ;; FULLWIDTH_DIGIT_ZERO, FULLWIDTH_DIGIT_NINE
+                          (- code 65296))
+                         ((char<= #\A upper #\Z)
+                          (+ 10 (- code-upper (char-code #\A))))
+                         ((<= 65313 (char-code upper) 65318)  ;; FULLWIDTH_LATIN_CAPITAL_LETTER_A, FULLWIDTH_LATIN_CAPITAL_LETTER_F
+                          (+ 10 (- code-upper 65313)))
+                         (t nil))))
+    (if (and potential (< potential radix))
+       potential
+      nil)))
 
 (defun graphic-char-p (char)
   ;; from SBCL/CMUCL:
index aa8388e..a745051 100644 (file)
 (test (null (digit-char-p #\a)))
 (test (= 10 (digit-char-p #\A 11)))
 (test (= 10 (digit-char-p #\a 11)))
-;; TODO: does the mapcar/lambda thing work here?
+;; (mapcar #'(lambda (radix)
+;;              (map 'list #'(lambda (x) (digit-char-p x radix))
+;;                   "059AaFGZ"))
+;;          '(2 8 10 16 36))
 
 ;; GRAPHIC-CHAR-P
 (test (graphic-char-p #\G))