(>= 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:
(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))