conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

* Added char-downcase, char-upcase, char-titlecase, and char-foldcase

This commit is contained in:
Abdulaziz Ghuloum 2007-06-17 17:20:19 +03:00
parent e28c1a6de7
commit df9ef4849d
8 changed files with 57 additions and 49 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.bzrignore
View File

@ -18,3 +18,4 @@ benchmarks/results.MzScheme-r6rs
benchmarks/results.Petite-Chez-Scheme-r5rs
benchmarks/results.Petite-Chez-Scheme-r6rs
benchmarks/results.Scheme48-r6rs
junk

BIN
src/ikarus.boot
View File

Binary file not shown.

12
src/ikarus.numerics.ss
View File

@ -116,8 +116,8 @@
(define (flabs x)
(if (flonum? x)
(if (flnegative? x)
(fl* x -1.0)
(if ($fl> x 0.0)
($fl* x -1.0)
x)
(error 'flabs "~s is not a flonum" x)))
)
@ -441,7 +441,7 @@
(foreign-call "ikrt_fxbnminus" x y)]
[(flonum? y)
(if ($fx= x 0)
(fl* y -1.0)
($fl* y -1.0)
($fl- (fixnum->flonum x) y))]
[(ratnum? y)
(let ([n ($ratnum-n y)] [d ($ratnum-d y)])
@ -881,7 +881,7 @@
(if ($bignum-positive? x) x (- x))]
[(flonum? x)
(if ($flnegative? x)
(fl* x -1.0)
($fl* x -1.0)
x)]
[(ratnum? x)
(let ([n ($ratnum-n x)])
@ -1287,7 +1287,7 @@
(f (fl- ac (car rest)) (cdr rest))))]
[(x)
(if (flonum? x)
(fl- 0.0 x)
($fl* -1.0 x)
(error 'fl+ "~s is not a flonum" x))]))
(define fl*
@ -1532,7 +1532,7 @@
(define flnegative?
(lambda (x)
(if (flonum? x)
($flnegative? x)
($fl< x 0.0)
(error 'flnegative? "~s is not a flonum" x))))
(define exact-integer-sqrt

2
src/ikarus.reader.ss
View File

@ -6,7 +6,7 @@
(ikarus system $fx)
(ikarus system $pairs)
(ikarus system $bytevectors)
(ikarus unicode-data)
(only (ikarus unicode-data) unicode-printable-char?)
(except (ikarus) read read-token comment-handler))
(define delimiter?

2
src/ikarus.writer.ss
View File

@ -10,7 +10,7 @@
(ikarus system $pairs)
(ikarus system $symbols)
(ikarus system $bytevectors)
(ikarus unicode-data)
(only (ikarus unicode-data) unicode-printable-char?)
(except (ikarus) write display format printf print-error
error-handler error))

4
src/makefile.ss
View File

@ -299,6 +299,10 @@
[integer->char i r]
[char->integer i r]
[char-whitespace? i r]
[char-downcase i]
[char-upcase i]
[char-titlecase i]
[char-foldcase i]
[string? i r]
[string i r]
[make-string i r]

39
src/unicode/extract-cases.ss
View File

@ -28,24 +28,27 @@
(define (compute-foldcase ls)
(define (find-vec idx)
(let f ([ls ls])
(cond
[(null? ls) (error 'find-vec "cannot find ~s" idx)]
[(= (caar ls) idx) (cdar ls)]
[else (f (cdr ls))])))
(let ([v (list->vector (map cdr ls))])
(define (upper i)
(+ i (vector-ref (find-vec i) 0)))
(define (lower i)
(+ i (vector-ref (find-vec i) 1)))
(define (set-folder! i j)
(vector-set! (find-vec i) 3 (- j i)))
(for-each
(lambda (x)
(let ([idx (car x)] [vec (cdr x)])
(vector-set! vec 3
(- (lower (upper idx)) idx))))
ls))
(cond
[(assq idx ls) => cdr]
[else (error 'find-vec "~s is missing" idx)]))
(define (upper i)
(+ i (vector-ref (find-vec i) 0)))
(define (lower i)
(+ i (vector-ref (find-vec i) 1)))
(define (set-folder! i j)
(vector-set! (find-vec i) 3 (- j i)))
(for-each
(lambda (x)
(let ([idx (car x)] [vec (cdr x)])
(vector-set! vec 3
(- (lower (upper idx)) idx))))
ls)
(for-each
(lambda (idx)
(let ([vec (find-vec idx)])
(vector-set! vec 3 0)))
;; turkic chars
'(#x130 #x131))
ls)
(define uc-index 12)

46
src/unicode/unicode-char-cases.ss
View File

@ -181,33 +181,33 @@
-1 0 -1 0 -7264 0 0 0 -32 0 0 -40 0))
(define char-foldcase-adjustment-vector
'#(0 32 0 0 0 775 0 32 0 32 0 0 0 0 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0
1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 -199 -200 1 0 1 0 1
0 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1
0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 -121 1 0 1 0 1 0 -268
0 210 1 0 1 0 206 1 0 205 1 0 0 79 202 203 1 0 205 207 0 211 209 1 0 0 0
211 213 0 214 1 0 1 0 1 0 218 1 0 218 0 1 0 218 1 0 217 1 0 1 0 219 1 0 0 1
0 0 0 0 2 1 0 2 1 0 2 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 0 1 0 1 0 1 0 1 0
1 0 1 0 1 0 1 0 1 0 0 2 1 0 1 0 -97 -56 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0
1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 -130 0 1 0 1 0 1 0 1 0 1 0 1 0
1 0 1 0 1 0 0 10795 1 0 -163 10792 0 1 0 -195 69 71 1 0 1 0 1 0 1 0 1 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 116
0 0 0 38 0 37 64 63 0 32 0 0 0 0 1 0 0 0 -30 -25 0 -15 -22 0 1 0 1 0 1 0 1
0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 -54 -48 0 0 -60 -64 0 1 0 -7 1 0 0 -130
80 32 0 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1
0 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0
1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 15 1 0 1 0 1 0 1 0 1 0 1 0 1 0 0 1 0 1
1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 0 0 1 0 1 0 1 0 0 1
0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0
1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 -121 1 0 1 0 1 0 -268 0 210
1 0 1 0 206 1 0 205 1 0 0 79 202 203 1 0 205 207 0 211 209 1 0 0 0 211 213
0 214 1 0 1 0 1 0 218 1 0 218 0 1 0 218 1 0 217 1 0 1 0 219 1 0 0 1 0 0 0 0
2 1 0 2 1 0 2 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 0 1 0 1 0 1 0 1 0 1 0 1 0
1 0 1 0 1 0 0 2 1 0 1 0 -97 -56 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0
1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 -130 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0
1 0 0 10795 1 0 -163 10792 0 1 0 -195 69 71 1 0 1 0 1 0 1 0 1 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 116 0 0 0
38 0 37 64 63 0 32 0 0 0 0 1 0 0 0 -30 -25 0 -15 -22 0 1 0 1 0 1 0 1 0 1 0
1 0 1 0 1 0 1 0 1 0 1 0 1 0 -54 -48 0 0 -60 -64 0 1 0 -7 1 0 0 -130 80 32 0
0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 0 1 0
1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0
1 0 1 0 1 0 1 0 1 0 1 0 1 0 15 1 0 1 0 1 0 1 0 1 0 1 0 1 0 0 1 0 1 0 1 0 1
0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1
0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 48 0 0 0 7264 0 0 0 1
0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 48 0 0 0 7264 0 0 0 1 0 1 0 1
0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1
0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1
0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1
0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 0 -58
0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 0 -58 1 0 1 0
1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0
1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0
1 0 1 0 1 0 1 0 1 0 1 0 1 0 0 -8 0 -8 0 -8 0 -8 0 -8 0 0 0 0 0 0 0 0 -8 0
-8 0 0 0 0 0 0 0 -8 0 -8 0 -8 0 0 0 0 -8 -74 -9 0 -7173 0 0 0 -86 -9 0 0 0
-8 -100 0 0 0 0 0 -8 -112 -7 0 0 0 -128 -126 -9 0 -7517 0 -8383 -8262 0 28
0 0 0 16 0 0 1 0 0 26 0 0 48 0 1 0 -10743 -3814 -10727 0 0 1 0 1 0 1 0 0 1
0 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0
1 0 1 0 1 0 1 0 1 0 0 -8 0 -8 0 -8 0 -8 0 -8 0 0 0 0 0 0 0 0 -8 0 -8 0 0 0
0 0 0 0 -8 0 -8 0 -8 0 0 0 0 -8 -74 -9 0 -7173 0 0 0 -86 -9 0 0 0 -8 -100 0
0 0 0 0 -8 -112 -7 0 0 0 -128 -126 -9 0 -7517 0 -8383 -8262 0 28 0 0 0 16 0
0 1 0 0 26 0 0 48 0 1 0 -10743 -3814 -10727 0 0 1 0 1 0 1 0 0 1 0 0 1 0 1 0
1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0
1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 0 0 0 32 0 0 0 40 0 0))
1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0
1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 0 0 0 32 0 0 0 40 0 0))