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-r5rs
benchmarks/results.Petite-Chez-Scheme-r6rs benchmarks/results.Petite-Chez-Scheme-r6rs
benchmarks/results.Scheme48-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) (define (flabs x)
(if (flonum? x) (if (flonum? x)
(if (flnegative? x) (if ($fl> x 0.0)
(fl* x -1.0) ($fl* x -1.0)
x) x)
(error 'flabs "~s is not a flonum" x))) (error 'flabs "~s is not a flonum" x)))
) )
@ -441,7 +441,7 @@
(foreign-call "ikrt_fxbnminus" x y)] (foreign-call "ikrt_fxbnminus" x y)]
[(flonum? y) [(flonum? y)
(if ($fx= x 0) (if ($fx= x 0)
(fl* y -1.0) ($fl* y -1.0)
($fl- (fixnum->flonum x) y))] ($fl- (fixnum->flonum x) y))]
[(ratnum? y) [(ratnum? y)
(let ([n ($ratnum-n y)] [d ($ratnum-d y)]) (let ([n ($ratnum-n y)] [d ($ratnum-d y)])
@ -881,7 +881,7 @@
(if ($bignum-positive? x) x (- x))] (if ($bignum-positive? x) x (- x))]
[(flonum? x) [(flonum? x)
(if ($flnegative? x) (if ($flnegative? x)
(fl* x -1.0) ($fl* x -1.0)
x)] x)]
[(ratnum? x) [(ratnum? x)
(let ([n ($ratnum-n x)]) (let ([n ($ratnum-n x)])
@ -1287,7 +1287,7 @@
(f (fl- ac (car rest)) (cdr rest))))] (f (fl- ac (car rest)) (cdr rest))))]
[(x) [(x)
(if (flonum? x) (if (flonum? x)
(fl- 0.0 x) ($fl* -1.0 x)
(error 'fl+ "~s is not a flonum" x))])) (error 'fl+ "~s is not a flonum" x))]))
(define fl* (define fl*
@ -1532,7 +1532,7 @@
(define flnegative? (define flnegative?
(lambda (x) (lambda (x)
(if (flonum? x) (if (flonum? x)
($flnegative? x) ($fl< x 0.0)
(error 'flnegative? "~s is not a flonum" x)))) (error 'flnegative? "~s is not a flonum" x))))
(define exact-integer-sqrt (define exact-integer-sqrt

2
src/ikarus.reader.ss
View File

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

2
src/ikarus.writer.ss
View File

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

4
src/makefile.ss
View File

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

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

@ -28,24 +28,27 @@
(define (compute-foldcase ls) (define (compute-foldcase ls)
(define (find-vec idx) (define (find-vec idx)
(let f ([ls ls]) (cond
(cond [(assq idx ls) => cdr]
[(null? ls) (error 'find-vec "cannot find ~s" idx)] [else (error 'find-vec "~s is missing" idx)]))
[(= (caar ls) idx) (cdar ls)] (define (upper i)
[else (f (cdr ls))]))) (+ i (vector-ref (find-vec i) 0)))
(let ([v (list->vector (map cdr ls))]) (define (lower i)
(define (upper i) (+ i (vector-ref (find-vec i) 1)))
(+ i (vector-ref (find-vec i) 0))) (define (set-folder! i j)
(define (lower i) (vector-set! (find-vec i) 3 (- j i)))
(+ i (vector-ref (find-vec i) 1))) (for-each
(define (set-folder! i j) (lambda (x)
(vector-set! (find-vec i) 3 (- j i))) (let ([idx (car x)] [vec (cdr x)])
(for-each (vector-set! vec 3
(lambda (x) (- (lower (upper idx)) idx))))
(let ([idx (car x)] [vec (cdr x)]) ls)
(vector-set! vec 3 (for-each
(- (lower (upper idx)) idx)))) (lambda (idx)
ls)) (let ([vec (find-vec idx)])
(vector-set! vec 3 0)))
;; turkic chars
'(#x130 #x131))
ls) ls)
(define uc-index 12) (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)) -1 0 -1 0 -7264 0 0 0 -32 0 0 -40 0))
(define char-foldcase-adjustment-vector (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 '#(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 1 0 1 0 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 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 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 -121 1 0 1 0 1 0 -268 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
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 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
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 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
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 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 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 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 1 0 1 0 -130 0 1 0 1 0 1 0 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 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 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 0 0 0 0 116 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
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 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
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 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
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 1 0 1 0 1 0 1 0 1 0 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
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 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 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 1 0 1 0 1 0 1 0 1 0 1
0 1 0 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 1 0 1
0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1
0 1 0 1 0 1 0 1 0 1 0 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 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 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 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
-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 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
-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 0 -8 -112 -7 0 0 0 -128 -126 -9 0 -7517 0 -8383 -8262 0 28 0 0 0 16 0
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 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
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 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))