Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-22 07:09:18 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Adding full unicode digit-value.

Browse source
This commit is contained in:
Alex Shinn 2012-11-11 13:38:17 +09:00
parent 5dbc970422
commit 2f5f7f73c7
4 changed files with 73 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
lib/init-7.scm
View file

@ -369,11 +369,6 @@
(if (<= n 9)
(integer->char (+ n (char->integer #\0)))
(integer->char (+ (- n 10) (char->integer #\A)))))
(define (digit-value ch)
(if (char-numeric? ch)
(- (char->integer ch) (char->integer #\0))
(and (<= 65 (char->integer (char-upcase ch)) 70)
(- (char->integer (char-upcase ch)) 55))))
(define (%number->string num)
(call-with-output-string (lambda (out) (write num out))))

4
lib/scheme/char.sld
View file

@ -5,8 +5,7 @@
(full-unicode
(import (chibi char-set full)
(chibi char-set base)
(chibi iset base)
(only (chibi) digit-value))
(chibi iset base))
(include "char/full.scm")
(include "char/case-offsets.scm"))
(else
@ -18,6 +17,7 @@
char-alphabetic? char-lower-case? char-numeric?
char-upper-case? char-whitespace? digit-value
char-upcase char-downcase))))
(include "digit-value.scm")
(export
char-alphabetic? char-ci<=? char-ci<? char-ci=? char-ci>=? char-ci>?
char-downcase char-foldcase char-lower-case? char-numeric?

64
lib/scheme/digit-value.scm Normal file
View file

@ -0,0 +1,64 @@
(cond-expand
(full-unicode
(define zeros
'#(#\x0030 ;DIGIT ZERO
#\x0660 ;ARABIC-INDIC DIGIT ZERO
#\x06F0 ;EXTENDED ARABIC-INDIC DIGIT ZERO
#\x07C0 ;NKO DIGIT ZERO
#\x0966 ;DEVANAGARI DIGIT ZERO
#\x09E6 ;BENGALI DIGIT ZERO
#\x0A66 ;GURMUKHI DIGIT ZERO
#\x0AE6 ;GUJARATI DIGIT ZERO
#\x0B66 ;ORIYA DIGIT ZERO
#\x0BE6 ;TAMIL DIGIT ZERO
#\x0C66 ;TELUGU DIGIT ZERO
#\x0CE6 ;KANNADA DIGIT ZERO
#\x0D66 ;MALAYALAM DIGIT ZERO
#\x0E50 ;THAI DIGIT ZERO
#\x0ED0 ;LAO DIGIT ZERO
#\x0F20 ;TIBETAN DIGIT ZERO
#\x1040 ;MYANMAR DIGIT ZERO
#\x1090 ;MYANMAR SHAN DIGIT ZERO
#\x17E0 ;KHMER DIGIT ZERO
#\x1810 ;MONGOLIAN DIGIT ZERO
#\x1946 ;LIMBU DIGIT ZERO
#\x19D0 ;NEW TAI LUE DIGIT ZERO
#\x1A80 ;TAI THAM HORA DIGIT ZERO
#\x1A90 ;TAI THAM THAM DIGIT ZERO
#\x1B50 ;BALINESE DIGIT ZERO
#\x1BB0 ;SUNDANESE DIGIT ZERO
#\x1C40 ;LEPCHA DIGIT ZERO
#\x1C50 ;OL CHIKI DIGIT ZERO
#\xA620 ;VAI DIGIT ZERO
#\xA8D0 ;SAURASHTRA DIGIT ZERO
#\xA900 ;KAYAH LI DIGIT ZERO
#\xA9D0 ;JAVANESE DIGIT ZERO
#\xAA50 ;CHAM DIGIT ZERO
#\xABF0 ;MEETEI MAYEK DIGIT ZERO
#\xFF10 ;FULLWIDTH DIGIT ZERO
#\x104A0 ;OSMANYA DIGIT ZERO
#\x11066 ;BRAHMI DIGIT ZERO
#\x1D7CE ;MATHEMATICAL BOLD DIGIT ZERO
#\x1D7D8 ;MATHEMATICAL DOUBLE-STRUCK DIGIT ZERO
#\x1D7E2 ;MATHEMATICAL SANS-SERIF DIGIT ZERO
#\x1D7EC ;MATHEMATICAL SANS-SERIF BOLD DIGIT ZERO
#\x1D7F6 ;MATHEMATICAL MONOSPACE DIGIT ZERO
)))
(else
(define zeros #(#\0))))
(define (digit-value ch)
(let ((n (char->integer ch)))
(let lp ((lo 0) (hi (- (vector-length zeros) 1)))
(if (> lo hi)
#f
(let* ((mid (+ lo (quotient (- hi lo) 2)))
(mid-zero (char->integer (vector-ref zeros mid))))
(cond
((<= mid-zero n (+ mid-zero 9))
(- n mid-zero))
((< n mid-zero)
(lp lo (- mid 1)))
(else
(lp (+ mid 1) hi))))))))

10
tests/r7rs-tests.scm
View file

@ -855,9 +855,13 @@
(test #f (char-lower-case? #\A))
(test #f (char-lower-case? #\3))
(test 0 (digit-value #\0))
(test 3 (digit-value #\3))
;; (test 4 (digit-value #\x0664))
;; (test 0 (digit-value #\x0EA6))
(test 9 (digit-value #\9))
(test 4 (digit-value #\x0664))
(test 0 (digit-value #\x0AE6))
(test #f (digit-value #\.))
(test #f (digit-value #\-))
(test 97 (char->integer #\a))
(test #\a (integer->char 97))
@ -1468,7 +1472,7 @@
;; Each test is of the form:
;;
;; (input-str expected-value (expected-write-values ...))
;; (input-str expected-value expected-write-values ...)
;;
;; where the input should be eqv? to the expected-value, and the
;; written output the same as any of the expected-write-values. The